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
);
1174 if (multibyte
&& !STRING_MULTIBYTE (tem
))
1176 hdir
= DECODE_FILE (tem
);
1177 newdir
= SSDATA (hdir
);
1180 collapse_newdir
= 0;
1183 else /* ~user/filename */
1186 for (p
= nm
; *p
&& !IS_DIRECTORY_SEP (*p
); p
++)
1188 o
= SAFE_ALLOCA (p
- nm
+ 1);
1189 memcpy (o
, nm
, p
- nm
);
1193 pw
= getpwnam (o
+ 1);
1199 newdir
= pw
->pw_dir
;
1200 /* `getpwnam' may return a unibyte string, which will
1201 bite us since we expect the directory to be
1203 tem
= build_string (newdir
);
1204 if (multibyte
&& !STRING_MULTIBYTE (tem
))
1206 hdir
= DECODE_FILE (tem
);
1207 newdir
= SSDATA (hdir
);
1211 collapse_newdir
= 0;
1215 /* If we don't find a user of that name, leave the name
1216 unchanged; don't move nm forward to p. */
1221 /* On DOS and Windows, nm is absolute if a drive name was specified;
1222 use the drive's current directory as the prefix if needed. */
1223 if (!newdir
&& drive
)
1225 /* Get default directory if needed to make nm absolute. */
1227 if (!IS_DIRECTORY_SEP (nm
[0]))
1229 adir
= alloca (MAXPATHLEN
+ 1);
1230 if (!getdefdir (c_toupper (drive
) - 'A' + 1, adir
))
1234 Lisp_Object tem
= build_string (adir
);
1236 tem
= DECODE_FILE (tem
);
1237 memcpy (adir
, SSDATA (tem
), SBYTES (tem
) + 1);
1242 /* Either nm starts with /, or drive isn't mounted. */
1244 adir
[0] = DRIVE_LETTER (drive
);
1253 /* Finally, if no prefix has been specified and nm is not absolute,
1254 then it must be expanded relative to default_directory. */
1258 /* /... alone is not absolute on DOS and Windows. */
1259 && !IS_DIRECTORY_SEP (nm
[0])
1262 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1266 newdir
= SSDATA (default_directory
);
1268 /* Note if special escape prefix is present, but remove for now. */
1269 if (newdir
[0] == '/' && newdir
[1] == ':')
1280 /* First ensure newdir is an absolute name. */
1282 /* Detect MSDOS file names with drive specifiers. */
1283 ! (IS_DRIVE (newdir
[0])
1284 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1286 /* Detect Windows file names in UNC format. */
1287 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1291 /* Effectively, let newdir be (expand-file-name newdir cwd).
1292 Because of the admonition against calling expand-file-name
1293 when we have pointers into lisp strings, we accomplish this
1294 indirectly by prepending newdir to nm if necessary, and using
1295 cwd (or the wd of newdir's drive) as the new newdir. */
1298 const int adir_size
= MAX_UTF8_PATH
;
1300 const int adir_size
= MAXPATHLEN
+ 1;
1303 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1305 drive
= (unsigned char) newdir
[0];
1308 if (!IS_DIRECTORY_SEP (nm
[0]))
1310 ptrdiff_t newlen
= strlen (newdir
);
1311 char *tmp
= alloca (newlen
+ file_name_as_directory_slop
1313 file_name_as_directory (tmp
, newdir
, newlen
, multibyte
);
1317 adir
= alloca (adir_size
);
1320 if (!getdefdir (c_toupper (drive
) - 'A' + 1, adir
))
1324 getcwd (adir
, adir_size
);
1327 Lisp_Object tem
= build_string (adir
);
1329 tem
= DECODE_FILE (tem
);
1330 memcpy (adir
, SSDATA (tem
), SBYTES (tem
) + 1);
1335 /* Strip off drive name from prefix, if present. */
1336 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1342 /* Keep only a prefix from newdir if nm starts with slash
1343 (//server/share for UNC, nothing otherwise). */
1344 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1347 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1349 char *adir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1351 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1353 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1366 /* Ignore any slash at the end of newdir, unless newdir is
1367 just "/" or "//". */
1368 length
= strlen (newdir
);
1369 while (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1370 && ! (length
== 2 && IS_DIRECTORY_SEP (newdir
[0])))
1376 /* Now concatenate the directory and name to new space in the stack frame. */
1377 tlen
= length
+ file_name_as_directory_slop
+ strlen (nm
) + 1;
1379 /* Reserve space for drive specifier and escape prefix, since either
1380 or both may need to be inserted. (The Microsoft x86 compiler
1381 produces incorrect code if the following two lines are combined.) */
1382 target
= alloca (tlen
+ 4);
1384 #else /* not DOS_NT */
1385 target
= SAFE_ALLOCA (tlen
);
1386 #endif /* not DOS_NT */
1391 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1394 /* If newdir is effectively "C:/", then the drive letter will have
1395 been stripped and newdir will be "/". Concatenating with an
1396 absolute directory in nm produces "//", which will then be
1397 incorrectly treated as a network share. Ignore newdir in
1398 this case (keeping the drive letter). */
1399 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1400 && newdir
[1] == '\0'))
1403 memcpy (target
, newdir
, length
);
1408 file_name_as_directory (target
, newdir
, length
, multibyte
);
1411 strcat (target
, nm
);
1413 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1421 if (!IS_DIRECTORY_SEP (*p
))
1425 else if (p
[1] == '.'
1426 && (IS_DIRECTORY_SEP (p
[2])
1429 /* If "/." is the entire filename, keep the "/". Otherwise,
1430 just delete the whole "/.". */
1431 if (o
== target
&& p
[2] == '\0')
1435 else if (p
[1] == '.' && p
[2] == '.'
1436 /* `/../' is the "superroot" on certain file systems.
1437 Turned off on DOS_NT systems because they have no
1438 "superroot" and because this causes us to produce
1439 file names like "d:/../foo" which fail file-related
1440 functions of the underlying OS. (To reproduce, try a
1441 long series of "../../" in default_directory, longer
1442 than the number of levels from the root.) */
1446 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1451 while (o
!= target
&& (--o
, !IS_DIRECTORY_SEP (*o
)))
1454 /* Don't go below server level in UNC filenames. */
1455 if (o
== target
+ 1 && IS_DIRECTORY_SEP (*o
)
1456 && IS_DIRECTORY_SEP (*target
))
1460 /* Keep initial / only if this is the whole name. */
1461 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1465 else if (IS_DIRECTORY_SEP (p
[1])
1466 && (p
!= target
|| IS_DIRECTORY_SEP (p
[2])))
1467 /* Collapse multiple "/", except leave leading "//" alone. */
1476 /* At last, set drive name. */
1478 /* Except for network file name. */
1479 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1480 #endif /* WINDOWSNT */
1482 if (!drive
) emacs_abort ();
1484 target
[0] = DRIVE_LETTER (drive
);
1487 /* Reinsert the escape prefix if required. */
1494 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1495 dostounix_filename (SSDATA (result
));
1497 if (!NILP (Vw32_downcase_file_names
))
1498 result
= Fdowncase (result
);
1501 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1502 #endif /* !DOS_NT */
1505 /* Again look to see if the file name has special constructs in it
1506 and perhaps call the corresponding file handler. This is needed
1507 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1508 the ".." component gives us "/user@host:/bar/../baz" which needs
1509 to be expanded again. */
1510 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1511 if (!NILP (handler
))
1513 handled_name
= call3 (handler
, Qexpand_file_name
,
1514 result
, default_directory
);
1515 if (! STRINGP (handled_name
))
1516 error ("Invalid handler in `file-name-handler-alist'");
1517 result
= handled_name
;
1525 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1526 This is the old version of expand-file-name, before it was thoroughly
1527 rewritten for Emacs 10.31. We leave this version here commented-out,
1528 because the code is very complex and likely to have subtle bugs. If
1529 bugs _are_ found, it might be of interest to look at the old code and
1530 see what did it do in the relevant situation.
1532 Don't remove this code: it's true that it will be accessible
1533 from the repository, but a few years from deletion, people will
1534 forget it is there. */
1536 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1537 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1538 "Convert FILENAME to absolute, and canonicalize it.\n\
1539 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1540 \(does not start with slash); if DEFAULT is nil or missing,\n\
1541 the current buffer's value of default-directory is used.\n\
1542 Filenames containing `.' or `..' as components are simplified;\n\
1543 initial `~/' expands to your home directory.\n\
1544 See also the function `substitute-in-file-name'.")
1546 Lisp_Object name
, defalt
;
1550 register unsigned char *newdir
, *p
, *o
;
1552 unsigned char *target
;
1555 CHECK_STRING (name
);
1558 /* If nm is absolute, flush ...// and detect /./ and /../.
1559 If no /./ or /../ we can return right away. */
1566 if (p
[0] == '/' && p
[1] == '/')
1568 if (p
[0] == '/' && p
[1] == '~')
1569 nm
= p
+ 1, lose
= 1;
1570 if (p
[0] == '/' && p
[1] == '.'
1571 && (p
[2] == '/' || p
[2] == 0
1572 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1578 if (nm
== SDATA (name
))
1580 return build_string (nm
);
1584 /* Now determine directory to start with and put it in NEWDIR. */
1588 if (nm
[0] == '~') /* prefix ~ */
1589 if (nm
[1] == '/' || nm
[1] == 0)/* ~/filename */
1591 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1592 newdir
= (unsigned char *) "";
1595 else /* ~user/filename */
1597 /* Get past ~ to user. */
1598 unsigned char *user
= nm
+ 1;
1599 /* Find end of name. */
1600 unsigned char *ptr
= (unsigned char *) strchr (user
, '/');
1601 ptrdiff_t len
= ptr
? ptr
- user
: strlen (user
);
1602 /* Copy the user name into temp storage. */
1603 o
= alloca (len
+ 1);
1604 memcpy (o
, user
, len
);
1607 /* Look up the user name. */
1609 pw
= (struct passwd
*) getpwnam (o
+ 1);
1612 error ("\"%s\" isn't a registered user", o
+ 1);
1614 newdir
= (unsigned char *) pw
->pw_dir
;
1616 /* Discard the user name from NM. */
1620 if (nm
[0] != '/' && !newdir
)
1623 defalt
= current_buffer
->directory
;
1624 CHECK_STRING (defalt
);
1625 newdir
= SDATA (defalt
);
1628 /* Now concatenate the directory and name to new space in the stack frame. */
1630 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1631 target
= alloca (tlen
);
1636 if (nm
[0] == 0 || nm
[0] == '/')
1637 strcpy (target
, newdir
);
1639 file_name_as_directory (target
, newdir
);
1642 strcat (target
, nm
);
1644 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1655 else if (!strncmp (p
, "//", 2)
1661 else if (p
[0] == '/' && p
[1] == '.'
1662 && (p
[2] == '/' || p
[2] == 0))
1664 else if (!strncmp (p
, "/..", 3)
1665 /* `/../' is the "superroot" on certain file systems. */
1667 && (p
[3] == '/' || p
[3] == 0))
1669 while (o
!= target
&& *--o
!= '/')
1671 if (o
== target
&& *o
== '/')
1681 return make_string (target
, o
- target
);
1685 /* If /~ or // appears, discard everything through first slash. */
1687 file_name_absolute_p (const char *filename
)
1690 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
1692 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
1693 && IS_DIRECTORY_SEP (filename
[2]))
1699 search_embedded_absfilename (char *nm
, char *endp
)
1703 for (p
= nm
+ 1; p
< endp
; p
++)
1705 if (IS_DIRECTORY_SEP (p
[-1])
1706 && file_name_absolute_p (p
)
1707 #if defined (WINDOWSNT) || defined (CYGWIN)
1708 /* // at start of file name is meaningful in Apollo,
1709 WindowsNT and Cygwin systems. */
1710 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
1711 #endif /* not (WINDOWSNT || CYGWIN) */
1714 for (s
= p
; *s
&& !IS_DIRECTORY_SEP (*s
); s
++);
1715 if (p
[0] == '~' && s
> p
+ 1) /* We've got "/~something/". */
1717 char *o
= alloca (s
- p
+ 1);
1719 memcpy (o
, p
, s
- p
);
1722 /* If we have ~user and `user' exists, discard
1723 everything up to ~. But if `user' does not exist, leave
1724 ~user alone, it might be a literal file name. */
1726 pw
= getpwnam (o
+ 1);
1738 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1739 Ssubstitute_in_file_name
, 1, 1, 0,
1740 doc
: /* Substitute environment variables referred to in FILENAME.
1741 `$FOO' where FOO is an environment variable name means to substitute
1742 the value of that variable. The variable name should be terminated
1743 with a character not a letter, digit or underscore; otherwise, enclose
1744 the entire variable name in braces.
1746 If `/~' appears, all of FILENAME through that `/' is discarded.
1747 If `//' appears, everything up to and including the first of
1748 those `/' is discarded. */)
1749 (Lisp_Object filename
)
1751 char *nm
, *p
, *x
, *endp
;
1752 bool substituted
= false;
1755 Lisp_Object handler
;
1757 CHECK_STRING (filename
);
1759 multibyte
= STRING_MULTIBYTE (filename
);
1761 /* If the file name has special constructs in it,
1762 call the corresponding file handler. */
1763 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1764 if (!NILP (handler
))
1766 Lisp_Object handled_name
= call2 (handler
, Qsubstitute_in_file_name
,
1768 if (STRINGP (handled_name
))
1769 return handled_name
;
1770 error ("Invalid handler in `file-name-handler-alist'");
1773 /* Always work on a copy of the string, in case GC happens during
1774 decode of environment variables, causing the original Lisp_String
1775 data to be relocated. */
1776 nm
= xlispstrdupa (filename
);
1779 dostounix_filename (nm
);
1780 substituted
= (memcmp (nm
, SDATA (filename
), SBYTES (filename
)) != 0);
1782 endp
= nm
+ SBYTES (filename
);
1784 /* If /~ or // appears, discard everything through first slash. */
1785 p
= search_embedded_absfilename (nm
, endp
);
1787 /* Start over with the new string, so we check the file-name-handler
1788 again. Important with filenames like "/home/foo//:/hello///there"
1789 which would substitute to "/:/hello///there" rather than "/there". */
1790 return Fsubstitute_in_file_name
1791 (make_specified_string (p
, -1, endp
- p
, multibyte
));
1793 /* See if any variables are substituted into the string. */
1795 if (!NILP (Ffboundp (Qsubstitute_env_in_file_name
)))
1798 = (!substituted
? filename
1799 : make_specified_string (nm
, -1, endp
- nm
, multibyte
));
1800 Lisp_Object tmp
= call1 (Qsubstitute_env_in_file_name
, name
);
1802 if (!EQ (tmp
, name
))
1810 if (!NILP (Vw32_downcase_file_names
))
1811 filename
= Fdowncase (filename
);
1816 xnm
= SSDATA (filename
);
1817 x
= xnm
+ SBYTES (filename
);
1819 /* If /~ or // appears, discard everything through first slash. */
1820 while ((p
= search_embedded_absfilename (xnm
, x
)) != NULL
)
1821 /* This time we do not start over because we've already expanded envvars
1822 and replaced $$ with $. Maybe we should start over as well, but we'd
1823 need to quote some $ to $$ first. */
1827 if (!NILP (Vw32_downcase_file_names
))
1829 Lisp_Object xname
= make_specified_string (xnm
, -1, x
- xnm
, multibyte
);
1831 xname
= Fdowncase (xname
);
1836 return (xnm
== SSDATA (filename
)
1838 : make_specified_string (xnm
, -1, x
- xnm
, multibyte
));
1841 /* A slightly faster and more convenient way to get
1842 (directory-file-name (expand-file-name FOO)). */
1845 expand_and_dir_to_file (Lisp_Object filename
, Lisp_Object defdir
)
1847 register Lisp_Object absname
;
1849 absname
= Fexpand_file_name (filename
, defdir
);
1851 /* Remove final slash, if any (unless this is the root dir).
1852 stat behaves differently depending! */
1853 if (SCHARS (absname
) > 1
1854 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
1855 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
) - 2)))
1856 /* We cannot take shortcuts; they might be wrong for magic file names. */
1857 absname
= Fdirectory_file_name (absname
);
1861 /* Signal an error if the file ABSNAME already exists.
1862 If INTERACTIVE, ask the user whether to proceed,
1863 and bypass the error if the user says to go ahead.
1864 QUERYSTRING is a name for the action that is being considered
1867 *STATPTR is used to store the stat information if the file exists.
1868 If the file does not exist, STATPTR->st_mode is set to 0.
1869 If STATPTR is null, we don't store into it.
1871 If QUICK, ask for y or n, not yes or no. */
1874 barf_or_query_if_file_exists (Lisp_Object absname
, const char *querystring
,
1875 bool interactive
, struct stat
*statptr
,
1878 Lisp_Object tem
, encoded_filename
;
1879 struct stat statbuf
;
1880 struct gcpro gcpro1
;
1882 encoded_filename
= ENCODE_FILE (absname
);
1884 /* `stat' is a good way to tell whether the file exists,
1885 regardless of what access permissions it has. */
1886 if (lstat (SSDATA (encoded_filename
), &statbuf
) >= 0)
1888 if (S_ISDIR (statbuf
.st_mode
))
1889 xsignal2 (Qfile_error
,
1890 build_string ("File is a directory"), absname
);
1893 xsignal2 (Qfile_already_exists
,
1894 build_string ("File already exists"), absname
);
1896 tem
= format2 ("File %s already exists; %s anyway? ",
1897 absname
, build_string (querystring
));
1899 tem
= call1 (intern ("y-or-n-p"), tem
);
1901 tem
= do_yes_or_no_p (tem
);
1904 xsignal2 (Qfile_already_exists
,
1905 build_string ("File already exists"), absname
);
1912 statptr
->st_mode
= 0;
1917 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
1918 "fCopy file: \nGCopy %s to file: \np\nP",
1919 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
1920 If NEWNAME names a directory, copy FILE there.
1922 This function always sets the file modes of the output file to match
1925 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1926 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1927 signal a `file-already-exists' error without overwriting. If
1928 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1929 about overwriting; this is what happens in interactive use with M-x.
1930 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1933 Fourth arg KEEP-TIME non-nil means give the output file the same
1934 last-modified time as the old one. (This works on only some systems.)
1936 A prefix arg makes KEEP-TIME non-nil.
1938 If PRESERVE-UID-GID is non-nil, we try to transfer the
1939 uid and gid of FILE to NEWNAME.
1941 If PRESERVE-EXTENDED-ATTRIBUTES is non-nil, we try to copy additional
1942 attributes of FILE to NEWNAME, such as its SELinux context and ACL
1943 entries (depending on how Emacs was built). */)
1944 (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
)
1948 char buf
[16 * 1024];
1949 struct stat st
, out_st
;
1950 Lisp_Object handler
;
1951 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1952 ptrdiff_t count
= SPECPDL_INDEX ();
1953 Lisp_Object encoded_file
, encoded_newname
;
1955 security_context_t con
;
1962 encoded_file
= encoded_newname
= Qnil
;
1963 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
1964 CHECK_STRING (file
);
1965 CHECK_STRING (newname
);
1967 if (!NILP (Ffile_directory_p (newname
)))
1968 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
1970 newname
= Fexpand_file_name (newname
, Qnil
);
1972 file
= Fexpand_file_name (file
, Qnil
);
1974 /* If the input file name has special constructs in it,
1975 call the corresponding file handler. */
1976 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1977 /* Likewise for output file name. */
1979 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1980 if (!NILP (handler
))
1981 RETURN_UNGCPRO (call7 (handler
, Qcopy_file
, file
, newname
,
1982 ok_if_already_exists
, keep_time
, preserve_uid_gid
,
1983 preserve_extended_attributes
));
1985 encoded_file
= ENCODE_FILE (file
);
1986 encoded_newname
= ENCODE_FILE (newname
);
1988 if (NILP (ok_if_already_exists
)
1989 || INTEGERP (ok_if_already_exists
))
1990 barf_or_query_if_file_exists (newname
, "copy to it",
1991 INTEGERP (ok_if_already_exists
), &out_st
, 0);
1992 else if (stat (SSDATA (encoded_newname
), &out_st
) < 0)
1996 result
= w32_copy_file (SSDATA (encoded_file
), SSDATA (encoded_newname
),
1997 !NILP (keep_time
), !NILP (preserve_uid_gid
),
1998 !NILP (preserve_extended_attributes
));
2002 report_file_error ("Copying file", list2 (file
, newname
));
2004 report_file_error ("Copying permissions from", file
);
2006 xsignal2 (Qfile_date_error
,
2007 build_string ("Resetting file times"), newname
);
2009 report_file_error ("Copying permissions to", newname
);
2011 #else /* not WINDOWSNT */
2013 ifd
= emacs_open (SSDATA (encoded_file
), O_RDONLY
, 0);
2017 report_file_error ("Opening input file", file
);
2019 record_unwind_protect_int (close_file_unwind
, ifd
);
2021 if (fstat (ifd
, &st
) != 0)
2022 report_file_error ("Input file status", file
);
2024 if (!NILP (preserve_extended_attributes
))
2027 if (is_selinux_enabled ())
2029 conlength
= fgetfilecon (ifd
, &con
);
2030 if (conlength
== -1)
2031 report_file_error ("Doing fgetfilecon", file
);
2036 if (out_st
.st_mode
!= 0
2037 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2038 report_file_errno ("Input and output files are the same",
2039 list2 (file
, newname
), 0);
2041 /* We can copy only regular files. */
2042 if (!S_ISREG (st
.st_mode
))
2043 report_file_errno ("Non-regular file", file
,
2044 S_ISDIR (st
.st_mode
) ? EISDIR
: EINVAL
);
2048 int new_mask
= st
.st_mode
& (!NILP (preserve_uid_gid
) ? 0600 : 0666);
2050 int new_mask
= S_IREAD
| S_IWRITE
;
2052 ofd
= emacs_open (SSDATA (encoded_newname
),
2053 (O_WRONLY
| O_TRUNC
| O_CREAT
2054 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0)),
2058 report_file_error ("Opening output file", newname
);
2060 record_unwind_protect_int (close_file_unwind
, ofd
);
2064 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2065 if (emacs_write_sig (ofd
, buf
, n
) != n
)
2066 report_file_error ("Write error", newname
);
2070 /* Preserve the original file permissions, and if requested, also its
2073 mode_t mode_mask
= 07777;
2074 if (!NILP (preserve_uid_gid
))
2076 /* Attempt to change owner and group. If that doesn't work
2077 attempt to change just the group, as that is sometimes allowed.
2078 Adjust the mode mask to eliminate setuid or setgid bits
2079 that are inappropriate if the owner and group are wrong. */
2080 if (fchown (ofd
, st
.st_uid
, st
.st_gid
) != 0)
2082 mode_mask
&= ~06000;
2083 if (fchown (ofd
, -1, st
.st_gid
) == 0)
2088 switch (!NILP (preserve_extended_attributes
)
2089 ? qcopy_acl (SSDATA (encoded_file
), ifd
,
2090 SSDATA (encoded_newname
), ofd
,
2091 st
.st_mode
& mode_mask
)
2092 : fchmod (ofd
, st
.st_mode
& mode_mask
))
2094 case -2: report_file_error ("Copying permissions from", file
);
2095 case -1: report_file_error ("Copying permissions to", newname
);
2098 #endif /* not MSDOS */
2103 /* Set the modified context back to the file. */
2104 bool fail
= fsetfilecon (ofd
, con
) != 0;
2105 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2106 if (fail
&& errno
!= ENOTSUP
)
2107 report_file_error ("Doing fsetfilecon", newname
);
2113 if (!NILP (keep_time
))
2115 struct timespec atime
= get_stat_atime (&st
);
2116 struct timespec mtime
= get_stat_mtime (&st
);
2117 if (set_file_times (ofd
, SSDATA (encoded_newname
), atime
, mtime
) != 0)
2118 xsignal2 (Qfile_date_error
,
2119 build_string ("Cannot set file date"), newname
);
2122 if (emacs_close (ofd
) < 0)
2123 report_file_error ("Write error", newname
);
2128 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2129 and if it can't, it tells so. Otherwise, under MSDOS we usually
2130 get only the READ bit, which will make the copied file read-only,
2131 so it's better not to chmod at all. */
2132 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2133 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2135 #endif /* not WINDOWSNT */
2137 /* Discard the unwind protects. */
2138 specpdl_ptr
= specpdl
+ count
;
2144 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2145 Smake_directory_internal
, 1, 1, 0,
2146 doc
: /* Create a new directory named DIRECTORY. */)
2147 (Lisp_Object directory
)
2150 Lisp_Object handler
;
2151 Lisp_Object encoded_dir
;
2153 CHECK_STRING (directory
);
2154 directory
= Fexpand_file_name (directory
, Qnil
);
2156 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2157 if (!NILP (handler
))
2158 return call2 (handler
, Qmake_directory_internal
, directory
);
2160 encoded_dir
= ENCODE_FILE (directory
);
2162 dir
= SSDATA (encoded_dir
);
2165 if (mkdir (dir
) != 0)
2167 if (mkdir (dir
, 0777 & ~auto_saving_dir_umask
) != 0)
2169 report_file_error ("Creating directory", directory
);
2174 DEFUN ("delete-directory-internal", Fdelete_directory_internal
,
2175 Sdelete_directory_internal
, 1, 1, 0,
2176 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2177 (Lisp_Object directory
)
2180 Lisp_Object encoded_dir
;
2182 CHECK_STRING (directory
);
2183 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2184 encoded_dir
= ENCODE_FILE (directory
);
2185 dir
= SSDATA (encoded_dir
);
2187 if (rmdir (dir
) != 0)
2188 report_file_error ("Removing directory", directory
);
2193 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 2,
2194 "(list (read-file-name \
2195 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2196 \"Move file to trash: \" \"Delete file: \") \
2197 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2198 (null current-prefix-arg))",
2199 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2200 If file has multiple names, it continues to exist with the other names.
2201 TRASH non-nil means to trash the file instead of deleting, provided
2202 `delete-by-moving-to-trash' is non-nil.
2204 When called interactively, TRASH is t if no prefix argument is given.
2205 With a prefix argument, TRASH is nil. */)
2206 (Lisp_Object filename
, Lisp_Object trash
)
2208 Lisp_Object handler
;
2209 Lisp_Object encoded_file
;
2210 struct gcpro gcpro1
;
2213 if (!NILP (Ffile_directory_p (filename
))
2214 && NILP (Ffile_symlink_p (filename
)))
2215 xsignal2 (Qfile_error
,
2216 build_string ("Removing old name: is a directory"),
2219 filename
= Fexpand_file_name (filename
, Qnil
);
2221 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2222 if (!NILP (handler
))
2223 return call3 (handler
, Qdelete_file
, filename
, trash
);
2225 if (delete_by_moving_to_trash
&& !NILP (trash
))
2226 return call1 (Qmove_file_to_trash
, filename
);
2228 encoded_file
= ENCODE_FILE (filename
);
2230 if (unlink (SSDATA (encoded_file
)) < 0)
2231 report_file_error ("Removing old name", filename
);
2236 internal_delete_file_1 (Lisp_Object ignore
)
2241 /* Delete file FILENAME, returning true if successful.
2242 This ignores `delete-by-moving-to-trash'. */
2245 internal_delete_file (Lisp_Object filename
)
2249 tem
= internal_condition_case_2 (Fdelete_file
, filename
, Qnil
,
2250 Qt
, internal_delete_file_1
);
2254 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2255 "fRename file: \nGRename %s to file: \np",
2256 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2257 If file has names other than FILE, it continues to have those names.
2258 Signals a `file-already-exists' error if a file NEWNAME already exists
2259 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2260 A number as third arg means request confirmation if NEWNAME already exists.
2261 This is what happens in interactive use with M-x. */)
2262 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2264 Lisp_Object handler
;
2265 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2266 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2268 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2269 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2270 CHECK_STRING (file
);
2271 CHECK_STRING (newname
);
2272 file
= Fexpand_file_name (file
, Qnil
);
2274 if ((!NILP (Ffile_directory_p (newname
)))
2276 /* If the file names are identical but for the case,
2277 don't attempt to move directory to itself. */
2278 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2282 Lisp_Object fname
= (NILP (Ffile_directory_p (file
))
2283 ? file
: Fdirectory_file_name (file
));
2284 newname
= Fexpand_file_name (Ffile_name_nondirectory (fname
), newname
);
2287 newname
= Fexpand_file_name (newname
, Qnil
);
2289 /* If the file name has special constructs in it,
2290 call the corresponding file handler. */
2291 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2293 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2294 if (!NILP (handler
))
2295 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2296 file
, newname
, ok_if_already_exists
));
2298 encoded_file
= ENCODE_FILE (file
);
2299 encoded_newname
= ENCODE_FILE (newname
);
2302 /* If the file names are identical but for the case, don't ask for
2303 confirmation: they simply want to change the letter-case of the
2305 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2307 if (NILP (ok_if_already_exists
)
2308 || INTEGERP (ok_if_already_exists
))
2309 barf_or_query_if_file_exists (newname
, "rename to it",
2310 INTEGERP (ok_if_already_exists
), 0, 0);
2311 if (rename (SSDATA (encoded_file
), SSDATA (encoded_newname
)) < 0)
2313 int rename_errno
= errno
;
2314 if (rename_errno
== EXDEV
)
2317 symlink_target
= Ffile_symlink_p (file
);
2318 if (! NILP (symlink_target
))
2319 Fmake_symbolic_link (symlink_target
, newname
,
2320 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2321 else if (!NILP (Ffile_directory_p (file
)))
2322 call4 (Qcopy_directory
, file
, newname
, Qt
, Qnil
);
2324 /* We have already prompted if it was an integer, so don't
2325 have copy-file prompt again. */
2326 Fcopy_file (file
, newname
,
2327 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2330 count
= SPECPDL_INDEX ();
2331 specbind (Qdelete_by_moving_to_trash
, Qnil
);
2333 if (!NILP (Ffile_directory_p (file
)) && NILP (symlink_target
))
2334 call2 (Qdelete_directory
, file
, Qt
);
2336 Fdelete_file (file
, Qnil
);
2337 unbind_to (count
, Qnil
);
2340 report_file_errno ("Renaming", list2 (file
, newname
), rename_errno
);
2346 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2347 "fAdd name to file: \nGName to add to %s: \np",
2348 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2349 Signals a `file-already-exists' error if a file NEWNAME already exists
2350 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2351 A number as third arg means request confirmation if NEWNAME already exists.
2352 This is what happens in interactive use with M-x. */)
2353 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2355 Lisp_Object handler
;
2356 Lisp_Object encoded_file
, encoded_newname
;
2357 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2359 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2360 encoded_file
= encoded_newname
= Qnil
;
2361 CHECK_STRING (file
);
2362 CHECK_STRING (newname
);
2363 file
= Fexpand_file_name (file
, Qnil
);
2365 if (!NILP (Ffile_directory_p (newname
)))
2366 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2368 newname
= Fexpand_file_name (newname
, Qnil
);
2370 /* If the file name has special constructs in it,
2371 call the corresponding file handler. */
2372 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2373 if (!NILP (handler
))
2374 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2375 newname
, ok_if_already_exists
));
2377 /* If the new name has special constructs in it,
2378 call the corresponding file handler. */
2379 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2380 if (!NILP (handler
))
2381 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2382 newname
, ok_if_already_exists
));
2384 encoded_file
= ENCODE_FILE (file
);
2385 encoded_newname
= ENCODE_FILE (newname
);
2387 if (NILP (ok_if_already_exists
)
2388 || INTEGERP (ok_if_already_exists
))
2389 barf_or_query_if_file_exists (newname
, "make it a new name",
2390 INTEGERP (ok_if_already_exists
), 0, 0);
2392 unlink (SSDATA (newname
));
2393 if (link (SSDATA (encoded_file
), SSDATA (encoded_newname
)) < 0)
2395 int link_errno
= errno
;
2396 report_file_errno ("Adding new name", list2 (file
, newname
), link_errno
);
2403 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2404 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2405 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2406 Both args must be strings.
2407 Signals a `file-already-exists' error if a file LINKNAME already exists
2408 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2409 A number as third arg means request confirmation if LINKNAME already exists.
2410 This happens for interactive use with M-x. */)
2411 (Lisp_Object filename
, Lisp_Object linkname
, Lisp_Object ok_if_already_exists
)
2413 Lisp_Object handler
;
2414 Lisp_Object encoded_filename
, encoded_linkname
;
2415 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2417 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2418 encoded_filename
= encoded_linkname
= Qnil
;
2419 CHECK_STRING (filename
);
2420 CHECK_STRING (linkname
);
2421 /* If the link target has a ~, we must expand it to get
2422 a truly valid file name. Otherwise, do not expand;
2423 we want to permit links to relative file names. */
2424 if (SREF (filename
, 0) == '~')
2425 filename
= Fexpand_file_name (filename
, Qnil
);
2427 if (!NILP (Ffile_directory_p (linkname
)))
2428 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2430 linkname
= Fexpand_file_name (linkname
, Qnil
);
2432 /* If the file name has special constructs in it,
2433 call the corresponding file handler. */
2434 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2435 if (!NILP (handler
))
2436 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2437 linkname
, ok_if_already_exists
));
2439 /* If the new link name has special constructs in it,
2440 call the corresponding file handler. */
2441 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2442 if (!NILP (handler
))
2443 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2444 linkname
, ok_if_already_exists
));
2446 encoded_filename
= ENCODE_FILE (filename
);
2447 encoded_linkname
= ENCODE_FILE (linkname
);
2449 if (NILP (ok_if_already_exists
)
2450 || INTEGERP (ok_if_already_exists
))
2451 barf_or_query_if_file_exists (linkname
, "make it a link",
2452 INTEGERP (ok_if_already_exists
), 0, 0);
2453 if (symlink (SSDATA (encoded_filename
), SSDATA (encoded_linkname
)) < 0)
2455 /* If we didn't complain already, silently delete existing file. */
2457 if (errno
== EEXIST
)
2459 unlink (SSDATA (encoded_linkname
));
2460 if (symlink (SSDATA (encoded_filename
), SSDATA (encoded_linkname
))
2467 if (errno
== ENOSYS
)
2470 xsignal1 (Qfile_error
,
2471 build_string ("Symbolic links are not supported"));
2474 symlink_errno
= errno
;
2475 report_file_errno ("Making symbolic link", list2 (filename
, linkname
),
2483 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2485 doc
: /* Return t if file FILENAME specifies an absolute file name.
2486 On Unix, this is a name starting with a `/' or a `~'. */)
2487 (Lisp_Object filename
)
2489 CHECK_STRING (filename
);
2490 return file_name_absolute_p (SSDATA (filename
)) ? Qt
: Qnil
;
2493 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2494 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
2495 See also `file-readable-p' and `file-attributes'.
2496 This returns nil for a symlink to a nonexistent file.
2497 Use `file-symlink-p' to test for such links. */)
2498 (Lisp_Object filename
)
2500 Lisp_Object absname
;
2501 Lisp_Object handler
;
2503 CHECK_STRING (filename
);
2504 absname
= Fexpand_file_name (filename
, Qnil
);
2506 /* If the file name has special constructs in it,
2507 call the corresponding file handler. */
2508 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2509 if (!NILP (handler
))
2511 Lisp_Object result
= call2 (handler
, Qfile_exists_p
, absname
);
2516 absname
= ENCODE_FILE (absname
);
2518 return check_existing (SSDATA (absname
)) ? Qt
: Qnil
;
2521 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2522 doc
: /* Return t if FILENAME can be executed by you.
2523 For a directory, this means you can access files in that directory. */)
2524 (Lisp_Object filename
)
2526 Lisp_Object absname
;
2527 Lisp_Object handler
;
2529 CHECK_STRING (filename
);
2530 absname
= Fexpand_file_name (filename
, Qnil
);
2532 /* If the file name has special constructs in it,
2533 call the corresponding file handler. */
2534 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2535 if (!NILP (handler
))
2536 return call2 (handler
, Qfile_executable_p
, absname
);
2538 absname
= ENCODE_FILE (absname
);
2540 return (check_executable (SSDATA (absname
)) ? Qt
: Qnil
);
2543 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2544 doc
: /* Return t if file FILENAME exists and you can read it.
2545 See also `file-exists-p' and `file-attributes'. */)
2546 (Lisp_Object filename
)
2548 Lisp_Object absname
;
2549 Lisp_Object handler
;
2551 CHECK_STRING (filename
);
2552 absname
= Fexpand_file_name (filename
, Qnil
);
2554 /* If the file name has special constructs in it,
2555 call the corresponding file handler. */
2556 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2557 if (!NILP (handler
))
2558 return call2 (handler
, Qfile_readable_p
, absname
);
2560 absname
= ENCODE_FILE (absname
);
2561 return (faccessat (AT_FDCWD
, SSDATA (absname
), R_OK
, AT_EACCESS
) == 0
2565 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2566 doc
: /* Return t if file FILENAME can be written or created by you. */)
2567 (Lisp_Object filename
)
2569 Lisp_Object absname
, dir
, encoded
;
2570 Lisp_Object handler
;
2572 CHECK_STRING (filename
);
2573 absname
= Fexpand_file_name (filename
, Qnil
);
2575 /* If the file name has special constructs in it,
2576 call the corresponding file handler. */
2577 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2578 if (!NILP (handler
))
2579 return call2 (handler
, Qfile_writable_p
, absname
);
2581 encoded
= ENCODE_FILE (absname
);
2582 if (check_writable (SSDATA (encoded
), W_OK
))
2584 if (errno
!= ENOENT
)
2587 dir
= Ffile_name_directory (absname
);
2588 eassert (!NILP (dir
));
2590 dir
= Fdirectory_file_name (dir
);
2593 dir
= ENCODE_FILE (dir
);
2595 /* The read-only attribute of the parent directory doesn't affect
2596 whether a file or directory can be created within it. Some day we
2597 should check ACLs though, which do affect this. */
2598 return file_directory_p (SDATA (dir
)) ? Qt
: Qnil
;
2600 return check_writable (SSDATA (dir
), W_OK
| X_OK
) ? Qt
: Qnil
;
2604 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2605 doc
: /* Access file FILENAME, and get an error if that does not work.
2606 The second argument STRING is used in the error message.
2607 If there is no error, returns nil. */)
2608 (Lisp_Object filename
, Lisp_Object string
)
2610 Lisp_Object handler
, encoded_filename
, absname
;
2612 CHECK_STRING (filename
);
2613 absname
= Fexpand_file_name (filename
, Qnil
);
2615 CHECK_STRING (string
);
2617 /* If the file name has special constructs in it,
2618 call the corresponding file handler. */
2619 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
2620 if (!NILP (handler
))
2621 return call3 (handler
, Qaccess_file
, absname
, string
);
2623 encoded_filename
= ENCODE_FILE (absname
);
2625 if (faccessat (AT_FDCWD
, SSDATA (encoded_filename
), R_OK
, AT_EACCESS
) != 0)
2626 report_file_error (SSDATA (string
), filename
);
2631 /* Relative to directory FD, return the symbolic link value of FILENAME.
2632 On failure, return nil. */
2634 emacs_readlinkat (int fd
, char const *filename
)
2636 static struct allocator
const emacs_norealloc_allocator
=
2637 { xmalloc
, NULL
, xfree
, memory_full
};
2639 char readlink_buf
[1024];
2640 char *buf
= careadlinkat (fd
, filename
, readlink_buf
, sizeof readlink_buf
,
2641 &emacs_norealloc_allocator
, readlinkat
);
2645 val
= build_unibyte_string (buf
);
2646 if (buf
[0] == '/' && strchr (buf
, ':'))
2647 val
= concat2 (build_unibyte_string ("/:"), val
);
2648 if (buf
!= readlink_buf
)
2650 val
= DECODE_FILE (val
);
2654 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2655 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
2656 The value is the link target, as a string.
2657 Otherwise it returns nil.
2659 This function returns t when given the name of a symlink that
2660 points to a nonexistent file. */)
2661 (Lisp_Object filename
)
2663 Lisp_Object handler
;
2665 CHECK_STRING (filename
);
2666 filename
= Fexpand_file_name (filename
, Qnil
);
2668 /* If the file name has special constructs in it,
2669 call the corresponding file handler. */
2670 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2671 if (!NILP (handler
))
2672 return call2 (handler
, Qfile_symlink_p
, filename
);
2674 filename
= ENCODE_FILE (filename
);
2676 return emacs_readlinkat (AT_FDCWD
, SSDATA (filename
));
2679 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2680 doc
: /* Return t if FILENAME names an existing directory.
2681 Symbolic links to directories count as directories.
2682 See `file-symlink-p' to distinguish symlinks. */)
2683 (Lisp_Object filename
)
2685 Lisp_Object absname
;
2686 Lisp_Object handler
;
2688 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2690 /* If the file name has special constructs in it,
2691 call the corresponding file handler. */
2692 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2693 if (!NILP (handler
))
2694 return call2 (handler
, Qfile_directory_p
, absname
);
2696 absname
= ENCODE_FILE (absname
);
2698 return file_directory_p (SSDATA (absname
)) ? Qt
: Qnil
;
2701 /* Return true if FILE is a directory or a symlink to a directory. */
2703 file_directory_p (char const *file
)
2706 /* This is cheaper than 'stat'. */
2707 return faccessat (AT_FDCWD
, file
, D_OK
, AT_EACCESS
) == 0;
2710 return stat (file
, &st
) == 0 && S_ISDIR (st
.st_mode
);
2714 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
,
2715 Sfile_accessible_directory_p
, 1, 1, 0,
2716 doc
: /* Return t if file FILENAME names a directory you can open.
2717 For the value to be t, FILENAME must specify the name of a directory as a file,
2718 and the directory must allow you to open files in it. In order to use a
2719 directory as a buffer's current directory, this predicate must return true.
2720 A directory name spec may be given instead; then the value is t
2721 if the directory so specified exists and really is a readable and
2722 searchable directory. */)
2723 (Lisp_Object filename
)
2725 Lisp_Object absname
;
2726 Lisp_Object handler
;
2728 CHECK_STRING (filename
);
2729 absname
= Fexpand_file_name (filename
, Qnil
);
2731 /* If the file name has special constructs in it,
2732 call the corresponding file handler. */
2733 handler
= Ffind_file_name_handler (absname
, Qfile_accessible_directory_p
);
2734 if (!NILP (handler
))
2736 Lisp_Object r
= call2 (handler
, Qfile_accessible_directory_p
, absname
);
2741 absname
= ENCODE_FILE (absname
);
2742 return file_accessible_directory_p (SSDATA (absname
)) ? Qt
: Qnil
;
2745 /* If FILE is a searchable directory or a symlink to a
2746 searchable directory, return true. Otherwise return
2747 false and set errno to an error number. */
2749 file_accessible_directory_p (char const *file
)
2752 /* There's no need to test whether FILE is searchable, as the
2753 searchable/executable bit is invented on DOS_NT platforms. */
2754 return file_directory_p (file
);
2756 /* On POSIXish platforms, use just one system call; this avoids a
2757 race and is typically faster. */
2758 ptrdiff_t len
= strlen (file
);
2764 /* Normally a file "FOO" is an accessible directory if "FOO/." exists.
2765 There are three exceptions: "", "/", and "//". Leave "" alone,
2766 as it's invalid. Append only "." to the other two exceptions as
2767 "/" and "//" are distinct on some platforms, whereas "/", "///",
2768 "////", etc. are all equivalent. */
2773 /* Just check for trailing '/' when deciding whether to append '/'.
2774 That's simpler than testing the two special cases "/" and "//",
2775 and it's a safe optimization here. */
2776 char *buf
= SAFE_ALLOCA (len
+ 3);
2777 memcpy (buf
, file
, len
);
2778 strcpy (buf
+ len
, &"/."[file
[len
- 1] == '/']);
2782 ok
= check_existing (dir
);
2783 saved_errno
= errno
;
2785 errno
= saved_errno
;
2790 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2791 doc
: /* Return t if FILENAME names a regular file.
2792 This is the sort of file that holds an ordinary stream of data bytes.
2793 Symbolic links to regular files count as regular files.
2794 See `file-symlink-p' to distinguish symlinks. */)
2795 (Lisp_Object filename
)
2797 register Lisp_Object absname
;
2799 Lisp_Object handler
;
2801 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2803 /* If the file name has special constructs in it,
2804 call the corresponding file handler. */
2805 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2806 if (!NILP (handler
))
2807 return call2 (handler
, Qfile_regular_p
, absname
);
2809 absname
= ENCODE_FILE (absname
);
2814 Lisp_Object tem
= Vw32_get_true_file_attributes
;
2816 /* Tell stat to use expensive method to get accurate info. */
2817 Vw32_get_true_file_attributes
= Qt
;
2818 result
= stat (SDATA (absname
), &st
);
2819 Vw32_get_true_file_attributes
= tem
;
2823 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2826 if (stat (SSDATA (absname
), &st
) < 0)
2828 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2832 DEFUN ("file-selinux-context", Ffile_selinux_context
,
2833 Sfile_selinux_context
, 1, 1, 0,
2834 doc
: /* Return SELinux context of file named FILENAME.
2835 The return value is a list (USER ROLE TYPE RANGE), where the list
2836 elements are strings naming the user, role, type, and range of the
2837 file's SELinux security context.
2839 Return (nil nil nil nil) if the file is nonexistent or inaccessible,
2840 or if SELinux is disabled, or if Emacs lacks SELinux support. */)
2841 (Lisp_Object filename
)
2843 Lisp_Object absname
;
2844 Lisp_Object values
[4];
2845 Lisp_Object handler
;
2847 security_context_t con
;
2852 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2854 /* If the file name has special constructs in it,
2855 call the corresponding file handler. */
2856 handler
= Ffind_file_name_handler (absname
, Qfile_selinux_context
);
2857 if (!NILP (handler
))
2858 return call2 (handler
, Qfile_selinux_context
, absname
);
2860 absname
= ENCODE_FILE (absname
);
2867 if (is_selinux_enabled ())
2869 conlength
= lgetfilecon (SSDATA (absname
), &con
);
2872 context
= context_new (con
);
2873 if (context_user_get (context
))
2874 values
[0] = build_string (context_user_get (context
));
2875 if (context_role_get (context
))
2876 values
[1] = build_string (context_role_get (context
));
2877 if (context_type_get (context
))
2878 values
[2] = build_string (context_type_get (context
));
2879 if (context_range_get (context
))
2880 values
[3] = build_string (context_range_get (context
));
2881 context_free (context
);
2887 return Flist (sizeof (values
) / sizeof (values
[0]), values
);
2890 DEFUN ("set-file-selinux-context", Fset_file_selinux_context
,
2891 Sset_file_selinux_context
, 2, 2, 0,
2892 doc
: /* Set SELinux context of file named FILENAME to CONTEXT.
2893 CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
2894 elements are strings naming the components of a SELinux context.
2896 Value is t if setting of SELinux context was successful, nil otherwise.
2898 This function does nothing and returns nil if SELinux is disabled,
2899 or if Emacs was not compiled with SELinux support. */)
2900 (Lisp_Object filename
, Lisp_Object context
)
2902 Lisp_Object absname
;
2903 Lisp_Object handler
;
2905 Lisp_Object encoded_absname
;
2906 Lisp_Object user
= CAR_SAFE (context
);
2907 Lisp_Object role
= CAR_SAFE (CDR_SAFE (context
));
2908 Lisp_Object type
= CAR_SAFE (CDR_SAFE (CDR_SAFE (context
)));
2909 Lisp_Object range
= CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context
))));
2910 security_context_t con
;
2913 context_t parsed_con
;
2916 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
2918 /* If the file name has special constructs in it,
2919 call the corresponding file handler. */
2920 handler
= Ffind_file_name_handler (absname
, Qset_file_selinux_context
);
2921 if (!NILP (handler
))
2922 return call3 (handler
, Qset_file_selinux_context
, absname
, context
);
2925 if (is_selinux_enabled ())
2927 /* Get current file context. */
2928 encoded_absname
= ENCODE_FILE (absname
);
2929 conlength
= lgetfilecon (SSDATA (encoded_absname
), &con
);
2932 parsed_con
= context_new (con
);
2933 /* Change the parts defined in the parameter.*/
2936 if (context_user_set (parsed_con
, SSDATA (user
)))
2937 error ("Doing context_user_set");
2941 if (context_role_set (parsed_con
, SSDATA (role
)))
2942 error ("Doing context_role_set");
2946 if (context_type_set (parsed_con
, SSDATA (type
)))
2947 error ("Doing context_type_set");
2949 if (STRINGP (range
))
2951 if (context_range_set (parsed_con
, SSDATA (range
)))
2952 error ("Doing context_range_set");
2955 /* Set the modified context back to the file. */
2956 fail
= (lsetfilecon (SSDATA (encoded_absname
),
2957 context_str (parsed_con
))
2959 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2960 if (fail
&& errno
!= ENOTSUP
)
2961 report_file_error ("Doing lsetfilecon", absname
);
2963 context_free (parsed_con
);
2965 return fail
? Qnil
: Qt
;
2968 report_file_error ("Doing lgetfilecon", absname
);
2975 DEFUN ("file-acl", Ffile_acl
, Sfile_acl
, 1, 1, 0,
2976 doc
: /* Return ACL entries of file named FILENAME.
2977 The entries are returned in a format suitable for use in `set-file-acl'
2978 but is otherwise undocumented and subject to change.
2979 Return nil if file does not exist or is not accessible, or if Emacs
2980 was unable to determine the ACL entries. */)
2981 (Lisp_Object filename
)
2983 Lisp_Object absname
;
2984 Lisp_Object handler
;
2985 #ifdef HAVE_ACL_SET_FILE
2987 Lisp_Object acl_string
;
2991 absname
= expand_and_dir_to_file (filename
,
2992 BVAR (current_buffer
, directory
));
2994 /* If the file name has special constructs in it,
2995 call the corresponding file handler. */
2996 handler
= Ffind_file_name_handler (absname
, Qfile_acl
);
2997 if (!NILP (handler
))
2998 return call2 (handler
, Qfile_acl
, absname
);
3000 #ifdef HAVE_ACL_SET_FILE
3001 absname
= ENCODE_FILE (absname
);
3003 acl
= acl_get_file (SSDATA (absname
), ACL_TYPE_ACCESS
);
3007 str
= acl_to_text (acl
, NULL
);
3014 acl_string
= build_string (str
);
3024 DEFUN ("set-file-acl", Fset_file_acl
, Sset_file_acl
,
3026 doc
: /* Set ACL of file named FILENAME to ACL-STRING.
3027 ACL-STRING should contain the textual representation of the ACL
3028 entries in a format suitable for the platform.
3030 Value is t if setting of ACL was successful, nil otherwise.
3032 Setting ACL for local files requires Emacs to be built with ACL
3034 (Lisp_Object filename
, Lisp_Object acl_string
)
3036 Lisp_Object absname
;
3037 Lisp_Object handler
;
3038 #ifdef HAVE_ACL_SET_FILE
3039 Lisp_Object encoded_absname
;
3044 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3046 /* If the file name has special constructs in it,
3047 call the corresponding file handler. */
3048 handler
= Ffind_file_name_handler (absname
, Qset_file_acl
);
3049 if (!NILP (handler
))
3050 return call3 (handler
, Qset_file_acl
, absname
, acl_string
);
3052 #ifdef HAVE_ACL_SET_FILE
3053 if (STRINGP (acl_string
))
3055 acl
= acl_from_text (SSDATA (acl_string
));
3058 report_file_error ("Converting ACL", absname
);
3062 encoded_absname
= ENCODE_FILE (absname
);
3064 fail
= (acl_set_file (SSDATA (encoded_absname
), ACL_TYPE_ACCESS
,
3067 if (fail
&& acl_errno_valid (errno
))
3068 report_file_error ("Setting ACL", absname
);
3071 return fail
? Qnil
: Qt
;
3078 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3079 doc
: /* Return mode bits of file named FILENAME, as an integer.
3080 Return nil, if file does not exist or is not accessible. */)
3081 (Lisp_Object filename
)
3083 Lisp_Object absname
;
3085 Lisp_Object handler
;
3087 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
3089 /* If the file name has special constructs in it,
3090 call the corresponding file handler. */
3091 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3092 if (!NILP (handler
))
3093 return call2 (handler
, Qfile_modes
, absname
);
3095 absname
= ENCODE_FILE (absname
);
3097 if (stat (SSDATA (absname
), &st
) < 0)
3100 return make_number (st
.st_mode
& 07777);
3103 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
3104 "(let ((file (read-file-name \"File: \"))) \
3105 (list file (read-file-modes nil file)))",
3106 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3107 Only the 12 low bits of MODE are used.
3109 Interactively, mode bits are read by `read-file-modes', which accepts
3110 symbolic notation, like the `chmod' command from GNU Coreutils. */)
3111 (Lisp_Object filename
, Lisp_Object mode
)
3113 Lisp_Object absname
, encoded_absname
;
3114 Lisp_Object handler
;
3116 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3117 CHECK_NUMBER (mode
);
3119 /* If the file name has special constructs in it,
3120 call the corresponding file handler. */
3121 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3122 if (!NILP (handler
))
3123 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3125 encoded_absname
= ENCODE_FILE (absname
);
3127 if (chmod (SSDATA (encoded_absname
), XINT (mode
) & 07777) < 0)
3128 report_file_error ("Doing chmod", absname
);
3133 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3134 doc
: /* Set the file permission bits for newly created files.
3135 The argument MODE should be an integer; only the low 9 bits are used.
3136 This setting is inherited by subprocesses. */)
3139 CHECK_NUMBER (mode
);
3141 umask ((~ XINT (mode
)) & 0777);
3146 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3147 doc
: /* Return the default file protection for created files.
3148 The value is an integer. */)
3155 realmask
= umask (0);
3159 XSETINT (value
, (~ realmask
) & 0777);
3164 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3165 doc
: /* Set times of file FILENAME to TIMESTAMP.
3166 Set both access and modification times.
3167 Return t on success, else nil.
3168 Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
3170 (Lisp_Object filename
, Lisp_Object timestamp
)
3172 Lisp_Object absname
, encoded_absname
;
3173 Lisp_Object handler
;
3174 struct timespec t
= lisp_time_argument (timestamp
);
3176 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3178 /* If the file name has special constructs in it,
3179 call the corresponding file handler. */
3180 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3181 if (!NILP (handler
))
3182 return call3 (handler
, Qset_file_times
, absname
, timestamp
);
3184 encoded_absname
= ENCODE_FILE (absname
);
3187 if (set_file_times (-1, SSDATA (encoded_absname
), t
, t
) != 0)
3190 /* Setting times on a directory always fails. */
3191 if (file_directory_p (SSDATA (encoded_absname
)))
3194 report_file_error ("Setting file times", absname
);
3202 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3203 doc
: /* Tell Unix to finish all pending disk updates. */)
3210 #endif /* HAVE_SYNC */
3212 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3213 doc
: /* Return t if file FILE1 is newer than file FILE2.
3214 If FILE1 does not exist, the answer is nil;
3215 otherwise, if FILE2 does not exist, the answer is t. */)
3216 (Lisp_Object file1
, Lisp_Object file2
)
3218 Lisp_Object absname1
, absname2
;
3219 struct stat st1
, st2
;
3220 Lisp_Object handler
;
3221 struct gcpro gcpro1
, gcpro2
;
3223 CHECK_STRING (file1
);
3224 CHECK_STRING (file2
);
3227 GCPRO2 (absname1
, file2
);
3228 absname1
= expand_and_dir_to_file (file1
, BVAR (current_buffer
, directory
));
3229 absname2
= expand_and_dir_to_file (file2
, BVAR (current_buffer
, directory
));
3232 /* If the file name has special constructs in it,
3233 call the corresponding file handler. */
3234 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3236 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3237 if (!NILP (handler
))
3238 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3240 GCPRO2 (absname1
, absname2
);
3241 absname1
= ENCODE_FILE (absname1
);
3242 absname2
= ENCODE_FILE (absname2
);
3245 if (stat (SSDATA (absname1
), &st1
) < 0)
3248 if (stat (SSDATA (absname2
), &st2
) < 0)
3251 return (timespec_cmp (get_stat_mtime (&st2
), get_stat_mtime (&st1
)) < 0
3255 #ifndef READ_BUF_SIZE
3256 #define READ_BUF_SIZE (64 << 10)
3258 /* Some buffer offsets are stored in 'int' variables. */
3259 verify (READ_BUF_SIZE
<= INT_MAX
);
3261 /* This function is called after Lisp functions to decide a coding
3262 system are called, or when they cause an error. Before they are
3263 called, the current buffer is set unibyte and it contains only a
3264 newly inserted text (thus the buffer was empty before the
3267 The functions may set markers, overlays, text properties, or even
3268 alter the buffer contents, change the current buffer.
3270 Here, we reset all those changes by:
3271 o set back the current buffer.
3272 o move all markers and overlays to BEG.
3273 o remove all text properties.
3274 o set back the buffer multibyteness. */
3277 decide_coding_unwind (Lisp_Object unwind_data
)
3279 Lisp_Object multibyte
, undo_list
, buffer
;
3281 multibyte
= XCAR (unwind_data
);
3282 unwind_data
= XCDR (unwind_data
);
3283 undo_list
= XCAR (unwind_data
);
3284 buffer
= XCDR (unwind_data
);
3286 set_buffer_internal (XBUFFER (buffer
));
3287 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3288 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3289 set_buffer_intervals (current_buffer
, NULL
);
3290 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3292 /* Now we are safe to change the buffer's multibyteness directly. */
3293 bset_enable_multibyte_characters (current_buffer
, multibyte
);
3294 bset_undo_list (current_buffer
, undo_list
);
3297 /* Read from a non-regular file. STATE is a Lisp_Save_Value
3298 object where slot 0 is the file descriptor, slot 1 specifies
3299 an offset to put the read bytes, and slot 2 is the maximum
3300 amount of bytes to read. Value is the number of bytes read. */
3303 read_non_regular (Lisp_Object state
)
3309 nbytes
= emacs_read (XSAVE_INTEGER (state
, 0),
3310 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
3311 + XSAVE_INTEGER (state
, 1)),
3312 XSAVE_INTEGER (state
, 2));
3314 /* Fast recycle this object for the likely next call. */
3316 return make_number (nbytes
);
3320 /* Condition-case handler used when reading from non-regular files
3321 in insert-file-contents. */
3324 read_non_regular_quit (Lisp_Object ignore
)
3329 /* Return the file offset that VAL represents, checking for type
3330 errors and overflow. */
3332 file_offset (Lisp_Object val
)
3334 if (RANGED_INTEGERP (0, val
, TYPE_MAXIMUM (off_t
)))
3339 double v
= XFLOAT_DATA (val
);
3341 && (sizeof (off_t
) < sizeof v
3342 ? v
<= TYPE_MAXIMUM (off_t
)
3343 : v
< TYPE_MAXIMUM (off_t
)))
3347 wrong_type_argument (intern ("file-offset"), val
);
3350 /* Return a special time value indicating the error number ERRNUM. */
3351 static struct timespec
3352 time_error_value (int errnum
)
3354 int ns
= (errnum
== ENOENT
|| errnum
== EACCES
|| errnum
== ENOTDIR
3355 ? NONEXISTENT_MODTIME_NSECS
3356 : UNKNOWN_MODTIME_NSECS
);
3357 return make_timespec (0, ns
);
3360 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3362 doc
: /* Insert contents of file FILENAME after point.
3363 Returns list of absolute file name and number of characters inserted.
3364 If second argument VISIT is non-nil, the buffer's visited filename and
3365 last save file modtime are set, and it is marked unmodified. If
3366 visiting and the file does not exist, visiting is completed before the
3369 The optional third and fourth arguments BEG and END specify what portion
3370 of the file to insert. These arguments count bytes in the file, not
3371 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3373 If optional fifth argument REPLACE is non-nil, replace the current
3374 buffer contents (in the accessible portion) with the file contents.
3375 This is better than simply deleting and inserting the whole thing
3376 because (1) it preserves some marker positions and (2) it puts less data
3377 in the undo list. When REPLACE is non-nil, the second return value is
3378 the number of characters that replace previous buffer contents.
3380 This function does code conversion according to the value of
3381 `coding-system-for-read' or `file-coding-system-alist', and sets the
3382 variable `last-coding-system-used' to the coding system actually used.
3384 In addition, this function decodes the inserted text from known formats
3385 by calling `format-decode', which see. */)
3386 (Lisp_Object filename
, Lisp_Object visit
, Lisp_Object beg
, Lisp_Object end
, Lisp_Object replace
)
3389 struct timespec mtime
;
3391 ptrdiff_t inserted
= 0;
3393 off_t beg_offset
, end_offset
;
3395 ptrdiff_t count
= SPECPDL_INDEX ();
3396 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3397 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3399 ptrdiff_t total
= 0;
3400 bool not_regular
= 0;
3402 char read_buf
[READ_BUF_SIZE
];
3403 struct coding_system coding
;
3404 bool replace_handled
= 0;
3405 bool set_coding_system
= 0;
3406 Lisp_Object coding_system
;
3408 /* If the undo log only contains the insertion, there's no point
3409 keeping it. It's typically when we first fill a file-buffer. */
3410 bool empty_undo_list_p
3411 = (!NILP (visit
) && NILP (BVAR (current_buffer
, undo_list
))
3413 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3414 bool we_locked_file
= 0;
3417 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3418 error ("Cannot do file visiting in an indirect buffer");
3420 if (!NILP (BVAR (current_buffer
, read_only
)))
3421 Fbarf_if_buffer_read_only ();
3425 orig_filename
= Qnil
;
3428 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3430 CHECK_STRING (filename
);
3431 filename
= Fexpand_file_name (filename
, Qnil
);
3433 /* The value Qnil means that the coding system is not yet
3435 coding_system
= Qnil
;
3437 /* If the file name has special constructs in it,
3438 call the corresponding file handler. */
3439 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3440 if (!NILP (handler
))
3442 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3443 visit
, beg
, end
, replace
);
3444 if (CONSP (val
) && CONSP (XCDR (val
))
3445 && RANGED_INTEGERP (0, XCAR (XCDR (val
)), ZV
- PT
))
3446 inserted
= XINT (XCAR (XCDR (val
)));
3450 orig_filename
= filename
;
3451 filename
= ENCODE_FILE (filename
);
3453 fd
= emacs_open (SSDATA (filename
), O_RDONLY
, 0);
3458 report_file_error ("Opening input file", orig_filename
);
3459 mtime
= time_error_value (save_errno
);
3461 if (!NILP (Vcoding_system_for_read
))
3462 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3466 fd_index
= SPECPDL_INDEX ();
3467 record_unwind_protect_int (close_file_unwind
, fd
);
3469 /* Replacement should preserve point as it preserves markers. */
3470 if (!NILP (replace
))
3471 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3473 if (fstat (fd
, &st
) != 0)
3474 report_file_error ("Input file status", orig_filename
);
3475 mtime
= get_stat_mtime (&st
);
3477 /* This code will need to be changed in order to work on named
3478 pipes, and it's probably just not worth it. So we should at
3479 least signal an error. */
3480 if (!S_ISREG (st
.st_mode
))
3487 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3488 xsignal2 (Qfile_error
,
3489 build_string ("not a regular file"), orig_filename
);
3494 if (!NILP (beg
) || !NILP (end
))
3495 error ("Attempt to visit less than an entire file");
3496 if (BEG
< Z
&& NILP (replace
))
3497 error ("Cannot do file visiting in a non-empty buffer");
3501 beg_offset
= file_offset (beg
);
3506 end_offset
= file_offset (end
);
3510 end_offset
= TYPE_MAXIMUM (off_t
);
3513 end_offset
= st
.st_size
;
3515 /* A negative size can happen on a platform that allows file
3516 sizes greater than the maximum off_t value. */
3520 /* The file size returned from stat may be zero, but data
3521 may be readable nonetheless, for example when this is a
3522 file in the /proc filesystem. */
3523 if (end_offset
== 0)
3524 end_offset
= READ_BUF_SIZE
;
3528 /* Check now whether the buffer will become too large,
3529 in the likely case where the file's length is not changing.
3530 This saves a lot of needless work before a buffer overflow. */
3533 /* The likely offset where we will stop reading. We could read
3534 more (or less), if the file grows (or shrinks) as we read it. */
3535 off_t likely_end
= min (end_offset
, st
.st_size
);
3537 if (beg_offset
< likely_end
)
3540 = Z_BYTE
- (!NILP (replace
) ? ZV_BYTE
- BEGV_BYTE
: 0);
3541 ptrdiff_t buf_growth_max
= BUF_BYTES_MAX
- buf_bytes
;
3542 off_t likely_growth
= likely_end
- beg_offset
;
3543 if (buf_growth_max
< likely_growth
)
3548 /* Prevent redisplay optimizations. */
3549 current_buffer
->clip_changed
= 1;
3551 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3553 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3554 setup_coding_system (coding_system
, &coding
);
3555 /* Ensure we set Vlast_coding_system_used. */
3556 set_coding_system
= 1;
3560 /* Decide the coding system to use for reading the file now
3561 because we can't use an optimized method for handling
3562 `coding:' tag if the current buffer is not empty. */
3563 if (!NILP (Vcoding_system_for_read
))
3564 coding_system
= Vcoding_system_for_read
;
3567 /* Don't try looking inside a file for a coding system
3568 specification if it is not seekable. */
3569 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3571 /* Find a coding system specified in the heading two
3572 lines or in the tailing several lines of the file.
3573 We assume that the 1K-byte and 3K-byte for heading
3574 and tailing respectively are sufficient for this
3578 if (st
.st_size
<= (1024 * 4))
3579 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3582 nread
= emacs_read (fd
, read_buf
, 1024);
3586 if (lseek (fd
, - (1024 * 3), SEEK_END
) < 0)
3587 report_file_error ("Setting file position",
3589 ntail
= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3590 nread
= ntail
< 0 ? ntail
: nread
+ ntail
;
3595 report_file_error ("Read error", orig_filename
);
3598 struct buffer
*prev
= current_buffer
;
3599 Lisp_Object workbuf
;
3602 record_unwind_current_buffer ();
3604 workbuf
= Fget_buffer_create (build_string (" *code-converting-work*"));
3605 buf
= XBUFFER (workbuf
);
3607 delete_all_overlays (buf
);
3608 bset_directory (buf
, BVAR (current_buffer
, directory
));
3609 bset_read_only (buf
, Qnil
);
3610 bset_filename (buf
, Qnil
);
3611 bset_undo_list (buf
, Qt
);
3612 eassert (buf
->overlays_before
== NULL
);
3613 eassert (buf
->overlays_after
== NULL
);
3615 set_buffer_internal (buf
);
3617 bset_enable_multibyte_characters (buf
, Qnil
);
3619 insert_1_both ((char *) read_buf
, nread
, nread
, 0, 0, 0);
3620 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3621 coding_system
= call2 (Vset_auto_coding_function
,
3622 filename
, make_number (nread
));
3623 set_buffer_internal (prev
);
3625 /* Discard the unwind protect for recovering the
3629 /* Rewind the file for the actual read done later. */
3630 if (lseek (fd
, 0, SEEK_SET
) < 0)
3631 report_file_error ("Setting file position", orig_filename
);
3635 if (NILP (coding_system
))
3637 /* If we have not yet decided a coding system, check
3638 file-coding-system-alist. */
3639 Lisp_Object args
[6];
3641 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3642 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3643 coding_system
= Ffind_operation_coding_system (6, args
);
3644 if (CONSP (coding_system
))
3645 coding_system
= XCAR (coding_system
);
3649 if (NILP (coding_system
))
3650 coding_system
= Qundecided
;
3652 CHECK_CODING_SYSTEM (coding_system
);
3654 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3655 /* We must suppress all character code conversion except for
3656 end-of-line conversion. */
3657 coding_system
= raw_text_coding_system (coding_system
);
3659 setup_coding_system (coding_system
, &coding
);
3660 /* Ensure we set Vlast_coding_system_used. */
3661 set_coding_system
= 1;
3664 /* If requested, replace the accessible part of the buffer
3665 with the file contents. Avoid replacing text at the
3666 beginning or end of the buffer that matches the file contents;
3667 that preserves markers pointing to the unchanged parts.
3669 Here we implement this feature in an optimized way
3670 for the case where code conversion is NOT needed.
3671 The following if-statement handles the case of conversion
3672 in a less optimal way.
3674 If the code conversion is "automatic" then we try using this
3675 method and hope for the best.
3676 But if we discover the need for conversion, we give up on this method
3677 and let the following if-statement handle the replace job. */
3680 && (NILP (coding_system
)
3681 || ! CODING_REQUIRE_DECODING (&coding
)))
3683 /* same_at_start and same_at_end count bytes,
3684 because file access counts bytes
3685 and BEG and END count bytes. */
3686 ptrdiff_t same_at_start
= BEGV_BYTE
;
3687 ptrdiff_t same_at_end
= ZV_BYTE
;
3689 /* There is still a possibility we will find the need to do code
3690 conversion. If that happens, set this variable to
3691 give up on handling REPLACE in the optimized way. */
3692 bool giveup_match_end
= 0;
3694 if (beg_offset
!= 0)
3696 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
3697 report_file_error ("Setting file position", orig_filename
);
3702 /* Count how many chars at the start of the file
3703 match the text at the beginning of the buffer. */
3708 nread
= emacs_read (fd
, read_buf
, sizeof read_buf
);
3710 report_file_error ("Read error", orig_filename
);
3711 else if (nread
== 0)
3714 if (CODING_REQUIRE_DETECTION (&coding
))
3716 coding_system
= detect_coding_system ((unsigned char *) read_buf
,
3719 setup_coding_system (coding_system
, &coding
);
3722 if (CODING_REQUIRE_DECODING (&coding
))
3723 /* We found that the file should be decoded somehow.
3724 Let's give up here. */
3726 giveup_match_end
= 1;
3731 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3732 && FETCH_BYTE (same_at_start
) == read_buf
[bufpos
])
3733 same_at_start
++, bufpos
++;
3734 /* If we found a discrepancy, stop the scan.
3735 Otherwise loop around and scan the next bufferful. */
3736 if (bufpos
!= nread
)
3740 /* If the file matches the buffer completely,
3741 there's no need to replace anything. */
3742 if (same_at_start
- BEGV_BYTE
== end_offset
- beg_offset
)
3745 clear_unwind_protect (fd_index
);
3747 /* Truncate the buffer to the size of the file. */
3748 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3753 /* Count how many chars at the end of the file
3754 match the text at the end of the buffer. But, if we have
3755 already found that decoding is necessary, don't waste time. */
3756 while (!giveup_match_end
)
3758 int total_read
, nread
, bufpos
, trial
;
3761 /* At what file position are we now scanning? */
3762 curpos
= end_offset
- (ZV_BYTE
- same_at_end
);
3763 /* If the entire file matches the buffer tail, stop the scan. */
3766 /* How much can we scan in the next step? */
3767 trial
= min (curpos
, sizeof read_buf
);
3768 if (lseek (fd
, curpos
- trial
, SEEK_SET
) < 0)
3769 report_file_error ("Setting file position", orig_filename
);
3771 total_read
= nread
= 0;
3772 while (total_read
< trial
)
3774 nread
= emacs_read (fd
, read_buf
+ total_read
, trial
- total_read
);
3776 report_file_error ("Read error", orig_filename
);
3777 else if (nread
== 0)
3779 total_read
+= nread
;
3782 /* Scan this bufferful from the end, comparing with
3783 the Emacs buffer. */
3784 bufpos
= total_read
;
3786 /* Compare with same_at_start to avoid counting some buffer text
3787 as matching both at the file's beginning and at the end. */
3788 while (bufpos
> 0 && same_at_end
> same_at_start
3789 && FETCH_BYTE (same_at_end
- 1) == read_buf
[bufpos
- 1])
3790 same_at_end
--, bufpos
--;
3792 /* If we found a discrepancy, stop the scan.
3793 Otherwise loop around and scan the preceding bufferful. */
3796 /* If this discrepancy is because of code conversion,
3797 we cannot use this method; giveup and try the other. */
3798 if (same_at_end
> same_at_start
3799 && FETCH_BYTE (same_at_end
- 1) >= 0200
3800 && ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3801 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3802 giveup_match_end
= 1;
3811 if (! giveup_match_end
)
3815 /* We win! We can handle REPLACE the optimized way. */
3817 /* Extend the start of non-matching text area to multibyte
3818 character boundary. */
3819 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3820 while (same_at_start
> BEGV_BYTE
3821 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3824 /* Extend the end of non-matching text area to multibyte
3825 character boundary. */
3826 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3827 while (same_at_end
< ZV_BYTE
3828 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3831 /* Don't try to reuse the same piece of text twice. */
3832 overlap
= (same_at_start
- BEGV_BYTE
3834 + (! NILP (end
) ? end_offset
: st
.st_size
) - ZV_BYTE
));
3836 same_at_end
+= overlap
;
3838 /* Arrange to read only the nonmatching middle part of the file. */
3839 beg_offset
+= same_at_start
- BEGV_BYTE
;
3840 end_offset
-= ZV_BYTE
- same_at_end
;
3842 invalidate_buffer_caches (current_buffer
,
3843 BYTE_TO_CHAR (same_at_start
),
3844 BYTE_TO_CHAR (same_at_end
));
3845 del_range_byte (same_at_start
, same_at_end
, 0);
3846 /* Insert from the file at the proper position. */
3847 temp
= BYTE_TO_CHAR (same_at_start
);
3848 SET_PT_BOTH (temp
, same_at_start
);
3850 /* If display currently starts at beginning of line,
3851 keep it that way. */
3852 if (XBUFFER (XWINDOW (selected_window
)->contents
) == current_buffer
)
3853 XWINDOW (selected_window
)->start_at_line_beg
= !NILP (Fbolp ());
3855 replace_handled
= 1;
3859 /* If requested, replace the accessible part of the buffer
3860 with the file contents. Avoid replacing text at the
3861 beginning or end of the buffer that matches the file contents;
3862 that preserves markers pointing to the unchanged parts.
3864 Here we implement this feature for the case where code conversion
3865 is needed, in a simple way that needs a lot of memory.
3866 The preceding if-statement handles the case of no conversion
3867 in a more optimized way. */
3868 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3870 ptrdiff_t same_at_start
= BEGV_BYTE
;
3871 ptrdiff_t same_at_end
= ZV_BYTE
;
3872 ptrdiff_t same_at_start_charpos
;
3873 ptrdiff_t inserted_chars
;
3876 unsigned char *decoded
;
3879 ptrdiff_t this_count
= SPECPDL_INDEX ();
3881 = ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
3882 Lisp_Object conversion_buffer
;
3883 struct gcpro gcpro1
;
3885 conversion_buffer
= code_conversion_save (1, multibyte
);
3887 /* First read the whole file, performing code conversion into
3888 CONVERSION_BUFFER. */
3890 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
3891 report_file_error ("Setting file position", orig_filename
);
3893 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3894 unprocessed
= 0; /* Bytes not processed in previous loop. */
3896 GCPRO1 (conversion_buffer
);
3899 /* Read at most READ_BUF_SIZE bytes at a time, to allow
3900 quitting while reading a huge file. */
3902 /* Allow quitting out of the actual I/O. */
3905 this = emacs_read (fd
, read_buf
+ unprocessed
,
3906 READ_BUF_SIZE
- unprocessed
);
3912 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
3913 BUF_Z (XBUFFER (conversion_buffer
)));
3914 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3915 unprocessed
+ this, conversion_buffer
);
3916 unprocessed
= coding
.carryover_bytes
;
3917 if (coding
.carryover_bytes
> 0)
3918 memcpy (read_buf
, coding
.carryover
, unprocessed
);
3922 report_file_error ("Read error", orig_filename
);
3924 clear_unwind_protect (fd_index
);
3926 if (unprocessed
> 0)
3928 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3929 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3930 unprocessed
, conversion_buffer
);
3931 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
3934 coding_system
= CODING_ID_NAME (coding
.id
);
3935 set_coding_system
= 1;
3936 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
3937 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
3938 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3940 /* Compare the beginning of the converted string with the buffer
3944 while (bufpos
< inserted
&& same_at_start
< same_at_end
3945 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
3946 same_at_start
++, bufpos
++;
3948 /* If the file matches the head of buffer completely,
3949 there's no need to replace anything. */
3951 if (bufpos
== inserted
)
3953 /* Truncate the buffer to the size of the file. */
3954 if (same_at_start
!= same_at_end
)
3956 invalidate_buffer_caches (current_buffer
,
3957 BYTE_TO_CHAR (same_at_start
),
3958 BYTE_TO_CHAR (same_at_end
));
3959 del_range_byte (same_at_start
, same_at_end
, 0);
3963 unbind_to (this_count
, Qnil
);
3967 /* Extend the start of non-matching text area to the previous
3968 multibyte character boundary. */
3969 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3970 while (same_at_start
> BEGV_BYTE
3971 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3974 /* Scan this bufferful from the end, comparing with
3975 the Emacs buffer. */
3978 /* Compare with same_at_start to avoid counting some buffer text
3979 as matching both at the file's beginning and at the end. */
3980 while (bufpos
> 0 && same_at_end
> same_at_start
3981 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
3982 same_at_end
--, bufpos
--;
3984 /* Extend the end of non-matching text area to the next
3985 multibyte character boundary. */
3986 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3987 while (same_at_end
< ZV_BYTE
3988 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3991 /* Don't try to reuse the same piece of text twice. */
3992 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3994 same_at_end
+= overlap
;
3996 /* If display currently starts at beginning of line,
3997 keep it that way. */
3998 if (XBUFFER (XWINDOW (selected_window
)->contents
) == current_buffer
)
3999 XWINDOW (selected_window
)->start_at_line_beg
= !NILP (Fbolp ());
4001 /* Replace the chars that we need to replace,
4002 and update INSERTED to equal the number of bytes
4003 we are taking from the decoded string. */
4004 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4006 if (same_at_end
!= same_at_start
)
4008 invalidate_buffer_caches (current_buffer
,
4009 BYTE_TO_CHAR (same_at_start
),
4010 BYTE_TO_CHAR (same_at_end
));
4011 del_range_byte (same_at_start
, same_at_end
, 0);
4013 eassert (same_at_start
== GPT_BYTE
);
4014 same_at_start
= GPT_BYTE
;
4018 temp
= BYTE_TO_CHAR (same_at_start
);
4020 /* Insert from the file at the proper position. */
4021 SET_PT_BOTH (temp
, same_at_start
);
4022 same_at_start_charpos
4023 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4024 same_at_start
- BEGV_BYTE
4025 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4026 eassert (same_at_start_charpos
== temp
- (BEGV
- BEG
));
4028 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4029 same_at_start
+ inserted
- BEGV_BYTE
4030 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
4031 - same_at_start_charpos
);
4032 /* This binding is to avoid ask-user-about-supersession-threat
4033 being called in insert_from_buffer (via in
4034 prepare_to_modify_buffer). */
4035 specbind (intern ("buffer-file-name"), Qnil
);
4036 insert_from_buffer (XBUFFER (conversion_buffer
),
4037 same_at_start_charpos
, inserted_chars
, 0);
4038 /* Set `inserted' to the number of inserted characters. */
4039 inserted
= PT
- temp
;
4040 /* Set point before the inserted characters. */
4041 SET_PT_BOTH (temp
, same_at_start
);
4043 unbind_to (this_count
, Qnil
);
4049 total
= end_offset
- beg_offset
;
4051 /* For a special file, all we can do is guess. */
4052 total
= READ_BUF_SIZE
;
4054 if (NILP (visit
) && total
> 0)
4056 #ifdef CLASH_DETECTION
4057 if (!NILP (BVAR (current_buffer
, file_truename
))
4058 /* Make binding buffer-file-name to nil effective. */
4059 && !NILP (BVAR (current_buffer
, filename
))
4060 && SAVE_MODIFF
>= MODIFF
)
4062 #endif /* CLASH_DETECTION */
4063 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4066 move_gap_both (PT
, PT_BYTE
);
4067 if (GAP_SIZE
< total
)
4068 make_gap (total
- GAP_SIZE
);
4070 if (beg_offset
!= 0 || !NILP (replace
))
4072 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
4073 report_file_error ("Setting file position", orig_filename
);
4076 /* In the following loop, HOW_MUCH contains the total bytes read so
4077 far for a regular file, and not changed for a special file. But,
4078 before exiting the loop, it is set to a negative value if I/O
4082 /* Total bytes inserted. */
4085 /* Here, we don't do code conversion in the loop. It is done by
4086 decode_coding_gap after all data are read into the buffer. */
4088 ptrdiff_t gap_size
= GAP_SIZE
;
4090 while (how_much
< total
)
4092 /* try is reserved in some compilers (Microsoft C) */
4093 ptrdiff_t trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4100 /* Maybe make more room. */
4101 if (gap_size
< trytry
)
4103 make_gap (trytry
- gap_size
);
4104 gap_size
= GAP_SIZE
- inserted
;
4107 /* Read from the file, capturing `quit'. When an
4108 error occurs, end the loop, and arrange for a quit
4109 to be signaled after decoding the text we read. */
4110 nbytes
= internal_condition_case_1
4112 make_save_int_int_int (fd
, inserted
, trytry
),
4113 Qerror
, read_non_regular_quit
);
4121 this = XINT (nbytes
);
4125 /* Allow quitting out of the actual I/O. We don't make text
4126 part of the buffer until all the reading is done, so a C-g
4127 here doesn't do any harm. */
4130 this = emacs_read (fd
,
4131 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
4145 /* For a regular file, where TOTAL is the real size,
4146 count HOW_MUCH to compare with it.
4147 For a special file, where TOTAL is just a buffer size,
4148 so don't bother counting in HOW_MUCH.
4149 (INSERTED is where we count the number of characters inserted.) */
4156 /* Now we have either read all the file data into the gap,
4157 or stop reading on I/O error or quit. If nothing was
4158 read, undo marking the buffer modified. */
4162 #ifdef CLASH_DETECTION
4164 unlock_file (BVAR (current_buffer
, file_truename
));
4166 Vdeactivate_mark
= old_Vdeactivate_mark
;
4169 Vdeactivate_mark
= Qt
;
4172 clear_unwind_protect (fd_index
);
4175 report_file_error ("Read error", orig_filename
);
4177 /* Make the text read part of the buffer. */
4178 GAP_SIZE
-= inserted
;
4180 GPT_BYTE
+= inserted
;
4182 ZV_BYTE
+= inserted
;
4187 /* Put an anchor to ensure multi-byte form ends at gap. */
4192 if (NILP (coding_system
))
4194 /* The coding system is not yet decided. Decide it by an
4195 optimized method for handling `coding:' tag.
4197 Note that we can get here only if the buffer was empty
4198 before the insertion. */
4200 if (!NILP (Vcoding_system_for_read
))
4201 coding_system
= Vcoding_system_for_read
;
4204 /* Since we are sure that the current buffer was empty
4205 before the insertion, we can toggle
4206 enable-multibyte-characters directly here without taking
4207 care of marker adjustment. By this way, we can run Lisp
4208 program safely before decoding the inserted text. */
4209 Lisp_Object unwind_data
;
4210 ptrdiff_t count1
= SPECPDL_INDEX ();
4212 unwind_data
= Fcons (BVAR (current_buffer
, enable_multibyte_characters
),
4213 Fcons (BVAR (current_buffer
, undo_list
),
4214 Fcurrent_buffer ()));
4215 bset_enable_multibyte_characters (current_buffer
, Qnil
);
4216 bset_undo_list (current_buffer
, Qt
);
4217 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4219 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4221 coding_system
= call2 (Vset_auto_coding_function
,
4222 filename
, make_number (inserted
));
4225 if (NILP (coding_system
))
4227 /* If the coding system is not yet decided, check
4228 file-coding-system-alist. */
4229 Lisp_Object args
[6];
4231 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4232 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4233 coding_system
= Ffind_operation_coding_system (6, args
);
4234 if (CONSP (coding_system
))
4235 coding_system
= XCAR (coding_system
);
4237 unbind_to (count1
, Qnil
);
4238 inserted
= Z_BYTE
- BEG_BYTE
;
4241 if (NILP (coding_system
))
4242 coding_system
= Qundecided
;
4244 CHECK_CODING_SYSTEM (coding_system
);
4246 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4247 /* We must suppress all character code conversion except for
4248 end-of-line conversion. */
4249 coding_system
= raw_text_coding_system (coding_system
);
4250 setup_coding_system (coding_system
, &coding
);
4251 /* Ensure we set Vlast_coding_system_used. */
4252 set_coding_system
= 1;
4257 /* When we visit a file by raw-text, we change the buffer to
4259 if (CODING_FOR_UNIBYTE (&coding
)
4260 /* Can't do this if part of the buffer might be preserved. */
4262 /* Visiting a file with these coding system makes the buffer
4264 bset_enable_multibyte_characters (current_buffer
, Qnil
);
4267 coding
.dst_multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
4268 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4269 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4271 move_gap_both (PT
, PT_BYTE
);
4272 GAP_SIZE
+= inserted
;
4273 ZV_BYTE
-= inserted
;
4277 decode_coding_gap (&coding
, inserted
, inserted
);
4278 inserted
= coding
.produced_char
;
4279 coding_system
= CODING_ID_NAME (coding
.id
);
4281 else if (inserted
> 0)
4282 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4285 /* Call after-change hooks for the inserted text, aside from the case
4286 of normal visiting (not with REPLACE), which is done in a new buffer
4287 "before" the buffer is changed. */
4288 if (inserted
> 0 && total
> 0
4289 && (NILP (visit
) || !NILP (replace
)))
4291 signal_after_change (PT
, 0, inserted
);
4292 update_compositions (PT
, PT
, CHECK_BORDER
);
4295 /* Now INSERTED is measured in characters. */
4301 if (empty_undo_list_p
)
4302 bset_undo_list (current_buffer
, Qnil
);
4306 current_buffer
->modtime
= mtime
;
4307 current_buffer
->modtime_size
= st
.st_size
;
4308 bset_filename (current_buffer
, orig_filename
);
4311 SAVE_MODIFF
= MODIFF
;
4312 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
4313 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4314 #ifdef CLASH_DETECTION
4317 if (!NILP (BVAR (current_buffer
, file_truename
)))
4318 unlock_file (BVAR (current_buffer
, file_truename
));
4319 unlock_file (filename
);
4321 #endif /* CLASH_DETECTION */
4323 xsignal2 (Qfile_error
,
4324 build_string ("not a regular file"), orig_filename
);
4327 if (set_coding_system
)
4328 Vlast_coding_system_used
= coding_system
;
4330 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4332 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4334 if (! NILP (insval
))
4336 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4337 wrong_type_argument (intern ("inserted-chars"), insval
);
4338 inserted
= XFASTINT (insval
);
4342 /* Decode file format. */
4345 /* Don't run point motion or modification hooks when decoding. */
4346 ptrdiff_t count1
= SPECPDL_INDEX ();
4347 ptrdiff_t old_inserted
= inserted
;
4348 specbind (Qinhibit_point_motion_hooks
, Qt
);
4349 specbind (Qinhibit_modification_hooks
, Qt
);
4351 /* Save old undo list and don't record undo for decoding. */
4352 old_undo
= BVAR (current_buffer
, undo_list
);
4353 bset_undo_list (current_buffer
, Qt
);
4357 insval
= call3 (Qformat_decode
,
4358 Qnil
, make_number (inserted
), visit
);
4359 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4360 wrong_type_argument (intern ("inserted-chars"), insval
);
4361 inserted
= XFASTINT (insval
);
4365 /* If REPLACE is non-nil and we succeeded in not replacing the
4366 beginning or end of the buffer text with the file's contents,
4367 call format-decode with `point' positioned at the beginning
4368 of the buffer and `inserted' equaling the number of
4369 characters in the buffer. Otherwise, format-decode might
4370 fail to correctly analyze the beginning or end of the buffer.
4371 Hence we temporarily save `point' and `inserted' here and
4372 restore `point' iff format-decode did not insert or delete
4373 any text. Otherwise we leave `point' at point-min. */
4374 ptrdiff_t opoint
= PT
;
4375 ptrdiff_t opoint_byte
= PT_BYTE
;
4376 ptrdiff_t oinserted
= ZV
- BEGV
;
4377 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4379 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4380 insval
= call3 (Qformat_decode
,
4381 Qnil
, make_number (oinserted
), visit
);
4382 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4383 wrong_type_argument (intern ("inserted-chars"), insval
);
4384 if (ochars_modiff
== CHARS_MODIFF
)
4385 /* format_decode didn't modify buffer's characters => move
4386 point back to position before inserted text and leave
4387 value of inserted alone. */
4388 SET_PT_BOTH (opoint
, opoint_byte
);
4390 /* format_decode modified buffer's characters => consider
4391 entire buffer changed and leave point at point-min. */
4392 inserted
= XFASTINT (insval
);
4395 /* For consistency with format-decode call these now iff inserted > 0
4396 (martin 2007-06-28). */
4397 p
= Vafter_insert_file_functions
;
4402 insval
= call1 (XCAR (p
), make_number (inserted
));
4405 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4406 wrong_type_argument (intern ("inserted-chars"), insval
);
4407 inserted
= XFASTINT (insval
);
4412 /* For the rationale of this see the comment on
4413 format-decode above. */
4414 ptrdiff_t opoint
= PT
;
4415 ptrdiff_t opoint_byte
= PT_BYTE
;
4416 ptrdiff_t oinserted
= ZV
- BEGV
;
4417 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4419 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4420 insval
= call1 (XCAR (p
), make_number (oinserted
));
4423 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4424 wrong_type_argument (intern ("inserted-chars"), insval
);
4425 if (ochars_modiff
== CHARS_MODIFF
)
4426 /* after_insert_file_functions didn't modify
4427 buffer's characters => move point back to
4428 position before inserted text and leave value of
4430 SET_PT_BOTH (opoint
, opoint_byte
);
4432 /* after_insert_file_functions did modify buffer's
4433 characters => consider entire buffer changed and
4434 leave point at point-min. */
4435 inserted
= XFASTINT (insval
);
4443 if (!empty_undo_list_p
)
4445 bset_undo_list (current_buffer
, old_undo
);
4446 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4448 /* Adjust the last undo record for the size change during
4449 the format conversion. */
4450 Lisp_Object tem
= XCAR (old_undo
);
4451 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4452 && INTEGERP (XCDR (tem
))
4453 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4454 XSETCDR (tem
, make_number (PT
+ inserted
));
4458 /* If undo_list was Qt before, keep it that way.
4459 Otherwise start with an empty undo_list. */
4460 bset_undo_list (current_buffer
, EQ (old_undo
, Qt
) ? Qt
: Qnil
);
4462 unbind_to (count1
, Qnil
);
4466 && current_buffer
->modtime
.tv_nsec
== NONEXISTENT_MODTIME_NSECS
)
4468 /* If visiting nonexistent file, return nil. */
4469 report_file_errno ("Opening input file", orig_filename
, save_errno
);
4472 /* We made a lot of deletions and insertions above, so invalidate
4473 the newline cache for the entire region of the inserted
4475 if (current_buffer
->newline_cache
)
4476 invalidate_region_cache (current_buffer
,
4477 current_buffer
->newline_cache
,
4478 PT
- BEG
, Z
- PT
- inserted
);
4481 Fsignal (Qquit
, Qnil
);
4483 /* Retval needs to be dealt with in all cases consistently. */
4485 val
= list2 (orig_filename
, make_number (inserted
));
4487 RETURN_UNGCPRO (unbind_to (count
, val
));
4490 static Lisp_Object
build_annotations (Lisp_Object
, Lisp_Object
);
4493 build_annotations_unwind (Lisp_Object arg
)
4495 Vwrite_region_annotation_buffers
= arg
;
4498 /* Decide the coding-system to encode the data with. */
4500 DEFUN ("choose-write-coding-system", Fchoose_write_coding_system
,
4501 Schoose_write_coding_system
, 3, 6, 0,
4502 doc
: /* Choose the coding system for writing a file.
4503 Arguments are as for `write-region'.
4504 This function is for internal use only. It may prompt the user. */ )
4505 (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4506 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
)
4509 Lisp_Object eol_parent
= Qnil
;
4511 /* Mimic write-region behavior. */
4514 XSETFASTINT (start
, BEGV
);
4515 XSETFASTINT (end
, ZV
);
4519 && NILP (Fstring_equal (BVAR (current_buffer
, filename
),
4520 BVAR (current_buffer
, auto_save_file_name
))))
4525 else if (!NILP (Vcoding_system_for_write
))
4527 val
= Vcoding_system_for_write
;
4528 if (coding_system_require_warning
4529 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4530 /* Confirm that VAL can surely encode the current region. */
4531 val
= call5 (Vselect_safe_coding_system_function
,
4532 start
, end
, list2 (Qt
, val
),
4537 /* If the variable `buffer-file-coding-system' is set locally,
4538 it means that the file was read with some kind of code
4539 conversion or the variable is explicitly set by users. We
4540 had better write it out with the same coding system even if
4541 `enable-multibyte-characters' is nil.
4543 If it is not set locally, we anyway have to convert EOL
4544 format if the default value of `buffer-file-coding-system'
4545 tells that it is not Unix-like (LF only) format. */
4546 bool using_default_coding
= 0;
4547 bool force_raw_text
= 0;
4549 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4551 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4554 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4560 /* Check file-coding-system-alist. */
4561 Lisp_Object args
[7], coding_systems
;
4563 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4564 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4566 coding_systems
= Ffind_operation_coding_system (7, args
);
4567 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4568 val
= XCDR (coding_systems
);
4573 /* If we still have not decided a coding system, use the
4574 default value of buffer-file-coding-system. */
4575 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4576 using_default_coding
= 1;
4579 if (! NILP (val
) && ! force_raw_text
)
4581 Lisp_Object spec
, attrs
;
4583 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4584 attrs
= AREF (spec
, 0);
4585 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4590 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4591 /* Confirm that VAL can surely encode the current region. */
4592 val
= call5 (Vselect_safe_coding_system_function
,
4593 start
, end
, val
, Qnil
, filename
);
4595 /* If the decided coding-system doesn't specify end-of-line
4596 format, we use that of
4597 `default-buffer-file-coding-system'. */
4598 if (! using_default_coding
4599 && ! NILP (BVAR (&buffer_defaults
, buffer_file_coding_system
)))
4600 val
= (coding_inherit_eol_type
4601 (val
, BVAR (&buffer_defaults
, buffer_file_coding_system
)));
4603 /* If we decide not to encode text, use `raw-text' or one of its
4606 val
= raw_text_coding_system (val
);
4609 val
= coding_inherit_eol_type (val
, eol_parent
);
4613 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4614 "r\nFWrite region to file: \ni\ni\ni\np",
4615 doc
: /* Write current region into specified file.
4616 When called from a program, requires three arguments:
4617 START, END and FILENAME. START and END are normally buffer positions
4618 specifying the part of the buffer to write.
4619 If START is nil, that means to use the entire buffer contents.
4620 If START is a string, then output that string to the file
4621 instead of any buffer contents; END is ignored.
4623 Optional fourth argument APPEND if non-nil means
4624 append to existing file contents (if any). If it is a number,
4625 seek to that offset in the file before writing.
4626 Optional fifth argument VISIT, if t or a string, means
4627 set the last-save-file-modtime of buffer to this file's modtime
4628 and mark buffer not modified.
4629 If VISIT is a string, it is a second file name;
4630 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4631 VISIT is also the file name to lock and unlock for clash detection.
4632 If VISIT is neither t nor nil nor a string,
4633 that means do not display the \"Wrote file\" message.
4634 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4635 use for locking and unlocking, overriding FILENAME and VISIT.
4636 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4637 for an existing file with the same name. If MUSTBENEW is `excl',
4638 that means to get an error if the file already exists; never overwrite.
4639 If MUSTBENEW is neither nil nor `excl', that means ask for
4640 confirmation before overwriting, but do go ahead and overwrite the file
4641 if the user confirms.
4643 This does code conversion according to the value of
4644 `coding-system-for-write', `buffer-file-coding-system', or
4645 `file-coding-system-alist', and sets the variable
4646 `last-coding-system-used' to the coding system actually used.
4648 This calls `write-region-annotate-functions' at the start, and
4649 `write-region-post-annotation-function' at the end. */)
4650 (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
, Lisp_Object append
,
4651 Lisp_Object visit
, Lisp_Object lockname
, Lisp_Object mustbenew
)
4653 return write_region (start
, end
, filename
, append
, visit
, lockname
, mustbenew
,
4657 /* Like Fwrite_region, except that if DESC is nonnegative, it is a file
4658 descriptor for FILENAME, so do not open or close FILENAME. */
4661 write_region (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4662 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
,
4663 Lisp_Object mustbenew
, int desc
)
4667 off_t offset
IF_LINT (= 0);
4668 bool open_and_close_file
= desc
< 0;
4673 struct timespec modtime
;
4674 ptrdiff_t count
= SPECPDL_INDEX ();
4675 ptrdiff_t count1
IF_LINT (= 0);
4676 Lisp_Object handler
;
4677 Lisp_Object visit_file
;
4678 Lisp_Object annotations
;
4679 Lisp_Object encoded_filename
;
4680 bool visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4681 bool quietly
= !NILP (visit
);
4682 bool file_locked
= 0;
4683 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4684 struct buffer
*given_buffer
;
4685 struct coding_system coding
;
4687 if (current_buffer
->base_buffer
&& visiting
)
4688 error ("Cannot do file visiting in an indirect buffer");
4690 if (!NILP (start
) && !STRINGP (start
))
4691 validate_region (&start
, &end
);
4694 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4696 filename
= Fexpand_file_name (filename
, Qnil
);
4698 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4699 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4701 if (STRINGP (visit
))
4702 visit_file
= Fexpand_file_name (visit
, Qnil
);
4704 visit_file
= filename
;
4706 if (NILP (lockname
))
4707 lockname
= visit_file
;
4711 /* If the file name has special constructs in it,
4712 call the corresponding file handler. */
4713 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4714 /* If FILENAME has no handler, see if VISIT has one. */
4715 if (NILP (handler
) && STRINGP (visit
))
4716 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4718 if (!NILP (handler
))
4721 val
= call6 (handler
, Qwrite_region
, start
, end
,
4722 filename
, append
, visit
);
4726 SAVE_MODIFF
= MODIFF
;
4727 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4728 bset_filename (current_buffer
, visit_file
);
4734 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4736 /* Special kludge to simplify auto-saving. */
4739 /* Do it later, so write-region-annotate-function can work differently
4740 if we save "the buffer" vs "a region".
4741 This is useful in tar-mode. --Stef
4742 XSETFASTINT (start, BEG);
4743 XSETFASTINT (end, Z); */
4747 record_unwind_protect (build_annotations_unwind
,
4748 Vwrite_region_annotation_buffers
);
4749 Vwrite_region_annotation_buffers
= list1 (Fcurrent_buffer ());
4751 given_buffer
= current_buffer
;
4753 if (!STRINGP (start
))
4755 annotations
= build_annotations (start
, end
);
4757 if (current_buffer
!= given_buffer
)
4759 XSETFASTINT (start
, BEGV
);
4760 XSETFASTINT (end
, ZV
);
4766 XSETFASTINT (start
, BEGV
);
4767 XSETFASTINT (end
, ZV
);
4772 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4774 /* Decide the coding-system to encode the data with.
4775 We used to make this choice before calling build_annotations, but that
4776 leads to problems when a write-annotate-function takes care of
4777 unsavable chars (as was the case with X-Symbol). */
4778 Vlast_coding_system_used
=
4779 Fchoose_write_coding_system (start
, end
, filename
,
4780 append
, visit
, lockname
);
4782 setup_coding_system (Vlast_coding_system_used
, &coding
);
4784 if (!STRINGP (start
) && !NILP (BVAR (current_buffer
, selective_display
)))
4785 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4787 #ifdef CLASH_DETECTION
4788 if (open_and_close_file
&& !auto_saving
)
4790 lock_file (lockname
);
4793 #endif /* CLASH_DETECTION */
4795 encoded_filename
= ENCODE_FILE (filename
);
4796 fn
= SSDATA (encoded_filename
);
4797 open_flags
= O_WRONLY
| O_BINARY
| O_CREAT
;
4798 open_flags
|= EQ (mustbenew
, Qexcl
) ? O_EXCL
: !NILP (append
) ? 0 : O_TRUNC
;
4799 if (NUMBERP (append
))
4800 offset
= file_offset (append
);
4801 else if (!NILP (append
))
4802 open_flags
|= O_APPEND
;
4804 mode
= S_IREAD
| S_IWRITE
;
4806 mode
= auto_saving
? auto_save_mode_bits
: 0666;
4809 if (open_and_close_file
)
4811 desc
= emacs_open (fn
, open_flags
, mode
);
4814 int open_errno
= errno
;
4815 #ifdef CLASH_DETECTION
4817 unlock_file (lockname
);
4818 #endif /* CLASH_DETECTION */
4820 report_file_errno ("Opening output file", filename
, open_errno
);
4823 count1
= SPECPDL_INDEX ();
4824 record_unwind_protect_int (close_file_unwind
, desc
);
4827 if (NUMBERP (append
))
4829 off_t ret
= lseek (desc
, offset
, SEEK_SET
);
4832 int lseek_errno
= errno
;
4833 #ifdef CLASH_DETECTION
4835 unlock_file (lockname
);
4836 #endif /* CLASH_DETECTION */
4838 report_file_errno ("Lseek error", filename
, lseek_errno
);
4846 if (STRINGP (start
))
4847 ok
= a_write (desc
, start
, 0, SCHARS (start
), &annotations
, &coding
);
4848 else if (XINT (start
) != XINT (end
))
4849 ok
= a_write (desc
, Qnil
, XINT (start
), XINT (end
) - XINT (start
),
4850 &annotations
, &coding
);
4853 /* If file was empty, still need to write the annotations. */
4854 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4855 ok
= a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4859 if (ok
&& CODING_REQUIRE_FLUSHING (&coding
)
4860 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
))
4862 /* We have to flush out a data. */
4863 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4864 ok
= e_write (desc
, Qnil
, 1, 1, &coding
);
4870 /* fsync is not crucial for temporary files. Nor for auto-save
4871 files, since they might lose some work anyway. */
4872 if (open_and_close_file
&& !auto_saving
&& !write_region_inhibit_fsync
)
4874 /* Transfer data and metadata to disk, retrying if interrupted.
4875 fsync can report a write failure here, e.g., due to disk full
4876 under NFS. But ignore EINVAL, which means fsync is not
4877 supported on this file. */
4878 while (fsync (desc
) != 0)
4881 if (errno
!= EINVAL
)
4882 ok
= 0, save_errno
= errno
;
4887 modtime
= invalid_timespec ();
4890 if (fstat (desc
, &st
) == 0)
4891 modtime
= get_stat_mtime (&st
);
4893 ok
= 0, save_errno
= errno
;
4896 if (open_and_close_file
)
4898 /* NFS can report a write failure now. */
4899 if (emacs_close (desc
) < 0)
4900 ok
= 0, save_errno
= errno
;
4902 /* Discard the unwind protect for close_file_unwind. */
4903 specpdl_ptr
= specpdl
+ count1
;
4906 /* Some file systems have a bug where st_mtime is not updated
4907 properly after a write. For example, CIFS might not see the
4908 st_mtime change until after the file is opened again.
4910 Attempt to detect this file system bug, and update MODTIME to the
4911 newer st_mtime if the bug appears to be present. This introduces
4912 a race condition, so to avoid most instances of the race condition
4913 on non-buggy file systems, skip this check if the most recently
4914 encountered non-buggy file system was the current file system.
4916 A race condition can occur if some other process modifies the
4917 file between the fstat above and the fstat below, but the race is
4918 unlikely and a similar race between the last write and the fstat
4919 above cannot possibly be closed anyway. */
4921 if (timespec_valid_p (modtime
)
4922 && ! (valid_timestamp_file_system
&& st
.st_dev
== timestamp_file_system
))
4924 int desc1
= emacs_open (fn
, O_WRONLY
| O_BINARY
, 0);
4928 if (fstat (desc1
, &st1
) == 0
4929 && st
.st_dev
== st1
.st_dev
&& st
.st_ino
== st1
.st_ino
)
4931 /* Use the heuristic if it appears to be valid. With neither
4932 O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the
4933 file, the time stamp won't change. Also, some non-POSIX
4934 systems don't update an empty file's time stamp when
4935 truncating it. Finally, file systems with 100 ns or worse
4936 resolution sometimes seem to have bugs: on a system with ns
4937 resolution, checking ns % 100 incorrectly avoids the heuristic
4938 1% of the time, but the problem should be temporary as we will
4939 try again on the next time stamp. */
4941 = ((open_flags
& (O_EXCL
| O_TRUNC
)) != 0
4943 && modtime
.tv_nsec
% 100 != 0);
4945 struct timespec modtime1
= get_stat_mtime (&st1
);
4947 && timespec_cmp (modtime
, modtime1
) == 0
4948 && st
.st_size
== st1
.st_size
)
4950 timestamp_file_system
= st
.st_dev
;
4951 valid_timestamp_file_system
= 1;
4955 st
.st_size
= st1
.st_size
;
4959 emacs_close (desc1
);
4963 /* Call write-region-post-annotation-function. */
4964 while (CONSP (Vwrite_region_annotation_buffers
))
4966 Lisp_Object buf
= XCAR (Vwrite_region_annotation_buffers
);
4967 if (!NILP (Fbuffer_live_p (buf
)))
4970 if (FUNCTIONP (Vwrite_region_post_annotation_function
))
4971 call0 (Vwrite_region_post_annotation_function
);
4973 Vwrite_region_annotation_buffers
4974 = XCDR (Vwrite_region_annotation_buffers
);
4977 unbind_to (count
, Qnil
);
4979 #ifdef CLASH_DETECTION
4981 unlock_file (lockname
);
4982 #endif /* CLASH_DETECTION */
4984 /* Do this before reporting IO error
4985 to avoid a "file has changed on disk" warning on
4986 next attempt to save. */
4987 if (timespec_valid_p (modtime
))
4989 current_buffer
->modtime
= modtime
;
4990 current_buffer
->modtime_size
= st
.st_size
;
4994 report_file_errno ("Write error", filename
, save_errno
);
4998 SAVE_MODIFF
= MODIFF
;
4999 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5000 bset_filename (current_buffer
, visit_file
);
5001 update_mode_lines
= 14;
5006 && ! NILP (Fstring_equal (BVAR (current_buffer
, filename
),
5007 BVAR (current_buffer
, auto_save_file_name
))))
5008 SAVE_MODIFF
= MODIFF
;
5014 message_with_string ((NUMBERP (append
)
5024 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5025 doc
: /* Return t if (car A) is numerically less than (car B). */)
5026 (Lisp_Object a
, Lisp_Object b
)
5028 Lisp_Object args
[2] = { Fcar (a
), Fcar (b
), };
5029 return Flss (2, args
);
5032 /* Build the complete list of annotations appropriate for writing out
5033 the text between START and END, by calling all the functions in
5034 write-region-annotate-functions and merging the lists they return.
5035 If one of these functions switches to a different buffer, we assume
5036 that buffer contains altered text. Therefore, the caller must
5037 make sure to restore the current buffer in all cases,
5038 as save-excursion would do. */
5041 build_annotations (Lisp_Object start
, Lisp_Object end
)
5043 Lisp_Object annotations
;
5045 struct gcpro gcpro1
, gcpro2
;
5046 Lisp_Object original_buffer
;
5048 bool used_global
= 0;
5050 XSETBUFFER (original_buffer
, current_buffer
);
5053 p
= Vwrite_region_annotate_functions
;
5054 GCPRO2 (annotations
, p
);
5057 struct buffer
*given_buffer
= current_buffer
;
5058 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5059 { /* Use the global value of the hook. */
5062 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5064 p
= Fappend (2, arg
);
5067 Vwrite_region_annotations_so_far
= annotations
;
5068 res
= call2 (XCAR (p
), start
, end
);
5069 /* If the function makes a different buffer current,
5070 assume that means this buffer contains altered text to be output.
5071 Reset START and END from the buffer bounds
5072 and discard all previous annotations because they should have
5073 been dealt with by this function. */
5074 if (current_buffer
!= given_buffer
)
5076 Vwrite_region_annotation_buffers
5077 = Fcons (Fcurrent_buffer (),
5078 Vwrite_region_annotation_buffers
);
5079 XSETFASTINT (start
, BEGV
);
5080 XSETFASTINT (end
, ZV
);
5083 Flength (res
); /* Check basic validity of return value */
5084 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5088 /* Now do the same for annotation functions implied by the file-format */
5089 if (auto_saving
&& (!EQ (BVAR (current_buffer
, auto_save_file_format
), Qt
)))
5090 p
= BVAR (current_buffer
, auto_save_file_format
);
5092 p
= BVAR (current_buffer
, file_format
);
5093 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5095 struct buffer
*given_buffer
= current_buffer
;
5097 Vwrite_region_annotations_so_far
= annotations
;
5099 /* Value is either a list of annotations or nil if the function
5100 has written annotations to a temporary buffer, which is now
5102 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5103 original_buffer
, make_number (i
));
5104 if (current_buffer
!= given_buffer
)
5106 XSETFASTINT (start
, BEGV
);
5107 XSETFASTINT (end
, ZV
);
5112 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5120 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5121 If STRING is nil, POS is the character position in the current buffer.
5122 Intersperse with them the annotations from *ANNOT
5123 which fall within the range of POS to POS + NCHARS,
5124 each at its appropriate position.
5126 We modify *ANNOT by discarding elements as we use them up.
5128 Return true if successful. */
5131 a_write (int desc
, Lisp_Object string
, ptrdiff_t pos
,
5132 ptrdiff_t nchars
, Lisp_Object
*annot
,
5133 struct coding_system
*coding
)
5137 ptrdiff_t lastpos
= pos
+ nchars
;
5139 while (NILP (*annot
) || CONSP (*annot
))
5141 tem
= Fcar_safe (Fcar (*annot
));
5144 nextpos
= XFASTINT (tem
);
5146 /* If there are no more annotations in this range,
5147 output the rest of the range all at once. */
5148 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5149 return e_write (desc
, string
, pos
, lastpos
, coding
);
5151 /* Output buffer text up to the next annotation's position. */
5154 if (!e_write (desc
, string
, pos
, nextpos
, coding
))
5158 /* Output the annotation. */
5159 tem
= Fcdr (Fcar (*annot
));
5162 if (!e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5165 *annot
= Fcdr (*annot
);
5170 /* Maximum number of characters that the next
5171 function encodes per one loop iteration. */
5173 enum { E_WRITE_MAX
= 8 * 1024 * 1024 };
5175 /* Write text in the range START and END into descriptor DESC,
5176 encoding them with coding system CODING. If STRING is nil, START
5177 and END are character positions of the current buffer, else they
5178 are indexes to the string STRING. Return true if successful. */
5181 e_write (int desc
, Lisp_Object string
, ptrdiff_t start
, ptrdiff_t end
,
5182 struct coding_system
*coding
)
5184 if (STRINGP (string
))
5187 end
= SCHARS (string
);
5190 /* We used to have a code for handling selective display here. But,
5191 now it is handled within encode_coding. */
5195 if (STRINGP (string
))
5197 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5198 if (CODING_REQUIRE_ENCODING (coding
))
5200 ptrdiff_t nchars
= min (end
- start
, E_WRITE_MAX
);
5202 /* Avoid creating huge Lisp string in encode_coding_object. */
5203 if (nchars
== E_WRITE_MAX
)
5204 coding
->raw_destination
= 1;
5206 encode_coding_object
5207 (coding
, string
, start
, string_char_to_byte (string
, start
),
5208 start
+ nchars
, string_char_to_byte (string
, start
+ nchars
),
5213 coding
->dst_object
= string
;
5214 coding
->consumed_char
= SCHARS (string
);
5215 coding
->produced
= SBYTES (string
);
5220 ptrdiff_t start_byte
= CHAR_TO_BYTE (start
);
5221 ptrdiff_t end_byte
= CHAR_TO_BYTE (end
);
5223 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5224 if (CODING_REQUIRE_ENCODING (coding
))
5226 ptrdiff_t nchars
= min (end
- start
, E_WRITE_MAX
);
5229 if (nchars
== E_WRITE_MAX
)
5230 coding
->raw_destination
= 1;
5232 encode_coding_object
5233 (coding
, Fcurrent_buffer (), start
, start_byte
,
5234 start
+ nchars
, CHAR_TO_BYTE (start
+ nchars
), Qt
);
5238 coding
->dst_object
= Qnil
;
5239 coding
->dst_pos_byte
= start_byte
;
5240 if (start
>= GPT
|| end
<= GPT
)
5242 coding
->consumed_char
= end
- start
;
5243 coding
->produced
= end_byte
- start_byte
;
5247 coding
->consumed_char
= GPT
- start
;
5248 coding
->produced
= GPT_BYTE
- start_byte
;
5253 if (coding
->produced
> 0)
5255 char *buf
= (coding
->raw_destination
? (char *) coding
->destination
5256 : (STRINGP (coding
->dst_object
)
5257 ? SSDATA (coding
->dst_object
)
5258 : (char *) BYTE_POS_ADDR (coding
->dst_pos_byte
)));
5259 coding
->produced
-= emacs_write_sig (desc
, buf
, coding
->produced
);
5261 if (coding
->raw_destination
)
5263 /* We're responsible for freeing this, see
5264 encode_coding_object to check why. */
5265 xfree (coding
->destination
);
5266 coding
->raw_destination
= 0;
5268 if (coding
->produced
)
5271 start
+= coding
->consumed_char
;
5277 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5278 Sverify_visited_file_modtime
, 0, 1, 0,
5279 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5280 This means that the file has not been changed since it was visited or saved.
5281 If BUF is omitted or nil, it defaults to the current buffer.
5282 See Info node `(elisp)Modification Time' for more details. */)
5287 Lisp_Object handler
;
5288 Lisp_Object filename
;
5289 struct timespec mtime
;
5299 if (!STRINGP (BVAR (b
, filename
))) return Qt
;
5300 if (b
->modtime
.tv_nsec
== UNKNOWN_MODTIME_NSECS
) return Qt
;
5302 /* If the file name has special constructs in it,
5303 call the corresponding file handler. */
5304 handler
= Ffind_file_name_handler (BVAR (b
, filename
),
5305 Qverify_visited_file_modtime
);
5306 if (!NILP (handler
))
5307 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5309 filename
= ENCODE_FILE (BVAR (b
, filename
));
5311 mtime
= (stat (SSDATA (filename
), &st
) == 0
5312 ? get_stat_mtime (&st
)
5313 : time_error_value (errno
));
5314 if (timespec_cmp (mtime
, b
->modtime
) == 0
5315 && (b
->modtime_size
< 0
5316 || st
.st_size
== b
->modtime_size
))
5321 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5322 Svisited_file_modtime
, 0, 0, 0,
5323 doc
: /* Return the current buffer's recorded visited file modification time.
5324 The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
5325 `file-attributes' returns. If the current buffer has no recorded file
5326 modification time, this function returns 0. If the visited file
5327 doesn't exist, return -1.
5328 See Info node `(elisp)Modification Time' for more details. */)
5331 int ns
= current_buffer
->modtime
.tv_nsec
;
5333 return make_number (UNKNOWN_MODTIME_NSECS
- ns
);
5334 return make_lisp_time (current_buffer
->modtime
);
5337 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5338 Sset_visited_file_modtime
, 0, 1, 0,
5339 doc
: /* Update buffer's recorded modification time from the visited file's time.
5340 Useful if the buffer was not read from the file normally
5341 or if the file itself has been changed for some known benign reason.
5342 An argument specifies the modification time value to use
5343 \(instead of that of the visited file), in the form of a list
5344 \(HIGH LOW USEC PSEC) or an integer flag as returned by
5345 `visited-file-modtime'. */)
5346 (Lisp_Object time_flag
)
5348 if (!NILP (time_flag
))
5350 struct timespec mtime
;
5351 if (INTEGERP (time_flag
))
5353 CHECK_RANGED_INTEGER (time_flag
, -1, 0);
5354 mtime
= make_timespec (0, UNKNOWN_MODTIME_NSECS
- XINT (time_flag
));
5357 mtime
= lisp_time_argument (time_flag
);
5359 current_buffer
->modtime
= mtime
;
5360 current_buffer
->modtime_size
= -1;
5364 register Lisp_Object filename
;
5366 Lisp_Object handler
;
5368 filename
= Fexpand_file_name (BVAR (current_buffer
, filename
), Qnil
);
5370 /* If the file name has special constructs in it,
5371 call the corresponding file handler. */
5372 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5373 if (!NILP (handler
))
5374 /* The handler can find the file name the same way we did. */
5375 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5377 filename
= ENCODE_FILE (filename
);
5379 if (stat (SSDATA (filename
), &st
) >= 0)
5381 current_buffer
->modtime
= get_stat_mtime (&st
);
5382 current_buffer
->modtime_size
= st
.st_size
;
5390 auto_save_error (Lisp_Object error_val
)
5392 Lisp_Object args
[3], msg
;
5394 struct gcpro gcpro1
;
5396 auto_save_error_occurred
= 1;
5398 ring_bell (XFRAME (selected_frame
));
5400 args
[0] = build_string ("Auto-saving %s: %s");
5401 args
[1] = BVAR (current_buffer
, name
);
5402 args
[2] = Ferror_message_string (error_val
);
5403 msg
= Fformat (3, args
);
5406 for (i
= 0; i
< 3; ++i
)
5411 message3_nolog (msg
);
5412 Fsleep_for (make_number (1), Qnil
);
5425 auto_save_mode_bits
= 0666;
5427 /* Get visited file's mode to become the auto save file's mode. */
5428 if (! NILP (BVAR (current_buffer
, filename
)))
5430 if (stat (SSDATA (BVAR (current_buffer
, filename
)), &st
) >= 0)
5431 /* But make sure we can overwrite it later! */
5432 auto_save_mode_bits
= (st
.st_mode
| 0600) & 0777;
5433 else if (modes
= Ffile_modes (BVAR (current_buffer
, filename
)),
5435 /* Remote files don't cooperate with stat. */
5436 auto_save_mode_bits
= (XINT (modes
) | 0600) & 0777;
5440 Fwrite_region (Qnil
, Qnil
, BVAR (current_buffer
, auto_save_file_name
), Qnil
,
5441 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5445 struct auto_save_unwind
5452 do_auto_save_unwind (void *arg
)
5454 struct auto_save_unwind
*p
= arg
;
5455 FILE *stream
= p
->stream
;
5456 minibuffer_auto_raise
= p
->auto_raise
;
5467 do_auto_save_make_dir (Lisp_Object dir
)
5471 auto_saving_dir_umask
= 077;
5472 result
= call2 (Qmake_directory
, dir
, Qt
);
5473 auto_saving_dir_umask
= 0;
5478 do_auto_save_eh (Lisp_Object ignore
)
5480 auto_saving_dir_umask
= 0;
5484 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5485 doc
: /* Auto-save all buffers that need it.
5486 This is all buffers that have auto-saving enabled
5487 and are changed since last auto-saved.
5488 Auto-saving writes the buffer into a file
5489 so that your editing is not lost if the system crashes.
5490 This file is not the file you visited; that changes only when you save.
5491 Normally we run the normal hook `auto-save-hook' before saving.
5493 A non-nil NO-MESSAGE argument means do not print any message if successful.
5494 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5495 (Lisp_Object no_message
, Lisp_Object current_only
)
5497 struct buffer
*old
= current_buffer
, *b
;
5498 Lisp_Object tail
, buf
, hook
;
5499 bool auto_saved
= 0;
5500 int do_handled_files
;
5502 FILE *stream
= NULL
;
5503 ptrdiff_t count
= SPECPDL_INDEX ();
5504 bool orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5505 bool old_message_p
= 0;
5506 struct auto_save_unwind auto_save_unwind
;
5507 struct gcpro gcpro1
, gcpro2
;
5509 if (max_specpdl_size
< specpdl_size
+ 40)
5510 max_specpdl_size
= specpdl_size
+ 40;
5515 if (NILP (no_message
))
5517 old_message_p
= push_message ();
5518 record_unwind_protect_void (pop_message_unwind
);
5521 /* Ordinarily don't quit within this function,
5522 but don't make it impossible to quit (in case we get hung in I/O). */
5526 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5527 point to non-strings reached from Vbuffer_alist. */
5529 hook
= intern ("auto-save-hook");
5530 safe_run_hooks (hook
);
5532 if (STRINGP (Vauto_save_list_file_name
))
5534 Lisp_Object listfile
;
5536 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5538 /* Don't try to create the directory when shutting down Emacs,
5539 because creating the directory might signal an error, and
5540 that would leave Emacs in a strange state. */
5541 if (!NILP (Vrun_hooks
))
5545 GCPRO2 (dir
, listfile
);
5546 dir
= Ffile_name_directory (listfile
);
5547 if (NILP (Ffile_directory_p (dir
)))
5548 internal_condition_case_1 (do_auto_save_make_dir
,
5554 stream
= emacs_fopen (SSDATA (listfile
), "w");
5557 auto_save_unwind
.stream
= stream
;
5558 auto_save_unwind
.auto_raise
= minibuffer_auto_raise
;
5559 record_unwind_protect_ptr (do_auto_save_unwind
, &auto_save_unwind
);
5560 minibuffer_auto_raise
= 0;
5562 auto_save_error_occurred
= 0;
5564 /* On first pass, save all files that don't have handlers.
5565 On second pass, save all files that do have handlers.
5567 If Emacs is crashing, the handlers may tweak what is causing
5568 Emacs to crash in the first place, and it would be a shame if
5569 Emacs failed to autosave perfectly ordinary files because it
5570 couldn't handle some ange-ftp'd file. */
5572 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5573 FOR_EACH_LIVE_BUFFER (tail
, buf
)
5577 /* Record all the buffers that have auto save mode
5578 in the special file that lists them. For each of these buffers,
5579 Record visited name (if any) and auto save name. */
5580 if (STRINGP (BVAR (b
, auto_save_file_name
))
5581 && stream
!= NULL
&& do_handled_files
== 0)
5584 if (!NILP (BVAR (b
, filename
)))
5586 fwrite (SDATA (BVAR (b
, filename
)), 1,
5587 SBYTES (BVAR (b
, filename
)), stream
);
5589 putc ('\n', stream
);
5590 fwrite (SDATA (BVAR (b
, auto_save_file_name
)), 1,
5591 SBYTES (BVAR (b
, auto_save_file_name
)), stream
);
5592 putc ('\n', stream
);
5596 if (!NILP (current_only
)
5597 && b
!= current_buffer
)
5600 /* Don't auto-save indirect buffers.
5601 The base buffer takes care of it. */
5605 /* Check for auto save enabled
5606 and file changed since last auto save
5607 and file changed since last real save. */
5608 if (STRINGP (BVAR (b
, auto_save_file_name
))
5609 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5610 && BUF_AUTOSAVE_MODIFF (b
) < BUF_MODIFF (b
)
5611 /* -1 means we've turned off autosaving for a while--see below. */
5612 && XINT (BVAR (b
, save_length
)) >= 0
5613 && (do_handled_files
5614 || NILP (Ffind_file_name_handler (BVAR (b
, auto_save_file_name
),
5617 struct timespec before_time
= current_timespec ();
5618 struct timespec after_time
;
5620 /* If we had a failure, don't try again for 20 minutes. */
5621 if (b
->auto_save_failure_time
> 0
5622 && before_time
.tv_sec
- b
->auto_save_failure_time
< 1200)
5625 set_buffer_internal (b
);
5626 if (NILP (Vauto_save_include_big_deletions
)
5627 && (XFASTINT (BVAR (b
, save_length
)) * 10
5628 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5629 /* A short file is likely to change a large fraction;
5630 spare the user annoying messages. */
5631 && XFASTINT (BVAR (b
, save_length
)) > 5000
5632 /* These messages are frequent and annoying for `*mail*'. */
5633 && !EQ (BVAR (b
, filename
), Qnil
)
5634 && NILP (no_message
))
5636 /* It has shrunk too much; turn off auto-saving here. */
5637 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5638 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5640 minibuffer_auto_raise
= 0;
5641 /* Turn off auto-saving until there's a real save,
5642 and prevent any more warnings. */
5643 XSETINT (BVAR (b
, save_length
), -1);
5644 Fsleep_for (make_number (1), Qnil
);
5647 if (!auto_saved
&& NILP (no_message
))
5648 message1 ("Auto-saving...");
5649 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5651 BUF_AUTOSAVE_MODIFF (b
) = BUF_MODIFF (b
);
5652 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5653 set_buffer_internal (old
);
5655 after_time
= current_timespec ();
5657 /* If auto-save took more than 60 seconds,
5658 assume it was an NFS failure that got a timeout. */
5659 if (after_time
.tv_sec
- before_time
.tv_sec
> 60)
5660 b
->auto_save_failure_time
= after_time
.tv_sec
;
5664 /* Prevent another auto save till enough input events come in. */
5665 record_auto_save ();
5667 if (auto_saved
&& NILP (no_message
))
5671 /* If we are going to restore an old message,
5672 give time to read ours. */
5673 sit_for (make_number (1), 0, 0);
5676 else if (!auto_save_error_occurred
)
5677 /* Don't overwrite the error message if an error occurred.
5678 If we displayed a message and then restored a state
5679 with no message, leave a "done" message on the screen. */
5680 message1 ("Auto-saving...done");
5685 /* This restores the message-stack status. */
5686 unbind_to (count
, Qnil
);
5690 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5691 Sset_buffer_auto_saved
, 0, 0, 0,
5692 doc
: /* Mark current buffer as auto-saved with its current text.
5693 No auto-save file will be written until the buffer changes again. */)
5696 /* FIXME: This should not be called in indirect buffers, since
5697 they're not autosaved. */
5698 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
5699 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5700 current_buffer
->auto_save_failure_time
= 0;
5704 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5705 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5706 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5709 current_buffer
->auto_save_failure_time
= 0;
5713 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5715 doc
: /* Return t if current buffer has been auto-saved recently.
5716 More precisely, if it has been auto-saved since last read from or saved
5717 in the visited file. If the buffer has no visited file,
5718 then any auto-save counts as "recent". */)
5721 /* FIXME: maybe we should return nil for indirect buffers since
5722 they're never autosaved. */
5723 return (SAVE_MODIFF
< BUF_AUTOSAVE_MODIFF (current_buffer
) ? Qt
: Qnil
);
5726 /* Reading and completing file names */
5728 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5729 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5730 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5731 The return value is only relevant for a call to `read-file-name' that happens
5732 before any other event (mouse or keypress) is handled. */)
5735 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) \
5736 || defined (HAVE_NS)
5737 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5740 && window_system_available (SELECTED_FRAME ()))
5747 Fread_file_name (Lisp_Object prompt
, Lisp_Object dir
, Lisp_Object default_filename
, Lisp_Object mustmatch
, Lisp_Object initial
, Lisp_Object predicate
)
5749 struct gcpro gcpro1
;
5750 Lisp_Object args
[7];
5752 GCPRO1 (default_filename
);
5753 args
[0] = intern ("read-file-name");
5756 args
[3] = default_filename
;
5757 args
[4] = mustmatch
;
5759 args
[6] = predicate
;
5760 RETURN_UNGCPRO (Ffuncall (7, args
));
5767 valid_timestamp_file_system
= 0;
5769 /* fsync can be a significant performance hit. Often it doesn't
5770 suffice to make the file-save operation survive a crash. For
5771 batch scripts, which are typically part of larger shell commands
5772 that don't fsync other files, its effect on performance can be
5773 significant so its utility is particularly questionable.
5774 Hence, for now by default fsync is used only when interactive.
5776 For more on why fsync often fails to work on today's hardware, see:
5777 Zheng M et al. Understanding the robustness of SSDs under power fault.
5778 11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84
5779 http://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf
5781 For more on why fsync does not suffice even if it works properly, see:
5782 Roche X. Necessary step(s) to synchronize filename operations on disk.
5783 Austin Group Defect 672, 2013-03-19
5784 http://austingroupbugs.net/view.php?id=672 */
5785 write_region_inhibit_fsync
= noninteractive
;
5789 syms_of_fileio (void)
5791 DEFSYM (Qoperations
, "operations");
5792 DEFSYM (Qexpand_file_name
, "expand-file-name");
5793 DEFSYM (Qsubstitute_in_file_name
, "substitute-in-file-name");
5794 DEFSYM (Qdirectory_file_name
, "directory-file-name");
5795 DEFSYM (Qfile_name_directory
, "file-name-directory");
5796 DEFSYM (Qfile_name_nondirectory
, "file-name-nondirectory");
5797 DEFSYM (Qunhandled_file_name_directory
, "unhandled-file-name-directory");
5798 DEFSYM (Qfile_name_as_directory
, "file-name-as-directory");
5799 DEFSYM (Qcopy_file
, "copy-file");
5800 DEFSYM (Qmake_directory_internal
, "make-directory-internal");
5801 DEFSYM (Qmake_directory
, "make-directory");
5802 DEFSYM (Qdelete_directory_internal
, "delete-directory-internal");
5803 DEFSYM (Qdelete_file
, "delete-file");
5804 DEFSYM (Qrename_file
, "rename-file");
5805 DEFSYM (Qadd_name_to_file
, "add-name-to-file");
5806 DEFSYM (Qmake_symbolic_link
, "make-symbolic-link");
5807 DEFSYM (Qfile_exists_p
, "file-exists-p");
5808 DEFSYM (Qfile_executable_p
, "file-executable-p");
5809 DEFSYM (Qfile_readable_p
, "file-readable-p");
5810 DEFSYM (Qfile_writable_p
, "file-writable-p");
5811 DEFSYM (Qfile_symlink_p
, "file-symlink-p");
5812 DEFSYM (Qaccess_file
, "access-file");
5813 DEFSYM (Qfile_directory_p
, "file-directory-p");
5814 DEFSYM (Qfile_regular_p
, "file-regular-p");
5815 DEFSYM (Qfile_accessible_directory_p
, "file-accessible-directory-p");
5816 DEFSYM (Qfile_modes
, "file-modes");
5817 DEFSYM (Qset_file_modes
, "set-file-modes");
5818 DEFSYM (Qset_file_times
, "set-file-times");
5819 DEFSYM (Qfile_selinux_context
, "file-selinux-context");
5820 DEFSYM (Qset_file_selinux_context
, "set-file-selinux-context");
5821 DEFSYM (Qfile_acl
, "file-acl");
5822 DEFSYM (Qset_file_acl
, "set-file-acl");
5823 DEFSYM (Qfile_newer_than_file_p
, "file-newer-than-file-p");
5824 DEFSYM (Qinsert_file_contents
, "insert-file-contents");
5825 DEFSYM (Qchoose_write_coding_system
, "choose-write-coding-system");
5826 DEFSYM (Qwrite_region
, "write-region");
5827 DEFSYM (Qverify_visited_file_modtime
, "verify-visited-file-modtime");
5828 DEFSYM (Qset_visited_file_modtime
, "set-visited-file-modtime");
5829 DEFSYM (Qauto_save_coding
, "auto-save-coding");
5831 DEFSYM (Qfile_name_history
, "file-name-history");
5832 Fset (Qfile_name_history
, Qnil
);
5834 DEFSYM (Qfile_error
, "file-error");
5835 DEFSYM (Qfile_already_exists
, "file-already-exists");
5836 DEFSYM (Qfile_date_error
, "file-date-error");
5837 DEFSYM (Qfile_notify_error
, "file-notify-error");
5838 DEFSYM (Qexcl
, "excl");
5840 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system
,
5841 doc
: /* Coding system for encoding file names.
5842 If it is nil, `default-file-name-coding-system' (which see) is used.
5844 On MS-Windows, the value of this variable is largely ignored if
5845 \`w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5846 behaves as if file names were encoded in `utf-8'. */);
5847 Vfile_name_coding_system
= Qnil
;
5849 DEFVAR_LISP ("default-file-name-coding-system",
5850 Vdefault_file_name_coding_system
,
5851 doc
: /* Default coding system for encoding file names.
5852 This variable is used only when `file-name-coding-system' is nil.
5854 This variable is set/changed by the command `set-language-environment'.
5855 User should not set this variable manually,
5856 instead use `file-name-coding-system' to get a constant encoding
5857 of file names regardless of the current language environment.
5859 On MS-Windows, the value of this variable is largely ignored if
5860 \`w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5861 behaves as if file names were encoded in `utf-8'. */);
5862 Vdefault_file_name_coding_system
= Qnil
;
5864 DEFSYM (Qformat_decode
, "format-decode");
5865 DEFSYM (Qformat_annotate_function
, "format-annotate-function");
5866 DEFSYM (Qafter_insert_file_set_coding
, "after-insert-file-set-coding");
5867 DEFSYM (Qcar_less_than_car
, "car-less-than-car");
5869 Fput (Qfile_error
, Qerror_conditions
,
5870 Fpurecopy (list2 (Qfile_error
, Qerror
)));
5871 Fput (Qfile_error
, Qerror_message
,
5872 build_pure_c_string ("File error"));
5874 Fput (Qfile_already_exists
, Qerror_conditions
,
5875 Fpurecopy (list3 (Qfile_already_exists
, Qfile_error
, Qerror
)));
5876 Fput (Qfile_already_exists
, Qerror_message
,
5877 build_pure_c_string ("File already exists"));
5879 Fput (Qfile_date_error
, Qerror_conditions
,
5880 Fpurecopy (list3 (Qfile_date_error
, Qfile_error
, Qerror
)));
5881 Fput (Qfile_date_error
, Qerror_message
,
5882 build_pure_c_string ("Cannot set file date"));
5884 Fput (Qfile_notify_error
, Qerror_conditions
,
5885 Fpurecopy (list3 (Qfile_notify_error
, Qfile_error
, Qerror
)));
5886 Fput (Qfile_notify_error
, Qerror_message
,
5887 build_pure_c_string ("File notification error"));
5889 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist
,
5890 doc
: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
5891 If a file name matches REGEXP, all I/O on that file is done by calling
5892 HANDLER. If a file name matches more than one handler, the handler
5893 whose match starts last in the file name gets precedence. The
5894 function `find-file-name-handler' checks this list for a handler for
5897 HANDLER should be a function. The first argument given to it is the
5898 name of the I/O primitive to be handled; the remaining arguments are
5899 the arguments that were passed to that primitive. For example, if you
5900 do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
5901 HANDLER is called like this:
5903 (funcall HANDLER 'file-exists-p FILENAME)
5905 Note that HANDLER must be able to handle all I/O primitives; if it has
5906 nothing special to do for a primitive, it should reinvoke the
5907 primitive to handle the operation \"the usual way\".
5908 See Info node `(elisp)Magic File Names' for more details. */);
5909 Vfile_name_handler_alist
= Qnil
;
5911 DEFVAR_LISP ("set-auto-coding-function",
5912 Vset_auto_coding_function
,
5913 doc
: /* If non-nil, a function to call to decide a coding system of file.
5914 Two arguments are passed to this function: the file name
5915 and the length of a file contents following the point.
5916 This function should return a coding system to decode the file contents.
5917 It should check the file name against `auto-coding-alist'.
5918 If no coding system is decided, it should check a coding system
5919 specified in the heading lines with the format:
5920 -*- ... coding: CODING-SYSTEM; ... -*-
5921 or local variable spec of the tailing lines with `coding:' tag. */);
5922 Vset_auto_coding_function
= Qnil
;
5924 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions
,
5925 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
5926 Each is passed one argument, the number of characters inserted,
5927 with point at the start of the inserted text. Each function
5928 should leave point the same, and return the new character count.
5929 If `insert-file-contents' is intercepted by a handler from
5930 `file-name-handler-alist', that handler is responsible for calling the
5931 functions in `after-insert-file-functions' if appropriate. */);
5932 Vafter_insert_file_functions
= Qnil
;
5934 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions
,
5935 doc
: /* A list of functions to be called at the start of `write-region'.
5936 Each is passed two arguments, START and END as for `write-region'.
5937 These are usually two numbers but not always; see the documentation
5938 for `write-region'. The function should return a list of pairs
5939 of the form (POSITION . STRING), consisting of strings to be effectively
5940 inserted at the specified positions of the file being written (1 means to
5941 insert before the first byte written). The POSITIONs must be sorted into
5944 If there are several annotation functions, the lists returned by these
5945 functions are merged destructively. As each annotation function runs,
5946 the variable `write-region-annotations-so-far' contains a list of all
5947 annotations returned by previous annotation functions.
5949 An annotation function can return with a different buffer current.
5950 Doing so removes the annotations returned by previous functions, and
5951 resets START and END to `point-min' and `point-max' of the new buffer.
5953 After `write-region' completes, Emacs calls the function stored in
5954 `write-region-post-annotation-function', once for each buffer that was
5955 current when building the annotations (i.e., at least once), with that
5956 buffer current. */);
5957 Vwrite_region_annotate_functions
= Qnil
;
5958 DEFSYM (Qwrite_region_annotate_functions
, "write-region-annotate-functions");
5960 DEFVAR_LISP ("write-region-post-annotation-function",
5961 Vwrite_region_post_annotation_function
,
5962 doc
: /* Function to call after `write-region' completes.
5963 The function is called with no arguments. If one or more of the
5964 annotation functions in `write-region-annotate-functions' changed the
5965 current buffer, the function stored in this variable is called for
5966 each of those additional buffers as well, in addition to the original
5967 buffer. The relevant buffer is current during each function call. */);
5968 Vwrite_region_post_annotation_function
= Qnil
;
5969 staticpro (&Vwrite_region_annotation_buffers
);
5971 DEFVAR_LISP ("write-region-annotations-so-far",
5972 Vwrite_region_annotations_so_far
,
5973 doc
: /* When an annotation function is called, this holds the previous annotations.
5974 These are the annotations made by other annotation functions
5975 that were already called. See also `write-region-annotate-functions'. */);
5976 Vwrite_region_annotations_so_far
= Qnil
;
5978 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers
,
5979 doc
: /* A list of file name handlers that temporarily should not be used.
5980 This applies only to the operation `inhibit-file-name-operation'. */);
5981 Vinhibit_file_name_handlers
= Qnil
;
5983 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation
,
5984 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5985 Vinhibit_file_name_operation
= Qnil
;
5987 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name
,
5988 doc
: /* File name in which we write a list of all auto save file names.
5989 This variable is initialized automatically from `auto-save-list-file-prefix'
5990 shortly after Emacs reads your init file, if you have not yet given it
5991 a non-nil value. */);
5992 Vauto_save_list_file_name
= Qnil
;
5994 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name
,
5995 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
5996 Normally auto-save files are written under other names. */);
5997 Vauto_save_visited_file_name
= Qnil
;
5999 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions
,
6000 doc
: /* If non-nil, auto-save even if a large part of the text is deleted.
6001 If nil, deleting a substantial portion of the text disables auto-save
6002 in the buffer; this is the default behavior, because the auto-save
6003 file is usually more useful if it contains the deleted text. */);
6004 Vauto_save_include_big_deletions
= Qnil
;
6006 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync
,
6007 doc
: /* Non-nil means don't call fsync in `write-region'.
6008 This variable affects calls to `write-region' as well as save commands.
6009 Setting this to nil may avoid data loss if the system loses power or
6010 the operating system crashes. */);
6011 write_region_inhibit_fsync
= 0; /* See also `init_fileio' above. */
6013 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash
,
6014 doc
: /* Specifies whether to use the system's trash can.
6015 When non-nil, certain file deletion commands use the function
6016 `move-file-to-trash' instead of deleting files outright.
6017 This includes interactive calls to `delete-file' and
6018 `delete-directory' and the Dired deletion commands. */);
6019 delete_by_moving_to_trash
= 0;
6020 Qdelete_by_moving_to_trash
= intern_c_string ("delete-by-moving-to-trash");
6022 DEFSYM (Qmove_file_to_trash
, "move-file-to-trash");
6023 DEFSYM (Qcopy_directory
, "copy-directory");
6024 DEFSYM (Qdelete_directory
, "delete-directory");
6025 DEFSYM (Qsubstitute_env_in_file_name
, "substitute-env-in-file-name");
6027 defsubr (&Sfind_file_name_handler
);
6028 defsubr (&Sfile_name_directory
);
6029 defsubr (&Sfile_name_nondirectory
);
6030 defsubr (&Sunhandled_file_name_directory
);
6031 defsubr (&Sfile_name_as_directory
);
6032 defsubr (&Sdirectory_file_name
);
6033 defsubr (&Smake_temp_name
);
6034 defsubr (&Sexpand_file_name
);
6035 defsubr (&Ssubstitute_in_file_name
);
6036 defsubr (&Scopy_file
);
6037 defsubr (&Smake_directory_internal
);
6038 defsubr (&Sdelete_directory_internal
);
6039 defsubr (&Sdelete_file
);
6040 defsubr (&Srename_file
);
6041 defsubr (&Sadd_name_to_file
);
6042 defsubr (&Smake_symbolic_link
);
6043 defsubr (&Sfile_name_absolute_p
);
6044 defsubr (&Sfile_exists_p
);
6045 defsubr (&Sfile_executable_p
);
6046 defsubr (&Sfile_readable_p
);
6047 defsubr (&Sfile_writable_p
);
6048 defsubr (&Saccess_file
);
6049 defsubr (&Sfile_symlink_p
);
6050 defsubr (&Sfile_directory_p
);
6051 defsubr (&Sfile_accessible_directory_p
);
6052 defsubr (&Sfile_regular_p
);
6053 defsubr (&Sfile_modes
);
6054 defsubr (&Sset_file_modes
);
6055 defsubr (&Sset_file_times
);
6056 defsubr (&Sfile_selinux_context
);
6057 defsubr (&Sfile_acl
);
6058 defsubr (&Sset_file_acl
);
6059 defsubr (&Sset_file_selinux_context
);
6060 defsubr (&Sset_default_file_modes
);
6061 defsubr (&Sdefault_file_modes
);
6062 defsubr (&Sfile_newer_than_file_p
);
6063 defsubr (&Sinsert_file_contents
);
6064 defsubr (&Schoose_write_coding_system
);
6065 defsubr (&Swrite_region
);
6066 defsubr (&Scar_less_than_car
);
6067 defsubr (&Sverify_visited_file_modtime
);
6068 defsubr (&Svisited_file_modtime
);
6069 defsubr (&Sset_visited_file_modtime
);
6070 defsubr (&Sdo_auto_save
);
6071 defsubr (&Sset_buffer_auto_saved
);
6072 defsubr (&Sclear_buffer_auto_save_failure
);
6073 defsubr (&Srecent_auto_save_p
);
6075 defsubr (&Snext_read_file_uses_dialog_p
);
6078 defsubr (&Sunix_sync
);