1 /* File IO for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-2014 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
10 (at 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 <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
34 #ifdef HAVE_LIBSELINUX
35 #include <selinux/selinux.h>
36 #include <selinux/context.h>
39 #ifdef HAVE_ACL_SET_FILE
46 #include "intervals.h"
47 #include "character.h"
51 #include "blockinput.h"
52 #include "region-cache.h"
54 #include "dispextern.h"
61 #endif /* not WINDOWSNT */
65 #include <sys/param.h>
69 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
70 redirector allows the six letters between 'Z' and 'a' as well. */
72 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
75 #define IS_DRIVE(x) c_isalpha (x)
77 /* Need to lower-case the drive letter, or else expanded
78 filenames will sometimes compare unequal, because
79 `expand-file-name' doesn't always down-case the drive letter. */
80 #define DRIVE_LETTER(x) c_tolower (x)
85 #include <allocator.h>
86 #include <careadlinkat.h>
87 #include <stat-time.h>
95 /* True during writing of auto-save files. */
96 static bool auto_saving
;
98 /* Emacs's real umask. */
99 static mode_t realmask
;
101 /* Nonzero umask during creation of auto-save directories. */
102 static mode_t auto_saving_dir_umask
;
104 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
105 a new file with the same mode as the original. */
106 static mode_t auto_save_mode_bits
;
108 /* Set by auto_save_1 if an error occurred during the last auto-save. */
109 static bool auto_save_error_occurred
;
111 /* If VALID_TIMESTAMP_FILE_SYSTEM, then TIMESTAMP_FILE_SYSTEM is the device
112 number of a file system where time stamps were observed to to work. */
113 static bool valid_timestamp_file_system
;
114 static dev_t timestamp_file_system
;
116 /* The symbol bound to coding-system-for-read when
117 insert-file-contents is called for recovering a file. This is not
118 an actual coding system name, but just an indicator to tell
119 insert-file-contents to use `emacs-mule' with a special flag for
120 auto saving and recovering a file. */
121 static Lisp_Object Qauto_save_coding
;
123 /* Property name of a file name handler,
124 which gives a list of operations it handles.. */
125 static Lisp_Object Qoperations
;
127 /* Lisp functions for translating file formats. */
128 static Lisp_Object Qformat_decode
, Qformat_annotate_function
;
130 /* Lisp function for setting buffer-file-coding-system and the
131 multibyteness of the current buffer after inserting a file. */
132 static Lisp_Object Qafter_insert_file_set_coding
;
134 static Lisp_Object Qwrite_region_annotate_functions
;
135 /* Each time an annotation function changes the buffer, the new buffer
137 static Lisp_Object Vwrite_region_annotation_buffers
;
139 static Lisp_Object Qdelete_by_moving_to_trash
;
141 /* Lisp function for moving files to trash. */
142 static Lisp_Object Qmove_file_to_trash
;
144 /* Lisp function for recursively copying directories. */
145 static Lisp_Object Qcopy_directory
;
147 /* Lisp function for recursively deleting directories. */
148 static Lisp_Object Qdelete_directory
;
150 static Lisp_Object Qsubstitute_env_in_file_name
;
152 Lisp_Object Qfile_error
, Qfile_notify_error
;
153 static Lisp_Object Qfile_already_exists
, Qfile_date_error
;
154 static Lisp_Object Qexcl
;
155 Lisp_Object Qfile_name_history
;
157 static Lisp_Object Qcar_less_than_car
;
159 static bool a_write (int, Lisp_Object
, ptrdiff_t, ptrdiff_t,
160 Lisp_Object
*, struct coding_system
*);
161 static bool e_write (int, Lisp_Object
, ptrdiff_t, ptrdiff_t,
162 struct coding_system
*);
165 /* Return true if FILENAME exists. */
168 check_existing (const char *filename
)
170 return faccessat (AT_FDCWD
, filename
, F_OK
, AT_EACCESS
) == 0;
173 /* Return true if file FILENAME exists and can be executed. */
176 check_executable (char *filename
)
178 return faccessat (AT_FDCWD
, filename
, X_OK
, AT_EACCESS
) == 0;
181 /* Return true if file FILENAME exists and can be accessed
182 according to AMODE, which should include W_OK.
183 On failure, return false and set errno. */
186 check_writable (const char *filename
, int amode
)
189 /* FIXME: an faccessat implementation should be added to the
190 DOS/Windows ports and this #ifdef branch should be removed. */
192 if (stat (filename
, &st
) < 0)
195 return (st
.st_mode
& S_IWRITE
|| S_ISDIR (st
.st_mode
));
196 #else /* not MSDOS */
197 bool res
= faccessat (AT_FDCWD
, filename
, amode
, AT_EACCESS
) == 0;
199 /* faccessat may have returned failure because Cygwin couldn't
200 determine the file's UID or GID; if so, we return success. */
203 int faccessat_errno
= errno
;
205 if (stat (filename
, &st
) < 0)
207 res
= (st
.st_uid
== -1 || st
.st_gid
== -1);
208 errno
= faccessat_errno
;
212 #endif /* not MSDOS */
215 /* Signal a file-access failure. STRING describes the failure,
216 NAME the file involved, and ERRORNO the errno value.
218 If NAME is neither null nor a pair, package it up as a singleton
219 list before reporting it; this saves report_file_errno's caller the
220 trouble of preserving errno before calling list1. */
223 report_file_errno (char const *string
, Lisp_Object name
, int errorno
)
225 Lisp_Object data
= CONSP (name
) || NILP (name
) ? name
: list1 (name
);
226 Lisp_Object errstring
;
229 synchronize_system_messages_locale ();
230 str
= strerror (errorno
);
231 errstring
= code_convert_string_norecord (build_unibyte_string (str
),
232 Vlocale_coding_system
, 0);
238 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
241 /* System error messages are capitalized. Downcase the initial
242 unless it is followed by a slash. (The slash case caters to
243 error messages that begin with "I/O" or, in German, "E/A".) */
244 if (STRING_MULTIBYTE (errstring
)
245 && ! EQ (Faref (errstring
, make_number (1)), make_number ('/')))
249 str
= SSDATA (errstring
);
250 c
= STRING_CHAR ((unsigned char *) str
);
251 Faset (errstring
, make_number (0), make_number (downcase (c
)));
254 xsignal (Qfile_error
,
255 Fcons (build_string (string
), Fcons (errstring
, data
)));
259 /* Signal a file-access failure that set errno. STRING describes the
260 failure, NAME the file involved. When invoking this function, take
261 care to not use arguments such as build_string ("foo") that involve
262 side effects that may set errno. */
265 report_file_error (char const *string
, Lisp_Object name
)
267 report_file_errno (string
, name
, errno
);
271 close_file_unwind (int fd
)
277 fclose_unwind (void *arg
)
283 /* Restore point, having saved it as a marker. */
286 restore_point_unwind (Lisp_Object location
)
288 Fgoto_char (location
);
289 unchain_marker (XMARKER (location
));
293 static Lisp_Object Qexpand_file_name
;
294 static Lisp_Object Qsubstitute_in_file_name
;
295 static Lisp_Object Qdirectory_file_name
;
296 static Lisp_Object Qfile_name_directory
;
297 static Lisp_Object Qfile_name_nondirectory
;
298 static Lisp_Object Qunhandled_file_name_directory
;
299 static Lisp_Object Qfile_name_as_directory
;
300 static Lisp_Object Qcopy_file
;
301 static Lisp_Object Qmake_directory_internal
;
302 static Lisp_Object Qmake_directory
;
303 static Lisp_Object Qdelete_directory_internal
;
304 Lisp_Object Qdelete_file
;
305 static Lisp_Object Qrename_file
;
306 static Lisp_Object Qadd_name_to_file
;
307 static Lisp_Object Qmake_symbolic_link
;
308 Lisp_Object Qfile_exists_p
;
309 static Lisp_Object Qfile_executable_p
;
310 static Lisp_Object Qfile_readable_p
;
311 static Lisp_Object Qfile_writable_p
;
312 static Lisp_Object Qfile_symlink_p
;
313 static Lisp_Object Qaccess_file
;
314 Lisp_Object Qfile_directory_p
;
315 static Lisp_Object Qfile_regular_p
;
316 static Lisp_Object Qfile_accessible_directory_p
;
317 static Lisp_Object Qfile_modes
;
318 static Lisp_Object Qset_file_modes
;
319 static Lisp_Object Qset_file_times
;
320 static Lisp_Object Qfile_selinux_context
;
321 static Lisp_Object Qset_file_selinux_context
;
322 static Lisp_Object Qfile_acl
;
323 static Lisp_Object Qset_file_acl
;
324 static Lisp_Object Qfile_newer_than_file_p
;
325 Lisp_Object Qinsert_file_contents
;
326 Lisp_Object Qwrite_region
;
327 static Lisp_Object Qverify_visited_file_modtime
;
328 static Lisp_Object Qset_visited_file_modtime
;
330 DEFUN ("find-file-name-handler", Ffind_file_name_handler
,
331 Sfind_file_name_handler
, 2, 2, 0,
332 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
333 Otherwise, return nil.
334 A file name is handled if one of the regular expressions in
335 `file-name-handler-alist' matches it.
337 If OPERATION equals `inhibit-file-name-operation', then we ignore
338 any handlers that are members of `inhibit-file-name-handlers',
339 but we still do run any other handlers. This lets handlers
340 use the standard functions without calling themselves recursively. */)
341 (Lisp_Object filename
, Lisp_Object operation
)
343 /* This function must not munge the match data. */
344 Lisp_Object chain
, inhibited_handlers
, result
;
348 CHECK_STRING (filename
);
350 if (EQ (operation
, Vinhibit_file_name_operation
))
351 inhibited_handlers
= Vinhibit_file_name_handlers
;
353 inhibited_handlers
= Qnil
;
355 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
356 chain
= XCDR (chain
))
362 Lisp_Object string
= XCAR (elt
);
364 Lisp_Object handler
= XCDR (elt
);
365 Lisp_Object operations
= Qnil
;
367 if (SYMBOLP (handler
))
368 operations
= Fget (handler
, Qoperations
);
371 && (match_pos
= fast_string_match (string
, filename
)) > pos
372 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
376 handler
= XCDR (elt
);
377 tem
= Fmemq (handler
, inhibited_handlers
);
391 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
393 doc
: /* Return the directory component in file name FILENAME.
394 Return nil if FILENAME does not include a directory.
395 Otherwise return a directory name.
396 Given a Unix syntax file name, returns a string ending in slash. */)
397 (Lisp_Object filename
)
400 register const char *beg
;
405 register const char *p
;
408 CHECK_STRING (filename
);
410 /* If the file name has special constructs in it,
411 call the corresponding file handler. */
412 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
415 Lisp_Object handled_name
= call2 (handler
, Qfile_name_directory
,
417 return STRINGP (handled_name
) ? handled_name
: Qnil
;
421 beg
= xlispstrdupa (filename
);
423 beg
= SSDATA (filename
);
425 p
= beg
+ SBYTES (filename
);
427 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
429 /* only recognize drive specifier at the beginning */
431 /* handle the "/:d:foo" and "/:foo" cases correctly */
432 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
433 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
440 /* Expansion of "c:" to drive and default directory. */
443 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
444 char *res
= alloca (MAXPATHLEN
+ 1);
447 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
449 memcpy (res
, beg
, 2);
454 if (getdefdir (c_toupper (*beg
) - 'A' + 1, r
))
456 size_t l
= strlen (res
);
458 if (l
> 3 || !IS_DIRECTORY_SEP (res
[l
- 1]))
461 p
= beg
+ strlen (beg
);
462 dostounix_filename (beg
);
463 tem_fn
= make_specified_string (beg
, -1, p
- beg
,
464 STRING_MULTIBYTE (filename
));
467 tem_fn
= make_specified_string (beg
- 2, -1, p
- beg
+ 2,
468 STRING_MULTIBYTE (filename
));
470 else if (STRING_MULTIBYTE (filename
))
472 tem_fn
= make_specified_string (beg
, -1, p
- beg
, 1);
473 dostounix_filename (SSDATA (tem_fn
));
475 if (!NILP (Vw32_downcase_file_names
))
476 tem_fn
= Fdowncase (tem_fn
);
481 dostounix_filename (beg
);
482 tem_fn
= make_specified_string (beg
, -1, p
- beg
, 0);
486 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
490 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
491 Sfile_name_nondirectory
, 1, 1, 0,
492 doc
: /* Return file name FILENAME sans its directory.
493 For example, in a Unix-syntax file name,
494 this is everything after the last slash,
495 or the entire name if it contains no slash. */)
496 (Lisp_Object filename
)
498 register const char *beg
, *p
, *end
;
501 CHECK_STRING (filename
);
503 /* If the file name has special constructs in it,
504 call the corresponding file handler. */
505 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
508 Lisp_Object handled_name
= call2 (handler
, Qfile_name_nondirectory
,
510 if (STRINGP (handled_name
))
512 error ("Invalid handler in `file-name-handler-alist'");
515 beg
= SSDATA (filename
);
516 end
= p
= beg
+ SBYTES (filename
);
518 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
520 /* only recognize drive specifier at beginning */
522 /* handle the "/:d:foo" case correctly */
523 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
528 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
531 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
532 Sunhandled_file_name_directory
, 1, 1, 0,
533 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
534 A `directly usable' directory name is one that may be used without the
535 intervention of any file handler.
536 If FILENAME is a directly usable file itself, return
537 \(file-name-directory FILENAME).
538 If FILENAME refers to a file which is not accessible from a local process,
539 then this should return nil.
540 The `call-process' and `start-process' functions use this function to
541 get a current directory to run processes in. */)
542 (Lisp_Object filename
)
546 /* If the file name has special constructs in it,
547 call the corresponding file handler. */
548 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
551 Lisp_Object handled_name
= call2 (handler
, Qunhandled_file_name_directory
,
553 return STRINGP (handled_name
) ? handled_name
: Qnil
;
556 return Ffile_name_directory (filename
);
559 /* Maximum number of bytes that DST will be longer than SRC
560 in file_name_as_directory. This occurs when SRCLEN == 0. */
561 enum { file_name_as_directory_slop
= 2 };
563 /* Convert from file name SRC of length SRCLEN to directory name in
564 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
565 string. On UNIX, just make sure there is a terminating /. Return
566 the length of DST in bytes. */
569 file_name_as_directory (char *dst
, const char *src
, ptrdiff_t srclen
,
580 memcpy (dst
, src
, srclen
);
581 if (!IS_DIRECTORY_SEP (dst
[srclen
- 1]))
582 dst
[srclen
++] = DIRECTORY_SEP
;
585 dostounix_filename (dst
);
590 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
591 Sfile_name_as_directory
, 1, 1, 0,
592 doc
: /* Return a string representing the file name FILE interpreted as a directory.
593 This operation exists because a directory is also a file, but its name as
594 a directory is different from its name as a file.
595 The result can be used as the value of `default-directory'
596 or passed as second argument to `expand-file-name'.
597 For a Unix-syntax file name, just appends a slash. */)
602 Lisp_Object handler
, val
;
609 /* If the file name has special constructs in it,
610 call the corresponding file handler. */
611 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
614 Lisp_Object handled_name
= call2 (handler
, Qfile_name_as_directory
,
616 if (STRINGP (handled_name
))
618 error ("Invalid handler in `file-name-handler-alist'");
622 if (!NILP (Vw32_downcase_file_names
))
623 file
= Fdowncase (file
);
625 buf
= SAFE_ALLOCA (SBYTES (file
) + file_name_as_directory_slop
+ 1);
626 length
= file_name_as_directory (buf
, SSDATA (file
), SBYTES (file
),
627 STRING_MULTIBYTE (file
));
628 val
= make_specified_string (buf
, -1, length
, STRING_MULTIBYTE (file
));
633 /* Convert from directory name SRC of length SRCLEN to file name in
634 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
635 string. On UNIX, just make sure there isn't a terminating /.
636 Return the length of DST in bytes. */
639 directory_file_name (char *dst
, char *src
, ptrdiff_t srclen
, bool multibyte
)
641 /* Process as Unix format: just remove any final slash.
642 But leave "/" and "//" unchanged. */
645 && !IS_ANY_SEP (src
[srclen
- 2])
647 && IS_DIRECTORY_SEP (src
[srclen
- 1])
648 && ! (srclen
== 2 && IS_DIRECTORY_SEP (src
[0])))
651 memcpy (dst
, src
, srclen
);
654 dostounix_filename (dst
);
659 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
661 doc
: /* Returns the file name of the directory named DIRECTORY.
662 This is the name of the file that holds the data for the directory DIRECTORY.
663 This operation exists because a directory is also a file, but its name as
664 a directory is different from its name as a file.
665 In Unix-syntax, this function just removes the final slash. */)
666 (Lisp_Object directory
)
670 Lisp_Object handler
, val
;
673 CHECK_STRING (directory
);
675 if (NILP (directory
))
678 /* If the file name has special constructs in it,
679 call the corresponding file handler. */
680 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
683 Lisp_Object handled_name
= call2 (handler
, Qdirectory_file_name
,
685 if (STRINGP (handled_name
))
687 error ("Invalid handler in `file-name-handler-alist'");
691 if (!NILP (Vw32_downcase_file_names
))
692 directory
= Fdowncase (directory
);
694 buf
= SAFE_ALLOCA (SBYTES (directory
) + 1);
695 length
= directory_file_name (buf
, SSDATA (directory
), SBYTES (directory
),
696 STRING_MULTIBYTE (directory
));
697 val
= make_specified_string (buf
, -1, length
, STRING_MULTIBYTE (directory
));
702 static const char make_temp_name_tbl
[64] =
704 'A','B','C','D','E','F','G','H',
705 'I','J','K','L','M','N','O','P',
706 'Q','R','S','T','U','V','W','X',
707 'Y','Z','a','b','c','d','e','f',
708 'g','h','i','j','k','l','m','n',
709 'o','p','q','r','s','t','u','v',
710 'w','x','y','z','0','1','2','3',
711 '4','5','6','7','8','9','-','_'
714 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
716 /* Value is a temporary file name starting with PREFIX, a string.
718 The Emacs process number forms part of the result, so there is
719 no danger of generating a name being used by another process.
720 In addition, this function makes an attempt to choose a name
721 which has no existing file. To make this work, PREFIX should be
722 an absolute file name.
724 BASE64_P means add the pid as 3 characters in base64
725 encoding. In this case, 6 characters will be added to PREFIX to
726 form the file name. Otherwise, if Emacs is running on a system
727 with long file names, add the pid as a decimal number.
729 This function signals an error if no unique file name could be
733 make_temp_name (Lisp_Object prefix
, bool base64_p
)
735 Lisp_Object val
, encoded_prefix
;
739 char pidbuf
[INT_BUFSIZE_BOUND (printmax_t
)];
742 CHECK_STRING (prefix
);
744 /* VAL is created by adding 6 characters to PREFIX. The first
745 three are the PID of this process, in base 64, and the second
746 three are incremented if the file already exists. This ensures
747 262144 unique file names per PID per PREFIX. */
753 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
754 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
755 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
760 #ifdef HAVE_LONG_FILE_NAMES
761 pidlen
= sprintf (pidbuf
, "%"pMd
, pid
);
763 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
764 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
765 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
770 encoded_prefix
= ENCODE_FILE (prefix
);
771 len
= SBYTES (encoded_prefix
);
772 val
= make_uninit_string (len
+ 3 + pidlen
);
774 memcpy (data
, SSDATA (encoded_prefix
), len
);
777 memcpy (p
, pidbuf
, pidlen
);
780 /* Here we try to minimize useless stat'ing when this function is
781 invoked many times successively with the same PREFIX. We achieve
782 this by initializing count to a random value, and incrementing it
785 We don't want make-temp-name to be called while dumping,
786 because then make_temp_name_count_initialized_p would get set
787 and then make_temp_name_count would not be set when Emacs starts. */
789 if (!make_temp_name_count_initialized_p
)
791 make_temp_name_count
= time (NULL
);
792 make_temp_name_count_initialized_p
= 1;
797 unsigned num
= make_temp_name_count
;
799 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
800 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
801 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
803 /* Poor man's congruential RN generator. Replace with
804 ++make_temp_name_count for debugging. */
805 make_temp_name_count
+= 25229;
806 make_temp_name_count
%= 225307;
808 if (!check_existing (data
))
810 /* We want to return only if errno is ENOENT. */
812 return DECODE_FILE (val
);
814 /* The error here is dubious, but there is little else we
815 can do. The alternatives are to return nil, which is
816 as bad as (and in many cases worse than) throwing the
817 error, or to ignore the error, which will likely result
818 in looping through 225307 stat's, which is not only
819 dog-slow, but also useless since eventually nil would
820 have to be returned anyway. */
821 report_file_error ("Cannot create temporary name for prefix",
829 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
830 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
831 The Emacs process number forms part of the result,
832 so there is no danger of generating a name being used by another process.
834 In addition, this function makes an attempt to choose a name
835 which has no existing file. To make this work,
836 PREFIX should be an absolute file name.
838 There is a race condition between calling `make-temp-name' and creating the
839 file which opens all kinds of security holes. For that reason, you should
840 probably use `make-temp-file' instead, except in three circumstances:
842 * If you are creating the file in the user's home directory.
843 * If you are creating a directory rather than an ordinary file.
844 * If you are taking special precautions as `make-temp-file' does. */)
847 return make_temp_name (prefix
, 0);
852 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
853 doc
: /* Convert filename NAME to absolute, and canonicalize it.
854 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
855 \(does not start with slash or tilde); both the directory name and
856 a directory's file name are accepted. If DEFAULT-DIRECTORY is nil or
857 missing, the current buffer's value of `default-directory' is used.
858 NAME should be a string that is a valid file name for the underlying
860 File name components that are `.' are removed, and
861 so are file name components followed by `..', along with the `..' itself;
862 note that these simplifications are done without checking the resulting
863 file names in the file system.
864 Multiple consecutive slashes are collapsed into a single slash,
865 except at the beginning of the file name when they are significant (e.g.,
866 UNC file names on MS-Windows.)
867 An initial `~/' expands to your home directory.
868 An initial `~USER/' expands to USER's home directory.
869 See also the function `substitute-in-file-name'.
871 For technical reasons, this function can return correct but
872 non-intuitive results for the root directory; for instance,
873 \(expand-file-name ".." "/") returns "/..". For this reason, use
874 \(directory-file-name (file-name-directory dirname)) to traverse a
875 filesystem tree, not (expand-file-name ".." dirname). */)
876 (Lisp_Object name
, Lisp_Object default_directory
)
878 /* These point to SDATA and need to be careful with string-relocation
879 during GC (via DECODE_FILE). */
882 /* This should only point to alloca'd data. */
889 bool collapse_newdir
= 1;
892 ptrdiff_t length
, newdirlen
;
893 Lisp_Object handler
, result
, handled_name
;
900 /* If the file name has special constructs in it,
901 call the corresponding file handler. */
902 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
905 handled_name
= call3 (handler
, Qexpand_file_name
,
906 name
, default_directory
);
907 if (STRINGP (handled_name
))
909 error ("Invalid handler in `file-name-handler-alist'");
913 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
914 if (NILP (default_directory
))
915 default_directory
= BVAR (current_buffer
, directory
);
916 if (! STRINGP (default_directory
))
919 /* "/" is not considered a root directory on DOS_NT, so using "/"
920 here causes an infinite recursion in, e.g., the following:
922 (let (default-directory)
923 (expand-file-name "a"))
925 To avoid this, we set default_directory to the root of the
927 default_directory
= build_string (emacs_root_dir ());
929 default_directory
= build_string ("/");
933 if (!NILP (default_directory
))
935 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
938 handled_name
= call3 (handler
, Qexpand_file_name
,
939 name
, default_directory
);
940 if (STRINGP (handled_name
))
942 error ("Invalid handler in `file-name-handler-alist'");
947 char *o
= SSDATA (default_directory
);
949 /* Make sure DEFAULT_DIRECTORY is properly expanded.
950 It would be better to do this down below where we actually use
951 default_directory. Unfortunately, calling Fexpand_file_name recursively
952 could invoke GC, and the strings might be relocated. This would
953 be annoying because we have pointers into strings lying around
954 that would need adjusting, and people would add new pointers to
955 the code and forget to adjust them, resulting in intermittent bugs.
956 Putting this call here avoids all that crud.
958 The EQ test avoids infinite recursion. */
959 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
960 /* Save time in some common cases - as long as default_directory
961 is not relative, it can be canonicalized with name below (if it
962 is needed at all) without requiring it to be expanded now. */
964 /* Detect MSDOS file names with drive specifiers. */
965 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
966 && IS_DIRECTORY_SEP (o
[2]))
968 /* Detect Windows file names in UNC format. */
969 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
971 #else /* not DOS_NT */
972 /* Detect Unix absolute file names (/... alone is not absolute on
974 && ! (IS_DIRECTORY_SEP (o
[0]))
975 #endif /* not DOS_NT */
981 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
985 multibyte
= STRING_MULTIBYTE (name
);
986 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
990 unsigned char *p
= SDATA (name
);
992 while (*p
&& ASCII_CHAR_P (*p
))
996 /* NAME is a pure ASCII string, and DEFAULT_DIRECTORY is
997 unibyte. Do not convert DEFAULT_DIRECTORY to
998 multibyte; instead, convert NAME to a unibyte string,
999 so that the result of this function is also a unibyte
1000 string. This is needed during bootstrapping and
1001 dumping, when Emacs cannot decode file names, because
1002 the locale environment is not set up. */
1003 name
= make_unibyte_string (SSDATA (name
), SBYTES (name
));
1007 default_directory
= string_to_multibyte (default_directory
);
1011 name
= string_to_multibyte (name
);
1017 if (!NILP (Vw32_downcase_file_names
))
1018 default_directory
= Fdowncase (default_directory
);
1021 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
1022 nm
= xlispstrdupa (name
);
1025 /* Note if special escape prefix is present, but remove for now. */
1026 if (nm
[0] == '/' && nm
[1] == ':')
1032 /* Find and remove drive specifier if present; this makes nm absolute
1033 even if the rest of the name appears to be relative. Only look for
1034 drive specifier at the beginning. */
1035 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1037 drive
= (unsigned char) nm
[0];
1042 /* If we see "c://somedir", we want to strip the first slash after the
1043 colon when stripping the drive letter. Otherwise, this expands to
1045 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1048 /* Discard any previous drive specifier if nm is now in UNC format. */
1049 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1])
1050 && !IS_DIRECTORY_SEP (nm
[2]))
1052 #endif /* WINDOWSNT */
1055 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1056 none are found, we can probably return right away. We will avoid
1057 allocating a new string if name is already fully expanded. */
1059 IS_DIRECTORY_SEP (nm
[0])
1061 && drive
&& !is_escaped
1064 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1068 /* If it turns out that the filename we want to return is just a
1069 suffix of FILENAME, we don't need to go through and edit
1070 things; we just need to construct a new string using data
1071 starting at the middle of FILENAME. If we set LOSE, that
1072 means we've discovered that we can't do that cool trick. */
1078 /* Since we know the name is absolute, we can assume that each
1079 element starts with a "/". */
1081 /* "." and ".." are hairy. */
1082 if (IS_DIRECTORY_SEP (p
[0])
1084 && (IS_DIRECTORY_SEP (p
[2])
1086 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1089 /* Replace multiple slashes with a single one, except
1090 leave leading "//" alone. */
1091 else if (IS_DIRECTORY_SEP (p
[0])
1092 && IS_DIRECTORY_SEP (p
[1])
1093 && (p
!= nm
|| IS_DIRECTORY_SEP (p
[2])))
1100 /* Make sure directories are all separated with /, but
1101 avoid allocation of a new string when not required. */
1102 dostounix_filename (nm
);
1104 if (IS_DIRECTORY_SEP (nm
[1]))
1106 if (strcmp (nm
, SSDATA (name
)) != 0)
1107 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1111 /* Drive must be set, so this is okay. */
1112 if (strcmp (nm
- 2, SSDATA (name
)) != 0)
1116 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1117 temp
[0] = DRIVE_LETTER (drive
);
1118 name
= concat2 (build_string (temp
), name
);
1121 if (!NILP (Vw32_downcase_file_names
))
1122 name
= Fdowncase (name
);
1125 #else /* not DOS_NT */
1126 if (strcmp (nm
, SSDATA (name
)) == 0)
1128 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1129 #endif /* not DOS_NT */
1133 /* At this point, nm might or might not be an absolute file name. We
1134 need to expand ~ or ~user if present, otherwise prefix nm with
1135 default_directory if nm is not absolute, and finally collapse /./
1136 and /foo/../ sequences.
1138 We set newdir to be the appropriate prefix if one is needed:
1139 - the relevant user directory if nm starts with ~ or ~user
1140 - the specified drive's working dir (DOS/NT only) if nm does not
1142 - the value of default_directory.
1144 Note that these prefixes are not guaranteed to be absolute (except
1145 for the working dir of a drive). Therefore, to ensure we always
1146 return an absolute name, if the final prefix is not absolute we
1147 append it to the current working directory. */
1152 if (nm
[0] == '~') /* prefix ~ */
1154 if (IS_DIRECTORY_SEP (nm
[1])
1155 || nm
[1] == 0) /* ~ by itself */
1159 if (!(newdir
= egetenv ("HOME")))
1162 /* `egetenv' may return a unibyte string, which will bite us since
1163 we expect the directory to be multibyte. */
1167 char newdir_utf8
[MAX_UTF8_PATH
];
1169 filename_from_ansi (newdir
, newdir_utf8
);
1170 tem
= build_string (newdir_utf8
);
1174 tem
= build_string (newdir
);
1175 newdirlen
= SBYTES (tem
);
1176 if (multibyte
&& !STRING_MULTIBYTE (tem
))
1178 hdir
= DECODE_FILE (tem
);
1179 newdir
= SSDATA (hdir
);
1180 newdirlen
= SBYTES (hdir
);
1183 collapse_newdir
= 0;
1186 else /* ~user/filename */
1189 for (p
= nm
; *p
&& !IS_DIRECTORY_SEP (*p
); p
++)
1191 o
= SAFE_ALLOCA (p
- nm
+ 1);
1192 memcpy (o
, nm
, p
- nm
);
1196 pw
= getpwnam (o
+ 1);
1202 newdir
= pw
->pw_dir
;
1203 /* `getpwnam' may return a unibyte string, which will
1204 bite us since we expect the directory to be
1206 tem
= build_string (newdir
);
1207 newdirlen
= SBYTES (tem
);
1208 if (multibyte
&& !STRING_MULTIBYTE (tem
))
1210 hdir
= DECODE_FILE (tem
);
1211 newdir
= SSDATA (hdir
);
1212 newdirlen
= SBYTES (hdir
);
1216 collapse_newdir
= 0;
1220 /* If we don't find a user of that name, leave the name
1221 unchanged; don't move nm forward to p. */
1226 /* On DOS and Windows, nm is absolute if a drive name was specified;
1227 use the drive's current directory as the prefix if needed. */
1228 if (!newdir
&& drive
)
1230 /* Get default directory if needed to make nm absolute. */
1232 if (!IS_DIRECTORY_SEP (nm
[0]))
1234 adir
= alloca (MAXPATHLEN
+ 1);
1235 if (!getdefdir (c_toupper (drive
) - 'A' + 1, adir
))
1239 Lisp_Object tem
= build_string (adir
);
1241 tem
= DECODE_FILE (tem
);
1242 newdirlen
= SBYTES (tem
);
1243 memcpy (adir
, SSDATA (tem
), newdirlen
+ 1);
1248 /* Either nm starts with /, or drive isn't mounted. */
1250 adir
[0] = DRIVE_LETTER (drive
);
1260 /* Finally, if no prefix has been specified and nm is not absolute,
1261 then it must be expanded relative to default_directory. */
1265 /* /... alone is not absolute on DOS and Windows. */
1266 && !IS_DIRECTORY_SEP (nm
[0])
1269 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1])
1270 && !IS_DIRECTORY_SEP (nm
[2]))
1274 newdir
= SSDATA (default_directory
);
1275 newdirlen
= SBYTES (default_directory
);
1277 /* Note if special escape prefix is present, but remove for now. */
1278 if (newdir
[0] == '/' && newdir
[1] == ':')
1290 /* First ensure newdir is an absolute name. */
1292 /* Detect MSDOS file names with drive specifiers. */
1293 ! (IS_DRIVE (newdir
[0])
1294 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1296 /* Detect Windows file names in UNC format. */
1297 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1])
1298 && !IS_DIRECTORY_SEP (newdir
[2]))
1302 /* Effectively, let newdir be (expand-file-name newdir cwd).
1303 Because of the admonition against calling expand-file-name
1304 when we have pointers into lisp strings, we accomplish this
1305 indirectly by prepending newdir to nm if necessary, and using
1306 cwd (or the wd of newdir's drive) as the new newdir. */
1309 const int adir_size
= MAX_UTF8_PATH
;
1311 const int adir_size
= MAXPATHLEN
+ 1;
1314 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1316 drive
= (unsigned char) newdir
[0];
1320 if (!IS_DIRECTORY_SEP (nm
[0]))
1322 char *tmp
= alloca (newdirlen
+ file_name_as_directory_slop
1324 file_name_as_directory (tmp
, newdir
, newdirlen
, multibyte
);
1328 adir
= alloca (adir_size
);
1331 if (!getdefdir (c_toupper (drive
) - 'A' + 1, adir
))
1335 getcwd (adir
, adir_size
);
1338 Lisp_Object tem
= build_string (adir
);
1340 tem
= DECODE_FILE (tem
);
1341 newdirlen
= SBYTES (tem
);
1342 memcpy (adir
, SSDATA (tem
), newdirlen
+ 1);
1345 newdirlen
= strlen (aidr
);
1349 /* Strip off drive name from prefix, if present. */
1350 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1357 /* Keep only a prefix from newdir if nm starts with slash
1358 (//server/share for UNC, nothing otherwise). */
1359 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1362 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1])
1363 && !IS_DIRECTORY_SEP (newdir
[2]))
1365 char *adir
= strcpy (alloca (newdirlen
+ 1), newdir
);
1367 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1369 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1372 newdirlen
= strlen (adir
);
1376 newdirlen
= 0, newdir
= "";
1383 /* Ignore any slash at the end of newdir, unless newdir is
1384 just "/" or "//". */
1386 eassert (length
== strlen (newdir
));
1387 while (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1388 && ! (length
== 2 && IS_DIRECTORY_SEP (newdir
[0])))
1394 /* Now concatenate the directory and name to new space in the stack frame. */
1395 tlen
= length
+ file_name_as_directory_slop
+ strlen (nm
) + 1;
1397 /* Reserve space for drive specifier and escape prefix, since either
1398 or both may need to be inserted. (The Microsoft x86 compiler
1399 produces incorrect code if the following two lines are combined.) */
1400 target
= alloca (tlen
+ 4);
1402 #else /* not DOS_NT */
1403 target
= SAFE_ALLOCA (tlen
);
1404 #endif /* not DOS_NT */
1409 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1412 /* If newdir is effectively "C:/", then the drive letter will have
1413 been stripped and newdir will be "/". Concatenating with an
1414 absolute directory in nm produces "//", which will then be
1415 incorrectly treated as a network share. Ignore newdir in
1416 this case (keeping the drive letter). */
1417 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1418 && newdir
[1] == '\0'))
1421 memcpy (target
, newdir
, length
);
1426 file_name_as_directory (target
, newdir
, length
, multibyte
);
1429 strcat (target
, nm
);
1431 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1439 if (!IS_DIRECTORY_SEP (*p
))
1443 else if (p
[1] == '.'
1444 && (IS_DIRECTORY_SEP (p
[2])
1447 /* If "/." is the entire filename, keep the "/". Otherwise,
1448 just delete the whole "/.". */
1449 if (o
== target
&& p
[2] == '\0')
1453 else if (p
[1] == '.' && p
[2] == '.'
1454 /* `/../' is the "superroot" on certain file systems.
1455 Turned off on DOS_NT systems because they have no
1456 "superroot" and because this causes us to produce
1457 file names like "d:/../foo" which fail file-related
1458 functions of the underlying OS. (To reproduce, try a
1459 long series of "../../" in default_directory, longer
1460 than the number of levels from the root.) */
1464 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1469 while (o
!= target
&& (--o
, !IS_DIRECTORY_SEP (*o
)))
1472 /* Don't go below server level in UNC filenames. */
1473 if (o
== target
+ 1 && IS_DIRECTORY_SEP (*o
)
1474 && IS_DIRECTORY_SEP (*target
))
1478 /* Keep initial / only if this is the whole name. */
1479 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1483 else if (IS_DIRECTORY_SEP (p
[1])
1484 && (p
!= target
|| IS_DIRECTORY_SEP (p
[2])))
1485 /* Collapse multiple "/", except leave leading "//" alone. */
1494 /* At last, set drive name. */
1496 /* Except for network file name. */
1497 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1498 #endif /* WINDOWSNT */
1500 if (!drive
) emacs_abort ();
1502 target
[0] = DRIVE_LETTER (drive
);
1505 /* Reinsert the escape prefix if required. */
1512 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1513 dostounix_filename (SSDATA (result
));
1515 if (!NILP (Vw32_downcase_file_names
))
1516 result
= Fdowncase (result
);
1519 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1520 #endif /* !DOS_NT */
1523 /* Again look to see if the file name has special constructs in it
1524 and perhaps call the corresponding file handler. This is needed
1525 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1526 the ".." component gives us "/user@host:/bar/../baz" which needs
1527 to be expanded again. */
1528 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1529 if (!NILP (handler
))
1531 handled_name
= call3 (handler
, Qexpand_file_name
,
1532 result
, default_directory
);
1533 if (! STRINGP (handled_name
))
1534 error ("Invalid handler in `file-name-handler-alist'");
1535 result
= handled_name
;
1543 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1544 This is the old version of expand-file-name, before it was thoroughly
1545 rewritten for Emacs 10.31. We leave this version here commented-out,
1546 because the code is very complex and likely to have subtle bugs. If
1547 bugs _are_ found, it might be of interest to look at the old code and
1548 see what did it do in the relevant situation.
1550 Don't remove this code: it's true that it will be accessible
1551 from the repository, but a few years from deletion, people will
1552 forget it is there. */
1554 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1555 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1556 "Convert FILENAME to absolute, and canonicalize it.\n\
1557 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1558 \(does not start with slash); if DEFAULT is nil or missing,\n\
1559 the current buffer's value of default-directory is used.\n\
1560 Filenames containing `.' or `..' as components are simplified;\n\
1561 initial `~/' expands to your home directory.\n\
1562 See also the function `substitute-in-file-name'.")
1564 Lisp_Object name
, defalt
;
1568 register unsigned char *newdir
, *p
, *o
;
1570 unsigned char *target
;
1573 CHECK_STRING (name
);
1576 /* If nm is absolute, flush ...// and detect /./ and /../.
1577 If no /./ or /../ we can return right away. */
1584 if (p
[0] == '/' && p
[1] == '/')
1586 if (p
[0] == '/' && p
[1] == '~')
1587 nm
= p
+ 1, lose
= 1;
1588 if (p
[0] == '/' && p
[1] == '.'
1589 && (p
[2] == '/' || p
[2] == 0
1590 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1596 if (nm
== SDATA (name
))
1598 return build_string (nm
);
1602 /* Now determine directory to start with and put it in NEWDIR. */
1606 if (nm
[0] == '~') /* prefix ~ */
1607 if (nm
[1] == '/' || nm
[1] == 0)/* ~/filename */
1609 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1610 newdir
= (unsigned char *) "";
1613 else /* ~user/filename */
1615 /* Get past ~ to user. */
1616 unsigned char *user
= nm
+ 1;
1617 /* Find end of name. */
1618 unsigned char *ptr
= (unsigned char *) strchr (user
, '/');
1619 ptrdiff_t len
= ptr
? ptr
- user
: strlen (user
);
1620 /* Copy the user name into temp storage. */
1621 o
= alloca (len
+ 1);
1622 memcpy (o
, user
, len
);
1625 /* Look up the user name. */
1627 pw
= (struct passwd
*) getpwnam (o
+ 1);
1630 error ("\"%s\" isn't a registered user", o
+ 1);
1632 newdir
= (unsigned char *) pw
->pw_dir
;
1634 /* Discard the user name from NM. */
1638 if (nm
[0] != '/' && !newdir
)
1641 defalt
= current_buffer
->directory
;
1642 CHECK_STRING (defalt
);
1643 newdir
= SDATA (defalt
);
1646 /* Now concatenate the directory and name to new space in the stack frame. */
1648 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1649 target
= alloca (tlen
);
1654 if (nm
[0] == 0 || nm
[0] == '/')
1655 strcpy (target
, newdir
);
1657 file_name_as_directory (target
, newdir
);
1660 strcat (target
, nm
);
1662 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1673 else if (!strncmp (p
, "//", 2)
1679 else if (p
[0] == '/' && p
[1] == '.'
1680 && (p
[2] == '/' || p
[2] == 0))
1682 else if (!strncmp (p
, "/..", 3)
1683 /* `/../' is the "superroot" on certain file systems. */
1685 && (p
[3] == '/' || p
[3] == 0))
1687 while (o
!= target
&& *--o
!= '/')
1689 if (o
== target
&& *o
== '/')
1699 return make_string (target
, o
- target
);
1703 /* If /~ or // appears, discard everything through first slash. */
1705 file_name_absolute_p (const char *filename
)
1708 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
1710 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
1711 && IS_DIRECTORY_SEP (filename
[2]))
1717 search_embedded_absfilename (char *nm
, char *endp
)
1721 for (p
= nm
+ 1; p
< endp
; p
++)
1723 if (IS_DIRECTORY_SEP (p
[-1])
1724 && file_name_absolute_p (p
)
1725 #if defined (WINDOWSNT) || defined (CYGWIN)
1726 /* // at start of file name is meaningful in Apollo,
1727 WindowsNT and Cygwin systems. */
1728 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
1729 #endif /* not (WINDOWSNT || CYGWIN) */
1732 for (s
= p
; *s
&& !IS_DIRECTORY_SEP (*s
); s
++);
1733 if (p
[0] == '~' && s
> p
+ 1) /* We've got "/~something/". */
1735 char *o
= alloca (s
- p
+ 1);
1737 memcpy (o
, p
, s
- p
);
1740 /* If we have ~user and `user' exists, discard
1741 everything up to ~. But if `user' does not exist, leave
1742 ~user alone, it might be a literal file name. */
1744 pw
= getpwnam (o
+ 1);
1756 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1757 Ssubstitute_in_file_name
, 1, 1, 0,
1758 doc
: /* Substitute environment variables referred to in FILENAME.
1759 `$FOO' where FOO is an environment variable name means to substitute
1760 the value of that variable. The variable name should be terminated
1761 with a character not a letter, digit or underscore; otherwise, enclose
1762 the entire variable name in braces.
1764 If `/~' appears, all of FILENAME through that `/' is discarded.
1765 If `//' appears, everything up to and including the first of
1766 those `/' is discarded. */)
1767 (Lisp_Object filename
)
1769 char *nm
, *p
, *x
, *endp
;
1770 bool substituted
= false;
1773 Lisp_Object handler
;
1775 CHECK_STRING (filename
);
1777 multibyte
= STRING_MULTIBYTE (filename
);
1779 /* If the file name has special constructs in it,
1780 call the corresponding file handler. */
1781 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1782 if (!NILP (handler
))
1784 Lisp_Object handled_name
= call2 (handler
, Qsubstitute_in_file_name
,
1786 if (STRINGP (handled_name
))
1787 return handled_name
;
1788 error ("Invalid handler in `file-name-handler-alist'");
1791 /* Always work on a copy of the string, in case GC happens during
1792 decode of environment variables, causing the original Lisp_String
1793 data to be relocated. */
1794 nm
= xlispstrdupa (filename
);
1797 dostounix_filename (nm
);
1798 substituted
= (memcmp (nm
, SDATA (filename
), SBYTES (filename
)) != 0);
1800 endp
= nm
+ SBYTES (filename
);
1802 /* If /~ or // appears, discard everything through first slash. */
1803 p
= search_embedded_absfilename (nm
, endp
);
1805 /* Start over with the new string, so we check the file-name-handler
1806 again. Important with filenames like "/home/foo//:/hello///there"
1807 which would substitute to "/:/hello///there" rather than "/there". */
1808 return Fsubstitute_in_file_name
1809 (make_specified_string (p
, -1, endp
- p
, multibyte
));
1811 /* See if any variables are substituted into the string. */
1813 if (!NILP (Ffboundp (Qsubstitute_env_in_file_name
)))
1816 = (!substituted
? filename
1817 : make_specified_string (nm
, -1, endp
- nm
, multibyte
));
1818 Lisp_Object tmp
= call1 (Qsubstitute_env_in_file_name
, name
);
1820 if (!EQ (tmp
, name
))
1828 if (!NILP (Vw32_downcase_file_names
))
1829 filename
= Fdowncase (filename
);
1834 xnm
= SSDATA (filename
);
1835 x
= xnm
+ SBYTES (filename
);
1837 /* If /~ or // appears, discard everything through first slash. */
1838 while ((p
= search_embedded_absfilename (xnm
, x
)) != NULL
)
1839 /* This time we do not start over because we've already expanded envvars
1840 and replaced $$ with $. Maybe we should start over as well, but we'd
1841 need to quote some $ to $$ first. */
1845 if (!NILP (Vw32_downcase_file_names
))
1847 Lisp_Object xname
= make_specified_string (xnm
, -1, x
- xnm
, multibyte
);
1849 xname
= Fdowncase (xname
);
1854 return (xnm
== SSDATA (filename
)
1856 : make_specified_string (xnm
, -1, x
- xnm
, multibyte
));
1859 /* A slightly faster and more convenient way to get
1860 (directory-file-name (expand-file-name FOO)). */
1863 expand_and_dir_to_file (Lisp_Object filename
, Lisp_Object defdir
)
1865 register Lisp_Object absname
;
1867 absname
= Fexpand_file_name (filename
, defdir
);
1869 /* Remove final slash, if any (unless this is the root dir).
1870 stat behaves differently depending! */
1871 if (SCHARS (absname
) > 1
1872 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
1873 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
) - 2)))
1874 /* We cannot take shortcuts; they might be wrong for magic file names. */
1875 absname
= Fdirectory_file_name (absname
);
1879 /* Signal an error if the file ABSNAME already exists.
1880 If KNOWN_TO_EXIST, the file is known to exist.
1881 QUERYSTRING is a name for the action that is being considered
1883 If INTERACTIVE, ask the user whether to proceed,
1884 and bypass the error if the user says to go ahead.
1885 If QUICK, ask for y or n, not yes or no. */
1888 barf_or_query_if_file_exists (Lisp_Object absname
, bool known_to_exist
,
1889 const char *querystring
, bool interactive
,
1892 Lisp_Object tem
, encoded_filename
;
1893 struct stat statbuf
;
1894 struct gcpro gcpro1
;
1896 encoded_filename
= ENCODE_FILE (absname
);
1898 if (! known_to_exist
&& lstat (SSDATA (encoded_filename
), &statbuf
) == 0)
1900 if (S_ISDIR (statbuf
.st_mode
))
1901 xsignal2 (Qfile_error
,
1902 build_string ("File is a directory"), absname
);
1903 known_to_exist
= true;
1909 xsignal2 (Qfile_already_exists
,
1910 build_string ("File already exists"), absname
);
1912 tem
= format2 ("File %s already exists; %s anyway? ",
1913 absname
, build_string (querystring
));
1915 tem
= call1 (intern ("y-or-n-p"), tem
);
1917 tem
= do_yes_or_no_p (tem
);
1920 xsignal2 (Qfile_already_exists
,
1921 build_string ("File already exists"), absname
);
1925 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
1926 "fCopy file: \nGCopy %s to file: \np\nP",
1927 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
1928 If NEWNAME names a directory, copy FILE there.
1930 This function always sets the file modes of the output file to match
1933 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1934 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1935 signal a `file-already-exists' error without overwriting. If
1936 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1937 about overwriting; this is what happens in interactive use with M-x.
1938 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1941 Fourth arg KEEP-TIME non-nil means give the output file the same
1942 last-modified time as the old one. (This works on only some systems.)
1944 A prefix arg makes KEEP-TIME non-nil.
1946 If PRESERVE-UID-GID is non-nil, we try to transfer the
1947 uid and gid of FILE to NEWNAME.
1949 If PRESERVE-PERMISSIONS is non-nil, copy permissions of FILE to NEWNAME;
1950 this includes the file modes, along with ACL entries and SELinux
1951 context if present. Otherwise, if NEWNAME is created its file
1952 permission bits are those of FILE, masked by the default file
1954 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
,
1955 Lisp_Object keep_time
, Lisp_Object preserve_uid_gid
,
1956 Lisp_Object preserve_permissions
)
1958 Lisp_Object handler
;
1959 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1960 ptrdiff_t count
= SPECPDL_INDEX ();
1961 Lisp_Object encoded_file
, encoded_newname
;
1963 security_context_t con
;
1969 bool already_exists
= false;
1973 char buf
[16 * 1024];
1977 encoded_file
= encoded_newname
= Qnil
;
1978 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
1979 CHECK_STRING (file
);
1980 CHECK_STRING (newname
);
1982 if (!NILP (Ffile_directory_p (newname
)))
1983 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
1985 newname
= Fexpand_file_name (newname
, Qnil
);
1987 file
= Fexpand_file_name (file
, Qnil
);
1989 /* If the input file name has special constructs in it,
1990 call the corresponding file handler. */
1991 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1992 /* Likewise for output file name. */
1994 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1995 if (!NILP (handler
))
1996 RETURN_UNGCPRO (call7 (handler
, Qcopy_file
, file
, newname
,
1997 ok_if_already_exists
, keep_time
, preserve_uid_gid
,
1998 preserve_permissions
));
2000 encoded_file
= ENCODE_FILE (file
);
2001 encoded_newname
= ENCODE_FILE (newname
);
2004 if (NILP (ok_if_already_exists
)
2005 || INTEGERP (ok_if_already_exists
))
2006 barf_or_query_if_file_exists (newname
, false, "copy to it",
2007 INTEGERP (ok_if_already_exists
), false);
2009 result
= w32_copy_file (SSDATA (encoded_file
), SSDATA (encoded_newname
),
2010 !NILP (keep_time
), !NILP (preserve_uid_gid
),
2011 !NILP (preserve_permissions
));
2015 report_file_error ("Copying file", list2 (file
, newname
));
2017 report_file_error ("Copying permissions from", file
);
2019 xsignal2 (Qfile_date_error
,
2020 build_string ("Resetting file times"), newname
);
2022 report_file_error ("Copying permissions to", newname
);
2024 #else /* not WINDOWSNT */
2026 ifd
= emacs_open (SSDATA (encoded_file
), O_RDONLY
, 0);
2030 report_file_error ("Opening input file", file
);
2032 record_unwind_protect_int (close_file_unwind
, ifd
);
2034 if (fstat (ifd
, &st
) != 0)
2035 report_file_error ("Input file status", file
);
2037 if (!NILP (preserve_permissions
))
2040 if (is_selinux_enabled ())
2042 conlength
= fgetfilecon (ifd
, &con
);
2043 if (conlength
== -1)
2044 report_file_error ("Doing fgetfilecon", file
);
2049 /* We can copy only regular files. */
2050 if (!S_ISREG (st
.st_mode
))
2051 report_file_errno ("Non-regular file", file
,
2052 S_ISDIR (st
.st_mode
) ? EISDIR
: EINVAL
);
2055 new_mask
= st
.st_mode
& (!NILP (preserve_uid_gid
) ? 0700 : 0777);
2057 new_mask
= S_IREAD
| S_IWRITE
;
2060 ofd
= emacs_open (SSDATA (encoded_newname
), O_WRONLY
| O_CREAT
| O_EXCL
,
2062 if (ofd
< 0 && errno
== EEXIST
)
2064 if (NILP (ok_if_already_exists
) || INTEGERP (ok_if_already_exists
))
2065 barf_or_query_if_file_exists (newname
, true, "copy to it",
2066 INTEGERP (ok_if_already_exists
), false);
2067 already_exists
= true;
2068 ofd
= emacs_open (SSDATA (encoded_newname
), O_WRONLY
, 0);
2071 report_file_error ("Opening output file", newname
);
2073 record_unwind_protect_int (close_file_unwind
, ofd
);
2078 if (fstat (ofd
, &out_st
) != 0)
2079 report_file_error ("Output file status", newname
);
2080 if (st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2081 report_file_errno ("Input and output files are the same",
2082 list2 (file
, newname
), 0);
2083 if (ftruncate (ofd
, 0) != 0)
2084 report_file_error ("Truncating output file", newname
);
2089 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2090 if (emacs_write_sig (ofd
, buf
, n
) != n
)
2091 report_file_error ("Write error", newname
);
2095 /* Preserve the original file permissions, and if requested, also its
2098 mode_t preserved_permissions
= st
.st_mode
& 07777;
2099 mode_t default_permissions
= st
.st_mode
& 0777 & ~realmask
;
2100 if (!NILP (preserve_uid_gid
))
2102 /* Attempt to change owner and group. If that doesn't work
2103 attempt to change just the group, as that is sometimes allowed.
2104 Adjust the mode mask to eliminate setuid or setgid bits
2105 or group permissions bits that are inappropriate if the
2106 owner or group are wrong. */
2107 if (fchown (ofd
, st
.st_uid
, st
.st_gid
) != 0)
2109 if (fchown (ofd
, -1, st
.st_gid
) == 0)
2110 preserved_permissions
&= ~04000;
2113 preserved_permissions
&= ~06000;
2115 /* Copy the other bits to the group bits, since the
2117 preserved_permissions
&= ~070;
2118 preserved_permissions
|= (preserved_permissions
& 7) << 3;
2119 default_permissions
&= ~070;
2120 default_permissions
|= (default_permissions
& 7) << 3;
2125 switch (!NILP (preserve_permissions
)
2126 ? qcopy_acl (SSDATA (encoded_file
), ifd
,
2127 SSDATA (encoded_newname
), ofd
,
2128 preserved_permissions
)
2130 || (new_mask
& ~realmask
) == default_permissions
)
2132 : fchmod (ofd
, default_permissions
))
2134 case -2: report_file_error ("Copying permissions from", file
);
2135 case -1: report_file_error ("Copying permissions to", newname
);
2138 #endif /* not MSDOS */
2143 /* Set the modified context back to the file. */
2144 bool fail
= fsetfilecon (ofd
, con
) != 0;
2145 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2146 if (fail
&& errno
!= ENOTSUP
)
2147 report_file_error ("Doing fsetfilecon", newname
);
2153 if (!NILP (keep_time
))
2155 struct timespec atime
= get_stat_atime (&st
);
2156 struct timespec mtime
= get_stat_mtime (&st
);
2157 if (set_file_times (ofd
, SSDATA (encoded_newname
), atime
, mtime
) != 0)
2158 xsignal2 (Qfile_date_error
,
2159 build_string ("Cannot set file date"), newname
);
2162 if (emacs_close (ofd
) < 0)
2163 report_file_error ("Write error", newname
);
2168 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2169 and if it can't, it tells so. Otherwise, under MSDOS we usually
2170 get only the READ bit, which will make the copied file read-only,
2171 so it's better not to chmod at all. */
2172 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2173 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2175 #endif /* not WINDOWSNT */
2177 /* Discard the unwind protects. */
2178 specpdl_ptr
= specpdl
+ count
;
2184 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2185 Smake_directory_internal
, 1, 1, 0,
2186 doc
: /* Create a new directory named DIRECTORY. */)
2187 (Lisp_Object directory
)
2190 Lisp_Object handler
;
2191 Lisp_Object encoded_dir
;
2193 CHECK_STRING (directory
);
2194 directory
= Fexpand_file_name (directory
, Qnil
);
2196 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2197 if (!NILP (handler
))
2198 return call2 (handler
, Qmake_directory_internal
, directory
);
2200 encoded_dir
= ENCODE_FILE (directory
);
2202 dir
= SSDATA (encoded_dir
);
2205 if (mkdir (dir
) != 0)
2207 if (mkdir (dir
, 0777 & ~auto_saving_dir_umask
) != 0)
2209 report_file_error ("Creating directory", directory
);
2214 DEFUN ("delete-directory-internal", Fdelete_directory_internal
,
2215 Sdelete_directory_internal
, 1, 1, 0,
2216 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2217 (Lisp_Object directory
)
2220 Lisp_Object encoded_dir
;
2222 CHECK_STRING (directory
);
2223 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2224 encoded_dir
= ENCODE_FILE (directory
);
2225 dir
= SSDATA (encoded_dir
);
2227 if (rmdir (dir
) != 0)
2228 report_file_error ("Removing directory", directory
);
2233 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 2,
2234 "(list (read-file-name \
2235 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2236 \"Move file to trash: \" \"Delete file: \") \
2237 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2238 (null current-prefix-arg))",
2239 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2240 If file has multiple names, it continues to exist with the other names.
2241 TRASH non-nil means to trash the file instead of deleting, provided
2242 `delete-by-moving-to-trash' is non-nil.
2244 When called interactively, TRASH is t if no prefix argument is given.
2245 With a prefix argument, TRASH is nil. */)
2246 (Lisp_Object filename
, Lisp_Object trash
)
2248 Lisp_Object handler
;
2249 Lisp_Object encoded_file
;
2250 struct gcpro gcpro1
;
2253 if (!NILP (Ffile_directory_p (filename
))
2254 && NILP (Ffile_symlink_p (filename
)))
2255 xsignal2 (Qfile_error
,
2256 build_string ("Removing old name: is a directory"),
2259 filename
= Fexpand_file_name (filename
, Qnil
);
2261 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2262 if (!NILP (handler
))
2263 return call3 (handler
, Qdelete_file
, filename
, trash
);
2265 if (delete_by_moving_to_trash
&& !NILP (trash
))
2266 return call1 (Qmove_file_to_trash
, filename
);
2268 encoded_file
= ENCODE_FILE (filename
);
2270 if (unlink (SSDATA (encoded_file
)) < 0)
2271 report_file_error ("Removing old name", filename
);
2276 internal_delete_file_1 (Lisp_Object ignore
)
2281 /* Delete file FILENAME, returning true if successful.
2282 This ignores `delete-by-moving-to-trash'. */
2285 internal_delete_file (Lisp_Object filename
)
2289 tem
= internal_condition_case_2 (Fdelete_file
, filename
, Qnil
,
2290 Qt
, internal_delete_file_1
);
2294 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2295 "fRename file: \nGRename %s to file: \np",
2296 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2297 If file has names other than FILE, it continues to have those names.
2298 Signals a `file-already-exists' error if a file NEWNAME already exists
2299 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2300 A number as third arg means request confirmation if NEWNAME already exists.
2301 This is what happens in interactive use with M-x. */)
2302 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2304 Lisp_Object handler
;
2305 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2306 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2308 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2309 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2310 CHECK_STRING (file
);
2311 CHECK_STRING (newname
);
2312 file
= Fexpand_file_name (file
, Qnil
);
2314 if ((!NILP (Ffile_directory_p (newname
)))
2316 /* If the file names are identical but for the case,
2317 don't attempt to move directory to itself. */
2318 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2322 Lisp_Object fname
= (NILP (Ffile_directory_p (file
))
2323 ? file
: Fdirectory_file_name (file
));
2324 newname
= Fexpand_file_name (Ffile_name_nondirectory (fname
), newname
);
2327 newname
= Fexpand_file_name (newname
, Qnil
);
2329 /* If the file name has special constructs in it,
2330 call the corresponding file handler. */
2331 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2333 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2334 if (!NILP (handler
))
2335 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2336 file
, newname
, ok_if_already_exists
));
2338 encoded_file
= ENCODE_FILE (file
);
2339 encoded_newname
= ENCODE_FILE (newname
);
2342 /* If the file names are identical but for the case, don't ask for
2343 confirmation: they simply want to change the letter-case of the
2345 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2347 if (NILP (ok_if_already_exists
)
2348 || INTEGERP (ok_if_already_exists
))
2349 barf_or_query_if_file_exists (newname
, false, "rename to it",
2350 INTEGERP (ok_if_already_exists
), false);
2351 if (rename (SSDATA (encoded_file
), SSDATA (encoded_newname
)) < 0)
2353 int rename_errno
= errno
;
2354 if (rename_errno
== EXDEV
)
2357 symlink_target
= Ffile_symlink_p (file
);
2358 if (! NILP (symlink_target
))
2359 Fmake_symbolic_link (symlink_target
, newname
,
2360 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2361 else if (!NILP (Ffile_directory_p (file
)))
2362 call4 (Qcopy_directory
, file
, newname
, Qt
, Qnil
);
2364 /* We have already prompted if it was an integer, so don't
2365 have copy-file prompt again. */
2366 Fcopy_file (file
, newname
,
2367 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2370 count
= SPECPDL_INDEX ();
2371 specbind (Qdelete_by_moving_to_trash
, Qnil
);
2373 if (!NILP (Ffile_directory_p (file
)) && NILP (symlink_target
))
2374 call2 (Qdelete_directory
, file
, Qt
);
2376 Fdelete_file (file
, Qnil
);
2377 unbind_to (count
, Qnil
);
2380 report_file_errno ("Renaming", list2 (file
, newname
), rename_errno
);
2386 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2387 "fAdd name to file: \nGName to add to %s: \np",
2388 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2389 Signals a `file-already-exists' error if a file NEWNAME already exists
2390 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2391 A number as third arg means request confirmation if NEWNAME already exists.
2392 This is what happens in interactive use with M-x. */)
2393 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2395 Lisp_Object handler
;
2396 Lisp_Object encoded_file
, encoded_newname
;
2397 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2399 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2400 encoded_file
= encoded_newname
= Qnil
;
2401 CHECK_STRING (file
);
2402 CHECK_STRING (newname
);
2403 file
= Fexpand_file_name (file
, Qnil
);
2405 if (!NILP (Ffile_directory_p (newname
)))
2406 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2408 newname
= Fexpand_file_name (newname
, Qnil
);
2410 /* If the file name has special constructs in it,
2411 call the corresponding file handler. */
2412 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2413 if (!NILP (handler
))
2414 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2415 newname
, ok_if_already_exists
));
2417 /* If the new name has special constructs in it,
2418 call the corresponding file handler. */
2419 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2420 if (!NILP (handler
))
2421 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2422 newname
, ok_if_already_exists
));
2424 encoded_file
= ENCODE_FILE (file
);
2425 encoded_newname
= ENCODE_FILE (newname
);
2427 if (NILP (ok_if_already_exists
)
2428 || INTEGERP (ok_if_already_exists
))
2429 barf_or_query_if_file_exists (newname
, false, "make it a new name",
2430 INTEGERP (ok_if_already_exists
), false);
2432 unlink (SSDATA (newname
));
2433 if (link (SSDATA (encoded_file
), SSDATA (encoded_newname
)) < 0)
2435 int link_errno
= errno
;
2436 report_file_errno ("Adding new name", list2 (file
, newname
), link_errno
);
2443 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2444 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2445 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2446 Both args must be strings.
2447 Signals a `file-already-exists' error if a file LINKNAME already exists
2448 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2449 A number as third arg means request confirmation if LINKNAME already exists.
2450 This happens for interactive use with M-x. */)
2451 (Lisp_Object filename
, Lisp_Object linkname
, Lisp_Object ok_if_already_exists
)
2453 Lisp_Object handler
;
2454 Lisp_Object encoded_filename
, encoded_linkname
;
2455 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2457 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2458 encoded_filename
= encoded_linkname
= Qnil
;
2459 CHECK_STRING (filename
);
2460 CHECK_STRING (linkname
);
2461 /* If the link target has a ~, we must expand it to get
2462 a truly valid file name. Otherwise, do not expand;
2463 we want to permit links to relative file names. */
2464 if (SREF (filename
, 0) == '~')
2465 filename
= Fexpand_file_name (filename
, Qnil
);
2467 if (!NILP (Ffile_directory_p (linkname
)))
2468 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2470 linkname
= Fexpand_file_name (linkname
, Qnil
);
2472 /* If the file name has special constructs in it,
2473 call the corresponding file handler. */
2474 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2475 if (!NILP (handler
))
2476 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2477 linkname
, ok_if_already_exists
));
2479 /* If the new link name has special constructs in it,
2480 call the corresponding file handler. */
2481 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2482 if (!NILP (handler
))
2483 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2484 linkname
, ok_if_already_exists
));
2486 encoded_filename
= ENCODE_FILE (filename
);
2487 encoded_linkname
= ENCODE_FILE (linkname
);
2489 if (NILP (ok_if_already_exists
)
2490 || INTEGERP (ok_if_already_exists
))
2491 barf_or_query_if_file_exists (linkname
, false, "make it a link",
2492 INTEGERP (ok_if_already_exists
), false);
2493 if (symlink (SSDATA (encoded_filename
), SSDATA (encoded_linkname
)) < 0)
2495 /* If we didn't complain already, silently delete existing file. */
2497 if (errno
== EEXIST
)
2499 unlink (SSDATA (encoded_linkname
));
2500 if (symlink (SSDATA (encoded_filename
), SSDATA (encoded_linkname
))
2507 if (errno
== ENOSYS
)
2510 xsignal1 (Qfile_error
,
2511 build_string ("Symbolic links are not supported"));
2514 symlink_errno
= errno
;
2515 report_file_errno ("Making symbolic link", list2 (filename
, linkname
),
2523 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2525 doc
: /* Return t if file FILENAME specifies an absolute file name.
2526 On Unix, this is a name starting with a `/' or a `~'. */)
2527 (Lisp_Object filename
)
2529 CHECK_STRING (filename
);
2530 return file_name_absolute_p (SSDATA (filename
)) ? Qt
: Qnil
;
2533 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2534 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
2535 See also `file-readable-p' and `file-attributes'.
2536 This returns nil for a symlink to a nonexistent file.
2537 Use `file-symlink-p' to test for such links. */)
2538 (Lisp_Object filename
)
2540 Lisp_Object absname
;
2541 Lisp_Object handler
;
2543 CHECK_STRING (filename
);
2544 absname
= Fexpand_file_name (filename
, Qnil
);
2546 /* If the file name has special constructs in it,
2547 call the corresponding file handler. */
2548 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2549 if (!NILP (handler
))
2551 Lisp_Object result
= call2 (handler
, Qfile_exists_p
, absname
);
2556 absname
= ENCODE_FILE (absname
);
2558 return check_existing (SSDATA (absname
)) ? Qt
: Qnil
;
2561 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2562 doc
: /* Return t if FILENAME can be executed by you.
2563 For a directory, this means you can access files in that directory.
2564 \(It is generally better to use `file-accessible-directory-p' for that
2565 purpose, though.) */)
2566 (Lisp_Object filename
)
2568 Lisp_Object absname
;
2569 Lisp_Object handler
;
2571 CHECK_STRING (filename
);
2572 absname
= Fexpand_file_name (filename
, Qnil
);
2574 /* If the file name has special constructs in it,
2575 call the corresponding file handler. */
2576 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2577 if (!NILP (handler
))
2578 return call2 (handler
, Qfile_executable_p
, absname
);
2580 absname
= ENCODE_FILE (absname
);
2582 return (check_executable (SSDATA (absname
)) ? Qt
: Qnil
);
2585 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2586 doc
: /* Return t if file FILENAME exists and you can read it.
2587 See also `file-exists-p' and `file-attributes'. */)
2588 (Lisp_Object filename
)
2590 Lisp_Object absname
;
2591 Lisp_Object handler
;
2593 CHECK_STRING (filename
);
2594 absname
= Fexpand_file_name (filename
, Qnil
);
2596 /* If the file name has special constructs in it,
2597 call the corresponding file handler. */
2598 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2599 if (!NILP (handler
))
2600 return call2 (handler
, Qfile_readable_p
, absname
);
2602 absname
= ENCODE_FILE (absname
);
2603 return (faccessat (AT_FDCWD
, SSDATA (absname
), R_OK
, AT_EACCESS
) == 0
2607 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2608 doc
: /* Return t if file FILENAME can be written or created by you. */)
2609 (Lisp_Object filename
)
2611 Lisp_Object absname
, dir
, encoded
;
2612 Lisp_Object handler
;
2614 CHECK_STRING (filename
);
2615 absname
= Fexpand_file_name (filename
, Qnil
);
2617 /* If the file name has special constructs in it,
2618 call the corresponding file handler. */
2619 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2620 if (!NILP (handler
))
2621 return call2 (handler
, Qfile_writable_p
, absname
);
2623 encoded
= ENCODE_FILE (absname
);
2624 if (check_writable (SSDATA (encoded
), W_OK
))
2626 if (errno
!= ENOENT
)
2629 dir
= Ffile_name_directory (absname
);
2630 eassert (!NILP (dir
));
2632 dir
= Fdirectory_file_name (dir
);
2635 dir
= ENCODE_FILE (dir
);
2637 /* The read-only attribute of the parent directory doesn't affect
2638 whether a file or directory can be created within it. Some day we
2639 should check ACLs though, which do affect this. */
2640 return file_directory_p (SDATA (dir
)) ? Qt
: Qnil
;
2642 return check_writable (SSDATA (dir
), W_OK
| X_OK
) ? Qt
: Qnil
;
2646 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2647 doc
: /* Access file FILENAME, and get an error if that does not work.
2648 The second argument STRING is used in the error message.
2649 If there is no error, returns nil. */)
2650 (Lisp_Object filename
, Lisp_Object string
)
2652 Lisp_Object handler
, encoded_filename
, absname
;
2654 CHECK_STRING (filename
);
2655 absname
= Fexpand_file_name (filename
, Qnil
);
2657 CHECK_STRING (string
);
2659 /* If the file name has special constructs in it,
2660 call the corresponding file handler. */
2661 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
2662 if (!NILP (handler
))
2663 return call3 (handler
, Qaccess_file
, absname
, string
);
2665 encoded_filename
= ENCODE_FILE (absname
);
2667 if (faccessat (AT_FDCWD
, SSDATA (encoded_filename
), R_OK
, AT_EACCESS
) != 0)
2668 report_file_error (SSDATA (string
), filename
);
2673 /* Relative to directory FD, return the symbolic link value of FILENAME.
2674 On failure, return nil. */
2676 emacs_readlinkat (int fd
, char const *filename
)
2678 static struct allocator
const emacs_norealloc_allocator
=
2679 { xmalloc
, NULL
, xfree
, memory_full
};
2681 char readlink_buf
[1024];
2682 char *buf
= careadlinkat (fd
, filename
, readlink_buf
, sizeof readlink_buf
,
2683 &emacs_norealloc_allocator
, readlinkat
);
2687 val
= build_unibyte_string (buf
);
2688 if (buf
[0] == '/' && strchr (buf
, ':'))
2689 val
= concat2 (build_unibyte_string ("/:"), val
);
2690 if (buf
!= readlink_buf
)
2692 val
= DECODE_FILE (val
);
2696 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2697 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
2698 The value is the link target, as a string.
2699 Otherwise it returns nil.
2701 This function does not check whether the link target exists. */)
2702 (Lisp_Object filename
)
2704 Lisp_Object handler
;
2706 CHECK_STRING (filename
);
2707 filename
= Fexpand_file_name (filename
, Qnil
);
2709 /* If the file name has special constructs in it,
2710 call the corresponding file handler. */
2711 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2712 if (!NILP (handler
))
2713 return call2 (handler
, Qfile_symlink_p
, filename
);
2715 filename
= ENCODE_FILE (filename
);
2717 return emacs_readlinkat (AT_FDCWD
, SSDATA (filename
));
2720 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2721 doc
: /* Return t if FILENAME names an existing directory.
2722 Symbolic links to directories count as directories.
2723 See `file-symlink-p' to distinguish symlinks. */)
2724 (Lisp_Object filename
)
2726 Lisp_Object absname
;
2727 Lisp_Object handler
;
2729 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2731 /* If the file name has special constructs in it,
2732 call the corresponding file handler. */
2733 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2734 if (!NILP (handler
))
2735 return call2 (handler
, Qfile_directory_p
, absname
);
2737 absname
= ENCODE_FILE (absname
);
2739 return file_directory_p (SSDATA (absname
)) ? Qt
: Qnil
;
2742 /* Return true if FILE is a directory or a symlink to a directory. */
2744 file_directory_p (char const *file
)
2747 /* This is cheaper than 'stat'. */
2748 return faccessat (AT_FDCWD
, file
, D_OK
, AT_EACCESS
) == 0;
2751 return stat (file
, &st
) == 0 && S_ISDIR (st
.st_mode
);
2755 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
,
2756 Sfile_accessible_directory_p
, 1, 1, 0,
2757 doc
: /* Return t if file FILENAME names a directory you can open.
2758 For the value to be t, FILENAME must specify the name of a directory as a file,
2759 and the directory must allow you to open files in it. In order to use a
2760 directory as a buffer's current directory, this predicate must return true.
2761 A directory name spec may be given instead; then the value is t
2762 if the directory so specified exists and really is a readable and
2763 searchable directory. */)
2764 (Lisp_Object filename
)
2766 Lisp_Object absname
;
2767 Lisp_Object handler
;
2769 CHECK_STRING (filename
);
2770 absname
= Fexpand_file_name (filename
, Qnil
);
2772 /* If the file name has special constructs in it,
2773 call the corresponding file handler. */
2774 handler
= Ffind_file_name_handler (absname
, Qfile_accessible_directory_p
);
2775 if (!NILP (handler
))
2777 Lisp_Object r
= call2 (handler
, Qfile_accessible_directory_p
, absname
);
2782 absname
= ENCODE_FILE (absname
);
2783 return file_accessible_directory_p (absname
) ? Qt
: Qnil
;
2786 /* If FILE is a searchable directory or a symlink to a
2787 searchable directory, return true. Otherwise return
2788 false and set errno to an error number. */
2790 file_accessible_directory_p (Lisp_Object file
)
2793 /* There's no need to test whether FILE is searchable, as the
2794 searchable/executable bit is invented on DOS_NT platforms. */
2795 return file_directory_p (SSDATA (file
));
2797 /* On POSIXish platforms, use just one system call; this avoids a
2798 race and is typically faster. */
2799 const char *data
= SSDATA (file
);
2800 ptrdiff_t len
= SBYTES (file
);
2806 /* Normally a file "FOO" is an accessible directory if "FOO/." exists.
2807 There are three exceptions: "", "/", and "//". Leave "" alone,
2808 as it's invalid. Append only "." to the other two exceptions as
2809 "/" and "//" are distinct on some platforms, whereas "/", "///",
2810 "////", etc. are all equivalent. */
2815 /* Just check for trailing '/' when deciding whether to append '/'.
2816 That's simpler than testing the two special cases "/" and "//",
2817 and it's a safe optimization here. */
2818 char *buf
= SAFE_ALLOCA (len
+ 3);
2819 memcpy (buf
, data
, len
);
2820 strcpy (buf
+ len
, &"/."[data
[len
- 1] == '/']);
2824 ok
= check_existing (dir
);
2825 saved_errno
= errno
;
2827 errno
= saved_errno
;
2832 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2833 doc
: /* Return t if FILENAME names a regular file.
2834 This is the sort of file that holds an ordinary stream of data bytes.
2835 Symbolic links to regular files count as regular files.
2836 See `file-symlink-p' to distinguish symlinks. */)
2837 (Lisp_Object filename
)
2839 register Lisp_Object absname
;
2841 Lisp_Object handler
;
2843 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2845 /* If the file name has special constructs in it,
2846 call the corresponding file handler. */
2847 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2848 if (!NILP (handler
))
2849 return call2 (handler
, Qfile_regular_p
, absname
);
2851 absname
= ENCODE_FILE (absname
);
2856 Lisp_Object tem
= Vw32_get_true_file_attributes
;
2858 /* Tell stat to use expensive method to get accurate info. */
2859 Vw32_get_true_file_attributes
= Qt
;
2860 result
= stat (SDATA (absname
), &st
);
2861 Vw32_get_true_file_attributes
= tem
;
2865 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2868 if (stat (SSDATA (absname
), &st
) < 0)
2870 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2874 DEFUN ("file-selinux-context", Ffile_selinux_context
,
2875 Sfile_selinux_context
, 1, 1, 0,
2876 doc
: /* Return SELinux context of file named FILENAME.
2877 The return value is a list (USER ROLE TYPE RANGE), where the list
2878 elements are strings naming the user, role, type, and range of the
2879 file's SELinux security context.
2881 Return (nil nil nil nil) if the file is nonexistent or inaccessible,
2882 or if SELinux is disabled, or if Emacs lacks SELinux support. */)
2883 (Lisp_Object filename
)
2885 Lisp_Object absname
;
2886 Lisp_Object values
[4];
2887 Lisp_Object handler
;
2889 security_context_t con
;
2894 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2896 /* If the file name has special constructs in it,
2897 call the corresponding file handler. */
2898 handler
= Ffind_file_name_handler (absname
, Qfile_selinux_context
);
2899 if (!NILP (handler
))
2900 return call2 (handler
, Qfile_selinux_context
, absname
);
2902 absname
= ENCODE_FILE (absname
);
2909 if (is_selinux_enabled ())
2911 conlength
= lgetfilecon (SSDATA (absname
), &con
);
2914 context
= context_new (con
);
2915 if (context_user_get (context
))
2916 values
[0] = build_string (context_user_get (context
));
2917 if (context_role_get (context
))
2918 values
[1] = build_string (context_role_get (context
));
2919 if (context_type_get (context
))
2920 values
[2] = build_string (context_type_get (context
));
2921 if (context_range_get (context
))
2922 values
[3] = build_string (context_range_get (context
));
2923 context_free (context
);
2929 return Flist (ARRAYELTS (values
), values
);
2932 DEFUN ("set-file-selinux-context", Fset_file_selinux_context
,
2933 Sset_file_selinux_context
, 2, 2, 0,
2934 doc
: /* Set SELinux context of file named FILENAME to CONTEXT.
2935 CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
2936 elements are strings naming the components of a SELinux context.
2938 Value is t if setting of SELinux context was successful, nil otherwise.
2940 This function does nothing and returns nil if SELinux is disabled,
2941 or if Emacs was not compiled with SELinux support. */)
2942 (Lisp_Object filename
, Lisp_Object context
)
2944 Lisp_Object absname
;
2945 Lisp_Object handler
;
2947 Lisp_Object encoded_absname
;
2948 Lisp_Object user
= CAR_SAFE (context
);
2949 Lisp_Object role
= CAR_SAFE (CDR_SAFE (context
));
2950 Lisp_Object type
= CAR_SAFE (CDR_SAFE (CDR_SAFE (context
)));
2951 Lisp_Object range
= CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context
))));
2952 security_context_t con
;
2955 context_t parsed_con
;
2958 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
2960 /* If the file name has special constructs in it,
2961 call the corresponding file handler. */
2962 handler
= Ffind_file_name_handler (absname
, Qset_file_selinux_context
);
2963 if (!NILP (handler
))
2964 return call3 (handler
, Qset_file_selinux_context
, absname
, context
);
2967 if (is_selinux_enabled ())
2969 /* Get current file context. */
2970 encoded_absname
= ENCODE_FILE (absname
);
2971 conlength
= lgetfilecon (SSDATA (encoded_absname
), &con
);
2974 parsed_con
= context_new (con
);
2975 /* Change the parts defined in the parameter.*/
2978 if (context_user_set (parsed_con
, SSDATA (user
)))
2979 error ("Doing context_user_set");
2983 if (context_role_set (parsed_con
, SSDATA (role
)))
2984 error ("Doing context_role_set");
2988 if (context_type_set (parsed_con
, SSDATA (type
)))
2989 error ("Doing context_type_set");
2991 if (STRINGP (range
))
2993 if (context_range_set (parsed_con
, SSDATA (range
)))
2994 error ("Doing context_range_set");
2997 /* Set the modified context back to the file. */
2998 fail
= (lsetfilecon (SSDATA (encoded_absname
),
2999 context_str (parsed_con
))
3001 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
3002 if (fail
&& errno
!= ENOTSUP
)
3003 report_file_error ("Doing lsetfilecon", absname
);
3005 context_free (parsed_con
);
3007 return fail
? Qnil
: Qt
;
3010 report_file_error ("Doing lgetfilecon", absname
);
3017 DEFUN ("file-acl", Ffile_acl
, Sfile_acl
, 1, 1, 0,
3018 doc
: /* Return ACL entries of file named FILENAME.
3019 The entries are returned in a format suitable for use in `set-file-acl'
3020 but is otherwise undocumented and subject to change.
3021 Return nil if file does not exist or is not accessible, or if Emacs
3022 was unable to determine the ACL entries. */)
3023 (Lisp_Object filename
)
3025 Lisp_Object absname
;
3026 Lisp_Object handler
;
3027 #ifdef HAVE_ACL_SET_FILE
3029 Lisp_Object acl_string
;
3031 # ifndef HAVE_ACL_TYPE_EXTENDED
3032 acl_type_t ACL_TYPE_EXTENDED
= ACL_TYPE_ACCESS
;
3036 absname
= expand_and_dir_to_file (filename
,
3037 BVAR (current_buffer
, directory
));
3039 /* If the file name has special constructs in it,
3040 call the corresponding file handler. */
3041 handler
= Ffind_file_name_handler (absname
, Qfile_acl
);
3042 if (!NILP (handler
))
3043 return call2 (handler
, Qfile_acl
, absname
);
3045 #ifdef HAVE_ACL_SET_FILE
3046 absname
= ENCODE_FILE (absname
);
3048 acl
= acl_get_file (SSDATA (absname
), ACL_TYPE_EXTENDED
);
3052 str
= acl_to_text (acl
, NULL
);
3059 acl_string
= build_string (str
);
3069 DEFUN ("set-file-acl", Fset_file_acl
, Sset_file_acl
,
3071 doc
: /* Set ACL of file named FILENAME to ACL-STRING.
3072 ACL-STRING should contain the textual representation of the ACL
3073 entries in a format suitable for the platform.
3075 Value is t if setting of ACL was successful, nil otherwise.
3077 Setting ACL for local files requires Emacs to be built with ACL
3079 (Lisp_Object filename
, Lisp_Object acl_string
)
3081 Lisp_Object absname
;
3082 Lisp_Object handler
;
3083 #ifdef HAVE_ACL_SET_FILE
3084 Lisp_Object encoded_absname
;
3089 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3091 /* If the file name has special constructs in it,
3092 call the corresponding file handler. */
3093 handler
= Ffind_file_name_handler (absname
, Qset_file_acl
);
3094 if (!NILP (handler
))
3095 return call3 (handler
, Qset_file_acl
, absname
, acl_string
);
3097 #ifdef HAVE_ACL_SET_FILE
3098 if (STRINGP (acl_string
))
3100 acl
= acl_from_text (SSDATA (acl_string
));
3103 report_file_error ("Converting ACL", absname
);
3107 encoded_absname
= ENCODE_FILE (absname
);
3109 fail
= (acl_set_file (SSDATA (encoded_absname
), ACL_TYPE_ACCESS
,
3112 if (fail
&& acl_errno_valid (errno
))
3113 report_file_error ("Setting ACL", absname
);
3116 return fail
? Qnil
: Qt
;
3123 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3124 doc
: /* Return mode bits of file named FILENAME, as an integer.
3125 Return nil, if file does not exist or is not accessible. */)
3126 (Lisp_Object filename
)
3128 Lisp_Object absname
;
3130 Lisp_Object handler
;
3132 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
3134 /* If the file name has special constructs in it,
3135 call the corresponding file handler. */
3136 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3137 if (!NILP (handler
))
3138 return call2 (handler
, Qfile_modes
, absname
);
3140 absname
= ENCODE_FILE (absname
);
3142 if (stat (SSDATA (absname
), &st
) < 0)
3145 return make_number (st
.st_mode
& 07777);
3148 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
3149 "(let ((file (read-file-name \"File: \"))) \
3150 (list file (read-file-modes nil file)))",
3151 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3152 Only the 12 low bits of MODE are used.
3154 Interactively, mode bits are read by `read-file-modes', which accepts
3155 symbolic notation, like the `chmod' command from GNU Coreutils. */)
3156 (Lisp_Object filename
, Lisp_Object mode
)
3158 Lisp_Object absname
, encoded_absname
;
3159 Lisp_Object handler
;
3161 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3162 CHECK_NUMBER (mode
);
3164 /* If the file name has special constructs in it,
3165 call the corresponding file handler. */
3166 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3167 if (!NILP (handler
))
3168 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3170 encoded_absname
= ENCODE_FILE (absname
);
3172 if (chmod (SSDATA (encoded_absname
), XINT (mode
) & 07777) < 0)
3173 report_file_error ("Doing chmod", absname
);
3178 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3179 doc
: /* Set the file permission bits for newly created files.
3180 The argument MODE should be an integer; only the low 9 bits are used.
3181 This setting is inherited by subprocesses. */)
3184 mode_t oldrealmask
, oldumask
, newumask
;
3185 CHECK_NUMBER (mode
);
3186 oldrealmask
= realmask
;
3187 newumask
= ~ XINT (mode
) & 0777;
3190 realmask
= newumask
;
3191 oldumask
= umask (newumask
);
3194 eassert (oldumask
== oldrealmask
);
3198 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3199 doc
: /* Return the default file protection for created files.
3200 The value is an integer. */)
3204 XSETINT (value
, (~ realmask
) & 0777);
3209 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3210 doc
: /* Set times of file FILENAME to TIMESTAMP.
3211 Set both access and modification times.
3212 Return t on success, else nil.
3213 Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
3215 (Lisp_Object filename
, Lisp_Object timestamp
)
3217 Lisp_Object absname
, encoded_absname
;
3218 Lisp_Object handler
;
3219 struct timespec t
= lisp_time_argument (timestamp
);
3221 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3223 /* If the file name has special constructs in it,
3224 call the corresponding file handler. */
3225 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3226 if (!NILP (handler
))
3227 return call3 (handler
, Qset_file_times
, absname
, timestamp
);
3229 encoded_absname
= ENCODE_FILE (absname
);
3232 if (set_file_times (-1, SSDATA (encoded_absname
), t
, t
) != 0)
3235 /* Setting times on a directory always fails. */
3236 if (file_directory_p (SSDATA (encoded_absname
)))
3239 report_file_error ("Setting file times", absname
);
3247 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3248 doc
: /* Tell Unix to finish all pending disk updates. */)
3255 #endif /* HAVE_SYNC */
3257 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3258 doc
: /* Return t if file FILE1 is newer than file FILE2.
3259 If FILE1 does not exist, the answer is nil;
3260 otherwise, if FILE2 does not exist, the answer is t. */)
3261 (Lisp_Object file1
, Lisp_Object file2
)
3263 Lisp_Object absname1
, absname2
;
3264 struct stat st1
, st2
;
3265 Lisp_Object handler
;
3266 struct gcpro gcpro1
, gcpro2
;
3268 CHECK_STRING (file1
);
3269 CHECK_STRING (file2
);
3272 GCPRO2 (absname1
, file2
);
3273 absname1
= expand_and_dir_to_file (file1
, BVAR (current_buffer
, directory
));
3274 absname2
= expand_and_dir_to_file (file2
, BVAR (current_buffer
, directory
));
3277 /* If the file name has special constructs in it,
3278 call the corresponding file handler. */
3279 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3281 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3282 if (!NILP (handler
))
3283 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3285 GCPRO2 (absname1
, absname2
);
3286 absname1
= ENCODE_FILE (absname1
);
3287 absname2
= ENCODE_FILE (absname2
);
3290 if (stat (SSDATA (absname1
), &st1
) < 0)
3293 if (stat (SSDATA (absname2
), &st2
) < 0)
3296 return (timespec_cmp (get_stat_mtime (&st2
), get_stat_mtime (&st1
)) < 0
3300 #ifndef READ_BUF_SIZE
3301 #define READ_BUF_SIZE (64 << 10)
3303 /* Some buffer offsets are stored in 'int' variables. */
3304 verify (READ_BUF_SIZE
<= INT_MAX
);
3306 /* This function is called after Lisp functions to decide a coding
3307 system are called, or when they cause an error. Before they are
3308 called, the current buffer is set unibyte and it contains only a
3309 newly inserted text (thus the buffer was empty before the
3312 The functions may set markers, overlays, text properties, or even
3313 alter the buffer contents, change the current buffer.
3315 Here, we reset all those changes by:
3316 o set back the current buffer.
3317 o move all markers and overlays to BEG.
3318 o remove all text properties.
3319 o set back the buffer multibyteness. */
3322 decide_coding_unwind (Lisp_Object unwind_data
)
3324 Lisp_Object multibyte
, undo_list
, buffer
;
3326 multibyte
= XCAR (unwind_data
);
3327 unwind_data
= XCDR (unwind_data
);
3328 undo_list
= XCAR (unwind_data
);
3329 buffer
= XCDR (unwind_data
);
3331 set_buffer_internal (XBUFFER (buffer
));
3332 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3333 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3334 set_buffer_intervals (current_buffer
, NULL
);
3335 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3337 /* Now we are safe to change the buffer's multibyteness directly. */
3338 bset_enable_multibyte_characters (current_buffer
, multibyte
);
3339 bset_undo_list (current_buffer
, undo_list
);
3342 /* Read from a non-regular file. STATE is a Lisp_Save_Value
3343 object where slot 0 is the file descriptor, slot 1 specifies
3344 an offset to put the read bytes, and slot 2 is the maximum
3345 amount of bytes to read. Value is the number of bytes read. */
3348 read_non_regular (Lisp_Object state
)
3354 nbytes
= emacs_read (XSAVE_INTEGER (state
, 0),
3355 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
3356 + XSAVE_INTEGER (state
, 1)),
3357 XSAVE_INTEGER (state
, 2));
3359 /* Fast recycle this object for the likely next call. */
3361 return make_number (nbytes
);
3365 /* Condition-case handler used when reading from non-regular files
3366 in insert-file-contents. */
3369 read_non_regular_quit (Lisp_Object ignore
)
3374 /* Return the file offset that VAL represents, checking for type
3375 errors and overflow. */
3377 file_offset (Lisp_Object val
)
3379 if (RANGED_INTEGERP (0, val
, TYPE_MAXIMUM (off_t
)))
3384 double v
= XFLOAT_DATA (val
);
3386 && (sizeof (off_t
) < sizeof v
3387 ? v
<= TYPE_MAXIMUM (off_t
)
3388 : v
< TYPE_MAXIMUM (off_t
)))
3392 wrong_type_argument (intern ("file-offset"), val
);
3395 /* Return a special time value indicating the error number ERRNUM. */
3396 static struct timespec
3397 time_error_value (int errnum
)
3399 int ns
= (errnum
== ENOENT
|| errnum
== EACCES
|| errnum
== ENOTDIR
3400 ? NONEXISTENT_MODTIME_NSECS
3401 : UNKNOWN_MODTIME_NSECS
);
3402 return make_timespec (0, ns
);
3405 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3407 doc
: /* Insert contents of file FILENAME after point.
3408 Returns list of absolute file name and number of characters inserted.
3409 If second argument VISIT is non-nil, the buffer's visited filename and
3410 last save file modtime are set, and it is marked unmodified. If
3411 visiting and the file does not exist, visiting is completed before the
3414 The optional third and fourth arguments BEG and END specify what portion
3415 of the file to insert. These arguments count bytes in the file, not
3416 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3418 If optional fifth argument REPLACE is non-nil, replace the current
3419 buffer contents (in the accessible portion) with the file contents.
3420 This is better than simply deleting and inserting the whole thing
3421 because (1) it preserves some marker positions and (2) it puts less data
3422 in the undo list. When REPLACE is non-nil, the second return value is
3423 the number of characters that replace previous buffer contents.
3425 This function does code conversion according to the value of
3426 `coding-system-for-read' or `file-coding-system-alist', and sets the
3427 variable `last-coding-system-used' to the coding system actually used.
3429 In addition, this function decodes the inserted text from known formats
3430 by calling `format-decode', which see. */)
3431 (Lisp_Object filename
, Lisp_Object visit
, Lisp_Object beg
, Lisp_Object end
, Lisp_Object replace
)
3434 struct timespec mtime
;
3436 ptrdiff_t inserted
= 0;
3438 off_t beg_offset
, end_offset
;
3440 ptrdiff_t count
= SPECPDL_INDEX ();
3441 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3442 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3444 ptrdiff_t total
= 0;
3445 bool not_regular
= 0;
3447 char read_buf
[READ_BUF_SIZE
];
3448 struct coding_system coding
;
3449 bool replace_handled
= 0;
3450 bool set_coding_system
= 0;
3451 Lisp_Object coding_system
;
3453 /* If the undo log only contains the insertion, there's no point
3454 keeping it. It's typically when we first fill a file-buffer. */
3455 bool empty_undo_list_p
3456 = (!NILP (visit
) && NILP (BVAR (current_buffer
, undo_list
))
3458 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3459 bool we_locked_file
= 0;
3462 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3463 error ("Cannot do file visiting in an indirect buffer");
3465 if (!NILP (BVAR (current_buffer
, read_only
)))
3466 Fbarf_if_buffer_read_only ();
3470 orig_filename
= Qnil
;
3473 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3475 CHECK_STRING (filename
);
3476 filename
= Fexpand_file_name (filename
, Qnil
);
3478 /* The value Qnil means that the coding system is not yet
3480 coding_system
= Qnil
;
3482 /* If the file name has special constructs in it,
3483 call the corresponding file handler. */
3484 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3485 if (!NILP (handler
))
3487 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3488 visit
, beg
, end
, replace
);
3489 if (CONSP (val
) && CONSP (XCDR (val
))
3490 && RANGED_INTEGERP (0, XCAR (XCDR (val
)), ZV
- PT
))
3491 inserted
= XINT (XCAR (XCDR (val
)));
3495 orig_filename
= filename
;
3496 filename
= ENCODE_FILE (filename
);
3498 fd
= emacs_open (SSDATA (filename
), O_RDONLY
, 0);
3503 report_file_error ("Opening input file", orig_filename
);
3504 mtime
= time_error_value (save_errno
);
3506 if (!NILP (Vcoding_system_for_read
))
3507 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3511 fd_index
= SPECPDL_INDEX ();
3512 record_unwind_protect_int (close_file_unwind
, fd
);
3514 /* Replacement should preserve point as it preserves markers. */
3515 if (!NILP (replace
))
3516 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3518 if (fstat (fd
, &st
) != 0)
3519 report_file_error ("Input file status", orig_filename
);
3520 mtime
= get_stat_mtime (&st
);
3522 /* This code will need to be changed in order to work on named
3523 pipes, and it's probably just not worth it. So we should at
3524 least signal an error. */
3525 if (!S_ISREG (st
.st_mode
))
3532 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3533 xsignal2 (Qfile_error
,
3534 build_string ("not a regular file"), orig_filename
);
3539 if (!NILP (beg
) || !NILP (end
))
3540 error ("Attempt to visit less than an entire file");
3541 if (BEG
< Z
&& NILP (replace
))
3542 error ("Cannot do file visiting in a non-empty buffer");
3546 beg_offset
= file_offset (beg
);
3551 end_offset
= file_offset (end
);
3555 end_offset
= TYPE_MAXIMUM (off_t
);
3558 end_offset
= st
.st_size
;
3560 /* A negative size can happen on a platform that allows file
3561 sizes greater than the maximum off_t value. */
3565 /* The file size returned from stat may be zero, but data
3566 may be readable nonetheless, for example when this is a
3567 file in the /proc filesystem. */
3568 if (end_offset
== 0)
3569 end_offset
= READ_BUF_SIZE
;
3573 /* Check now whether the buffer will become too large,
3574 in the likely case where the file's length is not changing.
3575 This saves a lot of needless work before a buffer overflow. */
3578 /* The likely offset where we will stop reading. We could read
3579 more (or less), if the file grows (or shrinks) as we read it. */
3580 off_t likely_end
= min (end_offset
, st
.st_size
);
3582 if (beg_offset
< likely_end
)
3585 = Z_BYTE
- (!NILP (replace
) ? ZV_BYTE
- BEGV_BYTE
: 0);
3586 ptrdiff_t buf_growth_max
= BUF_BYTES_MAX
- buf_bytes
;
3587 off_t likely_growth
= likely_end
- beg_offset
;
3588 if (buf_growth_max
< likely_growth
)
3593 /* Prevent redisplay optimizations. */
3594 current_buffer
->clip_changed
= 1;
3596 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3598 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3599 setup_coding_system (coding_system
, &coding
);
3600 /* Ensure we set Vlast_coding_system_used. */
3601 set_coding_system
= 1;
3605 /* Decide the coding system to use for reading the file now
3606 because we can't use an optimized method for handling
3607 `coding:' tag if the current buffer is not empty. */
3608 if (!NILP (Vcoding_system_for_read
))
3609 coding_system
= Vcoding_system_for_read
;
3612 /* Don't try looking inside a file for a coding system
3613 specification if it is not seekable. */
3614 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3616 /* Find a coding system specified in the heading two
3617 lines or in the tailing several lines of the file.
3618 We assume that the 1K-byte and 3K-byte for heading
3619 and tailing respectively are sufficient for this
3623 if (st
.st_size
<= (1024 * 4))
3624 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3627 nread
= emacs_read (fd
, read_buf
, 1024);
3631 if (lseek (fd
, - (1024 * 3), SEEK_END
) < 0)
3632 report_file_error ("Setting file position",
3634 ntail
= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3635 nread
= ntail
< 0 ? ntail
: nread
+ ntail
;
3640 report_file_error ("Read error", orig_filename
);
3643 struct buffer
*prev
= current_buffer
;
3644 Lisp_Object workbuf
;
3647 record_unwind_current_buffer ();
3649 workbuf
= Fget_buffer_create (build_string (" *code-converting-work*"));
3650 buf
= XBUFFER (workbuf
);
3652 delete_all_overlays (buf
);
3653 bset_directory (buf
, BVAR (current_buffer
, directory
));
3654 bset_read_only (buf
, Qnil
);
3655 bset_filename (buf
, Qnil
);
3656 bset_undo_list (buf
, Qt
);
3657 eassert (buf
->overlays_before
== NULL
);
3658 eassert (buf
->overlays_after
== NULL
);
3660 set_buffer_internal (buf
);
3662 bset_enable_multibyte_characters (buf
, Qnil
);
3664 insert_1_both ((char *) read_buf
, nread
, nread
, 0, 0, 0);
3665 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3666 coding_system
= call2 (Vset_auto_coding_function
,
3667 filename
, make_number (nread
));
3668 set_buffer_internal (prev
);
3670 /* Discard the unwind protect for recovering the
3674 /* Rewind the file for the actual read done later. */
3675 if (lseek (fd
, 0, SEEK_SET
) < 0)
3676 report_file_error ("Setting file position", orig_filename
);
3680 if (NILP (coding_system
))
3682 /* If we have not yet decided a coding system, check
3683 file-coding-system-alist. */
3684 Lisp_Object args
[6];
3686 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3687 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3688 coding_system
= Ffind_operation_coding_system (6, args
);
3689 if (CONSP (coding_system
))
3690 coding_system
= XCAR (coding_system
);
3694 if (NILP (coding_system
))
3695 coding_system
= Qundecided
;
3697 CHECK_CODING_SYSTEM (coding_system
);
3699 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3700 /* We must suppress all character code conversion except for
3701 end-of-line conversion. */
3702 coding_system
= raw_text_coding_system (coding_system
);
3704 setup_coding_system (coding_system
, &coding
);
3705 /* Ensure we set Vlast_coding_system_used. */
3706 set_coding_system
= 1;
3709 /* If requested, replace the accessible part of the buffer
3710 with the file contents. Avoid replacing text at the
3711 beginning or end of the buffer that matches the file contents;
3712 that preserves markers pointing to the unchanged parts.
3714 Here we implement this feature in an optimized way
3715 for the case where code conversion is NOT needed.
3716 The following if-statement handles the case of conversion
3717 in a less optimal way.
3719 If the code conversion is "automatic" then we try using this
3720 method and hope for the best.
3721 But if we discover the need for conversion, we give up on this method
3722 and let the following if-statement handle the replace job. */
3725 && (NILP (coding_system
)
3726 || ! CODING_REQUIRE_DECODING (&coding
)))
3728 /* same_at_start and same_at_end count bytes,
3729 because file access counts bytes
3730 and BEG and END count bytes. */
3731 ptrdiff_t same_at_start
= BEGV_BYTE
;
3732 ptrdiff_t same_at_end
= ZV_BYTE
;
3734 /* There is still a possibility we will find the need to do code
3735 conversion. If that happens, set this variable to
3736 give up on handling REPLACE in the optimized way. */
3737 bool giveup_match_end
= 0;
3739 if (beg_offset
!= 0)
3741 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
3742 report_file_error ("Setting file position", orig_filename
);
3747 /* Count how many chars at the start of the file
3748 match the text at the beginning of the buffer. */
3753 nread
= emacs_read (fd
, read_buf
, sizeof read_buf
);
3755 report_file_error ("Read error", orig_filename
);
3756 else if (nread
== 0)
3759 if (CODING_REQUIRE_DETECTION (&coding
))
3761 coding_system
= detect_coding_system ((unsigned char *) read_buf
,
3764 setup_coding_system (coding_system
, &coding
);
3767 if (CODING_REQUIRE_DECODING (&coding
))
3768 /* We found that the file should be decoded somehow.
3769 Let's give up here. */
3771 giveup_match_end
= 1;
3776 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3777 && FETCH_BYTE (same_at_start
) == read_buf
[bufpos
])
3778 same_at_start
++, bufpos
++;
3779 /* If we found a discrepancy, stop the scan.
3780 Otherwise loop around and scan the next bufferful. */
3781 if (bufpos
!= nread
)
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);
3798 /* Count how many chars at the end of the file
3799 match the text at the end of the buffer. But, if we have
3800 already found that decoding is necessary, don't waste time. */
3801 while (!giveup_match_end
)
3803 int total_read
, nread
, bufpos
, trial
;
3806 /* At what file position are we now scanning? */
3807 curpos
= end_offset
- (ZV_BYTE
- same_at_end
);
3808 /* If the entire file matches the buffer tail, stop the scan. */
3811 /* How much can we scan in the next step? */
3812 trial
= min (curpos
, sizeof read_buf
);
3813 if (lseek (fd
, curpos
- trial
, SEEK_SET
) < 0)
3814 report_file_error ("Setting file position", orig_filename
);
3816 total_read
= nread
= 0;
3817 while (total_read
< trial
)
3819 nread
= emacs_read (fd
, read_buf
+ total_read
, 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
= 1;
3856 if (! giveup_match_end
)
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
;
3883 /* Arrange to read only the nonmatching middle part of the file. */
3884 beg_offset
+= same_at_start
- BEGV_BYTE
;
3885 end_offset
-= ZV_BYTE
- same_at_end
;
3887 invalidate_buffer_caches (current_buffer
,
3888 BYTE_TO_CHAR (same_at_start
),
3889 BYTE_TO_CHAR (same_at_end
));
3890 del_range_byte (same_at_start
, same_at_end
, 0);
3891 /* Insert from the file at the proper position. */
3892 temp
= BYTE_TO_CHAR (same_at_start
);
3893 SET_PT_BOTH (temp
, same_at_start
);
3895 /* If display currently starts at beginning of line,
3896 keep it that way. */
3897 if (XBUFFER (XWINDOW (selected_window
)->contents
) == current_buffer
)
3898 XWINDOW (selected_window
)->start_at_line_beg
= !NILP (Fbolp ());
3900 replace_handled
= 1;
3904 /* If requested, replace the accessible part of the buffer
3905 with the file contents. Avoid replacing text at the
3906 beginning or end of the buffer that matches the file contents;
3907 that preserves markers pointing to the unchanged parts.
3909 Here we implement this feature for the case where code conversion
3910 is needed, in a simple way that needs a lot of memory.
3911 The preceding if-statement handles the case of no conversion
3912 in a more optimized way. */
3913 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3915 ptrdiff_t same_at_start
= BEGV_BYTE
;
3916 ptrdiff_t same_at_end
= ZV_BYTE
;
3917 ptrdiff_t same_at_start_charpos
;
3918 ptrdiff_t inserted_chars
;
3921 unsigned char *decoded
;
3924 ptrdiff_t this_count
= SPECPDL_INDEX ();
3926 = ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
3927 Lisp_Object conversion_buffer
;
3928 struct gcpro gcpro1
;
3930 conversion_buffer
= code_conversion_save (1, multibyte
);
3932 /* First read the whole file, performing code conversion into
3933 CONVERSION_BUFFER. */
3935 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
3936 report_file_error ("Setting file position", orig_filename
);
3938 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3939 unprocessed
= 0; /* Bytes not processed in previous loop. */
3941 GCPRO1 (conversion_buffer
);
3944 /* Read at most READ_BUF_SIZE bytes at a time, to allow
3945 quitting while reading a huge file. */
3947 /* Allow quitting out of the actual I/O. */
3950 this = emacs_read (fd
, read_buf
+ unprocessed
,
3951 READ_BUF_SIZE
- unprocessed
);
3957 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
3958 BUF_Z (XBUFFER (conversion_buffer
)));
3959 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3960 unprocessed
+ this, conversion_buffer
);
3961 unprocessed
= coding
.carryover_bytes
;
3962 if (coding
.carryover_bytes
> 0)
3963 memcpy (read_buf
, coding
.carryover
, unprocessed
);
3967 report_file_error ("Read error", orig_filename
);
3969 clear_unwind_protect (fd_index
);
3971 if (unprocessed
> 0)
3973 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3974 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3975 unprocessed
, conversion_buffer
);
3976 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
3979 coding_system
= CODING_ID_NAME (coding
.id
);
3980 set_coding_system
= 1;
3981 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
3982 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
3983 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3985 /* Compare the beginning of the converted string with the buffer
3989 while (bufpos
< inserted
&& same_at_start
< same_at_end
3990 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
3991 same_at_start
++, bufpos
++;
3993 /* If the file matches the head of buffer completely,
3994 there's no need to replace anything. */
3996 if (bufpos
== inserted
)
3998 /* Truncate the buffer to the size of the file. */
3999 if (same_at_start
!= same_at_end
)
4001 invalidate_buffer_caches (current_buffer
,
4002 BYTE_TO_CHAR (same_at_start
),
4003 BYTE_TO_CHAR (same_at_end
));
4004 del_range_byte (same_at_start
, same_at_end
, 0);
4008 unbind_to (this_count
, Qnil
);
4012 /* Extend the start of non-matching text area to the previous
4013 multibyte character boundary. */
4014 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4015 while (same_at_start
> BEGV_BYTE
4016 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4019 /* Scan this bufferful from the end, comparing with
4020 the Emacs buffer. */
4023 /* Compare with same_at_start to avoid counting some buffer text
4024 as matching both at the file's beginning and at the end. */
4025 while (bufpos
> 0 && same_at_end
> same_at_start
4026 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
4027 same_at_end
--, bufpos
--;
4029 /* Extend the end of non-matching text area to the next
4030 multibyte character boundary. */
4031 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4032 while (same_at_end
< ZV_BYTE
4033 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4036 /* Don't try to reuse the same piece of text twice. */
4037 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4039 same_at_end
+= overlap
;
4041 /* If display currently starts at beginning of line,
4042 keep it that way. */
4043 if (XBUFFER (XWINDOW (selected_window
)->contents
) == current_buffer
)
4044 XWINDOW (selected_window
)->start_at_line_beg
= !NILP (Fbolp ());
4046 /* Replace the chars that we need to replace,
4047 and update INSERTED to equal the number of bytes
4048 we are taking from the decoded string. */
4049 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4051 if (same_at_end
!= same_at_start
)
4053 invalidate_buffer_caches (current_buffer
,
4054 BYTE_TO_CHAR (same_at_start
),
4055 BYTE_TO_CHAR (same_at_end
));
4056 del_range_byte (same_at_start
, same_at_end
, 0);
4058 eassert (same_at_start
== GPT_BYTE
);
4059 same_at_start
= GPT_BYTE
;
4063 temp
= BYTE_TO_CHAR (same_at_start
);
4065 /* Insert from the file at the proper position. */
4066 SET_PT_BOTH (temp
, same_at_start
);
4067 same_at_start_charpos
4068 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4069 same_at_start
- BEGV_BYTE
4070 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4071 eassert (same_at_start_charpos
== temp
- (BEGV
- BEG
));
4073 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4074 same_at_start
+ inserted
- BEGV_BYTE
4075 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
4076 - same_at_start_charpos
);
4077 /* This binding is to avoid ask-user-about-supersession-threat
4078 being called in insert_from_buffer (via in
4079 prepare_to_modify_buffer). */
4080 specbind (intern ("buffer-file-name"), Qnil
);
4081 insert_from_buffer (XBUFFER (conversion_buffer
),
4082 same_at_start_charpos
, inserted_chars
, 0);
4083 /* Set `inserted' to the number of inserted characters. */
4084 inserted
= PT
- temp
;
4085 /* Set point before the inserted characters. */
4086 SET_PT_BOTH (temp
, same_at_start
);
4088 unbind_to (this_count
, Qnil
);
4094 total
= end_offset
- beg_offset
;
4096 /* For a special file, all we can do is guess. */
4097 total
= READ_BUF_SIZE
;
4099 if (NILP (visit
) && total
> 0)
4101 if (!NILP (BVAR (current_buffer
, file_truename
))
4102 /* Make binding buffer-file-name to nil effective. */
4103 && !NILP (BVAR (current_buffer
, filename
))
4104 && SAVE_MODIFF
>= MODIFF
)
4106 prepare_to_modify_buffer (PT
, PT
, NULL
);
4109 move_gap_both (PT
, PT_BYTE
);
4110 if (GAP_SIZE
< total
)
4111 make_gap (total
- GAP_SIZE
);
4113 if (beg_offset
!= 0 || !NILP (replace
))
4115 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
4116 report_file_error ("Setting file position", orig_filename
);
4119 /* In the following loop, HOW_MUCH contains the total bytes read so
4120 far for a regular file, and not changed for a special file. But,
4121 before exiting the loop, it is set to a negative value if I/O
4125 /* Total bytes inserted. */
4128 /* Here, we don't do code conversion in the loop. It is done by
4129 decode_coding_gap after all data are read into the buffer. */
4131 ptrdiff_t gap_size
= GAP_SIZE
;
4133 while (how_much
< total
)
4135 /* try is reserved in some compilers (Microsoft C) */
4136 ptrdiff_t trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4143 /* Maybe make more room. */
4144 if (gap_size
< trytry
)
4146 make_gap (trytry
- gap_size
);
4147 gap_size
= GAP_SIZE
- inserted
;
4150 /* Read from the file, capturing `quit'. When an
4151 error occurs, end the loop, and arrange for a quit
4152 to be signaled after decoding the text we read. */
4153 nbytes
= internal_condition_case_1
4155 make_save_int_int_int (fd
, inserted
, trytry
),
4156 Qerror
, read_non_regular_quit
);
4164 this = XINT (nbytes
);
4168 /* Allow quitting out of the actual I/O. We don't make text
4169 part of the buffer until all the reading is done, so a C-g
4170 here doesn't do any harm. */
4173 this = emacs_read (fd
,
4174 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
4188 /* For a regular file, where TOTAL is the real size,
4189 count HOW_MUCH to compare with it.
4190 For a special file, where TOTAL is just a buffer size,
4191 so don't bother counting in HOW_MUCH.
4192 (INSERTED is where we count the number of characters inserted.) */
4199 /* Now we have either read all the file data into the gap,
4200 or stop reading on I/O error or quit. If nothing was
4201 read, undo marking the buffer modified. */
4206 unlock_file (BVAR (current_buffer
, file_truename
));
4207 Vdeactivate_mark
= old_Vdeactivate_mark
;
4210 Vdeactivate_mark
= Qt
;
4213 clear_unwind_protect (fd_index
);
4216 report_file_error ("Read error", orig_filename
);
4218 /* Make the text read part of the buffer. */
4219 GAP_SIZE
-= inserted
;
4221 GPT_BYTE
+= inserted
;
4223 ZV_BYTE
+= inserted
;
4228 /* Put an anchor to ensure multi-byte form ends at gap. */
4233 if (NILP (coding_system
))
4235 /* The coding system is not yet decided. Decide it by an
4236 optimized method for handling `coding:' tag.
4238 Note that we can get here only if the buffer was empty
4239 before the insertion. */
4241 if (!NILP (Vcoding_system_for_read
))
4242 coding_system
= Vcoding_system_for_read
;
4245 /* Since we are sure that the current buffer was empty
4246 before the insertion, we can toggle
4247 enable-multibyte-characters directly here without taking
4248 care of marker adjustment. By this way, we can run Lisp
4249 program safely before decoding the inserted text. */
4250 Lisp_Object unwind_data
;
4251 ptrdiff_t count1
= SPECPDL_INDEX ();
4253 unwind_data
= Fcons (BVAR (current_buffer
, enable_multibyte_characters
),
4254 Fcons (BVAR (current_buffer
, undo_list
),
4255 Fcurrent_buffer ()));
4256 bset_enable_multibyte_characters (current_buffer
, Qnil
);
4257 bset_undo_list (current_buffer
, Qt
);
4258 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4260 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4262 coding_system
= call2 (Vset_auto_coding_function
,
4263 filename
, make_number (inserted
));
4266 if (NILP (coding_system
))
4268 /* If the coding system is not yet decided, check
4269 file-coding-system-alist. */
4270 Lisp_Object args
[6];
4272 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4273 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4274 coding_system
= Ffind_operation_coding_system (6, args
);
4275 if (CONSP (coding_system
))
4276 coding_system
= XCAR (coding_system
);
4278 unbind_to (count1
, Qnil
);
4279 inserted
= Z_BYTE
- BEG_BYTE
;
4282 if (NILP (coding_system
))
4283 coding_system
= Qundecided
;
4285 CHECK_CODING_SYSTEM (coding_system
);
4287 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4288 /* We must suppress all character code conversion except for
4289 end-of-line conversion. */
4290 coding_system
= raw_text_coding_system (coding_system
);
4291 setup_coding_system (coding_system
, &coding
);
4292 /* Ensure we set Vlast_coding_system_used. */
4293 set_coding_system
= 1;
4298 /* When we visit a file by raw-text, we change the buffer to
4300 if (CODING_FOR_UNIBYTE (&coding
)
4301 /* Can't do this if part of the buffer might be preserved. */
4303 /* Visiting a file with these coding system makes the buffer
4305 bset_enable_multibyte_characters (current_buffer
, Qnil
);
4308 coding
.dst_multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
4309 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4310 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4312 move_gap_both (PT
, PT_BYTE
);
4313 GAP_SIZE
+= inserted
;
4314 ZV_BYTE
-= inserted
;
4318 decode_coding_gap (&coding
, inserted
, inserted
);
4319 inserted
= coding
.produced_char
;
4320 coding_system
= CODING_ID_NAME (coding
.id
);
4322 else if (inserted
> 0)
4323 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4326 /* Call after-change hooks for the inserted text, aside from the case
4327 of normal visiting (not with REPLACE), which is done in a new buffer
4328 "before" the buffer is changed. */
4329 if (inserted
> 0 && total
> 0
4330 && (NILP (visit
) || !NILP (replace
)))
4332 signal_after_change (PT
, 0, inserted
);
4333 update_compositions (PT
, PT
, CHECK_BORDER
);
4336 /* Now INSERTED is measured in characters. */
4342 if (empty_undo_list_p
)
4343 bset_undo_list (current_buffer
, Qnil
);
4347 current_buffer
->modtime
= mtime
;
4348 current_buffer
->modtime_size
= st
.st_size
;
4349 bset_filename (current_buffer
, orig_filename
);
4352 SAVE_MODIFF
= MODIFF
;
4353 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
4354 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4357 if (!NILP (BVAR (current_buffer
, file_truename
)))
4358 unlock_file (BVAR (current_buffer
, file_truename
));
4359 unlock_file (filename
);
4362 xsignal2 (Qfile_error
,
4363 build_string ("not a regular file"), orig_filename
);
4366 if (set_coding_system
)
4367 Vlast_coding_system_used
= coding_system
;
4369 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4371 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4373 if (! NILP (insval
))
4375 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4376 wrong_type_argument (intern ("inserted-chars"), insval
);
4377 inserted
= XFASTINT (insval
);
4381 /* Decode file format. */
4384 /* Don't run point motion or modification hooks when decoding. */
4385 ptrdiff_t count1
= SPECPDL_INDEX ();
4386 ptrdiff_t old_inserted
= inserted
;
4387 specbind (Qinhibit_point_motion_hooks
, Qt
);
4388 specbind (Qinhibit_modification_hooks
, Qt
);
4390 /* Save old undo list and don't record undo for decoding. */
4391 old_undo
= BVAR (current_buffer
, undo_list
);
4392 bset_undo_list (current_buffer
, Qt
);
4396 insval
= call3 (Qformat_decode
,
4397 Qnil
, make_number (inserted
), visit
);
4398 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4399 wrong_type_argument (intern ("inserted-chars"), insval
);
4400 inserted
= XFASTINT (insval
);
4404 /* If REPLACE is non-nil and we succeeded in not replacing the
4405 beginning or end of the buffer text with the file's contents,
4406 call format-decode with `point' positioned at the beginning
4407 of the buffer and `inserted' equaling the number of
4408 characters in the buffer. Otherwise, format-decode might
4409 fail to correctly analyze the beginning or end of the buffer.
4410 Hence we temporarily save `point' and `inserted' here and
4411 restore `point' iff format-decode did not insert or delete
4412 any text. Otherwise we leave `point' at point-min. */
4413 ptrdiff_t opoint
= PT
;
4414 ptrdiff_t opoint_byte
= PT_BYTE
;
4415 ptrdiff_t oinserted
= ZV
- BEGV
;
4416 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4418 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4419 insval
= call3 (Qformat_decode
,
4420 Qnil
, make_number (oinserted
), visit
);
4421 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4422 wrong_type_argument (intern ("inserted-chars"), insval
);
4423 if (ochars_modiff
== CHARS_MODIFF
)
4424 /* format_decode didn't modify buffer's characters => move
4425 point back to position before inserted text and leave
4426 value of inserted alone. */
4427 SET_PT_BOTH (opoint
, opoint_byte
);
4429 /* format_decode modified buffer's characters => consider
4430 entire buffer changed and leave point at point-min. */
4431 inserted
= XFASTINT (insval
);
4434 /* For consistency with format-decode call these now iff inserted > 0
4435 (martin 2007-06-28). */
4436 p
= Vafter_insert_file_functions
;
4441 insval
= call1 (XCAR (p
), make_number (inserted
));
4444 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4445 wrong_type_argument (intern ("inserted-chars"), insval
);
4446 inserted
= XFASTINT (insval
);
4451 /* For the rationale of this see the comment on
4452 format-decode above. */
4453 ptrdiff_t opoint
= PT
;
4454 ptrdiff_t opoint_byte
= PT_BYTE
;
4455 ptrdiff_t oinserted
= ZV
- BEGV
;
4456 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4458 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4459 insval
= call1 (XCAR (p
), make_number (oinserted
));
4462 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4463 wrong_type_argument (intern ("inserted-chars"), insval
);
4464 if (ochars_modiff
== CHARS_MODIFF
)
4465 /* after_insert_file_functions didn't modify
4466 buffer's characters => move point back to
4467 position before inserted text and leave value of
4469 SET_PT_BOTH (opoint
, opoint_byte
);
4471 /* after_insert_file_functions did modify buffer's
4472 characters => consider entire buffer changed and
4473 leave point at point-min. */
4474 inserted
= XFASTINT (insval
);
4482 if (!empty_undo_list_p
)
4484 bset_undo_list (current_buffer
, old_undo
);
4485 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4487 /* Adjust the last undo record for the size change during
4488 the format conversion. */
4489 Lisp_Object tem
= XCAR (old_undo
);
4490 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4491 && INTEGERP (XCDR (tem
))
4492 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4493 XSETCDR (tem
, make_number (PT
+ inserted
));
4497 /* If undo_list was Qt before, keep it that way.
4498 Otherwise start with an empty undo_list. */
4499 bset_undo_list (current_buffer
, EQ (old_undo
, Qt
) ? Qt
: Qnil
);
4501 unbind_to (count1
, Qnil
);
4505 && current_buffer
->modtime
.tv_nsec
== NONEXISTENT_MODTIME_NSECS
)
4507 /* If visiting nonexistent file, return nil. */
4508 report_file_errno ("Opening input file", orig_filename
, save_errno
);
4511 /* We made a lot of deletions and insertions above, so invalidate
4512 the newline cache for the entire region of the inserted
4514 if (current_buffer
->base_buffer
&& current_buffer
->base_buffer
->newline_cache
)
4515 invalidate_region_cache (current_buffer
->base_buffer
,
4516 current_buffer
->base_buffer
->newline_cache
,
4517 PT
- BEG
, Z
- PT
- inserted
);
4518 else if (current_buffer
->newline_cache
)
4519 invalidate_region_cache (current_buffer
,
4520 current_buffer
->newline_cache
,
4521 PT
- BEG
, Z
- PT
- inserted
);
4524 Fsignal (Qquit
, Qnil
);
4526 /* Retval needs to be dealt with in all cases consistently. */
4528 val
= list2 (orig_filename
, make_number (inserted
));
4530 RETURN_UNGCPRO (unbind_to (count
, val
));
4533 static Lisp_Object
build_annotations (Lisp_Object
, Lisp_Object
);
4536 build_annotations_unwind (Lisp_Object arg
)
4538 Vwrite_region_annotation_buffers
= arg
;
4541 /* Decide the coding-system to encode the data with. */
4544 choose_write_coding_system (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4545 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
,
4546 struct coding_system
*coding
)
4549 Lisp_Object eol_parent
= Qnil
;
4552 && NILP (Fstring_equal (BVAR (current_buffer
, filename
),
4553 BVAR (current_buffer
, auto_save_file_name
))))
4558 else if (!NILP (Vcoding_system_for_write
))
4560 val
= Vcoding_system_for_write
;
4561 if (coding_system_require_warning
4562 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4563 /* Confirm that VAL can surely encode the current region. */
4564 val
= call5 (Vselect_safe_coding_system_function
,
4565 start
, end
, list2 (Qt
, val
),
4570 /* If the variable `buffer-file-coding-system' is set locally,
4571 it means that the file was read with some kind of code
4572 conversion or the variable is explicitly set by users. We
4573 had better write it out with the same coding system even if
4574 `enable-multibyte-characters' is nil.
4576 If it is not set locally, we anyway have to convert EOL
4577 format if the default value of `buffer-file-coding-system'
4578 tells that it is not Unix-like (LF only) format. */
4579 bool using_default_coding
= 0;
4580 bool force_raw_text
= 0;
4582 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4584 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4587 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4593 /* Check file-coding-system-alist. */
4594 Lisp_Object args
[7], coding_systems
;
4596 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4597 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4599 coding_systems
= Ffind_operation_coding_system (7, args
);
4600 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4601 val
= XCDR (coding_systems
);
4606 /* If we still have not decided a coding system, use the
4607 default value of buffer-file-coding-system. */
4608 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4609 using_default_coding
= 1;
4612 if (! NILP (val
) && ! force_raw_text
)
4614 Lisp_Object spec
, attrs
;
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
)))
4624 /* Confirm that VAL can surely encode the current region. */
4625 val
= call5 (Vselect_safe_coding_system_function
,
4626 start
, end
, val
, Qnil
, filename
);
4628 /* If the decided coding-system doesn't specify end-of-line
4629 format, we use that of
4630 `default-buffer-file-coding-system'. */
4631 if (! using_default_coding
4632 && ! NILP (BVAR (&buffer_defaults
, buffer_file_coding_system
)))
4633 val
= (coding_inherit_eol_type
4634 (val
, BVAR (&buffer_defaults
, buffer_file_coding_system
)));
4636 /* If we decide not to encode text, use `raw-text' or one of its
4639 val
= raw_text_coding_system (val
);
4642 val
= coding_inherit_eol_type (val
, eol_parent
);
4643 setup_coding_system (val
, coding
);
4645 if (!STRINGP (start
) && !NILP (BVAR (current_buffer
, selective_display
)))
4646 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4650 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4651 "r\nFWrite region to file: \ni\ni\ni\np",
4652 doc
: /* Write current region into specified file.
4653 When called from a program, requires three arguments:
4654 START, END and FILENAME. START and END are normally buffer positions
4655 specifying the part of the buffer to write.
4656 If START is nil, that means to use the entire buffer contents.
4657 If START is a string, then output that string to the file
4658 instead of any buffer contents; END is ignored.
4660 Optional fourth argument APPEND if non-nil means
4661 append to existing file contents (if any). If it is a number,
4662 seek to that offset in the file before writing.
4663 Optional fifth argument VISIT, if t or a string, means
4664 set the last-save-file-modtime of buffer to this file's modtime
4665 and mark buffer not modified.
4666 If VISIT is a string, it is a second file name;
4667 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4668 VISIT is also the file name to lock and unlock for clash detection.
4669 If VISIT is neither t nor nil nor a string,
4670 that means do not display the \"Wrote file\" message.
4671 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4672 use for locking and unlocking, overriding FILENAME and VISIT.
4673 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4674 for an existing file with the same name. If MUSTBENEW is `excl',
4675 that means to get an error if the file already exists; never overwrite.
4676 If MUSTBENEW is neither nil nor `excl', that means ask for
4677 confirmation before overwriting, but do go ahead and overwrite the file
4678 if the user confirms.
4680 This does code conversion according to the value of
4681 `coding-system-for-write', `buffer-file-coding-system', or
4682 `file-coding-system-alist', and sets the variable
4683 `last-coding-system-used' to the coding system actually used.
4685 This calls `write-region-annotate-functions' at the start, and
4686 `write-region-post-annotation-function' at the end. */)
4687 (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
, Lisp_Object append
,
4688 Lisp_Object visit
, Lisp_Object lockname
, Lisp_Object mustbenew
)
4690 return write_region (start
, end
, filename
, append
, visit
, lockname
, mustbenew
,
4694 /* Like Fwrite_region, except that if DESC is nonnegative, it is a file
4695 descriptor for FILENAME, so do not open or close FILENAME. */
4698 write_region (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4699 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
,
4700 Lisp_Object mustbenew
, int desc
)
4704 off_t offset
IF_LINT (= 0);
4705 bool open_and_close_file
= desc
< 0;
4710 struct timespec modtime
;
4711 ptrdiff_t count
= SPECPDL_INDEX ();
4712 ptrdiff_t count1
IF_LINT (= 0);
4713 Lisp_Object handler
;
4714 Lisp_Object visit_file
;
4715 Lisp_Object annotations
;
4716 Lisp_Object encoded_filename
;
4717 bool visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4718 bool quietly
= !NILP (visit
);
4719 bool file_locked
= 0;
4720 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4721 struct buffer
*given_buffer
;
4722 struct coding_system coding
;
4724 if (current_buffer
->base_buffer
&& visiting
)
4725 error ("Cannot do file visiting in an indirect buffer");
4727 if (!NILP (start
) && !STRINGP (start
))
4728 validate_region (&start
, &end
);
4731 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4733 filename
= Fexpand_file_name (filename
, Qnil
);
4735 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4736 barf_or_query_if_file_exists (filename
, false, "overwrite", true, true);
4738 if (STRINGP (visit
))
4739 visit_file
= Fexpand_file_name (visit
, Qnil
);
4741 visit_file
= filename
;
4743 if (NILP (lockname
))
4744 lockname
= visit_file
;
4748 /* If the file name has special constructs in it,
4749 call the corresponding file handler. */
4750 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4751 /* If FILENAME has no handler, see if VISIT has one. */
4752 if (NILP (handler
) && STRINGP (visit
))
4753 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4755 if (!NILP (handler
))
4758 val
= call6 (handler
, Qwrite_region
, start
, end
,
4759 filename
, append
, visit
);
4763 SAVE_MODIFF
= MODIFF
;
4764 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4765 bset_filename (current_buffer
, visit_file
);
4771 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4773 /* Special kludge to simplify auto-saving. */
4776 /* Do it later, so write-region-annotate-function can work differently
4777 if we save "the buffer" vs "a region".
4778 This is useful in tar-mode. --Stef
4779 XSETFASTINT (start, BEG);
4780 XSETFASTINT (end, Z); */
4784 record_unwind_protect (build_annotations_unwind
,
4785 Vwrite_region_annotation_buffers
);
4786 Vwrite_region_annotation_buffers
= list1 (Fcurrent_buffer ());
4788 given_buffer
= current_buffer
;
4790 if (!STRINGP (start
))
4792 annotations
= build_annotations (start
, end
);
4794 if (current_buffer
!= given_buffer
)
4796 XSETFASTINT (start
, BEGV
);
4797 XSETFASTINT (end
, ZV
);
4803 XSETFASTINT (start
, BEGV
);
4804 XSETFASTINT (end
, ZV
);
4809 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4811 /* Decide the coding-system to encode the data with.
4812 We used to make this choice before calling build_annotations, but that
4813 leads to problems when a write-annotate-function takes care of
4814 unsavable chars (as was the case with X-Symbol). */
4815 Vlast_coding_system_used
4816 = choose_write_coding_system (start
, end
, filename
,
4817 append
, visit
, lockname
, &coding
);
4819 if (open_and_close_file
&& !auto_saving
)
4821 lock_file (lockname
);
4825 encoded_filename
= ENCODE_FILE (filename
);
4826 fn
= SSDATA (encoded_filename
);
4827 open_flags
= O_WRONLY
| O_BINARY
| O_CREAT
;
4828 open_flags
|= EQ (mustbenew
, Qexcl
) ? O_EXCL
: !NILP (append
) ? 0 : O_TRUNC
;
4829 if (NUMBERP (append
))
4830 offset
= file_offset (append
);
4831 else if (!NILP (append
))
4832 open_flags
|= O_APPEND
;
4834 mode
= S_IREAD
| S_IWRITE
;
4836 mode
= auto_saving
? auto_save_mode_bits
: 0666;
4839 if (open_and_close_file
)
4841 desc
= emacs_open (fn
, open_flags
, mode
);
4844 int open_errno
= errno
;
4846 unlock_file (lockname
);
4848 report_file_errno ("Opening output file", filename
, open_errno
);
4851 count1
= SPECPDL_INDEX ();
4852 record_unwind_protect_int (close_file_unwind
, desc
);
4855 if (NUMBERP (append
))
4857 off_t ret
= lseek (desc
, offset
, SEEK_SET
);
4860 int lseek_errno
= errno
;
4862 unlock_file (lockname
);
4864 report_file_errno ("Lseek error", filename
, lseek_errno
);
4872 if (STRINGP (start
))
4873 ok
= a_write (desc
, start
, 0, SCHARS (start
), &annotations
, &coding
);
4874 else if (XINT (start
) != XINT (end
))
4875 ok
= a_write (desc
, Qnil
, XINT (start
), XINT (end
) - XINT (start
),
4876 &annotations
, &coding
);
4879 /* If file was empty, still need to write the annotations. */
4880 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4881 ok
= a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4885 if (ok
&& CODING_REQUIRE_FLUSHING (&coding
)
4886 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
))
4888 /* We have to flush out a data. */
4889 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4890 ok
= e_write (desc
, Qnil
, 1, 1, &coding
);
4896 /* fsync is not crucial for temporary files. Nor for auto-save
4897 files, since they might lose some work anyway. */
4898 if (open_and_close_file
&& !auto_saving
&& !write_region_inhibit_fsync
)
4900 /* Transfer data and metadata to disk, retrying if interrupted.
4901 fsync can report a write failure here, e.g., due to disk full
4902 under NFS. But ignore EINVAL, which means fsync is not
4903 supported on this file. */
4904 while (fsync (desc
) != 0)
4907 if (errno
!= EINVAL
)
4908 ok
= 0, save_errno
= errno
;
4913 modtime
= invalid_timespec ();
4916 if (fstat (desc
, &st
) == 0)
4917 modtime
= get_stat_mtime (&st
);
4919 ok
= 0, save_errno
= errno
;
4922 if (open_and_close_file
)
4924 /* NFS can report a write failure now. */
4925 if (emacs_close (desc
) < 0)
4926 ok
= 0, save_errno
= errno
;
4928 /* Discard the unwind protect for close_file_unwind. */
4929 specpdl_ptr
= specpdl
+ count1
;
4932 /* Some file systems have a bug where st_mtime is not updated
4933 properly after a write. For example, CIFS might not see the
4934 st_mtime change until after the file is opened again.
4936 Attempt to detect this file system bug, and update MODTIME to the
4937 newer st_mtime if the bug appears to be present. This introduces
4938 a race condition, so to avoid most instances of the race condition
4939 on non-buggy file systems, skip this check if the most recently
4940 encountered non-buggy file system was the current file system.
4942 A race condition can occur if some other process modifies the
4943 file between the fstat above and the fstat below, but the race is
4944 unlikely and a similar race between the last write and the fstat
4945 above cannot possibly be closed anyway. */
4947 if (timespec_valid_p (modtime
)
4948 && ! (valid_timestamp_file_system
&& st
.st_dev
== timestamp_file_system
))
4950 int desc1
= emacs_open (fn
, O_WRONLY
| O_BINARY
, 0);
4954 if (fstat (desc1
, &st1
) == 0
4955 && st
.st_dev
== st1
.st_dev
&& st
.st_ino
== st1
.st_ino
)
4957 /* Use the heuristic if it appears to be valid. With neither
4958 O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the
4959 file, the time stamp won't change. Also, some non-POSIX
4960 systems don't update an empty file's time stamp when
4961 truncating it. Finally, file systems with 100 ns or worse
4962 resolution sometimes seem to have bugs: on a system with ns
4963 resolution, checking ns % 100 incorrectly avoids the heuristic
4964 1% of the time, but the problem should be temporary as we will
4965 try again on the next time stamp. */
4967 = ((open_flags
& (O_EXCL
| O_TRUNC
)) != 0
4969 && modtime
.tv_nsec
% 100 != 0);
4971 struct timespec modtime1
= get_stat_mtime (&st1
);
4973 && timespec_cmp (modtime
, modtime1
) == 0
4974 && st
.st_size
== st1
.st_size
)
4976 timestamp_file_system
= st
.st_dev
;
4977 valid_timestamp_file_system
= 1;
4981 st
.st_size
= st1
.st_size
;
4985 emacs_close (desc1
);
4989 /* Call write-region-post-annotation-function. */
4990 while (CONSP (Vwrite_region_annotation_buffers
))
4992 Lisp_Object buf
= XCAR (Vwrite_region_annotation_buffers
);
4993 if (!NILP (Fbuffer_live_p (buf
)))
4996 if (FUNCTIONP (Vwrite_region_post_annotation_function
))
4997 call0 (Vwrite_region_post_annotation_function
);
4999 Vwrite_region_annotation_buffers
5000 = XCDR (Vwrite_region_annotation_buffers
);
5003 unbind_to (count
, Qnil
);
5006 unlock_file (lockname
);
5008 /* Do this before reporting IO error
5009 to avoid a "file has changed on disk" warning on
5010 next attempt to save. */
5011 if (timespec_valid_p (modtime
))
5013 current_buffer
->modtime
= modtime
;
5014 current_buffer
->modtime_size
= st
.st_size
;
5018 report_file_errno ("Write error", filename
, save_errno
);
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;
5030 && ! NILP (Fstring_equal (BVAR (current_buffer
, filename
),
5031 BVAR (current_buffer
, auto_save_file_name
))))
5032 SAVE_MODIFF
= MODIFF
;
5038 message_with_string ((NUMBERP (append
)
5048 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5049 doc
: /* Return t if (car A) is numerically less than (car B). */)
5050 (Lisp_Object a
, Lisp_Object b
)
5052 Lisp_Object args
[2];
5055 return Flss (2, args
);
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 struct gcpro gcpro1
, gcpro2
;
5072 Lisp_Object original_buffer
;
5074 bool used_global
= 0;
5076 XSETBUFFER (original_buffer
, current_buffer
);
5079 p
= Vwrite_region_annotate_functions
;
5080 GCPRO2 (annotations
, p
);
5083 struct buffer
*given_buffer
= current_buffer
;
5084 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5085 { /* Use the global value of the hook. */
5088 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5090 p
= Fappend (2, arg
);
5093 Vwrite_region_annotations_so_far
= annotations
;
5094 res
= call2 (XCAR (p
), start
, end
);
5095 /* If the function makes a different buffer current,
5096 assume that means this buffer contains altered text to be output.
5097 Reset START and END from the buffer bounds
5098 and discard all previous annotations because they should have
5099 been dealt with by this function. */
5100 if (current_buffer
!= given_buffer
)
5102 Vwrite_region_annotation_buffers
5103 = Fcons (Fcurrent_buffer (),
5104 Vwrite_region_annotation_buffers
);
5105 XSETFASTINT (start
, BEGV
);
5106 XSETFASTINT (end
, ZV
);
5109 Flength (res
); /* Check basic validity of return value */
5110 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5114 /* Now do the same for annotation functions implied by the file-format */
5115 if (auto_saving
&& (!EQ (BVAR (current_buffer
, auto_save_file_format
), Qt
)))
5116 p
= BVAR (current_buffer
, auto_save_file_format
);
5118 p
= BVAR (current_buffer
, file_format
);
5119 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5121 struct buffer
*given_buffer
= current_buffer
;
5123 Vwrite_region_annotations_so_far
= annotations
;
5125 /* Value is either a list of annotations or nil if the function
5126 has written annotations to a temporary buffer, which is now
5128 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5129 original_buffer
, make_number (i
));
5130 if (current_buffer
!= given_buffer
)
5132 XSETFASTINT (start
, BEGV
);
5133 XSETFASTINT (end
, ZV
);
5138 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5146 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5147 If STRING is nil, POS is the character position in the current buffer.
5148 Intersperse with them the annotations from *ANNOT
5149 which fall within the range of POS to POS + NCHARS,
5150 each at its appropriate position.
5152 We modify *ANNOT by discarding elements as we use them up.
5154 Return true if successful. */
5157 a_write (int desc
, Lisp_Object string
, ptrdiff_t pos
,
5158 ptrdiff_t nchars
, Lisp_Object
*annot
,
5159 struct coding_system
*coding
)
5163 ptrdiff_t lastpos
= pos
+ nchars
;
5165 while (NILP (*annot
) || CONSP (*annot
))
5167 tem
= Fcar_safe (Fcar (*annot
));
5170 nextpos
= XFASTINT (tem
);
5172 /* If there are no more annotations in this range,
5173 output the rest of the range all at once. */
5174 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5175 return e_write (desc
, string
, pos
, lastpos
, coding
);
5177 /* Output buffer text up to the next annotation's position. */
5180 if (!e_write (desc
, string
, pos
, nextpos
, coding
))
5184 /* Output the annotation. */
5185 tem
= Fcdr (Fcar (*annot
));
5188 if (!e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5191 *annot
= Fcdr (*annot
);
5196 /* Maximum number of characters that the next
5197 function encodes per one loop iteration. */
5199 enum { E_WRITE_MAX
= 8 * 1024 * 1024 };
5201 /* Write text in the range START and END into descriptor DESC,
5202 encoding them with coding system CODING. If STRING is nil, START
5203 and END are character positions of the current buffer, else they
5204 are indexes to the string STRING. Return true if successful. */
5207 e_write (int desc
, Lisp_Object string
, ptrdiff_t start
, ptrdiff_t end
,
5208 struct coding_system
*coding
)
5210 if (STRINGP (string
))
5213 end
= SCHARS (string
);
5216 /* We used to have a code for handling selective display here. But,
5217 now it is handled within encode_coding. */
5221 if (STRINGP (string
))
5223 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5224 if (CODING_REQUIRE_ENCODING (coding
))
5226 ptrdiff_t nchars
= min (end
- start
, E_WRITE_MAX
);
5228 /* Avoid creating huge Lisp string in encode_coding_object. */
5229 if (nchars
== E_WRITE_MAX
)
5230 coding
->raw_destination
= 1;
5232 encode_coding_object
5233 (coding
, string
, start
, string_char_to_byte (string
, start
),
5234 start
+ nchars
, string_char_to_byte (string
, start
+ nchars
),
5239 coding
->dst_object
= string
;
5240 coding
->consumed_char
= SCHARS (string
);
5241 coding
->produced
= SBYTES (string
);
5246 ptrdiff_t start_byte
= CHAR_TO_BYTE (start
);
5247 ptrdiff_t end_byte
= CHAR_TO_BYTE (end
);
5249 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5250 if (CODING_REQUIRE_ENCODING (coding
))
5252 ptrdiff_t nchars
= min (end
- start
, E_WRITE_MAX
);
5255 if (nchars
== E_WRITE_MAX
)
5256 coding
->raw_destination
= 1;
5258 encode_coding_object
5259 (coding
, Fcurrent_buffer (), start
, start_byte
,
5260 start
+ nchars
, CHAR_TO_BYTE (start
+ nchars
), Qt
);
5264 coding
->dst_object
= Qnil
;
5265 coding
->dst_pos_byte
= start_byte
;
5266 if (start
>= GPT
|| end
<= GPT
)
5268 coding
->consumed_char
= end
- start
;
5269 coding
->produced
= end_byte
- start_byte
;
5273 coding
->consumed_char
= GPT
- start
;
5274 coding
->produced
= GPT_BYTE
- start_byte
;
5279 if (coding
->produced
> 0)
5281 char *buf
= (coding
->raw_destination
? (char *) coding
->destination
5282 : (STRINGP (coding
->dst_object
)
5283 ? SSDATA (coding
->dst_object
)
5284 : (char *) BYTE_POS_ADDR (coding
->dst_pos_byte
)));
5285 coding
->produced
-= emacs_write_sig (desc
, buf
, coding
->produced
);
5287 if (coding
->raw_destination
)
5289 /* We're responsible for freeing this, see
5290 encode_coding_object to check why. */
5291 xfree (coding
->destination
);
5292 coding
->raw_destination
= 0;
5294 if (coding
->produced
)
5297 start
+= coding
->consumed_char
;
5303 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5304 Sverify_visited_file_modtime
, 0, 1, 0,
5305 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5306 This means that the file has not been changed since it was visited or saved.
5307 If BUF is omitted or nil, it defaults to the current buffer.
5308 See Info node `(elisp)Modification Time' for more details. */)
5313 Lisp_Object handler
;
5314 Lisp_Object filename
;
5315 struct timespec mtime
;
5325 if (!STRINGP (BVAR (b
, filename
))) return Qt
;
5326 if (b
->modtime
.tv_nsec
== UNKNOWN_MODTIME_NSECS
) return Qt
;
5328 /* If the file name has special constructs in it,
5329 call the corresponding file handler. */
5330 handler
= Ffind_file_name_handler (BVAR (b
, filename
),
5331 Qverify_visited_file_modtime
);
5332 if (!NILP (handler
))
5333 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5335 filename
= ENCODE_FILE (BVAR (b
, filename
));
5337 mtime
= (stat (SSDATA (filename
), &st
) == 0
5338 ? get_stat_mtime (&st
)
5339 : time_error_value (errno
));
5340 if (timespec_cmp (mtime
, b
->modtime
) == 0
5341 && (b
->modtime_size
< 0
5342 || st
.st_size
== b
->modtime_size
))
5347 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5348 Svisited_file_modtime
, 0, 0, 0,
5349 doc
: /* Return the current buffer's recorded visited file modification time.
5350 The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
5351 `file-attributes' returns. If the current buffer has no recorded file
5352 modification time, this function returns 0. If the visited file
5353 doesn't exist, return -1.
5354 See Info node `(elisp)Modification Time' for more details. */)
5357 int ns
= current_buffer
->modtime
.tv_nsec
;
5359 return make_number (UNKNOWN_MODTIME_NSECS
- ns
);
5360 return make_lisp_time (current_buffer
->modtime
);
5363 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5364 Sset_visited_file_modtime
, 0, 1, 0,
5365 doc
: /* Update buffer's recorded modification time from the visited file's time.
5366 Useful if the buffer was not read from the file normally
5367 or if the file itself has been changed for some known benign reason.
5368 An argument specifies the modification time value to use
5369 \(instead of that of the visited file), in the form of a list
5370 \(HIGH LOW USEC PSEC) or an integer flag as returned by
5371 `visited-file-modtime'. */)
5372 (Lisp_Object time_flag
)
5374 if (!NILP (time_flag
))
5376 struct timespec mtime
;
5377 if (INTEGERP (time_flag
))
5379 CHECK_RANGED_INTEGER (time_flag
, -1, 0);
5380 mtime
= make_timespec (0, UNKNOWN_MODTIME_NSECS
- XINT (time_flag
));
5383 mtime
= lisp_time_argument (time_flag
);
5385 current_buffer
->modtime
= mtime
;
5386 current_buffer
->modtime_size
= -1;
5390 register Lisp_Object filename
;
5392 Lisp_Object handler
;
5394 filename
= Fexpand_file_name (BVAR (current_buffer
, filename
), Qnil
);
5396 /* If the file name has special constructs in it,
5397 call the corresponding file handler. */
5398 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5399 if (!NILP (handler
))
5400 /* The handler can find the file name the same way we did. */
5401 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5403 filename
= ENCODE_FILE (filename
);
5405 if (stat (SSDATA (filename
), &st
) >= 0)
5407 current_buffer
->modtime
= get_stat_mtime (&st
);
5408 current_buffer
->modtime_size
= st
.st_size
;
5416 auto_save_error (Lisp_Object error_val
)
5418 Lisp_Object args
[3], msg
;
5420 struct gcpro gcpro1
;
5422 auto_save_error_occurred
= 1;
5424 ring_bell (XFRAME (selected_frame
));
5426 args
[0] = build_string ("Auto-saving %s: %s");
5427 args
[1] = BVAR (current_buffer
, name
);
5428 args
[2] = Ferror_message_string (error_val
);
5429 msg
= Fformat (3, args
);
5432 for (i
= 0; i
< 3; ++i
)
5437 message3_nolog (msg
);
5438 Fsleep_for (make_number (1), Qnil
);
5451 auto_save_mode_bits
= 0666;
5453 /* Get visited file's mode to become the auto save file's mode. */
5454 if (! NILP (BVAR (current_buffer
, filename
)))
5456 if (stat (SSDATA (BVAR (current_buffer
, filename
)), &st
) >= 0)
5457 /* But make sure we can overwrite it later! */
5458 auto_save_mode_bits
= (st
.st_mode
| 0600) & 0777;
5459 else if (modes
= Ffile_modes (BVAR (current_buffer
, filename
)),
5461 /* Remote files don't cooperate with stat. */
5462 auto_save_mode_bits
= (XINT (modes
) | 0600) & 0777;
5466 Fwrite_region (Qnil
, Qnil
, BVAR (current_buffer
, auto_save_file_name
), Qnil
,
5467 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5471 struct auto_save_unwind
5478 do_auto_save_unwind (void *arg
)
5480 struct auto_save_unwind
*p
= arg
;
5481 FILE *stream
= p
->stream
;
5482 minibuffer_auto_raise
= p
->auto_raise
;
5493 do_auto_save_make_dir (Lisp_Object dir
)
5497 auto_saving_dir_umask
= 077;
5498 result
= call2 (Qmake_directory
, dir
, Qt
);
5499 auto_saving_dir_umask
= 0;
5504 do_auto_save_eh (Lisp_Object ignore
)
5506 auto_saving_dir_umask
= 0;
5510 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5511 doc
: /* Auto-save all buffers that need it.
5512 This is all buffers that have auto-saving enabled
5513 and are changed since last auto-saved.
5514 Auto-saving writes the buffer into a file
5515 so that your editing is not lost if the system crashes.
5516 This file is not the file you visited; that changes only when you save.
5517 Normally we run the normal hook `auto-save-hook' before saving.
5519 A non-nil NO-MESSAGE argument means do not print any message if successful.
5520 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5521 (Lisp_Object no_message
, Lisp_Object current_only
)
5523 struct buffer
*old
= current_buffer
, *b
;
5524 Lisp_Object tail
, buf
, hook
;
5525 bool auto_saved
= 0;
5526 int do_handled_files
;
5528 FILE *stream
= NULL
;
5529 ptrdiff_t count
= SPECPDL_INDEX ();
5530 bool orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5531 bool old_message_p
= 0;
5532 struct auto_save_unwind auto_save_unwind
;
5533 struct gcpro gcpro1
, gcpro2
;
5535 if (max_specpdl_size
< specpdl_size
+ 40)
5536 max_specpdl_size
= specpdl_size
+ 40;
5541 if (NILP (no_message
))
5543 old_message_p
= push_message ();
5544 record_unwind_protect_void (pop_message_unwind
);
5547 /* Ordinarily don't quit within this function,
5548 but don't make it impossible to quit (in case we get hung in I/O). */
5552 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5553 point to non-strings reached from Vbuffer_alist. */
5555 hook
= intern ("auto-save-hook");
5556 safe_run_hooks (hook
);
5558 if (STRINGP (Vauto_save_list_file_name
))
5560 Lisp_Object listfile
;
5562 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5564 /* Don't try to create the directory when shutting down Emacs,
5565 because creating the directory might signal an error, and
5566 that would leave Emacs in a strange state. */
5567 if (!NILP (Vrun_hooks
))
5571 GCPRO2 (dir
, listfile
);
5572 dir
= Ffile_name_directory (listfile
);
5573 if (NILP (Ffile_directory_p (dir
)))
5574 internal_condition_case_1 (do_auto_save_make_dir
,
5580 stream
= emacs_fopen (SSDATA (listfile
), "w");
5583 auto_save_unwind
.stream
= stream
;
5584 auto_save_unwind
.auto_raise
= minibuffer_auto_raise
;
5585 record_unwind_protect_ptr (do_auto_save_unwind
, &auto_save_unwind
);
5586 minibuffer_auto_raise
= 0;
5588 auto_save_error_occurred
= 0;
5590 /* On first pass, save all files that don't have handlers.
5591 On second pass, save all files that do have handlers.
5593 If Emacs is crashing, the handlers may tweak what is causing
5594 Emacs to crash in the first place, and it would be a shame if
5595 Emacs failed to autosave perfectly ordinary files because it
5596 couldn't handle some ange-ftp'd file. */
5598 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5599 FOR_EACH_LIVE_BUFFER (tail
, buf
)
5603 /* Record all the buffers that have auto save mode
5604 in the special file that lists them. For each of these buffers,
5605 Record visited name (if any) and auto save name. */
5606 if (STRINGP (BVAR (b
, auto_save_file_name
))
5607 && stream
!= NULL
&& do_handled_files
== 0)
5610 if (!NILP (BVAR (b
, filename
)))
5612 fwrite (SDATA (BVAR (b
, filename
)), 1,
5613 SBYTES (BVAR (b
, filename
)), stream
);
5615 putc ('\n', stream
);
5616 fwrite (SDATA (BVAR (b
, auto_save_file_name
)), 1,
5617 SBYTES (BVAR (b
, auto_save_file_name
)), stream
);
5618 putc ('\n', stream
);
5622 if (!NILP (current_only
)
5623 && b
!= current_buffer
)
5626 /* Don't auto-save indirect buffers.
5627 The base buffer takes care of it. */
5631 /* Check for auto save enabled
5632 and file changed since last auto save
5633 and file changed since last real save. */
5634 if (STRINGP (BVAR (b
, auto_save_file_name
))
5635 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5636 && BUF_AUTOSAVE_MODIFF (b
) < BUF_MODIFF (b
)
5637 /* -1 means we've turned off autosaving for a while--see below. */
5638 && XINT (BVAR (b
, save_length
)) >= 0
5639 && (do_handled_files
5640 || NILP (Ffind_file_name_handler (BVAR (b
, auto_save_file_name
),
5643 struct timespec before_time
= current_timespec ();
5644 struct timespec after_time
;
5646 /* If we had a failure, don't try again for 20 minutes. */
5647 if (b
->auto_save_failure_time
> 0
5648 && before_time
.tv_sec
- b
->auto_save_failure_time
< 1200)
5651 set_buffer_internal (b
);
5652 if (NILP (Vauto_save_include_big_deletions
)
5653 && (XFASTINT (BVAR (b
, save_length
)) * 10
5654 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5655 /* A short file is likely to change a large fraction;
5656 spare the user annoying messages. */
5657 && XFASTINT (BVAR (b
, save_length
)) > 5000
5658 /* These messages are frequent and annoying for `*mail*'. */
5659 && !EQ (BVAR (b
, filename
), Qnil
)
5660 && NILP (no_message
))
5662 /* It has shrunk too much; turn off auto-saving here. */
5663 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5664 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5666 minibuffer_auto_raise
= 0;
5667 /* Turn off auto-saving until there's a real save,
5668 and prevent any more warnings. */
5669 XSETINT (BVAR (b
, save_length
), -1);
5670 Fsleep_for (make_number (1), Qnil
);
5673 if (!auto_saved
&& NILP (no_message
))
5674 message1 ("Auto-saving...");
5675 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5677 BUF_AUTOSAVE_MODIFF (b
) = BUF_MODIFF (b
);
5678 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5679 set_buffer_internal (old
);
5681 after_time
= current_timespec ();
5683 /* If auto-save took more than 60 seconds,
5684 assume it was an NFS failure that got a timeout. */
5685 if (after_time
.tv_sec
- before_time
.tv_sec
> 60)
5686 b
->auto_save_failure_time
= after_time
.tv_sec
;
5690 /* Prevent another auto save till enough input events come in. */
5691 record_auto_save ();
5693 if (auto_saved
&& NILP (no_message
))
5697 /* If we are going to restore an old message,
5698 give time to read ours. */
5699 sit_for (make_number (1), 0, 0);
5702 else if (!auto_save_error_occurred
)
5703 /* Don't overwrite the error message if an error occurred.
5704 If we displayed a message and then restored a state
5705 with no message, leave a "done" message on the screen. */
5706 message1 ("Auto-saving...done");
5711 /* This restores the message-stack status. */
5712 unbind_to (count
, Qnil
);
5716 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5717 Sset_buffer_auto_saved
, 0, 0, 0,
5718 doc
: /* Mark current buffer as auto-saved with its current text.
5719 No auto-save file will be written until the buffer changes again. */)
5722 /* FIXME: This should not be called in indirect buffers, since
5723 they're not autosaved. */
5724 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
5725 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5726 current_buffer
->auto_save_failure_time
= 0;
5730 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5731 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5732 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5735 current_buffer
->auto_save_failure_time
= 0;
5739 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5741 doc
: /* Return t if current buffer has been auto-saved recently.
5742 More precisely, if it has been auto-saved since last read from or saved
5743 in the visited file. If the buffer has no visited file,
5744 then any auto-save counts as "recent". */)
5747 /* FIXME: maybe we should return nil for indirect buffers since
5748 they're never autosaved. */
5749 return (SAVE_MODIFF
< BUF_AUTOSAVE_MODIFF (current_buffer
) ? Qt
: Qnil
);
5752 /* Reading and completing file names */
5754 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5755 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5756 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5757 The return value is only relevant for a call to `read-file-name' that happens
5758 before any other event (mouse or keypress) is handled. */)
5761 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) \
5762 || defined (HAVE_NS)
5763 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5766 && window_system_available (SELECTED_FRAME ()))
5775 realmask
= umask (0);
5778 valid_timestamp_file_system
= 0;
5780 /* fsync can be a significant performance hit. Often it doesn't
5781 suffice to make the file-save operation survive a crash. For
5782 batch scripts, which are typically part of larger shell commands
5783 that don't fsync other files, its effect on performance can be
5784 significant so its utility is particularly questionable.
5785 Hence, for now by default fsync is used only when interactive.
5787 For more on why fsync often fails to work on today's hardware, see:
5788 Zheng M et al. Understanding the robustness of SSDs under power fault.
5789 11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84
5790 http://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf
5792 For more on why fsync does not suffice even if it works properly, see:
5793 Roche X. Necessary step(s) to synchronize filename operations on disk.
5794 Austin Group Defect 672, 2013-03-19
5795 http://austingroupbugs.net/view.php?id=672 */
5796 write_region_inhibit_fsync
= noninteractive
;
5800 syms_of_fileio (void)
5802 DEFSYM (Qoperations
, "operations");
5803 DEFSYM (Qexpand_file_name
, "expand-file-name");
5804 DEFSYM (Qsubstitute_in_file_name
, "substitute-in-file-name");
5805 DEFSYM (Qdirectory_file_name
, "directory-file-name");
5806 DEFSYM (Qfile_name_directory
, "file-name-directory");
5807 DEFSYM (Qfile_name_nondirectory
, "file-name-nondirectory");
5808 DEFSYM (Qunhandled_file_name_directory
, "unhandled-file-name-directory");
5809 DEFSYM (Qfile_name_as_directory
, "file-name-as-directory");
5810 DEFSYM (Qcopy_file
, "copy-file");
5811 DEFSYM (Qmake_directory_internal
, "make-directory-internal");
5812 DEFSYM (Qmake_directory
, "make-directory");
5813 DEFSYM (Qdelete_directory_internal
, "delete-directory-internal");
5814 DEFSYM (Qdelete_file
, "delete-file");
5815 DEFSYM (Qrename_file
, "rename-file");
5816 DEFSYM (Qadd_name_to_file
, "add-name-to-file");
5817 DEFSYM (Qmake_symbolic_link
, "make-symbolic-link");
5818 DEFSYM (Qfile_exists_p
, "file-exists-p");
5819 DEFSYM (Qfile_executable_p
, "file-executable-p");
5820 DEFSYM (Qfile_readable_p
, "file-readable-p");
5821 DEFSYM (Qfile_writable_p
, "file-writable-p");
5822 DEFSYM (Qfile_symlink_p
, "file-symlink-p");
5823 DEFSYM (Qaccess_file
, "access-file");
5824 DEFSYM (Qfile_directory_p
, "file-directory-p");
5825 DEFSYM (Qfile_regular_p
, "file-regular-p");
5826 DEFSYM (Qfile_accessible_directory_p
, "file-accessible-directory-p");
5827 DEFSYM (Qfile_modes
, "file-modes");
5828 DEFSYM (Qset_file_modes
, "set-file-modes");
5829 DEFSYM (Qset_file_times
, "set-file-times");
5830 DEFSYM (Qfile_selinux_context
, "file-selinux-context");
5831 DEFSYM (Qset_file_selinux_context
, "set-file-selinux-context");
5832 DEFSYM (Qfile_acl
, "file-acl");
5833 DEFSYM (Qset_file_acl
, "set-file-acl");
5834 DEFSYM (Qfile_newer_than_file_p
, "file-newer-than-file-p");
5835 DEFSYM (Qinsert_file_contents
, "insert-file-contents");
5836 DEFSYM (Qwrite_region
, "write-region");
5837 DEFSYM (Qverify_visited_file_modtime
, "verify-visited-file-modtime");
5838 DEFSYM (Qset_visited_file_modtime
, "set-visited-file-modtime");
5839 DEFSYM (Qauto_save_coding
, "auto-save-coding");
5841 DEFSYM (Qfile_name_history
, "file-name-history");
5842 Fset (Qfile_name_history
, Qnil
);
5844 DEFSYM (Qfile_error
, "file-error");
5845 DEFSYM (Qfile_already_exists
, "file-already-exists");
5846 DEFSYM (Qfile_date_error
, "file-date-error");
5847 DEFSYM (Qfile_notify_error
, "file-notify-error");
5848 DEFSYM (Qexcl
, "excl");
5850 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system
,
5851 doc
: /* Coding system for encoding file names.
5852 If it is nil, `default-file-name-coding-system' (which see) is used.
5854 On MS-Windows, the value of this variable is largely ignored if
5855 \`w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5856 behaves as if file names were encoded in `utf-8'. */);
5857 Vfile_name_coding_system
= Qnil
;
5859 DEFVAR_LISP ("default-file-name-coding-system",
5860 Vdefault_file_name_coding_system
,
5861 doc
: /* Default coding system for encoding file names.
5862 This variable is used only when `file-name-coding-system' is nil.
5864 This variable is set/changed by the command `set-language-environment'.
5865 User should not set this variable manually,
5866 instead use `file-name-coding-system' to get a constant encoding
5867 of file names regardless of the current language environment.
5869 On MS-Windows, the value of this variable is largely ignored if
5870 \`w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5871 behaves as if file names were encoded in `utf-8'. */);
5872 Vdefault_file_name_coding_system
= Qnil
;
5874 DEFSYM (Qformat_decode
, "format-decode");
5875 DEFSYM (Qformat_annotate_function
, "format-annotate-function");
5876 DEFSYM (Qafter_insert_file_set_coding
, "after-insert-file-set-coding");
5877 DEFSYM (Qcar_less_than_car
, "car-less-than-car");
5879 Fput (Qfile_error
, Qerror_conditions
,
5880 Fpurecopy (list2 (Qfile_error
, Qerror
)));
5881 Fput (Qfile_error
, Qerror_message
,
5882 build_pure_c_string ("File error"));
5884 Fput (Qfile_already_exists
, Qerror_conditions
,
5885 Fpurecopy (list3 (Qfile_already_exists
, Qfile_error
, Qerror
)));
5886 Fput (Qfile_already_exists
, Qerror_message
,
5887 build_pure_c_string ("File already exists"));
5889 Fput (Qfile_date_error
, Qerror_conditions
,
5890 Fpurecopy (list3 (Qfile_date_error
, Qfile_error
, Qerror
)));
5891 Fput (Qfile_date_error
, Qerror_message
,
5892 build_pure_c_string ("Cannot set file date"));
5894 Fput (Qfile_notify_error
, Qerror_conditions
,
5895 Fpurecopy (list3 (Qfile_notify_error
, Qfile_error
, Qerror
)));
5896 Fput (Qfile_notify_error
, Qerror_message
,
5897 build_pure_c_string ("File notification error"));
5899 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist
,
5900 doc
: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
5901 If a file name matches REGEXP, all I/O on that file is done by calling
5902 HANDLER. If a file name matches more than one handler, the handler
5903 whose match starts last in the file name gets precedence. The
5904 function `find-file-name-handler' checks this list for a handler for
5907 HANDLER should be a function. The first argument given to it is the
5908 name of the I/O primitive to be handled; the remaining arguments are
5909 the arguments that were passed to that primitive. For example, if you
5910 do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
5911 HANDLER is called like this:
5913 (funcall HANDLER 'file-exists-p FILENAME)
5915 Note that HANDLER must be able to handle all I/O primitives; if it has
5916 nothing special to do for a primitive, it should reinvoke the
5917 primitive to handle the operation \"the usual way\".
5918 See Info node `(elisp)Magic File Names' for more details. */);
5919 Vfile_name_handler_alist
= Qnil
;
5921 DEFVAR_LISP ("set-auto-coding-function",
5922 Vset_auto_coding_function
,
5923 doc
: /* If non-nil, a function to call to decide a coding system of file.
5924 Two arguments are passed to this function: the file name
5925 and the length of a file contents following the point.
5926 This function should return a coding system to decode the file contents.
5927 It should check the file name against `auto-coding-alist'.
5928 If no coding system is decided, it should check a coding system
5929 specified in the heading lines with the format:
5930 -*- ... coding: CODING-SYSTEM; ... -*-
5931 or local variable spec of the tailing lines with `coding:' tag. */);
5932 Vset_auto_coding_function
= Qnil
;
5934 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions
,
5935 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
5936 Each is passed one argument, the number of characters inserted,
5937 with point at the start of the inserted text. Each function
5938 should leave point the same, and return the new character count.
5939 If `insert-file-contents' is intercepted by a handler from
5940 `file-name-handler-alist', that handler is responsible for calling the
5941 functions in `after-insert-file-functions' if appropriate. */);
5942 Vafter_insert_file_functions
= Qnil
;
5944 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions
,
5945 doc
: /* A list of functions to be called at the start of `write-region'.
5946 Each is passed two arguments, START and END as for `write-region'.
5947 These are usually two numbers but not always; see the documentation
5948 for `write-region'. The function should return a list of pairs
5949 of the form (POSITION . STRING), consisting of strings to be effectively
5950 inserted at the specified positions of the file being written (1 means to
5951 insert before the first byte written). The POSITIONs must be sorted into
5954 If there are several annotation functions, the lists returned by these
5955 functions are merged destructively. As each annotation function runs,
5956 the variable `write-region-annotations-so-far' contains a list of all
5957 annotations returned by previous annotation functions.
5959 An annotation function can return with a different buffer current.
5960 Doing so removes the annotations returned by previous functions, and
5961 resets START and END to `point-min' and `point-max' of the new buffer.
5963 After `write-region' completes, Emacs calls the function stored in
5964 `write-region-post-annotation-function', once for each buffer that was
5965 current when building the annotations (i.e., at least once), with that
5966 buffer current. */);
5967 Vwrite_region_annotate_functions
= Qnil
;
5968 DEFSYM (Qwrite_region_annotate_functions
, "write-region-annotate-functions");
5970 DEFVAR_LISP ("write-region-post-annotation-function",
5971 Vwrite_region_post_annotation_function
,
5972 doc
: /* Function to call after `write-region' completes.
5973 The function is called with no arguments. If one or more of the
5974 annotation functions in `write-region-annotate-functions' changed the
5975 current buffer, the function stored in this variable is called for
5976 each of those additional buffers as well, in addition to the original
5977 buffer. The relevant buffer is current during each function call. */);
5978 Vwrite_region_post_annotation_function
= Qnil
;
5979 staticpro (&Vwrite_region_annotation_buffers
);
5981 DEFVAR_LISP ("write-region-annotations-so-far",
5982 Vwrite_region_annotations_so_far
,
5983 doc
: /* When an annotation function is called, this holds the previous annotations.
5984 These are the annotations made by other annotation functions
5985 that were already called. See also `write-region-annotate-functions'. */);
5986 Vwrite_region_annotations_so_far
= Qnil
;
5988 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers
,
5989 doc
: /* A list of file name handlers that temporarily should not be used.
5990 This applies only to the operation `inhibit-file-name-operation'. */);
5991 Vinhibit_file_name_handlers
= Qnil
;
5993 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation
,
5994 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5995 Vinhibit_file_name_operation
= Qnil
;
5997 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name
,
5998 doc
: /* File name in which we write a list of all auto save file names.
5999 This variable is initialized automatically from `auto-save-list-file-prefix'
6000 shortly after Emacs reads your init file, if you have not yet given it
6001 a non-nil value. */);
6002 Vauto_save_list_file_name
= Qnil
;
6004 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name
,
6005 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
6006 Normally auto-save files are written under other names. */);
6007 Vauto_save_visited_file_name
= Qnil
;
6009 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions
,
6010 doc
: /* If non-nil, auto-save even if a large part of the text is deleted.
6011 If nil, deleting a substantial portion of the text disables auto-save
6012 in the buffer; this is the default behavior, because the auto-save
6013 file is usually more useful if it contains the deleted text. */);
6014 Vauto_save_include_big_deletions
= Qnil
;
6016 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync
,
6017 doc
: /* Non-nil means don't call fsync in `write-region'.
6018 This variable affects calls to `write-region' as well as save commands.
6019 Setting this to nil may avoid data loss if the system loses power or
6020 the operating system crashes. By default, it is non-nil in batch mode. */);
6021 write_region_inhibit_fsync
= 0; /* See also `init_fileio' above. */
6023 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash
,
6024 doc
: /* Specifies whether to use the system's trash can.
6025 When non-nil, certain file deletion commands use the function
6026 `move-file-to-trash' instead of deleting files outright.
6027 This includes interactive calls to `delete-file' and
6028 `delete-directory' and the Dired deletion commands. */);
6029 delete_by_moving_to_trash
= 0;
6030 Qdelete_by_moving_to_trash
= intern_c_string ("delete-by-moving-to-trash");
6032 DEFSYM (Qmove_file_to_trash
, "move-file-to-trash");
6033 DEFSYM (Qcopy_directory
, "copy-directory");
6034 DEFSYM (Qdelete_directory
, "delete-directory");
6035 DEFSYM (Qsubstitute_env_in_file_name
, "substitute-env-in-file-name");
6037 defsubr (&Sfind_file_name_handler
);
6038 defsubr (&Sfile_name_directory
);
6039 defsubr (&Sfile_name_nondirectory
);
6040 defsubr (&Sunhandled_file_name_directory
);
6041 defsubr (&Sfile_name_as_directory
);
6042 defsubr (&Sdirectory_file_name
);
6043 defsubr (&Smake_temp_name
);
6044 defsubr (&Sexpand_file_name
);
6045 defsubr (&Ssubstitute_in_file_name
);
6046 defsubr (&Scopy_file
);
6047 defsubr (&Smake_directory_internal
);
6048 defsubr (&Sdelete_directory_internal
);
6049 defsubr (&Sdelete_file
);
6050 defsubr (&Srename_file
);
6051 defsubr (&Sadd_name_to_file
);
6052 defsubr (&Smake_symbolic_link
);
6053 defsubr (&Sfile_name_absolute_p
);
6054 defsubr (&Sfile_exists_p
);
6055 defsubr (&Sfile_executable_p
);
6056 defsubr (&Sfile_readable_p
);
6057 defsubr (&Sfile_writable_p
);
6058 defsubr (&Saccess_file
);
6059 defsubr (&Sfile_symlink_p
);
6060 defsubr (&Sfile_directory_p
);
6061 defsubr (&Sfile_accessible_directory_p
);
6062 defsubr (&Sfile_regular_p
);
6063 defsubr (&Sfile_modes
);
6064 defsubr (&Sset_file_modes
);
6065 defsubr (&Sset_file_times
);
6066 defsubr (&Sfile_selinux_context
);
6067 defsubr (&Sfile_acl
);
6068 defsubr (&Sset_file_acl
);
6069 defsubr (&Sset_file_selinux_context
);
6070 defsubr (&Sset_default_file_modes
);
6071 defsubr (&Sdefault_file_modes
);
6072 defsubr (&Sfile_newer_than_file_p
);
6073 defsubr (&Sinsert_file_contents
);
6074 defsubr (&Swrite_region
);
6075 defsubr (&Scar_less_than_car
);
6076 defsubr (&Sverify_visited_file_modtime
);
6077 defsubr (&Svisited_file_modtime
);
6078 defsubr (&Sset_visited_file_modtime
);
6079 defsubr (&Sdo_auto_save
);
6080 defsubr (&Sset_buffer_auto_saved
);
6081 defsubr (&Sclear_buffer_auto_save_failure
);
6082 defsubr (&Srecent_auto_save_p
);
6084 defsubr (&Snext_read_file_uses_dialog_p
);
6087 defsubr (&Sunix_sync
);