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"
52 #include "region-cache.h"
54 #include "dispextern.h"
61 #endif /* not WINDOWSNT */
65 #include <sys/param.h>
69 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
70 redirector allows the six letters between 'Z' and 'a' as well. */
72 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
75 #define IS_DRIVE(x) c_isalpha (x)
77 /* Need to lower-case the drive letter, or else expanded
78 filenames will sometimes compare unequal, because
79 `expand-file-name' doesn't always down-case the drive letter. */
80 #define DRIVE_LETTER(x) c_tolower (x)
85 #include <allocator.h>
86 #include <careadlinkat.h>
87 #include <stat-time.h>
95 /* True during writing of auto-save files. */
96 static bool auto_saving
;
98 /* Nonzero umask during creation of auto-save directories. */
99 static mode_t auto_saving_dir_umask
;
101 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
102 a new file with the same mode as the original. */
103 static mode_t auto_save_mode_bits
;
105 /* Set by auto_save_1 if an error occurred during the last auto-save. */
106 static bool auto_save_error_occurred
;
108 /* If VALID_TIMESTAMP_FILE_SYSTEM, then TIMESTAMP_FILE_SYSTEM is the device
109 number of a file system where time stamps were observed to to work. */
110 static bool valid_timestamp_file_system
;
111 static dev_t timestamp_file_system
;
113 /* The symbol bound to coding-system-for-read when
114 insert-file-contents is called for recovering a file. This is not
115 an actual coding system name, but just an indicator to tell
116 insert-file-contents to use `emacs-mule' with a special flag for
117 auto saving and recovering a file. */
118 static Lisp_Object Qauto_save_coding
;
120 /* Property name of a file name handler,
121 which gives a list of operations it handles.. */
122 static Lisp_Object Qoperations
;
124 /* Lisp functions for translating file formats. */
125 static Lisp_Object Qformat_decode
, Qformat_annotate_function
;
127 /* Lisp function for setting buffer-file-coding-system and the
128 multibyteness of the current buffer after inserting a file. */
129 static Lisp_Object Qafter_insert_file_set_coding
;
131 static Lisp_Object Qwrite_region_annotate_functions
;
132 /* Each time an annotation function changes the buffer, the new buffer
134 static Lisp_Object Vwrite_region_annotation_buffers
;
136 static Lisp_Object Qdelete_by_moving_to_trash
;
138 /* Lisp function for moving files to trash. */
139 static Lisp_Object Qmove_file_to_trash
;
141 /* Lisp function for recursively copying directories. */
142 static Lisp_Object Qcopy_directory
;
144 /* Lisp function for recursively deleting directories. */
145 static Lisp_Object Qdelete_directory
;
147 static Lisp_Object Qsubstitute_env_in_file_name
;
149 Lisp_Object Qfile_error
, Qfile_notify_error
;
150 static Lisp_Object Qfile_already_exists
, Qfile_date_error
;
151 static Lisp_Object Qexcl
;
152 Lisp_Object Qfile_name_history
;
154 static Lisp_Object Qcar_less_than_car
;
156 static bool a_write (int, Lisp_Object
, ptrdiff_t, ptrdiff_t,
157 Lisp_Object
*, struct coding_system
*);
158 static bool e_write (int, Lisp_Object
, ptrdiff_t, ptrdiff_t,
159 struct coding_system
*);
162 /* Return true if FILENAME exists. */
165 check_existing (const char *filename
)
167 return faccessat (AT_FDCWD
, filename
, F_OK
, AT_EACCESS
) == 0;
170 /* Return true if file FILENAME exists and can be executed. */
173 check_executable (char *filename
)
175 return faccessat (AT_FDCWD
, filename
, X_OK
, AT_EACCESS
) == 0;
178 /* Return true if file FILENAME exists and can be accessed
179 according to AMODE, which should include W_OK.
180 On failure, return false and set errno. */
183 check_writable (const char *filename
, int amode
)
186 /* FIXME: an faccessat implementation should be added to the
187 DOS/Windows ports and this #ifdef branch should be removed. */
189 if (stat (filename
, &st
) < 0)
192 return (st
.st_mode
& S_IWRITE
|| S_ISDIR (st
.st_mode
));
193 #else /* not MSDOS */
194 bool res
= faccessat (AT_FDCWD
, filename
, amode
, AT_EACCESS
) == 0;
196 /* faccessat may have returned failure because Cygwin couldn't
197 determine the file's UID or GID; if so, we return success. */
200 int faccessat_errno
= errno
;
202 if (stat (filename
, &st
) < 0)
204 res
= (st
.st_uid
== -1 || st
.st_gid
== -1);
205 errno
= faccessat_errno
;
209 #endif /* not MSDOS */
212 /* Signal a file-access failure. STRING describes the failure,
213 NAME the file involved, and ERRORNO the errno value.
215 If NAME is neither null nor a pair, package it up as a singleton
216 list before reporting it; this saves report_file_errno's caller the
217 trouble of preserving errno before calling list1. */
220 report_file_errno (char const *string
, Lisp_Object name
, int errorno
)
222 Lisp_Object data
= CONSP (name
) || NILP (name
) ? name
: list1 (name
);
223 Lisp_Object errstring
;
226 synchronize_system_messages_locale ();
227 str
= strerror (errorno
);
228 errstring
= code_convert_string_norecord (build_unibyte_string (str
),
229 Vlocale_coding_system
, 0);
235 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
238 /* System error messages are capitalized. Downcase the initial
239 unless it is followed by a slash. (The slash case caters to
240 error messages that begin with "I/O" or, in German, "E/A".) */
241 if (STRING_MULTIBYTE (errstring
)
242 && ! EQ (Faref (errstring
, make_number (1)), make_number ('/')))
246 str
= SSDATA (errstring
);
247 c
= STRING_CHAR ((unsigned char *) str
);
248 Faset (errstring
, make_number (0), make_number (downcase (c
)));
251 xsignal (Qfile_error
,
252 Fcons (build_string (string
), Fcons (errstring
, data
)));
256 /* Signal a file-access failure that set errno. STRING describes the
257 failure, NAME the file involved. When invoking this function, take
258 care to not use arguments such as build_string ("foo") that involve
259 side effects that may set errno. */
262 report_file_error (char const *string
, Lisp_Object name
)
264 report_file_errno (string
, name
, errno
);
268 close_file_unwind (int fd
)
274 fclose_unwind (void *arg
)
280 /* Restore point, having saved it as a marker. */
283 restore_point_unwind (Lisp_Object location
)
285 Fgoto_char (location
);
286 unchain_marker (XMARKER (location
));
290 static Lisp_Object Qexpand_file_name
;
291 static Lisp_Object Qsubstitute_in_file_name
;
292 static Lisp_Object Qdirectory_file_name
;
293 static Lisp_Object Qfile_name_directory
;
294 static Lisp_Object Qfile_name_nondirectory
;
295 static Lisp_Object Qunhandled_file_name_directory
;
296 static Lisp_Object Qfile_name_as_directory
;
297 static Lisp_Object Qcopy_file
;
298 static Lisp_Object Qmake_directory_internal
;
299 static Lisp_Object Qmake_directory
;
300 static Lisp_Object Qdelete_directory_internal
;
301 Lisp_Object Qdelete_file
;
302 static Lisp_Object Qrename_file
;
303 static Lisp_Object Qadd_name_to_file
;
304 static Lisp_Object Qmake_symbolic_link
;
305 Lisp_Object Qfile_exists_p
;
306 static Lisp_Object Qfile_executable_p
;
307 static Lisp_Object Qfile_readable_p
;
308 static Lisp_Object Qfile_writable_p
;
309 static Lisp_Object Qfile_symlink_p
;
310 static Lisp_Object Qaccess_file
;
311 Lisp_Object Qfile_directory_p
;
312 static Lisp_Object Qfile_regular_p
;
313 static Lisp_Object Qfile_accessible_directory_p
;
314 static Lisp_Object Qfile_modes
;
315 static Lisp_Object Qset_file_modes
;
316 static Lisp_Object Qset_file_times
;
317 static Lisp_Object Qfile_selinux_context
;
318 static Lisp_Object Qset_file_selinux_context
;
319 static Lisp_Object Qfile_acl
;
320 static Lisp_Object Qset_file_acl
;
321 static Lisp_Object Qfile_newer_than_file_p
;
322 Lisp_Object Qinsert_file_contents
;
323 static Lisp_Object Qchoose_write_coding_system
;
324 Lisp_Object Qwrite_region
;
325 static Lisp_Object Qverify_visited_file_modtime
;
326 static Lisp_Object Qset_visited_file_modtime
;
328 DEFUN ("find-file-name-handler", Ffind_file_name_handler
,
329 Sfind_file_name_handler
, 2, 2, 0,
330 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
331 Otherwise, return nil.
332 A file name is handled if one of the regular expressions in
333 `file-name-handler-alist' matches it.
335 If OPERATION equals `inhibit-file-name-operation', then we ignore
336 any handlers that are members of `inhibit-file-name-handlers',
337 but we still do run any other handlers. This lets handlers
338 use the standard functions without calling themselves recursively. */)
339 (Lisp_Object filename
, Lisp_Object operation
)
341 /* This function must not munge the match data. */
342 Lisp_Object chain
, inhibited_handlers
, result
;
346 CHECK_STRING (filename
);
348 if (EQ (operation
, Vinhibit_file_name_operation
))
349 inhibited_handlers
= Vinhibit_file_name_handlers
;
351 inhibited_handlers
= Qnil
;
353 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
354 chain
= XCDR (chain
))
360 Lisp_Object string
= XCAR (elt
);
362 Lisp_Object handler
= XCDR (elt
);
363 Lisp_Object operations
= Qnil
;
365 if (SYMBOLP (handler
))
366 operations
= Fget (handler
, Qoperations
);
369 && (match_pos
= fast_string_match (string
, filename
)) > pos
370 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
374 handler
= XCDR (elt
);
375 tem
= Fmemq (handler
, inhibited_handlers
);
389 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
391 doc
: /* Return the directory component in file name FILENAME.
392 Return nil if FILENAME does not include a directory.
393 Otherwise return a directory name.
394 Given a Unix syntax file name, returns a string ending in slash. */)
395 (Lisp_Object filename
)
398 register const char *beg
;
403 register const char *p
;
406 CHECK_STRING (filename
);
408 /* If the file name has special constructs in it,
409 call the corresponding file handler. */
410 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
413 Lisp_Object handled_name
= call2 (handler
, Qfile_name_directory
,
415 return STRINGP (handled_name
) ? handled_name
: Qnil
;
419 beg
= xlispstrdupa (filename
);
421 beg
= SSDATA (filename
);
423 p
= beg
+ SBYTES (filename
);
425 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
427 /* only recognize drive specifier at the beginning */
429 /* handle the "/:d:foo" and "/:foo" cases correctly */
430 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
431 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
438 /* Expansion of "c:" to drive and default directory. */
441 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
442 char *res
= alloca (MAXPATHLEN
+ 1);
445 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
447 memcpy (res
, beg
, 2);
452 if (getdefdir (c_toupper (*beg
) - 'A' + 1, r
))
454 size_t l
= strlen (res
);
456 if (l
> 3 || !IS_DIRECTORY_SEP (res
[l
- 1]))
459 p
= beg
+ strlen (beg
);
460 dostounix_filename (beg
);
461 tem_fn
= make_specified_string (beg
, -1, p
- beg
,
462 STRING_MULTIBYTE (filename
));
465 tem_fn
= make_specified_string (beg
- 2, -1, p
- beg
+ 2,
466 STRING_MULTIBYTE (filename
));
468 else if (STRING_MULTIBYTE (filename
))
470 tem_fn
= make_specified_string (beg
, -1, p
- beg
, 1);
471 dostounix_filename (SSDATA (tem_fn
));
473 if (!NILP (Vw32_downcase_file_names
))
474 tem_fn
= Fdowncase (tem_fn
);
479 dostounix_filename (beg
);
480 tem_fn
= make_specified_string (beg
, -1, p
- beg
, 0);
484 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
488 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
489 Sfile_name_nondirectory
, 1, 1, 0,
490 doc
: /* Return file name FILENAME sans its directory.
491 For example, in a Unix-syntax file name,
492 this is everything after the last slash,
493 or the entire name if it contains no slash. */)
494 (Lisp_Object filename
)
496 register const char *beg
, *p
, *end
;
499 CHECK_STRING (filename
);
501 /* If the file name has special constructs in it,
502 call the corresponding file handler. */
503 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
506 Lisp_Object handled_name
= call2 (handler
, Qfile_name_nondirectory
,
508 if (STRINGP (handled_name
))
510 error ("Invalid handler in `file-name-handler-alist'");
513 beg
= SSDATA (filename
);
514 end
= p
= beg
+ SBYTES (filename
);
516 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
518 /* only recognize drive specifier at beginning */
520 /* handle the "/:d:foo" case correctly */
521 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
526 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
529 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
530 Sunhandled_file_name_directory
, 1, 1, 0,
531 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
532 A `directly usable' directory name is one that may be used without the
533 intervention of any file handler.
534 If FILENAME is a directly usable file itself, return
535 \(file-name-directory FILENAME).
536 If FILENAME refers to a file which is not accessible from a local process,
537 then this should return nil.
538 The `call-process' and `start-process' functions use this function to
539 get a current directory to run processes in. */)
540 (Lisp_Object filename
)
544 /* If the file name has special constructs in it,
545 call the corresponding file handler. */
546 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
549 Lisp_Object handled_name
= call2 (handler
, Qunhandled_file_name_directory
,
551 return STRINGP (handled_name
) ? handled_name
: Qnil
;
554 return Ffile_name_directory (filename
);
557 /* Maximum number of bytes that DST will be longer than SRC
558 in file_name_as_directory. This occurs when SRCLEN == 0. */
559 enum { file_name_as_directory_slop
= 2 };
561 /* Convert from file name SRC of length SRCLEN to directory name in
562 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
563 string. On UNIX, just make sure there is a terminating /. Return
564 the length of DST in bytes. */
567 file_name_as_directory (char *dst
, const char *src
, ptrdiff_t srclen
,
578 memcpy (dst
, src
, srclen
);
579 if (!IS_DIRECTORY_SEP (dst
[srclen
- 1]))
580 dst
[srclen
++] = DIRECTORY_SEP
;
583 dostounix_filename (dst
);
588 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
589 Sfile_name_as_directory
, 1, 1, 0,
590 doc
: /* Return a string representing the file name FILE interpreted as a directory.
591 This operation exists because a directory is also a file, but its name as
592 a directory is different from its name as a file.
593 The result can be used as the value of `default-directory'
594 or passed as second argument to `expand-file-name'.
595 For a Unix-syntax file name, just appends a slash. */)
600 Lisp_Object handler
, val
;
607 /* If the file name has special constructs in it,
608 call the corresponding file handler. */
609 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
612 Lisp_Object handled_name
= call2 (handler
, Qfile_name_as_directory
,
614 if (STRINGP (handled_name
))
616 error ("Invalid handler in `file-name-handler-alist'");
620 if (!NILP (Vw32_downcase_file_names
))
621 file
= Fdowncase (file
);
623 buf
= SAFE_ALLOCA (SBYTES (file
) + file_name_as_directory_slop
+ 1);
624 length
= file_name_as_directory (buf
, SSDATA (file
), SBYTES (file
),
625 STRING_MULTIBYTE (file
));
626 val
= make_specified_string (buf
, -1, length
, STRING_MULTIBYTE (file
));
631 /* Convert from directory name SRC of length SRCLEN to file name in
632 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
633 string. On UNIX, just make sure there isn't a terminating /.
634 Return the length of DST in bytes. */
637 directory_file_name (char *dst
, char *src
, ptrdiff_t srclen
, bool multibyte
)
639 /* Process as Unix format: just remove any final slash.
640 But leave "/" and "//" unchanged. */
643 && !IS_ANY_SEP (src
[srclen
- 2])
645 && IS_DIRECTORY_SEP (src
[srclen
- 1])
646 && ! (srclen
== 2 && IS_DIRECTORY_SEP (src
[0])))
649 memcpy (dst
, src
, srclen
);
652 dostounix_filename (dst
);
657 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
659 doc
: /* Returns the file name of the directory named DIRECTORY.
660 This is the name of the file that holds the data for the directory DIRECTORY.
661 This operation exists because a directory is also a file, but its name as
662 a directory is different from its name as a file.
663 In Unix-syntax, this function just removes the final slash. */)
664 (Lisp_Object directory
)
668 Lisp_Object handler
, val
;
671 CHECK_STRING (directory
);
673 if (NILP (directory
))
676 /* If the file name has special constructs in it,
677 call the corresponding file handler. */
678 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
681 Lisp_Object handled_name
= call2 (handler
, Qdirectory_file_name
,
683 if (STRINGP (handled_name
))
685 error ("Invalid handler in `file-name-handler-alist'");
689 if (!NILP (Vw32_downcase_file_names
))
690 directory
= Fdowncase (directory
);
692 buf
= SAFE_ALLOCA (SBYTES (directory
) + 1);
693 length
= directory_file_name (buf
, SSDATA (directory
), SBYTES (directory
),
694 STRING_MULTIBYTE (directory
));
695 val
= make_specified_string (buf
, -1, length
, STRING_MULTIBYTE (directory
));
700 static const char make_temp_name_tbl
[64] =
702 'A','B','C','D','E','F','G','H',
703 'I','J','K','L','M','N','O','P',
704 'Q','R','S','T','U','V','W','X',
705 'Y','Z','a','b','c','d','e','f',
706 'g','h','i','j','k','l','m','n',
707 'o','p','q','r','s','t','u','v',
708 'w','x','y','z','0','1','2','3',
709 '4','5','6','7','8','9','-','_'
712 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
714 /* Value is a temporary file name starting with PREFIX, a string.
716 The Emacs process number forms part of the result, so there is
717 no danger of generating a name being used by another process.
718 In addition, this function makes an attempt to choose a name
719 which has no existing file. To make this work, PREFIX should be
720 an absolute file name.
722 BASE64_P means add the pid as 3 characters in base64
723 encoding. In this case, 6 characters will be added to PREFIX to
724 form the file name. Otherwise, if Emacs is running on a system
725 with long file names, add the pid as a decimal number.
727 This function signals an error if no unique file name could be
731 make_temp_name (Lisp_Object prefix
, bool base64_p
)
733 Lisp_Object val
, encoded_prefix
;
737 char pidbuf
[INT_BUFSIZE_BOUND (printmax_t
)];
740 CHECK_STRING (prefix
);
742 /* VAL is created by adding 6 characters to PREFIX. The first
743 three are the PID of this process, in base 64, and the second
744 three are incremented if the file already exists. This ensures
745 262144 unique file names per PID per PREFIX. */
751 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
752 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
753 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
758 #ifdef HAVE_LONG_FILE_NAMES
759 pidlen
= sprintf (pidbuf
, "%"pMd
, pid
);
761 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
762 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
763 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
768 encoded_prefix
= ENCODE_FILE (prefix
);
769 len
= SBYTES (encoded_prefix
);
770 val
= make_uninit_string (len
+ 3 + pidlen
);
772 memcpy (data
, SSDATA (encoded_prefix
), len
);
775 memcpy (p
, pidbuf
, pidlen
);
778 /* Here we try to minimize useless stat'ing when this function is
779 invoked many times successively with the same PREFIX. We achieve
780 this by initializing count to a random value, and incrementing it
783 We don't want make-temp-name to be called while dumping,
784 because then make_temp_name_count_initialized_p would get set
785 and then make_temp_name_count would not be set when Emacs starts. */
787 if (!make_temp_name_count_initialized_p
)
789 make_temp_name_count
= time (NULL
);
790 make_temp_name_count_initialized_p
= 1;
795 unsigned num
= make_temp_name_count
;
797 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
798 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
799 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
801 /* Poor man's congruential RN generator. Replace with
802 ++make_temp_name_count for debugging. */
803 make_temp_name_count
+= 25229;
804 make_temp_name_count
%= 225307;
806 if (!check_existing (data
))
808 /* We want to return only if errno is ENOENT. */
810 return DECODE_FILE (val
);
812 /* The error here is dubious, but there is little else we
813 can do. The alternatives are to return nil, which is
814 as bad as (and in many cases worse than) throwing the
815 error, or to ignore the error, which will likely result
816 in looping through 225307 stat's, which is not only
817 dog-slow, but also useless since eventually nil would
818 have to be returned anyway. */
819 report_file_error ("Cannot create temporary name for prefix",
827 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
828 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
829 The Emacs process number forms part of the result,
830 so there is no danger of generating a name being used by another process.
832 In addition, this function makes an attempt to choose a name
833 which has no existing file. To make this work,
834 PREFIX should be an absolute file name.
836 There is a race condition between calling `make-temp-name' and creating the
837 file which opens all kinds of security holes. For that reason, you should
838 probably use `make-temp-file' instead, except in three circumstances:
840 * If you are creating the file in the user's home directory.
841 * If you are creating a directory rather than an ordinary file.
842 * If you are taking special precautions as `make-temp-file' does. */)
845 return make_temp_name (prefix
, 0);
850 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
851 doc
: /* Convert filename NAME to absolute, and canonicalize it.
852 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
853 \(does not start with slash or tilde); both the directory name and
854 a directory's file name are accepted. If DEFAULT-DIRECTORY is nil or
855 missing, the current buffer's value of `default-directory' is used.
856 NAME should be a string that is a valid file name for the underlying
858 File name components that are `.' are removed, and
859 so are file name components followed by `..', along with the `..' itself;
860 note that these simplifications are done without checking the resulting
861 file names in the file system.
862 Multiple consecutive slashes are collapsed into a single slash,
863 except at the beginning of the file name when they are significant (e.g.,
864 UNC file names on MS-Windows.)
865 An initial `~/' expands to your home directory.
866 An initial `~USER/' expands to USER's home directory.
867 See also the function `substitute-in-file-name'.
869 For technical reasons, this function can return correct but
870 non-intuitive results for the root directory; for instance,
871 \(expand-file-name ".." "/") returns "/..". For this reason, use
872 \(directory-file-name (file-name-directory dirname)) to traverse a
873 filesystem tree, not (expand-file-name ".." dirname). */)
874 (Lisp_Object name
, Lisp_Object default_directory
)
876 /* These point to SDATA and need to be careful with string-relocation
877 during GC (via DECODE_FILE). */
880 /* This should only point to alloca'd data. */
887 bool collapse_newdir
= 1;
891 Lisp_Object handler
, result
, handled_name
;
898 /* If the file name has special constructs in it,
899 call the corresponding file handler. */
900 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
903 handled_name
= call3 (handler
, Qexpand_file_name
,
904 name
, default_directory
);
905 if (STRINGP (handled_name
))
907 error ("Invalid handler in `file-name-handler-alist'");
911 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
912 if (NILP (default_directory
))
913 default_directory
= BVAR (current_buffer
, directory
);
914 if (! STRINGP (default_directory
))
917 /* "/" is not considered a root directory on DOS_NT, so using "/"
918 here causes an infinite recursion in, e.g., the following:
920 (let (default-directory)
921 (expand-file-name "a"))
923 To avoid this, we set default_directory to the root of the
925 default_directory
= build_string (emacs_root_dir ());
927 default_directory
= build_string ("/");
931 if (!NILP (default_directory
))
933 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
936 handled_name
= call3 (handler
, Qexpand_file_name
,
937 name
, default_directory
);
938 if (STRINGP (handled_name
))
940 error ("Invalid handler in `file-name-handler-alist'");
945 char *o
= SSDATA (default_directory
);
947 /* Make sure DEFAULT_DIRECTORY is properly expanded.
948 It would be better to do this down below where we actually use
949 default_directory. Unfortunately, calling Fexpand_file_name recursively
950 could invoke GC, and the strings might be relocated. This would
951 be annoying because we have pointers into strings lying around
952 that would need adjusting, and people would add new pointers to
953 the code and forget to adjust them, resulting in intermittent bugs.
954 Putting this call here avoids all that crud.
956 The EQ test avoids infinite recursion. */
957 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
958 /* Save time in some common cases - as long as default_directory
959 is not relative, it can be canonicalized with name below (if it
960 is needed at all) without requiring it to be expanded now. */
962 /* Detect MSDOS file names with drive specifiers. */
963 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
964 && IS_DIRECTORY_SEP (o
[2]))
966 /* Detect Windows file names in UNC format. */
967 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
969 #else /* not DOS_NT */
970 /* Detect Unix absolute file names (/... alone is not absolute on
972 && ! (IS_DIRECTORY_SEP (o
[0]))
973 #endif /* not DOS_NT */
979 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
983 multibyte
= STRING_MULTIBYTE (name
);
984 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
988 unsigned char *p
= SDATA (name
);
990 while (*p
&& ASCII_BYTE_P (*p
))
994 /* NAME is a pure ASCII string, and DEFAULT_DIRECTORY is
995 unibyte. Do not convert DEFAULT_DIRECTORY to
996 multibyte; instead, convert NAME to a unibyte string,
997 so that the result of this function is also a unibyte
998 string. This is needed during bootstrapping and
999 dumping, when Emacs cannot decode file names, because
1000 the locale environment is not set up. */
1001 name
= make_unibyte_string (SSDATA (name
), SBYTES (name
));
1005 default_directory
= string_to_multibyte (default_directory
);
1009 name
= string_to_multibyte (name
);
1015 if (!NILP (Vw32_downcase_file_names
))
1016 default_directory
= Fdowncase (default_directory
);
1019 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
1020 nm
= xlispstrdupa (name
);
1023 /* Note if special escape prefix is present, but remove for now. */
1024 if (nm
[0] == '/' && nm
[1] == ':')
1030 /* Find and remove drive specifier if present; this makes nm absolute
1031 even if the rest of the name appears to be relative. Only look for
1032 drive specifier at the beginning. */
1033 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1035 drive
= (unsigned char) nm
[0];
1040 /* If we see "c://somedir", we want to strip the first slash after the
1041 colon when stripping the drive letter. Otherwise, this expands to
1043 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1046 /* Discard any previous drive specifier if nm is now in UNC format. */
1047 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1051 #endif /* WINDOWSNT */
1054 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1055 none are found, we can probably return right away. We will avoid
1056 allocating a new string if name is already fully expanded. */
1058 IS_DIRECTORY_SEP (nm
[0])
1060 && drive
&& !is_escaped
1063 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1067 /* If it turns out that the filename we want to return is just a
1068 suffix of FILENAME, we don't need to go through and edit
1069 things; we just need to construct a new string using data
1070 starting at the middle of FILENAME. If we set LOSE, that
1071 means we've discovered that we can't do that cool trick. */
1077 /* Since we know the name is absolute, we can assume that each
1078 element starts with a "/". */
1080 /* "." and ".." are hairy. */
1081 if (IS_DIRECTORY_SEP (p
[0])
1083 && (IS_DIRECTORY_SEP (p
[2])
1085 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1088 /* Replace multiple slashes with a single one, except
1089 leave leading "//" alone. */
1090 else if (IS_DIRECTORY_SEP (p
[0])
1091 && IS_DIRECTORY_SEP (p
[1])
1092 && (p
!= nm
|| IS_DIRECTORY_SEP (p
[2])))
1099 /* Make sure directories are all separated with /, but
1100 avoid allocation of a new string when not required. */
1101 dostounix_filename (nm
);
1103 if (IS_DIRECTORY_SEP (nm
[1]))
1105 if (strcmp (nm
, SSDATA (name
)) != 0)
1106 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1110 /* Drive must be set, so this is okay. */
1111 if (strcmp (nm
- 2, SSDATA (name
)) != 0)
1115 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1116 temp
[0] = DRIVE_LETTER (drive
);
1117 name
= concat2 (build_string (temp
), name
);
1120 if (!NILP (Vw32_downcase_file_names
))
1121 name
= Fdowncase (name
);
1124 #else /* not DOS_NT */
1125 if (strcmp (nm
, SSDATA (name
)) == 0)
1127 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1128 #endif /* not DOS_NT */
1132 /* At this point, nm might or might not be an absolute file name. We
1133 need to expand ~ or ~user if present, otherwise prefix nm with
1134 default_directory if nm is not absolute, and finally collapse /./
1135 and /foo/../ sequences.
1137 We set newdir to be the appropriate prefix if one is needed:
1138 - the relevant user directory if nm starts with ~ or ~user
1139 - the specified drive's working dir (DOS/NT only) if nm does not
1141 - the value of default_directory.
1143 Note that these prefixes are not guaranteed to be absolute (except
1144 for the working dir of a drive). Therefore, to ensure we always
1145 return an absolute name, if the final prefix is not absolute we
1146 append it to the current working directory. */
1150 if (nm
[0] == '~') /* prefix ~ */
1152 if (IS_DIRECTORY_SEP (nm
[1])
1153 || nm
[1] == 0) /* ~ by itself */
1157 if (!(newdir
= egetenv ("HOME")))
1160 /* `egetenv' may return a unibyte string, which will bite us since
1161 we expect the directory to be multibyte. */
1165 char newdir_utf8
[MAX_UTF8_PATH
];
1167 filename_from_ansi (newdir
, newdir_utf8
);
1168 tem
= build_string (newdir_utf8
);
1172 tem
= build_string (newdir
);
1173 if (multibyte
&& !STRING_MULTIBYTE (tem
))
1175 hdir
= DECODE_FILE (tem
);
1176 newdir
= SSDATA (hdir
);
1179 collapse_newdir
= 0;
1182 else /* ~user/filename */
1185 for (p
= nm
; *p
&& !IS_DIRECTORY_SEP (*p
); p
++)
1187 o
= SAFE_ALLOCA (p
- nm
+ 1);
1188 memcpy (o
, nm
, p
- nm
);
1192 pw
= getpwnam (o
+ 1);
1198 newdir
= pw
->pw_dir
;
1199 /* `getpwnam' may return a unibyte string, which will
1200 bite us since we expect the directory to be
1202 tem
= build_string (newdir
);
1203 if (multibyte
&& !STRING_MULTIBYTE (tem
))
1205 hdir
= DECODE_FILE (tem
);
1206 newdir
= SSDATA (hdir
);
1210 collapse_newdir
= 0;
1214 /* If we don't find a user of that name, leave the name
1215 unchanged; don't move nm forward to p. */
1220 /* On DOS and Windows, nm is absolute if a drive name was specified;
1221 use the drive's current directory as the prefix if needed. */
1222 if (!newdir
&& drive
)
1224 /* Get default directory if needed to make nm absolute. */
1226 if (!IS_DIRECTORY_SEP (nm
[0]))
1228 adir
= alloca (MAXPATHLEN
+ 1);
1229 if (!getdefdir (c_toupper (drive
) - 'A' + 1, adir
))
1233 Lisp_Object tem
= build_string (adir
);
1235 tem
= DECODE_FILE (tem
);
1236 memcpy (adir
, SSDATA (tem
), SBYTES (tem
) + 1);
1241 /* Either nm starts with /, or drive isn't mounted. */
1243 adir
[0] = DRIVE_LETTER (drive
);
1252 /* Finally, if no prefix has been specified and nm is not absolute,
1253 then it must be expanded relative to default_directory. */
1257 /* /... alone is not absolute on DOS and Windows. */
1258 && !IS_DIRECTORY_SEP (nm
[0])
1261 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1265 newdir
= SSDATA (default_directory
);
1267 /* Note if special escape prefix is present, but remove for now. */
1268 if (newdir
[0] == '/' && newdir
[1] == ':')
1279 /* First ensure newdir is an absolute name. */
1281 /* Detect MSDOS file names with drive specifiers. */
1282 ! (IS_DRIVE (newdir
[0])
1283 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1285 /* Detect Windows file names in UNC format. */
1286 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1290 /* Effectively, let newdir be (expand-file-name newdir cwd).
1291 Because of the admonition against calling expand-file-name
1292 when we have pointers into lisp strings, we accomplish this
1293 indirectly by prepending newdir to nm if necessary, and using
1294 cwd (or the wd of newdir's drive) as the new newdir. */
1297 const int adir_size
= MAX_UTF8_PATH
;
1299 const int adir_size
= MAXPATHLEN
+ 1;
1302 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1304 drive
= (unsigned char) newdir
[0];
1307 if (!IS_DIRECTORY_SEP (nm
[0]))
1309 ptrdiff_t newlen
= strlen (newdir
);
1310 char *tmp
= alloca (newlen
+ file_name_as_directory_slop
1312 file_name_as_directory (tmp
, newdir
, newlen
, multibyte
);
1316 adir
= alloca (adir_size
);
1319 if (!getdefdir (c_toupper (drive
) - 'A' + 1, adir
))
1323 getcwd (adir
, adir_size
);
1326 Lisp_Object tem
= build_string (adir
);
1328 tem
= DECODE_FILE (tem
);
1329 memcpy (adir
, SSDATA (tem
), SBYTES (tem
) + 1);
1334 /* Strip off drive name from prefix, if present. */
1335 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1341 /* Keep only a prefix from newdir if nm starts with slash
1342 (//server/share for UNC, nothing otherwise). */
1343 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1346 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1348 char *adir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1350 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1352 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1365 /* Ignore any slash at the end of newdir, unless newdir is
1366 just "/" or "//". */
1367 length
= strlen (newdir
);
1368 while (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1369 && ! (length
== 2 && IS_DIRECTORY_SEP (newdir
[0])))
1375 /* Now concatenate the directory and name to new space in the stack frame. */
1376 tlen
= length
+ file_name_as_directory_slop
+ strlen (nm
) + 1;
1378 /* Reserve space for drive specifier and escape prefix, since either
1379 or both may need to be inserted. (The Microsoft x86 compiler
1380 produces incorrect code if the following two lines are combined.) */
1381 target
= alloca (tlen
+ 4);
1383 #else /* not DOS_NT */
1384 target
= SAFE_ALLOCA (tlen
);
1385 #endif /* not DOS_NT */
1390 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1393 /* If newdir is effectively "C:/", then the drive letter will have
1394 been stripped and newdir will be "/". Concatenating with an
1395 absolute directory in nm produces "//", which will then be
1396 incorrectly treated as a network share. Ignore newdir in
1397 this case (keeping the drive letter). */
1398 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1399 && newdir
[1] == '\0'))
1402 memcpy (target
, newdir
, length
);
1407 file_name_as_directory (target
, newdir
, length
, multibyte
);
1410 strcat (target
, nm
);
1412 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1420 if (!IS_DIRECTORY_SEP (*p
))
1424 else if (p
[1] == '.'
1425 && (IS_DIRECTORY_SEP (p
[2])
1428 /* If "/." is the entire filename, keep the "/". Otherwise,
1429 just delete the whole "/.". */
1430 if (o
== target
&& p
[2] == '\0')
1434 else if (p
[1] == '.' && p
[2] == '.'
1435 /* `/../' is the "superroot" on certain file systems.
1436 Turned off on DOS_NT systems because they have no
1437 "superroot" and because this causes us to produce
1438 file names like "d:/../foo" which fail file-related
1439 functions of the underlying OS. (To reproduce, try a
1440 long series of "../../" in default_directory, longer
1441 than the number of levels from the root.) */
1445 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1450 while (o
!= target
&& (--o
, !IS_DIRECTORY_SEP (*o
)))
1453 /* Don't go below server level in UNC filenames. */
1454 if (o
== target
+ 1 && IS_DIRECTORY_SEP (*o
)
1455 && IS_DIRECTORY_SEP (*target
))
1459 /* Keep initial / only if this is the whole name. */
1460 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1464 else if (IS_DIRECTORY_SEP (p
[1])
1465 && (p
!= target
|| IS_DIRECTORY_SEP (p
[2])))
1466 /* Collapse multiple "/", except leave leading "//" alone. */
1475 /* At last, set drive name. */
1477 /* Except for network file name. */
1478 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1479 #endif /* WINDOWSNT */
1481 if (!drive
) emacs_abort ();
1483 target
[0] = DRIVE_LETTER (drive
);
1486 /* Reinsert the escape prefix if required. */
1493 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1494 dostounix_filename (SSDATA (result
));
1496 if (!NILP (Vw32_downcase_file_names
))
1497 result
= Fdowncase (result
);
1500 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1501 #endif /* !DOS_NT */
1504 /* Again look to see if the file name has special constructs in it
1505 and perhaps call the corresponding file handler. This is needed
1506 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1507 the ".." component gives us "/user@host:/bar/../baz" which needs
1508 to be expanded again. */
1509 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1510 if (!NILP (handler
))
1512 handled_name
= call3 (handler
, Qexpand_file_name
,
1513 result
, default_directory
);
1514 if (! STRINGP (handled_name
))
1515 error ("Invalid handler in `file-name-handler-alist'");
1516 result
= handled_name
;
1524 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1525 This is the old version of expand-file-name, before it was thoroughly
1526 rewritten for Emacs 10.31. We leave this version here commented-out,
1527 because the code is very complex and likely to have subtle bugs. If
1528 bugs _are_ found, it might be of interest to look at the old code and
1529 see what did it do in the relevant situation.
1531 Don't remove this code: it's true that it will be accessible
1532 from the repository, but a few years from deletion, people will
1533 forget it is there. */
1535 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1536 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1537 "Convert FILENAME to absolute, and canonicalize it.\n\
1538 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1539 \(does not start with slash); if DEFAULT is nil or missing,\n\
1540 the current buffer's value of default-directory is used.\n\
1541 Filenames containing `.' or `..' as components are simplified;\n\
1542 initial `~/' expands to your home directory.\n\
1543 See also the function `substitute-in-file-name'.")
1545 Lisp_Object name
, defalt
;
1549 register unsigned char *newdir
, *p
, *o
;
1551 unsigned char *target
;
1554 CHECK_STRING (name
);
1557 /* If nm is absolute, flush ...// and detect /./ and /../.
1558 If no /./ or /../ we can return right away. */
1565 if (p
[0] == '/' && p
[1] == '/')
1567 if (p
[0] == '/' && p
[1] == '~')
1568 nm
= p
+ 1, lose
= 1;
1569 if (p
[0] == '/' && p
[1] == '.'
1570 && (p
[2] == '/' || p
[2] == 0
1571 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1577 if (nm
== SDATA (name
))
1579 return build_string (nm
);
1583 /* Now determine directory to start with and put it in NEWDIR. */
1587 if (nm
[0] == '~') /* prefix ~ */
1588 if (nm
[1] == '/' || nm
[1] == 0)/* ~/filename */
1590 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1591 newdir
= (unsigned char *) "";
1594 else /* ~user/filename */
1596 /* Get past ~ to user. */
1597 unsigned char *user
= nm
+ 1;
1598 /* Find end of name. */
1599 unsigned char *ptr
= (unsigned char *) strchr (user
, '/');
1600 ptrdiff_t len
= ptr
? ptr
- user
: strlen (user
);
1601 /* Copy the user name into temp storage. */
1602 o
= alloca (len
+ 1);
1603 memcpy (o
, user
, len
);
1606 /* Look up the user name. */
1608 pw
= (struct passwd
*) getpwnam (o
+ 1);
1611 error ("\"%s\" isn't a registered user", o
+ 1);
1613 newdir
= (unsigned char *) pw
->pw_dir
;
1615 /* Discard the user name from NM. */
1619 if (nm
[0] != '/' && !newdir
)
1622 defalt
= current_buffer
->directory
;
1623 CHECK_STRING (defalt
);
1624 newdir
= SDATA (defalt
);
1627 /* Now concatenate the directory and name to new space in the stack frame. */
1629 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1630 target
= alloca (tlen
);
1635 if (nm
[0] == 0 || nm
[0] == '/')
1636 strcpy (target
, newdir
);
1638 file_name_as_directory (target
, newdir
);
1641 strcat (target
, nm
);
1643 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1654 else if (!strncmp (p
, "//", 2)
1660 else if (p
[0] == '/' && p
[1] == '.'
1661 && (p
[2] == '/' || p
[2] == 0))
1663 else if (!strncmp (p
, "/..", 3)
1664 /* `/../' is the "superroot" on certain file systems. */
1666 && (p
[3] == '/' || p
[3] == 0))
1668 while (o
!= target
&& *--o
!= '/')
1670 if (o
== target
&& *o
== '/')
1680 return make_string (target
, o
- target
);
1684 /* If /~ or // appears, discard everything through first slash. */
1686 file_name_absolute_p (const char *filename
)
1689 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
1691 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
1692 && IS_DIRECTORY_SEP (filename
[2]))
1698 search_embedded_absfilename (char *nm
, char *endp
)
1702 for (p
= nm
+ 1; p
< endp
; p
++)
1704 if (IS_DIRECTORY_SEP (p
[-1])
1705 && file_name_absolute_p (p
)
1706 #if defined (WINDOWSNT) || defined (CYGWIN)
1707 /* // at start of file name is meaningful in Apollo,
1708 WindowsNT and Cygwin systems. */
1709 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
1710 #endif /* not (WINDOWSNT || CYGWIN) */
1713 for (s
= p
; *s
&& !IS_DIRECTORY_SEP (*s
); s
++);
1714 if (p
[0] == '~' && s
> p
+ 1) /* We've got "/~something/". */
1716 char *o
= alloca (s
- p
+ 1);
1718 memcpy (o
, p
, s
- p
);
1721 /* If we have ~user and `user' exists, discard
1722 everything up to ~. But if `user' does not exist, leave
1723 ~user alone, it might be a literal file name. */
1725 pw
= getpwnam (o
+ 1);
1737 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1738 Ssubstitute_in_file_name
, 1, 1, 0,
1739 doc
: /* Substitute environment variables referred to in FILENAME.
1740 `$FOO' where FOO is an environment variable name means to substitute
1741 the value of that variable. The variable name should be terminated
1742 with a character not a letter, digit or underscore; otherwise, enclose
1743 the entire variable name in braces.
1745 If `/~' appears, all of FILENAME through that `/' is discarded.
1746 If `//' appears, everything up to and including the first of
1747 those `/' is discarded. */)
1748 (Lisp_Object filename
)
1750 char *nm
, *p
, *x
, *endp
;
1751 bool substituted
= false;
1754 Lisp_Object handler
;
1756 CHECK_STRING (filename
);
1758 multibyte
= STRING_MULTIBYTE (filename
);
1760 /* If the file name has special constructs in it,
1761 call the corresponding file handler. */
1762 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1763 if (!NILP (handler
))
1765 Lisp_Object handled_name
= call2 (handler
, Qsubstitute_in_file_name
,
1767 if (STRINGP (handled_name
))
1768 return handled_name
;
1769 error ("Invalid handler in `file-name-handler-alist'");
1772 /* Always work on a copy of the string, in case GC happens during
1773 decode of environment variables, causing the original Lisp_String
1774 data to be relocated. */
1775 nm
= xlispstrdupa (filename
);
1778 dostounix_filename (nm
);
1779 substituted
= (memcmp (nm
, SDATA (filename
), SBYTES (filename
)) != 0);
1781 endp
= nm
+ SBYTES (filename
);
1783 /* If /~ or // appears, discard everything through first slash. */
1784 p
= search_embedded_absfilename (nm
, endp
);
1786 /* Start over with the new string, so we check the file-name-handler
1787 again. Important with filenames like "/home/foo//:/hello///there"
1788 which would substitute to "/:/hello///there" rather than "/there". */
1789 return Fsubstitute_in_file_name
1790 (make_specified_string (p
, -1, endp
- p
, multibyte
));
1792 /* See if any variables are substituted into the string. */
1794 if (!NILP (Ffboundp (Qsubstitute_env_in_file_name
)))
1797 = (!substituted
? filename
1798 : make_specified_string (nm
, -1, endp
- nm
, multibyte
));
1799 Lisp_Object tmp
= call1 (Qsubstitute_env_in_file_name
, name
);
1801 if (!EQ (tmp
, name
))
1809 if (!NILP (Vw32_downcase_file_names
))
1810 filename
= Fdowncase (filename
);
1815 xnm
= SSDATA (filename
);
1816 x
= xnm
+ SBYTES (filename
);
1818 /* If /~ or // appears, discard everything through first slash. */
1819 while ((p
= search_embedded_absfilename (xnm
, x
)) != NULL
)
1820 /* This time we do not start over because we've already expanded envvars
1821 and replaced $$ with $. Maybe we should start over as well, but we'd
1822 need to quote some $ to $$ first. */
1826 if (!NILP (Vw32_downcase_file_names
))
1828 Lisp_Object xname
= make_specified_string (xnm
, -1, x
- xnm
, multibyte
);
1830 xname
= Fdowncase (xname
);
1835 return (xnm
== SSDATA (filename
)
1837 : make_specified_string (xnm
, -1, x
- xnm
, multibyte
));
1840 /* A slightly faster and more convenient way to get
1841 (directory-file-name (expand-file-name FOO)). */
1844 expand_and_dir_to_file (Lisp_Object filename
, Lisp_Object defdir
)
1846 register Lisp_Object absname
;
1848 absname
= Fexpand_file_name (filename
, defdir
);
1850 /* Remove final slash, if any (unless this is the root dir).
1851 stat behaves differently depending! */
1852 if (SCHARS (absname
) > 1
1853 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
1854 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
) - 2)))
1855 /* We cannot take shortcuts; they might be wrong for magic file names. */
1856 absname
= Fdirectory_file_name (absname
);
1860 /* Signal an error if the file ABSNAME already exists.
1861 If INTERACTIVE, ask the user whether to proceed,
1862 and bypass the error if the user says to go ahead.
1863 QUERYSTRING is a name for the action that is being considered
1866 *STATPTR is used to store the stat information if the file exists.
1867 If the file does not exist, STATPTR->st_mode is set to 0.
1868 If STATPTR is null, we don't store into it.
1870 If QUICK, ask for y or n, not yes or no. */
1873 barf_or_query_if_file_exists (Lisp_Object absname
, const char *querystring
,
1874 bool interactive
, struct stat
*statptr
,
1877 Lisp_Object tem
, encoded_filename
;
1878 struct stat statbuf
;
1879 struct gcpro gcpro1
;
1881 encoded_filename
= ENCODE_FILE (absname
);
1883 /* `stat' is a good way to tell whether the file exists,
1884 regardless of what access permissions it has. */
1885 if (lstat (SSDATA (encoded_filename
), &statbuf
) >= 0)
1887 if (S_ISDIR (statbuf
.st_mode
))
1888 xsignal2 (Qfile_error
,
1889 build_string ("File is a directory"), absname
);
1892 xsignal2 (Qfile_already_exists
,
1893 build_string ("File already exists"), absname
);
1895 tem
= format2 ("File %s already exists; %s anyway? ",
1896 absname
, build_string (querystring
));
1898 tem
= call1 (intern ("y-or-n-p"), tem
);
1900 tem
= do_yes_or_no_p (tem
);
1903 xsignal2 (Qfile_already_exists
,
1904 build_string ("File already exists"), absname
);
1911 statptr
->st_mode
= 0;
1916 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
1917 "fCopy file: \nGCopy %s to file: \np\nP",
1918 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
1919 If NEWNAME names a directory, copy FILE there.
1921 This function always sets the file modes of the output file to match
1924 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1925 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1926 signal a `file-already-exists' error without overwriting. If
1927 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1928 about overwriting; this is what happens in interactive use with M-x.
1929 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1932 Fourth arg KEEP-TIME non-nil means give the output file the same
1933 last-modified time as the old one. (This works on only some systems.)
1935 A prefix arg makes KEEP-TIME non-nil.
1937 If PRESERVE-UID-GID is non-nil, we try to transfer the
1938 uid and gid of FILE to NEWNAME.
1940 If PRESERVE-EXTENDED-ATTRIBUTES is non-nil, we try to copy additional
1941 attributes of FILE to NEWNAME, such as its SELinux context and ACL
1942 entries (depending on how Emacs was built). */)
1943 (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
)
1946 Lisp_Object handler
;
1947 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1948 ptrdiff_t count
= SPECPDL_INDEX ();
1949 Lisp_Object encoded_file
, encoded_newname
;
1951 security_context_t con
;
1959 char buf
[16 * 1024];
1963 encoded_file
= encoded_newname
= Qnil
;
1964 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
1965 CHECK_STRING (file
);
1966 CHECK_STRING (newname
);
1968 if (!NILP (Ffile_directory_p (newname
)))
1969 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
1971 newname
= Fexpand_file_name (newname
, Qnil
);
1973 file
= Fexpand_file_name (file
, Qnil
);
1975 /* If the input file name has special constructs in it,
1976 call the corresponding file handler. */
1977 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1978 /* Likewise for output file name. */
1980 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1981 if (!NILP (handler
))
1982 RETURN_UNGCPRO (call7 (handler
, Qcopy_file
, file
, newname
,
1983 ok_if_already_exists
, keep_time
, preserve_uid_gid
,
1984 preserve_extended_attributes
));
1986 encoded_file
= ENCODE_FILE (file
);
1987 encoded_newname
= ENCODE_FILE (newname
);
1989 if (NILP (ok_if_already_exists
)
1990 || INTEGERP (ok_if_already_exists
))
1991 barf_or_query_if_file_exists (newname
, "copy to it",
1992 INTEGERP (ok_if_already_exists
), &out_st
, 0);
1993 else if (stat (SSDATA (encoded_newname
), &out_st
) < 0)
1997 result
= w32_copy_file (SSDATA (encoded_file
), SSDATA (encoded_newname
),
1998 !NILP (keep_time
), !NILP (preserve_uid_gid
),
1999 !NILP (preserve_extended_attributes
));
2003 report_file_error ("Copying file", list2 (file
, newname
));
2005 report_file_error ("Copying permissions from", file
);
2007 xsignal2 (Qfile_date_error
,
2008 build_string ("Resetting file times"), newname
);
2010 report_file_error ("Copying permissions to", newname
);
2012 #else /* not WINDOWSNT */
2014 ifd
= emacs_open (SSDATA (encoded_file
), O_RDONLY
, 0);
2018 report_file_error ("Opening input file", file
);
2020 record_unwind_protect_int (close_file_unwind
, ifd
);
2022 if (fstat (ifd
, &st
) != 0)
2023 report_file_error ("Input file status", file
);
2025 if (!NILP (preserve_extended_attributes
))
2028 if (is_selinux_enabled ())
2030 conlength
= fgetfilecon (ifd
, &con
);
2031 if (conlength
== -1)
2032 report_file_error ("Doing fgetfilecon", file
);
2037 if (out_st
.st_mode
!= 0
2038 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2039 report_file_errno ("Input and output files are the same",
2040 list2 (file
, newname
), 0);
2042 /* We can copy only regular files. */
2043 if (!S_ISREG (st
.st_mode
))
2044 report_file_errno ("Non-regular file", file
,
2045 S_ISDIR (st
.st_mode
) ? EISDIR
: EINVAL
);
2049 int new_mask
= st
.st_mode
& (!NILP (preserve_uid_gid
) ? 0600 : 0666);
2051 int new_mask
= S_IREAD
| S_IWRITE
;
2053 ofd
= emacs_open (SSDATA (encoded_newname
),
2054 (O_WRONLY
| O_TRUNC
| O_CREAT
2055 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0)),
2059 report_file_error ("Opening output file", newname
);
2061 record_unwind_protect_int (close_file_unwind
, ofd
);
2065 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2066 if (emacs_write_sig (ofd
, buf
, n
) != n
)
2067 report_file_error ("Write error", newname
);
2071 /* Preserve the original file permissions, and if requested, also its
2074 mode_t mode_mask
= 07777;
2075 if (!NILP (preserve_uid_gid
))
2077 /* Attempt to change owner and group. If that doesn't work
2078 attempt to change just the group, as that is sometimes allowed.
2079 Adjust the mode mask to eliminate setuid or setgid bits
2080 that are inappropriate if the owner and group are wrong. */
2081 if (fchown (ofd
, st
.st_uid
, st
.st_gid
) != 0)
2083 mode_mask
&= ~06000;
2084 if (fchown (ofd
, -1, st
.st_gid
) == 0)
2089 switch (!NILP (preserve_extended_attributes
)
2090 ? qcopy_acl (SSDATA (encoded_file
), ifd
,
2091 SSDATA (encoded_newname
), ofd
,
2092 st
.st_mode
& mode_mask
)
2093 : fchmod (ofd
, st
.st_mode
& mode_mask
))
2095 case -2: report_file_error ("Copying permissions from", file
);
2096 case -1: report_file_error ("Copying permissions to", newname
);
2099 #endif /* not MSDOS */
2104 /* Set the modified context back to the file. */
2105 bool fail
= fsetfilecon (ofd
, con
) != 0;
2106 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2107 if (fail
&& errno
!= ENOTSUP
)
2108 report_file_error ("Doing fsetfilecon", newname
);
2114 if (!NILP (keep_time
))
2116 struct timespec atime
= get_stat_atime (&st
);
2117 struct timespec mtime
= get_stat_mtime (&st
);
2118 if (set_file_times (ofd
, SSDATA (encoded_newname
), atime
, mtime
) != 0)
2119 xsignal2 (Qfile_date_error
,
2120 build_string ("Cannot set file date"), newname
);
2123 if (emacs_close (ofd
) < 0)
2124 report_file_error ("Write error", newname
);
2129 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2130 and if it can't, it tells so. Otherwise, under MSDOS we usually
2131 get only the READ bit, which will make the copied file read-only,
2132 so it's better not to chmod at all. */
2133 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2134 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2136 #endif /* not WINDOWSNT */
2138 /* Discard the unwind protects. */
2139 specpdl_ptr
= specpdl
+ count
;
2145 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2146 Smake_directory_internal
, 1, 1, 0,
2147 doc
: /* Create a new directory named DIRECTORY. */)
2148 (Lisp_Object directory
)
2151 Lisp_Object handler
;
2152 Lisp_Object encoded_dir
;
2154 CHECK_STRING (directory
);
2155 directory
= Fexpand_file_name (directory
, Qnil
);
2157 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2158 if (!NILP (handler
))
2159 return call2 (handler
, Qmake_directory_internal
, directory
);
2161 encoded_dir
= ENCODE_FILE (directory
);
2163 dir
= SSDATA (encoded_dir
);
2166 if (mkdir (dir
) != 0)
2168 if (mkdir (dir
, 0777 & ~auto_saving_dir_umask
) != 0)
2170 report_file_error ("Creating directory", directory
);
2175 DEFUN ("delete-directory-internal", Fdelete_directory_internal
,
2176 Sdelete_directory_internal
, 1, 1, 0,
2177 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2178 (Lisp_Object directory
)
2181 Lisp_Object encoded_dir
;
2183 CHECK_STRING (directory
);
2184 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2185 encoded_dir
= ENCODE_FILE (directory
);
2186 dir
= SSDATA (encoded_dir
);
2188 if (rmdir (dir
) != 0)
2189 report_file_error ("Removing directory", directory
);
2194 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 2,
2195 "(list (read-file-name \
2196 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2197 \"Move file to trash: \" \"Delete file: \") \
2198 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2199 (null current-prefix-arg))",
2200 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2201 If file has multiple names, it continues to exist with the other names.
2202 TRASH non-nil means to trash the file instead of deleting, provided
2203 `delete-by-moving-to-trash' is non-nil.
2205 When called interactively, TRASH is t if no prefix argument is given.
2206 With a prefix argument, TRASH is nil. */)
2207 (Lisp_Object filename
, Lisp_Object trash
)
2209 Lisp_Object handler
;
2210 Lisp_Object encoded_file
;
2211 struct gcpro gcpro1
;
2214 if (!NILP (Ffile_directory_p (filename
))
2215 && NILP (Ffile_symlink_p (filename
)))
2216 xsignal2 (Qfile_error
,
2217 build_string ("Removing old name: is a directory"),
2220 filename
= Fexpand_file_name (filename
, Qnil
);
2222 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2223 if (!NILP (handler
))
2224 return call3 (handler
, Qdelete_file
, filename
, trash
);
2226 if (delete_by_moving_to_trash
&& !NILP (trash
))
2227 return call1 (Qmove_file_to_trash
, filename
);
2229 encoded_file
= ENCODE_FILE (filename
);
2231 if (unlink (SSDATA (encoded_file
)) < 0)
2232 report_file_error ("Removing old name", filename
);
2237 internal_delete_file_1 (Lisp_Object ignore
)
2242 /* Delete file FILENAME, returning true if successful.
2243 This ignores `delete-by-moving-to-trash'. */
2246 internal_delete_file (Lisp_Object filename
)
2250 tem
= internal_condition_case_2 (Fdelete_file
, filename
, Qnil
,
2251 Qt
, internal_delete_file_1
);
2255 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2256 "fRename file: \nGRename %s to file: \np",
2257 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2258 If file has names other than FILE, it continues to have those names.
2259 Signals a `file-already-exists' error if a file NEWNAME already exists
2260 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2261 A number as third arg means request confirmation if NEWNAME already exists.
2262 This is what happens in interactive use with M-x. */)
2263 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2265 Lisp_Object handler
;
2266 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2267 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2269 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2270 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2271 CHECK_STRING (file
);
2272 CHECK_STRING (newname
);
2273 file
= Fexpand_file_name (file
, Qnil
);
2275 if ((!NILP (Ffile_directory_p (newname
)))
2277 /* If the file names are identical but for the case,
2278 don't attempt to move directory to itself. */
2279 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2283 Lisp_Object fname
= (NILP (Ffile_directory_p (file
))
2284 ? file
: Fdirectory_file_name (file
));
2285 newname
= Fexpand_file_name (Ffile_name_nondirectory (fname
), newname
);
2288 newname
= Fexpand_file_name (newname
, Qnil
);
2290 /* If the file name has special constructs in it,
2291 call the corresponding file handler. */
2292 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2294 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2295 if (!NILP (handler
))
2296 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2297 file
, newname
, ok_if_already_exists
));
2299 encoded_file
= ENCODE_FILE (file
);
2300 encoded_newname
= ENCODE_FILE (newname
);
2303 /* If the file names are identical but for the case, don't ask for
2304 confirmation: they simply want to change the letter-case of the
2306 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2308 if (NILP (ok_if_already_exists
)
2309 || INTEGERP (ok_if_already_exists
))
2310 barf_or_query_if_file_exists (newname
, "rename to it",
2311 INTEGERP (ok_if_already_exists
), 0, 0);
2312 if (rename (SSDATA (encoded_file
), SSDATA (encoded_newname
)) < 0)
2314 int rename_errno
= errno
;
2315 if (rename_errno
== EXDEV
)
2318 symlink_target
= Ffile_symlink_p (file
);
2319 if (! NILP (symlink_target
))
2320 Fmake_symbolic_link (symlink_target
, newname
,
2321 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2322 else if (!NILP (Ffile_directory_p (file
)))
2323 call4 (Qcopy_directory
, file
, newname
, Qt
, Qnil
);
2325 /* We have already prompted if it was an integer, so don't
2326 have copy-file prompt again. */
2327 Fcopy_file (file
, newname
,
2328 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2331 count
= SPECPDL_INDEX ();
2332 specbind (Qdelete_by_moving_to_trash
, Qnil
);
2334 if (!NILP (Ffile_directory_p (file
)) && NILP (symlink_target
))
2335 call2 (Qdelete_directory
, file
, Qt
);
2337 Fdelete_file (file
, Qnil
);
2338 unbind_to (count
, Qnil
);
2341 report_file_errno ("Renaming", list2 (file
, newname
), rename_errno
);
2347 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2348 "fAdd name to file: \nGName to add to %s: \np",
2349 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2350 Signals a `file-already-exists' error if a file NEWNAME already exists
2351 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2352 A number as third arg means request confirmation if NEWNAME already exists.
2353 This is what happens in interactive use with M-x. */)
2354 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2356 Lisp_Object handler
;
2357 Lisp_Object encoded_file
, encoded_newname
;
2358 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2360 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2361 encoded_file
= encoded_newname
= Qnil
;
2362 CHECK_STRING (file
);
2363 CHECK_STRING (newname
);
2364 file
= Fexpand_file_name (file
, Qnil
);
2366 if (!NILP (Ffile_directory_p (newname
)))
2367 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2369 newname
= Fexpand_file_name (newname
, Qnil
);
2371 /* If the file name has special constructs in it,
2372 call the corresponding file handler. */
2373 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2374 if (!NILP (handler
))
2375 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2376 newname
, ok_if_already_exists
));
2378 /* If the new name has special constructs in it,
2379 call the corresponding file handler. */
2380 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2381 if (!NILP (handler
))
2382 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2383 newname
, ok_if_already_exists
));
2385 encoded_file
= ENCODE_FILE (file
);
2386 encoded_newname
= ENCODE_FILE (newname
);
2388 if (NILP (ok_if_already_exists
)
2389 || INTEGERP (ok_if_already_exists
))
2390 barf_or_query_if_file_exists (newname
, "make it a new name",
2391 INTEGERP (ok_if_already_exists
), 0, 0);
2393 unlink (SSDATA (newname
));
2394 if (link (SSDATA (encoded_file
), SSDATA (encoded_newname
)) < 0)
2396 int link_errno
= errno
;
2397 report_file_errno ("Adding new name", list2 (file
, newname
), link_errno
);
2404 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2405 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2406 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2407 Both args must be strings.
2408 Signals a `file-already-exists' error if a file LINKNAME already exists
2409 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2410 A number as third arg means request confirmation if LINKNAME already exists.
2411 This happens for interactive use with M-x. */)
2412 (Lisp_Object filename
, Lisp_Object linkname
, Lisp_Object ok_if_already_exists
)
2414 Lisp_Object handler
;
2415 Lisp_Object encoded_filename
, encoded_linkname
;
2416 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2418 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2419 encoded_filename
= encoded_linkname
= Qnil
;
2420 CHECK_STRING (filename
);
2421 CHECK_STRING (linkname
);
2422 /* If the link target has a ~, we must expand it to get
2423 a truly valid file name. Otherwise, do not expand;
2424 we want to permit links to relative file names. */
2425 if (SREF (filename
, 0) == '~')
2426 filename
= Fexpand_file_name (filename
, Qnil
);
2428 if (!NILP (Ffile_directory_p (linkname
)))
2429 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2431 linkname
= Fexpand_file_name (linkname
, Qnil
);
2433 /* If the file name has special constructs in it,
2434 call the corresponding file handler. */
2435 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2436 if (!NILP (handler
))
2437 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2438 linkname
, ok_if_already_exists
));
2440 /* If the new link name has special constructs in it,
2441 call the corresponding file handler. */
2442 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2443 if (!NILP (handler
))
2444 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2445 linkname
, ok_if_already_exists
));
2447 encoded_filename
= ENCODE_FILE (filename
);
2448 encoded_linkname
= ENCODE_FILE (linkname
);
2450 if (NILP (ok_if_already_exists
)
2451 || INTEGERP (ok_if_already_exists
))
2452 barf_or_query_if_file_exists (linkname
, "make it a link",
2453 INTEGERP (ok_if_already_exists
), 0, 0);
2454 if (symlink (SSDATA (encoded_filename
), SSDATA (encoded_linkname
)) < 0)
2456 /* If we didn't complain already, silently delete existing file. */
2458 if (errno
== EEXIST
)
2460 unlink (SSDATA (encoded_linkname
));
2461 if (symlink (SSDATA (encoded_filename
), SSDATA (encoded_linkname
))
2468 if (errno
== ENOSYS
)
2471 xsignal1 (Qfile_error
,
2472 build_string ("Symbolic links are not supported"));
2475 symlink_errno
= errno
;
2476 report_file_errno ("Making symbolic link", list2 (filename
, linkname
),
2484 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2486 doc
: /* Return t if file FILENAME specifies an absolute file name.
2487 On Unix, this is a name starting with a `/' or a `~'. */)
2488 (Lisp_Object filename
)
2490 CHECK_STRING (filename
);
2491 return file_name_absolute_p (SSDATA (filename
)) ? Qt
: Qnil
;
2494 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2495 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
2496 See also `file-readable-p' and `file-attributes'.
2497 This returns nil for a symlink to a nonexistent file.
2498 Use `file-symlink-p' to test for such links. */)
2499 (Lisp_Object filename
)
2501 Lisp_Object absname
;
2502 Lisp_Object handler
;
2504 CHECK_STRING (filename
);
2505 absname
= Fexpand_file_name (filename
, Qnil
);
2507 /* If the file name has special constructs in it,
2508 call the corresponding file handler. */
2509 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2510 if (!NILP (handler
))
2512 Lisp_Object result
= call2 (handler
, Qfile_exists_p
, absname
);
2517 absname
= ENCODE_FILE (absname
);
2519 return check_existing (SSDATA (absname
)) ? Qt
: Qnil
;
2522 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2523 doc
: /* Return t if FILENAME can be executed by you.
2524 For a directory, this means you can access files in that directory. */)
2525 (Lisp_Object filename
)
2527 Lisp_Object absname
;
2528 Lisp_Object handler
;
2530 CHECK_STRING (filename
);
2531 absname
= Fexpand_file_name (filename
, Qnil
);
2533 /* If the file name has special constructs in it,
2534 call the corresponding file handler. */
2535 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2536 if (!NILP (handler
))
2537 return call2 (handler
, Qfile_executable_p
, absname
);
2539 absname
= ENCODE_FILE (absname
);
2541 return (check_executable (SSDATA (absname
)) ? Qt
: Qnil
);
2544 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2545 doc
: /* Return t if file FILENAME exists and you can read it.
2546 See also `file-exists-p' and `file-attributes'. */)
2547 (Lisp_Object filename
)
2549 Lisp_Object absname
;
2550 Lisp_Object handler
;
2552 CHECK_STRING (filename
);
2553 absname
= Fexpand_file_name (filename
, Qnil
);
2555 /* If the file name has special constructs in it,
2556 call the corresponding file handler. */
2557 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2558 if (!NILP (handler
))
2559 return call2 (handler
, Qfile_readable_p
, absname
);
2561 absname
= ENCODE_FILE (absname
);
2562 return (faccessat (AT_FDCWD
, SSDATA (absname
), R_OK
, AT_EACCESS
) == 0
2566 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2567 doc
: /* Return t if file FILENAME can be written or created by you. */)
2568 (Lisp_Object filename
)
2570 Lisp_Object absname
, dir
, encoded
;
2571 Lisp_Object handler
;
2573 CHECK_STRING (filename
);
2574 absname
= Fexpand_file_name (filename
, Qnil
);
2576 /* If the file name has special constructs in it,
2577 call the corresponding file handler. */
2578 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2579 if (!NILP (handler
))
2580 return call2 (handler
, Qfile_writable_p
, absname
);
2582 encoded
= ENCODE_FILE (absname
);
2583 if (check_writable (SSDATA (encoded
), W_OK
))
2585 if (errno
!= ENOENT
)
2588 dir
= Ffile_name_directory (absname
);
2589 eassert (!NILP (dir
));
2591 dir
= Fdirectory_file_name (dir
);
2594 dir
= ENCODE_FILE (dir
);
2596 /* The read-only attribute of the parent directory doesn't affect
2597 whether a file or directory can be created within it. Some day we
2598 should check ACLs though, which do affect this. */
2599 return file_directory_p (SDATA (dir
)) ? Qt
: Qnil
;
2601 return check_writable (SSDATA (dir
), W_OK
| X_OK
) ? Qt
: Qnil
;
2605 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2606 doc
: /* Access file FILENAME, and get an error if that does not work.
2607 The second argument STRING is used in the error message.
2608 If there is no error, returns nil. */)
2609 (Lisp_Object filename
, Lisp_Object string
)
2611 Lisp_Object handler
, encoded_filename
, absname
;
2613 CHECK_STRING (filename
);
2614 absname
= Fexpand_file_name (filename
, Qnil
);
2616 CHECK_STRING (string
);
2618 /* If the file name has special constructs in it,
2619 call the corresponding file handler. */
2620 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
2621 if (!NILP (handler
))
2622 return call3 (handler
, Qaccess_file
, absname
, string
);
2624 encoded_filename
= ENCODE_FILE (absname
);
2626 if (faccessat (AT_FDCWD
, SSDATA (encoded_filename
), R_OK
, AT_EACCESS
) != 0)
2627 report_file_error (SSDATA (string
), filename
);
2632 /* Relative to directory FD, return the symbolic link value of FILENAME.
2633 On failure, return nil. */
2635 emacs_readlinkat (int fd
, char const *filename
)
2637 static struct allocator
const emacs_norealloc_allocator
=
2638 { xmalloc
, NULL
, xfree
, memory_full
};
2640 char readlink_buf
[1024];
2641 char *buf
= careadlinkat (fd
, filename
, readlink_buf
, sizeof readlink_buf
,
2642 &emacs_norealloc_allocator
, readlinkat
);
2646 val
= build_unibyte_string (buf
);
2647 if (buf
[0] == '/' && strchr (buf
, ':'))
2648 val
= concat2 (build_unibyte_string ("/:"), val
);
2649 if (buf
!= readlink_buf
)
2651 val
= DECODE_FILE (val
);
2655 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2656 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
2657 The value is the link target, as a string.
2658 Otherwise it returns nil.
2660 This function returns t when given the name of a symlink that
2661 points to a nonexistent file. */)
2662 (Lisp_Object filename
)
2664 Lisp_Object handler
;
2666 CHECK_STRING (filename
);
2667 filename
= Fexpand_file_name (filename
, Qnil
);
2669 /* If the file name has special constructs in it,
2670 call the corresponding file handler. */
2671 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2672 if (!NILP (handler
))
2673 return call2 (handler
, Qfile_symlink_p
, filename
);
2675 filename
= ENCODE_FILE (filename
);
2677 return emacs_readlinkat (AT_FDCWD
, SSDATA (filename
));
2680 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2681 doc
: /* Return t if FILENAME names an existing directory.
2682 Symbolic links to directories count as directories.
2683 See `file-symlink-p' to distinguish symlinks. */)
2684 (Lisp_Object filename
)
2686 Lisp_Object absname
;
2687 Lisp_Object handler
;
2689 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2691 /* If the file name has special constructs in it,
2692 call the corresponding file handler. */
2693 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2694 if (!NILP (handler
))
2695 return call2 (handler
, Qfile_directory_p
, absname
);
2697 absname
= ENCODE_FILE (absname
);
2699 return file_directory_p (SSDATA (absname
)) ? Qt
: Qnil
;
2702 /* Return true if FILE is a directory or a symlink to a directory. */
2704 file_directory_p (char const *file
)
2707 /* This is cheaper than 'stat'. */
2708 return faccessat (AT_FDCWD
, file
, D_OK
, AT_EACCESS
) == 0;
2711 return stat (file
, &st
) == 0 && S_ISDIR (st
.st_mode
);
2715 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
,
2716 Sfile_accessible_directory_p
, 1, 1, 0,
2717 doc
: /* Return t if file FILENAME names a directory you can open.
2718 For the value to be t, FILENAME must specify the name of a directory as a file,
2719 and the directory must allow you to open files in it. In order to use a
2720 directory as a buffer's current directory, this predicate must return true.
2721 A directory name spec may be given instead; then the value is t
2722 if the directory so specified exists and really is a readable and
2723 searchable directory. */)
2724 (Lisp_Object filename
)
2726 Lisp_Object absname
;
2727 Lisp_Object handler
;
2729 CHECK_STRING (filename
);
2730 absname
= Fexpand_file_name (filename
, Qnil
);
2732 /* If the file name has special constructs in it,
2733 call the corresponding file handler. */
2734 handler
= Ffind_file_name_handler (absname
, Qfile_accessible_directory_p
);
2735 if (!NILP (handler
))
2737 Lisp_Object r
= call2 (handler
, Qfile_accessible_directory_p
, absname
);
2742 absname
= ENCODE_FILE (absname
);
2743 return file_accessible_directory_p (SSDATA (absname
)) ? Qt
: Qnil
;
2746 /* If FILE is a searchable directory or a symlink to a
2747 searchable directory, return true. Otherwise return
2748 false and set errno to an error number. */
2750 file_accessible_directory_p (char const *file
)
2753 /* There's no need to test whether FILE is searchable, as the
2754 searchable/executable bit is invented on DOS_NT platforms. */
2755 return file_directory_p (file
);
2757 /* On POSIXish platforms, use just one system call; this avoids a
2758 race and is typically faster. */
2759 ptrdiff_t len
= strlen (file
);
2765 /* Normally a file "FOO" is an accessible directory if "FOO/." exists.
2766 There are three exceptions: "", "/", and "//". Leave "" alone,
2767 as it's invalid. Append only "." to the other two exceptions as
2768 "/" and "//" are distinct on some platforms, whereas "/", "///",
2769 "////", etc. are all equivalent. */
2774 /* Just check for trailing '/' when deciding whether to append '/'.
2775 That's simpler than testing the two special cases "/" and "//",
2776 and it's a safe optimization here. */
2777 char *buf
= SAFE_ALLOCA (len
+ 3);
2778 memcpy (buf
, file
, len
);
2779 strcpy (buf
+ len
, &"/."[file
[len
- 1] == '/']);
2783 ok
= check_existing (dir
);
2784 saved_errno
= errno
;
2786 errno
= saved_errno
;
2791 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2792 doc
: /* Return t if FILENAME names a regular file.
2793 This is the sort of file that holds an ordinary stream of data bytes.
2794 Symbolic links to regular files count as regular files.
2795 See `file-symlink-p' to distinguish symlinks. */)
2796 (Lisp_Object filename
)
2798 register Lisp_Object absname
;
2800 Lisp_Object handler
;
2802 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2804 /* If the file name has special constructs in it,
2805 call the corresponding file handler. */
2806 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2807 if (!NILP (handler
))
2808 return call2 (handler
, Qfile_regular_p
, absname
);
2810 absname
= ENCODE_FILE (absname
);
2815 Lisp_Object tem
= Vw32_get_true_file_attributes
;
2817 /* Tell stat to use expensive method to get accurate info. */
2818 Vw32_get_true_file_attributes
= Qt
;
2819 result
= stat (SDATA (absname
), &st
);
2820 Vw32_get_true_file_attributes
= tem
;
2824 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2827 if (stat (SSDATA (absname
), &st
) < 0)
2829 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2833 DEFUN ("file-selinux-context", Ffile_selinux_context
,
2834 Sfile_selinux_context
, 1, 1, 0,
2835 doc
: /* Return SELinux context of file named FILENAME.
2836 The return value is a list (USER ROLE TYPE RANGE), where the list
2837 elements are strings naming the user, role, type, and range of the
2838 file's SELinux security context.
2840 Return (nil nil nil nil) if the file is nonexistent or inaccessible,
2841 or if SELinux is disabled, or if Emacs lacks SELinux support. */)
2842 (Lisp_Object filename
)
2844 Lisp_Object absname
;
2845 Lisp_Object values
[4];
2846 Lisp_Object handler
;
2848 security_context_t con
;
2853 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2855 /* If the file name has special constructs in it,
2856 call the corresponding file handler. */
2857 handler
= Ffind_file_name_handler (absname
, Qfile_selinux_context
);
2858 if (!NILP (handler
))
2859 return call2 (handler
, Qfile_selinux_context
, absname
);
2861 absname
= ENCODE_FILE (absname
);
2868 if (is_selinux_enabled ())
2870 conlength
= lgetfilecon (SSDATA (absname
), &con
);
2873 context
= context_new (con
);
2874 if (context_user_get (context
))
2875 values
[0] = build_string (context_user_get (context
));
2876 if (context_role_get (context
))
2877 values
[1] = build_string (context_role_get (context
));
2878 if (context_type_get (context
))
2879 values
[2] = build_string (context_type_get (context
));
2880 if (context_range_get (context
))
2881 values
[3] = build_string (context_range_get (context
));
2882 context_free (context
);
2888 return Flist (sizeof (values
) / sizeof (values
[0]), values
);
2891 DEFUN ("set-file-selinux-context", Fset_file_selinux_context
,
2892 Sset_file_selinux_context
, 2, 2, 0,
2893 doc
: /* Set SELinux context of file named FILENAME to CONTEXT.
2894 CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
2895 elements are strings naming the components of a SELinux context.
2897 Value is t if setting of SELinux context was successful, nil otherwise.
2899 This function does nothing and returns nil if SELinux is disabled,
2900 or if Emacs was not compiled with SELinux support. */)
2901 (Lisp_Object filename
, Lisp_Object context
)
2903 Lisp_Object absname
;
2904 Lisp_Object handler
;
2906 Lisp_Object encoded_absname
;
2907 Lisp_Object user
= CAR_SAFE (context
);
2908 Lisp_Object role
= CAR_SAFE (CDR_SAFE (context
));
2909 Lisp_Object type
= CAR_SAFE (CDR_SAFE (CDR_SAFE (context
)));
2910 Lisp_Object range
= CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context
))));
2911 security_context_t con
;
2914 context_t parsed_con
;
2917 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
2919 /* If the file name has special constructs in it,
2920 call the corresponding file handler. */
2921 handler
= Ffind_file_name_handler (absname
, Qset_file_selinux_context
);
2922 if (!NILP (handler
))
2923 return call3 (handler
, Qset_file_selinux_context
, absname
, context
);
2926 if (is_selinux_enabled ())
2928 /* Get current file context. */
2929 encoded_absname
= ENCODE_FILE (absname
);
2930 conlength
= lgetfilecon (SSDATA (encoded_absname
), &con
);
2933 parsed_con
= context_new (con
);
2934 /* Change the parts defined in the parameter.*/
2937 if (context_user_set (parsed_con
, SSDATA (user
)))
2938 error ("Doing context_user_set");
2942 if (context_role_set (parsed_con
, SSDATA (role
)))
2943 error ("Doing context_role_set");
2947 if (context_type_set (parsed_con
, SSDATA (type
)))
2948 error ("Doing context_type_set");
2950 if (STRINGP (range
))
2952 if (context_range_set (parsed_con
, SSDATA (range
)))
2953 error ("Doing context_range_set");
2956 /* Set the modified context back to the file. */
2957 fail
= (lsetfilecon (SSDATA (encoded_absname
),
2958 context_str (parsed_con
))
2960 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2961 if (fail
&& errno
!= ENOTSUP
)
2962 report_file_error ("Doing lsetfilecon", absname
);
2964 context_free (parsed_con
);
2966 return fail
? Qnil
: Qt
;
2969 report_file_error ("Doing lgetfilecon", absname
);
2976 DEFUN ("file-acl", Ffile_acl
, Sfile_acl
, 1, 1, 0,
2977 doc
: /* Return ACL entries of file named FILENAME.
2978 The entries are returned in a format suitable for use in `set-file-acl'
2979 but is otherwise undocumented and subject to change.
2980 Return nil if file does not exist or is not accessible, or if Emacs
2981 was unable to determine the ACL entries. */)
2982 (Lisp_Object filename
)
2984 Lisp_Object absname
;
2985 Lisp_Object handler
;
2986 #ifdef HAVE_ACL_SET_FILE
2988 Lisp_Object acl_string
;
2992 absname
= expand_and_dir_to_file (filename
,
2993 BVAR (current_buffer
, directory
));
2995 /* If the file name has special constructs in it,
2996 call the corresponding file handler. */
2997 handler
= Ffind_file_name_handler (absname
, Qfile_acl
);
2998 if (!NILP (handler
))
2999 return call2 (handler
, Qfile_acl
, absname
);
3001 #ifdef HAVE_ACL_SET_FILE
3002 absname
= ENCODE_FILE (absname
);
3004 acl
= acl_get_file (SSDATA (absname
), ACL_TYPE_ACCESS
);
3008 str
= acl_to_text (acl
, NULL
);
3015 acl_string
= build_string (str
);
3025 DEFUN ("set-file-acl", Fset_file_acl
, Sset_file_acl
,
3027 doc
: /* Set ACL of file named FILENAME to ACL-STRING.
3028 ACL-STRING should contain the textual representation of the ACL
3029 entries in a format suitable for the platform.
3031 Value is t if setting of ACL was successful, nil otherwise.
3033 Setting ACL for local files requires Emacs to be built with ACL
3035 (Lisp_Object filename
, Lisp_Object acl_string
)
3037 Lisp_Object absname
;
3038 Lisp_Object handler
;
3039 #ifdef HAVE_ACL_SET_FILE
3040 Lisp_Object encoded_absname
;
3045 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3047 /* If the file name has special constructs in it,
3048 call the corresponding file handler. */
3049 handler
= Ffind_file_name_handler (absname
, Qset_file_acl
);
3050 if (!NILP (handler
))
3051 return call3 (handler
, Qset_file_acl
, absname
, acl_string
);
3053 #ifdef HAVE_ACL_SET_FILE
3054 if (STRINGP (acl_string
))
3056 acl
= acl_from_text (SSDATA (acl_string
));
3059 report_file_error ("Converting ACL", absname
);
3063 encoded_absname
= ENCODE_FILE (absname
);
3065 fail
= (acl_set_file (SSDATA (encoded_absname
), ACL_TYPE_ACCESS
,
3068 if (fail
&& acl_errno_valid (errno
))
3069 report_file_error ("Setting ACL", absname
);
3072 return fail
? Qnil
: Qt
;
3079 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3080 doc
: /* Return mode bits of file named FILENAME, as an integer.
3081 Return nil, if file does not exist or is not accessible. */)
3082 (Lisp_Object filename
)
3084 Lisp_Object absname
;
3086 Lisp_Object handler
;
3088 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
3090 /* If the file name has special constructs in it,
3091 call the corresponding file handler. */
3092 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3093 if (!NILP (handler
))
3094 return call2 (handler
, Qfile_modes
, absname
);
3096 absname
= ENCODE_FILE (absname
);
3098 if (stat (SSDATA (absname
), &st
) < 0)
3101 return make_number (st
.st_mode
& 07777);
3104 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
3105 "(let ((file (read-file-name \"File: \"))) \
3106 (list file (read-file-modes nil file)))",
3107 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3108 Only the 12 low bits of MODE are used.
3110 Interactively, mode bits are read by `read-file-modes', which accepts
3111 symbolic notation, like the `chmod' command from GNU Coreutils. */)
3112 (Lisp_Object filename
, Lisp_Object mode
)
3114 Lisp_Object absname
, encoded_absname
;
3115 Lisp_Object handler
;
3117 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3118 CHECK_NUMBER (mode
);
3120 /* If the file name has special constructs in it,
3121 call the corresponding file handler. */
3122 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3123 if (!NILP (handler
))
3124 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3126 encoded_absname
= ENCODE_FILE (absname
);
3128 if (chmod (SSDATA (encoded_absname
), XINT (mode
) & 07777) < 0)
3129 report_file_error ("Doing chmod", absname
);
3134 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3135 doc
: /* Set the file permission bits for newly created files.
3136 The argument MODE should be an integer; only the low 9 bits are used.
3137 This setting is inherited by subprocesses. */)
3140 CHECK_NUMBER (mode
);
3142 umask ((~ XINT (mode
)) & 0777);
3147 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3148 doc
: /* Return the default file protection for created files.
3149 The value is an integer. */)
3156 realmask
= umask (0);
3160 XSETINT (value
, (~ realmask
) & 0777);
3165 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3166 doc
: /* Set times of file FILENAME to TIMESTAMP.
3167 Set both access and modification times.
3168 Return t on success, else nil.
3169 Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
3171 (Lisp_Object filename
, Lisp_Object timestamp
)
3173 Lisp_Object absname
, encoded_absname
;
3174 Lisp_Object handler
;
3175 struct timespec t
= lisp_time_argument (timestamp
);
3177 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3179 /* If the file name has special constructs in it,
3180 call the corresponding file handler. */
3181 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3182 if (!NILP (handler
))
3183 return call3 (handler
, Qset_file_times
, absname
, timestamp
);
3185 encoded_absname
= ENCODE_FILE (absname
);
3188 if (set_file_times (-1, SSDATA (encoded_absname
), t
, t
) != 0)
3191 /* Setting times on a directory always fails. */
3192 if (file_directory_p (SSDATA (encoded_absname
)))
3195 report_file_error ("Setting file times", absname
);
3203 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3204 doc
: /* Tell Unix to finish all pending disk updates. */)
3211 #endif /* HAVE_SYNC */
3213 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3214 doc
: /* Return t if file FILE1 is newer than file FILE2.
3215 If FILE1 does not exist, the answer is nil;
3216 otherwise, if FILE2 does not exist, the answer is t. */)
3217 (Lisp_Object file1
, Lisp_Object file2
)
3219 Lisp_Object absname1
, absname2
;
3220 struct stat st1
, st2
;
3221 Lisp_Object handler
;
3222 struct gcpro gcpro1
, gcpro2
;
3224 CHECK_STRING (file1
);
3225 CHECK_STRING (file2
);
3228 GCPRO2 (absname1
, file2
);
3229 absname1
= expand_and_dir_to_file (file1
, BVAR (current_buffer
, directory
));
3230 absname2
= expand_and_dir_to_file (file2
, BVAR (current_buffer
, directory
));
3233 /* If the file name has special constructs in it,
3234 call the corresponding file handler. */
3235 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3237 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3238 if (!NILP (handler
))
3239 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3241 GCPRO2 (absname1
, absname2
);
3242 absname1
= ENCODE_FILE (absname1
);
3243 absname2
= ENCODE_FILE (absname2
);
3246 if (stat (SSDATA (absname1
), &st1
) < 0)
3249 if (stat (SSDATA (absname2
), &st2
) < 0)
3252 return (timespec_cmp (get_stat_mtime (&st2
), get_stat_mtime (&st1
)) < 0
3256 #ifndef READ_BUF_SIZE
3257 #define READ_BUF_SIZE (64 << 10)
3259 /* Some buffer offsets are stored in 'int' variables. */
3260 verify (READ_BUF_SIZE
<= INT_MAX
);
3262 /* This function is called after Lisp functions to decide a coding
3263 system are called, or when they cause an error. Before they are
3264 called, the current buffer is set unibyte and it contains only a
3265 newly inserted text (thus the buffer was empty before the
3268 The functions may set markers, overlays, text properties, or even
3269 alter the buffer contents, change the current buffer.
3271 Here, we reset all those changes by:
3272 o set back the current buffer.
3273 o move all markers and overlays to BEG.
3274 o remove all text properties.
3275 o set back the buffer multibyteness. */
3278 decide_coding_unwind (Lisp_Object unwind_data
)
3280 Lisp_Object multibyte
, undo_list
, buffer
;
3282 multibyte
= XCAR (unwind_data
);
3283 unwind_data
= XCDR (unwind_data
);
3284 undo_list
= XCAR (unwind_data
);
3285 buffer
= XCDR (unwind_data
);
3287 set_buffer_internal (XBUFFER (buffer
));
3288 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3289 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3290 set_buffer_intervals (current_buffer
, NULL
);
3291 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3293 /* Now we are safe to change the buffer's multibyteness directly. */
3294 bset_enable_multibyte_characters (current_buffer
, multibyte
);
3295 bset_undo_list (current_buffer
, undo_list
);
3298 /* Read from a non-regular file. STATE is a Lisp_Save_Value
3299 object where slot 0 is the file descriptor, slot 1 specifies
3300 an offset to put the read bytes, and slot 2 is the maximum
3301 amount of bytes to read. Value is the number of bytes read. */
3304 read_non_regular (Lisp_Object state
)
3310 nbytes
= emacs_read (XSAVE_INTEGER (state
, 0),
3311 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
3312 + XSAVE_INTEGER (state
, 1)),
3313 XSAVE_INTEGER (state
, 2));
3315 /* Fast recycle this object for the likely next call. */
3317 return make_number (nbytes
);
3321 /* Condition-case handler used when reading from non-regular files
3322 in insert-file-contents. */
3325 read_non_regular_quit (Lisp_Object ignore
)
3330 /* Return the file offset that VAL represents, checking for type
3331 errors and overflow. */
3333 file_offset (Lisp_Object val
)
3335 if (RANGED_INTEGERP (0, val
, TYPE_MAXIMUM (off_t
)))
3340 double v
= XFLOAT_DATA (val
);
3342 && (sizeof (off_t
) < sizeof v
3343 ? v
<= TYPE_MAXIMUM (off_t
)
3344 : v
< TYPE_MAXIMUM (off_t
)))
3348 wrong_type_argument (intern ("file-offset"), val
);
3351 /* Return a special time value indicating the error number ERRNUM. */
3352 static struct timespec
3353 time_error_value (int errnum
)
3355 int ns
= (errnum
== ENOENT
|| errnum
== EACCES
|| errnum
== ENOTDIR
3356 ? NONEXISTENT_MODTIME_NSECS
3357 : UNKNOWN_MODTIME_NSECS
);
3358 return make_timespec (0, ns
);
3361 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3363 doc
: /* Insert contents of file FILENAME after point.
3364 Returns list of absolute file name and number of characters inserted.
3365 If second argument VISIT is non-nil, the buffer's visited filename and
3366 last save file modtime are set, and it is marked unmodified. If
3367 visiting and the file does not exist, visiting is completed before the
3370 The optional third and fourth arguments BEG and END specify what portion
3371 of the file to insert. These arguments count bytes in the file, not
3372 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3374 If optional fifth argument REPLACE is non-nil, replace the current
3375 buffer contents (in the accessible portion) with the file contents.
3376 This is better than simply deleting and inserting the whole thing
3377 because (1) it preserves some marker positions and (2) it puts less data
3378 in the undo list. When REPLACE is non-nil, the second return value is
3379 the number of characters that replace previous buffer contents.
3381 This function does code conversion according to the value of
3382 `coding-system-for-read' or `file-coding-system-alist', and sets the
3383 variable `last-coding-system-used' to the coding system actually used.
3385 In addition, this function decodes the inserted text from known formats
3386 by calling `format-decode', which see. */)
3387 (Lisp_Object filename
, Lisp_Object visit
, Lisp_Object beg
, Lisp_Object end
, Lisp_Object replace
)
3390 struct timespec mtime
;
3392 ptrdiff_t inserted
= 0;
3394 off_t beg_offset
, end_offset
;
3396 ptrdiff_t count
= SPECPDL_INDEX ();
3397 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3398 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3400 ptrdiff_t total
= 0;
3401 bool not_regular
= 0;
3403 char read_buf
[READ_BUF_SIZE
];
3404 struct coding_system coding
;
3405 bool replace_handled
= 0;
3406 bool set_coding_system
= 0;
3407 Lisp_Object coding_system
;
3409 /* If the undo log only contains the insertion, there's no point
3410 keeping it. It's typically when we first fill a file-buffer. */
3411 bool empty_undo_list_p
3412 = (!NILP (visit
) && NILP (BVAR (current_buffer
, undo_list
))
3414 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3415 bool we_locked_file
= 0;
3418 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3419 error ("Cannot do file visiting in an indirect buffer");
3421 if (!NILP (BVAR (current_buffer
, read_only
)))
3422 Fbarf_if_buffer_read_only ();
3426 orig_filename
= Qnil
;
3429 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3431 CHECK_STRING (filename
);
3432 filename
= Fexpand_file_name (filename
, Qnil
);
3434 /* The value Qnil means that the coding system is not yet
3436 coding_system
= Qnil
;
3438 /* If the file name has special constructs in it,
3439 call the corresponding file handler. */
3440 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3441 if (!NILP (handler
))
3443 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3444 visit
, beg
, end
, replace
);
3445 if (CONSP (val
) && CONSP (XCDR (val
))
3446 && RANGED_INTEGERP (0, XCAR (XCDR (val
)), ZV
- PT
))
3447 inserted
= XINT (XCAR (XCDR (val
)));
3451 orig_filename
= filename
;
3452 filename
= ENCODE_FILE (filename
);
3454 fd
= emacs_open (SSDATA (filename
), O_RDONLY
, 0);
3459 report_file_error ("Opening input file", orig_filename
);
3460 mtime
= time_error_value (save_errno
);
3462 if (!NILP (Vcoding_system_for_read
))
3463 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3467 fd_index
= SPECPDL_INDEX ();
3468 record_unwind_protect_int (close_file_unwind
, fd
);
3470 /* Replacement should preserve point as it preserves markers. */
3471 if (!NILP (replace
))
3472 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3474 if (fstat (fd
, &st
) != 0)
3475 report_file_error ("Input file status", orig_filename
);
3476 mtime
= get_stat_mtime (&st
);
3478 /* This code will need to be changed in order to work on named
3479 pipes, and it's probably just not worth it. So we should at
3480 least signal an error. */
3481 if (!S_ISREG (st
.st_mode
))
3488 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3489 xsignal2 (Qfile_error
,
3490 build_string ("not a regular file"), orig_filename
);
3495 if (!NILP (beg
) || !NILP (end
))
3496 error ("Attempt to visit less than an entire file");
3497 if (BEG
< Z
&& NILP (replace
))
3498 error ("Cannot do file visiting in a non-empty buffer");
3502 beg_offset
= file_offset (beg
);
3507 end_offset
= file_offset (end
);
3511 end_offset
= TYPE_MAXIMUM (off_t
);
3514 end_offset
= st
.st_size
;
3516 /* A negative size can happen on a platform that allows file
3517 sizes greater than the maximum off_t value. */
3521 /* The file size returned from stat may be zero, but data
3522 may be readable nonetheless, for example when this is a
3523 file in the /proc filesystem. */
3524 if (end_offset
== 0)
3525 end_offset
= READ_BUF_SIZE
;
3529 /* Check now whether the buffer will become too large,
3530 in the likely case where the file's length is not changing.
3531 This saves a lot of needless work before a buffer overflow. */
3534 /* The likely offset where we will stop reading. We could read
3535 more (or less), if the file grows (or shrinks) as we read it. */
3536 off_t likely_end
= min (end_offset
, st
.st_size
);
3538 if (beg_offset
< likely_end
)
3541 = Z_BYTE
- (!NILP (replace
) ? ZV_BYTE
- BEGV_BYTE
: 0);
3542 ptrdiff_t buf_growth_max
= BUF_BYTES_MAX
- buf_bytes
;
3543 off_t likely_growth
= likely_end
- beg_offset
;
3544 if (buf_growth_max
< likely_growth
)
3549 /* Prevent redisplay optimizations. */
3550 current_buffer
->clip_changed
= 1;
3552 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3554 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3555 setup_coding_system (coding_system
, &coding
);
3556 /* Ensure we set Vlast_coding_system_used. */
3557 set_coding_system
= 1;
3561 /* Decide the coding system to use for reading the file now
3562 because we can't use an optimized method for handling
3563 `coding:' tag if the current buffer is not empty. */
3564 if (!NILP (Vcoding_system_for_read
))
3565 coding_system
= Vcoding_system_for_read
;
3568 /* Don't try looking inside a file for a coding system
3569 specification if it is not seekable. */
3570 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3572 /* Find a coding system specified in the heading two
3573 lines or in the tailing several lines of the file.
3574 We assume that the 1K-byte and 3K-byte for heading
3575 and tailing respectively are sufficient for this
3579 if (st
.st_size
<= (1024 * 4))
3580 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3583 nread
= emacs_read (fd
, read_buf
, 1024);
3587 if (lseek (fd
, - (1024 * 3), SEEK_END
) < 0)
3588 report_file_error ("Setting file position",
3590 ntail
= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3591 nread
= ntail
< 0 ? ntail
: nread
+ ntail
;
3596 report_file_error ("Read error", orig_filename
);
3599 struct buffer
*prev
= current_buffer
;
3600 Lisp_Object workbuf
;
3603 record_unwind_current_buffer ();
3605 workbuf
= Fget_buffer_create (build_string (" *code-converting-work*"));
3606 buf
= XBUFFER (workbuf
);
3608 delete_all_overlays (buf
);
3609 bset_directory (buf
, BVAR (current_buffer
, directory
));
3610 bset_read_only (buf
, Qnil
);
3611 bset_filename (buf
, Qnil
);
3612 bset_undo_list (buf
, Qt
);
3613 eassert (buf
->overlays_before
== NULL
);
3614 eassert (buf
->overlays_after
== NULL
);
3616 set_buffer_internal (buf
);
3618 bset_enable_multibyte_characters (buf
, Qnil
);
3620 insert_1_both ((char *) read_buf
, nread
, nread
, 0, 0, 0);
3621 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3622 coding_system
= call2 (Vset_auto_coding_function
,
3623 filename
, make_number (nread
));
3624 set_buffer_internal (prev
);
3626 /* Discard the unwind protect for recovering the
3630 /* Rewind the file for the actual read done later. */
3631 if (lseek (fd
, 0, SEEK_SET
) < 0)
3632 report_file_error ("Setting file position", orig_filename
);
3636 if (NILP (coding_system
))
3638 /* If we have not yet decided a coding system, check
3639 file-coding-system-alist. */
3640 Lisp_Object args
[6];
3642 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3643 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3644 coding_system
= Ffind_operation_coding_system (6, args
);
3645 if (CONSP (coding_system
))
3646 coding_system
= XCAR (coding_system
);
3650 if (NILP (coding_system
))
3651 coding_system
= Qundecided
;
3653 CHECK_CODING_SYSTEM (coding_system
);
3655 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3656 /* We must suppress all character code conversion except for
3657 end-of-line conversion. */
3658 coding_system
= raw_text_coding_system (coding_system
);
3660 setup_coding_system (coding_system
, &coding
);
3661 /* Ensure we set Vlast_coding_system_used. */
3662 set_coding_system
= 1;
3665 /* If requested, replace the accessible part of the buffer
3666 with the file contents. Avoid replacing text at the
3667 beginning or end of the buffer that matches the file contents;
3668 that preserves markers pointing to the unchanged parts.
3670 Here we implement this feature in an optimized way
3671 for the case where code conversion is NOT needed.
3672 The following if-statement handles the case of conversion
3673 in a less optimal way.
3675 If the code conversion is "automatic" then we try using this
3676 method and hope for the best.
3677 But if we discover the need for conversion, we give up on this method
3678 and let the following if-statement handle the replace job. */
3681 && (NILP (coding_system
)
3682 || ! CODING_REQUIRE_DECODING (&coding
)))
3684 /* same_at_start and same_at_end count bytes,
3685 because file access counts bytes
3686 and BEG and END count bytes. */
3687 ptrdiff_t same_at_start
= BEGV_BYTE
;
3688 ptrdiff_t same_at_end
= ZV_BYTE
;
3690 /* There is still a possibility we will find the need to do code
3691 conversion. If that happens, set this variable to
3692 give up on handling REPLACE in the optimized way. */
3693 bool giveup_match_end
= 0;
3695 if (beg_offset
!= 0)
3697 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
3698 report_file_error ("Setting file position", orig_filename
);
3703 /* Count how many chars at the start of the file
3704 match the text at the beginning of the buffer. */
3709 nread
= emacs_read (fd
, read_buf
, sizeof read_buf
);
3711 report_file_error ("Read error", orig_filename
);
3712 else if (nread
== 0)
3715 if (CODING_REQUIRE_DETECTION (&coding
))
3717 coding_system
= detect_coding_system ((unsigned char *) read_buf
,
3720 setup_coding_system (coding_system
, &coding
);
3723 if (CODING_REQUIRE_DECODING (&coding
))
3724 /* We found that the file should be decoded somehow.
3725 Let's give up here. */
3727 giveup_match_end
= 1;
3732 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3733 && FETCH_BYTE (same_at_start
) == read_buf
[bufpos
])
3734 same_at_start
++, bufpos
++;
3735 /* If we found a discrepancy, stop the scan.
3736 Otherwise loop around and scan the next bufferful. */
3737 if (bufpos
!= nread
)
3741 /* If the file matches the buffer completely,
3742 there's no need to replace anything. */
3743 if (same_at_start
- BEGV_BYTE
== end_offset
- beg_offset
)
3746 clear_unwind_protect (fd_index
);
3748 /* Truncate the buffer to the size of the file. */
3749 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3754 /* Count how many chars at the end of the file
3755 match the text at the end of the buffer. But, if we have
3756 already found that decoding is necessary, don't waste time. */
3757 while (!giveup_match_end
)
3759 int total_read
, nread
, bufpos
, trial
;
3762 /* At what file position are we now scanning? */
3763 curpos
= end_offset
- (ZV_BYTE
- same_at_end
);
3764 /* If the entire file matches the buffer tail, stop the scan. */
3767 /* How much can we scan in the next step? */
3768 trial
= min (curpos
, sizeof read_buf
);
3769 if (lseek (fd
, curpos
- trial
, SEEK_SET
) < 0)
3770 report_file_error ("Setting file position", orig_filename
);
3772 total_read
= nread
= 0;
3773 while (total_read
< trial
)
3775 nread
= emacs_read (fd
, read_buf
+ total_read
, trial
- total_read
);
3777 report_file_error ("Read error", orig_filename
);
3778 else if (nread
== 0)
3780 total_read
+= nread
;
3783 /* Scan this bufferful from the end, comparing with
3784 the Emacs buffer. */
3785 bufpos
= total_read
;
3787 /* Compare with same_at_start to avoid counting some buffer text
3788 as matching both at the file's beginning and at the end. */
3789 while (bufpos
> 0 && same_at_end
> same_at_start
3790 && FETCH_BYTE (same_at_end
- 1) == read_buf
[bufpos
- 1])
3791 same_at_end
--, bufpos
--;
3793 /* If we found a discrepancy, stop the scan.
3794 Otherwise loop around and scan the preceding bufferful. */
3797 /* If this discrepancy is because of code conversion,
3798 we cannot use this method; giveup and try the other. */
3799 if (same_at_end
> same_at_start
3800 && FETCH_BYTE (same_at_end
- 1) >= 0200
3801 && ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3802 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3803 giveup_match_end
= 1;
3812 if (! giveup_match_end
)
3816 /* We win! We can handle REPLACE the optimized way. */
3818 /* Extend the start of non-matching text area to multibyte
3819 character boundary. */
3820 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3821 while (same_at_start
> BEGV_BYTE
3822 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3825 /* Extend the end of non-matching text area to multibyte
3826 character boundary. */
3827 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3828 while (same_at_end
< ZV_BYTE
3829 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3832 /* Don't try to reuse the same piece of text twice. */
3833 overlap
= (same_at_start
- BEGV_BYTE
3835 + (! NILP (end
) ? end_offset
: st
.st_size
) - ZV_BYTE
));
3837 same_at_end
+= overlap
;
3839 /* Arrange to read only the nonmatching middle part of the file. */
3840 beg_offset
+= same_at_start
- BEGV_BYTE
;
3841 end_offset
-= ZV_BYTE
- same_at_end
;
3843 invalidate_buffer_caches (current_buffer
,
3844 BYTE_TO_CHAR (same_at_start
),
3845 BYTE_TO_CHAR (same_at_end
));
3846 del_range_byte (same_at_start
, same_at_end
, 0);
3847 /* Insert from the file at the proper position. */
3848 temp
= BYTE_TO_CHAR (same_at_start
);
3849 SET_PT_BOTH (temp
, same_at_start
);
3851 /* If display currently starts at beginning of line,
3852 keep it that way. */
3853 if (XBUFFER (XWINDOW (selected_window
)->contents
) == current_buffer
)
3854 XWINDOW (selected_window
)->start_at_line_beg
= !NILP (Fbolp ());
3856 replace_handled
= 1;
3860 /* If requested, replace the accessible part of the buffer
3861 with the file contents. Avoid replacing text at the
3862 beginning or end of the buffer that matches the file contents;
3863 that preserves markers pointing to the unchanged parts.
3865 Here we implement this feature for the case where code conversion
3866 is needed, in a simple way that needs a lot of memory.
3867 The preceding if-statement handles the case of no conversion
3868 in a more optimized way. */
3869 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3871 ptrdiff_t same_at_start
= BEGV_BYTE
;
3872 ptrdiff_t same_at_end
= ZV_BYTE
;
3873 ptrdiff_t same_at_start_charpos
;
3874 ptrdiff_t inserted_chars
;
3877 unsigned char *decoded
;
3880 ptrdiff_t this_count
= SPECPDL_INDEX ();
3882 = ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
3883 Lisp_Object conversion_buffer
;
3884 struct gcpro gcpro1
;
3886 conversion_buffer
= code_conversion_save (1, multibyte
);
3888 /* First read the whole file, performing code conversion into
3889 CONVERSION_BUFFER. */
3891 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
3892 report_file_error ("Setting file position", orig_filename
);
3894 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3895 unprocessed
= 0; /* Bytes not processed in previous loop. */
3897 GCPRO1 (conversion_buffer
);
3900 /* Read at most READ_BUF_SIZE bytes at a time, to allow
3901 quitting while reading a huge file. */
3903 /* Allow quitting out of the actual I/O. */
3906 this = emacs_read (fd
, read_buf
+ unprocessed
,
3907 READ_BUF_SIZE
- unprocessed
);
3913 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
3914 BUF_Z (XBUFFER (conversion_buffer
)));
3915 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3916 unprocessed
+ this, conversion_buffer
);
3917 unprocessed
= coding
.carryover_bytes
;
3918 if (coding
.carryover_bytes
> 0)
3919 memcpy (read_buf
, coding
.carryover
, unprocessed
);
3923 report_file_error ("Read error", orig_filename
);
3925 clear_unwind_protect (fd_index
);
3927 if (unprocessed
> 0)
3929 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3930 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3931 unprocessed
, conversion_buffer
);
3932 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
3935 coding_system
= CODING_ID_NAME (coding
.id
);
3936 set_coding_system
= 1;
3937 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
3938 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
3939 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3941 /* Compare the beginning of the converted string with the buffer
3945 while (bufpos
< inserted
&& same_at_start
< same_at_end
3946 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
3947 same_at_start
++, bufpos
++;
3949 /* If the file matches the head of buffer completely,
3950 there's no need to replace anything. */
3952 if (bufpos
== inserted
)
3954 /* Truncate the buffer to the size of the file. */
3955 if (same_at_start
!= same_at_end
)
3957 invalidate_buffer_caches (current_buffer
,
3958 BYTE_TO_CHAR (same_at_start
),
3959 BYTE_TO_CHAR (same_at_end
));
3960 del_range_byte (same_at_start
, same_at_end
, 0);
3964 unbind_to (this_count
, Qnil
);
3968 /* Extend the start of non-matching text area to the previous
3969 multibyte character boundary. */
3970 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3971 while (same_at_start
> BEGV_BYTE
3972 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3975 /* Scan this bufferful from the end, comparing with
3976 the Emacs buffer. */
3979 /* Compare with same_at_start to avoid counting some buffer text
3980 as matching both at the file's beginning and at the end. */
3981 while (bufpos
> 0 && same_at_end
> same_at_start
3982 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
3983 same_at_end
--, bufpos
--;
3985 /* Extend the end of non-matching text area to the next
3986 multibyte character boundary. */
3987 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3988 while (same_at_end
< ZV_BYTE
3989 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3992 /* Don't try to reuse the same piece of text twice. */
3993 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3995 same_at_end
+= overlap
;
3997 /* If display currently starts at beginning of line,
3998 keep it that way. */
3999 if (XBUFFER (XWINDOW (selected_window
)->contents
) == current_buffer
)
4000 XWINDOW (selected_window
)->start_at_line_beg
= !NILP (Fbolp ());
4002 /* Replace the chars that we need to replace,
4003 and update INSERTED to equal the number of bytes
4004 we are taking from the decoded string. */
4005 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4007 if (same_at_end
!= same_at_start
)
4009 invalidate_buffer_caches (current_buffer
,
4010 BYTE_TO_CHAR (same_at_start
),
4011 BYTE_TO_CHAR (same_at_end
));
4012 del_range_byte (same_at_start
, same_at_end
, 0);
4014 eassert (same_at_start
== GPT_BYTE
);
4015 same_at_start
= GPT_BYTE
;
4019 temp
= BYTE_TO_CHAR (same_at_start
);
4021 /* Insert from the file at the proper position. */
4022 SET_PT_BOTH (temp
, same_at_start
);
4023 same_at_start_charpos
4024 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4025 same_at_start
- BEGV_BYTE
4026 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4027 eassert (same_at_start_charpos
== temp
- (BEGV
- BEG
));
4029 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4030 same_at_start
+ inserted
- BEGV_BYTE
4031 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
4032 - same_at_start_charpos
);
4033 /* This binding is to avoid ask-user-about-supersession-threat
4034 being called in insert_from_buffer (via in
4035 prepare_to_modify_buffer). */
4036 specbind (intern ("buffer-file-name"), Qnil
);
4037 insert_from_buffer (XBUFFER (conversion_buffer
),
4038 same_at_start_charpos
, inserted_chars
, 0);
4039 /* Set `inserted' to the number of inserted characters. */
4040 inserted
= PT
- temp
;
4041 /* Set point before the inserted characters. */
4042 SET_PT_BOTH (temp
, same_at_start
);
4044 unbind_to (this_count
, Qnil
);
4050 total
= end_offset
- beg_offset
;
4052 /* For a special file, all we can do is guess. */
4053 total
= READ_BUF_SIZE
;
4055 if (NILP (visit
) && total
> 0)
4057 #ifdef CLASH_DETECTION
4058 if (!NILP (BVAR (current_buffer
, file_truename
))
4059 /* Make binding buffer-file-name to nil effective. */
4060 && !NILP (BVAR (current_buffer
, filename
))
4061 && SAVE_MODIFF
>= MODIFF
)
4063 #endif /* CLASH_DETECTION */
4064 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4067 move_gap_both (PT
, PT_BYTE
);
4068 if (GAP_SIZE
< total
)
4069 make_gap (total
- GAP_SIZE
);
4071 if (beg_offset
!= 0 || !NILP (replace
))
4073 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
4074 report_file_error ("Setting file position", orig_filename
);
4077 /* In the following loop, HOW_MUCH contains the total bytes read so
4078 far for a regular file, and not changed for a special file. But,
4079 before exiting the loop, it is set to a negative value if I/O
4083 /* Total bytes inserted. */
4086 /* Here, we don't do code conversion in the loop. It is done by
4087 decode_coding_gap after all data are read into the buffer. */
4089 ptrdiff_t gap_size
= GAP_SIZE
;
4091 while (how_much
< total
)
4093 /* try is reserved in some compilers (Microsoft C) */
4094 ptrdiff_t trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4101 /* Maybe make more room. */
4102 if (gap_size
< trytry
)
4104 make_gap (trytry
- gap_size
);
4105 gap_size
= GAP_SIZE
- inserted
;
4108 /* Read from the file, capturing `quit'. When an
4109 error occurs, end the loop, and arrange for a quit
4110 to be signaled after decoding the text we read. */
4111 nbytes
= internal_condition_case_1
4113 make_save_int_int_int (fd
, inserted
, trytry
),
4114 Qerror
, read_non_regular_quit
);
4122 this = XINT (nbytes
);
4126 /* Allow quitting out of the actual I/O. We don't make text
4127 part of the buffer until all the reading is done, so a C-g
4128 here doesn't do any harm. */
4131 this = emacs_read (fd
,
4132 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
4146 /* For a regular file, where TOTAL is the real size,
4147 count HOW_MUCH to compare with it.
4148 For a special file, where TOTAL is just a buffer size,
4149 so don't bother counting in HOW_MUCH.
4150 (INSERTED is where we count the number of characters inserted.) */
4157 /* Now we have either read all the file data into the gap,
4158 or stop reading on I/O error or quit. If nothing was
4159 read, undo marking the buffer modified. */
4163 #ifdef CLASH_DETECTION
4165 unlock_file (BVAR (current_buffer
, file_truename
));
4167 Vdeactivate_mark
= old_Vdeactivate_mark
;
4170 Vdeactivate_mark
= Qt
;
4173 clear_unwind_protect (fd_index
);
4176 report_file_error ("Read error", orig_filename
);
4178 /* Make the text read part of the buffer. */
4179 GAP_SIZE
-= inserted
;
4181 GPT_BYTE
+= inserted
;
4183 ZV_BYTE
+= inserted
;
4188 /* Put an anchor to ensure multi-byte form ends at gap. */
4193 if (NILP (coding_system
))
4195 /* The coding system is not yet decided. Decide it by an
4196 optimized method for handling `coding:' tag.
4198 Note that we can get here only if the buffer was empty
4199 before the insertion. */
4201 if (!NILP (Vcoding_system_for_read
))
4202 coding_system
= Vcoding_system_for_read
;
4205 /* Since we are sure that the current buffer was empty
4206 before the insertion, we can toggle
4207 enable-multibyte-characters directly here without taking
4208 care of marker adjustment. By this way, we can run Lisp
4209 program safely before decoding the inserted text. */
4210 Lisp_Object unwind_data
;
4211 ptrdiff_t count1
= SPECPDL_INDEX ();
4213 unwind_data
= Fcons (BVAR (current_buffer
, enable_multibyte_characters
),
4214 Fcons (BVAR (current_buffer
, undo_list
),
4215 Fcurrent_buffer ()));
4216 bset_enable_multibyte_characters (current_buffer
, Qnil
);
4217 bset_undo_list (current_buffer
, Qt
);
4218 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4220 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4222 coding_system
= call2 (Vset_auto_coding_function
,
4223 filename
, make_number (inserted
));
4226 if (NILP (coding_system
))
4228 /* If the coding system is not yet decided, check
4229 file-coding-system-alist. */
4230 Lisp_Object args
[6];
4232 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4233 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4234 coding_system
= Ffind_operation_coding_system (6, args
);
4235 if (CONSP (coding_system
))
4236 coding_system
= XCAR (coding_system
);
4238 unbind_to (count1
, Qnil
);
4239 inserted
= Z_BYTE
- BEG_BYTE
;
4242 if (NILP (coding_system
))
4243 coding_system
= Qundecided
;
4245 CHECK_CODING_SYSTEM (coding_system
);
4247 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4248 /* We must suppress all character code conversion except for
4249 end-of-line conversion. */
4250 coding_system
= raw_text_coding_system (coding_system
);
4251 setup_coding_system (coding_system
, &coding
);
4252 /* Ensure we set Vlast_coding_system_used. */
4253 set_coding_system
= 1;
4258 /* When we visit a file by raw-text, we change the buffer to
4260 if (CODING_FOR_UNIBYTE (&coding
)
4261 /* Can't do this if part of the buffer might be preserved. */
4263 /* Visiting a file with these coding system makes the buffer
4265 bset_enable_multibyte_characters (current_buffer
, Qnil
);
4268 coding
.dst_multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
4269 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4270 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4272 move_gap_both (PT
, PT_BYTE
);
4273 GAP_SIZE
+= inserted
;
4274 ZV_BYTE
-= inserted
;
4278 decode_coding_gap (&coding
, inserted
, inserted
);
4279 inserted
= coding
.produced_char
;
4280 coding_system
= CODING_ID_NAME (coding
.id
);
4282 else if (inserted
> 0)
4283 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4286 /* Call after-change hooks for the inserted text, aside from the case
4287 of normal visiting (not with REPLACE), which is done in a new buffer
4288 "before" the buffer is changed. */
4289 if (inserted
> 0 && total
> 0
4290 && (NILP (visit
) || !NILP (replace
)))
4292 signal_after_change (PT
, 0, inserted
);
4293 update_compositions (PT
, PT
, CHECK_BORDER
);
4296 /* Now INSERTED is measured in characters. */
4302 if (empty_undo_list_p
)
4303 bset_undo_list (current_buffer
, Qnil
);
4307 current_buffer
->modtime
= mtime
;
4308 current_buffer
->modtime_size
= st
.st_size
;
4309 bset_filename (current_buffer
, orig_filename
);
4312 SAVE_MODIFF
= MODIFF
;
4313 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
4314 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4315 #ifdef CLASH_DETECTION
4318 if (!NILP (BVAR (current_buffer
, file_truename
)))
4319 unlock_file (BVAR (current_buffer
, file_truename
));
4320 unlock_file (filename
);
4322 #endif /* CLASH_DETECTION */
4324 xsignal2 (Qfile_error
,
4325 build_string ("not a regular file"), orig_filename
);
4328 if (set_coding_system
)
4329 Vlast_coding_system_used
= coding_system
;
4331 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4333 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4335 if (! NILP (insval
))
4337 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4338 wrong_type_argument (intern ("inserted-chars"), insval
);
4339 inserted
= XFASTINT (insval
);
4343 /* Decode file format. */
4346 /* Don't run point motion or modification hooks when decoding. */
4347 ptrdiff_t count1
= SPECPDL_INDEX ();
4348 ptrdiff_t old_inserted
= inserted
;
4349 specbind (Qinhibit_point_motion_hooks
, Qt
);
4350 specbind (Qinhibit_modification_hooks
, Qt
);
4352 /* Save old undo list and don't record undo for decoding. */
4353 old_undo
= BVAR (current_buffer
, undo_list
);
4354 bset_undo_list (current_buffer
, Qt
);
4358 insval
= call3 (Qformat_decode
,
4359 Qnil
, make_number (inserted
), visit
);
4360 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4361 wrong_type_argument (intern ("inserted-chars"), insval
);
4362 inserted
= XFASTINT (insval
);
4366 /* If REPLACE is non-nil and we succeeded in not replacing the
4367 beginning or end of the buffer text with the file's contents,
4368 call format-decode with `point' positioned at the beginning
4369 of the buffer and `inserted' equaling the number of
4370 characters in the buffer. Otherwise, format-decode might
4371 fail to correctly analyze the beginning or end of the buffer.
4372 Hence we temporarily save `point' and `inserted' here and
4373 restore `point' iff format-decode did not insert or delete
4374 any text. Otherwise we leave `point' at point-min. */
4375 ptrdiff_t opoint
= PT
;
4376 ptrdiff_t opoint_byte
= PT_BYTE
;
4377 ptrdiff_t oinserted
= ZV
- BEGV
;
4378 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4380 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4381 insval
= call3 (Qformat_decode
,
4382 Qnil
, make_number (oinserted
), visit
);
4383 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4384 wrong_type_argument (intern ("inserted-chars"), insval
);
4385 if (ochars_modiff
== CHARS_MODIFF
)
4386 /* format_decode didn't modify buffer's characters => move
4387 point back to position before inserted text and leave
4388 value of inserted alone. */
4389 SET_PT_BOTH (opoint
, opoint_byte
);
4391 /* format_decode modified buffer's characters => consider
4392 entire buffer changed and leave point at point-min. */
4393 inserted
= XFASTINT (insval
);
4396 /* For consistency with format-decode call these now iff inserted > 0
4397 (martin 2007-06-28). */
4398 p
= Vafter_insert_file_functions
;
4403 insval
= call1 (XCAR (p
), make_number (inserted
));
4406 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4407 wrong_type_argument (intern ("inserted-chars"), insval
);
4408 inserted
= XFASTINT (insval
);
4413 /* For the rationale of this see the comment on
4414 format-decode above. */
4415 ptrdiff_t opoint
= PT
;
4416 ptrdiff_t opoint_byte
= PT_BYTE
;
4417 ptrdiff_t oinserted
= ZV
- BEGV
;
4418 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4420 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4421 insval
= call1 (XCAR (p
), make_number (oinserted
));
4424 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4425 wrong_type_argument (intern ("inserted-chars"), insval
);
4426 if (ochars_modiff
== CHARS_MODIFF
)
4427 /* after_insert_file_functions didn't modify
4428 buffer's characters => move point back to
4429 position before inserted text and leave value of
4431 SET_PT_BOTH (opoint
, opoint_byte
);
4433 /* after_insert_file_functions did modify buffer's
4434 characters => consider entire buffer changed and
4435 leave point at point-min. */
4436 inserted
= XFASTINT (insval
);
4444 if (!empty_undo_list_p
)
4446 bset_undo_list (current_buffer
, old_undo
);
4447 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4449 /* Adjust the last undo record for the size change during
4450 the format conversion. */
4451 Lisp_Object tem
= XCAR (old_undo
);
4452 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4453 && INTEGERP (XCDR (tem
))
4454 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4455 XSETCDR (tem
, make_number (PT
+ inserted
));
4459 /* If undo_list was Qt before, keep it that way.
4460 Otherwise start with an empty undo_list. */
4461 bset_undo_list (current_buffer
, EQ (old_undo
, Qt
) ? Qt
: Qnil
);
4463 unbind_to (count1
, Qnil
);
4467 && current_buffer
->modtime
.tv_nsec
== NONEXISTENT_MODTIME_NSECS
)
4469 /* If visiting nonexistent file, return nil. */
4470 report_file_errno ("Opening input file", orig_filename
, save_errno
);
4473 /* We made a lot of deletions and insertions above, so invalidate
4474 the newline cache for the entire region of the inserted
4476 if (current_buffer
->newline_cache
)
4477 invalidate_region_cache (current_buffer
,
4478 current_buffer
->newline_cache
,
4479 PT
- BEG
, Z
- PT
- inserted
);
4482 Fsignal (Qquit
, Qnil
);
4484 /* Retval needs to be dealt with in all cases consistently. */
4486 val
= list2 (orig_filename
, make_number (inserted
));
4488 RETURN_UNGCPRO (unbind_to (count
, val
));
4491 static Lisp_Object
build_annotations (Lisp_Object
, Lisp_Object
);
4494 build_annotations_unwind (Lisp_Object arg
)
4496 Vwrite_region_annotation_buffers
= arg
;
4499 /* Decide the coding-system to encode the data with. */
4501 DEFUN ("choose-write-coding-system", Fchoose_write_coding_system
,
4502 Schoose_write_coding_system
, 3, 6, 0,
4503 doc
: /* Choose the coding system for writing a file.
4504 Arguments are as for `write-region'.
4505 This function is for internal use only. It may prompt the user. */ )
4506 (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4507 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
)
4510 Lisp_Object eol_parent
= Qnil
;
4512 /* Mimic write-region behavior. */
4515 XSETFASTINT (start
, BEGV
);
4516 XSETFASTINT (end
, ZV
);
4520 && NILP (Fstring_equal (BVAR (current_buffer
, filename
),
4521 BVAR (current_buffer
, auto_save_file_name
))))
4526 else if (!NILP (Vcoding_system_for_write
))
4528 val
= Vcoding_system_for_write
;
4529 if (coding_system_require_warning
4530 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4531 /* Confirm that VAL can surely encode the current region. */
4532 val
= call5 (Vselect_safe_coding_system_function
,
4533 start
, end
, list2 (Qt
, val
),
4538 /* If the variable `buffer-file-coding-system' is set locally,
4539 it means that the file was read with some kind of code
4540 conversion or the variable is explicitly set by users. We
4541 had better write it out with the same coding system even if
4542 `enable-multibyte-characters' is nil.
4544 If it is not set locally, we anyway have to convert EOL
4545 format if the default value of `buffer-file-coding-system'
4546 tells that it is not Unix-like (LF only) format. */
4547 bool using_default_coding
= 0;
4548 bool force_raw_text
= 0;
4550 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4552 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4555 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4561 /* Check file-coding-system-alist. */
4562 Lisp_Object args
[7], coding_systems
;
4564 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4565 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4567 coding_systems
= Ffind_operation_coding_system (7, args
);
4568 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4569 val
= XCDR (coding_systems
);
4574 /* If we still have not decided a coding system, use the
4575 default value of buffer-file-coding-system. */
4576 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4577 using_default_coding
= 1;
4580 if (! NILP (val
) && ! force_raw_text
)
4582 Lisp_Object spec
, attrs
;
4584 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4585 attrs
= AREF (spec
, 0);
4586 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4591 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4592 /* Confirm that VAL can surely encode the current region. */
4593 val
= call5 (Vselect_safe_coding_system_function
,
4594 start
, end
, val
, Qnil
, filename
);
4596 /* If the decided coding-system doesn't specify end-of-line
4597 format, we use that of
4598 `default-buffer-file-coding-system'. */
4599 if (! using_default_coding
4600 && ! NILP (BVAR (&buffer_defaults
, buffer_file_coding_system
)))
4601 val
= (coding_inherit_eol_type
4602 (val
, BVAR (&buffer_defaults
, buffer_file_coding_system
)));
4604 /* If we decide not to encode text, use `raw-text' or one of its
4607 val
= raw_text_coding_system (val
);
4610 val
= coding_inherit_eol_type (val
, eol_parent
);
4614 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4615 "r\nFWrite region to file: \ni\ni\ni\np",
4616 doc
: /* Write current region into specified file.
4617 When called from a program, requires three arguments:
4618 START, END and FILENAME. START and END are normally buffer positions
4619 specifying the part of the buffer to write.
4620 If START is nil, that means to use the entire buffer contents.
4621 If START is a string, then output that string to the file
4622 instead of any buffer contents; END is ignored.
4624 Optional fourth argument APPEND if non-nil means
4625 append to existing file contents (if any). If it is a number,
4626 seek to that offset in the file before writing.
4627 Optional fifth argument VISIT, if t or a string, means
4628 set the last-save-file-modtime of buffer to this file's modtime
4629 and mark buffer not modified.
4630 If VISIT is a string, it is a second file name;
4631 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4632 VISIT is also the file name to lock and unlock for clash detection.
4633 If VISIT is neither t nor nil nor a string,
4634 that means do not display the \"Wrote file\" message.
4635 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4636 use for locking and unlocking, overriding FILENAME and VISIT.
4637 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4638 for an existing file with the same name. If MUSTBENEW is `excl',
4639 that means to get an error if the file already exists; never overwrite.
4640 If MUSTBENEW is neither nil nor `excl', that means ask for
4641 confirmation before overwriting, but do go ahead and overwrite the file
4642 if the user confirms.
4644 This does code conversion according to the value of
4645 `coding-system-for-write', `buffer-file-coding-system', or
4646 `file-coding-system-alist', and sets the variable
4647 `last-coding-system-used' to the coding system actually used.
4649 This calls `write-region-annotate-functions' at the start, and
4650 `write-region-post-annotation-function' at the end. */)
4651 (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
, Lisp_Object append
,
4652 Lisp_Object visit
, Lisp_Object lockname
, Lisp_Object mustbenew
)
4654 return write_region (start
, end
, filename
, append
, visit
, lockname
, mustbenew
,
4658 /* Like Fwrite_region, except that if DESC is nonnegative, it is a file
4659 descriptor for FILENAME, so do not open or close FILENAME. */
4662 write_region (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4663 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
,
4664 Lisp_Object mustbenew
, int desc
)
4668 off_t offset
IF_LINT (= 0);
4669 bool open_and_close_file
= desc
< 0;
4674 struct timespec modtime
;
4675 ptrdiff_t count
= SPECPDL_INDEX ();
4676 ptrdiff_t count1
IF_LINT (= 0);
4677 Lisp_Object handler
;
4678 Lisp_Object visit_file
;
4679 Lisp_Object annotations
;
4680 Lisp_Object encoded_filename
;
4681 bool visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4682 bool quietly
= !NILP (visit
);
4683 bool file_locked
= 0;
4684 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4685 struct buffer
*given_buffer
;
4686 struct coding_system coding
;
4688 if (current_buffer
->base_buffer
&& visiting
)
4689 error ("Cannot do file visiting in an indirect buffer");
4691 if (!NILP (start
) && !STRINGP (start
))
4692 validate_region (&start
, &end
);
4695 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4697 filename
= Fexpand_file_name (filename
, Qnil
);
4699 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4700 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4702 if (STRINGP (visit
))
4703 visit_file
= Fexpand_file_name (visit
, Qnil
);
4705 visit_file
= filename
;
4707 if (NILP (lockname
))
4708 lockname
= visit_file
;
4712 /* If the file name has special constructs in it,
4713 call the corresponding file handler. */
4714 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4715 /* If FILENAME has no handler, see if VISIT has one. */
4716 if (NILP (handler
) && STRINGP (visit
))
4717 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4719 if (!NILP (handler
))
4722 val
= call6 (handler
, Qwrite_region
, start
, end
,
4723 filename
, append
, visit
);
4727 SAVE_MODIFF
= MODIFF
;
4728 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4729 bset_filename (current_buffer
, visit_file
);
4735 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4737 /* Special kludge to simplify auto-saving. */
4740 /* Do it later, so write-region-annotate-function can work differently
4741 if we save "the buffer" vs "a region".
4742 This is useful in tar-mode. --Stef
4743 XSETFASTINT (start, BEG);
4744 XSETFASTINT (end, Z); */
4748 record_unwind_protect (build_annotations_unwind
,
4749 Vwrite_region_annotation_buffers
);
4750 Vwrite_region_annotation_buffers
= list1 (Fcurrent_buffer ());
4752 given_buffer
= current_buffer
;
4754 if (!STRINGP (start
))
4756 annotations
= build_annotations (start
, end
);
4758 if (current_buffer
!= given_buffer
)
4760 XSETFASTINT (start
, BEGV
);
4761 XSETFASTINT (end
, ZV
);
4767 XSETFASTINT (start
, BEGV
);
4768 XSETFASTINT (end
, ZV
);
4773 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4775 /* Decide the coding-system to encode the data with.
4776 We used to make this choice before calling build_annotations, but that
4777 leads to problems when a write-annotate-function takes care of
4778 unsavable chars (as was the case with X-Symbol). */
4779 Vlast_coding_system_used
=
4780 Fchoose_write_coding_system (start
, end
, filename
,
4781 append
, visit
, lockname
);
4783 setup_coding_system (Vlast_coding_system_used
, &coding
);
4785 if (!STRINGP (start
) && !NILP (BVAR (current_buffer
, selective_display
)))
4786 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4788 #ifdef CLASH_DETECTION
4789 if (open_and_close_file
&& !auto_saving
)
4791 lock_file (lockname
);
4794 #endif /* CLASH_DETECTION */
4796 encoded_filename
= ENCODE_FILE (filename
);
4797 fn
= SSDATA (encoded_filename
);
4798 open_flags
= O_WRONLY
| O_BINARY
| O_CREAT
;
4799 open_flags
|= EQ (mustbenew
, Qexcl
) ? O_EXCL
: !NILP (append
) ? 0 : O_TRUNC
;
4800 if (NUMBERP (append
))
4801 offset
= file_offset (append
);
4802 else if (!NILP (append
))
4803 open_flags
|= O_APPEND
;
4805 mode
= S_IREAD
| S_IWRITE
;
4807 mode
= auto_saving
? auto_save_mode_bits
: 0666;
4810 if (open_and_close_file
)
4812 desc
= emacs_open (fn
, open_flags
, mode
);
4815 int open_errno
= errno
;
4816 #ifdef CLASH_DETECTION
4818 unlock_file (lockname
);
4819 #endif /* CLASH_DETECTION */
4821 report_file_errno ("Opening output file", filename
, open_errno
);
4824 count1
= SPECPDL_INDEX ();
4825 record_unwind_protect_int (close_file_unwind
, desc
);
4828 if (NUMBERP (append
))
4830 off_t ret
= lseek (desc
, offset
, SEEK_SET
);
4833 int lseek_errno
= errno
;
4834 #ifdef CLASH_DETECTION
4836 unlock_file (lockname
);
4837 #endif /* CLASH_DETECTION */
4839 report_file_errno ("Lseek error", filename
, lseek_errno
);
4847 if (STRINGP (start
))
4848 ok
= a_write (desc
, start
, 0, SCHARS (start
), &annotations
, &coding
);
4849 else if (XINT (start
) != XINT (end
))
4850 ok
= a_write (desc
, Qnil
, XINT (start
), XINT (end
) - XINT (start
),
4851 &annotations
, &coding
);
4854 /* If file was empty, still need to write the annotations. */
4855 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4856 ok
= a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4860 if (ok
&& CODING_REQUIRE_FLUSHING (&coding
)
4861 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
))
4863 /* We have to flush out a data. */
4864 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4865 ok
= e_write (desc
, Qnil
, 1, 1, &coding
);
4871 /* fsync is not crucial for temporary files. Nor for auto-save
4872 files, since they might lose some work anyway. */
4873 if (open_and_close_file
&& !auto_saving
&& !write_region_inhibit_fsync
)
4875 /* Transfer data and metadata to disk, retrying if interrupted.
4876 fsync can report a write failure here, e.g., due to disk full
4877 under NFS. But ignore EINVAL, which means fsync is not
4878 supported on this file. */
4879 while (fsync (desc
) != 0)
4882 if (errno
!= EINVAL
)
4883 ok
= 0, save_errno
= errno
;
4888 modtime
= invalid_timespec ();
4891 if (fstat (desc
, &st
) == 0)
4892 modtime
= get_stat_mtime (&st
);
4894 ok
= 0, save_errno
= errno
;
4897 if (open_and_close_file
)
4899 /* NFS can report a write failure now. */
4900 if (emacs_close (desc
) < 0)
4901 ok
= 0, save_errno
= errno
;
4903 /* Discard the unwind protect for close_file_unwind. */
4904 specpdl_ptr
= specpdl
+ count1
;
4907 /* Some file systems have a bug where st_mtime is not updated
4908 properly after a write. For example, CIFS might not see the
4909 st_mtime change until after the file is opened again.
4911 Attempt to detect this file system bug, and update MODTIME to the
4912 newer st_mtime if the bug appears to be present. This introduces
4913 a race condition, so to avoid most instances of the race condition
4914 on non-buggy file systems, skip this check if the most recently
4915 encountered non-buggy file system was the current file system.
4917 A race condition can occur if some other process modifies the
4918 file between the fstat above and the fstat below, but the race is
4919 unlikely and a similar race between the last write and the fstat
4920 above cannot possibly be closed anyway. */
4922 if (timespec_valid_p (modtime
)
4923 && ! (valid_timestamp_file_system
&& st
.st_dev
== timestamp_file_system
))
4925 int desc1
= emacs_open (fn
, O_WRONLY
| O_BINARY
, 0);
4929 if (fstat (desc1
, &st1
) == 0
4930 && st
.st_dev
== st1
.st_dev
&& st
.st_ino
== st1
.st_ino
)
4932 /* Use the heuristic if it appears to be valid. With neither
4933 O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the
4934 file, the time stamp won't change. Also, some non-POSIX
4935 systems don't update an empty file's time stamp when
4936 truncating it. Finally, file systems with 100 ns or worse
4937 resolution sometimes seem to have bugs: on a system with ns
4938 resolution, checking ns % 100 incorrectly avoids the heuristic
4939 1% of the time, but the problem should be temporary as we will
4940 try again on the next time stamp. */
4942 = ((open_flags
& (O_EXCL
| O_TRUNC
)) != 0
4944 && modtime
.tv_nsec
% 100 != 0);
4946 struct timespec modtime1
= get_stat_mtime (&st1
);
4948 && timespec_cmp (modtime
, modtime1
) == 0
4949 && st
.st_size
== st1
.st_size
)
4951 timestamp_file_system
= st
.st_dev
;
4952 valid_timestamp_file_system
= 1;
4956 st
.st_size
= st1
.st_size
;
4960 emacs_close (desc1
);
4964 /* Call write-region-post-annotation-function. */
4965 while (CONSP (Vwrite_region_annotation_buffers
))
4967 Lisp_Object buf
= XCAR (Vwrite_region_annotation_buffers
);
4968 if (!NILP (Fbuffer_live_p (buf
)))
4971 if (FUNCTIONP (Vwrite_region_post_annotation_function
))
4972 call0 (Vwrite_region_post_annotation_function
);
4974 Vwrite_region_annotation_buffers
4975 = XCDR (Vwrite_region_annotation_buffers
);
4978 unbind_to (count
, Qnil
);
4980 #ifdef CLASH_DETECTION
4982 unlock_file (lockname
);
4983 #endif /* CLASH_DETECTION */
4985 /* Do this before reporting IO error
4986 to avoid a "file has changed on disk" warning on
4987 next attempt to save. */
4988 if (timespec_valid_p (modtime
))
4990 current_buffer
->modtime
= modtime
;
4991 current_buffer
->modtime_size
= st
.st_size
;
4995 report_file_errno ("Write error", filename
, save_errno
);
4999 SAVE_MODIFF
= MODIFF
;
5000 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5001 bset_filename (current_buffer
, visit_file
);
5002 update_mode_lines
= 14;
5007 && ! NILP (Fstring_equal (BVAR (current_buffer
, filename
),
5008 BVAR (current_buffer
, auto_save_file_name
))))
5009 SAVE_MODIFF
= MODIFF
;
5015 message_with_string ((NUMBERP (append
)
5025 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5026 doc
: /* Return t if (car A) is numerically less than (car B). */)
5027 (Lisp_Object a
, Lisp_Object b
)
5029 Lisp_Object args
[2] = { Fcar (a
), Fcar (b
), };
5030 return Flss (2, args
);
5033 /* Build the complete list of annotations appropriate for writing out
5034 the text between START and END, by calling all the functions in
5035 write-region-annotate-functions and merging the lists they return.
5036 If one of these functions switches to a different buffer, we assume
5037 that buffer contains altered text. Therefore, the caller must
5038 make sure to restore the current buffer in all cases,
5039 as save-excursion would do. */
5042 build_annotations (Lisp_Object start
, Lisp_Object end
)
5044 Lisp_Object annotations
;
5046 struct gcpro gcpro1
, gcpro2
;
5047 Lisp_Object original_buffer
;
5049 bool used_global
= 0;
5051 XSETBUFFER (original_buffer
, current_buffer
);
5054 p
= Vwrite_region_annotate_functions
;
5055 GCPRO2 (annotations
, p
);
5058 struct buffer
*given_buffer
= current_buffer
;
5059 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5060 { /* Use the global value of the hook. */
5063 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5065 p
= Fappend (2, arg
);
5068 Vwrite_region_annotations_so_far
= annotations
;
5069 res
= call2 (XCAR (p
), start
, end
);
5070 /* If the function makes a different buffer current,
5071 assume that means this buffer contains altered text to be output.
5072 Reset START and END from the buffer bounds
5073 and discard all previous annotations because they should have
5074 been dealt with by this function. */
5075 if (current_buffer
!= given_buffer
)
5077 Vwrite_region_annotation_buffers
5078 = Fcons (Fcurrent_buffer (),
5079 Vwrite_region_annotation_buffers
);
5080 XSETFASTINT (start
, BEGV
);
5081 XSETFASTINT (end
, ZV
);
5084 Flength (res
); /* Check basic validity of return value */
5085 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5089 /* Now do the same for annotation functions implied by the file-format */
5090 if (auto_saving
&& (!EQ (BVAR (current_buffer
, auto_save_file_format
), Qt
)))
5091 p
= BVAR (current_buffer
, auto_save_file_format
);
5093 p
= BVAR (current_buffer
, file_format
);
5094 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5096 struct buffer
*given_buffer
= current_buffer
;
5098 Vwrite_region_annotations_so_far
= annotations
;
5100 /* Value is either a list of annotations or nil if the function
5101 has written annotations to a temporary buffer, which is now
5103 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5104 original_buffer
, make_number (i
));
5105 if (current_buffer
!= given_buffer
)
5107 XSETFASTINT (start
, BEGV
);
5108 XSETFASTINT (end
, ZV
);
5113 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5121 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5122 If STRING is nil, POS is the character position in the current buffer.
5123 Intersperse with them the annotations from *ANNOT
5124 which fall within the range of POS to POS + NCHARS,
5125 each at its appropriate position.
5127 We modify *ANNOT by discarding elements as we use them up.
5129 Return true if successful. */
5132 a_write (int desc
, Lisp_Object string
, ptrdiff_t pos
,
5133 ptrdiff_t nchars
, Lisp_Object
*annot
,
5134 struct coding_system
*coding
)
5138 ptrdiff_t lastpos
= pos
+ nchars
;
5140 while (NILP (*annot
) || CONSP (*annot
))
5142 tem
= Fcar_safe (Fcar (*annot
));
5145 nextpos
= XFASTINT (tem
);
5147 /* If there are no more annotations in this range,
5148 output the rest of the range all at once. */
5149 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5150 return e_write (desc
, string
, pos
, lastpos
, coding
);
5152 /* Output buffer text up to the next annotation's position. */
5155 if (!e_write (desc
, string
, pos
, nextpos
, coding
))
5159 /* Output the annotation. */
5160 tem
= Fcdr (Fcar (*annot
));
5163 if (!e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5166 *annot
= Fcdr (*annot
);
5171 /* Maximum number of characters that the next
5172 function encodes per one loop iteration. */
5174 enum { E_WRITE_MAX
= 8 * 1024 * 1024 };
5176 /* Write text in the range START and END into descriptor DESC,
5177 encoding them with coding system CODING. If STRING is nil, START
5178 and END are character positions of the current buffer, else they
5179 are indexes to the string STRING. Return true if successful. */
5182 e_write (int desc
, Lisp_Object string
, ptrdiff_t start
, ptrdiff_t end
,
5183 struct coding_system
*coding
)
5185 if (STRINGP (string
))
5188 end
= SCHARS (string
);
5191 /* We used to have a code for handling selective display here. But,
5192 now it is handled within encode_coding. */
5196 if (STRINGP (string
))
5198 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5199 if (CODING_REQUIRE_ENCODING (coding
))
5201 ptrdiff_t nchars
= min (end
- start
, E_WRITE_MAX
);
5203 /* Avoid creating huge Lisp string in encode_coding_object. */
5204 if (nchars
== E_WRITE_MAX
)
5205 coding
->raw_destination
= 1;
5207 encode_coding_object
5208 (coding
, string
, start
, string_char_to_byte (string
, start
),
5209 start
+ nchars
, string_char_to_byte (string
, start
+ nchars
),
5214 coding
->dst_object
= string
;
5215 coding
->consumed_char
= SCHARS (string
);
5216 coding
->produced
= SBYTES (string
);
5221 ptrdiff_t start_byte
= CHAR_TO_BYTE (start
);
5222 ptrdiff_t end_byte
= CHAR_TO_BYTE (end
);
5224 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5225 if (CODING_REQUIRE_ENCODING (coding
))
5227 ptrdiff_t nchars
= min (end
- start
, E_WRITE_MAX
);
5230 if (nchars
== E_WRITE_MAX
)
5231 coding
->raw_destination
= 1;
5233 encode_coding_object
5234 (coding
, Fcurrent_buffer (), start
, start_byte
,
5235 start
+ nchars
, CHAR_TO_BYTE (start
+ nchars
), Qt
);
5239 coding
->dst_object
= Qnil
;
5240 coding
->dst_pos_byte
= start_byte
;
5241 if (start
>= GPT
|| end
<= GPT
)
5243 coding
->consumed_char
= end
- start
;
5244 coding
->produced
= end_byte
- start_byte
;
5248 coding
->consumed_char
= GPT
- start
;
5249 coding
->produced
= GPT_BYTE
- start_byte
;
5254 if (coding
->produced
> 0)
5256 char *buf
= (coding
->raw_destination
? (char *) coding
->destination
5257 : (STRINGP (coding
->dst_object
)
5258 ? SSDATA (coding
->dst_object
)
5259 : (char *) BYTE_POS_ADDR (coding
->dst_pos_byte
)));
5260 coding
->produced
-= emacs_write_sig (desc
, buf
, coding
->produced
);
5262 if (coding
->raw_destination
)
5264 /* We're responsible for freeing this, see
5265 encode_coding_object to check why. */
5266 xfree (coding
->destination
);
5267 coding
->raw_destination
= 0;
5269 if (coding
->produced
)
5272 start
+= coding
->consumed_char
;
5278 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5279 Sverify_visited_file_modtime
, 0, 1, 0,
5280 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5281 This means that the file has not been changed since it was visited or saved.
5282 If BUF is omitted or nil, it defaults to the current buffer.
5283 See Info node `(elisp)Modification Time' for more details. */)
5288 Lisp_Object handler
;
5289 Lisp_Object filename
;
5290 struct timespec mtime
;
5300 if (!STRINGP (BVAR (b
, filename
))) return Qt
;
5301 if (b
->modtime
.tv_nsec
== UNKNOWN_MODTIME_NSECS
) return Qt
;
5303 /* If the file name has special constructs in it,
5304 call the corresponding file handler. */
5305 handler
= Ffind_file_name_handler (BVAR (b
, filename
),
5306 Qverify_visited_file_modtime
);
5307 if (!NILP (handler
))
5308 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5310 filename
= ENCODE_FILE (BVAR (b
, filename
));
5312 mtime
= (stat (SSDATA (filename
), &st
) == 0
5313 ? get_stat_mtime (&st
)
5314 : time_error_value (errno
));
5315 if (timespec_cmp (mtime
, b
->modtime
) == 0
5316 && (b
->modtime_size
< 0
5317 || st
.st_size
== b
->modtime_size
))
5322 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5323 Svisited_file_modtime
, 0, 0, 0,
5324 doc
: /* Return the current buffer's recorded visited file modification time.
5325 The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
5326 `file-attributes' returns. If the current buffer has no recorded file
5327 modification time, this function returns 0. If the visited file
5328 doesn't exist, return -1.
5329 See Info node `(elisp)Modification Time' for more details. */)
5332 int ns
= current_buffer
->modtime
.tv_nsec
;
5334 return make_number (UNKNOWN_MODTIME_NSECS
- ns
);
5335 return make_lisp_time (current_buffer
->modtime
);
5338 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5339 Sset_visited_file_modtime
, 0, 1, 0,
5340 doc
: /* Update buffer's recorded modification time from the visited file's time.
5341 Useful if the buffer was not read from the file normally
5342 or if the file itself has been changed for some known benign reason.
5343 An argument specifies the modification time value to use
5344 \(instead of that of the visited file), in the form of a list
5345 \(HIGH LOW USEC PSEC) or an integer flag as returned by
5346 `visited-file-modtime'. */)
5347 (Lisp_Object time_flag
)
5349 if (!NILP (time_flag
))
5351 struct timespec mtime
;
5352 if (INTEGERP (time_flag
))
5354 CHECK_RANGED_INTEGER (time_flag
, -1, 0);
5355 mtime
= make_timespec (0, UNKNOWN_MODTIME_NSECS
- XINT (time_flag
));
5358 mtime
= lisp_time_argument (time_flag
);
5360 current_buffer
->modtime
= mtime
;
5361 current_buffer
->modtime_size
= -1;
5365 register Lisp_Object filename
;
5367 Lisp_Object handler
;
5369 filename
= Fexpand_file_name (BVAR (current_buffer
, filename
), Qnil
);
5371 /* If the file name has special constructs in it,
5372 call the corresponding file handler. */
5373 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5374 if (!NILP (handler
))
5375 /* The handler can find the file name the same way we did. */
5376 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5378 filename
= ENCODE_FILE (filename
);
5380 if (stat (SSDATA (filename
), &st
) >= 0)
5382 current_buffer
->modtime
= get_stat_mtime (&st
);
5383 current_buffer
->modtime_size
= st
.st_size
;
5391 auto_save_error (Lisp_Object error_val
)
5393 Lisp_Object args
[3], msg
;
5395 struct gcpro gcpro1
;
5397 auto_save_error_occurred
= 1;
5399 ring_bell (XFRAME (selected_frame
));
5401 args
[0] = build_string ("Auto-saving %s: %s");
5402 args
[1] = BVAR (current_buffer
, name
);
5403 args
[2] = Ferror_message_string (error_val
);
5404 msg
= Fformat (3, args
);
5407 for (i
= 0; i
< 3; ++i
)
5412 message3_nolog (msg
);
5413 Fsleep_for (make_number (1), Qnil
);
5426 auto_save_mode_bits
= 0666;
5428 /* Get visited file's mode to become the auto save file's mode. */
5429 if (! NILP (BVAR (current_buffer
, filename
)))
5431 if (stat (SSDATA (BVAR (current_buffer
, filename
)), &st
) >= 0)
5432 /* But make sure we can overwrite it later! */
5433 auto_save_mode_bits
= (st
.st_mode
| 0600) & 0777;
5434 else if (modes
= Ffile_modes (BVAR (current_buffer
, filename
)),
5436 /* Remote files don't cooperate with stat. */
5437 auto_save_mode_bits
= (XINT (modes
) | 0600) & 0777;
5441 Fwrite_region (Qnil
, Qnil
, BVAR (current_buffer
, auto_save_file_name
), Qnil
,
5442 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5446 struct auto_save_unwind
5453 do_auto_save_unwind (void *arg
)
5455 struct auto_save_unwind
*p
= arg
;
5456 FILE *stream
= p
->stream
;
5457 minibuffer_auto_raise
= p
->auto_raise
;
5468 do_auto_save_make_dir (Lisp_Object dir
)
5472 auto_saving_dir_umask
= 077;
5473 result
= call2 (Qmake_directory
, dir
, Qt
);
5474 auto_saving_dir_umask
= 0;
5479 do_auto_save_eh (Lisp_Object ignore
)
5481 auto_saving_dir_umask
= 0;
5485 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5486 doc
: /* Auto-save all buffers that need it.
5487 This is all buffers that have auto-saving enabled
5488 and are changed since last auto-saved.
5489 Auto-saving writes the buffer into a file
5490 so that your editing is not lost if the system crashes.
5491 This file is not the file you visited; that changes only when you save.
5492 Normally we run the normal hook `auto-save-hook' before saving.
5494 A non-nil NO-MESSAGE argument means do not print any message if successful.
5495 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5496 (Lisp_Object no_message
, Lisp_Object current_only
)
5498 struct buffer
*old
= current_buffer
, *b
;
5499 Lisp_Object tail
, buf
, hook
;
5500 bool auto_saved
= 0;
5501 int do_handled_files
;
5503 FILE *stream
= NULL
;
5504 ptrdiff_t count
= SPECPDL_INDEX ();
5505 bool orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5506 bool old_message_p
= 0;
5507 struct auto_save_unwind auto_save_unwind
;
5508 struct gcpro gcpro1
, gcpro2
;
5510 if (max_specpdl_size
< specpdl_size
+ 40)
5511 max_specpdl_size
= specpdl_size
+ 40;
5516 if (NILP (no_message
))
5518 old_message_p
= push_message ();
5519 record_unwind_protect_void (pop_message_unwind
);
5522 /* Ordinarily don't quit within this function,
5523 but don't make it impossible to quit (in case we get hung in I/O). */
5527 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5528 point to non-strings reached from Vbuffer_alist. */
5530 hook
= intern ("auto-save-hook");
5531 safe_run_hooks (hook
);
5533 if (STRINGP (Vauto_save_list_file_name
))
5535 Lisp_Object listfile
;
5537 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5539 /* Don't try to create the directory when shutting down Emacs,
5540 because creating the directory might signal an error, and
5541 that would leave Emacs in a strange state. */
5542 if (!NILP (Vrun_hooks
))
5546 GCPRO2 (dir
, listfile
);
5547 dir
= Ffile_name_directory (listfile
);
5548 if (NILP (Ffile_directory_p (dir
)))
5549 internal_condition_case_1 (do_auto_save_make_dir
,
5555 stream
= emacs_fopen (SSDATA (listfile
), "w");
5558 auto_save_unwind
.stream
= stream
;
5559 auto_save_unwind
.auto_raise
= minibuffer_auto_raise
;
5560 record_unwind_protect_ptr (do_auto_save_unwind
, &auto_save_unwind
);
5561 minibuffer_auto_raise
= 0;
5563 auto_save_error_occurred
= 0;
5565 /* On first pass, save all files that don't have handlers.
5566 On second pass, save all files that do have handlers.
5568 If Emacs is crashing, the handlers may tweak what is causing
5569 Emacs to crash in the first place, and it would be a shame if
5570 Emacs failed to autosave perfectly ordinary files because it
5571 couldn't handle some ange-ftp'd file. */
5573 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5574 FOR_EACH_LIVE_BUFFER (tail
, buf
)
5578 /* Record all the buffers that have auto save mode
5579 in the special file that lists them. For each of these buffers,
5580 Record visited name (if any) and auto save name. */
5581 if (STRINGP (BVAR (b
, auto_save_file_name
))
5582 && stream
!= NULL
&& do_handled_files
== 0)
5585 if (!NILP (BVAR (b
, filename
)))
5587 fwrite (SDATA (BVAR (b
, filename
)), 1,
5588 SBYTES (BVAR (b
, filename
)), stream
);
5590 putc ('\n', stream
);
5591 fwrite (SDATA (BVAR (b
, auto_save_file_name
)), 1,
5592 SBYTES (BVAR (b
, auto_save_file_name
)), stream
);
5593 putc ('\n', stream
);
5597 if (!NILP (current_only
)
5598 && b
!= current_buffer
)
5601 /* Don't auto-save indirect buffers.
5602 The base buffer takes care of it. */
5606 /* Check for auto save enabled
5607 and file changed since last auto save
5608 and file changed since last real save. */
5609 if (STRINGP (BVAR (b
, auto_save_file_name
))
5610 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5611 && BUF_AUTOSAVE_MODIFF (b
) < BUF_MODIFF (b
)
5612 /* -1 means we've turned off autosaving for a while--see below. */
5613 && XINT (BVAR (b
, save_length
)) >= 0
5614 && (do_handled_files
5615 || NILP (Ffind_file_name_handler (BVAR (b
, auto_save_file_name
),
5618 struct timespec before_time
= current_timespec ();
5619 struct timespec after_time
;
5621 /* If we had a failure, don't try again for 20 minutes. */
5622 if (b
->auto_save_failure_time
> 0
5623 && before_time
.tv_sec
- b
->auto_save_failure_time
< 1200)
5626 set_buffer_internal (b
);
5627 if (NILP (Vauto_save_include_big_deletions
)
5628 && (XFASTINT (BVAR (b
, save_length
)) * 10
5629 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5630 /* A short file is likely to change a large fraction;
5631 spare the user annoying messages. */
5632 && XFASTINT (BVAR (b
, save_length
)) > 5000
5633 /* These messages are frequent and annoying for `*mail*'. */
5634 && !EQ (BVAR (b
, filename
), Qnil
)
5635 && NILP (no_message
))
5637 /* It has shrunk too much; turn off auto-saving here. */
5638 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5639 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5641 minibuffer_auto_raise
= 0;
5642 /* Turn off auto-saving until there's a real save,
5643 and prevent any more warnings. */
5644 XSETINT (BVAR (b
, save_length
), -1);
5645 Fsleep_for (make_number (1), Qnil
);
5648 if (!auto_saved
&& NILP (no_message
))
5649 message1 ("Auto-saving...");
5650 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5652 BUF_AUTOSAVE_MODIFF (b
) = BUF_MODIFF (b
);
5653 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5654 set_buffer_internal (old
);
5656 after_time
= current_timespec ();
5658 /* If auto-save took more than 60 seconds,
5659 assume it was an NFS failure that got a timeout. */
5660 if (after_time
.tv_sec
- before_time
.tv_sec
> 60)
5661 b
->auto_save_failure_time
= after_time
.tv_sec
;
5665 /* Prevent another auto save till enough input events come in. */
5666 record_auto_save ();
5668 if (auto_saved
&& NILP (no_message
))
5672 /* If we are going to restore an old message,
5673 give time to read ours. */
5674 sit_for (make_number (1), 0, 0);
5677 else if (!auto_save_error_occurred
)
5678 /* Don't overwrite the error message if an error occurred.
5679 If we displayed a message and then restored a state
5680 with no message, leave a "done" message on the screen. */
5681 message1 ("Auto-saving...done");
5686 /* This restores the message-stack status. */
5687 unbind_to (count
, Qnil
);
5691 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5692 Sset_buffer_auto_saved
, 0, 0, 0,
5693 doc
: /* Mark current buffer as auto-saved with its current text.
5694 No auto-save file will be written until the buffer changes again. */)
5697 /* FIXME: This should not be called in indirect buffers, since
5698 they're not autosaved. */
5699 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
5700 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5701 current_buffer
->auto_save_failure_time
= 0;
5705 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5706 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5707 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5710 current_buffer
->auto_save_failure_time
= 0;
5714 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5716 doc
: /* Return t if current buffer has been auto-saved recently.
5717 More precisely, if it has been auto-saved since last read from or saved
5718 in the visited file. If the buffer has no visited file,
5719 then any auto-save counts as "recent". */)
5722 /* FIXME: maybe we should return nil for indirect buffers since
5723 they're never autosaved. */
5724 return (SAVE_MODIFF
< BUF_AUTOSAVE_MODIFF (current_buffer
) ? Qt
: Qnil
);
5727 /* Reading and completing file names */
5729 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5730 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5731 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5732 The return value is only relevant for a call to `read-file-name' that happens
5733 before any other event (mouse or keypress) is handled. */)
5736 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) \
5737 || defined (HAVE_NS)
5738 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5741 && window_system_available (SELECTED_FRAME ()))
5748 Fread_file_name (Lisp_Object prompt
, Lisp_Object dir
, Lisp_Object default_filename
, Lisp_Object mustmatch
, Lisp_Object initial
, Lisp_Object predicate
)
5750 struct gcpro gcpro1
;
5751 Lisp_Object args
[7];
5753 GCPRO1 (default_filename
);
5754 args
[0] = intern ("read-file-name");
5757 args
[3] = default_filename
;
5758 args
[4] = mustmatch
;
5760 args
[6] = predicate
;
5761 RETURN_UNGCPRO (Ffuncall (7, args
));
5768 valid_timestamp_file_system
= 0;
5770 /* fsync can be a significant performance hit. Often it doesn't
5771 suffice to make the file-save operation survive a crash. For
5772 batch scripts, which are typically part of larger shell commands
5773 that don't fsync other files, its effect on performance can be
5774 significant so its utility is particularly questionable.
5775 Hence, for now by default fsync is used only when interactive.
5777 For more on why fsync often fails to work on today's hardware, see:
5778 Zheng M et al. Understanding the robustness of SSDs under power fault.
5779 11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84
5780 http://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf
5782 For more on why fsync does not suffice even if it works properly, see:
5783 Roche X. Necessary step(s) to synchronize filename operations on disk.
5784 Austin Group Defect 672, 2013-03-19
5785 http://austingroupbugs.net/view.php?id=672 */
5786 write_region_inhibit_fsync
= noninteractive
;
5790 syms_of_fileio (void)
5792 DEFSYM (Qoperations
, "operations");
5793 DEFSYM (Qexpand_file_name
, "expand-file-name");
5794 DEFSYM (Qsubstitute_in_file_name
, "substitute-in-file-name");
5795 DEFSYM (Qdirectory_file_name
, "directory-file-name");
5796 DEFSYM (Qfile_name_directory
, "file-name-directory");
5797 DEFSYM (Qfile_name_nondirectory
, "file-name-nondirectory");
5798 DEFSYM (Qunhandled_file_name_directory
, "unhandled-file-name-directory");
5799 DEFSYM (Qfile_name_as_directory
, "file-name-as-directory");
5800 DEFSYM (Qcopy_file
, "copy-file");
5801 DEFSYM (Qmake_directory_internal
, "make-directory-internal");
5802 DEFSYM (Qmake_directory
, "make-directory");
5803 DEFSYM (Qdelete_directory_internal
, "delete-directory-internal");
5804 DEFSYM (Qdelete_file
, "delete-file");
5805 DEFSYM (Qrename_file
, "rename-file");
5806 DEFSYM (Qadd_name_to_file
, "add-name-to-file");
5807 DEFSYM (Qmake_symbolic_link
, "make-symbolic-link");
5808 DEFSYM (Qfile_exists_p
, "file-exists-p");
5809 DEFSYM (Qfile_executable_p
, "file-executable-p");
5810 DEFSYM (Qfile_readable_p
, "file-readable-p");
5811 DEFSYM (Qfile_writable_p
, "file-writable-p");
5812 DEFSYM (Qfile_symlink_p
, "file-symlink-p");
5813 DEFSYM (Qaccess_file
, "access-file");
5814 DEFSYM (Qfile_directory_p
, "file-directory-p");
5815 DEFSYM (Qfile_regular_p
, "file-regular-p");
5816 DEFSYM (Qfile_accessible_directory_p
, "file-accessible-directory-p");
5817 DEFSYM (Qfile_modes
, "file-modes");
5818 DEFSYM (Qset_file_modes
, "set-file-modes");
5819 DEFSYM (Qset_file_times
, "set-file-times");
5820 DEFSYM (Qfile_selinux_context
, "file-selinux-context");
5821 DEFSYM (Qset_file_selinux_context
, "set-file-selinux-context");
5822 DEFSYM (Qfile_acl
, "file-acl");
5823 DEFSYM (Qset_file_acl
, "set-file-acl");
5824 DEFSYM (Qfile_newer_than_file_p
, "file-newer-than-file-p");
5825 DEFSYM (Qinsert_file_contents
, "insert-file-contents");
5826 DEFSYM (Qchoose_write_coding_system
, "choose-write-coding-system");
5827 DEFSYM (Qwrite_region
, "write-region");
5828 DEFSYM (Qverify_visited_file_modtime
, "verify-visited-file-modtime");
5829 DEFSYM (Qset_visited_file_modtime
, "set-visited-file-modtime");
5830 DEFSYM (Qauto_save_coding
, "auto-save-coding");
5832 DEFSYM (Qfile_name_history
, "file-name-history");
5833 Fset (Qfile_name_history
, Qnil
);
5835 DEFSYM (Qfile_error
, "file-error");
5836 DEFSYM (Qfile_already_exists
, "file-already-exists");
5837 DEFSYM (Qfile_date_error
, "file-date-error");
5838 DEFSYM (Qfile_notify_error
, "file-notify-error");
5839 DEFSYM (Qexcl
, "excl");
5841 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system
,
5842 doc
: /* Coding system for encoding file names.
5843 If it is nil, `default-file-name-coding-system' (which see) is used.
5845 On MS-Windows, the value of this variable is largely ignored if
5846 \`w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5847 behaves as if file names were encoded in `utf-8'. */);
5848 Vfile_name_coding_system
= Qnil
;
5850 DEFVAR_LISP ("default-file-name-coding-system",
5851 Vdefault_file_name_coding_system
,
5852 doc
: /* Default coding system for encoding file names.
5853 This variable is used only when `file-name-coding-system' is nil.
5855 This variable is set/changed by the command `set-language-environment'.
5856 User should not set this variable manually,
5857 instead use `file-name-coding-system' to get a constant encoding
5858 of file names regardless of the current language environment.
5860 On MS-Windows, the value of this variable is largely ignored if
5861 \`w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5862 behaves as if file names were encoded in `utf-8'. */);
5863 Vdefault_file_name_coding_system
= Qnil
;
5865 DEFSYM (Qformat_decode
, "format-decode");
5866 DEFSYM (Qformat_annotate_function
, "format-annotate-function");
5867 DEFSYM (Qafter_insert_file_set_coding
, "after-insert-file-set-coding");
5868 DEFSYM (Qcar_less_than_car
, "car-less-than-car");
5870 Fput (Qfile_error
, Qerror_conditions
,
5871 Fpurecopy (list2 (Qfile_error
, Qerror
)));
5872 Fput (Qfile_error
, Qerror_message
,
5873 build_pure_c_string ("File error"));
5875 Fput (Qfile_already_exists
, Qerror_conditions
,
5876 Fpurecopy (list3 (Qfile_already_exists
, Qfile_error
, Qerror
)));
5877 Fput (Qfile_already_exists
, Qerror_message
,
5878 build_pure_c_string ("File already exists"));
5880 Fput (Qfile_date_error
, Qerror_conditions
,
5881 Fpurecopy (list3 (Qfile_date_error
, Qfile_error
, Qerror
)));
5882 Fput (Qfile_date_error
, Qerror_message
,
5883 build_pure_c_string ("Cannot set file date"));
5885 Fput (Qfile_notify_error
, Qerror_conditions
,
5886 Fpurecopy (list3 (Qfile_notify_error
, Qfile_error
, Qerror
)));
5887 Fput (Qfile_notify_error
, Qerror_message
,
5888 build_pure_c_string ("File notification error"));
5890 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist
,
5891 doc
: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
5892 If a file name matches REGEXP, all I/O on that file is done by calling
5893 HANDLER. If a file name matches more than one handler, the handler
5894 whose match starts last in the file name gets precedence. The
5895 function `find-file-name-handler' checks this list for a handler for
5898 HANDLER should be a function. The first argument given to it is the
5899 name of the I/O primitive to be handled; the remaining arguments are
5900 the arguments that were passed to that primitive. For example, if you
5901 do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
5902 HANDLER is called like this:
5904 (funcall HANDLER 'file-exists-p FILENAME)
5906 Note that HANDLER must be able to handle all I/O primitives; if it has
5907 nothing special to do for a primitive, it should reinvoke the
5908 primitive to handle the operation \"the usual way\".
5909 See Info node `(elisp)Magic File Names' for more details. */);
5910 Vfile_name_handler_alist
= Qnil
;
5912 DEFVAR_LISP ("set-auto-coding-function",
5913 Vset_auto_coding_function
,
5914 doc
: /* If non-nil, a function to call to decide a coding system of file.
5915 Two arguments are passed to this function: the file name
5916 and the length of a file contents following the point.
5917 This function should return a coding system to decode the file contents.
5918 It should check the file name against `auto-coding-alist'.
5919 If no coding system is decided, it should check a coding system
5920 specified in the heading lines with the format:
5921 -*- ... coding: CODING-SYSTEM; ... -*-
5922 or local variable spec of the tailing lines with `coding:' tag. */);
5923 Vset_auto_coding_function
= Qnil
;
5925 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions
,
5926 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
5927 Each is passed one argument, the number of characters inserted,
5928 with point at the start of the inserted text. Each function
5929 should leave point the same, and return the new character count.
5930 If `insert-file-contents' is intercepted by a handler from
5931 `file-name-handler-alist', that handler is responsible for calling the
5932 functions in `after-insert-file-functions' if appropriate. */);
5933 Vafter_insert_file_functions
= Qnil
;
5935 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions
,
5936 doc
: /* A list of functions to be called at the start of `write-region'.
5937 Each is passed two arguments, START and END as for `write-region'.
5938 These are usually two numbers but not always; see the documentation
5939 for `write-region'. The function should return a list of pairs
5940 of the form (POSITION . STRING), consisting of strings to be effectively
5941 inserted at the specified positions of the file being written (1 means to
5942 insert before the first byte written). The POSITIONs must be sorted into
5945 If there are several annotation functions, the lists returned by these
5946 functions are merged destructively. As each annotation function runs,
5947 the variable `write-region-annotations-so-far' contains a list of all
5948 annotations returned by previous annotation functions.
5950 An annotation function can return with a different buffer current.
5951 Doing so removes the annotations returned by previous functions, and
5952 resets START and END to `point-min' and `point-max' of the new buffer.
5954 After `write-region' completes, Emacs calls the function stored in
5955 `write-region-post-annotation-function', once for each buffer that was
5956 current when building the annotations (i.e., at least once), with that
5957 buffer current. */);
5958 Vwrite_region_annotate_functions
= Qnil
;
5959 DEFSYM (Qwrite_region_annotate_functions
, "write-region-annotate-functions");
5961 DEFVAR_LISP ("write-region-post-annotation-function",
5962 Vwrite_region_post_annotation_function
,
5963 doc
: /* Function to call after `write-region' completes.
5964 The function is called with no arguments. If one or more of the
5965 annotation functions in `write-region-annotate-functions' changed the
5966 current buffer, the function stored in this variable is called for
5967 each of those additional buffers as well, in addition to the original
5968 buffer. The relevant buffer is current during each function call. */);
5969 Vwrite_region_post_annotation_function
= Qnil
;
5970 staticpro (&Vwrite_region_annotation_buffers
);
5972 DEFVAR_LISP ("write-region-annotations-so-far",
5973 Vwrite_region_annotations_so_far
,
5974 doc
: /* When an annotation function is called, this holds the previous annotations.
5975 These are the annotations made by other annotation functions
5976 that were already called. See also `write-region-annotate-functions'. */);
5977 Vwrite_region_annotations_so_far
= Qnil
;
5979 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers
,
5980 doc
: /* A list of file name handlers that temporarily should not be used.
5981 This applies only to the operation `inhibit-file-name-operation'. */);
5982 Vinhibit_file_name_handlers
= Qnil
;
5984 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation
,
5985 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5986 Vinhibit_file_name_operation
= Qnil
;
5988 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name
,
5989 doc
: /* File name in which we write a list of all auto save file names.
5990 This variable is initialized automatically from `auto-save-list-file-prefix'
5991 shortly after Emacs reads your init file, if you have not yet given it
5992 a non-nil value. */);
5993 Vauto_save_list_file_name
= Qnil
;
5995 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name
,
5996 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
5997 Normally auto-save files are written under other names. */);
5998 Vauto_save_visited_file_name
= Qnil
;
6000 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions
,
6001 doc
: /* If non-nil, auto-save even if a large part of the text is deleted.
6002 If nil, deleting a substantial portion of the text disables auto-save
6003 in the buffer; this is the default behavior, because the auto-save
6004 file is usually more useful if it contains the deleted text. */);
6005 Vauto_save_include_big_deletions
= Qnil
;
6007 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync
,
6008 doc
: /* Non-nil means don't call fsync in `write-region'.
6009 This variable affects calls to `write-region' as well as save commands.
6010 Setting this to nil may avoid data loss if the system loses power or
6011 the operating system crashes. */);
6012 write_region_inhibit_fsync
= 0; /* See also `init_fileio' above. */
6014 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash
,
6015 doc
: /* Specifies whether to use the system's trash can.
6016 When non-nil, certain file deletion commands use the function
6017 `move-file-to-trash' instead of deleting files outright.
6018 This includes interactive calls to `delete-file' and
6019 `delete-directory' and the Dired deletion commands. */);
6020 delete_by_moving_to_trash
= 0;
6021 Qdelete_by_moving_to_trash
= intern_c_string ("delete-by-moving-to-trash");
6023 DEFSYM (Qmove_file_to_trash
, "move-file-to-trash");
6024 DEFSYM (Qcopy_directory
, "copy-directory");
6025 DEFSYM (Qdelete_directory
, "delete-directory");
6026 DEFSYM (Qsubstitute_env_in_file_name
, "substitute-env-in-file-name");
6028 defsubr (&Sfind_file_name_handler
);
6029 defsubr (&Sfile_name_directory
);
6030 defsubr (&Sfile_name_nondirectory
);
6031 defsubr (&Sunhandled_file_name_directory
);
6032 defsubr (&Sfile_name_as_directory
);
6033 defsubr (&Sdirectory_file_name
);
6034 defsubr (&Smake_temp_name
);
6035 defsubr (&Sexpand_file_name
);
6036 defsubr (&Ssubstitute_in_file_name
);
6037 defsubr (&Scopy_file
);
6038 defsubr (&Smake_directory_internal
);
6039 defsubr (&Sdelete_directory_internal
);
6040 defsubr (&Sdelete_file
);
6041 defsubr (&Srename_file
);
6042 defsubr (&Sadd_name_to_file
);
6043 defsubr (&Smake_symbolic_link
);
6044 defsubr (&Sfile_name_absolute_p
);
6045 defsubr (&Sfile_exists_p
);
6046 defsubr (&Sfile_executable_p
);
6047 defsubr (&Sfile_readable_p
);
6048 defsubr (&Sfile_writable_p
);
6049 defsubr (&Saccess_file
);
6050 defsubr (&Sfile_symlink_p
);
6051 defsubr (&Sfile_directory_p
);
6052 defsubr (&Sfile_accessible_directory_p
);
6053 defsubr (&Sfile_regular_p
);
6054 defsubr (&Sfile_modes
);
6055 defsubr (&Sset_file_modes
);
6056 defsubr (&Sset_file_times
);
6057 defsubr (&Sfile_selinux_context
);
6058 defsubr (&Sfile_acl
);
6059 defsubr (&Sset_file_acl
);
6060 defsubr (&Sset_file_selinux_context
);
6061 defsubr (&Sset_default_file_modes
);
6062 defsubr (&Sdefault_file_modes
);
6063 defsubr (&Sfile_newer_than_file_p
);
6064 defsubr (&Sinsert_file_contents
);
6065 defsubr (&Schoose_write_coding_system
);
6066 defsubr (&Swrite_region
);
6067 defsubr (&Scar_less_than_car
);
6068 defsubr (&Sverify_visited_file_modtime
);
6069 defsubr (&Svisited_file_modtime
);
6070 defsubr (&Sset_visited_file_modtime
);
6071 defsubr (&Sdo_auto_save
);
6072 defsubr (&Sset_buffer_auto_saved
);
6073 defsubr (&Sclear_buffer_auto_save_failure
);
6074 defsubr (&Srecent_auto_save_p
);
6076 defsubr (&Snext_read_file_uses_dialog_p
);
6079 defsubr (&Sunix_sync
);