1 /* File IO for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-2013 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"
53 #include "dispextern.h"
60 #endif /* not WINDOWSNT */
64 #include <sys/param.h>
68 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
69 redirector allows the six letters between 'Z' and 'a' as well. */
71 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
74 #define IS_DRIVE(x) c_isalpha (x)
76 /* Need to lower-case the drive letter, or else expanded
77 filenames will sometimes compare unequal, because
78 `expand-file-name' doesn't always down-case the drive letter. */
79 #define DRIVE_LETTER(x) c_tolower (x)
84 #include <allocator.h>
85 #include <careadlinkat.h>
86 #include <stat-time.h>
94 /* True during writing of auto-save files. */
95 static bool auto_saving
;
97 /* Nonzero umask during creation of auto-save directories. */
98 static mode_t auto_saving_dir_umask
;
100 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
101 a new file with the same mode as the original. */
102 static mode_t auto_save_mode_bits
;
104 /* Set by auto_save_1 if an error occurred during the last auto-save. */
105 static bool auto_save_error_occurred
;
107 /* If VALID_TIMESTAMP_FILE_SYSTEM, then TIMESTAMP_FILE_SYSTEM is the device
108 number of a file system where time stamps were observed to to work. */
109 static bool valid_timestamp_file_system
;
110 static dev_t timestamp_file_system
;
112 /* The symbol bound to coding-system-for-read when
113 insert-file-contents is called for recovering a file. This is not
114 an actual coding system name, but just an indicator to tell
115 insert-file-contents to use `emacs-mule' with a special flag for
116 auto saving and recovering a file. */
117 static Lisp_Object Qauto_save_coding
;
119 /* Property name of a file name handler,
120 which gives a list of operations it handles.. */
121 static Lisp_Object Qoperations
;
123 /* Lisp functions for translating file formats. */
124 static Lisp_Object Qformat_decode
, Qformat_annotate_function
;
126 /* Lisp function for setting buffer-file-coding-system and the
127 multibyteness of the current buffer after inserting a file. */
128 static Lisp_Object Qafter_insert_file_set_coding
;
130 static Lisp_Object Qwrite_region_annotate_functions
;
131 /* Each time an annotation function changes the buffer, the new buffer
133 static Lisp_Object Vwrite_region_annotation_buffers
;
135 static Lisp_Object Qdelete_by_moving_to_trash
;
137 /* Lisp function for moving files to trash. */
138 static Lisp_Object Qmove_file_to_trash
;
140 /* Lisp function for recursively copying directories. */
141 static Lisp_Object Qcopy_directory
;
143 /* Lisp function for recursively deleting directories. */
144 static Lisp_Object Qdelete_directory
;
146 static Lisp_Object Qsubstitute_env_in_file_name
;
151 Lisp_Object Qfile_error
, Qfile_notify_error
;
152 static Lisp_Object Qfile_already_exists
, Qfile_date_error
;
153 static Lisp_Object Qexcl
;
154 Lisp_Object Qfile_name_history
;
156 static Lisp_Object Qcar_less_than_car
;
158 static bool a_write (int, Lisp_Object
, ptrdiff_t, ptrdiff_t,
159 Lisp_Object
*, struct coding_system
*);
160 static bool e_write (int, Lisp_Object
, ptrdiff_t, ptrdiff_t,
161 struct coding_system
*);
164 /* Return true if FILENAME exists. */
167 check_existing (const char *filename
)
169 return faccessat (AT_FDCWD
, filename
, F_OK
, AT_EACCESS
) == 0;
172 /* Return true if file FILENAME exists and can be executed. */
175 check_executable (char *filename
)
177 return faccessat (AT_FDCWD
, filename
, X_OK
, AT_EACCESS
) == 0;
180 /* Return true if file FILENAME exists and can be accessed
181 according to AMODE, which should include W_OK.
182 On failure, return false and set errno. */
185 check_writable (const char *filename
, int amode
)
188 /* FIXME: an faccessat implementation should be added to the
189 DOS/Windows ports and this #ifdef branch should be removed. */
191 if (stat (filename
, &st
) < 0)
194 return (st
.st_mode
& S_IWRITE
|| S_ISDIR (st
.st_mode
));
195 #else /* not MSDOS */
196 bool res
= faccessat (AT_FDCWD
, filename
, amode
, AT_EACCESS
) == 0;
198 /* faccessat may have returned failure because Cygwin couldn't
199 determine the file's UID or GID; if so, we return success. */
202 int faccessat_errno
= errno
;
204 if (stat (filename
, &st
) < 0)
206 res
= (st
.st_uid
== -1 || st
.st_gid
== -1);
207 errno
= faccessat_errno
;
211 #endif /* not MSDOS */
214 /* Signal a file-access failure. STRING describes the failure,
215 NAME the file involved, and ERRORNO the errno value.
217 If NAME is neither null nor a pair, package it up as a singleton
218 list before reporting it; this saves report_file_errno's caller the
219 trouble of preserving errno before calling list1. */
222 report_file_errno (char const *string
, Lisp_Object name
, int errorno
)
224 Lisp_Object data
= CONSP (name
) || NILP (name
) ? name
: list1 (name
);
225 Lisp_Object errstring
;
228 synchronize_system_messages_locale ();
229 str
= strerror (errorno
);
230 errstring
= code_convert_string_norecord (build_unibyte_string (str
),
231 Vlocale_coding_system
, 0);
237 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
240 /* System error messages are capitalized. Downcase the initial
241 unless it is followed by a slash. (The slash case caters to
242 error messages that begin with "I/O" or, in German, "E/A".) */
243 if (STRING_MULTIBYTE (errstring
)
244 && ! EQ (Faref (errstring
, make_number (1)), make_number ('/')))
248 str
= SSDATA (errstring
);
249 c
= STRING_CHAR ((unsigned char *) str
);
250 Faset (errstring
, make_number (0), make_number (downcase (c
)));
253 xsignal (Qfile_error
,
254 Fcons (build_string (string
), Fcons (errstring
, data
)));
258 /* Signal a file-access failure that set errno. STRING describes the
259 failure, NAME the file involved. When invoking this function, take
260 care to not use arguments such as build_string ("foo") that involve
261 side effects that may set errno. */
264 report_file_error (char const *string
, Lisp_Object name
)
266 report_file_errno (string
, name
, errno
);
270 close_file_unwind (int fd
)
276 fclose_unwind (void *arg
)
282 /* Restore point, having saved it as a marker. */
285 restore_point_unwind (Lisp_Object location
)
287 Fgoto_char (location
);
288 unchain_marker (XMARKER (location
));
292 static Lisp_Object Qexpand_file_name
;
293 static Lisp_Object Qsubstitute_in_file_name
;
294 static Lisp_Object Qdirectory_file_name
;
295 static Lisp_Object Qfile_name_directory
;
296 static Lisp_Object Qfile_name_nondirectory
;
297 static Lisp_Object Qunhandled_file_name_directory
;
298 static Lisp_Object Qfile_name_as_directory
;
299 static Lisp_Object Qcopy_file
;
300 static Lisp_Object Qmake_directory_internal
;
301 static Lisp_Object Qmake_directory
;
302 static Lisp_Object Qdelete_directory_internal
;
303 Lisp_Object Qdelete_file
;
304 static Lisp_Object Qrename_file
;
305 static Lisp_Object Qadd_name_to_file
;
306 static Lisp_Object Qmake_symbolic_link
;
307 Lisp_Object Qfile_exists_p
;
308 static Lisp_Object Qfile_executable_p
;
309 static Lisp_Object Qfile_readable_p
;
310 static Lisp_Object Qfile_writable_p
;
311 static Lisp_Object Qfile_symlink_p
;
312 static Lisp_Object Qaccess_file
;
313 Lisp_Object Qfile_directory_p
;
314 static Lisp_Object Qfile_regular_p
;
315 static Lisp_Object Qfile_accessible_directory_p
;
316 static Lisp_Object Qfile_modes
;
317 static Lisp_Object Qset_file_modes
;
318 static Lisp_Object Qset_file_times
;
319 static Lisp_Object Qfile_selinux_context
;
320 static Lisp_Object Qset_file_selinux_context
;
321 static Lisp_Object Qfile_acl
;
322 static Lisp_Object Qset_file_acl
;
323 static Lisp_Object Qfile_newer_than_file_p
;
324 Lisp_Object Qinsert_file_contents
;
325 static Lisp_Object Qchoose_write_coding_system
;
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
, 0);
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
), 1);
475 if (!NILP (Vw32_downcase_file_names
))
476 tem_fn
= Fdowncase (tem_fn
);
481 dostounix_filename (beg
, 0);
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
, multibyte
);
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
, multibyte
);
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
)
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 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
771 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
772 if (!STRING_MULTIBYTE (prefix
))
773 STRING_SET_UNIBYTE (val
);
775 memcpy (data
, SSDATA (prefix
), len
);
778 memcpy (p
, pidbuf
, pidlen
);
781 /* Here we try to minimize useless stat'ing when this function is
782 invoked many times successively with the same PREFIX. We achieve
783 this by initializing count to a random value, and incrementing it
786 We don't want make-temp-name to be called while dumping,
787 because then make_temp_name_count_initialized_p would get set
788 and then make_temp_name_count would not be set when Emacs starts. */
790 if (!make_temp_name_count_initialized_p
)
792 make_temp_name_count
= time (NULL
);
793 make_temp_name_count_initialized_p
= 1;
798 unsigned num
= make_temp_name_count
;
800 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
801 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
802 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
804 /* Poor man's congruential RN generator. Replace with
805 ++make_temp_name_count for debugging. */
806 make_temp_name_count
+= 25229;
807 make_temp_name_count
%= 225307;
809 if (!check_existing (data
))
811 /* We want to return only if errno is ENOENT. */
815 /* The error here is dubious, but there is little else we
816 can do. The alternatives are to return nil, which is
817 as bad as (and in many cases worse than) throwing the
818 error, or to ignore the error, which will likely result
819 in looping through 225307 stat's, which is not only
820 dog-slow, but also useless since eventually nil would
821 have to be returned anyway. */
822 report_file_error ("Cannot create temporary name for prefix",
830 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
831 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
832 The Emacs process number forms part of the result,
833 so there is no danger of generating a name being used by another process.
835 In addition, this function makes an attempt to choose a name
836 which has no existing file. To make this work,
837 PREFIX should be an absolute file name.
839 There is a race condition between calling `make-temp-name' and creating the
840 file which opens all kinds of security holes. For that reason, you should
841 probably use `make-temp-file' instead, except in three circumstances:
843 * If you are creating the file in the user's home directory.
844 * If you are creating a directory rather than an ordinary file.
845 * If you are taking special precautions as `make-temp-file' does. */)
848 return make_temp_name (prefix
, 0);
853 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
854 doc
: /* Convert filename NAME to absolute, and canonicalize it.
855 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
856 \(does not start with slash or tilde); both the directory name and
857 a directory's file name are accepted. If DEFAULT-DIRECTORY is nil or
858 missing, the current buffer's value of `default-directory' is used.
859 NAME should be a string that is a valid file name for the underlying
861 File name components that are `.' are removed, and
862 so are file name components followed by `..', along with the `..' itself;
863 note that these simplifications are done without checking the resulting
864 file names in the file system.
865 Multiple consecutive slashes are collapsed into a single slash,
866 except at the beginning of the file name when they are significant (e.g.,
867 UNC file names on MS-Windows.)
868 An initial `~/' expands to your home directory.
869 An initial `~USER/' expands to USER's home directory.
870 See also the function `substitute-in-file-name'.
872 For technical reasons, this function can return correct but
873 non-intuitive results for the root directory; for instance,
874 \(expand-file-name ".." "/") returns "/..". For this reason, use
875 \(directory-file-name (file-name-directory dirname)) to traverse a
876 filesystem tree, not (expand-file-name ".." dirname). */)
877 (Lisp_Object name
, Lisp_Object default_directory
)
879 /* These point to SDATA and need to be careful with string-relocation
880 during GC (via DECODE_FILE). */
883 /* This should only point to alloca'd data. */
890 bool collapse_newdir
= 1;
894 Lisp_Object handler
, result
, handled_name
;
901 /* If the file name has special constructs in it,
902 call the corresponding file handler. */
903 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
906 handled_name
= call3 (handler
, Qexpand_file_name
,
907 name
, default_directory
);
908 if (STRINGP (handled_name
))
910 error ("Invalid handler in `file-name-handler-alist'");
914 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
915 if (NILP (default_directory
))
916 default_directory
= BVAR (current_buffer
, directory
);
917 if (! STRINGP (default_directory
))
920 /* "/" is not considered a root directory on DOS_NT, so using "/"
921 here causes an infinite recursion in, e.g., the following:
923 (let (default-directory)
924 (expand-file-name "a"))
926 To avoid this, we set default_directory to the root of the
928 default_directory
= build_string (emacs_root_dir ());
930 default_directory
= build_string ("/");
934 if (!NILP (default_directory
))
936 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
939 handled_name
= call3 (handler
, Qexpand_file_name
,
940 name
, default_directory
);
941 if (STRINGP (handled_name
))
943 error ("Invalid handler in `file-name-handler-alist'");
948 char *o
= SSDATA (default_directory
);
950 /* Make sure DEFAULT_DIRECTORY is properly expanded.
951 It would be better to do this down below where we actually use
952 default_directory. Unfortunately, calling Fexpand_file_name recursively
953 could invoke GC, and the strings might be relocated. This would
954 be annoying because we have pointers into strings lying around
955 that would need adjusting, and people would add new pointers to
956 the code and forget to adjust them, resulting in intermittent bugs.
957 Putting this call here avoids all that crud.
959 The EQ test avoids infinite recursion. */
960 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
961 /* Save time in some common cases - as long as default_directory
962 is not relative, it can be canonicalized with name below (if it
963 is needed at all) without requiring it to be expanded now. */
965 /* Detect MSDOS file names with drive specifiers. */
966 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
967 && IS_DIRECTORY_SEP (o
[2]))
969 /* Detect Windows file names in UNC format. */
970 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
972 #else /* not DOS_NT */
973 /* Detect Unix absolute file names (/... alone is not absolute on
975 && ! (IS_DIRECTORY_SEP (o
[0]))
976 #endif /* not DOS_NT */
982 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
986 multibyte
= STRING_MULTIBYTE (name
);
987 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
990 default_directory
= string_to_multibyte (default_directory
);
993 name
= string_to_multibyte (name
);
999 if (!NILP (Vw32_downcase_file_names
))
1000 default_directory
= Fdowncase (default_directory
);
1003 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
1004 nm
= xlispstrdupa (name
);
1007 /* Note if special escape prefix is present, but remove for now. */
1008 if (nm
[0] == '/' && nm
[1] == ':')
1014 /* Find and remove drive specifier if present; this makes nm absolute
1015 even if the rest of the name appears to be relative. Only look for
1016 drive specifier at the beginning. */
1017 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1019 drive
= (unsigned char) nm
[0];
1024 /* If we see "c://somedir", we want to strip the first slash after the
1025 colon when stripping the drive letter. Otherwise, this expands to
1027 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1030 /* Discard any previous drive specifier if nm is now in UNC format. */
1031 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1035 #endif /* WINDOWSNT */
1038 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1039 none are found, we can probably return right away. We will avoid
1040 allocating a new string if name is already fully expanded. */
1042 IS_DIRECTORY_SEP (nm
[0])
1044 && drive
&& !is_escaped
1047 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1051 /* If it turns out that the filename we want to return is just a
1052 suffix of FILENAME, we don't need to go through and edit
1053 things; we just need to construct a new string using data
1054 starting at the middle of FILENAME. If we set LOSE, that
1055 means we've discovered that we can't do that cool trick. */
1061 /* Since we know the name is absolute, we can assume that each
1062 element starts with a "/". */
1064 /* "." and ".." are hairy. */
1065 if (IS_DIRECTORY_SEP (p
[0])
1067 && (IS_DIRECTORY_SEP (p
[2])
1069 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1072 /* Replace multiple slashes with a single one, except
1073 leave leading "//" alone. */
1074 else if (IS_DIRECTORY_SEP (p
[0])
1075 && IS_DIRECTORY_SEP (p
[1])
1076 && (p
!= nm
|| IS_DIRECTORY_SEP (p
[2])))
1083 /* Make sure directories are all separated with /, but
1084 avoid allocation of a new string when not required. */
1085 dostounix_filename (nm
, multibyte
);
1087 if (IS_DIRECTORY_SEP (nm
[1]))
1089 if (strcmp (nm
, SSDATA (name
)) != 0)
1090 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1094 /* Drive must be set, so this is okay. */
1095 if (strcmp (nm
- 2, SSDATA (name
)) != 0)
1099 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1100 temp
[0] = DRIVE_LETTER (drive
);
1101 name
= concat2 (build_string (temp
), name
);
1104 if (!NILP (Vw32_downcase_file_names
))
1105 name
= Fdowncase (name
);
1108 #else /* not DOS_NT */
1109 if (strcmp (nm
, SSDATA (name
)) == 0)
1111 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1112 #endif /* not DOS_NT */
1116 /* At this point, nm might or might not be an absolute file name. We
1117 need to expand ~ or ~user if present, otherwise prefix nm with
1118 default_directory if nm is not absolute, and finally collapse /./
1119 and /foo/../ sequences.
1121 We set newdir to be the appropriate prefix if one is needed:
1122 - the relevant user directory if nm starts with ~ or ~user
1123 - the specified drive's working dir (DOS/NT only) if nm does not
1125 - the value of default_directory.
1127 Note that these prefixes are not guaranteed to be absolute (except
1128 for the working dir of a drive). Therefore, to ensure we always
1129 return an absolute name, if the final prefix is not absolute we
1130 append it to the current working directory. */
1134 if (nm
[0] == '~') /* prefix ~ */
1136 if (IS_DIRECTORY_SEP (nm
[1])
1137 || nm
[1] == 0) /* ~ by itself */
1141 if (!(newdir
= egetenv ("HOME")))
1144 /* `egetenv' may return a unibyte string, which will bite us since
1145 we expect the directory to be multibyte. */
1146 tem
= build_string (newdir
);
1147 if (multibyte
&& !STRING_MULTIBYTE (tem
))
1149 hdir
= DECODE_FILE (tem
);
1150 newdir
= SSDATA (hdir
);
1153 collapse_newdir
= 0;
1156 else /* ~user/filename */
1159 for (p
= nm
; *p
&& !IS_DIRECTORY_SEP (*p
); p
++)
1161 o
= SAFE_ALLOCA (p
- nm
+ 1);
1162 memcpy (o
, nm
, p
- nm
);
1166 pw
= getpwnam (o
+ 1);
1172 newdir
= pw
->pw_dir
;
1173 /* `getpwnam' may return a unibyte string, which will
1174 bite us since we expect the directory to be
1176 tem
= build_string (newdir
);
1177 if (multibyte
&& !STRING_MULTIBYTE (tem
))
1179 hdir
= DECODE_FILE (tem
);
1180 newdir
= SSDATA (hdir
);
1184 collapse_newdir
= 0;
1188 /* If we don't find a user of that name, leave the name
1189 unchanged; don't move nm forward to p. */
1194 /* On DOS and Windows, nm is absolute if a drive name was specified;
1195 use the drive's current directory as the prefix if needed. */
1196 if (!newdir
&& drive
)
1198 /* Get default directory if needed to make nm absolute. */
1200 if (!IS_DIRECTORY_SEP (nm
[0]))
1202 adir
= alloca (MAXPATHLEN
+ 1);
1203 if (!getdefdir (c_toupper (drive
) - 'A' + 1, adir
))
1207 Lisp_Object tem
= build_string (adir
);
1209 tem
= DECODE_FILE (tem
);
1210 memcpy (adir
, SSDATA (tem
), SBYTES (tem
) + 1);
1215 /* Either nm starts with /, or drive isn't mounted. */
1217 adir
[0] = DRIVE_LETTER (drive
);
1226 /* Finally, if no prefix has been specified and nm is not absolute,
1227 then it must be expanded relative to default_directory. */
1231 /* /... alone is not absolute on DOS and Windows. */
1232 && !IS_DIRECTORY_SEP (nm
[0])
1235 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1239 newdir
= SSDATA (default_directory
);
1241 /* Note if special escape prefix is present, but remove for now. */
1242 if (newdir
[0] == '/' && newdir
[1] == ':')
1253 /* First ensure newdir is an absolute name. */
1255 /* Detect MSDOS file names with drive specifiers. */
1256 ! (IS_DRIVE (newdir
[0])
1257 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1259 /* Detect Windows file names in UNC format. */
1260 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1264 /* Effectively, let newdir be (expand-file-name newdir cwd).
1265 Because of the admonition against calling expand-file-name
1266 when we have pointers into lisp strings, we accomplish this
1267 indirectly by prepending newdir to nm if necessary, and using
1268 cwd (or the wd of newdir's drive) as the new newdir. */
1271 const int adir_size
= MAX_UTF8_PATH
;
1273 const int adir_size
= MAXPATHLEN
+ 1;
1276 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1278 drive
= (unsigned char) newdir
[0];
1281 if (!IS_DIRECTORY_SEP (nm
[0]))
1283 ptrdiff_t newlen
= strlen (newdir
);
1284 char *tmp
= alloca (newlen
+ file_name_as_directory_slop
1286 file_name_as_directory (tmp
, newdir
, newlen
, multibyte
);
1290 adir
= alloca (adir_size
);
1293 if (!getdefdir (c_toupper (drive
) - 'A' + 1, adir
))
1297 getcwd (adir
, adir_size
);
1300 Lisp_Object tem
= build_string (adir
);
1302 tem
= DECODE_FILE (tem
);
1303 memcpy (adir
, SSDATA (tem
), SBYTES (tem
) + 1);
1308 /* Strip off drive name from prefix, if present. */
1309 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1315 /* Keep only a prefix from newdir if nm starts with slash
1316 (//server/share for UNC, nothing otherwise). */
1317 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1320 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1322 char *adir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1324 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1326 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1339 /* Ignore any slash at the end of newdir, unless newdir is
1340 just "/" or "//". */
1341 length
= strlen (newdir
);
1342 while (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1343 && ! (length
== 2 && IS_DIRECTORY_SEP (newdir
[0])))
1349 /* Now concatenate the directory and name to new space in the stack frame. */
1350 tlen
= length
+ file_name_as_directory_slop
+ strlen (nm
) + 1;
1352 /* Reserve space for drive specifier and escape prefix, since either
1353 or both may need to be inserted. (The Microsoft x86 compiler
1354 produces incorrect code if the following two lines are combined.) */
1355 target
= alloca (tlen
+ 4);
1357 #else /* not DOS_NT */
1358 target
= SAFE_ALLOCA (tlen
);
1359 #endif /* not DOS_NT */
1364 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1367 /* If newdir is effectively "C:/", then the drive letter will have
1368 been stripped and newdir will be "/". Concatenating with an
1369 absolute directory in nm produces "//", which will then be
1370 incorrectly treated as a network share. Ignore newdir in
1371 this case (keeping the drive letter). */
1372 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1373 && newdir
[1] == '\0'))
1376 memcpy (target
, newdir
, length
);
1381 file_name_as_directory (target
, newdir
, length
, multibyte
);
1384 strcat (target
, nm
);
1386 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1394 if (!IS_DIRECTORY_SEP (*p
))
1398 else if (p
[1] == '.'
1399 && (IS_DIRECTORY_SEP (p
[2])
1402 /* If "/." is the entire filename, keep the "/". Otherwise,
1403 just delete the whole "/.". */
1404 if (o
== target
&& p
[2] == '\0')
1408 else if (p
[1] == '.' && p
[2] == '.'
1409 /* `/../' is the "superroot" on certain file systems.
1410 Turned off on DOS_NT systems because they have no
1411 "superroot" and because this causes us to produce
1412 file names like "d:/../foo" which fail file-related
1413 functions of the underlying OS. (To reproduce, try a
1414 long series of "../../" in default_directory, longer
1415 than the number of levels from the root.) */
1419 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1424 while (o
!= target
&& (--o
, !IS_DIRECTORY_SEP (*o
)))
1427 /* Don't go below server level in UNC filenames. */
1428 if (o
== target
+ 1 && IS_DIRECTORY_SEP (*o
)
1429 && IS_DIRECTORY_SEP (*target
))
1433 /* Keep initial / only if this is the whole name. */
1434 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1438 else if (IS_DIRECTORY_SEP (p
[1])
1439 && (p
!= target
|| IS_DIRECTORY_SEP (p
[2])))
1440 /* Collapse multiple "/", except leave leading "//" alone. */
1449 /* At last, set drive name. */
1451 /* Except for network file name. */
1452 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1453 #endif /* WINDOWSNT */
1455 if (!drive
) emacs_abort ();
1457 target
[0] = DRIVE_LETTER (drive
);
1460 /* Reinsert the escape prefix if required. */
1467 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1468 dostounix_filename (SSDATA (result
), multibyte
);
1470 if (!NILP (Vw32_downcase_file_names
))
1471 result
= Fdowncase (result
);
1474 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1475 #endif /* !DOS_NT */
1478 /* Again look to see if the file name has special constructs in it
1479 and perhaps call the corresponding file handler. This is needed
1480 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1481 the ".." component gives us "/user@host:/bar/../baz" which needs
1482 to be expanded again. */
1483 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1484 if (!NILP (handler
))
1486 handled_name
= call3 (handler
, Qexpand_file_name
,
1487 result
, default_directory
);
1488 if (! STRINGP (handled_name
))
1489 error ("Invalid handler in `file-name-handler-alist'");
1490 result
= handled_name
;
1498 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1499 This is the old version of expand-file-name, before it was thoroughly
1500 rewritten for Emacs 10.31. We leave this version here commented-out,
1501 because the code is very complex and likely to have subtle bugs. If
1502 bugs _are_ found, it might be of interest to look at the old code and
1503 see what did it do in the relevant situation.
1505 Don't remove this code: it's true that it will be accessible
1506 from the repository, but a few years from deletion, people will
1507 forget it is there. */
1509 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1510 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1511 "Convert FILENAME to absolute, and canonicalize it.\n\
1512 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1513 \(does not start with slash); if DEFAULT is nil or missing,\n\
1514 the current buffer's value of default-directory is used.\n\
1515 Filenames containing `.' or `..' as components are simplified;\n\
1516 initial `~/' expands to your home directory.\n\
1517 See also the function `substitute-in-file-name'.")
1519 Lisp_Object name
, defalt
;
1523 register unsigned char *newdir
, *p
, *o
;
1525 unsigned char *target
;
1528 CHECK_STRING (name
);
1531 /* If nm is absolute, flush ...// and detect /./ and /../.
1532 If no /./ or /../ we can return right away. */
1539 if (p
[0] == '/' && p
[1] == '/')
1541 if (p
[0] == '/' && p
[1] == '~')
1542 nm
= p
+ 1, lose
= 1;
1543 if (p
[0] == '/' && p
[1] == '.'
1544 && (p
[2] == '/' || p
[2] == 0
1545 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1551 if (nm
== SDATA (name
))
1553 return build_string (nm
);
1557 /* Now determine directory to start with and put it in NEWDIR. */
1561 if (nm
[0] == '~') /* prefix ~ */
1562 if (nm
[1] == '/' || nm
[1] == 0)/* ~/filename */
1564 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1565 newdir
= (unsigned char *) "";
1568 else /* ~user/filename */
1570 /* Get past ~ to user. */
1571 unsigned char *user
= nm
+ 1;
1572 /* Find end of name. */
1573 unsigned char *ptr
= (unsigned char *) strchr (user
, '/');
1574 ptrdiff_t len
= ptr
? ptr
- user
: strlen (user
);
1575 /* Copy the user name into temp storage. */
1576 o
= alloca (len
+ 1);
1577 memcpy (o
, user
, len
);
1580 /* Look up the user name. */
1582 pw
= (struct passwd
*) getpwnam (o
+ 1);
1585 error ("\"%s\" isn't a registered user", o
+ 1);
1587 newdir
= (unsigned char *) pw
->pw_dir
;
1589 /* Discard the user name from NM. */
1593 if (nm
[0] != '/' && !newdir
)
1596 defalt
= current_buffer
->directory
;
1597 CHECK_STRING (defalt
);
1598 newdir
= SDATA (defalt
);
1601 /* Now concatenate the directory and name to new space in the stack frame. */
1603 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1604 target
= alloca (tlen
);
1609 if (nm
[0] == 0 || nm
[0] == '/')
1610 strcpy (target
, newdir
);
1612 file_name_as_directory (target
, newdir
);
1615 strcat (target
, nm
);
1617 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1628 else if (!strncmp (p
, "//", 2)
1634 else if (p
[0] == '/' && p
[1] == '.'
1635 && (p
[2] == '/' || p
[2] == 0))
1637 else if (!strncmp (p
, "/..", 3)
1638 /* `/../' is the "superroot" on certain file systems. */
1640 && (p
[3] == '/' || p
[3] == 0))
1642 while (o
!= target
&& *--o
!= '/')
1644 if (o
== target
&& *o
== '/')
1654 return make_string (target
, o
- target
);
1658 /* If /~ or // appears, discard everything through first slash. */
1660 file_name_absolute_p (const char *filename
)
1663 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
1665 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
1666 && IS_DIRECTORY_SEP (filename
[2]))
1672 search_embedded_absfilename (char *nm
, char *endp
)
1676 for (p
= nm
+ 1; p
< endp
; p
++)
1678 if (IS_DIRECTORY_SEP (p
[-1])
1679 && file_name_absolute_p (p
)
1680 #if defined (WINDOWSNT) || defined (CYGWIN)
1681 /* // at start of file name is meaningful in Apollo,
1682 WindowsNT and Cygwin systems. */
1683 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
1684 #endif /* not (WINDOWSNT || CYGWIN) */
1687 for (s
= p
; *s
&& !IS_DIRECTORY_SEP (*s
); s
++);
1688 if (p
[0] == '~' && s
> p
+ 1) /* We've got "/~something/". */
1690 char *o
= alloca (s
- p
+ 1);
1692 memcpy (o
, p
, s
- p
);
1695 /* If we have ~user and `user' exists, discard
1696 everything up to ~. But if `user' does not exist, leave
1697 ~user alone, it might be a literal file name. */
1699 pw
= getpwnam (o
+ 1);
1711 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1712 Ssubstitute_in_file_name
, 1, 1, 0,
1713 doc
: /* Substitute environment variables referred to in FILENAME.
1714 `$FOO' where FOO is an environment variable name means to substitute
1715 the value of that variable. The variable name should be terminated
1716 with a character not a letter, digit or underscore; otherwise, enclose
1717 the entire variable name in braces.
1719 If `/~' appears, all of FILENAME through that `/' is discarded.
1720 If `//' appears, everything up to and including the first of
1721 those `/' is discarded. */)
1722 (Lisp_Object filename
)
1724 char *nm
, *p
, *x
, *endp
;
1725 bool substituted
= false;
1728 Lisp_Object handler
;
1730 CHECK_STRING (filename
);
1732 multibyte
= STRING_MULTIBYTE (filename
);
1734 /* If the file name has special constructs in it,
1735 call the corresponding file handler. */
1736 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1737 if (!NILP (handler
))
1739 Lisp_Object handled_name
= call2 (handler
, Qsubstitute_in_file_name
,
1741 if (STRINGP (handled_name
))
1742 return handled_name
;
1743 error ("Invalid handler in `file-name-handler-alist'");
1746 /* Always work on a copy of the string, in case GC happens during
1747 decode of environment variables, causing the original Lisp_String
1748 data to be relocated. */
1749 nm
= xlispstrdupa (filename
);
1752 dostounix_filename (nm
, multibyte
);
1753 substituted
= (memcmp (nm
, SDATA (filename
), SBYTES (filename
)) != 0);
1755 endp
= nm
+ SBYTES (filename
);
1757 /* If /~ or // appears, discard everything through first slash. */
1758 p
= search_embedded_absfilename (nm
, endp
);
1760 /* Start over with the new string, so we check the file-name-handler
1761 again. Important with filenames like "/home/foo//:/hello///there"
1762 which would substitute to "/:/hello///there" rather than "/there". */
1763 return Fsubstitute_in_file_name
1764 (make_specified_string (p
, -1, endp
- p
, multibyte
));
1766 /* See if any variables are substituted into the string. */
1768 if (!NILP (Ffboundp (Qsubstitute_env_in_file_name
)))
1771 = (!substituted
? filename
1772 : make_specified_string (nm
, -1, endp
- nm
, multibyte
));
1773 Lisp_Object tmp
= call1 (Qsubstitute_env_in_file_name
, name
);
1775 if (!EQ (tmp
, name
))
1783 if (!NILP (Vw32_downcase_file_names
))
1784 filename
= Fdowncase (filename
);
1789 xnm
= SSDATA (filename
);
1790 x
= xnm
+ SBYTES (filename
);
1792 /* If /~ or // appears, discard everything through first slash. */
1793 while ((p
= search_embedded_absfilename (xnm
, x
)) != NULL
)
1794 /* This time we do not start over because we've already expanded envvars
1795 and replaced $$ with $. Maybe we should start over as well, but we'd
1796 need to quote some $ to $$ first. */
1800 if (!NILP (Vw32_downcase_file_names
))
1802 Lisp_Object xname
= make_specified_string (xnm
, -1, x
- xnm
, multibyte
);
1804 xname
= Fdowncase (xname
);
1809 return (xnm
== SSDATA (filename
)
1811 : make_specified_string (xnm
, -1, x
- xnm
, multibyte
));
1814 /* A slightly faster and more convenient way to get
1815 (directory-file-name (expand-file-name FOO)). */
1818 expand_and_dir_to_file (Lisp_Object filename
, Lisp_Object defdir
)
1820 register Lisp_Object absname
;
1822 absname
= Fexpand_file_name (filename
, defdir
);
1824 /* Remove final slash, if any (unless this is the root dir).
1825 stat behaves differently depending! */
1826 if (SCHARS (absname
) > 1
1827 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
1828 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
) - 2)))
1829 /* We cannot take shortcuts; they might be wrong for magic file names. */
1830 absname
= Fdirectory_file_name (absname
);
1834 /* Signal an error if the file ABSNAME already exists.
1835 If INTERACTIVE, ask the user whether to proceed,
1836 and bypass the error if the user says to go ahead.
1837 QUERYSTRING is a name for the action that is being considered
1840 *STATPTR is used to store the stat information if the file exists.
1841 If the file does not exist, STATPTR->st_mode is set to 0.
1842 If STATPTR is null, we don't store into it.
1844 If QUICK, ask for y or n, not yes or no. */
1847 barf_or_query_if_file_exists (Lisp_Object absname
, const char *querystring
,
1848 bool interactive
, struct stat
*statptr
,
1851 Lisp_Object tem
, encoded_filename
;
1852 struct stat statbuf
;
1853 struct gcpro gcpro1
;
1855 encoded_filename
= ENCODE_FILE (absname
);
1857 /* `stat' is a good way to tell whether the file exists,
1858 regardless of what access permissions it has. */
1859 if (lstat (SSDATA (encoded_filename
), &statbuf
) >= 0)
1861 if (S_ISDIR (statbuf
.st_mode
))
1862 xsignal2 (Qfile_error
,
1863 build_string ("File is a directory"), absname
);
1866 xsignal2 (Qfile_already_exists
,
1867 build_string ("File already exists"), absname
);
1869 tem
= format2 ("File %s already exists; %s anyway? ",
1870 absname
, build_string (querystring
));
1872 tem
= call1 (intern ("y-or-n-p"), tem
);
1874 tem
= do_yes_or_no_p (tem
);
1877 xsignal2 (Qfile_already_exists
,
1878 build_string ("File already exists"), absname
);
1885 statptr
->st_mode
= 0;
1890 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
1891 "fCopy file: \nGCopy %s to file: \np\nP",
1892 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
1893 If NEWNAME names a directory, copy FILE there.
1895 This function always sets the file modes of the output file to match
1898 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1899 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1900 signal a `file-already-exists' error without overwriting. If
1901 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1902 about overwriting; this is what happens in interactive use with M-x.
1903 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1906 Fourth arg KEEP-TIME non-nil means give the output file the same
1907 last-modified time as the old one. (This works on only some systems.)
1909 A prefix arg makes KEEP-TIME non-nil.
1911 If PRESERVE-UID-GID is non-nil, we try to transfer the
1912 uid and gid of FILE to NEWNAME.
1914 If PRESERVE-EXTENDED-ATTRIBUTES is non-nil, we try to copy additional
1915 attributes of FILE to NEWNAME, such as its SELinux context and ACL
1916 entries (depending on how Emacs was built). */)
1917 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
, Lisp_Object keep_time
, Lisp_Object preserve_uid_gid
, Lisp_Object preserve_extended_attributes
)
1921 char buf
[16 * 1024];
1922 struct stat st
, out_st
;
1923 Lisp_Object handler
;
1924 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1925 ptrdiff_t count
= SPECPDL_INDEX ();
1926 Lisp_Object encoded_file
, encoded_newname
;
1928 security_context_t con
;
1935 encoded_file
= encoded_newname
= Qnil
;
1936 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
1937 CHECK_STRING (file
);
1938 CHECK_STRING (newname
);
1940 if (!NILP (Ffile_directory_p (newname
)))
1941 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
1943 newname
= Fexpand_file_name (newname
, Qnil
);
1945 file
= Fexpand_file_name (file
, Qnil
);
1947 /* If the input file name has special constructs in it,
1948 call the corresponding file handler. */
1949 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1950 /* Likewise for output file name. */
1952 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1953 if (!NILP (handler
))
1954 RETURN_UNGCPRO (call7 (handler
, Qcopy_file
, file
, newname
,
1955 ok_if_already_exists
, keep_time
, preserve_uid_gid
,
1956 preserve_extended_attributes
));
1958 encoded_file
= ENCODE_FILE (file
);
1959 encoded_newname
= ENCODE_FILE (newname
);
1961 if (NILP (ok_if_already_exists
)
1962 || INTEGERP (ok_if_already_exists
))
1963 barf_or_query_if_file_exists (newname
, "copy to it",
1964 INTEGERP (ok_if_already_exists
), &out_st
, 0);
1965 else if (stat (SSDATA (encoded_newname
), &out_st
) < 0)
1969 if (!NILP (preserve_extended_attributes
))
1971 acl
= acl_get_file (SDATA (encoded_file
), ACL_TYPE_ACCESS
);
1972 if (acl
== NULL
&& acl_errno_valid (errno
))
1973 report_file_error ("Getting ACL", file
);
1975 if (!CopyFile (SDATA (encoded_file
),
1976 SDATA (encoded_newname
),
1979 /* CopyFile doesn't set errno when it fails. By far the most
1980 "popular" reason is that the target is read-only. */
1981 report_file_errno ("Copying file", list2 (file
, newname
),
1982 GetLastError () == 5 ? EACCES
: EPERM
);
1984 /* CopyFile retains the timestamp by default. */
1985 else if (NILP (keep_time
))
1987 struct timespec now
;
1991 filename
= SDATA (encoded_newname
);
1993 /* Ensure file is writable while its modified time is set. */
1994 attributes
= GetFileAttributes (filename
);
1995 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
1996 now
= current_timespec ();
1997 if (set_file_times (-1, filename
, now
, now
))
1999 /* Restore original attributes. */
2000 SetFileAttributes (filename
, attributes
);
2001 xsignal2 (Qfile_date_error
,
2002 build_string ("Cannot set file date"), newname
);
2004 /* Restore original attributes. */
2005 SetFileAttributes (filename
, attributes
);
2010 acl_set_file (SDATA (encoded_newname
), ACL_TYPE_ACCESS
, acl
) != 0;
2011 if (fail
&& acl_errno_valid (errno
))
2012 report_file_error ("Setting ACL", newname
);
2016 #else /* not WINDOWSNT */
2018 ifd
= emacs_open (SSDATA (encoded_file
), O_RDONLY
, 0);
2022 report_file_error ("Opening input file", file
);
2024 record_unwind_protect_int (close_file_unwind
, ifd
);
2026 if (fstat (ifd
, &st
) != 0)
2027 report_file_error ("Input file status", file
);
2029 if (!NILP (preserve_extended_attributes
))
2032 if (is_selinux_enabled ())
2034 conlength
= fgetfilecon (ifd
, &con
);
2035 if (conlength
== -1)
2036 report_file_error ("Doing fgetfilecon", file
);
2041 if (out_st
.st_mode
!= 0
2042 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2043 report_file_errno ("Input and output files are the same",
2044 list2 (file
, newname
), 0);
2046 /* We can copy only regular files. */
2047 if (!S_ISREG (st
.st_mode
))
2048 report_file_errno ("Non-regular file", file
,
2049 S_ISDIR (st
.st_mode
) ? EISDIR
: EINVAL
);
2053 int new_mask
= st
.st_mode
& (!NILP (preserve_uid_gid
) ? 0600 : 0666);
2055 int new_mask
= S_IREAD
| S_IWRITE
;
2057 ofd
= emacs_open (SSDATA (encoded_newname
),
2058 (O_WRONLY
| O_TRUNC
| O_CREAT
2059 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0)),
2063 report_file_error ("Opening output file", newname
);
2065 record_unwind_protect_int (close_file_unwind
, ofd
);
2069 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2070 if (emacs_write_sig (ofd
, buf
, n
) != n
)
2071 report_file_error ("Write error", newname
);
2075 /* Preserve the original file permissions, and if requested, also its
2078 mode_t mode_mask
= 07777;
2079 if (!NILP (preserve_uid_gid
))
2081 /* Attempt to change owner and group. If that doesn't work
2082 attempt to change just the group, as that is sometimes allowed.
2083 Adjust the mode mask to eliminate setuid or setgid bits
2084 that are inappropriate if the owner and group are wrong. */
2085 if (fchown (ofd
, st
.st_uid
, st
.st_gid
) != 0)
2087 mode_mask
&= ~06000;
2088 if (fchown (ofd
, -1, st
.st_gid
) == 0)
2093 switch (!NILP (preserve_extended_attributes
)
2094 ? qcopy_acl (SSDATA (encoded_file
), ifd
,
2095 SSDATA (encoded_newname
), ofd
,
2096 st
.st_mode
& mode_mask
)
2097 : fchmod (ofd
, st
.st_mode
& mode_mask
))
2099 case -2: report_file_error ("Copying permissions from", file
);
2100 case -1: report_file_error ("Copying permissions to", newname
);
2103 #endif /* not MSDOS */
2108 /* Set the modified context back to the file. */
2109 bool fail
= fsetfilecon (ofd
, con
) != 0;
2110 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2111 if (fail
&& errno
!= ENOTSUP
)
2112 report_file_error ("Doing fsetfilecon", newname
);
2118 if (!NILP (keep_time
))
2120 struct timespec atime
= get_stat_atime (&st
);
2121 struct timespec mtime
= get_stat_mtime (&st
);
2122 if (set_file_times (ofd
, SSDATA (encoded_newname
), atime
, mtime
))
2123 xsignal2 (Qfile_date_error
,
2124 build_string ("Cannot set file date"), newname
);
2127 if (emacs_close (ofd
) < 0)
2128 report_file_error ("Write error", newname
);
2133 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2134 and if it can't, it tells so. Otherwise, under MSDOS we usually
2135 get only the READ bit, which will make the copied file read-only,
2136 so it's better not to chmod at all. */
2137 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2138 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2140 #endif /* not WINDOWSNT */
2142 /* Discard the unwind protects. */
2143 specpdl_ptr
= specpdl
+ count
;
2149 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2150 Smake_directory_internal
, 1, 1, 0,
2151 doc
: /* Create a new directory named DIRECTORY. */)
2152 (Lisp_Object directory
)
2155 Lisp_Object handler
;
2156 Lisp_Object encoded_dir
;
2158 CHECK_STRING (directory
);
2159 directory
= Fexpand_file_name (directory
, Qnil
);
2161 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2162 if (!NILP (handler
))
2163 return call2 (handler
, Qmake_directory_internal
, directory
);
2165 encoded_dir
= ENCODE_FILE (directory
);
2167 dir
= SSDATA (encoded_dir
);
2170 if (mkdir (dir
) != 0)
2172 if (mkdir (dir
, 0777 & ~auto_saving_dir_umask
) != 0)
2174 report_file_error ("Creating directory", directory
);
2179 DEFUN ("delete-directory-internal", Fdelete_directory_internal
,
2180 Sdelete_directory_internal
, 1, 1, 0,
2181 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2182 (Lisp_Object directory
)
2185 Lisp_Object encoded_dir
;
2187 CHECK_STRING (directory
);
2188 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2189 encoded_dir
= ENCODE_FILE (directory
);
2190 dir
= SSDATA (encoded_dir
);
2192 if (rmdir (dir
) != 0)
2193 report_file_error ("Removing directory", directory
);
2198 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 2,
2199 "(list (read-file-name \
2200 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2201 \"Move file to trash: \" \"Delete file: \") \
2202 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2203 (null current-prefix-arg))",
2204 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2205 If file has multiple names, it continues to exist with the other names.
2206 TRASH non-nil means to trash the file instead of deleting, provided
2207 `delete-by-moving-to-trash' is non-nil.
2209 When called interactively, TRASH is t if no prefix argument is given.
2210 With a prefix argument, TRASH is nil. */)
2211 (Lisp_Object filename
, Lisp_Object trash
)
2213 Lisp_Object handler
;
2214 Lisp_Object encoded_file
;
2215 struct gcpro gcpro1
;
2218 if (!NILP (Ffile_directory_p (filename
))
2219 && NILP (Ffile_symlink_p (filename
)))
2220 xsignal2 (Qfile_error
,
2221 build_string ("Removing old name: is a directory"),
2224 filename
= Fexpand_file_name (filename
, Qnil
);
2226 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2227 if (!NILP (handler
))
2228 return call3 (handler
, Qdelete_file
, filename
, trash
);
2230 if (delete_by_moving_to_trash
&& !NILP (trash
))
2231 return call1 (Qmove_file_to_trash
, filename
);
2233 encoded_file
= ENCODE_FILE (filename
);
2235 if (unlink (SSDATA (encoded_file
)) < 0)
2236 report_file_error ("Removing old name", filename
);
2241 internal_delete_file_1 (Lisp_Object ignore
)
2246 /* Delete file FILENAME, returning true if successful.
2247 This ignores `delete-by-moving-to-trash'. */
2250 internal_delete_file (Lisp_Object filename
)
2254 tem
= internal_condition_case_2 (Fdelete_file
, filename
, Qnil
,
2255 Qt
, internal_delete_file_1
);
2259 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2260 "fRename file: \nGRename %s to file: \np",
2261 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2262 If file has names other than FILE, it continues to have those names.
2263 Signals a `file-already-exists' error if a file NEWNAME already exists
2264 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2265 A number as third arg means request confirmation if NEWNAME already exists.
2266 This is what happens in interactive use with M-x. */)
2267 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2269 Lisp_Object handler
;
2270 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2271 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2273 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2274 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2275 CHECK_STRING (file
);
2276 CHECK_STRING (newname
);
2277 file
= Fexpand_file_name (file
, Qnil
);
2279 if ((!NILP (Ffile_directory_p (newname
)))
2281 /* If the file names are identical but for the case,
2282 don't attempt to move directory to itself. */
2283 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2287 Lisp_Object fname
= (NILP (Ffile_directory_p (file
))
2288 ? file
: Fdirectory_file_name (file
));
2289 newname
= Fexpand_file_name (Ffile_name_nondirectory (fname
), newname
);
2292 newname
= Fexpand_file_name (newname
, Qnil
);
2294 /* If the file name has special constructs in it,
2295 call the corresponding file handler. */
2296 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2298 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2299 if (!NILP (handler
))
2300 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2301 file
, newname
, ok_if_already_exists
));
2303 encoded_file
= ENCODE_FILE (file
);
2304 encoded_newname
= ENCODE_FILE (newname
);
2307 /* If the file names are identical but for the case, don't ask for
2308 confirmation: they simply want to change the letter-case of the
2310 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2312 if (NILP (ok_if_already_exists
)
2313 || INTEGERP (ok_if_already_exists
))
2314 barf_or_query_if_file_exists (newname
, "rename to it",
2315 INTEGERP (ok_if_already_exists
), 0, 0);
2316 if (rename (SSDATA (encoded_file
), SSDATA (encoded_newname
)) < 0)
2318 int rename_errno
= errno
;
2319 if (rename_errno
== EXDEV
)
2322 symlink_target
= Ffile_symlink_p (file
);
2323 if (! NILP (symlink_target
))
2324 Fmake_symbolic_link (symlink_target
, newname
,
2325 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2326 else if (!NILP (Ffile_directory_p (file
)))
2327 call4 (Qcopy_directory
, file
, newname
, Qt
, Qnil
);
2329 /* We have already prompted if it was an integer, so don't
2330 have copy-file prompt again. */
2331 Fcopy_file (file
, newname
,
2332 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2335 count
= SPECPDL_INDEX ();
2336 specbind (Qdelete_by_moving_to_trash
, Qnil
);
2338 if (!NILP (Ffile_directory_p (file
)) && NILP (symlink_target
))
2339 call2 (Qdelete_directory
, file
, Qt
);
2341 Fdelete_file (file
, Qnil
);
2342 unbind_to (count
, Qnil
);
2345 report_file_errno ("Renaming", list2 (file
, newname
), rename_errno
);
2351 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2352 "fAdd name to file: \nGName to add to %s: \np",
2353 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2354 Signals a `file-already-exists' error if a file NEWNAME already exists
2355 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2356 A number as third arg means request confirmation if NEWNAME already exists.
2357 This is what happens in interactive use with M-x. */)
2358 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2360 Lisp_Object handler
;
2361 Lisp_Object encoded_file
, encoded_newname
;
2362 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2364 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2365 encoded_file
= encoded_newname
= Qnil
;
2366 CHECK_STRING (file
);
2367 CHECK_STRING (newname
);
2368 file
= Fexpand_file_name (file
, Qnil
);
2370 if (!NILP (Ffile_directory_p (newname
)))
2371 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2373 newname
= Fexpand_file_name (newname
, Qnil
);
2375 /* If the file name has special constructs in it,
2376 call the corresponding file handler. */
2377 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2378 if (!NILP (handler
))
2379 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2380 newname
, ok_if_already_exists
));
2382 /* If the new name has special constructs in it,
2383 call the corresponding file handler. */
2384 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2385 if (!NILP (handler
))
2386 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2387 newname
, ok_if_already_exists
));
2389 encoded_file
= ENCODE_FILE (file
);
2390 encoded_newname
= ENCODE_FILE (newname
);
2392 if (NILP (ok_if_already_exists
)
2393 || INTEGERP (ok_if_already_exists
))
2394 barf_or_query_if_file_exists (newname
, "make it a new name",
2395 INTEGERP (ok_if_already_exists
), 0, 0);
2397 unlink (SSDATA (newname
));
2398 if (link (SSDATA (encoded_file
), SSDATA (encoded_newname
)) < 0)
2400 int link_errno
= errno
;
2401 report_file_errno ("Adding new name", list2 (file
, newname
), link_errno
);
2408 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2409 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2410 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2411 Both args must be strings.
2412 Signals a `file-already-exists' error if a file LINKNAME already exists
2413 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2414 A number as third arg means request confirmation if LINKNAME already exists.
2415 This happens for interactive use with M-x. */)
2416 (Lisp_Object filename
, Lisp_Object linkname
, Lisp_Object ok_if_already_exists
)
2418 Lisp_Object handler
;
2419 Lisp_Object encoded_filename
, encoded_linkname
;
2420 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2422 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2423 encoded_filename
= encoded_linkname
= Qnil
;
2424 CHECK_STRING (filename
);
2425 CHECK_STRING (linkname
);
2426 /* If the link target has a ~, we must expand it to get
2427 a truly valid file name. Otherwise, do not expand;
2428 we want to permit links to relative file names. */
2429 if (SREF (filename
, 0) == '~')
2430 filename
= Fexpand_file_name (filename
, Qnil
);
2432 if (!NILP (Ffile_directory_p (linkname
)))
2433 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2435 linkname
= Fexpand_file_name (linkname
, Qnil
);
2437 /* If the file name has special constructs in it,
2438 call the corresponding file handler. */
2439 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2440 if (!NILP (handler
))
2441 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2442 linkname
, ok_if_already_exists
));
2444 /* If the new link name has special constructs in it,
2445 call the corresponding file handler. */
2446 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2447 if (!NILP (handler
))
2448 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2449 linkname
, ok_if_already_exists
));
2451 encoded_filename
= ENCODE_FILE (filename
);
2452 encoded_linkname
= ENCODE_FILE (linkname
);
2454 if (NILP (ok_if_already_exists
)
2455 || INTEGERP (ok_if_already_exists
))
2456 barf_or_query_if_file_exists (linkname
, "make it a link",
2457 INTEGERP (ok_if_already_exists
), 0, 0);
2458 if (symlink (SSDATA (encoded_filename
), SSDATA (encoded_linkname
)) < 0)
2460 /* If we didn't complain already, silently delete existing file. */
2462 if (errno
== EEXIST
)
2464 unlink (SSDATA (encoded_linkname
));
2465 if (symlink (SSDATA (encoded_filename
), SSDATA (encoded_linkname
))
2472 if (errno
== ENOSYS
)
2475 xsignal1 (Qfile_error
,
2476 build_string ("Symbolic links are not supported"));
2479 symlink_errno
= errno
;
2480 report_file_errno ("Making symbolic link", list2 (filename
, linkname
),
2488 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2490 doc
: /* Return t if file FILENAME specifies an absolute file name.
2491 On Unix, this is a name starting with a `/' or a `~'. */)
2492 (Lisp_Object filename
)
2494 CHECK_STRING (filename
);
2495 return file_name_absolute_p (SSDATA (filename
)) ? Qt
: Qnil
;
2498 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2499 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
2500 See also `file-readable-p' and `file-attributes'.
2501 This returns nil for a symlink to a nonexistent file.
2502 Use `file-symlink-p' to test for such links. */)
2503 (Lisp_Object filename
)
2505 Lisp_Object absname
;
2506 Lisp_Object handler
;
2508 CHECK_STRING (filename
);
2509 absname
= Fexpand_file_name (filename
, Qnil
);
2511 /* If the file name has special constructs in it,
2512 call the corresponding file handler. */
2513 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2514 if (!NILP (handler
))
2516 Lisp_Object result
= call2 (handler
, Qfile_exists_p
, absname
);
2521 absname
= ENCODE_FILE (absname
);
2523 return check_existing (SSDATA (absname
)) ? Qt
: Qnil
;
2526 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2527 doc
: /* Return t if FILENAME can be executed by you.
2528 For a directory, this means you can access files in that directory. */)
2529 (Lisp_Object filename
)
2531 Lisp_Object absname
;
2532 Lisp_Object handler
;
2534 CHECK_STRING (filename
);
2535 absname
= Fexpand_file_name (filename
, Qnil
);
2537 /* If the file name has special constructs in it,
2538 call the corresponding file handler. */
2539 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2540 if (!NILP (handler
))
2541 return call2 (handler
, Qfile_executable_p
, absname
);
2543 absname
= ENCODE_FILE (absname
);
2545 return (check_executable (SSDATA (absname
)) ? Qt
: Qnil
);
2548 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2549 doc
: /* Return t if file FILENAME exists and you can read it.
2550 See also `file-exists-p' and `file-attributes'. */)
2551 (Lisp_Object filename
)
2553 Lisp_Object absname
;
2554 Lisp_Object handler
;
2556 CHECK_STRING (filename
);
2557 absname
= Fexpand_file_name (filename
, Qnil
);
2559 /* If the file name has special constructs in it,
2560 call the corresponding file handler. */
2561 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2562 if (!NILP (handler
))
2563 return call2 (handler
, Qfile_readable_p
, absname
);
2565 absname
= ENCODE_FILE (absname
);
2566 return (faccessat (AT_FDCWD
, SSDATA (absname
), R_OK
, AT_EACCESS
) == 0
2570 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2571 doc
: /* Return t if file FILENAME can be written or created by you. */)
2572 (Lisp_Object filename
)
2574 Lisp_Object absname
, dir
, encoded
;
2575 Lisp_Object handler
;
2577 CHECK_STRING (filename
);
2578 absname
= Fexpand_file_name (filename
, Qnil
);
2580 /* If the file name has special constructs in it,
2581 call the corresponding file handler. */
2582 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2583 if (!NILP (handler
))
2584 return call2 (handler
, Qfile_writable_p
, absname
);
2586 encoded
= ENCODE_FILE (absname
);
2587 if (check_writable (SSDATA (encoded
), W_OK
))
2589 if (errno
!= ENOENT
)
2592 dir
= Ffile_name_directory (absname
);
2593 eassert (!NILP (dir
));
2595 dir
= Fdirectory_file_name (dir
);
2598 dir
= ENCODE_FILE (dir
);
2600 /* The read-only attribute of the parent directory doesn't affect
2601 whether a file or directory can be created within it. Some day we
2602 should check ACLs though, which do affect this. */
2603 return file_directory_p (SDATA (dir
)) ? Qt
: Qnil
;
2605 return check_writable (SSDATA (dir
), W_OK
| X_OK
) ? Qt
: Qnil
;
2609 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2610 doc
: /* Access file FILENAME, and get an error if that does not work.
2611 The second argument STRING is used in the error message.
2612 If there is no error, returns nil. */)
2613 (Lisp_Object filename
, Lisp_Object string
)
2615 Lisp_Object handler
, encoded_filename
, absname
;
2617 CHECK_STRING (filename
);
2618 absname
= Fexpand_file_name (filename
, Qnil
);
2620 CHECK_STRING (string
);
2622 /* If the file name has special constructs in it,
2623 call the corresponding file handler. */
2624 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
2625 if (!NILP (handler
))
2626 return call3 (handler
, Qaccess_file
, absname
, string
);
2628 encoded_filename
= ENCODE_FILE (absname
);
2630 if (faccessat (AT_FDCWD
, SSDATA (encoded_filename
), R_OK
, AT_EACCESS
) != 0)
2631 report_file_error (SSDATA (string
), filename
);
2636 /* Relative to directory FD, return the symbolic link value of FILENAME.
2637 On failure, return nil. */
2639 emacs_readlinkat (int fd
, char const *filename
)
2641 static struct allocator
const emacs_norealloc_allocator
=
2642 { xmalloc
, NULL
, xfree
, memory_full
};
2644 char readlink_buf
[1024];
2645 char *buf
= careadlinkat (fd
, filename
, readlink_buf
, sizeof readlink_buf
,
2646 &emacs_norealloc_allocator
, readlinkat
);
2650 val
= build_string (buf
);
2651 if (buf
[0] == '/' && strchr (buf
, ':'))
2652 val
= concat2 (build_string ("/:"), val
);
2653 if (buf
!= readlink_buf
)
2655 val
= DECODE_FILE (val
);
2659 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2660 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
2661 The value is the link target, as a string.
2662 Otherwise it returns nil.
2664 This function returns t when given the name of a symlink that
2665 points to a nonexistent file. */)
2666 (Lisp_Object filename
)
2668 Lisp_Object handler
;
2670 CHECK_STRING (filename
);
2671 filename
= Fexpand_file_name (filename
, Qnil
);
2673 /* If the file name has special constructs in it,
2674 call the corresponding file handler. */
2675 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2676 if (!NILP (handler
))
2677 return call2 (handler
, Qfile_symlink_p
, filename
);
2679 filename
= ENCODE_FILE (filename
);
2681 return emacs_readlinkat (AT_FDCWD
, SSDATA (filename
));
2684 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2685 doc
: /* Return t if FILENAME names an existing directory.
2686 Symbolic links to directories count as directories.
2687 See `file-symlink-p' to distinguish symlinks. */)
2688 (Lisp_Object filename
)
2690 Lisp_Object absname
;
2691 Lisp_Object handler
;
2693 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2695 /* If the file name has special constructs in it,
2696 call the corresponding file handler. */
2697 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2698 if (!NILP (handler
))
2699 return call2 (handler
, Qfile_directory_p
, absname
);
2701 absname
= ENCODE_FILE (absname
);
2703 return file_directory_p (SSDATA (absname
)) ? Qt
: Qnil
;
2706 /* Return true if FILE is a directory or a symlink to a directory. */
2708 file_directory_p (char const *file
)
2711 /* This is cheaper than 'stat'. */
2712 return faccessat (AT_FDCWD
, file
, D_OK
, AT_EACCESS
) == 0;
2715 return stat (file
, &st
) == 0 && S_ISDIR (st
.st_mode
);
2719 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
,
2720 Sfile_accessible_directory_p
, 1, 1, 0,
2721 doc
: /* Return t if file FILENAME names a directory you can open.
2722 For the value to be t, FILENAME must specify the name of a directory as a file,
2723 and the directory must allow you to open files in it. In order to use a
2724 directory as a buffer's current directory, this predicate must return true.
2725 A directory name spec may be given instead; then the value is t
2726 if the directory so specified exists and really is a readable and
2727 searchable directory. */)
2728 (Lisp_Object filename
)
2730 Lisp_Object absname
;
2731 Lisp_Object handler
;
2733 CHECK_STRING (filename
);
2734 absname
= Fexpand_file_name (filename
, Qnil
);
2736 /* If the file name has special constructs in it,
2737 call the corresponding file handler. */
2738 handler
= Ffind_file_name_handler (absname
, Qfile_accessible_directory_p
);
2739 if (!NILP (handler
))
2741 Lisp_Object r
= call2 (handler
, Qfile_accessible_directory_p
, absname
);
2746 absname
= ENCODE_FILE (absname
);
2747 return file_accessible_directory_p (SSDATA (absname
)) ? Qt
: Qnil
;
2750 /* If FILE is a searchable directory or a symlink to a
2751 searchable directory, return true. Otherwise return
2752 false and set errno to an error number. */
2754 file_accessible_directory_p (char const *file
)
2757 /* There's no need to test whether FILE is searchable, as the
2758 searchable/executable bit is invented on DOS_NT platforms. */
2759 return file_directory_p (file
);
2761 /* On POSIXish platforms, use just one system call; this avoids a
2762 race and is typically faster. */
2763 ptrdiff_t len
= strlen (file
);
2769 /* Normally a file "FOO" is an accessible directory if "FOO/." exists.
2770 There are three exceptions: "", "/", and "//". Leave "" alone,
2771 as it's invalid. Append only "." to the other two exceptions as
2772 "/" and "//" are distinct on some platforms, whereas "/", "///",
2773 "////", etc. are all equivalent. */
2778 /* Just check for trailing '/' when deciding whether to append '/'.
2779 That's simpler than testing the two special cases "/" and "//",
2780 and it's a safe optimization here. */
2781 char *buf
= SAFE_ALLOCA (len
+ 3);
2782 memcpy (buf
, file
, len
);
2783 strcpy (buf
+ len
, &"/."[file
[len
- 1] == '/']);
2787 ok
= check_existing (dir
);
2788 saved_errno
= errno
;
2790 errno
= saved_errno
;
2795 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2796 doc
: /* Return t if FILENAME names a regular file.
2797 This is the sort of file that holds an ordinary stream of data bytes.
2798 Symbolic links to regular files count as regular files.
2799 See `file-symlink-p' to distinguish symlinks. */)
2800 (Lisp_Object filename
)
2802 register Lisp_Object absname
;
2804 Lisp_Object handler
;
2806 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2808 /* If the file name has special constructs in it,
2809 call the corresponding file handler. */
2810 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2811 if (!NILP (handler
))
2812 return call2 (handler
, Qfile_regular_p
, absname
);
2814 absname
= ENCODE_FILE (absname
);
2819 Lisp_Object tem
= Vw32_get_true_file_attributes
;
2821 /* Tell stat to use expensive method to get accurate info. */
2822 Vw32_get_true_file_attributes
= Qt
;
2823 result
= stat (SDATA (absname
), &st
);
2824 Vw32_get_true_file_attributes
= tem
;
2828 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2831 if (stat (SSDATA (absname
), &st
) < 0)
2833 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2837 DEFUN ("file-selinux-context", Ffile_selinux_context
,
2838 Sfile_selinux_context
, 1, 1, 0,
2839 doc
: /* Return SELinux context of file named FILENAME.
2840 The return value is a list (USER ROLE TYPE RANGE), where the list
2841 elements are strings naming the user, role, type, and range of the
2842 file's SELinux security context.
2844 Return (nil nil nil nil) if the file is nonexistent or inaccessible,
2845 or if SELinux is disabled, or if Emacs lacks SELinux support. */)
2846 (Lisp_Object filename
)
2848 Lisp_Object absname
;
2849 Lisp_Object values
[4];
2850 Lisp_Object handler
;
2852 security_context_t con
;
2857 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2859 /* If the file name has special constructs in it,
2860 call the corresponding file handler. */
2861 handler
= Ffind_file_name_handler (absname
, Qfile_selinux_context
);
2862 if (!NILP (handler
))
2863 return call2 (handler
, Qfile_selinux_context
, absname
);
2865 absname
= ENCODE_FILE (absname
);
2872 if (is_selinux_enabled ())
2874 conlength
= lgetfilecon (SSDATA (absname
), &con
);
2877 context
= context_new (con
);
2878 if (context_user_get (context
))
2879 values
[0] = build_string (context_user_get (context
));
2880 if (context_role_get (context
))
2881 values
[1] = build_string (context_role_get (context
));
2882 if (context_type_get (context
))
2883 values
[2] = build_string (context_type_get (context
));
2884 if (context_range_get (context
))
2885 values
[3] = build_string (context_range_get (context
));
2886 context_free (context
);
2892 return Flist (sizeof (values
) / sizeof (values
[0]), values
);
2895 DEFUN ("set-file-selinux-context", Fset_file_selinux_context
,
2896 Sset_file_selinux_context
, 2, 2, 0,
2897 doc
: /* Set SELinux context of file named FILENAME to CONTEXT.
2898 CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
2899 elements are strings naming the components of a SELinux context.
2901 Value is t if setting of SELinux context was successful, nil otherwise.
2903 This function does nothing and returns nil if SELinux is disabled,
2904 or if Emacs was not compiled with SELinux support. */)
2905 (Lisp_Object filename
, Lisp_Object context
)
2907 Lisp_Object absname
;
2908 Lisp_Object handler
;
2910 Lisp_Object encoded_absname
;
2911 Lisp_Object user
= CAR_SAFE (context
);
2912 Lisp_Object role
= CAR_SAFE (CDR_SAFE (context
));
2913 Lisp_Object type
= CAR_SAFE (CDR_SAFE (CDR_SAFE (context
)));
2914 Lisp_Object range
= CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context
))));
2915 security_context_t con
;
2918 context_t parsed_con
;
2921 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
2923 /* If the file name has special constructs in it,
2924 call the corresponding file handler. */
2925 handler
= Ffind_file_name_handler (absname
, Qset_file_selinux_context
);
2926 if (!NILP (handler
))
2927 return call3 (handler
, Qset_file_selinux_context
, absname
, context
);
2930 if (is_selinux_enabled ())
2932 /* Get current file context. */
2933 encoded_absname
= ENCODE_FILE (absname
);
2934 conlength
= lgetfilecon (SSDATA (encoded_absname
), &con
);
2937 parsed_con
= context_new (con
);
2938 /* Change the parts defined in the parameter.*/
2941 if (context_user_set (parsed_con
, SSDATA (user
)))
2942 error ("Doing context_user_set");
2946 if (context_role_set (parsed_con
, SSDATA (role
)))
2947 error ("Doing context_role_set");
2951 if (context_type_set (parsed_con
, SSDATA (type
)))
2952 error ("Doing context_type_set");
2954 if (STRINGP (range
))
2956 if (context_range_set (parsed_con
, SSDATA (range
)))
2957 error ("Doing context_range_set");
2960 /* Set the modified context back to the file. */
2961 fail
= (lsetfilecon (SSDATA (encoded_absname
),
2962 context_str (parsed_con
))
2964 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2965 if (fail
&& errno
!= ENOTSUP
)
2966 report_file_error ("Doing lsetfilecon", absname
);
2968 context_free (parsed_con
);
2970 return fail
? Qnil
: Qt
;
2973 report_file_error ("Doing lgetfilecon", absname
);
2980 DEFUN ("file-acl", Ffile_acl
, Sfile_acl
, 1, 1, 0,
2981 doc
: /* Return ACL entries of file named FILENAME.
2982 The entries are returned in a format suitable for use in `set-file-acl'
2983 but is otherwise undocumented and subject to change.
2984 Return nil if file does not exist or is not accessible, or if Emacs
2985 was unable to determine the ACL entries. */)
2986 (Lisp_Object filename
)
2988 Lisp_Object absname
;
2989 Lisp_Object handler
;
2990 #ifdef HAVE_ACL_SET_FILE
2992 Lisp_Object acl_string
;
2996 absname
= expand_and_dir_to_file (filename
,
2997 BVAR (current_buffer
, directory
));
2999 /* If the file name has special constructs in it,
3000 call the corresponding file handler. */
3001 handler
= Ffind_file_name_handler (absname
, Qfile_acl
);
3002 if (!NILP (handler
))
3003 return call2 (handler
, Qfile_acl
, absname
);
3005 #ifdef HAVE_ACL_SET_FILE
3006 absname
= ENCODE_FILE (absname
);
3008 acl
= acl_get_file (SSDATA (absname
), ACL_TYPE_ACCESS
);
3012 str
= acl_to_text (acl
, NULL
);
3019 acl_string
= build_string (str
);
3029 DEFUN ("set-file-acl", Fset_file_acl
, Sset_file_acl
,
3031 doc
: /* Set ACL of file named FILENAME to ACL-STRING.
3032 ACL-STRING should contain the textual representation of the ACL
3033 entries in a format suitable for the platform.
3035 Value is t if setting of ACL was successful, nil otherwise.
3037 Setting ACL for local files requires Emacs to be built with ACL
3039 (Lisp_Object filename
, Lisp_Object acl_string
)
3041 Lisp_Object absname
;
3042 Lisp_Object handler
;
3043 #ifdef HAVE_ACL_SET_FILE
3044 Lisp_Object encoded_absname
;
3049 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3051 /* If the file name has special constructs in it,
3052 call the corresponding file handler. */
3053 handler
= Ffind_file_name_handler (absname
, Qset_file_acl
);
3054 if (!NILP (handler
))
3055 return call3 (handler
, Qset_file_acl
, absname
, acl_string
);
3057 #ifdef HAVE_ACL_SET_FILE
3058 if (STRINGP (acl_string
))
3060 acl
= acl_from_text (SSDATA (acl_string
));
3063 report_file_error ("Converting ACL", absname
);
3067 encoded_absname
= ENCODE_FILE (absname
);
3069 fail
= (acl_set_file (SSDATA (encoded_absname
), ACL_TYPE_ACCESS
,
3072 if (fail
&& acl_errno_valid (errno
))
3073 report_file_error ("Setting ACL", absname
);
3076 return fail
? Qnil
: Qt
;
3083 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3084 doc
: /* Return mode bits of file named FILENAME, as an integer.
3085 Return nil, if file does not exist or is not accessible. */)
3086 (Lisp_Object filename
)
3088 Lisp_Object absname
;
3090 Lisp_Object handler
;
3092 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
3094 /* If the file name has special constructs in it,
3095 call the corresponding file handler. */
3096 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3097 if (!NILP (handler
))
3098 return call2 (handler
, Qfile_modes
, absname
);
3100 absname
= ENCODE_FILE (absname
);
3102 if (stat (SSDATA (absname
), &st
) < 0)
3105 return make_number (st
.st_mode
& 07777);
3108 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
3109 "(let ((file (read-file-name \"File: \"))) \
3110 (list file (read-file-modes nil file)))",
3111 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3112 Only the 12 low bits of MODE are used.
3114 Interactively, mode bits are read by `read-file-modes', which accepts
3115 symbolic notation, like the `chmod' command from GNU Coreutils. */)
3116 (Lisp_Object filename
, Lisp_Object mode
)
3118 Lisp_Object absname
, encoded_absname
;
3119 Lisp_Object handler
;
3121 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3122 CHECK_NUMBER (mode
);
3124 /* If the file name has special constructs in it,
3125 call the corresponding file handler. */
3126 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3127 if (!NILP (handler
))
3128 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3130 encoded_absname
= ENCODE_FILE (absname
);
3132 if (chmod (SSDATA (encoded_absname
), XINT (mode
) & 07777) < 0)
3133 report_file_error ("Doing chmod", absname
);
3138 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3139 doc
: /* Set the file permission bits for newly created files.
3140 The argument MODE should be an integer; only the low 9 bits are used.
3141 This setting is inherited by subprocesses. */)
3144 CHECK_NUMBER (mode
);
3146 umask ((~ XINT (mode
)) & 0777);
3151 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3152 doc
: /* Return the default file protection for created files.
3153 The value is an integer. */)
3160 realmask
= umask (0);
3164 XSETINT (value
, (~ realmask
) & 0777);
3169 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3170 doc
: /* Set times of file FILENAME to TIMESTAMP.
3171 Set both access and modification times.
3172 Return t on success, else nil.
3173 Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
3175 (Lisp_Object filename
, Lisp_Object timestamp
)
3177 Lisp_Object absname
, encoded_absname
;
3178 Lisp_Object handler
;
3179 struct timespec t
= lisp_time_argument (timestamp
);
3181 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3183 /* If the file name has special constructs in it,
3184 call the corresponding file handler. */
3185 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3186 if (!NILP (handler
))
3187 return call3 (handler
, Qset_file_times
, absname
, timestamp
);
3189 encoded_absname
= ENCODE_FILE (absname
);
3192 if (set_file_times (-1, SSDATA (encoded_absname
), t
, t
))
3195 /* Setting times on a directory always fails. */
3196 if (file_directory_p (SSDATA (encoded_absname
)))
3199 report_file_error ("Setting file times", absname
);
3207 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3208 doc
: /* Tell Unix to finish all pending disk updates. */)
3215 #endif /* HAVE_SYNC */
3217 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3218 doc
: /* Return t if file FILE1 is newer than file FILE2.
3219 If FILE1 does not exist, the answer is nil;
3220 otherwise, if FILE2 does not exist, the answer is t. */)
3221 (Lisp_Object file1
, Lisp_Object file2
)
3223 Lisp_Object absname1
, absname2
;
3224 struct stat st1
, st2
;
3225 Lisp_Object handler
;
3226 struct gcpro gcpro1
, gcpro2
;
3228 CHECK_STRING (file1
);
3229 CHECK_STRING (file2
);
3232 GCPRO2 (absname1
, file2
);
3233 absname1
= expand_and_dir_to_file (file1
, BVAR (current_buffer
, directory
));
3234 absname2
= expand_and_dir_to_file (file2
, BVAR (current_buffer
, directory
));
3237 /* If the file name has special constructs in it,
3238 call the corresponding file handler. */
3239 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3241 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3242 if (!NILP (handler
))
3243 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3245 GCPRO2 (absname1
, absname2
);
3246 absname1
= ENCODE_FILE (absname1
);
3247 absname2
= ENCODE_FILE (absname2
);
3250 if (stat (SSDATA (absname1
), &st1
) < 0)
3253 if (stat (SSDATA (absname2
), &st2
) < 0)
3256 return (timespec_cmp (get_stat_mtime (&st2
), get_stat_mtime (&st1
)) < 0
3260 #ifndef READ_BUF_SIZE
3261 #define READ_BUF_SIZE (64 << 10)
3263 /* Some buffer offsets are stored in 'int' variables. */
3264 verify (READ_BUF_SIZE
<= INT_MAX
);
3266 /* This function is called after Lisp functions to decide a coding
3267 system are called, or when they cause an error. Before they are
3268 called, the current buffer is set unibyte and it contains only a
3269 newly inserted text (thus the buffer was empty before the
3272 The functions may set markers, overlays, text properties, or even
3273 alter the buffer contents, change the current buffer.
3275 Here, we reset all those changes by:
3276 o set back the current buffer.
3277 o move all markers and overlays to BEG.
3278 o remove all text properties.
3279 o set back the buffer multibyteness. */
3282 decide_coding_unwind (Lisp_Object unwind_data
)
3284 Lisp_Object multibyte
, undo_list
, buffer
;
3286 multibyte
= XCAR (unwind_data
);
3287 unwind_data
= XCDR (unwind_data
);
3288 undo_list
= XCAR (unwind_data
);
3289 buffer
= XCDR (unwind_data
);
3291 set_buffer_internal (XBUFFER (buffer
));
3292 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3293 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3294 set_buffer_intervals (current_buffer
, NULL
);
3295 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3297 /* Now we are safe to change the buffer's multibyteness directly. */
3298 bset_enable_multibyte_characters (current_buffer
, multibyte
);
3299 bset_undo_list (current_buffer
, undo_list
);
3302 /* Read from a non-regular file. STATE is a Lisp_Save_Value
3303 object where slot 0 is the file descriptor, slot 1 specifies
3304 an offset to put the read bytes, and slot 2 is the maximum
3305 amount of bytes to read. Value is the number of bytes read. */
3308 read_non_regular (Lisp_Object state
)
3314 nbytes
= emacs_read (XSAVE_INTEGER (state
, 0),
3315 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
3316 + XSAVE_INTEGER (state
, 1)),
3317 XSAVE_INTEGER (state
, 2));
3319 /* Fast recycle this object for the likely next call. */
3321 return make_number (nbytes
);
3325 /* Condition-case handler used when reading from non-regular files
3326 in insert-file-contents. */
3329 read_non_regular_quit (Lisp_Object ignore
)
3334 /* Return the file offset that VAL represents, checking for type
3335 errors and overflow. */
3337 file_offset (Lisp_Object val
)
3339 if (RANGED_INTEGERP (0, val
, TYPE_MAXIMUM (off_t
)))
3344 double v
= XFLOAT_DATA (val
);
3346 && (sizeof (off_t
) < sizeof v
3347 ? v
<= TYPE_MAXIMUM (off_t
)
3348 : v
< TYPE_MAXIMUM (off_t
)))
3352 wrong_type_argument (intern ("file-offset"), val
);
3355 /* Return a special time value indicating the error number ERRNUM. */
3356 static struct timespec
3357 time_error_value (int errnum
)
3359 int ns
= (errnum
== ENOENT
|| errnum
== EACCES
|| errnum
== ENOTDIR
3360 ? NONEXISTENT_MODTIME_NSECS
3361 : UNKNOWN_MODTIME_NSECS
);
3362 return make_timespec (0, ns
);
3365 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3367 doc
: /* Insert contents of file FILENAME after point.
3368 Returns list of absolute file name and number of characters inserted.
3369 If second argument VISIT is non-nil, the buffer's visited filename and
3370 last save file modtime are set, and it is marked unmodified. If
3371 visiting and the file does not exist, visiting is completed before the
3374 The optional third and fourth arguments BEG and END specify what portion
3375 of the file to insert. These arguments count bytes in the file, not
3376 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3378 If optional fifth argument REPLACE is non-nil, replace the current
3379 buffer contents (in the accessible portion) with the file contents.
3380 This is better than simply deleting and inserting the whole thing
3381 because (1) it preserves some marker positions and (2) it puts less data
3382 in the undo list. When REPLACE is non-nil, the second return value is
3383 the number of characters that replace previous buffer contents.
3385 This function does code conversion according to the value of
3386 `coding-system-for-read' or `file-coding-system-alist', and sets the
3387 variable `last-coding-system-used' to the coding system actually used.
3389 In addition, this function decodes the inserted text from known formats
3390 by calling `format-decode', which see. */)
3391 (Lisp_Object filename
, Lisp_Object visit
, Lisp_Object beg
, Lisp_Object end
, Lisp_Object replace
)
3394 struct timespec mtime
;
3396 ptrdiff_t inserted
= 0;
3398 off_t beg_offset
, end_offset
;
3400 ptrdiff_t count
= SPECPDL_INDEX ();
3401 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3402 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3404 ptrdiff_t total
= 0;
3405 bool not_regular
= 0;
3407 char read_buf
[READ_BUF_SIZE
];
3408 struct coding_system coding
;
3409 bool replace_handled
= 0;
3410 bool set_coding_system
= 0;
3411 Lisp_Object coding_system
;
3413 /* If the undo log only contains the insertion, there's no point
3414 keeping it. It's typically when we first fill a file-buffer. */
3415 bool empty_undo_list_p
3416 = (!NILP (visit
) && NILP (BVAR (current_buffer
, undo_list
))
3418 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3419 bool we_locked_file
= 0;
3422 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3423 error ("Cannot do file visiting in an indirect buffer");
3425 if (!NILP (BVAR (current_buffer
, read_only
)))
3426 Fbarf_if_buffer_read_only ();
3430 orig_filename
= Qnil
;
3433 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3435 CHECK_STRING (filename
);
3436 filename
= Fexpand_file_name (filename
, Qnil
);
3438 /* The value Qnil means that the coding system is not yet
3440 coding_system
= Qnil
;
3442 /* If the file name has special constructs in it,
3443 call the corresponding file handler. */
3444 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3445 if (!NILP (handler
))
3447 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3448 visit
, beg
, end
, replace
);
3449 if (CONSP (val
) && CONSP (XCDR (val
))
3450 && RANGED_INTEGERP (0, XCAR (XCDR (val
)), ZV
- PT
))
3451 inserted
= XINT (XCAR (XCDR (val
)));
3455 orig_filename
= filename
;
3456 filename
= ENCODE_FILE (filename
);
3458 fd
= emacs_open (SSDATA (filename
), O_RDONLY
, 0);
3463 report_file_error ("Opening input file", orig_filename
);
3464 mtime
= time_error_value (save_errno
);
3466 if (!NILP (Vcoding_system_for_read
))
3467 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3471 fd_index
= SPECPDL_INDEX ();
3472 record_unwind_protect_int (close_file_unwind
, fd
);
3474 /* Replacement should preserve point as it preserves markers. */
3475 if (!NILP (replace
))
3476 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3478 if (fstat (fd
, &st
) != 0)
3479 report_file_error ("Input file status", orig_filename
);
3480 mtime
= get_stat_mtime (&st
);
3482 /* This code will need to be changed in order to work on named
3483 pipes, and it's probably just not worth it. So we should at
3484 least signal an error. */
3485 if (!S_ISREG (st
.st_mode
))
3492 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3493 xsignal2 (Qfile_error
,
3494 build_string ("not a regular file"), orig_filename
);
3499 if (!NILP (beg
) || !NILP (end
))
3500 error ("Attempt to visit less than an entire file");
3501 if (BEG
< Z
&& NILP (replace
))
3502 error ("Cannot do file visiting in a non-empty buffer");
3506 beg_offset
= file_offset (beg
);
3511 end_offset
= file_offset (end
);
3515 end_offset
= TYPE_MAXIMUM (off_t
);
3518 end_offset
= st
.st_size
;
3520 /* A negative size can happen on a platform that allows file
3521 sizes greater than the maximum off_t value. */
3525 /* The file size returned from stat may be zero, but data
3526 may be readable nonetheless, for example when this is a
3527 file in the /proc filesystem. */
3528 if (end_offset
== 0)
3529 end_offset
= READ_BUF_SIZE
;
3533 /* Check now whether the buffer will become too large,
3534 in the likely case where the file's length is not changing.
3535 This saves a lot of needless work before a buffer overflow. */
3538 /* The likely offset where we will stop reading. We could read
3539 more (or less), if the file grows (or shrinks) as we read it. */
3540 off_t likely_end
= min (end_offset
, st
.st_size
);
3542 if (beg_offset
< likely_end
)
3545 = Z_BYTE
- (!NILP (replace
) ? ZV_BYTE
- BEGV_BYTE
: 0);
3546 ptrdiff_t buf_growth_max
= BUF_BYTES_MAX
- buf_bytes
;
3547 off_t likely_growth
= likely_end
- beg_offset
;
3548 if (buf_growth_max
< likely_growth
)
3553 /* Prevent redisplay optimizations. */
3554 current_buffer
->clip_changed
= 1;
3556 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3558 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3559 setup_coding_system (coding_system
, &coding
);
3560 /* Ensure we set Vlast_coding_system_used. */
3561 set_coding_system
= 1;
3565 /* Decide the coding system to use for reading the file now
3566 because we can't use an optimized method for handling
3567 `coding:' tag if the current buffer is not empty. */
3568 if (!NILP (Vcoding_system_for_read
))
3569 coding_system
= Vcoding_system_for_read
;
3572 /* Don't try looking inside a file for a coding system
3573 specification if it is not seekable. */
3574 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3576 /* Find a coding system specified in the heading two
3577 lines or in the tailing several lines of the file.
3578 We assume that the 1K-byte and 3K-byte for heading
3579 and tailing respectively are sufficient for this
3583 if (st
.st_size
<= (1024 * 4))
3584 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3587 nread
= emacs_read (fd
, read_buf
, 1024);
3591 if (lseek (fd
, - (1024 * 3), SEEK_END
) < 0)
3592 report_file_error ("Setting file position",
3594 ntail
= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3595 nread
= ntail
< 0 ? ntail
: nread
+ ntail
;
3600 report_file_error ("Read error", orig_filename
);
3603 struct buffer
*prev
= current_buffer
;
3604 Lisp_Object workbuf
;
3607 record_unwind_current_buffer ();
3609 workbuf
= Fget_buffer_create (build_string (" *code-converting-work*"));
3610 buf
= XBUFFER (workbuf
);
3612 delete_all_overlays (buf
);
3613 bset_directory (buf
, BVAR (current_buffer
, directory
));
3614 bset_read_only (buf
, Qnil
);
3615 bset_filename (buf
, Qnil
);
3616 bset_undo_list (buf
, Qt
);
3617 eassert (buf
->overlays_before
== NULL
);
3618 eassert (buf
->overlays_after
== NULL
);
3620 set_buffer_internal (buf
);
3622 bset_enable_multibyte_characters (buf
, Qnil
);
3624 insert_1_both ((char *) read_buf
, nread
, nread
, 0, 0, 0);
3625 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3626 coding_system
= call2 (Vset_auto_coding_function
,
3627 filename
, make_number (nread
));
3628 set_buffer_internal (prev
);
3630 /* Discard the unwind protect for recovering the
3634 /* Rewind the file for the actual read done later. */
3635 if (lseek (fd
, 0, SEEK_SET
) < 0)
3636 report_file_error ("Setting file position", orig_filename
);
3640 if (NILP (coding_system
))
3642 /* If we have not yet decided a coding system, check
3643 file-coding-system-alist. */
3644 Lisp_Object args
[6];
3646 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3647 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3648 coding_system
= Ffind_operation_coding_system (6, args
);
3649 if (CONSP (coding_system
))
3650 coding_system
= XCAR (coding_system
);
3654 if (NILP (coding_system
))
3655 coding_system
= Qundecided
;
3657 CHECK_CODING_SYSTEM (coding_system
);
3659 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3660 /* We must suppress all character code conversion except for
3661 end-of-line conversion. */
3662 coding_system
= raw_text_coding_system (coding_system
);
3664 setup_coding_system (coding_system
, &coding
);
3665 /* Ensure we set Vlast_coding_system_used. */
3666 set_coding_system
= 1;
3669 /* If requested, replace the accessible part of the buffer
3670 with the file contents. Avoid replacing text at the
3671 beginning or end of the buffer that matches the file contents;
3672 that preserves markers pointing to the unchanged parts.
3674 Here we implement this feature in an optimized way
3675 for the case where code conversion is NOT needed.
3676 The following if-statement handles the case of conversion
3677 in a less optimal way.
3679 If the code conversion is "automatic" then we try using this
3680 method and hope for the best.
3681 But if we discover the need for conversion, we give up on this method
3682 and let the following if-statement handle the replace job. */
3685 && (NILP (coding_system
)
3686 || ! CODING_REQUIRE_DECODING (&coding
)))
3688 /* same_at_start and same_at_end count bytes,
3689 because file access counts bytes
3690 and BEG and END count bytes. */
3691 ptrdiff_t same_at_start
= BEGV_BYTE
;
3692 ptrdiff_t same_at_end
= ZV_BYTE
;
3694 /* There is still a possibility we will find the need to do code
3695 conversion. If that happens, set this variable to
3696 give up on handling REPLACE in the optimized way. */
3697 bool giveup_match_end
= 0;
3699 if (beg_offset
!= 0)
3701 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
3702 report_file_error ("Setting file position", orig_filename
);
3707 /* Count how many chars at the start of the file
3708 match the text at the beginning of the buffer. */
3713 nread
= emacs_read (fd
, read_buf
, sizeof read_buf
);
3715 report_file_error ("Read error", orig_filename
);
3716 else if (nread
== 0)
3719 if (CODING_REQUIRE_DETECTION (&coding
))
3721 coding_system
= detect_coding_system ((unsigned char *) read_buf
,
3724 setup_coding_system (coding_system
, &coding
);
3727 if (CODING_REQUIRE_DECODING (&coding
))
3728 /* We found that the file should be decoded somehow.
3729 Let's give up here. */
3731 giveup_match_end
= 1;
3736 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3737 && FETCH_BYTE (same_at_start
) == read_buf
[bufpos
])
3738 same_at_start
++, bufpos
++;
3739 /* If we found a discrepancy, stop the scan.
3740 Otherwise loop around and scan the next bufferful. */
3741 if (bufpos
!= nread
)
3745 /* If the file matches the buffer completely,
3746 there's no need to replace anything. */
3747 if (same_at_start
- BEGV_BYTE
== end_offset
- beg_offset
)
3750 clear_unwind_protect (fd_index
);
3752 /* Truncate the buffer to the size of the file. */
3753 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3758 /* Count how many chars at the end of the file
3759 match the text at the end of the buffer. But, if we have
3760 already found that decoding is necessary, don't waste time. */
3761 while (!giveup_match_end
)
3763 int total_read
, nread
, bufpos
, trial
;
3766 /* At what file position are we now scanning? */
3767 curpos
= end_offset
- (ZV_BYTE
- same_at_end
);
3768 /* If the entire file matches the buffer tail, stop the scan. */
3771 /* How much can we scan in the next step? */
3772 trial
= min (curpos
, sizeof read_buf
);
3773 if (lseek (fd
, curpos
- trial
, SEEK_SET
) < 0)
3774 report_file_error ("Setting file position", orig_filename
);
3776 total_read
= nread
= 0;
3777 while (total_read
< trial
)
3779 nread
= emacs_read (fd
, read_buf
+ total_read
, trial
- total_read
);
3781 report_file_error ("Read error", orig_filename
);
3782 else if (nread
== 0)
3784 total_read
+= nread
;
3787 /* Scan this bufferful from the end, comparing with
3788 the Emacs buffer. */
3789 bufpos
= total_read
;
3791 /* Compare with same_at_start to avoid counting some buffer text
3792 as matching both at the file's beginning and at the end. */
3793 while (bufpos
> 0 && same_at_end
> same_at_start
3794 && FETCH_BYTE (same_at_end
- 1) == read_buf
[bufpos
- 1])
3795 same_at_end
--, bufpos
--;
3797 /* If we found a discrepancy, stop the scan.
3798 Otherwise loop around and scan the preceding bufferful. */
3801 /* If this discrepancy is because of code conversion,
3802 we cannot use this method; giveup and try the other. */
3803 if (same_at_end
> same_at_start
3804 && FETCH_BYTE (same_at_end
- 1) >= 0200
3805 && ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3806 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3807 giveup_match_end
= 1;
3816 if (! giveup_match_end
)
3820 /* We win! We can handle REPLACE the optimized way. */
3822 /* Extend the start of non-matching text area to multibyte
3823 character boundary. */
3824 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3825 while (same_at_start
> BEGV_BYTE
3826 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3829 /* Extend the end of non-matching text area to multibyte
3830 character boundary. */
3831 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3832 while (same_at_end
< ZV_BYTE
3833 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3836 /* Don't try to reuse the same piece of text twice. */
3837 overlap
= (same_at_start
- BEGV_BYTE
3839 + (! NILP (end
) ? end_offset
: st
.st_size
) - ZV_BYTE
));
3841 same_at_end
+= overlap
;
3843 /* Arrange to read only the nonmatching middle part of the file. */
3844 beg_offset
+= same_at_start
- BEGV_BYTE
;
3845 end_offset
-= ZV_BYTE
- same_at_end
;
3847 del_range_byte (same_at_start
, same_at_end
, 0);
3848 /* Insert from the file at the proper position. */
3849 temp
= BYTE_TO_CHAR (same_at_start
);
3850 SET_PT_BOTH (temp
, same_at_start
);
3852 /* If display currently starts at beginning of line,
3853 keep it that way. */
3854 if (XBUFFER (XWINDOW (selected_window
)->contents
) == current_buffer
)
3855 XWINDOW (selected_window
)->start_at_line_beg
= !NILP (Fbolp ());
3857 replace_handled
= 1;
3861 /* If requested, replace the accessible part of the buffer
3862 with the file contents. Avoid replacing text at the
3863 beginning or end of the buffer that matches the file contents;
3864 that preserves markers pointing to the unchanged parts.
3866 Here we implement this feature for the case where code conversion
3867 is needed, in a simple way that needs a lot of memory.
3868 The preceding if-statement handles the case of no conversion
3869 in a more optimized way. */
3870 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3872 ptrdiff_t same_at_start
= BEGV_BYTE
;
3873 ptrdiff_t same_at_end
= ZV_BYTE
;
3874 ptrdiff_t same_at_start_charpos
;
3875 ptrdiff_t inserted_chars
;
3878 unsigned char *decoded
;
3881 ptrdiff_t this_count
= SPECPDL_INDEX ();
3883 = ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
3884 Lisp_Object conversion_buffer
;
3885 struct gcpro gcpro1
;
3887 conversion_buffer
= code_conversion_save (1, multibyte
);
3889 /* First read the whole file, performing code conversion into
3890 CONVERSION_BUFFER. */
3892 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
3893 report_file_error ("Setting file position", orig_filename
);
3895 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3896 unprocessed
= 0; /* Bytes not processed in previous loop. */
3898 GCPRO1 (conversion_buffer
);
3901 /* Read at most READ_BUF_SIZE bytes at a time, to allow
3902 quitting while reading a huge file. */
3904 /* Allow quitting out of the actual I/O. */
3907 this = emacs_read (fd
, read_buf
+ unprocessed
,
3908 READ_BUF_SIZE
- unprocessed
);
3914 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
3915 BUF_Z (XBUFFER (conversion_buffer
)));
3916 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3917 unprocessed
+ this, conversion_buffer
);
3918 unprocessed
= coding
.carryover_bytes
;
3919 if (coding
.carryover_bytes
> 0)
3920 memcpy (read_buf
, coding
.carryover
, unprocessed
);
3924 report_file_error ("Read error", orig_filename
);
3926 clear_unwind_protect (fd_index
);
3928 if (unprocessed
> 0)
3930 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3931 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3932 unprocessed
, conversion_buffer
);
3933 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
3936 coding_system
= CODING_ID_NAME (coding
.id
);
3937 set_coding_system
= 1;
3938 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
3939 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
3940 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3942 /* Compare the beginning of the converted string with the buffer
3946 while (bufpos
< inserted
&& same_at_start
< same_at_end
3947 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
3948 same_at_start
++, bufpos
++;
3950 /* If the file matches the head of buffer completely,
3951 there's no need to replace anything. */
3953 if (bufpos
== inserted
)
3955 /* Truncate the buffer to the size of the file. */
3956 if (same_at_start
!= same_at_end
)
3957 del_range_byte (same_at_start
, same_at_end
, 0);
3960 unbind_to (this_count
, Qnil
);
3964 /* Extend the start of non-matching text area to the previous
3965 multibyte character boundary. */
3966 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3967 while (same_at_start
> BEGV_BYTE
3968 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3971 /* Scan this bufferful from the end, comparing with
3972 the Emacs buffer. */
3975 /* Compare with same_at_start to avoid counting some buffer text
3976 as matching both at the file's beginning and at the end. */
3977 while (bufpos
> 0 && same_at_end
> same_at_start
3978 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
3979 same_at_end
--, bufpos
--;
3981 /* Extend the end of non-matching text area to the next
3982 multibyte character boundary. */
3983 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3984 while (same_at_end
< ZV_BYTE
3985 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3988 /* Don't try to reuse the same piece of text twice. */
3989 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3991 same_at_end
+= overlap
;
3993 /* If display currently starts at beginning of line,
3994 keep it that way. */
3995 if (XBUFFER (XWINDOW (selected_window
)->contents
) == current_buffer
)
3996 XWINDOW (selected_window
)->start_at_line_beg
= !NILP (Fbolp ());
3998 /* Replace the chars that we need to replace,
3999 and update INSERTED to equal the number of bytes
4000 we are taking from the decoded string. */
4001 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4003 if (same_at_end
!= same_at_start
)
4005 del_range_byte (same_at_start
, same_at_end
, 0);
4007 eassert (same_at_start
== GPT_BYTE
);
4008 same_at_start
= GPT_BYTE
;
4012 temp
= BYTE_TO_CHAR (same_at_start
);
4014 /* Insert from the file at the proper position. */
4015 SET_PT_BOTH (temp
, same_at_start
);
4016 same_at_start_charpos
4017 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4018 same_at_start
- BEGV_BYTE
4019 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4020 eassert (same_at_start_charpos
== temp
- (BEGV
- BEG
));
4022 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4023 same_at_start
+ inserted
- BEGV_BYTE
4024 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
4025 - same_at_start_charpos
);
4026 /* This binding is to avoid ask-user-about-supersession-threat
4027 being called in insert_from_buffer (via in
4028 prepare_to_modify_buffer). */
4029 specbind (intern ("buffer-file-name"), Qnil
);
4030 insert_from_buffer (XBUFFER (conversion_buffer
),
4031 same_at_start_charpos
, inserted_chars
, 0);
4032 /* Set `inserted' to the number of inserted characters. */
4033 inserted
= PT
- temp
;
4034 /* Set point before the inserted characters. */
4035 SET_PT_BOTH (temp
, same_at_start
);
4037 unbind_to (this_count
, Qnil
);
4043 total
= end_offset
- beg_offset
;
4045 /* For a special file, all we can do is guess. */
4046 total
= READ_BUF_SIZE
;
4048 if (NILP (visit
) && total
> 0)
4050 #ifdef CLASH_DETECTION
4051 if (!NILP (BVAR (current_buffer
, file_truename
))
4052 /* Make binding buffer-file-name to nil effective. */
4053 && !NILP (BVAR (current_buffer
, filename
))
4054 && SAVE_MODIFF
>= MODIFF
)
4056 #endif /* CLASH_DETECTION */
4057 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4060 move_gap_both (PT
, PT_BYTE
);
4061 if (GAP_SIZE
< total
)
4062 make_gap (total
- GAP_SIZE
);
4064 if (beg_offset
!= 0 || !NILP (replace
))
4066 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
4067 report_file_error ("Setting file position", orig_filename
);
4070 /* In the following loop, HOW_MUCH contains the total bytes read so
4071 far for a regular file, and not changed for a special file. But,
4072 before exiting the loop, it is set to a negative value if I/O
4076 /* Total bytes inserted. */
4079 /* Here, we don't do code conversion in the loop. It is done by
4080 decode_coding_gap after all data are read into the buffer. */
4082 ptrdiff_t gap_size
= GAP_SIZE
;
4084 while (how_much
< total
)
4086 /* try is reserved in some compilers (Microsoft C) */
4087 ptrdiff_t trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4094 /* Maybe make more room. */
4095 if (gap_size
< trytry
)
4097 make_gap (trytry
- gap_size
);
4098 gap_size
= GAP_SIZE
- inserted
;
4101 /* Read from the file, capturing `quit'. When an
4102 error occurs, end the loop, and arrange for a quit
4103 to be signaled after decoding the text we read. */
4104 nbytes
= internal_condition_case_1
4106 make_save_int_int_int (fd
, inserted
, trytry
),
4107 Qerror
, read_non_regular_quit
);
4115 this = XINT (nbytes
);
4119 /* Allow quitting out of the actual I/O. We don't make text
4120 part of the buffer until all the reading is done, so a C-g
4121 here doesn't do any harm. */
4124 this = emacs_read (fd
,
4125 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
4139 /* For a regular file, where TOTAL is the real size,
4140 count HOW_MUCH to compare with it.
4141 For a special file, where TOTAL is just a buffer size,
4142 so don't bother counting in HOW_MUCH.
4143 (INSERTED is where we count the number of characters inserted.) */
4150 /* Now we have either read all the file data into the gap,
4151 or stop reading on I/O error or quit. If nothing was
4152 read, undo marking the buffer modified. */
4156 #ifdef CLASH_DETECTION
4158 unlock_file (BVAR (current_buffer
, file_truename
));
4160 Vdeactivate_mark
= old_Vdeactivate_mark
;
4163 Vdeactivate_mark
= Qt
;
4166 clear_unwind_protect (fd_index
);
4169 report_file_error ("Read error", orig_filename
);
4171 /* Make the text read part of the buffer. */
4172 GAP_SIZE
-= inserted
;
4174 GPT_BYTE
+= inserted
;
4176 ZV_BYTE
+= inserted
;
4181 /* Put an anchor to ensure multi-byte form ends at gap. */
4186 if (NILP (coding_system
))
4188 /* The coding system is not yet decided. Decide it by an
4189 optimized method for handling `coding:' tag.
4191 Note that we can get here only if the buffer was empty
4192 before the insertion. */
4194 if (!NILP (Vcoding_system_for_read
))
4195 coding_system
= Vcoding_system_for_read
;
4198 /* Since we are sure that the current buffer was empty
4199 before the insertion, we can toggle
4200 enable-multibyte-characters directly here without taking
4201 care of marker adjustment. By this way, we can run Lisp
4202 program safely before decoding the inserted text. */
4203 Lisp_Object unwind_data
;
4204 ptrdiff_t count1
= SPECPDL_INDEX ();
4206 unwind_data
= Fcons (BVAR (current_buffer
, enable_multibyte_characters
),
4207 Fcons (BVAR (current_buffer
, undo_list
),
4208 Fcurrent_buffer ()));
4209 bset_enable_multibyte_characters (current_buffer
, Qnil
);
4210 bset_undo_list (current_buffer
, Qt
);
4211 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4213 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4215 coding_system
= call2 (Vset_auto_coding_function
,
4216 filename
, make_number (inserted
));
4219 if (NILP (coding_system
))
4221 /* If the coding system is not yet decided, check
4222 file-coding-system-alist. */
4223 Lisp_Object args
[6];
4225 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4226 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4227 coding_system
= Ffind_operation_coding_system (6, args
);
4228 if (CONSP (coding_system
))
4229 coding_system
= XCAR (coding_system
);
4231 unbind_to (count1
, Qnil
);
4232 inserted
= Z_BYTE
- BEG_BYTE
;
4235 if (NILP (coding_system
))
4236 coding_system
= Qundecided
;
4238 CHECK_CODING_SYSTEM (coding_system
);
4240 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4241 /* We must suppress all character code conversion except for
4242 end-of-line conversion. */
4243 coding_system
= raw_text_coding_system (coding_system
);
4244 setup_coding_system (coding_system
, &coding
);
4245 /* Ensure we set Vlast_coding_system_used. */
4246 set_coding_system
= 1;
4251 /* When we visit a file by raw-text, we change the buffer to
4253 if (CODING_FOR_UNIBYTE (&coding
)
4254 /* Can't do this if part of the buffer might be preserved. */
4256 /* Visiting a file with these coding system makes the buffer
4258 bset_enable_multibyte_characters (current_buffer
, Qnil
);
4261 coding
.dst_multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
4262 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4263 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4265 move_gap_both (PT
, PT_BYTE
);
4266 GAP_SIZE
+= inserted
;
4267 ZV_BYTE
-= inserted
;
4271 decode_coding_gap (&coding
, inserted
, inserted
);
4272 inserted
= coding
.produced_char
;
4273 coding_system
= CODING_ID_NAME (coding
.id
);
4275 else if (inserted
> 0)
4276 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4279 /* Call after-change hooks for the inserted text, aside from the case
4280 of normal visiting (not with REPLACE), which is done in a new buffer
4281 "before" the buffer is changed. */
4282 if (inserted
> 0 && total
> 0
4283 && (NILP (visit
) || !NILP (replace
)))
4285 signal_after_change (PT
, 0, inserted
);
4286 update_compositions (PT
, PT
, CHECK_BORDER
);
4289 /* Now INSERTED is measured in characters. */
4295 if (empty_undo_list_p
)
4296 bset_undo_list (current_buffer
, Qnil
);
4300 current_buffer
->modtime
= mtime
;
4301 current_buffer
->modtime_size
= st
.st_size
;
4302 bset_filename (current_buffer
, orig_filename
);
4305 SAVE_MODIFF
= MODIFF
;
4306 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
4307 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4308 #ifdef CLASH_DETECTION
4311 if (!NILP (BVAR (current_buffer
, file_truename
)))
4312 unlock_file (BVAR (current_buffer
, file_truename
));
4313 unlock_file (filename
);
4315 #endif /* CLASH_DETECTION */
4317 xsignal2 (Qfile_error
,
4318 build_string ("not a regular file"), orig_filename
);
4321 if (set_coding_system
)
4322 Vlast_coding_system_used
= coding_system
;
4324 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4326 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4328 if (! NILP (insval
))
4330 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4331 wrong_type_argument (intern ("inserted-chars"), insval
);
4332 inserted
= XFASTINT (insval
);
4336 /* Decode file format. */
4339 /* Don't run point motion or modification hooks when decoding. */
4340 ptrdiff_t count1
= SPECPDL_INDEX ();
4341 ptrdiff_t old_inserted
= inserted
;
4342 specbind (Qinhibit_point_motion_hooks
, Qt
);
4343 specbind (Qinhibit_modification_hooks
, Qt
);
4345 /* Save old undo list and don't record undo for decoding. */
4346 old_undo
= BVAR (current_buffer
, undo_list
);
4347 bset_undo_list (current_buffer
, Qt
);
4351 insval
= call3 (Qformat_decode
,
4352 Qnil
, make_number (inserted
), visit
);
4353 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4354 wrong_type_argument (intern ("inserted-chars"), insval
);
4355 inserted
= XFASTINT (insval
);
4359 /* If REPLACE is non-nil and we succeeded in not replacing the
4360 beginning or end of the buffer text with the file's contents,
4361 call format-decode with `point' positioned at the beginning
4362 of the buffer and `inserted' equaling the number of
4363 characters in the buffer. Otherwise, format-decode might
4364 fail to correctly analyze the beginning or end of the buffer.
4365 Hence we temporarily save `point' and `inserted' here and
4366 restore `point' iff format-decode did not insert or delete
4367 any text. Otherwise we leave `point' at point-min. */
4368 ptrdiff_t opoint
= PT
;
4369 ptrdiff_t opoint_byte
= PT_BYTE
;
4370 ptrdiff_t oinserted
= ZV
- BEGV
;
4371 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4373 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4374 insval
= call3 (Qformat_decode
,
4375 Qnil
, make_number (oinserted
), visit
);
4376 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4377 wrong_type_argument (intern ("inserted-chars"), insval
);
4378 if (ochars_modiff
== CHARS_MODIFF
)
4379 /* format_decode didn't modify buffer's characters => move
4380 point back to position before inserted text and leave
4381 value of inserted alone. */
4382 SET_PT_BOTH (opoint
, opoint_byte
);
4384 /* format_decode modified buffer's characters => consider
4385 entire buffer changed and leave point at point-min. */
4386 inserted
= XFASTINT (insval
);
4389 /* For consistency with format-decode call these now iff inserted > 0
4390 (martin 2007-06-28). */
4391 p
= Vafter_insert_file_functions
;
4396 insval
= call1 (XCAR (p
), make_number (inserted
));
4399 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4400 wrong_type_argument (intern ("inserted-chars"), insval
);
4401 inserted
= XFASTINT (insval
);
4406 /* For the rationale of this see the comment on
4407 format-decode above. */
4408 ptrdiff_t opoint
= PT
;
4409 ptrdiff_t opoint_byte
= PT_BYTE
;
4410 ptrdiff_t oinserted
= ZV
- BEGV
;
4411 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4413 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4414 insval
= call1 (XCAR (p
), make_number (oinserted
));
4417 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4418 wrong_type_argument (intern ("inserted-chars"), insval
);
4419 if (ochars_modiff
== CHARS_MODIFF
)
4420 /* after_insert_file_functions didn't modify
4421 buffer's characters => move point back to
4422 position before inserted text and leave value of
4424 SET_PT_BOTH (opoint
, opoint_byte
);
4426 /* after_insert_file_functions did modify buffer's
4427 characters => consider entire buffer changed and
4428 leave point at point-min. */
4429 inserted
= XFASTINT (insval
);
4437 if (!empty_undo_list_p
)
4439 bset_undo_list (current_buffer
, old_undo
);
4440 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4442 /* Adjust the last undo record for the size change during
4443 the format conversion. */
4444 Lisp_Object tem
= XCAR (old_undo
);
4445 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4446 && INTEGERP (XCDR (tem
))
4447 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4448 XSETCDR (tem
, make_number (PT
+ inserted
));
4452 /* If undo_list was Qt before, keep it that way.
4453 Otherwise start with an empty undo_list. */
4454 bset_undo_list (current_buffer
, EQ (old_undo
, Qt
) ? Qt
: Qnil
);
4456 unbind_to (count1
, Qnil
);
4460 && current_buffer
->modtime
.tv_nsec
== NONEXISTENT_MODTIME_NSECS
)
4462 /* If visiting nonexistent file, return nil. */
4463 report_file_errno ("Opening input file", orig_filename
, save_errno
);
4467 Fsignal (Qquit
, Qnil
);
4469 /* Retval needs to be dealt with in all cases consistently. */
4471 val
= list2 (orig_filename
, make_number (inserted
));
4473 RETURN_UNGCPRO (unbind_to (count
, val
));
4476 static Lisp_Object
build_annotations (Lisp_Object
, Lisp_Object
);
4479 build_annotations_unwind (Lisp_Object arg
)
4481 Vwrite_region_annotation_buffers
= arg
;
4484 /* Decide the coding-system to encode the data with. */
4486 DEFUN ("choose-write-coding-system", Fchoose_write_coding_system
,
4487 Schoose_write_coding_system
, 3, 6, 0,
4488 doc
: /* Choose the coding system for writing a file.
4489 Arguments are as for `write-region'.
4490 This function is for internal use only. It may prompt the user. */ )
4491 (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4492 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
)
4495 Lisp_Object eol_parent
= Qnil
;
4497 /* Mimic write-region behavior. */
4500 XSETFASTINT (start
, BEGV
);
4501 XSETFASTINT (end
, ZV
);
4505 && NILP (Fstring_equal (BVAR (current_buffer
, filename
),
4506 BVAR (current_buffer
, auto_save_file_name
))))
4511 else if (!NILP (Vcoding_system_for_write
))
4513 val
= Vcoding_system_for_write
;
4514 if (coding_system_require_warning
4515 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4516 /* Confirm that VAL can surely encode the current region. */
4517 val
= call5 (Vselect_safe_coding_system_function
,
4518 start
, end
, list2 (Qt
, val
),
4523 /* If the variable `buffer-file-coding-system' is set locally,
4524 it means that the file was read with some kind of code
4525 conversion or the variable is explicitly set by users. We
4526 had better write it out with the same coding system even if
4527 `enable-multibyte-characters' is nil.
4529 If it is not set locally, we anyway have to convert EOL
4530 format if the default value of `buffer-file-coding-system'
4531 tells that it is not Unix-like (LF only) format. */
4532 bool using_default_coding
= 0;
4533 bool force_raw_text
= 0;
4535 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4537 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4540 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4546 /* Check file-coding-system-alist. */
4547 Lisp_Object args
[7], coding_systems
;
4549 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4550 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4552 coding_systems
= Ffind_operation_coding_system (7, args
);
4553 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4554 val
= XCDR (coding_systems
);
4559 /* If we still have not decided a coding system, use the
4560 default value of buffer-file-coding-system. */
4561 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4562 using_default_coding
= 1;
4565 if (! NILP (val
) && ! force_raw_text
)
4567 Lisp_Object spec
, attrs
;
4569 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4570 attrs
= AREF (spec
, 0);
4571 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4576 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4577 /* Confirm that VAL can surely encode the current region. */
4578 val
= call5 (Vselect_safe_coding_system_function
,
4579 start
, end
, val
, Qnil
, filename
);
4581 /* If the decided coding-system doesn't specify end-of-line
4582 format, we use that of
4583 `default-buffer-file-coding-system'. */
4584 if (! using_default_coding
4585 && ! NILP (BVAR (&buffer_defaults
, buffer_file_coding_system
)))
4586 val
= (coding_inherit_eol_type
4587 (val
, BVAR (&buffer_defaults
, buffer_file_coding_system
)));
4589 /* If we decide not to encode text, use `raw-text' or one of its
4592 val
= raw_text_coding_system (val
);
4595 val
= coding_inherit_eol_type (val
, eol_parent
);
4599 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4600 "r\nFWrite region to file: \ni\ni\ni\np",
4601 doc
: /* Write current region into specified file.
4602 When called from a program, requires three arguments:
4603 START, END and FILENAME. START and END are normally buffer positions
4604 specifying the part of the buffer to write.
4605 If START is nil, that means to use the entire buffer contents.
4606 If START is a string, then output that string to the file
4607 instead of any buffer contents; END is ignored.
4609 Optional fourth argument APPEND if non-nil means
4610 append to existing file contents (if any). If it is a number,
4611 seek to that offset in the file before writing.
4612 Optional fifth argument VISIT, if t or a string, means
4613 set the last-save-file-modtime of buffer to this file's modtime
4614 and mark buffer not modified.
4615 If VISIT is a string, it is a second file name;
4616 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4617 VISIT is also the file name to lock and unlock for clash detection.
4618 If VISIT is neither t nor nil nor a string,
4619 that means do not display the \"Wrote file\" message.
4620 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4621 use for locking and unlocking, overriding FILENAME and VISIT.
4622 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4623 for an existing file with the same name. If MUSTBENEW is `excl',
4624 that means to get an error if the file already exists; never overwrite.
4625 If MUSTBENEW is neither nil nor `excl', that means ask for
4626 confirmation before overwriting, but do go ahead and overwrite the file
4627 if the user confirms.
4629 This does code conversion according to the value of
4630 `coding-system-for-write', `buffer-file-coding-system', or
4631 `file-coding-system-alist', and sets the variable
4632 `last-coding-system-used' to the coding system actually used.
4634 This calls `write-region-annotate-functions' at the start, and
4635 `write-region-post-annotation-function' at the end. */)
4636 (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
, Lisp_Object append
,
4637 Lisp_Object visit
, Lisp_Object lockname
, Lisp_Object mustbenew
)
4639 return write_region (start
, end
, filename
, append
, visit
, lockname
, mustbenew
,
4643 /* Like Fwrite_region, except that if DESC is nonnegative, it is a file
4644 descriptor for FILENAME, so do not open or close FILENAME. */
4647 write_region (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4648 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
,
4649 Lisp_Object mustbenew
, int desc
)
4653 off_t offset
IF_LINT (= 0);
4654 bool open_and_close_file
= desc
< 0;
4659 struct timespec modtime
;
4660 ptrdiff_t count
= SPECPDL_INDEX ();
4661 ptrdiff_t count1
IF_LINT (= 0);
4662 Lisp_Object handler
;
4663 Lisp_Object visit_file
;
4664 Lisp_Object annotations
;
4665 Lisp_Object encoded_filename
;
4666 bool visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4667 bool quietly
= !NILP (visit
);
4668 bool file_locked
= 0;
4669 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4670 struct buffer
*given_buffer
;
4671 struct coding_system coding
;
4673 if (current_buffer
->base_buffer
&& visiting
)
4674 error ("Cannot do file visiting in an indirect buffer");
4676 if (!NILP (start
) && !STRINGP (start
))
4677 validate_region (&start
, &end
);
4680 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4682 filename
= Fexpand_file_name (filename
, Qnil
);
4684 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4685 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4687 if (STRINGP (visit
))
4688 visit_file
= Fexpand_file_name (visit
, Qnil
);
4690 visit_file
= filename
;
4692 if (NILP (lockname
))
4693 lockname
= visit_file
;
4697 /* If the file name has special constructs in it,
4698 call the corresponding file handler. */
4699 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4700 /* If FILENAME has no handler, see if VISIT has one. */
4701 if (NILP (handler
) && STRINGP (visit
))
4702 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4704 if (!NILP (handler
))
4707 val
= call6 (handler
, Qwrite_region
, start
, end
,
4708 filename
, append
, visit
);
4712 SAVE_MODIFF
= MODIFF
;
4713 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4714 bset_filename (current_buffer
, visit_file
);
4720 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4722 /* Special kludge to simplify auto-saving. */
4725 /* Do it later, so write-region-annotate-function can work differently
4726 if we save "the buffer" vs "a region".
4727 This is useful in tar-mode. --Stef
4728 XSETFASTINT (start, BEG);
4729 XSETFASTINT (end, Z); */
4733 record_unwind_protect (build_annotations_unwind
,
4734 Vwrite_region_annotation_buffers
);
4735 Vwrite_region_annotation_buffers
= list1 (Fcurrent_buffer ());
4737 given_buffer
= current_buffer
;
4739 if (!STRINGP (start
))
4741 annotations
= build_annotations (start
, end
);
4743 if (current_buffer
!= given_buffer
)
4745 XSETFASTINT (start
, BEGV
);
4746 XSETFASTINT (end
, ZV
);
4752 XSETFASTINT (start
, BEGV
);
4753 XSETFASTINT (end
, ZV
);
4758 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4760 /* Decide the coding-system to encode the data with.
4761 We used to make this choice before calling build_annotations, but that
4762 leads to problems when a write-annotate-function takes care of
4763 unsavable chars (as was the case with X-Symbol). */
4764 Vlast_coding_system_used
=
4765 Fchoose_write_coding_system (start
, end
, filename
,
4766 append
, visit
, lockname
);
4768 setup_coding_system (Vlast_coding_system_used
, &coding
);
4770 if (!STRINGP (start
) && !NILP (BVAR (current_buffer
, selective_display
)))
4771 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4773 #ifdef CLASH_DETECTION
4774 if (open_and_close_file
&& !auto_saving
)
4776 lock_file (lockname
);
4779 #endif /* CLASH_DETECTION */
4781 encoded_filename
= ENCODE_FILE (filename
);
4782 fn
= SSDATA (encoded_filename
);
4783 open_flags
= O_WRONLY
| O_BINARY
| O_CREAT
;
4784 open_flags
|= EQ (mustbenew
, Qexcl
) ? O_EXCL
: !NILP (append
) ? 0 : O_TRUNC
;
4785 if (NUMBERP (append
))
4786 offset
= file_offset (append
);
4787 else if (!NILP (append
))
4788 open_flags
|= O_APPEND
;
4790 mode
= S_IREAD
| S_IWRITE
;
4792 mode
= auto_saving
? auto_save_mode_bits
: 0666;
4795 if (open_and_close_file
)
4797 desc
= emacs_open (fn
, open_flags
, mode
);
4800 int open_errno
= errno
;
4801 #ifdef CLASH_DETECTION
4803 unlock_file (lockname
);
4804 #endif /* CLASH_DETECTION */
4806 report_file_errno ("Opening output file", filename
, open_errno
);
4809 count1
= SPECPDL_INDEX ();
4810 record_unwind_protect_int (close_file_unwind
, desc
);
4813 if (NUMBERP (append
))
4815 off_t ret
= lseek (desc
, offset
, SEEK_SET
);
4818 int lseek_errno
= errno
;
4819 #ifdef CLASH_DETECTION
4821 unlock_file (lockname
);
4822 #endif /* CLASH_DETECTION */
4824 report_file_errno ("Lseek error", filename
, lseek_errno
);
4832 if (STRINGP (start
))
4833 ok
= a_write (desc
, start
, 0, SCHARS (start
), &annotations
, &coding
);
4834 else if (XINT (start
) != XINT (end
))
4835 ok
= a_write (desc
, Qnil
, XINT (start
), XINT (end
) - XINT (start
),
4836 &annotations
, &coding
);
4839 /* If file was empty, still need to write the annotations. */
4840 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4841 ok
= a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4845 if (ok
&& CODING_REQUIRE_FLUSHING (&coding
)
4846 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
))
4848 /* We have to flush out a data. */
4849 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4850 ok
= e_write (desc
, Qnil
, 1, 1, &coding
);
4856 /* fsync is not crucial for temporary files. Nor for auto-save
4857 files, since they might lose some work anyway. */
4858 if (open_and_close_file
&& !auto_saving
&& !write_region_inhibit_fsync
)
4860 /* Transfer data and metadata to disk, retrying if interrupted.
4861 fsync can report a write failure here, e.g., due to disk full
4862 under NFS. But ignore EINVAL, which means fsync is not
4863 supported on this file. */
4864 while (fsync (desc
) != 0)
4867 if (errno
!= EINVAL
)
4868 ok
= 0, save_errno
= errno
;
4873 modtime
= invalid_timespec ();
4876 if (fstat (desc
, &st
) == 0)
4877 modtime
= get_stat_mtime (&st
);
4879 ok
= 0, save_errno
= errno
;
4882 if (open_and_close_file
)
4884 /* NFS can report a write failure now. */
4885 if (emacs_close (desc
) < 0)
4886 ok
= 0, save_errno
= errno
;
4888 /* Discard the unwind protect for close_file_unwind. */
4889 specpdl_ptr
= specpdl
+ count1
;
4892 /* Some file systems have a bug where st_mtime is not updated
4893 properly after a write. For example, CIFS might not see the
4894 st_mtime change until after the file is opened again.
4896 Attempt to detect this file system bug, and update MODTIME to the
4897 newer st_mtime if the bug appears to be present. This introduces
4898 a race condition, so to avoid most instances of the race condition
4899 on non-buggy file systems, skip this check if the most recently
4900 encountered non-buggy file system was the current file system.
4902 A race condition can occur if some other process modifies the
4903 file between the fstat above and the fstat below, but the race is
4904 unlikely and a similar race between the last write and the fstat
4905 above cannot possibly be closed anyway. */
4907 if (timespec_valid_p (modtime
)
4908 && ! (valid_timestamp_file_system
&& st
.st_dev
== timestamp_file_system
))
4910 int desc1
= emacs_open (fn
, O_WRONLY
| O_BINARY
, 0);
4914 if (fstat (desc1
, &st1
) == 0
4915 && st
.st_dev
== st1
.st_dev
&& st
.st_ino
== st1
.st_ino
)
4917 /* Use the heuristic if it appears to be valid. With neither
4918 O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the
4919 file, the time stamp won't change. Also, some non-POSIX
4920 systems don't update an empty file's time stamp when
4921 truncating it. Finally, file systems with 100 ns or worse
4922 resolution sometimes seem to have bugs: on a system with ns
4923 resolution, checking ns % 100 incorrectly avoids the heuristic
4924 1% of the time, but the problem should be temporary as we will
4925 try again on the next time stamp. */
4927 = ((open_flags
& (O_EXCL
| O_TRUNC
)) != 0
4929 && modtime
.tv_nsec
% 100 != 0);
4931 struct timespec modtime1
= get_stat_mtime (&st1
);
4933 && timespec_cmp (modtime
, modtime1
) == 0
4934 && st
.st_size
== st1
.st_size
)
4936 timestamp_file_system
= st
.st_dev
;
4937 valid_timestamp_file_system
= 1;
4941 st
.st_size
= st1
.st_size
;
4945 emacs_close (desc1
);
4949 /* Call write-region-post-annotation-function. */
4950 while (CONSP (Vwrite_region_annotation_buffers
))
4952 Lisp_Object buf
= XCAR (Vwrite_region_annotation_buffers
);
4953 if (!NILP (Fbuffer_live_p (buf
)))
4956 if (FUNCTIONP (Vwrite_region_post_annotation_function
))
4957 call0 (Vwrite_region_post_annotation_function
);
4959 Vwrite_region_annotation_buffers
4960 = XCDR (Vwrite_region_annotation_buffers
);
4963 unbind_to (count
, Qnil
);
4965 #ifdef CLASH_DETECTION
4967 unlock_file (lockname
);
4968 #endif /* CLASH_DETECTION */
4970 /* Do this before reporting IO error
4971 to avoid a "file has changed on disk" warning on
4972 next attempt to save. */
4973 if (timespec_valid_p (modtime
))
4975 current_buffer
->modtime
= modtime
;
4976 current_buffer
->modtime_size
= st
.st_size
;
4980 report_file_errno ("Write error", filename
, save_errno
);
4984 SAVE_MODIFF
= MODIFF
;
4985 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4986 bset_filename (current_buffer
, visit_file
);
4987 update_mode_lines
++;
4992 && ! NILP (Fstring_equal (BVAR (current_buffer
, filename
),
4993 BVAR (current_buffer
, auto_save_file_name
))))
4994 SAVE_MODIFF
= MODIFF
;
5000 message_with_string ((NUMBERP (append
)
5010 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5011 doc
: /* Return t if (car A) is numerically less than (car B). */)
5012 (Lisp_Object a
, Lisp_Object b
)
5014 Lisp_Object args
[2] = { Fcar (a
), Fcar (b
), };
5015 return Flss (2, args
);
5018 /* Build the complete list of annotations appropriate for writing out
5019 the text between START and END, by calling all the functions in
5020 write-region-annotate-functions and merging the lists they return.
5021 If one of these functions switches to a different buffer, we assume
5022 that buffer contains altered text. Therefore, the caller must
5023 make sure to restore the current buffer in all cases,
5024 as save-excursion would do. */
5027 build_annotations (Lisp_Object start
, Lisp_Object end
)
5029 Lisp_Object annotations
;
5031 struct gcpro gcpro1
, gcpro2
;
5032 Lisp_Object original_buffer
;
5034 bool used_global
= 0;
5036 XSETBUFFER (original_buffer
, current_buffer
);
5039 p
= Vwrite_region_annotate_functions
;
5040 GCPRO2 (annotations
, p
);
5043 struct buffer
*given_buffer
= current_buffer
;
5044 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5045 { /* Use the global value of the hook. */
5048 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5050 p
= Fappend (2, arg
);
5053 Vwrite_region_annotations_so_far
= annotations
;
5054 res
= call2 (XCAR (p
), start
, end
);
5055 /* If the function makes a different buffer current,
5056 assume that means this buffer contains altered text to be output.
5057 Reset START and END from the buffer bounds
5058 and discard all previous annotations because they should have
5059 been dealt with by this function. */
5060 if (current_buffer
!= given_buffer
)
5062 Vwrite_region_annotation_buffers
5063 = Fcons (Fcurrent_buffer (),
5064 Vwrite_region_annotation_buffers
);
5065 XSETFASTINT (start
, BEGV
);
5066 XSETFASTINT (end
, ZV
);
5069 Flength (res
); /* Check basic validity of return value */
5070 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5074 /* Now do the same for annotation functions implied by the file-format */
5075 if (auto_saving
&& (!EQ (BVAR (current_buffer
, auto_save_file_format
), Qt
)))
5076 p
= BVAR (current_buffer
, auto_save_file_format
);
5078 p
= BVAR (current_buffer
, file_format
);
5079 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5081 struct buffer
*given_buffer
= current_buffer
;
5083 Vwrite_region_annotations_so_far
= annotations
;
5085 /* Value is either a list of annotations or nil if the function
5086 has written annotations to a temporary buffer, which is now
5088 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5089 original_buffer
, make_number (i
));
5090 if (current_buffer
!= given_buffer
)
5092 XSETFASTINT (start
, BEGV
);
5093 XSETFASTINT (end
, ZV
);
5098 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5106 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5107 If STRING is nil, POS is the character position in the current buffer.
5108 Intersperse with them the annotations from *ANNOT
5109 which fall within the range of POS to POS + NCHARS,
5110 each at its appropriate position.
5112 We modify *ANNOT by discarding elements as we use them up.
5114 Return true if successful. */
5117 a_write (int desc
, Lisp_Object string
, ptrdiff_t pos
,
5118 ptrdiff_t nchars
, Lisp_Object
*annot
,
5119 struct coding_system
*coding
)
5123 ptrdiff_t lastpos
= pos
+ nchars
;
5125 while (NILP (*annot
) || CONSP (*annot
))
5127 tem
= Fcar_safe (Fcar (*annot
));
5130 nextpos
= XFASTINT (tem
);
5132 /* If there are no more annotations in this range,
5133 output the rest of the range all at once. */
5134 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5135 return e_write (desc
, string
, pos
, lastpos
, coding
);
5137 /* Output buffer text up to the next annotation's position. */
5140 if (!e_write (desc
, string
, pos
, nextpos
, coding
))
5144 /* Output the annotation. */
5145 tem
= Fcdr (Fcar (*annot
));
5148 if (!e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5151 *annot
= Fcdr (*annot
);
5156 /* Maximum number of characters that the next
5157 function encodes per one loop iteration. */
5159 enum { E_WRITE_MAX
= 8 * 1024 * 1024 };
5161 /* Write text in the range START and END into descriptor DESC,
5162 encoding them with coding system CODING. If STRING is nil, START
5163 and END are character positions of the current buffer, else they
5164 are indexes to the string STRING. Return true if successful. */
5167 e_write (int desc
, Lisp_Object string
, ptrdiff_t start
, ptrdiff_t end
,
5168 struct coding_system
*coding
)
5170 if (STRINGP (string
))
5173 end
= SCHARS (string
);
5176 /* We used to have a code for handling selective display here. But,
5177 now it is handled within encode_coding. */
5181 if (STRINGP (string
))
5183 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5184 if (CODING_REQUIRE_ENCODING (coding
))
5186 ptrdiff_t nchars
= min (end
- start
, E_WRITE_MAX
);
5188 /* Avoid creating huge Lisp string in encode_coding_object. */
5189 if (nchars
== E_WRITE_MAX
)
5190 coding
->raw_destination
= 1;
5192 encode_coding_object
5193 (coding
, string
, start
, string_char_to_byte (string
, start
),
5194 start
+ nchars
, string_char_to_byte (string
, start
+ nchars
),
5199 coding
->dst_object
= string
;
5200 coding
->consumed_char
= SCHARS (string
);
5201 coding
->produced
= SBYTES (string
);
5206 ptrdiff_t start_byte
= CHAR_TO_BYTE (start
);
5207 ptrdiff_t end_byte
= CHAR_TO_BYTE (end
);
5209 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5210 if (CODING_REQUIRE_ENCODING (coding
))
5212 ptrdiff_t nchars
= min (end
- start
, E_WRITE_MAX
);
5215 if (nchars
== E_WRITE_MAX
)
5216 coding
->raw_destination
= 1;
5218 encode_coding_object
5219 (coding
, Fcurrent_buffer (), start
, start_byte
,
5220 start
+ nchars
, CHAR_TO_BYTE (start
+ nchars
), Qt
);
5224 coding
->dst_object
= Qnil
;
5225 coding
->dst_pos_byte
= start_byte
;
5226 if (start
>= GPT
|| end
<= GPT
)
5228 coding
->consumed_char
= end
- start
;
5229 coding
->produced
= end_byte
- start_byte
;
5233 coding
->consumed_char
= GPT
- start
;
5234 coding
->produced
= GPT_BYTE
- start_byte
;
5239 if (coding
->produced
> 0)
5241 char *buf
= (coding
->raw_destination
? (char *) coding
->destination
5242 : (STRINGP (coding
->dst_object
)
5243 ? SSDATA (coding
->dst_object
)
5244 : (char *) BYTE_POS_ADDR (coding
->dst_pos_byte
)));
5245 coding
->produced
-= emacs_write_sig (desc
, buf
, coding
->produced
);
5247 if (coding
->raw_destination
)
5249 /* We're responsible for freeing this, see
5250 encode_coding_object to check why. */
5251 xfree (coding
->destination
);
5252 coding
->raw_destination
= 0;
5254 if (coding
->produced
)
5257 start
+= coding
->consumed_char
;
5263 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5264 Sverify_visited_file_modtime
, 0, 1, 0,
5265 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5266 This means that the file has not been changed since it was visited or saved.
5267 If BUF is omitted or nil, it defaults to the current buffer.
5268 See Info node `(elisp)Modification Time' for more details. */)
5273 Lisp_Object handler
;
5274 Lisp_Object filename
;
5275 struct timespec mtime
;
5285 if (!STRINGP (BVAR (b
, filename
))) return Qt
;
5286 if (b
->modtime
.tv_nsec
== UNKNOWN_MODTIME_NSECS
) return Qt
;
5288 /* If the file name has special constructs in it,
5289 call the corresponding file handler. */
5290 handler
= Ffind_file_name_handler (BVAR (b
, filename
),
5291 Qverify_visited_file_modtime
);
5292 if (!NILP (handler
))
5293 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5295 filename
= ENCODE_FILE (BVAR (b
, filename
));
5297 mtime
= (stat (SSDATA (filename
), &st
) == 0
5298 ? get_stat_mtime (&st
)
5299 : time_error_value (errno
));
5300 if (timespec_cmp (mtime
, b
->modtime
) == 0
5301 && (b
->modtime_size
< 0
5302 || st
.st_size
== b
->modtime_size
))
5307 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5308 Svisited_file_modtime
, 0, 0, 0,
5309 doc
: /* Return the current buffer's recorded visited file modification time.
5310 The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
5311 `file-attributes' returns. If the current buffer has no recorded file
5312 modification time, this function returns 0. If the visited file
5313 doesn't exist, return -1.
5314 See Info node `(elisp)Modification Time' for more details. */)
5317 int ns
= current_buffer
->modtime
.tv_nsec
;
5319 return make_number (UNKNOWN_MODTIME_NSECS
- ns
);
5320 return make_lisp_time (current_buffer
->modtime
);
5323 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5324 Sset_visited_file_modtime
, 0, 1, 0,
5325 doc
: /* Update buffer's recorded modification time from the visited file's time.
5326 Useful if the buffer was not read from the file normally
5327 or if the file itself has been changed for some known benign reason.
5328 An argument specifies the modification time value to use
5329 \(instead of that of the visited file), in the form of a list
5330 \(HIGH LOW USEC PSEC) or an integer flag as returned by
5331 `visited-file-modtime'. */)
5332 (Lisp_Object time_flag
)
5334 if (!NILP (time_flag
))
5336 struct timespec mtime
;
5337 if (INTEGERP (time_flag
))
5339 CHECK_RANGED_INTEGER (time_flag
, -1, 0);
5340 mtime
= make_timespec (0, UNKNOWN_MODTIME_NSECS
- XINT (time_flag
));
5343 mtime
= lisp_time_argument (time_flag
);
5345 current_buffer
->modtime
= mtime
;
5346 current_buffer
->modtime_size
= -1;
5350 register Lisp_Object filename
;
5352 Lisp_Object handler
;
5354 filename
= Fexpand_file_name (BVAR (current_buffer
, filename
), Qnil
);
5356 /* If the file name has special constructs in it,
5357 call the corresponding file handler. */
5358 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5359 if (!NILP (handler
))
5360 /* The handler can find the file name the same way we did. */
5361 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5363 filename
= ENCODE_FILE (filename
);
5365 if (stat (SSDATA (filename
), &st
) >= 0)
5367 current_buffer
->modtime
= get_stat_mtime (&st
);
5368 current_buffer
->modtime_size
= st
.st_size
;
5376 auto_save_error (Lisp_Object error_val
)
5378 Lisp_Object args
[3], msg
;
5380 struct gcpro gcpro1
;
5382 auto_save_error_occurred
= 1;
5384 ring_bell (XFRAME (selected_frame
));
5386 args
[0] = build_string ("Auto-saving %s: %s");
5387 args
[1] = BVAR (current_buffer
, name
);
5388 args
[2] = Ferror_message_string (error_val
);
5389 msg
= Fformat (3, args
);
5392 for (i
= 0; i
< 3; ++i
)
5397 message3_nolog (msg
);
5398 Fsleep_for (make_number (1), Qnil
);
5411 auto_save_mode_bits
= 0666;
5413 /* Get visited file's mode to become the auto save file's mode. */
5414 if (! NILP (BVAR (current_buffer
, filename
)))
5416 if (stat (SSDATA (BVAR (current_buffer
, filename
)), &st
) >= 0)
5417 /* But make sure we can overwrite it later! */
5418 auto_save_mode_bits
= (st
.st_mode
| 0600) & 0777;
5419 else if (modes
= Ffile_modes (BVAR (current_buffer
, filename
)),
5421 /* Remote files don't cooperate with stat. */
5422 auto_save_mode_bits
= (XINT (modes
) | 0600) & 0777;
5426 Fwrite_region (Qnil
, Qnil
, BVAR (current_buffer
, auto_save_file_name
), Qnil
,
5427 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5431 struct auto_save_unwind
5438 do_auto_save_unwind (void *arg
)
5440 struct auto_save_unwind
*p
= arg
;
5441 FILE *stream
= p
->stream
;
5442 minibuffer_auto_raise
= p
->auto_raise
;
5453 do_auto_save_make_dir (Lisp_Object dir
)
5457 auto_saving_dir_umask
= 077;
5458 result
= call2 (Qmake_directory
, dir
, Qt
);
5459 auto_saving_dir_umask
= 0;
5464 do_auto_save_eh (Lisp_Object ignore
)
5466 auto_saving_dir_umask
= 0;
5470 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5471 doc
: /* Auto-save all buffers that need it.
5472 This is all buffers that have auto-saving enabled
5473 and are changed since last auto-saved.
5474 Auto-saving writes the buffer into a file
5475 so that your editing is not lost if the system crashes.
5476 This file is not the file you visited; that changes only when you save.
5477 Normally we run the normal hook `auto-save-hook' before saving.
5479 A non-nil NO-MESSAGE argument means do not print any message if successful.
5480 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5481 (Lisp_Object no_message
, Lisp_Object current_only
)
5483 struct buffer
*old
= current_buffer
, *b
;
5484 Lisp_Object tail
, buf
, hook
;
5485 bool auto_saved
= 0;
5486 int do_handled_files
;
5488 FILE *stream
= NULL
;
5489 ptrdiff_t count
= SPECPDL_INDEX ();
5490 bool orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5491 bool old_message_p
= 0;
5492 struct auto_save_unwind auto_save_unwind
;
5493 struct gcpro gcpro1
, gcpro2
;
5495 if (max_specpdl_size
< specpdl_size
+ 40)
5496 max_specpdl_size
= specpdl_size
+ 40;
5501 if (NILP (no_message
))
5503 old_message_p
= push_message ();
5504 record_unwind_protect_void (pop_message_unwind
);
5507 /* Ordinarily don't quit within this function,
5508 but don't make it impossible to quit (in case we get hung in I/O). */
5512 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5513 point to non-strings reached from Vbuffer_alist. */
5515 hook
= intern ("auto-save-hook");
5516 safe_run_hooks (hook
);
5518 if (STRINGP (Vauto_save_list_file_name
))
5520 Lisp_Object listfile
;
5522 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5524 /* Don't try to create the directory when shutting down Emacs,
5525 because creating the directory might signal an error, and
5526 that would leave Emacs in a strange state. */
5527 if (!NILP (Vrun_hooks
))
5531 GCPRO2 (dir
, listfile
);
5532 dir
= Ffile_name_directory (listfile
);
5533 if (NILP (Ffile_directory_p (dir
)))
5534 internal_condition_case_1 (do_auto_save_make_dir
,
5540 stream
= emacs_fopen (SSDATA (listfile
), "w");
5543 auto_save_unwind
.stream
= stream
;
5544 auto_save_unwind
.auto_raise
= minibuffer_auto_raise
;
5545 record_unwind_protect_ptr (do_auto_save_unwind
, &auto_save_unwind
);
5546 minibuffer_auto_raise
= 0;
5548 auto_save_error_occurred
= 0;
5550 /* On first pass, save all files that don't have handlers.
5551 On second pass, save all files that do have handlers.
5553 If Emacs is crashing, the handlers may tweak what is causing
5554 Emacs to crash in the first place, and it would be a shame if
5555 Emacs failed to autosave perfectly ordinary files because it
5556 couldn't handle some ange-ftp'd file. */
5558 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5559 FOR_EACH_LIVE_BUFFER (tail
, buf
)
5563 /* Record all the buffers that have auto save mode
5564 in the special file that lists them. For each of these buffers,
5565 Record visited name (if any) and auto save name. */
5566 if (STRINGP (BVAR (b
, auto_save_file_name
))
5567 && stream
!= NULL
&& do_handled_files
== 0)
5570 if (!NILP (BVAR (b
, filename
)))
5572 fwrite (SDATA (BVAR (b
, filename
)), 1,
5573 SBYTES (BVAR (b
, filename
)), stream
);
5575 putc ('\n', stream
);
5576 fwrite (SDATA (BVAR (b
, auto_save_file_name
)), 1,
5577 SBYTES (BVAR (b
, auto_save_file_name
)), stream
);
5578 putc ('\n', stream
);
5582 if (!NILP (current_only
)
5583 && b
!= current_buffer
)
5586 /* Don't auto-save indirect buffers.
5587 The base buffer takes care of it. */
5591 /* Check for auto save enabled
5592 and file changed since last auto save
5593 and file changed since last real save. */
5594 if (STRINGP (BVAR (b
, auto_save_file_name
))
5595 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5596 && BUF_AUTOSAVE_MODIFF (b
) < BUF_MODIFF (b
)
5597 /* -1 means we've turned off autosaving for a while--see below. */
5598 && XINT (BVAR (b
, save_length
)) >= 0
5599 && (do_handled_files
5600 || NILP (Ffind_file_name_handler (BVAR (b
, auto_save_file_name
),
5603 struct timespec before_time
= current_timespec ();
5604 struct timespec after_time
;
5606 /* If we had a failure, don't try again for 20 minutes. */
5607 if (b
->auto_save_failure_time
> 0
5608 && before_time
.tv_sec
- b
->auto_save_failure_time
< 1200)
5611 set_buffer_internal (b
);
5612 if (NILP (Vauto_save_include_big_deletions
)
5613 && (XFASTINT (BVAR (b
, save_length
)) * 10
5614 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5615 /* A short file is likely to change a large fraction;
5616 spare the user annoying messages. */
5617 && XFASTINT (BVAR (b
, save_length
)) > 5000
5618 /* These messages are frequent and annoying for `*mail*'. */
5619 && !EQ (BVAR (b
, filename
), Qnil
)
5620 && NILP (no_message
))
5622 /* It has shrunk too much; turn off auto-saving here. */
5623 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5624 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5626 minibuffer_auto_raise
= 0;
5627 /* Turn off auto-saving until there's a real save,
5628 and prevent any more warnings. */
5629 XSETINT (BVAR (b
, save_length
), -1);
5630 Fsleep_for (make_number (1), Qnil
);
5633 if (!auto_saved
&& NILP (no_message
))
5634 message1 ("Auto-saving...");
5635 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5637 BUF_AUTOSAVE_MODIFF (b
) = BUF_MODIFF (b
);
5638 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5639 set_buffer_internal (old
);
5641 after_time
= current_timespec ();
5643 /* If auto-save took more than 60 seconds,
5644 assume it was an NFS failure that got a timeout. */
5645 if (after_time
.tv_sec
- before_time
.tv_sec
> 60)
5646 b
->auto_save_failure_time
= after_time
.tv_sec
;
5650 /* Prevent another auto save till enough input events come in. */
5651 record_auto_save ();
5653 if (auto_saved
&& NILP (no_message
))
5657 /* If we are going to restore an old message,
5658 give time to read ours. */
5659 sit_for (make_number (1), 0, 0);
5662 else if (!auto_save_error_occurred
)
5663 /* Don't overwrite the error message if an error occurred.
5664 If we displayed a message and then restored a state
5665 with no message, leave a "done" message on the screen. */
5666 message1 ("Auto-saving...done");
5671 /* This restores the message-stack status. */
5672 unbind_to (count
, Qnil
);
5676 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5677 Sset_buffer_auto_saved
, 0, 0, 0,
5678 doc
: /* Mark current buffer as auto-saved with its current text.
5679 No auto-save file will be written until the buffer changes again. */)
5682 /* FIXME: This should not be called in indirect buffers, since
5683 they're not autosaved. */
5684 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
5685 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5686 current_buffer
->auto_save_failure_time
= 0;
5690 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5691 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5692 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5695 current_buffer
->auto_save_failure_time
= 0;
5699 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5701 doc
: /* Return t if current buffer has been auto-saved recently.
5702 More precisely, if it has been auto-saved since last read from or saved
5703 in the visited file. If the buffer has no visited file,
5704 then any auto-save counts as "recent". */)
5707 /* FIXME: maybe we should return nil for indirect buffers since
5708 they're never autosaved. */
5709 return (SAVE_MODIFF
< BUF_AUTOSAVE_MODIFF (current_buffer
) ? Qt
: Qnil
);
5712 /* Reading and completing file names */
5714 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5715 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5716 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5717 The return value is only relevant for a call to `read-file-name' that happens
5718 before any other event (mouse or keypress) is handled. */)
5721 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) \
5722 || defined (HAVE_NS)
5723 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5726 && window_system_available (SELECTED_FRAME ()))
5733 Fread_file_name (Lisp_Object prompt
, Lisp_Object dir
, Lisp_Object default_filename
, Lisp_Object mustmatch
, Lisp_Object initial
, Lisp_Object predicate
)
5735 struct gcpro gcpro1
;
5736 Lisp_Object args
[7];
5738 GCPRO1 (default_filename
);
5739 args
[0] = intern ("read-file-name");
5742 args
[3] = default_filename
;
5743 args
[4] = mustmatch
;
5745 args
[6] = predicate
;
5746 RETURN_UNGCPRO (Ffuncall (7, args
));
5753 valid_timestamp_file_system
= 0;
5757 syms_of_fileio (void)
5759 DEFSYM (Qoperations
, "operations");
5760 DEFSYM (Qexpand_file_name
, "expand-file-name");
5761 DEFSYM (Qsubstitute_in_file_name
, "substitute-in-file-name");
5762 DEFSYM (Qdirectory_file_name
, "directory-file-name");
5763 DEFSYM (Qfile_name_directory
, "file-name-directory");
5764 DEFSYM (Qfile_name_nondirectory
, "file-name-nondirectory");
5765 DEFSYM (Qunhandled_file_name_directory
, "unhandled-file-name-directory");
5766 DEFSYM (Qfile_name_as_directory
, "file-name-as-directory");
5767 DEFSYM (Qcopy_file
, "copy-file");
5768 DEFSYM (Qmake_directory_internal
, "make-directory-internal");
5769 DEFSYM (Qmake_directory
, "make-directory");
5770 DEFSYM (Qdelete_directory_internal
, "delete-directory-internal");
5771 DEFSYM (Qdelete_file
, "delete-file");
5772 DEFSYM (Qrename_file
, "rename-file");
5773 DEFSYM (Qadd_name_to_file
, "add-name-to-file");
5774 DEFSYM (Qmake_symbolic_link
, "make-symbolic-link");
5775 DEFSYM (Qfile_exists_p
, "file-exists-p");
5776 DEFSYM (Qfile_executable_p
, "file-executable-p");
5777 DEFSYM (Qfile_readable_p
, "file-readable-p");
5778 DEFSYM (Qfile_writable_p
, "file-writable-p");
5779 DEFSYM (Qfile_symlink_p
, "file-symlink-p");
5780 DEFSYM (Qaccess_file
, "access-file");
5781 DEFSYM (Qfile_directory_p
, "file-directory-p");
5782 DEFSYM (Qfile_regular_p
, "file-regular-p");
5783 DEFSYM (Qfile_accessible_directory_p
, "file-accessible-directory-p");
5784 DEFSYM (Qfile_modes
, "file-modes");
5785 DEFSYM (Qset_file_modes
, "set-file-modes");
5786 DEFSYM (Qset_file_times
, "set-file-times");
5787 DEFSYM (Qfile_selinux_context
, "file-selinux-context");
5788 DEFSYM (Qset_file_selinux_context
, "set-file-selinux-context");
5789 DEFSYM (Qfile_acl
, "file-acl");
5790 DEFSYM (Qset_file_acl
, "set-file-acl");
5791 DEFSYM (Qfile_newer_than_file_p
, "file-newer-than-file-p");
5792 DEFSYM (Qinsert_file_contents
, "insert-file-contents");
5793 DEFSYM (Qchoose_write_coding_system
, "choose-write-coding-system");
5794 DEFSYM (Qwrite_region
, "write-region");
5795 DEFSYM (Qverify_visited_file_modtime
, "verify-visited-file-modtime");
5796 DEFSYM (Qset_visited_file_modtime
, "set-visited-file-modtime");
5797 DEFSYM (Qauto_save_coding
, "auto-save-coding");
5799 DEFSYM (Qfile_name_history
, "file-name-history");
5800 Fset (Qfile_name_history
, Qnil
);
5802 DEFSYM (Qfile_error
, "file-error");
5803 DEFSYM (Qfile_already_exists
, "file-already-exists");
5804 DEFSYM (Qfile_date_error
, "file-date-error");
5805 DEFSYM (Qfile_notify_error
, "file-notify-error");
5806 DEFSYM (Qexcl
, "excl");
5808 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system
,
5809 doc
: /* Coding system for encoding file names.
5810 If it is nil, `default-file-name-coding-system' (which see) is used. */);
5811 Vfile_name_coding_system
= Qnil
;
5813 DEFVAR_LISP ("default-file-name-coding-system",
5814 Vdefault_file_name_coding_system
,
5815 doc
: /* Default coding system for encoding file names.
5816 This variable is used only when `file-name-coding-system' is nil.
5818 This variable is set/changed by the command `set-language-environment'.
5819 User should not set this variable manually,
5820 instead use `file-name-coding-system' to get a constant encoding
5821 of file names regardless of the current language environment. */);
5822 Vdefault_file_name_coding_system
= Qnil
;
5824 DEFSYM (Qformat_decode
, "format-decode");
5825 DEFSYM (Qformat_annotate_function
, "format-annotate-function");
5826 DEFSYM (Qafter_insert_file_set_coding
, "after-insert-file-set-coding");
5827 DEFSYM (Qcar_less_than_car
, "car-less-than-car");
5829 Fput (Qfile_error
, Qerror_conditions
,
5830 Fpurecopy (list2 (Qfile_error
, Qerror
)));
5831 Fput (Qfile_error
, Qerror_message
,
5832 build_pure_c_string ("File error"));
5834 Fput (Qfile_already_exists
, Qerror_conditions
,
5835 Fpurecopy (list3 (Qfile_already_exists
, Qfile_error
, Qerror
)));
5836 Fput (Qfile_already_exists
, Qerror_message
,
5837 build_pure_c_string ("File already exists"));
5839 Fput (Qfile_date_error
, Qerror_conditions
,
5840 Fpurecopy (list3 (Qfile_date_error
, Qfile_error
, Qerror
)));
5841 Fput (Qfile_date_error
, Qerror_message
,
5842 build_pure_c_string ("Cannot set file date"));
5844 Fput (Qfile_notify_error
, Qerror_conditions
,
5845 Fpurecopy (list3 (Qfile_notify_error
, Qfile_error
, Qerror
)));
5846 Fput (Qfile_notify_error
, Qerror_message
,
5847 build_pure_c_string ("File notification error"));
5849 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist
,
5850 doc
: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
5851 If a file name matches REGEXP, all I/O on that file is done by calling
5852 HANDLER. If a file name matches more than one handler, the handler
5853 whose match starts last in the file name gets precedence. The
5854 function `find-file-name-handler' checks this list for a handler for
5857 HANDLER should be a function. The first argument given to it is the
5858 name of the I/O primitive to be handled; the remaining arguments are
5859 the arguments that were passed to that primitive. For example, if you
5860 do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
5861 HANDLER is called like this:
5863 (funcall HANDLER 'file-exists-p FILENAME)
5865 Note that HANDLER must be able to handle all I/O primitives; if it has
5866 nothing special to do for a primitive, it should reinvoke the
5867 primitive to handle the operation \"the usual way\".
5868 See Info node `(elisp)Magic File Names' for more details. */);
5869 Vfile_name_handler_alist
= Qnil
;
5871 DEFVAR_LISP ("set-auto-coding-function",
5872 Vset_auto_coding_function
,
5873 doc
: /* If non-nil, a function to call to decide a coding system of file.
5874 Two arguments are passed to this function: the file name
5875 and the length of a file contents following the point.
5876 This function should return a coding system to decode the file contents.
5877 It should check the file name against `auto-coding-alist'.
5878 If no coding system is decided, it should check a coding system
5879 specified in the heading lines with the format:
5880 -*- ... coding: CODING-SYSTEM; ... -*-
5881 or local variable spec of the tailing lines with `coding:' tag. */);
5882 Vset_auto_coding_function
= Qnil
;
5884 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions
,
5885 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
5886 Each is passed one argument, the number of characters inserted,
5887 with point at the start of the inserted text. Each function
5888 should leave point the same, and return the new character count.
5889 If `insert-file-contents' is intercepted by a handler from
5890 `file-name-handler-alist', that handler is responsible for calling the
5891 functions in `after-insert-file-functions' if appropriate. */);
5892 Vafter_insert_file_functions
= Qnil
;
5894 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions
,
5895 doc
: /* A list of functions to be called at the start of `write-region'.
5896 Each is passed two arguments, START and END as for `write-region'.
5897 These are usually two numbers but not always; see the documentation
5898 for `write-region'. The function should return a list of pairs
5899 of the form (POSITION . STRING), consisting of strings to be effectively
5900 inserted at the specified positions of the file being written (1 means to
5901 insert before the first byte written). The POSITIONs must be sorted into
5904 If there are several annotation functions, the lists returned by these
5905 functions are merged destructively. As each annotation function runs,
5906 the variable `write-region-annotations-so-far' contains a list of all
5907 annotations returned by previous annotation functions.
5909 An annotation function can return with a different buffer current.
5910 Doing so removes the annotations returned by previous functions, and
5911 resets START and END to `point-min' and `point-max' of the new buffer.
5913 After `write-region' completes, Emacs calls the function stored in
5914 `write-region-post-annotation-function', once for each buffer that was
5915 current when building the annotations (i.e., at least once), with that
5916 buffer current. */);
5917 Vwrite_region_annotate_functions
= Qnil
;
5918 DEFSYM (Qwrite_region_annotate_functions
, "write-region-annotate-functions");
5920 DEFVAR_LISP ("write-region-post-annotation-function",
5921 Vwrite_region_post_annotation_function
,
5922 doc
: /* Function to call after `write-region' completes.
5923 The function is called with no arguments. If one or more of the
5924 annotation functions in `write-region-annotate-functions' changed the
5925 current buffer, the function stored in this variable is called for
5926 each of those additional buffers as well, in addition to the original
5927 buffer. The relevant buffer is current during each function call. */);
5928 Vwrite_region_post_annotation_function
= Qnil
;
5929 staticpro (&Vwrite_region_annotation_buffers
);
5931 DEFVAR_LISP ("write-region-annotations-so-far",
5932 Vwrite_region_annotations_so_far
,
5933 doc
: /* When an annotation function is called, this holds the previous annotations.
5934 These are the annotations made by other annotation functions
5935 that were already called. See also `write-region-annotate-functions'. */);
5936 Vwrite_region_annotations_so_far
= Qnil
;
5938 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers
,
5939 doc
: /* A list of file name handlers that temporarily should not be used.
5940 This applies only to the operation `inhibit-file-name-operation'. */);
5941 Vinhibit_file_name_handlers
= Qnil
;
5943 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation
,
5944 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5945 Vinhibit_file_name_operation
= Qnil
;
5947 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name
,
5948 doc
: /* File name in which we write a list of all auto save file names.
5949 This variable is initialized automatically from `auto-save-list-file-prefix'
5950 shortly after Emacs reads your init file, if you have not yet given it
5951 a non-nil value. */);
5952 Vauto_save_list_file_name
= Qnil
;
5954 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name
,
5955 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
5956 Normally auto-save files are written under other names. */);
5957 Vauto_save_visited_file_name
= Qnil
;
5959 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions
,
5960 doc
: /* If non-nil, auto-save even if a large part of the text is deleted.
5961 If nil, deleting a substantial portion of the text disables auto-save
5962 in the buffer; this is the default behavior, because the auto-save
5963 file is usually more useful if it contains the deleted text. */);
5964 Vauto_save_include_big_deletions
= Qnil
;
5966 /* fsync can be a significant performance hit. Often it doesn't
5967 suffice to make the file-save operation survive a crash. For
5968 batch scripts, which are typically part of larger shell commands
5969 that don't fsync other files, its effect on performance can be
5970 significant so its utility is particularly questionable.
5971 Hence, for now by default fsync is used only when interactive.
5973 For more on why fsync often fails to work on today's hardware, see:
5974 Zheng M et al. Understanding the robustness of SSDs under power fault.
5975 11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84
5976 http://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf
5978 For more on why fsync does not suffice even if it works properly, see:
5979 Roche X. Necessary step(s) to synchronize filename operations on disk.
5980 Austin Group Defect 672, 2013-03-19
5981 http://austingroupbugs.net/view.php?id=672 */
5982 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync
,
5983 doc
: /* Non-nil means don't call fsync in `write-region'.
5984 This variable affects calls to `write-region' as well as save commands.
5985 Setting this to nil may avoid data loss if the system loses power or
5986 the operating system crashes. */);
5987 write_region_inhibit_fsync
= noninteractive
;
5989 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash
,
5990 doc
: /* Specifies whether to use the system's trash can.
5991 When non-nil, certain file deletion commands use the function
5992 `move-file-to-trash' instead of deleting files outright.
5993 This includes interactive calls to `delete-file' and
5994 `delete-directory' and the Dired deletion commands. */);
5995 delete_by_moving_to_trash
= 0;
5996 Qdelete_by_moving_to_trash
= intern_c_string ("delete-by-moving-to-trash");
5998 DEFSYM (Qmove_file_to_trash
, "move-file-to-trash");
5999 DEFSYM (Qcopy_directory
, "copy-directory");
6000 DEFSYM (Qdelete_directory
, "delete-directory");
6001 DEFSYM (Qsubstitute_env_in_file_name
, "substitute-env-in-file-name");
6003 defsubr (&Sfind_file_name_handler
);
6004 defsubr (&Sfile_name_directory
);
6005 defsubr (&Sfile_name_nondirectory
);
6006 defsubr (&Sunhandled_file_name_directory
);
6007 defsubr (&Sfile_name_as_directory
);
6008 defsubr (&Sdirectory_file_name
);
6009 defsubr (&Smake_temp_name
);
6010 defsubr (&Sexpand_file_name
);
6011 defsubr (&Ssubstitute_in_file_name
);
6012 defsubr (&Scopy_file
);
6013 defsubr (&Smake_directory_internal
);
6014 defsubr (&Sdelete_directory_internal
);
6015 defsubr (&Sdelete_file
);
6016 defsubr (&Srename_file
);
6017 defsubr (&Sadd_name_to_file
);
6018 defsubr (&Smake_symbolic_link
);
6019 defsubr (&Sfile_name_absolute_p
);
6020 defsubr (&Sfile_exists_p
);
6021 defsubr (&Sfile_executable_p
);
6022 defsubr (&Sfile_readable_p
);
6023 defsubr (&Sfile_writable_p
);
6024 defsubr (&Saccess_file
);
6025 defsubr (&Sfile_symlink_p
);
6026 defsubr (&Sfile_directory_p
);
6027 defsubr (&Sfile_accessible_directory_p
);
6028 defsubr (&Sfile_regular_p
);
6029 defsubr (&Sfile_modes
);
6030 defsubr (&Sset_file_modes
);
6031 defsubr (&Sset_file_times
);
6032 defsubr (&Sfile_selinux_context
);
6033 defsubr (&Sfile_acl
);
6034 defsubr (&Sset_file_acl
);
6035 defsubr (&Sset_file_selinux_context
);
6036 defsubr (&Sset_default_file_modes
);
6037 defsubr (&Sdefault_file_modes
);
6038 defsubr (&Sfile_newer_than_file_p
);
6039 defsubr (&Sinsert_file_contents
);
6040 defsubr (&Schoose_write_coding_system
);
6041 defsubr (&Swrite_region
);
6042 defsubr (&Scar_less_than_car
);
6043 defsubr (&Sverify_visited_file_modtime
);
6044 defsubr (&Svisited_file_modtime
);
6045 defsubr (&Sset_visited_file_modtime
);
6046 defsubr (&Sdo_auto_save
);
6047 defsubr (&Sset_buffer_auto_saved
);
6048 defsubr (&Sclear_buffer_auto_save_failure
);
6049 defsubr (&Srecent_auto_save_p
);
6051 defsubr (&Snext_read_file_uses_dialog_p
);
6054 defsubr (&Sunix_sync
);