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>
46 #include "intervals.h"
47 #include "character.h"
51 #include "blockinput.h"
53 #include "dispextern.h"
61 #endif /* not WINDOWSNT */
65 #include <sys/param.h>
70 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
71 redirector allows the six letters between 'Z' and 'a' as well. */
73 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
76 #define IS_DRIVE(x) c_isalpha (x)
78 /* Need to lower-case the drive letter, or else expanded
79 filenames will sometimes compare unequal, because
80 `expand-file-name' doesn't always down-case the drive letter. */
81 #define DRIVE_LETTER(x) c_tolower (x)
85 #include <stat-time.h>
93 /* True during writing of auto-save files. */
94 static bool auto_saving
;
96 /* Nonzero umask during creation of auto-save directories. */
97 static mode_t auto_saving_dir_umask
;
99 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
100 a new file with the same mode as the original. */
101 static mode_t auto_save_mode_bits
;
103 /* Set by auto_save_1 if an error occurred during the last auto-save. */
104 static bool auto_save_error_occurred
;
106 /* If VALID_TIMESTAMP_FILE_SYSTEM, then TIMESTAMP_FILE_SYSTEM is the device
107 number of a file system where time stamps were observed to to work. */
108 static bool valid_timestamp_file_system
;
109 static dev_t timestamp_file_system
;
111 /* The symbol bound to coding-system-for-read when
112 insert-file-contents is called for recovering a file. This is not
113 an actual coding system name, but just an indicator to tell
114 insert-file-contents to use `emacs-mule' with a special flag for
115 auto saving and recovering a file. */
116 static Lisp_Object Qauto_save_coding
;
118 /* Property name of a file name handler,
119 which gives a list of operations it handles.. */
120 static Lisp_Object Qoperations
;
122 /* Lisp functions for translating file formats. */
123 static Lisp_Object Qformat_decode
, Qformat_annotate_function
;
125 /* Lisp function for setting buffer-file-coding-system and the
126 multibyteness of the current buffer after inserting a file. */
127 static Lisp_Object Qafter_insert_file_set_coding
;
129 static Lisp_Object Qwrite_region_annotate_functions
;
130 /* Each time an annotation function changes the buffer, the new buffer
132 static Lisp_Object Vwrite_region_annotation_buffers
;
137 static Lisp_Object Qdelete_by_moving_to_trash
;
139 /* Lisp function for moving files to trash. */
140 static Lisp_Object Qmove_file_to_trash
;
142 /* Lisp function for recursively copying directories. */
143 static Lisp_Object Qcopy_directory
;
145 /* Lisp function for recursively deleting directories. */
146 static Lisp_Object Qdelete_directory
;
151 Lisp_Object Qfile_error
;
152 static Lisp_Object Qfile_already_exists
, Qfile_date_error
;
153 static Lisp_Object Qexcl
;
154 Lisp_Object Qfile_name_history
;
156 static Lisp_Object Qcar_less_than_car
;
158 static bool a_write (int, Lisp_Object
, ptrdiff_t, ptrdiff_t,
159 Lisp_Object
*, struct coding_system
*);
160 static bool e_write (int, Lisp_Object
, ptrdiff_t, ptrdiff_t,
161 struct coding_system
*);
165 report_file_error (const char *string
, Lisp_Object data
)
167 Lisp_Object errstring
;
171 synchronize_system_messages_locale ();
172 str
= strerror (errorno
);
173 errstring
= code_convert_string_norecord (build_unibyte_string (str
),
174 Vlocale_coding_system
, 0);
180 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
183 /* System error messages are capitalized. Downcase the initial
184 unless it is followed by a slash. (The slash case caters to
185 error messages that begin with "I/O" or, in German, "E/A".) */
186 if (STRING_MULTIBYTE (errstring
)
187 && ! EQ (Faref (errstring
, make_number (1)), make_number ('/')))
191 str
= SSDATA (errstring
);
192 c
= STRING_CHAR ((unsigned char *) str
);
193 Faset (errstring
, make_number (0), make_number (downcase (c
)));
196 xsignal (Qfile_error
,
197 Fcons (build_string (string
), Fcons (errstring
, data
)));
202 close_file_unwind (Lisp_Object fd
)
204 emacs_close (XFASTINT (fd
));
208 /* Restore point, having saved it as a marker. */
211 restore_point_unwind (Lisp_Object location
)
213 Fgoto_char (location
);
214 Fset_marker (location
, Qnil
, Qnil
);
219 static Lisp_Object Qexpand_file_name
;
220 static Lisp_Object Qsubstitute_in_file_name
;
221 static Lisp_Object Qdirectory_file_name
;
222 static Lisp_Object Qfile_name_directory
;
223 static Lisp_Object Qfile_name_nondirectory
;
224 static Lisp_Object Qunhandled_file_name_directory
;
225 static Lisp_Object Qfile_name_as_directory
;
226 static Lisp_Object Qcopy_file
;
227 static Lisp_Object Qmake_directory_internal
;
228 static Lisp_Object Qmake_directory
;
229 static Lisp_Object Qdelete_directory_internal
;
230 Lisp_Object Qdelete_file
;
231 static Lisp_Object Qrename_file
;
232 static Lisp_Object Qadd_name_to_file
;
233 static Lisp_Object Qmake_symbolic_link
;
234 Lisp_Object Qfile_exists_p
;
235 static Lisp_Object Qfile_executable_p
;
236 static Lisp_Object Qfile_readable_p
;
237 static Lisp_Object Qfile_writable_p
;
238 static Lisp_Object Qfile_symlink_p
;
239 static Lisp_Object Qaccess_file
;
240 Lisp_Object Qfile_directory_p
;
241 static Lisp_Object Qfile_regular_p
;
242 static Lisp_Object Qfile_accessible_directory_p
;
243 static Lisp_Object Qfile_modes
;
244 static Lisp_Object Qset_file_modes
;
245 static Lisp_Object Qset_file_times
;
246 static Lisp_Object Qfile_selinux_context
;
247 static Lisp_Object Qset_file_selinux_context
;
248 static Lisp_Object Qfile_acl
;
249 static Lisp_Object Qset_file_acl
;
250 static Lisp_Object Qfile_newer_than_file_p
;
251 Lisp_Object Qinsert_file_contents
;
252 Lisp_Object Qwrite_region
;
253 static Lisp_Object Qverify_visited_file_modtime
;
254 static Lisp_Object Qset_visited_file_modtime
;
256 DEFUN ("find-file-name-handler", Ffind_file_name_handler
,
257 Sfind_file_name_handler
, 2, 2, 0,
258 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
259 Otherwise, return nil.
260 A file name is handled if one of the regular expressions in
261 `file-name-handler-alist' matches it.
263 If OPERATION equals `inhibit-file-name-operation', then we ignore
264 any handlers that are members of `inhibit-file-name-handlers',
265 but we still do run any other handlers. This lets handlers
266 use the standard functions without calling themselves recursively. */)
267 (Lisp_Object filename
, Lisp_Object operation
)
269 /* This function must not munge the match data. */
270 Lisp_Object chain
, inhibited_handlers
, result
;
274 CHECK_STRING (filename
);
276 if (EQ (operation
, Vinhibit_file_name_operation
))
277 inhibited_handlers
= Vinhibit_file_name_handlers
;
279 inhibited_handlers
= Qnil
;
281 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
282 chain
= XCDR (chain
))
288 Lisp_Object string
= XCAR (elt
);
290 Lisp_Object handler
= XCDR (elt
);
291 Lisp_Object operations
= Qnil
;
293 if (SYMBOLP (handler
))
294 operations
= Fget (handler
, Qoperations
);
297 && (match_pos
= fast_string_match (string
, filename
)) > pos
298 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
302 handler
= XCDR (elt
);
303 tem
= Fmemq (handler
, inhibited_handlers
);
317 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
319 doc
: /* Return the directory component in file name FILENAME.
320 Return nil if FILENAME does not include a directory.
321 Otherwise return a directory name.
322 Given a Unix syntax file name, returns a string ending in slash. */)
323 (Lisp_Object filename
)
326 register const char *beg
;
331 register const char *p
;
334 CHECK_STRING (filename
);
336 /* If the file name has special constructs in it,
337 call the corresponding file handler. */
338 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
341 Lisp_Object handled_name
= call2 (handler
, Qfile_name_directory
,
343 return STRINGP (handled_name
) ? handled_name
: Qnil
;
347 beg
= alloca (SBYTES (filename
) + 1);
348 memcpy (beg
, SSDATA (filename
), SBYTES (filename
) + 1);
350 beg
= SSDATA (filename
);
352 p
= beg
+ SBYTES (filename
);
354 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
356 /* only recognize drive specifier at the beginning */
358 /* handle the "/:d:foo" and "/:foo" cases correctly */
359 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
360 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
367 /* Expansion of "c:" to drive and default directory. */
370 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
371 char *res
= alloca (MAXPATHLEN
+ 1);
374 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
376 memcpy (res
, beg
, 2);
381 if (getdefdir (c_toupper (*beg
) - 'A' + 1, r
))
383 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
386 p
= beg
+ strlen (beg
);
387 dostounix_filename (beg
);
388 tem_fn
= make_specified_string (beg
, -1, p
- beg
,
389 STRING_MULTIBYTE (filename
));
392 tem_fn
= make_specified_string (beg
- 2, -1, p
- beg
+ 2,
393 STRING_MULTIBYTE (filename
));
395 else if (STRING_MULTIBYTE (filename
))
397 tem_fn
= ENCODE_FILE (make_specified_string (beg
, -1, p
- beg
, 1));
398 dostounix_filename (SSDATA (tem_fn
));
399 tem_fn
= DECODE_FILE (tem_fn
);
403 dostounix_filename (beg
);
404 tem_fn
= make_specified_string (beg
, -1, p
- beg
, 0);
408 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
412 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
413 Sfile_name_nondirectory
, 1, 1, 0,
414 doc
: /* Return file name FILENAME sans its directory.
415 For example, in a Unix-syntax file name,
416 this is everything after the last slash,
417 or the entire name if it contains no slash. */)
418 (Lisp_Object filename
)
420 register const char *beg
, *p
, *end
;
423 CHECK_STRING (filename
);
425 /* If the file name has special constructs in it,
426 call the corresponding file handler. */
427 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
430 Lisp_Object handled_name
= call2 (handler
, Qfile_name_nondirectory
,
432 if (STRINGP (handled_name
))
434 error ("Invalid handler in `file-name-handler-alist'");
437 beg
= SSDATA (filename
);
438 end
= p
= beg
+ SBYTES (filename
);
440 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
442 /* only recognize drive specifier at beginning */
444 /* handle the "/:d:foo" case correctly */
445 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
450 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
453 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
454 Sunhandled_file_name_directory
, 1, 1, 0,
455 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
456 A `directly usable' directory name is one that may be used without the
457 intervention of any file handler.
458 If FILENAME is a directly usable file itself, return
459 \(file-name-directory FILENAME).
460 If FILENAME refers to a file which is not accessible from a local process,
461 then this should return nil.
462 The `call-process' and `start-process' functions use this function to
463 get a current directory to run processes in. */)
464 (Lisp_Object filename
)
468 /* If the file name has special constructs in it,
469 call the corresponding file handler. */
470 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
473 Lisp_Object handled_name
= call2 (handler
, Qunhandled_file_name_directory
,
475 return STRINGP (handled_name
) ? handled_name
: Qnil
;
478 return Ffile_name_directory (filename
);
481 /* Convert from file name SRC of length SRCLEN to directory name in
482 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
483 string. On UNIX, just make sure there is a terminating /. Return
484 the length of DST in bytes. */
487 file_name_as_directory (char *dst
, const char *src
, ptrdiff_t srclen
,
500 if (!IS_DIRECTORY_SEP (dst
[srclen
- 1]))
502 dst
[srclen
] = DIRECTORY_SEP
;
503 dst
[srclen
+ 1] = '\0';
509 Lisp_Object tem_fn
= make_specified_string (dst
, -1, srclen
, 1);
511 tem_fn
= ENCODE_FILE (tem_fn
);
512 dostounix_filename (SSDATA (tem_fn
));
513 tem_fn
= DECODE_FILE (tem_fn
);
514 memcpy (dst
, SSDATA (tem_fn
), (srclen
= SBYTES (tem_fn
)) + 1);
517 dostounix_filename (dst
);
522 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
523 Sfile_name_as_directory
, 1, 1, 0,
524 doc
: /* Return a string representing the file name FILE interpreted as a directory.
525 This operation exists because a directory is also a file, but its name as
526 a directory is different from its name as a file.
527 The result can be used as the value of `default-directory'
528 or passed as second argument to `expand-file-name'.
529 For a Unix-syntax file name, just appends a slash. */)
540 /* If the file name has special constructs in it,
541 call the corresponding file handler. */
542 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
545 Lisp_Object handled_name
= call2 (handler
, Qfile_name_as_directory
,
547 if (STRINGP (handled_name
))
549 error ("Invalid handler in `file-name-handler-alist'");
552 buf
= alloca (SBYTES (file
) + 10);
553 length
= file_name_as_directory (buf
, SSDATA (file
), SBYTES (file
),
554 STRING_MULTIBYTE (file
));
555 return make_specified_string (buf
, -1, length
, STRING_MULTIBYTE (file
));
558 /* Convert from directory name SRC of length SRCLEN to file name in
559 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
560 string. On UNIX, just make sure there isn't a terminating /.
561 Return the length of DST in bytes. */
564 directory_file_name (char *dst
, char *src
, ptrdiff_t srclen
, bool multibyte
)
566 /* Process as Unix format: just remove any final slash.
567 But leave "/" unchanged; do not change it to "". */
570 && IS_DIRECTORY_SEP (dst
[srclen
- 1])
572 && !IS_ANY_SEP (dst
[srclen
- 2])
582 Lisp_Object tem_fn
= make_specified_string (dst
, -1, srclen
, 1);
584 tem_fn
= ENCODE_FILE (tem_fn
);
585 dostounix_filename (SSDATA (tem_fn
));
586 tem_fn
= DECODE_FILE (tem_fn
);
587 memcpy (dst
, SSDATA (tem_fn
), (srclen
= SBYTES (tem_fn
)) + 1);
590 dostounix_filename (dst
);
595 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
597 doc
: /* Returns the file name of the directory named DIRECTORY.
598 This is the name of the file that holds the data for the directory DIRECTORY.
599 This operation exists because a directory is also a file, but its name as
600 a directory is different from its name as a file.
601 In Unix-syntax, this function just removes the final slash. */)
602 (Lisp_Object directory
)
608 CHECK_STRING (directory
);
610 if (NILP (directory
))
613 /* If the file name has special constructs in it,
614 call the corresponding file handler. */
615 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
618 Lisp_Object handled_name
= call2 (handler
, Qdirectory_file_name
,
620 if (STRINGP (handled_name
))
622 error ("Invalid handler in `file-name-handler-alist'");
625 buf
= alloca (SBYTES (directory
) + 20);
626 length
= directory_file_name (buf
, SSDATA (directory
), SBYTES (directory
),
627 STRING_MULTIBYTE (directory
));
628 return make_specified_string (buf
, -1, length
, STRING_MULTIBYTE (directory
));
631 static const char make_temp_name_tbl
[64] =
633 'A','B','C','D','E','F','G','H',
634 'I','J','K','L','M','N','O','P',
635 'Q','R','S','T','U','V','W','X',
636 'Y','Z','a','b','c','d','e','f',
637 'g','h','i','j','k','l','m','n',
638 'o','p','q','r','s','t','u','v',
639 'w','x','y','z','0','1','2','3',
640 '4','5','6','7','8','9','-','_'
643 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
645 /* Value is a temporary file name starting with PREFIX, a string.
647 The Emacs process number forms part of the result, so there is
648 no danger of generating a name being used by another process.
649 In addition, this function makes an attempt to choose a name
650 which has no existing file. To make this work, PREFIX should be
651 an absolute file name.
653 BASE64_P means add the pid as 3 characters in base64
654 encoding. In this case, 6 characters will be added to PREFIX to
655 form the file name. Otherwise, if Emacs is running on a system
656 with long file names, add the pid as a decimal number.
658 This function signals an error if no unique file name could be
662 make_temp_name (Lisp_Object prefix
, bool base64_p
)
668 char pidbuf
[INT_BUFSIZE_BOUND (printmax_t
)];
671 CHECK_STRING (prefix
);
673 /* VAL is created by adding 6 characters to PREFIX. The first
674 three are the PID of this process, in base 64, and the second
675 three are incremented if the file already exists. This ensures
676 262144 unique file names per PID per PREFIX. */
682 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
683 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
684 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
689 #ifdef HAVE_LONG_FILE_NAMES
690 pidlen
= sprintf (pidbuf
, "%"pMd
, pid
);
692 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
693 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
694 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
699 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
700 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
701 if (!STRING_MULTIBYTE (prefix
))
702 STRING_SET_UNIBYTE (val
);
704 memcpy (data
, SSDATA (prefix
), len
);
707 memcpy (p
, pidbuf
, pidlen
);
710 /* Here we try to minimize useless stat'ing when this function is
711 invoked many times successively with the same PREFIX. We achieve
712 this by initializing count to a random value, and incrementing it
715 We don't want make-temp-name to be called while dumping,
716 because then make_temp_name_count_initialized_p would get set
717 and then make_temp_name_count would not be set when Emacs starts. */
719 if (!make_temp_name_count_initialized_p
)
721 make_temp_name_count
= time (NULL
);
722 make_temp_name_count_initialized_p
= 1;
727 unsigned num
= make_temp_name_count
;
729 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
730 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
731 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
733 /* Poor man's congruential RN generator. Replace with
734 ++make_temp_name_count for debugging. */
735 make_temp_name_count
+= 25229;
736 make_temp_name_count
%= 225307;
738 if (!check_existing (data
))
740 /* We want to return only if errno is ENOENT. */
744 /* The error here is dubious, but there is little else we
745 can do. The alternatives are to return nil, which is
746 as bad as (and in many cases worse than) throwing the
747 error, or to ignore the error, which will likely result
748 in looping through 225307 stat's, which is not only
749 dog-slow, but also useless since eventually nil would
750 have to be returned anyway. */
751 report_file_error ("Cannot create temporary name for prefix",
752 Fcons (prefix
, Qnil
));
759 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
760 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
761 The Emacs process number forms part of the result,
762 so there is no danger of generating a name being used by another process.
764 In addition, this function makes an attempt to choose a name
765 which has no existing file. To make this work,
766 PREFIX should be an absolute file name.
768 There is a race condition between calling `make-temp-name' and creating the
769 file which opens all kinds of security holes. For that reason, you should
770 probably use `make-temp-file' instead, except in three circumstances:
772 * If you are creating the file in the user's home directory.
773 * If you are creating a directory rather than an ordinary file.
774 * If you are taking special precautions as `make-temp-file' does. */)
777 return make_temp_name (prefix
, 0);
782 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
783 doc
: /* Convert filename NAME to absolute, and canonicalize it.
784 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
785 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
786 the current buffer's value of `default-directory' is used.
787 NAME should be a string that is a valid file name for the underlying
789 File name components that are `.' are removed, and
790 so are file name components followed by `..', along with the `..' itself;
791 note that these simplifications are done without checking the resulting
792 file names in the file system.
793 Multiple consecutive slashes are collapsed into a single slash,
794 except at the beginning of the file name when they are significant (e.g.,
795 UNC file names on MS-Windows.)
796 An initial `~/' expands to your home directory.
797 An initial `~USER/' expands to USER's home directory.
798 See also the function `substitute-in-file-name'.
800 For technical reasons, this function can return correct but
801 non-intuitive results for the root directory; for instance,
802 \(expand-file-name ".." "/") returns "/..". For this reason, use
803 \(directory-file-name (file-name-directory dirname)) to traverse a
804 filesystem tree, not (expand-file-name ".." dirname). */)
805 (Lisp_Object name
, Lisp_Object default_directory
)
807 /* These point to SDATA and need to be careful with string-relocation
808 during GC (via DECODE_FILE). */
811 /* This should only point to alloca'd data. */
818 bool collapse_newdir
= 1;
822 Lisp_Object handler
, result
, handled_name
;
828 /* If the file name has special constructs in it,
829 call the corresponding file handler. */
830 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
833 handled_name
= call3 (handler
, Qexpand_file_name
,
834 name
, default_directory
);
835 if (STRINGP (handled_name
))
837 error ("Invalid handler in `file-name-handler-alist'");
841 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
842 if (NILP (default_directory
))
843 default_directory
= BVAR (current_buffer
, directory
);
844 if (! STRINGP (default_directory
))
847 /* "/" is not considered a root directory on DOS_NT, so using "/"
848 here causes an infinite recursion in, e.g., the following:
850 (let (default-directory)
851 (expand-file-name "a"))
853 To avoid this, we set default_directory to the root of the
855 default_directory
= build_string (emacs_root_dir ());
857 default_directory
= build_string ("/");
861 if (!NILP (default_directory
))
863 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
866 handled_name
= call3 (handler
, Qexpand_file_name
,
867 name
, default_directory
);
868 if (STRINGP (handled_name
))
870 error ("Invalid handler in `file-name-handler-alist'");
875 char *o
= SSDATA (default_directory
);
877 /* Make sure DEFAULT_DIRECTORY is properly expanded.
878 It would be better to do this down below where we actually use
879 default_directory. Unfortunately, calling Fexpand_file_name recursively
880 could invoke GC, and the strings might be relocated. This would
881 be annoying because we have pointers into strings lying around
882 that would need adjusting, and people would add new pointers to
883 the code and forget to adjust them, resulting in intermittent bugs.
884 Putting this call here avoids all that crud.
886 The EQ test avoids infinite recursion. */
887 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
888 /* Save time in some common cases - as long as default_directory
889 is not relative, it can be canonicalized with name below (if it
890 is needed at all) without requiring it to be expanded now. */
892 /* Detect MSDOS file names with drive specifiers. */
893 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
894 && IS_DIRECTORY_SEP (o
[2]))
896 /* Detect Windows file names in UNC format. */
897 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
899 #else /* not DOS_NT */
900 /* Detect Unix absolute file names (/... alone is not absolute on
902 && ! (IS_DIRECTORY_SEP (o
[0]))
903 #endif /* not DOS_NT */
909 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
913 multibyte
= STRING_MULTIBYTE (name
);
914 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
917 default_directory
= string_to_multibyte (default_directory
);
920 name
= string_to_multibyte (name
);
925 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
926 nm
= alloca (SBYTES (name
) + 1);
927 memcpy (nm
, SSDATA (name
), SBYTES (name
) + 1);
930 /* Note if special escape prefix is present, but remove for now. */
931 if (nm
[0] == '/' && nm
[1] == ':')
937 /* Find and remove drive specifier if present; this makes nm absolute
938 even if the rest of the name appears to be relative. Only look for
939 drive specifier at the beginning. */
940 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
942 drive
= (unsigned char) nm
[0];
947 /* If we see "c://somedir", we want to strip the first slash after the
948 colon when stripping the drive letter. Otherwise, this expands to
950 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
953 /* Discard any previous drive specifier if nm is now in UNC format. */
954 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
958 #endif /* WINDOWSNT */
961 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
962 none are found, we can probably return right away. We will avoid
963 allocating a new string if name is already fully expanded. */
965 IS_DIRECTORY_SEP (nm
[0])
967 && drive
&& !is_escaped
970 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
974 /* If it turns out that the filename we want to return is just a
975 suffix of FILENAME, we don't need to go through and edit
976 things; we just need to construct a new string using data
977 starting at the middle of FILENAME. If we set LOSE, that
978 means we've discovered that we can't do that cool trick. */
984 /* Since we know the name is absolute, we can assume that each
985 element starts with a "/". */
987 /* "." and ".." are hairy. */
988 if (IS_DIRECTORY_SEP (p
[0])
990 && (IS_DIRECTORY_SEP (p
[2])
992 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
995 /* We want to replace multiple `/' in a row with a single
998 && IS_DIRECTORY_SEP (p
[0])
999 && IS_DIRECTORY_SEP (p
[1]))
1006 /* Make sure directories are all separated with /, but
1007 avoid allocation of a new string when not required. */
1010 Lisp_Object tem_name
= make_specified_string (nm
, -1, strlen (nm
),
1013 tem_name
= ENCODE_FILE (tem_name
);
1014 dostounix_filename (SSDATA (tem_name
));
1015 tem_name
= DECODE_FILE (tem_name
);
1016 memcpy (nm
, SSDATA (tem_name
), SBYTES (tem_name
) + 1);
1019 dostounix_filename (nm
);
1021 if (IS_DIRECTORY_SEP (nm
[1]))
1023 if (strcmp (nm
, SSDATA (name
)) != 0)
1024 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1028 /* Drive must be set, so this is okay. */
1029 if (strcmp (nm
- 2, SSDATA (name
)) != 0)
1033 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1034 temp
[0] = DRIVE_LETTER (drive
);
1035 name
= concat2 (build_string (temp
), name
);
1038 #else /* not DOS_NT */
1039 if (strcmp (nm
, SSDATA (name
)) == 0)
1041 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1042 #endif /* not DOS_NT */
1046 /* At this point, nm might or might not be an absolute file name. We
1047 need to expand ~ or ~user if present, otherwise prefix nm with
1048 default_directory if nm is not absolute, and finally collapse /./
1049 and /foo/../ sequences.
1051 We set newdir to be the appropriate prefix if one is needed:
1052 - the relevant user directory if nm starts with ~ or ~user
1053 - the specified drive's working dir (DOS/NT only) if nm does not
1055 - the value of default_directory.
1057 Note that these prefixes are not guaranteed to be absolute (except
1058 for the working dir of a drive). Therefore, to ensure we always
1059 return an absolute name, if the final prefix is not absolute we
1060 append it to the current working directory. */
1064 if (nm
[0] == '~') /* prefix ~ */
1066 if (IS_DIRECTORY_SEP (nm
[1])
1067 || nm
[1] == 0) /* ~ by itself */
1071 if (!(newdir
= egetenv ("HOME")))
1074 /* `egetenv' may return a unibyte string, which will bite us since
1075 we expect the directory to be multibyte. */
1076 tem
= build_string (newdir
);
1077 if (multibyte
&& !STRING_MULTIBYTE (tem
))
1079 hdir
= DECODE_FILE (tem
);
1080 newdir
= SSDATA (hdir
);
1083 collapse_newdir
= 0;
1086 else /* ~user/filename */
1089 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)); p
++);
1090 o
= alloca (p
- nm
+ 1);
1091 memcpy (o
, nm
, p
- nm
);
1095 pw
= getpwnam (o
+ 1);
1101 newdir
= pw
->pw_dir
;
1102 /* `getpwnam' may return a unibyte string, which will
1103 bite us since we expect the directory to be
1105 tem
= build_string (newdir
);
1106 if (multibyte
&& !STRING_MULTIBYTE (tem
))
1108 hdir
= DECODE_FILE (tem
);
1109 newdir
= SSDATA (hdir
);
1113 collapse_newdir
= 0;
1117 /* If we don't find a user of that name, leave the name
1118 unchanged; don't move nm forward to p. */
1123 /* On DOS and Windows, nm is absolute if a drive name was specified;
1124 use the drive's current directory as the prefix if needed. */
1125 if (!newdir
&& drive
)
1127 /* Get default directory if needed to make nm absolute. */
1129 if (!IS_DIRECTORY_SEP (nm
[0]))
1131 adir
= alloca (MAXPATHLEN
+ 1);
1132 if (!getdefdir (c_toupper (drive
) - 'A' + 1, adir
))
1136 Lisp_Object tem
= build_string (adir
);
1138 tem
= DECODE_FILE (tem
);
1139 memcpy (adir
, SSDATA (tem
), SBYTES (tem
) + 1);
1144 /* Either nm starts with /, or drive isn't mounted. */
1146 adir
[0] = DRIVE_LETTER (drive
);
1155 /* Finally, if no prefix has been specified and nm is not absolute,
1156 then it must be expanded relative to default_directory. */
1160 /* /... alone is not absolute on DOS and Windows. */
1161 && !IS_DIRECTORY_SEP (nm
[0])
1164 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1168 newdir
= SSDATA (default_directory
);
1170 /* Note if special escape prefix is present, but remove for now. */
1171 if (newdir
[0] == '/' && newdir
[1] == ':')
1182 /* First ensure newdir is an absolute name. */
1184 /* Detect MSDOS file names with drive specifiers. */
1185 ! (IS_DRIVE (newdir
[0])
1186 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1188 /* Detect Windows file names in UNC format. */
1189 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1193 /* Effectively, let newdir be (expand-file-name newdir cwd).
1194 Because of the admonition against calling expand-file-name
1195 when we have pointers into lisp strings, we accomplish this
1196 indirectly by prepending newdir to nm if necessary, and using
1197 cwd (or the wd of newdir's drive) as the new newdir. */
1200 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1202 drive
= (unsigned char) newdir
[0];
1205 if (!IS_DIRECTORY_SEP (nm
[0]))
1207 ptrdiff_t newlen
= strlen (newdir
);
1208 char *tmp
= alloca (newlen
+ strlen (nm
) + 2);
1209 file_name_as_directory (tmp
, newdir
, newlen
, multibyte
);
1213 adir
= alloca (MAXPATHLEN
+ 1);
1216 if (!getdefdir (c_toupper (drive
) - 'A' + 1, adir
))
1220 getcwd (adir
, MAXPATHLEN
+ 1);
1223 Lisp_Object tem
= build_string (adir
);
1225 tem
= DECODE_FILE (tem
);
1226 memcpy (adir
, SSDATA (tem
), SBYTES (tem
) + 1);
1231 /* Strip off drive name from prefix, if present. */
1232 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1238 /* Keep only a prefix from newdir if nm starts with slash
1239 (//server/share for UNC, nothing otherwise). */
1240 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1243 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1245 char *adir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1247 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1249 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1262 /* Get rid of any slash at the end of newdir, unless newdir is
1263 just / or // (an incomplete UNC name). */
1264 length
= strlen (newdir
);
1266 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1268 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1272 char *temp
= alloca (length
);
1273 memcpy (temp
, newdir
, length
- 1);
1274 temp
[length
- 1] = 0;
1285 /* Now concatenate the directory and name to new space in the stack frame. */
1286 tlen
+= strlen (nm
) + 1;
1288 /* Reserve space for drive specifier and escape prefix, since either
1289 or both may need to be inserted. (The Microsoft x86 compiler
1290 produces incorrect code if the following two lines are combined.) */
1291 target
= alloca (tlen
+ 4);
1293 #else /* not DOS_NT */
1294 target
= alloca (tlen
);
1295 #endif /* not DOS_NT */
1300 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1303 /* If newdir is effectively "C:/", then the drive letter will have
1304 been stripped and newdir will be "/". Concatenating with an
1305 absolute directory in nm produces "//", which will then be
1306 incorrectly treated as a network share. Ignore newdir in
1307 this case (keeping the drive letter). */
1308 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1309 && newdir
[1] == '\0'))
1311 strcpy (target
, newdir
);
1314 file_name_as_directory (target
, newdir
, length
, multibyte
);
1317 strcat (target
, nm
);
1319 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1327 if (!IS_DIRECTORY_SEP (*p
))
1331 else if (p
[1] == '.'
1332 && (IS_DIRECTORY_SEP (p
[2])
1335 /* If "/." is the entire filename, keep the "/". Otherwise,
1336 just delete the whole "/.". */
1337 if (o
== target
&& p
[2] == '\0')
1341 else if (p
[1] == '.' && p
[2] == '.'
1342 /* `/../' is the "superroot" on certain file systems.
1343 Turned off on DOS_NT systems because they have no
1344 "superroot" and because this causes us to produce
1345 file names like "d:/../foo" which fail file-related
1346 functions of the underlying OS. (To reproduce, try a
1347 long series of "../../" in default_directory, longer
1348 than the number of levels from the root.) */
1352 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1357 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1360 /* Don't go below server level in UNC filenames. */
1361 if (o
== target
+ 1 && IS_DIRECTORY_SEP (*o
)
1362 && IS_DIRECTORY_SEP (*target
))
1366 /* Keep initial / only if this is the whole name. */
1367 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1371 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1372 /* Collapse multiple `/' in a row. */
1381 /* At last, set drive name. */
1383 /* Except for network file name. */
1384 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1385 #endif /* WINDOWSNT */
1387 if (!drive
) emacs_abort ();
1389 target
[0] = DRIVE_LETTER (drive
);
1392 /* Reinsert the escape prefix if required. */
1399 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1402 result
= ENCODE_FILE (result
);
1403 dostounix_filename (SSDATA (result
));
1404 result
= DECODE_FILE (result
);
1407 dostounix_filename (SSDATA (result
));
1409 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1410 #endif /* !DOS_NT */
1413 /* Again look to see if the file name has special constructs in it
1414 and perhaps call the corresponding file handler. This is needed
1415 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1416 the ".." component gives us "/user@host:/bar/../baz" which needs
1417 to be expanded again. */
1418 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1419 if (!NILP (handler
))
1421 handled_name
= call3 (handler
, Qexpand_file_name
,
1422 result
, default_directory
);
1423 if (STRINGP (handled_name
))
1424 return handled_name
;
1425 error ("Invalid handler in `file-name-handler-alist'");
1432 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1433 This is the old version of expand-file-name, before it was thoroughly
1434 rewritten for Emacs 10.31. We leave this version here commented-out,
1435 because the code is very complex and likely to have subtle bugs. If
1436 bugs _are_ found, it might be of interest to look at the old code and
1437 see what did it do in the relevant situation.
1439 Don't remove this code: it's true that it will be accessible
1440 from the repository, but a few years from deletion, people will
1441 forget it is there. */
1443 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1444 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1445 "Convert FILENAME to absolute, and canonicalize it.\n\
1446 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1447 \(does not start with slash); if DEFAULT is nil or missing,\n\
1448 the current buffer's value of default-directory is used.\n\
1449 Filenames containing `.' or `..' as components are simplified;\n\
1450 initial `~/' expands to your home directory.\n\
1451 See also the function `substitute-in-file-name'.")
1453 Lisp_Object name
, defalt
;
1457 register unsigned char *newdir
, *p
, *o
;
1459 unsigned char *target
;
1462 CHECK_STRING (name
);
1465 /* If nm is absolute, flush ...// and detect /./ and /../.
1466 If no /./ or /../ we can return right away. */
1473 if (p
[0] == '/' && p
[1] == '/')
1475 if (p
[0] == '/' && p
[1] == '~')
1476 nm
= p
+ 1, lose
= 1;
1477 if (p
[0] == '/' && p
[1] == '.'
1478 && (p
[2] == '/' || p
[2] == 0
1479 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1485 if (nm
== SDATA (name
))
1487 return build_string (nm
);
1491 /* Now determine directory to start with and put it in NEWDIR. */
1495 if (nm
[0] == '~') /* prefix ~ */
1496 if (nm
[1] == '/' || nm
[1] == 0)/* ~/filename */
1498 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1499 newdir
= (unsigned char *) "";
1502 else /* ~user/filename */
1504 /* Get past ~ to user. */
1505 unsigned char *user
= nm
+ 1;
1506 /* Find end of name. */
1507 unsigned char *ptr
= (unsigned char *) strchr (user
, '/');
1508 ptrdiff_t len
= ptr
? ptr
- user
: strlen (user
);
1509 /* Copy the user name into temp storage. */
1510 o
= alloca (len
+ 1);
1511 memcpy (o
, user
, len
);
1514 /* Look up the user name. */
1516 pw
= (struct passwd
*) getpwnam (o
+ 1);
1519 error ("\"%s\" isn't a registered user", o
+ 1);
1521 newdir
= (unsigned char *) pw
->pw_dir
;
1523 /* Discard the user name from NM. */
1527 if (nm
[0] != '/' && !newdir
)
1530 defalt
= current_buffer
->directory
;
1531 CHECK_STRING (defalt
);
1532 newdir
= SDATA (defalt
);
1535 /* Now concatenate the directory and name to new space in the stack frame. */
1537 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1538 target
= alloca (tlen
);
1543 if (nm
[0] == 0 || nm
[0] == '/')
1544 strcpy (target
, newdir
);
1546 file_name_as_directory (target
, newdir
);
1549 strcat (target
, nm
);
1551 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1562 else if (!strncmp (p
, "//", 2)
1568 else if (p
[0] == '/' && p
[1] == '.'
1569 && (p
[2] == '/' || p
[2] == 0))
1571 else if (!strncmp (p
, "/..", 3)
1572 /* `/../' is the "superroot" on certain file systems. */
1574 && (p
[3] == '/' || p
[3] == 0))
1576 while (o
!= target
&& *--o
!= '/')
1578 if (o
== target
&& *o
== '/')
1588 return make_string (target
, o
- target
);
1592 /* If /~ or // appears, discard everything through first slash. */
1594 file_name_absolute_p (const char *filename
)
1597 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
1599 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
1600 && IS_DIRECTORY_SEP (filename
[2]))
1606 search_embedded_absfilename (char *nm
, char *endp
)
1610 for (p
= nm
+ 1; p
< endp
; p
++)
1612 if (IS_DIRECTORY_SEP (p
[-1])
1613 && file_name_absolute_p (p
)
1614 #if defined (WINDOWSNT) || defined (CYGWIN)
1615 /* // at start of file name is meaningful in Apollo,
1616 WindowsNT and Cygwin systems. */
1617 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
1618 #endif /* not (WINDOWSNT || CYGWIN) */
1621 for (s
= p
; *s
&& !IS_DIRECTORY_SEP (*s
); s
++);
1622 if (p
[0] == '~' && s
> p
+ 1) /* We've got "/~something/". */
1624 char *o
= alloca (s
- p
+ 1);
1626 memcpy (o
, p
, s
- p
);
1629 /* If we have ~user and `user' exists, discard
1630 everything up to ~. But if `user' does not exist, leave
1631 ~user alone, it might be a literal file name. */
1633 pw
= getpwnam (o
+ 1);
1645 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1646 Ssubstitute_in_file_name
, 1, 1, 0,
1647 doc
: /* Substitute environment variables referred to in FILENAME.
1648 `$FOO' where FOO is an environment variable name means to substitute
1649 the value of that variable. The variable name should be terminated
1650 with a character not a letter, digit or underscore; otherwise, enclose
1651 the entire variable name in braces.
1653 If `/~' appears, all of FILENAME through that `/' is discarded.
1654 If `//' appears, everything up to and including the first of
1655 those `/' is discarded. */)
1656 (Lisp_Object filename
)
1658 char *nm
, *s
, *p
, *o
, *x
, *endp
;
1659 char *target
= NULL
;
1660 ptrdiff_t total
= 0;
1661 bool substituted
= 0;
1664 Lisp_Object handler
;
1666 CHECK_STRING (filename
);
1668 multibyte
= STRING_MULTIBYTE (filename
);
1670 /* If the file name has special constructs in it,
1671 call the corresponding file handler. */
1672 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1673 if (!NILP (handler
))
1675 Lisp_Object handled_name
= call2 (handler
, Qsubstitute_in_file_name
,
1677 if (STRINGP (handled_name
))
1678 return handled_name
;
1679 error ("Invalid handler in `file-name-handler-alist'");
1682 /* Always work on a copy of the string, in case GC happens during
1683 decode of environment variables, causing the original Lisp_String
1684 data to be relocated. */
1685 nm
= alloca (SBYTES (filename
) + 1);
1686 memcpy (nm
, SDATA (filename
), SBYTES (filename
) + 1);
1691 Lisp_Object encoded_filename
= ENCODE_FILE (filename
);
1694 dostounix_filename (SDATA (encoded_filename
));
1695 tem_fn
= DECODE_FILE (encoded_filename
);
1696 nm
= alloca (SBYTES (tem_fn
) + 1);
1697 memcpy (nm
, SDATA (tem_fn
), SBYTES (tem_fn
) + 1);
1698 substituted
= (memcmp (nm
, SDATA (filename
), SBYTES (filename
)) != 0);
1704 dostounix_filename (nm
);
1705 substituted
= (memcmp (nm
, SDATA (filename
), SBYTES (filename
)) != 0);
1708 endp
= nm
+ SBYTES (filename
);
1710 /* If /~ or // appears, discard everything through first slash. */
1711 p
= search_embedded_absfilename (nm
, endp
);
1713 /* Start over with the new string, so we check the file-name-handler
1714 again. Important with filenames like "/home/foo//:/hello///there"
1715 which would substitute to "/:/hello///there" rather than "/there". */
1716 return Fsubstitute_in_file_name
1717 (make_specified_string (p
, -1, endp
- p
, multibyte
));
1719 /* See if any variables are substituted into the string
1720 and find the total length of their values in `total'. */
1722 for (p
= nm
; p
!= endp
;)
1732 /* "$$" means a single "$". */
1741 while (p
!= endp
&& *p
!= '}') p
++;
1742 if (*p
!= '}') goto missingclose
;
1748 while (p
!= endp
&& (c_isalnum (*p
) || *p
== '_')) p
++;
1752 /* Copy out the variable name. */
1753 target
= alloca (s
- o
+ 1);
1754 memcpy (target
, o
, s
- o
);
1757 strupr (target
); /* $home == $HOME etc. */
1760 /* Get variable value. */
1761 o
= egetenv (target
);
1764 /* Don't try to guess a maximum length - UTF8 can use up to
1765 four bytes per character. This code is unlikely to run
1766 in a situation that requires performance, so decoding the
1767 env variables twice should be acceptable. Note that
1768 decoding may cause a garbage collect. */
1769 Lisp_Object orig
, decoded
;
1770 orig
= build_unibyte_string (o
);
1771 decoded
= DECODE_FILE (orig
);
1772 total
+= SBYTES (decoded
);
1782 /* If substitution required, recopy the string and do it. */
1783 /* Make space in stack frame for the new copy. */
1784 xnm
= alloca (SBYTES (filename
) + total
+ 1);
1787 /* Copy the rest of the name through, replacing $ constructs with values. */
1804 while (p
!= endp
&& *p
!= '}') p
++;
1805 if (*p
!= '}') goto missingclose
;
1811 while (p
!= endp
&& (c_isalnum (*p
) || *p
== '_')) p
++;
1815 /* Copy out the variable name. */
1816 target
= alloca (s
- o
+ 1);
1817 memcpy (target
, o
, s
- o
);
1820 strupr (target
); /* $home == $HOME etc. */
1823 /* Get variable value. */
1824 o
= egetenv (target
);
1828 strcpy (x
, target
); x
+= strlen (target
);
1832 Lisp_Object orig
, decoded
;
1833 ptrdiff_t orig_length
, decoded_length
;
1834 orig_length
= strlen (o
);
1835 orig
= make_unibyte_string (o
, orig_length
);
1836 decoded
= DECODE_FILE (orig
);
1837 decoded_length
= SBYTES (decoded
);
1838 memcpy (x
, SDATA (decoded
), decoded_length
);
1839 x
+= decoded_length
;
1841 /* If environment variable needed decoding, return value
1842 needs to be multibyte. */
1843 if (decoded_length
!= orig_length
1844 || memcmp (SDATA (decoded
), o
, orig_length
))
1851 /* If /~ or // appears, discard everything through first slash. */
1852 while ((p
= search_embedded_absfilename (xnm
, x
)) != NULL
)
1853 /* This time we do not start over because we've already expanded envvars
1854 and replaced $$ with $. Maybe we should start over as well, but we'd
1855 need to quote some $ to $$ first. */
1858 return make_specified_string (xnm
, -1, x
- xnm
, multibyte
);
1861 error ("Bad format environment-variable substitution");
1863 error ("Missing \"}\" in environment-variable substitution");
1865 error ("Substituting nonexistent environment variable \"%s\"", target
);
1871 /* A slightly faster and more convenient way to get
1872 (directory-file-name (expand-file-name FOO)). */
1875 expand_and_dir_to_file (Lisp_Object filename
, Lisp_Object defdir
)
1877 register Lisp_Object absname
;
1879 absname
= Fexpand_file_name (filename
, defdir
);
1881 /* Remove final slash, if any (unless this is the root dir).
1882 stat behaves differently depending! */
1883 if (SCHARS (absname
) > 1
1884 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
1885 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
) - 2)))
1886 /* We cannot take shortcuts; they might be wrong for magic file names. */
1887 absname
= Fdirectory_file_name (absname
);
1891 /* Signal an error if the file ABSNAME already exists.
1892 If INTERACTIVE, ask the user whether to proceed,
1893 and bypass the error if the user says to go ahead.
1894 QUERYSTRING is a name for the action that is being considered
1897 *STATPTR is used to store the stat information if the file exists.
1898 If the file does not exist, STATPTR->st_mode is set to 0.
1899 If STATPTR is null, we don't store into it.
1901 If QUICK, ask for y or n, not yes or no. */
1904 barf_or_query_if_file_exists (Lisp_Object absname
, const char *querystring
,
1905 bool interactive
, struct stat
*statptr
,
1908 Lisp_Object tem
, encoded_filename
;
1909 struct stat statbuf
;
1910 struct gcpro gcpro1
;
1912 encoded_filename
= ENCODE_FILE (absname
);
1914 /* `stat' is a good way to tell whether the file exists,
1915 regardless of what access permissions it has. */
1916 if (lstat (SSDATA (encoded_filename
), &statbuf
) >= 0)
1918 if (S_ISDIR (statbuf
.st_mode
))
1919 xsignal2 (Qfile_error
,
1920 build_string ("File is a directory"), absname
);
1923 xsignal2 (Qfile_already_exists
,
1924 build_string ("File already exists"), absname
);
1926 tem
= format2 ("File %s already exists; %s anyway? ",
1927 absname
, build_string (querystring
));
1929 tem
= call1 (intern ("y-or-n-p"), tem
);
1931 tem
= do_yes_or_no_p (tem
);
1934 xsignal2 (Qfile_already_exists
,
1935 build_string ("File already exists"), absname
);
1942 statptr
->st_mode
= 0;
1947 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
1948 "fCopy file: \nGCopy %s to file: \np\nP",
1949 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
1950 If NEWNAME names a directory, copy FILE there.
1952 This function always sets the file modes of the output file to match
1955 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1956 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1957 signal a `file-already-exists' error without overwriting. If
1958 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1959 about overwriting; this is what happens in interactive use with M-x.
1960 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1963 Fourth arg KEEP-TIME non-nil means give the output file the same
1964 last-modified time as the old one. (This works on only some systems.)
1966 A prefix arg makes KEEP-TIME non-nil.
1968 If PRESERVE-UID-GID is non-nil, we try to transfer the
1969 uid and gid of FILE to NEWNAME.
1971 If PRESERVE-EXTENDED-ATTRIBUTES is non-nil, we try to copy additional
1972 attributes of FILE to NEWNAME, such as its SELinux context and ACL
1973 entries (depending on how Emacs was built). */)
1974 (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
)
1978 char buf
[16 * 1024];
1979 struct stat st
, out_st
;
1980 Lisp_Object handler
;
1981 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1982 ptrdiff_t count
= SPECPDL_INDEX ();
1983 Lisp_Object encoded_file
, encoded_newname
;
1985 security_context_t con
;
1988 #ifdef HAVE_POSIX_ACL
1992 encoded_file
= encoded_newname
= Qnil
;
1993 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
1994 CHECK_STRING (file
);
1995 CHECK_STRING (newname
);
1997 if (!NILP (Ffile_directory_p (newname
)))
1998 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2000 newname
= Fexpand_file_name (newname
, Qnil
);
2002 file
= Fexpand_file_name (file
, Qnil
);
2004 /* If the input file name has special constructs in it,
2005 call the corresponding file handler. */
2006 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2007 /* Likewise for output file name. */
2009 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2010 if (!NILP (handler
))
2011 RETURN_UNGCPRO (call7 (handler
, Qcopy_file
, file
, newname
,
2012 ok_if_already_exists
, keep_time
, preserve_uid_gid
,
2013 preserve_extended_attributes
));
2015 encoded_file
= ENCODE_FILE (file
);
2016 encoded_newname
= ENCODE_FILE (newname
);
2018 if (NILP (ok_if_already_exists
)
2019 || INTEGERP (ok_if_already_exists
))
2020 barf_or_query_if_file_exists (newname
, "copy to it",
2021 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2022 else if (stat (SSDATA (encoded_newname
), &out_st
) < 0)
2026 if (!NILP (preserve_extended_attributes
))
2028 #ifdef HAVE_POSIX_ACL
2029 acl
= acl_get_file (SDATA (encoded_file
), ACL_TYPE_ACCESS
);
2030 if (acl
== NULL
&& errno
!= ENOTSUP
)
2031 report_file_error ("Getting ACL", Fcons (file
, Qnil
));
2034 if (!CopyFile (SDATA (encoded_file
),
2035 SDATA (encoded_newname
),
2038 /* CopyFile doesn't set errno when it fails. By far the most
2039 "popular" reason is that the target is read-only. */
2040 if (GetLastError () == 5)
2044 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2046 /* CopyFile retains the timestamp by default. */
2047 else if (NILP (keep_time
))
2053 filename
= SDATA (encoded_newname
);
2055 /* Ensure file is writable while its modified time is set. */
2056 attributes
= GetFileAttributes (filename
);
2057 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2058 now
= current_emacs_time ();
2059 if (set_file_times (-1, filename
, now
, now
))
2061 /* Restore original attributes. */
2062 SetFileAttributes (filename
, attributes
);
2063 xsignal2 (Qfile_date_error
,
2064 build_string ("Cannot set file date"), newname
);
2066 /* Restore original attributes. */
2067 SetFileAttributes (filename
, attributes
);
2069 #ifdef HAVE_POSIX_ACL
2073 acl_set_file (SDATA (encoded_newname
), ACL_TYPE_ACCESS
, acl
) != 0;
2074 if (fail
&& errno
!= ENOTSUP
)
2075 report_file_error ("Setting ACL", Fcons (newname
, Qnil
));
2080 #else /* not WINDOWSNT */
2082 ifd
= emacs_open (SSDATA (encoded_file
), O_RDONLY
, 0);
2086 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2088 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2090 if (fstat (ifd
, &st
) != 0)
2091 report_file_error ("Input file status", Fcons (file
, Qnil
));
2093 if (!NILP (preserve_extended_attributes
))
2096 if (is_selinux_enabled ())
2098 conlength
= fgetfilecon (ifd
, &con
);
2099 if (conlength
== -1)
2100 report_file_error ("Doing fgetfilecon", Fcons (file
, Qnil
));
2104 #ifdef HAVE_POSIX_ACL
2105 acl
= acl_get_fd (ifd
);
2106 if (acl
== NULL
&& errno
!= ENOTSUP
)
2107 report_file_error ("Getting ACL", Fcons (file
, Qnil
));
2111 if (out_st
.st_mode
!= 0
2112 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2115 report_file_error ("Input and output files are the same",
2116 Fcons (file
, Fcons (newname
, Qnil
)));
2119 /* We can copy only regular files. */
2120 if (!S_ISREG (st
.st_mode
))
2122 /* Get a better looking error message. */
2123 errno
= S_ISDIR (st
.st_mode
) ? EISDIR
: EINVAL
;
2124 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2128 /* System's default file type was set to binary by _fmode in emacs.c. */
2129 ofd
= emacs_open (SDATA (encoded_newname
),
2130 O_WRONLY
| O_TRUNC
| O_CREAT
2131 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2132 S_IREAD
| S_IWRITE
);
2133 #else /* not MSDOS */
2135 mode_t new_mask
= !NILP (preserve_uid_gid
) ? 0600 : 0666;
2136 new_mask
&= st
.st_mode
;
2137 ofd
= emacs_open (SSDATA (encoded_newname
),
2138 (O_WRONLY
| O_TRUNC
| O_CREAT
2139 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0)),
2142 #endif /* not MSDOS */
2144 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2146 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2150 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2151 if (emacs_write (ofd
, buf
, n
) != n
)
2152 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2156 /* Preserve the original file modes, and if requested, also its
2159 mode_t mode_mask
= 07777;
2160 if (!NILP (preserve_uid_gid
))
2162 /* Attempt to change owner and group. If that doesn't work
2163 attempt to change just the group, as that is sometimes allowed.
2164 Adjust the mode mask to eliminate setuid or setgid bits
2165 that are inappropriate if the owner and group are wrong. */
2166 if (fchown (ofd
, st
.st_uid
, st
.st_gid
) != 0)
2168 mode_mask
&= ~06000;
2169 if (fchown (ofd
, -1, st
.st_gid
) == 0)
2173 if (fchmod (ofd
, st
.st_mode
& mode_mask
) != 0)
2174 report_file_error ("Doing chmod", Fcons (newname
, Qnil
));
2176 #endif /* not MSDOS */
2181 /* Set the modified context back to the file. */
2182 bool fail
= fsetfilecon (ofd
, con
) != 0;
2183 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2184 if (fail
&& errno
!= ENOTSUP
)
2185 report_file_error ("Doing fsetfilecon", Fcons (newname
, Qnil
));
2191 #ifdef HAVE_POSIX_ACL
2194 bool fail
= acl_set_fd (ofd
, acl
) != 0;
2195 if (fail
&& errno
!= ENOTSUP
)
2196 report_file_error ("Setting ACL", Fcons (newname
, Qnil
));
2202 if (!NILP (keep_time
))
2204 EMACS_TIME atime
= get_stat_atime (&st
);
2205 EMACS_TIME mtime
= get_stat_mtime (&st
);
2206 if (set_file_times (ofd
, SSDATA (encoded_newname
), atime
, mtime
))
2207 xsignal2 (Qfile_date_error
,
2208 build_string ("Cannot set file date"), newname
);
2211 if (emacs_close (ofd
) < 0)
2212 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2217 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2218 and if it can't, it tells so. Otherwise, under MSDOS we usually
2219 get only the READ bit, which will make the copied file read-only,
2220 so it's better not to chmod at all. */
2221 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2222 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2224 #endif /* not WINDOWSNT */
2226 /* Discard the unwind protects. */
2227 specpdl_ptr
= specpdl
+ count
;
2233 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2234 Smake_directory_internal
, 1, 1, 0,
2235 doc
: /* Create a new directory named DIRECTORY. */)
2236 (Lisp_Object directory
)
2239 Lisp_Object handler
;
2240 Lisp_Object encoded_dir
;
2242 CHECK_STRING (directory
);
2243 directory
= Fexpand_file_name (directory
, Qnil
);
2245 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2246 if (!NILP (handler
))
2247 return call2 (handler
, Qmake_directory_internal
, directory
);
2249 encoded_dir
= ENCODE_FILE (directory
);
2251 dir
= SSDATA (encoded_dir
);
2254 if (mkdir (dir
) != 0)
2256 if (mkdir (dir
, 0777 & ~auto_saving_dir_umask
) != 0)
2258 report_file_error ("Creating directory", list1 (directory
));
2263 DEFUN ("delete-directory-internal", Fdelete_directory_internal
,
2264 Sdelete_directory_internal
, 1, 1, 0,
2265 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2266 (Lisp_Object directory
)
2269 Lisp_Object encoded_dir
;
2271 CHECK_STRING (directory
);
2272 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2273 encoded_dir
= ENCODE_FILE (directory
);
2274 dir
= SSDATA (encoded_dir
);
2276 if (rmdir (dir
) != 0)
2277 report_file_error ("Removing directory", list1 (directory
));
2282 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 2,
2283 "(list (read-file-name \
2284 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2285 \"Move file to trash: \" \"Delete file: \") \
2286 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2287 (null current-prefix-arg))",
2288 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2289 If file has multiple names, it continues to exist with the other names.
2290 TRASH non-nil means to trash the file instead of deleting, provided
2291 `delete-by-moving-to-trash' is non-nil.
2293 When called interactively, TRASH is t if no prefix argument is given.
2294 With a prefix argument, TRASH is nil. */)
2295 (Lisp_Object filename
, Lisp_Object trash
)
2297 Lisp_Object handler
;
2298 Lisp_Object encoded_file
;
2299 struct gcpro gcpro1
;
2302 if (!NILP (Ffile_directory_p (filename
))
2303 && NILP (Ffile_symlink_p (filename
)))
2304 xsignal2 (Qfile_error
,
2305 build_string ("Removing old name: is a directory"),
2308 filename
= Fexpand_file_name (filename
, Qnil
);
2310 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2311 if (!NILP (handler
))
2312 return call3 (handler
, Qdelete_file
, filename
, trash
);
2314 if (delete_by_moving_to_trash
&& !NILP (trash
))
2315 return call1 (Qmove_file_to_trash
, filename
);
2317 encoded_file
= ENCODE_FILE (filename
);
2319 if (unlink (SSDATA (encoded_file
)) < 0)
2320 report_file_error ("Removing old name", list1 (filename
));
2325 internal_delete_file_1 (Lisp_Object ignore
)
2330 /* Delete file FILENAME, returning true if successful.
2331 This ignores `delete-by-moving-to-trash'. */
2334 internal_delete_file (Lisp_Object filename
)
2338 tem
= internal_condition_case_2 (Fdelete_file
, filename
, Qnil
,
2339 Qt
, internal_delete_file_1
);
2343 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2344 "fRename file: \nGRename %s to file: \np",
2345 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2346 If file has names other than FILE, it continues to have those names.
2347 Signals a `file-already-exists' error if a file NEWNAME already exists
2348 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2349 A number as third arg means request confirmation if NEWNAME already exists.
2350 This is what happens in interactive use with M-x. */)
2351 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2353 Lisp_Object handler
;
2354 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2355 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2357 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2358 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2359 CHECK_STRING (file
);
2360 CHECK_STRING (newname
);
2361 file
= Fexpand_file_name (file
, Qnil
);
2363 if ((!NILP (Ffile_directory_p (newname
)))
2365 /* If the file names are identical but for the case,
2366 don't attempt to move directory to itself. */
2367 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2371 Lisp_Object fname
= (NILP (Ffile_directory_p (file
))
2372 ? file
: Fdirectory_file_name (file
));
2373 newname
= Fexpand_file_name (Ffile_name_nondirectory (fname
), newname
);
2376 newname
= Fexpand_file_name (newname
, Qnil
);
2378 /* If the file name has special constructs in it,
2379 call the corresponding file handler. */
2380 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2382 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2383 if (!NILP (handler
))
2384 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2385 file
, newname
, ok_if_already_exists
));
2387 encoded_file
= ENCODE_FILE (file
);
2388 encoded_newname
= ENCODE_FILE (newname
);
2391 /* If the file names are identical but for the case, don't ask for
2392 confirmation: they simply want to change the letter-case of the
2394 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2396 if (NILP (ok_if_already_exists
)
2397 || INTEGERP (ok_if_already_exists
))
2398 barf_or_query_if_file_exists (newname
, "rename to it",
2399 INTEGERP (ok_if_already_exists
), 0, 0);
2400 if (rename (SSDATA (encoded_file
), SSDATA (encoded_newname
)) < 0)
2405 symlink_target
= Ffile_symlink_p (file
);
2406 if (! NILP (symlink_target
))
2407 Fmake_symbolic_link (symlink_target
, newname
,
2408 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2409 else if (!NILP (Ffile_directory_p (file
)))
2410 call4 (Qcopy_directory
, file
, newname
, Qt
, Qnil
);
2412 /* We have already prompted if it was an integer, so don't
2413 have copy-file prompt again. */
2414 Fcopy_file (file
, newname
,
2415 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2418 count
= SPECPDL_INDEX ();
2419 specbind (Qdelete_by_moving_to_trash
, Qnil
);
2421 if (!NILP (Ffile_directory_p (file
)) && NILP (symlink_target
))
2422 call2 (Qdelete_directory
, file
, Qt
);
2424 Fdelete_file (file
, Qnil
);
2425 unbind_to (count
, Qnil
);
2428 report_file_error ("Renaming", list2 (file
, newname
));
2434 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2435 "fAdd name to file: \nGName to add to %s: \np",
2436 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2437 Signals a `file-already-exists' error if a file NEWNAME already exists
2438 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2439 A number as third arg means request confirmation if NEWNAME already exists.
2440 This is what happens in interactive use with M-x. */)
2441 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2443 Lisp_Object handler
;
2444 Lisp_Object encoded_file
, encoded_newname
;
2445 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2447 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2448 encoded_file
= encoded_newname
= Qnil
;
2449 CHECK_STRING (file
);
2450 CHECK_STRING (newname
);
2451 file
= Fexpand_file_name (file
, Qnil
);
2453 if (!NILP (Ffile_directory_p (newname
)))
2454 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2456 newname
= Fexpand_file_name (newname
, Qnil
);
2458 /* If the file name has special constructs in it,
2459 call the corresponding file handler. */
2460 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2461 if (!NILP (handler
))
2462 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2463 newname
, ok_if_already_exists
));
2465 /* If the new name has special constructs in it,
2466 call the corresponding file handler. */
2467 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2468 if (!NILP (handler
))
2469 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2470 newname
, ok_if_already_exists
));
2472 encoded_file
= ENCODE_FILE (file
);
2473 encoded_newname
= ENCODE_FILE (newname
);
2475 if (NILP (ok_if_already_exists
)
2476 || INTEGERP (ok_if_already_exists
))
2477 barf_or_query_if_file_exists (newname
, "make it a new name",
2478 INTEGERP (ok_if_already_exists
), 0, 0);
2480 unlink (SSDATA (newname
));
2481 if (link (SSDATA (encoded_file
), SSDATA (encoded_newname
)) < 0)
2482 report_file_error ("Adding new name", list2 (file
, newname
));
2488 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2489 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2490 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2491 Both args must be strings.
2492 Signals a `file-already-exists' error if a file LINKNAME already exists
2493 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2494 A number as third arg means request confirmation if LINKNAME already exists.
2495 This happens for interactive use with M-x. */)
2496 (Lisp_Object filename
, Lisp_Object linkname
, Lisp_Object ok_if_already_exists
)
2498 Lisp_Object handler
;
2499 Lisp_Object encoded_filename
, encoded_linkname
;
2500 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2502 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2503 encoded_filename
= encoded_linkname
= Qnil
;
2504 CHECK_STRING (filename
);
2505 CHECK_STRING (linkname
);
2506 /* If the link target has a ~, we must expand it to get
2507 a truly valid file name. Otherwise, do not expand;
2508 we want to permit links to relative file names. */
2509 if (SREF (filename
, 0) == '~')
2510 filename
= Fexpand_file_name (filename
, Qnil
);
2512 if (!NILP (Ffile_directory_p (linkname
)))
2513 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2515 linkname
= Fexpand_file_name (linkname
, Qnil
);
2517 /* If the file name has special constructs in it,
2518 call the corresponding file handler. */
2519 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2520 if (!NILP (handler
))
2521 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2522 linkname
, ok_if_already_exists
));
2524 /* If the new link name has special constructs in it,
2525 call the corresponding file handler. */
2526 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2527 if (!NILP (handler
))
2528 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2529 linkname
, ok_if_already_exists
));
2531 encoded_filename
= ENCODE_FILE (filename
);
2532 encoded_linkname
= ENCODE_FILE (linkname
);
2534 if (NILP (ok_if_already_exists
)
2535 || INTEGERP (ok_if_already_exists
))
2536 barf_or_query_if_file_exists (linkname
, "make it a link",
2537 INTEGERP (ok_if_already_exists
), 0, 0);
2538 if (symlink (SSDATA (encoded_filename
), SSDATA (encoded_linkname
)) < 0)
2540 /* If we didn't complain already, silently delete existing file. */
2541 if (errno
== EEXIST
)
2543 unlink (SSDATA (encoded_linkname
));
2544 if (symlink (SSDATA (encoded_filename
), SSDATA (encoded_linkname
))
2551 if (errno
== ENOSYS
)
2554 xsignal1 (Qfile_error
,
2555 build_string ("Symbolic links are not supported"));
2558 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2565 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2567 doc
: /* Return t if file FILENAME specifies an absolute file name.
2568 On Unix, this is a name starting with a `/' or a `~'. */)
2569 (Lisp_Object filename
)
2571 CHECK_STRING (filename
);
2572 return file_name_absolute_p (SSDATA (filename
)) ? Qt
: Qnil
;
2575 /* Return true if FILENAME exists. */
2577 check_existing (const char *filename
)
2579 return faccessat (AT_FDCWD
, filename
, F_OK
, AT_EACCESS
) == 0;
2582 /* Return true if file FILENAME exists and can be executed. */
2585 check_executable (char *filename
)
2587 return faccessat (AT_FDCWD
, filename
, X_OK
, AT_EACCESS
) == 0;
2590 /* Return true if file FILENAME exists and can be accessed
2591 according to AMODE, which should include W_OK.
2592 On failure, return false and set errno. */
2595 check_writable (const char *filename
, int amode
)
2598 /* FIXME: an faccessat implementation should be added to the
2599 DOS/Windows ports and this #ifdef branch should be removed. */
2601 if (stat (filename
, &st
) < 0)
2604 return (st
.st_mode
& S_IWRITE
|| S_ISDIR (st
.st_mode
));
2605 #else /* not MSDOS */
2606 bool res
= faccessat (AT_FDCWD
, filename
, amode
, AT_EACCESS
) == 0;
2608 /* faccessat may have returned failure because Cygwin couldn't
2609 determine the file's UID or GID; if so, we return success. */
2612 int faccessat_errno
= errno
;
2614 if (stat (filename
, &st
) < 0)
2616 res
= (st
.st_uid
== -1 || st
.st_gid
== -1);
2617 errno
= faccessat_errno
;
2621 #endif /* not MSDOS */
2624 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2625 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
2626 See also `file-readable-p' and `file-attributes'.
2627 This returns nil for a symlink to a nonexistent file.
2628 Use `file-symlink-p' to test for such links. */)
2629 (Lisp_Object filename
)
2631 Lisp_Object absname
;
2632 Lisp_Object handler
;
2634 CHECK_STRING (filename
);
2635 absname
= Fexpand_file_name (filename
, Qnil
);
2637 /* If the file name has special constructs in it,
2638 call the corresponding file handler. */
2639 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2640 if (!NILP (handler
))
2641 return call2 (handler
, Qfile_exists_p
, absname
);
2643 absname
= ENCODE_FILE (absname
);
2645 return (check_existing (SSDATA (absname
))) ? Qt
: Qnil
;
2648 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2649 doc
: /* Return t if FILENAME can be executed by you.
2650 For a directory, this means you can access files in that directory. */)
2651 (Lisp_Object filename
)
2653 Lisp_Object absname
;
2654 Lisp_Object handler
;
2656 CHECK_STRING (filename
);
2657 absname
= Fexpand_file_name (filename
, Qnil
);
2659 /* If the file name has special constructs in it,
2660 call the corresponding file handler. */
2661 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2662 if (!NILP (handler
))
2663 return call2 (handler
, Qfile_executable_p
, absname
);
2665 absname
= ENCODE_FILE (absname
);
2667 return (check_executable (SSDATA (absname
)) ? Qt
: Qnil
);
2670 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2671 doc
: /* Return t if file FILENAME exists and you can read it.
2672 See also `file-exists-p' and `file-attributes'. */)
2673 (Lisp_Object filename
)
2675 Lisp_Object absname
;
2676 Lisp_Object handler
;
2678 CHECK_STRING (filename
);
2679 absname
= Fexpand_file_name (filename
, Qnil
);
2681 /* If the file name has special constructs in it,
2682 call the corresponding file handler. */
2683 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2684 if (!NILP (handler
))
2685 return call2 (handler
, Qfile_readable_p
, absname
);
2687 absname
= ENCODE_FILE (absname
);
2688 return (faccessat (AT_FDCWD
, SSDATA (absname
), R_OK
, AT_EACCESS
) == 0
2692 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2693 doc
: /* Return t if file FILENAME can be written or created by you. */)
2694 (Lisp_Object filename
)
2696 Lisp_Object absname
, dir
, encoded
;
2697 Lisp_Object handler
;
2699 CHECK_STRING (filename
);
2700 absname
= Fexpand_file_name (filename
, Qnil
);
2702 /* If the file name has special constructs in it,
2703 call the corresponding file handler. */
2704 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2705 if (!NILP (handler
))
2706 return call2 (handler
, Qfile_writable_p
, absname
);
2708 encoded
= ENCODE_FILE (absname
);
2709 if (check_writable (SSDATA (encoded
), W_OK
))
2711 if (errno
!= ENOENT
)
2714 dir
= Ffile_name_directory (absname
);
2715 eassert (!NILP (dir
));
2717 dir
= Fdirectory_file_name (dir
);
2720 dir
= ENCODE_FILE (dir
);
2722 /* The read-only attribute of the parent directory doesn't affect
2723 whether a file or directory can be created within it. Some day we
2724 should check ACLs though, which do affect this. */
2725 return file_directory_p (SDATA (dir
)) ? Qt
: Qnil
;
2727 return check_writable (SSDATA (dir
), W_OK
| X_OK
) ? Qt
: Qnil
;
2731 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2732 doc
: /* Access file FILENAME, and get an error if that does not work.
2733 The second argument STRING is used in the error message.
2734 If there is no error, returns nil. */)
2735 (Lisp_Object filename
, Lisp_Object string
)
2737 Lisp_Object handler
, encoded_filename
, absname
;
2740 CHECK_STRING (filename
);
2741 absname
= Fexpand_file_name (filename
, Qnil
);
2743 CHECK_STRING (string
);
2745 /* If the file name has special constructs in it,
2746 call the corresponding file handler. */
2747 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
2748 if (!NILP (handler
))
2749 return call3 (handler
, Qaccess_file
, absname
, string
);
2751 encoded_filename
= ENCODE_FILE (absname
);
2753 fd
= emacs_open (SSDATA (encoded_filename
), O_RDONLY
, 0);
2755 report_file_error (SSDATA (string
), Fcons (filename
, Qnil
));
2761 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2762 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
2763 The value is the link target, as a string.
2764 Otherwise it returns nil.
2766 This function returns t when given the name of a symlink that
2767 points to a nonexistent file. */)
2768 (Lisp_Object filename
)
2770 Lisp_Object handler
;
2773 char readlink_buf
[READLINK_BUFSIZE
];
2775 CHECK_STRING (filename
);
2776 filename
= Fexpand_file_name (filename
, Qnil
);
2778 /* If the file name has special constructs in it,
2779 call the corresponding file handler. */
2780 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2781 if (!NILP (handler
))
2782 return call2 (handler
, Qfile_symlink_p
, filename
);
2784 filename
= ENCODE_FILE (filename
);
2786 buf
= emacs_readlink (SSDATA (filename
), readlink_buf
);
2790 val
= build_string (buf
);
2791 if (buf
[0] == '/' && strchr (buf
, ':'))
2792 val
= concat2 (build_string ("/:"), val
);
2793 if (buf
!= readlink_buf
)
2795 val
= DECODE_FILE (val
);
2799 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2800 doc
: /* Return t if FILENAME names an existing directory.
2801 Symbolic links to directories count as directories.
2802 See `file-symlink-p' to distinguish symlinks. */)
2803 (Lisp_Object filename
)
2805 Lisp_Object absname
;
2806 Lisp_Object handler
;
2808 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2810 /* If the file name has special constructs in it,
2811 call the corresponding file handler. */
2812 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2813 if (!NILP (handler
))
2814 return call2 (handler
, Qfile_directory_p
, absname
);
2816 absname
= ENCODE_FILE (absname
);
2818 return file_directory_p (SSDATA (absname
)) ? Qt
: Qnil
;
2821 /* Return true if FILE is a directory or a symlink to a directory. */
2823 file_directory_p (char const *file
)
2826 /* This is cheaper than 'stat'. */
2827 return faccessat (AT_FDCWD
, file
, D_OK
, AT_EACCESS
) == 0;
2830 return stat (file
, &st
) == 0 && S_ISDIR (st
.st_mode
);
2834 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
,
2835 Sfile_accessible_directory_p
, 1, 1, 0,
2836 doc
: /* Return t if file FILENAME names a directory you can open.
2837 For the value to be t, FILENAME must specify the name of a directory as a file,
2838 and the directory must allow you to open files in it. In order to use a
2839 directory as a buffer's current directory, this predicate must return true.
2840 A directory name spec may be given instead; then the value is t
2841 if the directory so specified exists and really is a readable and
2842 searchable directory. */)
2843 (Lisp_Object filename
)
2845 Lisp_Object absname
;
2846 Lisp_Object handler
;
2848 CHECK_STRING (filename
);
2849 absname
= Fexpand_file_name (filename
, Qnil
);
2851 /* If the file name has special constructs in it,
2852 call the corresponding file handler. */
2853 handler
= Ffind_file_name_handler (absname
, Qfile_accessible_directory_p
);
2854 if (!NILP (handler
))
2855 return call2 (handler
, Qfile_accessible_directory_p
, absname
);
2857 absname
= ENCODE_FILE (absname
);
2858 return file_accessible_directory_p (SSDATA (absname
)) ? Qt
: Qnil
;
2861 /* If FILE is a searchable directory or a symlink to a
2862 searchable directory, return true. Otherwise return
2863 false and set errno to an error number. */
2865 file_accessible_directory_p (char const *file
)
2868 /* There's no need to test whether FILE is searchable, as the
2869 searchable/executable bit is invented on DOS_NT platforms. */
2870 return file_directory_p (file
);
2872 /* On POSIXish platforms, use just one system call; this avoids a
2873 race and is typically faster. */
2874 ptrdiff_t len
= strlen (file
);
2880 /* Normally a file "FOO" is an accessible directory if "FOO/." exists.
2881 There are three exceptions: "", "/", and "//". Leave "" alone,
2882 as it's invalid. Append only "." to the other two exceptions as
2883 "/" and "//" are distinct on some platforms, whereas "/", "///",
2884 "////", etc. are all equivalent. */
2889 /* Just check for trailing '/' when deciding whether to append '/'.
2890 That's simpler than testing the two special cases "/" and "//",
2891 and it's a safe optimization here. */
2892 char *buf
= SAFE_ALLOCA (len
+ 3);
2893 memcpy (buf
, file
, len
);
2894 strcpy (buf
+ len
, "/." + (file
[len
- 1] == '/'));
2898 ok
= check_existing (dir
);
2899 saved_errno
= errno
;
2901 errno
= saved_errno
;
2906 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2907 doc
: /* Return t if FILENAME names a regular file.
2908 This is the sort of file that holds an ordinary stream of data bytes.
2909 Symbolic links to regular files count as regular files.
2910 See `file-symlink-p' to distinguish symlinks. */)
2911 (Lisp_Object filename
)
2913 register Lisp_Object absname
;
2915 Lisp_Object handler
;
2917 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2919 /* If the file name has special constructs in it,
2920 call the corresponding file handler. */
2921 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2922 if (!NILP (handler
))
2923 return call2 (handler
, Qfile_regular_p
, absname
);
2925 absname
= ENCODE_FILE (absname
);
2930 Lisp_Object tem
= Vw32_get_true_file_attributes
;
2932 /* Tell stat to use expensive method to get accurate info. */
2933 Vw32_get_true_file_attributes
= Qt
;
2934 result
= stat (SDATA (absname
), &st
);
2935 Vw32_get_true_file_attributes
= tem
;
2939 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2942 if (stat (SSDATA (absname
), &st
) < 0)
2944 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2948 DEFUN ("file-selinux-context", Ffile_selinux_context
,
2949 Sfile_selinux_context
, 1, 1, 0,
2950 doc
: /* Return SELinux context of file named FILENAME.
2951 The return value is a list (USER ROLE TYPE RANGE), where the list
2952 elements are strings naming the user, role, type, and range of the
2953 file's SELinux security context.
2955 Return (nil nil nil nil) if the file is nonexistent or inaccessible,
2956 or if SELinux is disabled, or if Emacs lacks SELinux support. */)
2957 (Lisp_Object filename
)
2959 Lisp_Object absname
;
2960 Lisp_Object values
[4];
2961 Lisp_Object handler
;
2963 security_context_t con
;
2968 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2970 /* If the file name has special constructs in it,
2971 call the corresponding file handler. */
2972 handler
= Ffind_file_name_handler (absname
, Qfile_selinux_context
);
2973 if (!NILP (handler
))
2974 return call2 (handler
, Qfile_selinux_context
, absname
);
2976 absname
= ENCODE_FILE (absname
);
2983 if (is_selinux_enabled ())
2985 conlength
= lgetfilecon (SSDATA (absname
), &con
);
2988 context
= context_new (con
);
2989 if (context_user_get (context
))
2990 values
[0] = build_string (context_user_get (context
));
2991 if (context_role_get (context
))
2992 values
[1] = build_string (context_role_get (context
));
2993 if (context_type_get (context
))
2994 values
[2] = build_string (context_type_get (context
));
2995 if (context_range_get (context
))
2996 values
[3] = build_string (context_range_get (context
));
2997 context_free (context
);
3003 return Flist (sizeof (values
) / sizeof (values
[0]), values
);
3006 DEFUN ("set-file-selinux-context", Fset_file_selinux_context
,
3007 Sset_file_selinux_context
, 2, 2, 0,
3008 doc
: /* Set SELinux context of file named FILENAME to CONTEXT.
3009 CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
3010 elements are strings naming the components of a SELinux context.
3012 Value is t if setting of SELinux context was successful, nil otherwise.
3014 This function does nothing and returns nil if SELinux is disabled,
3015 or if Emacs was not compiled with SELinux support. */)
3016 (Lisp_Object filename
, Lisp_Object context
)
3018 Lisp_Object absname
;
3019 Lisp_Object handler
;
3021 Lisp_Object encoded_absname
;
3022 Lisp_Object user
= CAR_SAFE (context
);
3023 Lisp_Object role
= CAR_SAFE (CDR_SAFE (context
));
3024 Lisp_Object type
= CAR_SAFE (CDR_SAFE (CDR_SAFE (context
)));
3025 Lisp_Object range
= CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context
))));
3026 security_context_t con
;
3029 context_t parsed_con
;
3032 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3034 /* If the file name has special constructs in it,
3035 call the corresponding file handler. */
3036 handler
= Ffind_file_name_handler (absname
, Qset_file_selinux_context
);
3037 if (!NILP (handler
))
3038 return call3 (handler
, Qset_file_selinux_context
, absname
, context
);
3041 if (is_selinux_enabled ())
3043 /* Get current file context. */
3044 encoded_absname
= ENCODE_FILE (absname
);
3045 conlength
= lgetfilecon (SSDATA (encoded_absname
), &con
);
3048 parsed_con
= context_new (con
);
3049 /* Change the parts defined in the parameter.*/
3052 if (context_user_set (parsed_con
, SSDATA (user
)))
3053 error ("Doing context_user_set");
3057 if (context_role_set (parsed_con
, SSDATA (role
)))
3058 error ("Doing context_role_set");
3062 if (context_type_set (parsed_con
, SSDATA (type
)))
3063 error ("Doing context_type_set");
3065 if (STRINGP (range
))
3067 if (context_range_set (parsed_con
, SSDATA (range
)))
3068 error ("Doing context_range_set");
3071 /* Set the modified context back to the file. */
3072 fail
= (lsetfilecon (SSDATA (encoded_absname
),
3073 context_str (parsed_con
))
3075 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
3076 if (fail
&& errno
!= ENOTSUP
)
3077 report_file_error ("Doing lsetfilecon", Fcons (absname
, Qnil
));
3079 context_free (parsed_con
);
3081 return fail
? Qnil
: Qt
;
3084 report_file_error ("Doing lgetfilecon", Fcons (absname
, Qnil
));
3091 DEFUN ("file-acl", Ffile_acl
, Sfile_acl
, 1, 1, 0,
3092 doc
: /* Return ACL entries of file named FILENAME.
3093 The entries are returned in a format suitable for use in `set-file-acl'
3094 but is otherwise undocumented and subject to change.
3095 Return nil if file does not exist or is not accessible, or if Emacs
3096 was unable to determine the ACL entries. */)
3097 (Lisp_Object filename
)
3099 Lisp_Object absname
;
3100 Lisp_Object handler
;
3101 #ifdef HAVE_POSIX_ACL
3103 Lisp_Object acl_string
;
3107 absname
= expand_and_dir_to_file (filename
,
3108 BVAR (current_buffer
, directory
));
3110 /* If the file name has special constructs in it,
3111 call the corresponding file handler. */
3112 handler
= Ffind_file_name_handler (absname
, Qfile_acl
);
3113 if (!NILP (handler
))
3114 return call2 (handler
, Qfile_acl
, absname
);
3116 #ifdef HAVE_POSIX_ACL
3117 absname
= ENCODE_FILE (absname
);
3119 acl
= acl_get_file (SSDATA (absname
), ACL_TYPE_ACCESS
);
3123 str
= acl_to_text (acl
, NULL
);
3130 acl_string
= build_string (str
);
3140 DEFUN ("set-file-acl", Fset_file_acl
, Sset_file_acl
,
3142 doc
: /* Set ACL of file named FILENAME to ACL-STRING.
3143 ACL-STRING should contain the textual representation of the ACL
3144 entries in a format suitable for the platform.
3146 Value is t if setting of ACL was successful, nil otherwise.
3148 Setting ACL for local files requires Emacs to be built with ACL
3150 (Lisp_Object filename
, Lisp_Object acl_string
)
3152 Lisp_Object absname
;
3153 Lisp_Object handler
;
3154 #ifdef HAVE_POSIX_ACL
3155 Lisp_Object encoded_absname
;
3160 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3162 /* If the file name has special constructs in it,
3163 call the corresponding file handler. */
3164 handler
= Ffind_file_name_handler (absname
, Qset_file_acl
);
3165 if (!NILP (handler
))
3166 return call3 (handler
, Qset_file_acl
, absname
, acl_string
);
3168 #ifdef HAVE_POSIX_ACL
3169 if (STRINGP (acl_string
))
3171 acl
= acl_from_text (SSDATA (acl_string
));
3174 report_file_error ("Converting ACL", Fcons (absname
, Qnil
));
3178 encoded_absname
= ENCODE_FILE (absname
);
3180 fail
= (acl_set_file (SSDATA (encoded_absname
), ACL_TYPE_ACCESS
,
3183 if (fail
&& errno
!= ENOTSUP
)
3184 report_file_error ("Setting ACL", Fcons (absname
, Qnil
));
3187 return fail
? Qnil
: Qt
;
3194 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3195 doc
: /* Return mode bits of file named FILENAME, as an integer.
3196 Return nil, if file does not exist or is not accessible. */)
3197 (Lisp_Object filename
)
3199 Lisp_Object absname
;
3201 Lisp_Object handler
;
3203 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
3205 /* If the file name has special constructs in it,
3206 call the corresponding file handler. */
3207 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3208 if (!NILP (handler
))
3209 return call2 (handler
, Qfile_modes
, absname
);
3211 absname
= ENCODE_FILE (absname
);
3213 if (stat (SSDATA (absname
), &st
) < 0)
3216 return make_number (st
.st_mode
& 07777);
3219 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
3220 "(let ((file (read-file-name \"File: \"))) \
3221 (list file (read-file-modes nil file)))",
3222 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3223 Only the 12 low bits of MODE are used.
3225 Interactively, mode bits are read by `read-file-modes', which accepts
3226 symbolic notation, like the `chmod' command from GNU Coreutils. */)
3227 (Lisp_Object filename
, Lisp_Object mode
)
3229 Lisp_Object absname
, encoded_absname
;
3230 Lisp_Object handler
;
3232 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3233 CHECK_NUMBER (mode
);
3235 /* If the file name has special constructs in it,
3236 call the corresponding file handler. */
3237 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3238 if (!NILP (handler
))
3239 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3241 encoded_absname
= ENCODE_FILE (absname
);
3243 if (chmod (SSDATA (encoded_absname
), XINT (mode
) & 07777) < 0)
3244 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3249 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3250 doc
: /* Set the file permission bits for newly created files.
3251 The argument MODE should be an integer; only the low 9 bits are used.
3252 This setting is inherited by subprocesses. */)
3255 CHECK_NUMBER (mode
);
3257 umask ((~ XINT (mode
)) & 0777);
3262 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3263 doc
: /* Return the default file protection for created files.
3264 The value is an integer. */)
3271 realmask
= umask (0);
3275 XSETINT (value
, (~ realmask
) & 0777);
3280 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3281 doc
: /* Set times of file FILENAME to TIMESTAMP.
3282 Set both access and modification times.
3283 Return t on success, else nil.
3284 Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
3286 (Lisp_Object filename
, Lisp_Object timestamp
)
3288 Lisp_Object absname
, encoded_absname
;
3289 Lisp_Object handler
;
3290 EMACS_TIME t
= lisp_time_argument (timestamp
);
3292 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3294 /* If the file name has special constructs in it,
3295 call the corresponding file handler. */
3296 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3297 if (!NILP (handler
))
3298 return call3 (handler
, Qset_file_times
, absname
, timestamp
);
3300 encoded_absname
= ENCODE_FILE (absname
);
3303 if (set_file_times (-1, SSDATA (encoded_absname
), t
, t
))
3306 /* Setting times on a directory always fails. */
3307 if (file_directory_p (SSDATA (encoded_absname
)))
3310 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3319 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3320 doc
: /* Tell Unix to finish all pending disk updates. */)
3327 #endif /* HAVE_SYNC */
3329 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3330 doc
: /* Return t if file FILE1 is newer than file FILE2.
3331 If FILE1 does not exist, the answer is nil;
3332 otherwise, if FILE2 does not exist, the answer is t. */)
3333 (Lisp_Object file1
, Lisp_Object file2
)
3335 Lisp_Object absname1
, absname2
;
3336 struct stat st1
, st2
;
3337 Lisp_Object handler
;
3338 struct gcpro gcpro1
, gcpro2
;
3340 CHECK_STRING (file1
);
3341 CHECK_STRING (file2
);
3344 GCPRO2 (absname1
, file2
);
3345 absname1
= expand_and_dir_to_file (file1
, BVAR (current_buffer
, directory
));
3346 absname2
= expand_and_dir_to_file (file2
, BVAR (current_buffer
, directory
));
3349 /* If the file name has special constructs in it,
3350 call the corresponding file handler. */
3351 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3353 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3354 if (!NILP (handler
))
3355 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3357 GCPRO2 (absname1
, absname2
);
3358 absname1
= ENCODE_FILE (absname1
);
3359 absname2
= ENCODE_FILE (absname2
);
3362 if (stat (SSDATA (absname1
), &st1
) < 0)
3365 if (stat (SSDATA (absname2
), &st2
) < 0)
3368 return (EMACS_TIME_GT (get_stat_mtime (&st1
), get_stat_mtime (&st2
))
3372 #ifndef READ_BUF_SIZE
3373 #define READ_BUF_SIZE (64 << 10)
3375 /* Some buffer offsets are stored in 'int' variables. */
3376 verify (READ_BUF_SIZE
<= INT_MAX
);
3378 /* This function is called after Lisp functions to decide a coding
3379 system are called, or when they cause an error. Before they are
3380 called, the current buffer is set unibyte and it contains only a
3381 newly inserted text (thus the buffer was empty before the
3384 The functions may set markers, overlays, text properties, or even
3385 alter the buffer contents, change the current buffer.
3387 Here, we reset all those changes by:
3388 o set back the current buffer.
3389 o move all markers and overlays to BEG.
3390 o remove all text properties.
3391 o set back the buffer multibyteness. */
3394 decide_coding_unwind (Lisp_Object unwind_data
)
3396 Lisp_Object multibyte
, undo_list
, buffer
;
3398 multibyte
= XCAR (unwind_data
);
3399 unwind_data
= XCDR (unwind_data
);
3400 undo_list
= XCAR (unwind_data
);
3401 buffer
= XCDR (unwind_data
);
3403 set_buffer_internal (XBUFFER (buffer
));
3404 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3405 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3406 set_buffer_intervals (current_buffer
, NULL
);
3407 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3409 /* Now we are safe to change the buffer's multibyteness directly. */
3410 bset_enable_multibyte_characters (current_buffer
, multibyte
);
3411 bset_undo_list (current_buffer
, undo_list
);
3416 /* Check quit and read from the file. STATE is a Lisp_Save_Value
3417 object where slot 0 is the file descriptor, slot 1 specifies
3418 an offset to put the read bytes, and slot 2 is the maximum
3419 amount of bytes to read. Value is the number of bytes read. */
3422 read_contents (Lisp_Object state
)
3428 nbytes
= emacs_read (XSAVE_INTEGER (state
, 0),
3429 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
3430 + XSAVE_INTEGER (state
, 1)),
3431 XSAVE_INTEGER (state
, 2));
3433 /* Fast recycle this object for the likely next call. */
3435 return make_number (nbytes
);
3438 /* Condition-case handler used when reading files in insert-file-contents. */
3441 read_contents_quit (Lisp_Object ignore
)
3446 /* Return the file offset that VAL represents, checking for type
3447 errors and overflow. */
3449 file_offset (Lisp_Object val
)
3451 if (RANGED_INTEGERP (0, val
, TYPE_MAXIMUM (off_t
)))
3456 double v
= XFLOAT_DATA (val
);
3458 && (sizeof (off_t
) < sizeof v
3459 ? v
<= TYPE_MAXIMUM (off_t
)
3460 : v
< TYPE_MAXIMUM (off_t
)))
3464 wrong_type_argument (intern ("file-offset"), val
);
3467 /* Return a special time value indicating the error number ERRNUM. */
3469 time_error_value (int errnum
)
3471 int ns
= (errnum
== ENOENT
|| errnum
== EACCES
|| errnum
== ENOTDIR
3472 ? NONEXISTENT_MODTIME_NSECS
3473 : UNKNOWN_MODTIME_NSECS
);
3474 return make_emacs_time (0, ns
);
3477 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3479 doc
: /* Insert contents of file FILENAME after point.
3480 Returns list of absolute file name and number of characters inserted.
3481 If second argument VISIT is non-nil, the buffer's visited filename and
3482 last save file modtime are set, and it is marked unmodified. If
3483 visiting and the file does not exist, visiting is completed before the
3486 The optional third and fourth arguments BEG and END specify what portion
3487 of the file to insert. These arguments count bytes in the file, not
3488 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3490 If optional fifth argument REPLACE is non-nil, replace the current
3491 buffer contents (in the accessible portion) with the file contents.
3492 This is better than simply deleting and inserting the whole thing
3493 because (1) it preserves some marker positions and (2) it puts less data
3494 in the undo list. When REPLACE is non-nil, the second return value is
3495 the number of characters that replace previous buffer contents.
3497 This function does code conversion according to the value of
3498 `coding-system-for-read' or `file-coding-system-alist', and sets the
3499 variable `last-coding-system-used' to the coding system actually used.
3501 In addition, this function decodes the inserted text from known formats
3502 by calling `format-decode', which see. */)
3503 (Lisp_Object filename
, Lisp_Object visit
, Lisp_Object beg
, Lisp_Object end
, Lisp_Object replace
)
3508 ptrdiff_t inserted
= 0;
3511 off_t beg_offset
, end_offset
;
3513 ptrdiff_t count
= SPECPDL_INDEX ();
3514 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3515 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3517 ptrdiff_t total
= 0;
3518 bool not_regular
= 0;
3519 int save_errno
= 0, read_errno
= 0;
3520 char read_buf
[READ_BUF_SIZE
];
3521 struct coding_system coding
;
3522 char buffer
[1 << 14];
3523 bool replace_handled
= 0;
3524 bool set_coding_system
= 0;
3525 Lisp_Object coding_system
;
3527 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3528 bool we_locked_file
= 0;
3529 bool deferred_remove_unwind_protect
= 0;
3531 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3532 error ("Cannot do file visiting in an indirect buffer");
3534 if (!NILP (BVAR (current_buffer
, read_only
)))
3535 Fbarf_if_buffer_read_only ();
3539 orig_filename
= Qnil
;
3542 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3544 CHECK_STRING (filename
);
3545 filename
= Fexpand_file_name (filename
, Qnil
);
3547 /* The value Qnil means that the coding system is not yet
3549 coding_system
= Qnil
;
3551 /* If the file name has special constructs in it,
3552 call the corresponding file handler. */
3553 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3554 if (!NILP (handler
))
3556 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3557 visit
, beg
, end
, replace
);
3558 if (CONSP (val
) && CONSP (XCDR (val
))
3559 && RANGED_INTEGERP (0, XCAR (XCDR (val
)), ZV
- PT
))
3560 inserted
= XINT (XCAR (XCDR (val
)));
3564 orig_filename
= filename
;
3565 filename
= ENCODE_FILE (filename
);
3567 fd
= emacs_open (SSDATA (filename
), O_RDONLY
, 0);
3572 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3573 mtime
= time_error_value (save_errno
);
3576 if (!NILP (Vcoding_system_for_read
))
3577 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3581 /* Replacement should preserve point as it preserves markers. */
3582 if (!NILP (replace
))
3583 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3585 record_unwind_protect (close_file_unwind
, make_number (fd
));
3587 if (fstat (fd
, &st
) != 0)
3588 report_file_error ("Input file status", Fcons (orig_filename
, Qnil
));
3589 mtime
= get_stat_mtime (&st
);
3591 /* This code will need to be changed in order to work on named
3592 pipes, and it's probably just not worth it. So we should at
3593 least signal an error. */
3594 if (!S_ISREG (st
.st_mode
))
3601 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3602 xsignal2 (Qfile_error
,
3603 build_string ("not a regular file"), orig_filename
);
3608 if (!NILP (beg
) || !NILP (end
))
3609 error ("Attempt to visit less than an entire file");
3610 if (BEG
< Z
&& NILP (replace
))
3611 error ("Cannot do file visiting in a non-empty buffer");
3615 beg_offset
= file_offset (beg
);
3620 end_offset
= file_offset (end
);
3624 end_offset
= TYPE_MAXIMUM (off_t
);
3627 end_offset
= st
.st_size
;
3629 /* A negative size can happen on a platform that allows file
3630 sizes greater than the maximum off_t value. */
3634 /* The file size returned from stat may be zero, but data
3635 may be readable nonetheless, for example when this is a
3636 file in the /proc filesystem. */
3637 if (end_offset
== 0)
3638 end_offset
= READ_BUF_SIZE
;
3642 /* Check now whether the buffer will become too large,
3643 in the likely case where the file's length is not changing.
3644 This saves a lot of needless work before a buffer overflow. */
3647 /* The likely offset where we will stop reading. We could read
3648 more (or less), if the file grows (or shrinks) as we read it. */
3649 off_t likely_end
= min (end_offset
, st
.st_size
);
3651 if (beg_offset
< likely_end
)
3654 = Z_BYTE
- (!NILP (replace
) ? ZV_BYTE
- BEGV_BYTE
: 0);
3655 ptrdiff_t buf_growth_max
= BUF_BYTES_MAX
- buf_bytes
;
3656 off_t likely_growth
= likely_end
- beg_offset
;
3657 if (buf_growth_max
< likely_growth
)
3662 /* Prevent redisplay optimizations. */
3663 current_buffer
->clip_changed
= 1;
3665 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3667 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3668 setup_coding_system (coding_system
, &coding
);
3669 /* Ensure we set Vlast_coding_system_used. */
3670 set_coding_system
= 1;
3674 /* Decide the coding system to use for reading the file now
3675 because we can't use an optimized method for handling
3676 `coding:' tag if the current buffer is not empty. */
3677 if (!NILP (Vcoding_system_for_read
))
3678 coding_system
= Vcoding_system_for_read
;
3681 /* Don't try looking inside a file for a coding system
3682 specification if it is not seekable. */
3683 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3685 /* Find a coding system specified in the heading two
3686 lines or in the tailing several lines of the file.
3687 We assume that the 1K-byte and 3K-byte for heading
3688 and tailing respectively are sufficient for this
3692 if (st
.st_size
<= (1024 * 4))
3693 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3696 nread
= emacs_read (fd
, read_buf
, 1024);
3700 if (lseek (fd
, - (1024 * 3), SEEK_END
) < 0)
3701 report_file_error ("Setting file position",
3702 Fcons (orig_filename
, Qnil
));
3703 ntail
= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3704 nread
= ntail
< 0 ? ntail
: nread
+ ntail
;
3709 error ("IO error reading %s: %s",
3710 SDATA (orig_filename
), emacs_strerror (errno
));
3713 struct buffer
*prev
= current_buffer
;
3714 Lisp_Object workbuf
;
3717 record_unwind_current_buffer ();
3719 workbuf
= Fget_buffer_create (build_string (" *code-converting-work*"));
3720 buf
= XBUFFER (workbuf
);
3722 delete_all_overlays (buf
);
3723 bset_directory (buf
, BVAR (current_buffer
, directory
));
3724 bset_read_only (buf
, Qnil
);
3725 bset_filename (buf
, Qnil
);
3726 bset_undo_list (buf
, Qt
);
3727 eassert (buf
->overlays_before
== NULL
);
3728 eassert (buf
->overlays_after
== NULL
);
3730 set_buffer_internal (buf
);
3732 bset_enable_multibyte_characters (buf
, Qnil
);
3734 insert_1_both ((char *) read_buf
, nread
, nread
, 0, 0, 0);
3735 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3736 coding_system
= call2 (Vset_auto_coding_function
,
3737 filename
, make_number (nread
));
3738 set_buffer_internal (prev
);
3740 /* Discard the unwind protect for recovering the
3744 /* Rewind the file for the actual read done later. */
3745 if (lseek (fd
, 0, SEEK_SET
) < 0)
3746 report_file_error ("Setting file position",
3747 Fcons (orig_filename
, Qnil
));
3751 if (NILP (coding_system
))
3753 /* If we have not yet decided a coding system, check
3754 file-coding-system-alist. */
3755 Lisp_Object args
[6];
3757 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3758 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3759 coding_system
= Ffind_operation_coding_system (6, args
);
3760 if (CONSP (coding_system
))
3761 coding_system
= XCAR (coding_system
);
3765 if (NILP (coding_system
))
3766 coding_system
= Qundecided
;
3768 CHECK_CODING_SYSTEM (coding_system
);
3770 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3771 /* We must suppress all character code conversion except for
3772 end-of-line conversion. */
3773 coding_system
= raw_text_coding_system (coding_system
);
3775 setup_coding_system (coding_system
, &coding
);
3776 /* Ensure we set Vlast_coding_system_used. */
3777 set_coding_system
= 1;
3780 /* If requested, replace the accessible part of the buffer
3781 with the file contents. Avoid replacing text at the
3782 beginning or end of the buffer that matches the file contents;
3783 that preserves markers pointing to the unchanged parts.
3785 Here we implement this feature in an optimized way
3786 for the case where code conversion is NOT needed.
3787 The following if-statement handles the case of conversion
3788 in a less optimal way.
3790 If the code conversion is "automatic" then we try using this
3791 method and hope for the best.
3792 But if we discover the need for conversion, we give up on this method
3793 and let the following if-statement handle the replace job. */
3796 && (NILP (coding_system
)
3797 || ! CODING_REQUIRE_DECODING (&coding
)))
3799 /* same_at_start and same_at_end count bytes,
3800 because file access counts bytes
3801 and BEG and END count bytes. */
3802 ptrdiff_t same_at_start
= BEGV_BYTE
;
3803 ptrdiff_t same_at_end
= ZV_BYTE
;
3805 /* There is still a possibility we will find the need to do code
3806 conversion. If that happens, set this variable to
3807 give up on handling REPLACE in the optimized way. */
3808 bool giveup_match_end
= 0;
3810 if (beg_offset
!= 0)
3812 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
3813 report_file_error ("Setting file position",
3814 Fcons (orig_filename
, Qnil
));
3819 /* Count how many chars at the start of the file
3820 match the text at the beginning of the buffer. */
3825 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3827 error ("IO error reading %s: %s",
3828 SSDATA (orig_filename
), emacs_strerror (errno
));
3829 else if (nread
== 0)
3832 if (CODING_REQUIRE_DETECTION (&coding
))
3834 coding_system
= detect_coding_system ((unsigned char *) buffer
,
3837 setup_coding_system (coding_system
, &coding
);
3840 if (CODING_REQUIRE_DECODING (&coding
))
3841 /* We found that the file should be decoded somehow.
3842 Let's give up here. */
3844 giveup_match_end
= 1;
3849 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3850 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3851 same_at_start
++, bufpos
++;
3852 /* If we found a discrepancy, stop the scan.
3853 Otherwise loop around and scan the next bufferful. */
3854 if (bufpos
!= nread
)
3858 /* If the file matches the buffer completely,
3859 there's no need to replace anything. */
3860 if (same_at_start
- BEGV_BYTE
== end_offset
- beg_offset
)
3864 /* Truncate the buffer to the size of the file. */
3865 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3870 /* Count how many chars at the end of the file
3871 match the text at the end of the buffer. But, if we have
3872 already found that decoding is necessary, don't waste time. */
3873 while (!giveup_match_end
)
3875 int total_read
, nread
, bufpos
, trial
;
3878 /* At what file position are we now scanning? */
3879 curpos
= end_offset
- (ZV_BYTE
- same_at_end
);
3880 /* If the entire file matches the buffer tail, stop the scan. */
3883 /* How much can we scan in the next step? */
3884 trial
= min (curpos
, sizeof buffer
);
3885 if (lseek (fd
, curpos
- trial
, SEEK_SET
) < 0)
3886 report_file_error ("Setting file position",
3887 Fcons (orig_filename
, Qnil
));
3889 total_read
= nread
= 0;
3890 while (total_read
< trial
)
3892 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3894 error ("IO error reading %s: %s",
3895 SDATA (orig_filename
), emacs_strerror (errno
));
3896 else if (nread
== 0)
3898 total_read
+= nread
;
3901 /* Scan this bufferful from the end, comparing with
3902 the Emacs buffer. */
3903 bufpos
= total_read
;
3905 /* Compare with same_at_start to avoid counting some buffer text
3906 as matching both at the file's beginning and at the end. */
3907 while (bufpos
> 0 && same_at_end
> same_at_start
3908 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3909 same_at_end
--, bufpos
--;
3911 /* If we found a discrepancy, stop the scan.
3912 Otherwise loop around and scan the preceding bufferful. */
3915 /* If this discrepancy is because of code conversion,
3916 we cannot use this method; giveup and try the other. */
3917 if (same_at_end
> same_at_start
3918 && FETCH_BYTE (same_at_end
- 1) >= 0200
3919 && ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3920 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3921 giveup_match_end
= 1;
3930 if (! giveup_match_end
)
3934 /* We win! We can handle REPLACE the optimized way. */
3936 /* Extend the start of non-matching text area to multibyte
3937 character boundary. */
3938 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3939 while (same_at_start
> BEGV_BYTE
3940 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3943 /* Extend the end of non-matching text area to multibyte
3944 character boundary. */
3945 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3946 while (same_at_end
< ZV_BYTE
3947 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3950 /* Don't try to reuse the same piece of text twice. */
3951 overlap
= (same_at_start
- BEGV_BYTE
3953 + (! NILP (end
) ? end_offset
: st
.st_size
) - ZV_BYTE
));
3955 same_at_end
+= overlap
;
3957 /* Arrange to read only the nonmatching middle part of the file. */
3958 beg_offset
+= same_at_start
- BEGV_BYTE
;
3959 end_offset
-= ZV_BYTE
- same_at_end
;
3961 del_range_byte (same_at_start
, same_at_end
, 0);
3962 /* Insert from the file at the proper position. */
3963 temp
= BYTE_TO_CHAR (same_at_start
);
3964 SET_PT_BOTH (temp
, same_at_start
);
3966 /* If display currently starts at beginning of line,
3967 keep it that way. */
3968 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3969 XWINDOW (selected_window
)->start_at_line_beg
= !NILP (Fbolp ());
3971 replace_handled
= 1;
3975 /* If requested, replace the accessible part of the buffer
3976 with the file contents. Avoid replacing text at the
3977 beginning or end of the buffer that matches the file contents;
3978 that preserves markers pointing to the unchanged parts.
3980 Here we implement this feature for the case where code conversion
3981 is needed, in a simple way that needs a lot of memory.
3982 The preceding if-statement handles the case of no conversion
3983 in a more optimized way. */
3984 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3986 ptrdiff_t same_at_start
= BEGV_BYTE
;
3987 ptrdiff_t same_at_end
= ZV_BYTE
;
3988 ptrdiff_t same_at_start_charpos
;
3989 ptrdiff_t inserted_chars
;
3992 unsigned char *decoded
;
3995 ptrdiff_t this_count
= SPECPDL_INDEX ();
3997 = ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
3998 Lisp_Object conversion_buffer
;
3999 struct gcpro gcpro1
;
4001 conversion_buffer
= code_conversion_save (1, multibyte
);
4003 /* First read the whole file, performing code conversion into
4004 CONVERSION_BUFFER. */
4006 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
4007 report_file_error ("Setting file position",
4008 Fcons (orig_filename
, Qnil
));
4010 total
= st
.st_size
; /* Total bytes in the file. */
4011 how_much
= 0; /* Bytes read from file so far. */
4012 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4013 unprocessed
= 0; /* Bytes not processed in previous loop. */
4015 GCPRO1 (conversion_buffer
);
4016 while (how_much
< total
)
4018 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
4019 quitting while reading a huge while. */
4020 /* `try'' is reserved in some compilers (Microsoft C). */
4021 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4023 /* Allow quitting out of the actual I/O. */
4026 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
4034 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
4035 BUF_Z (XBUFFER (conversion_buffer
)));
4036 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
4037 unprocessed
+ this, conversion_buffer
);
4038 unprocessed
= coding
.carryover_bytes
;
4039 if (coding
.carryover_bytes
> 0)
4040 memcpy (read_buf
, coding
.carryover
, unprocessed
);
4045 /* We should remove the unwind_protect calling
4046 close_file_unwind, but other stuff has been added the stack,
4047 so defer the removal till we reach the `handled' label. */
4048 deferred_remove_unwind_protect
= 1;
4050 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
4051 if we couldn't read the file. */
4054 error ("IO error reading %s: %s",
4055 SDATA (orig_filename
), emacs_strerror (errno
));
4057 if (unprocessed
> 0)
4059 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4060 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
4061 unprocessed
, conversion_buffer
);
4062 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
4065 coding_system
= CODING_ID_NAME (coding
.id
);
4066 set_coding_system
= 1;
4067 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
4068 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
4069 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4071 /* Compare the beginning of the converted string with the buffer
4075 while (bufpos
< inserted
&& same_at_start
< same_at_end
4076 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
4077 same_at_start
++, bufpos
++;
4079 /* If the file matches the head of buffer completely,
4080 there's no need to replace anything. */
4082 if (bufpos
== inserted
)
4084 /* Truncate the buffer to the size of the file. */
4085 if (same_at_start
== same_at_end
)
4088 del_range_byte (same_at_start
, same_at_end
, 0);
4091 unbind_to (this_count
, Qnil
);
4095 /* Extend the start of non-matching text area to the previous
4096 multibyte character boundary. */
4097 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4098 while (same_at_start
> BEGV_BYTE
4099 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4102 /* Scan this bufferful from the end, comparing with
4103 the Emacs buffer. */
4106 /* Compare with same_at_start to avoid counting some buffer text
4107 as matching both at the file's beginning and at the end. */
4108 while (bufpos
> 0 && same_at_end
> same_at_start
4109 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
4110 same_at_end
--, bufpos
--;
4112 /* Extend the end of non-matching text area to the next
4113 multibyte character boundary. */
4114 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4115 while (same_at_end
< ZV_BYTE
4116 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4119 /* Don't try to reuse the same piece of text twice. */
4120 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4122 same_at_end
+= overlap
;
4124 /* If display currently starts at beginning of line,
4125 keep it that way. */
4126 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4127 XWINDOW (selected_window
)->start_at_line_beg
= !NILP (Fbolp ());
4129 /* Replace the chars that we need to replace,
4130 and update INSERTED to equal the number of bytes
4131 we are taking from the decoded string. */
4132 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4134 if (same_at_end
!= same_at_start
)
4136 del_range_byte (same_at_start
, same_at_end
, 0);
4138 same_at_start
= GPT_BYTE
;
4142 temp
= BYTE_TO_CHAR (same_at_start
);
4144 /* Insert from the file at the proper position. */
4145 SET_PT_BOTH (temp
, same_at_start
);
4146 same_at_start_charpos
4147 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4148 same_at_start
- BEGV_BYTE
4149 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4151 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4152 same_at_start
+ inserted
- BEGV_BYTE
4153 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
4154 - same_at_start_charpos
);
4155 /* This binding is to avoid ask-user-about-supersession-threat
4156 being called in insert_from_buffer (via in
4157 prepare_to_modify_buffer). */
4158 specbind (intern ("buffer-file-name"), Qnil
);
4159 insert_from_buffer (XBUFFER (conversion_buffer
),
4160 same_at_start_charpos
, inserted_chars
, 0);
4161 /* Set `inserted' to the number of inserted characters. */
4162 inserted
= PT
- temp
;
4163 /* Set point before the inserted characters. */
4164 SET_PT_BOTH (temp
, same_at_start
);
4166 unbind_to (this_count
, Qnil
);
4172 total
= end_offset
- beg_offset
;
4174 /* For a special file, all we can do is guess. */
4175 total
= READ_BUF_SIZE
;
4177 if (NILP (visit
) && total
> 0)
4179 #ifdef CLASH_DETECTION
4180 if (!NILP (BVAR (current_buffer
, file_truename
))
4181 /* Make binding buffer-file-name to nil effective. */
4182 && !NILP (BVAR (current_buffer
, filename
))
4183 && SAVE_MODIFF
>= MODIFF
)
4185 #endif /* CLASH_DETECTION */
4186 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4189 move_gap_both (PT
, PT_BYTE
);
4190 if (GAP_SIZE
< total
)
4191 make_gap (total
- GAP_SIZE
);
4193 if (beg_offset
!= 0 || !NILP (replace
))
4195 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
4196 report_file_error ("Setting file position",
4197 Fcons (orig_filename
, Qnil
));
4200 /* In the following loop, HOW_MUCH contains the total bytes read
4201 so far for a regular file, and not changed for a special file. */
4204 /* Total bytes inserted. */
4207 /* Here we don't do code conversion in the loop. It is done by
4208 decode_coding_gap after all data are read into the buffer, or
4209 reading loop is interrupted with quit or due to I/O error. */
4211 while (how_much
< total
)
4213 ptrdiff_t nread
, maxread
= min (total
- how_much
, READ_BUF_SIZE
);
4216 /* For a special file, gap is enlarged as we read,
4217 so GAP_SIZE should be checked every time. */
4218 if (not_regular
&& (GAP_SIZE
< maxread
))
4219 make_gap (maxread
- GAP_SIZE
);
4221 /* Read from the file, capturing `quit'. */
4222 result
= internal_condition_case_1
4224 make_save_value ("iii", (ptrdiff_t) fd
, inserted
, maxread
),
4225 Qerror
, read_contents_quit
);
4228 /* Quit is signaled. End the loop and arrange
4229 real quit after decoding the text we read. */
4233 nread
= XINT (result
);
4236 /* End of file or I/O error. End the loop and
4237 save error code in case of I/O error. */
4243 /* Adjust gap and end positions. */
4254 /* For a regular file, where TOTAL is the real size, count HOW_MUCH to
4255 compare with it. For a special file, where TOTAL is just a buffer
4256 size, don't bother counting in HOW_MUCH, but always accumulate the
4257 number of bytes read in INSERTED. */
4263 /* Now we have either read all the file data into the gap,
4264 or stop reading on I/O error or quit. If nothing was
4265 read, undo marking the buffer modified. */
4269 #ifdef CLASH_DETECTION
4271 unlock_file (BVAR (current_buffer
, file_truename
));
4273 Vdeactivate_mark
= old_Vdeactivate_mark
;
4276 Vdeactivate_mark
= Qt
;
4280 /* Discard the unwind protect for closing the file. */
4285 if (NILP (coding_system
))
4287 /* The coding system is not yet decided. Decide it by an
4288 optimized method for handling `coding:' tag.
4290 Note that we can get here only if the buffer was empty
4291 before the insertion. */
4293 if (!NILP (Vcoding_system_for_read
))
4294 coding_system
= Vcoding_system_for_read
;
4297 /* Since we are sure that the current buffer was empty
4298 before the insertion, we can toggle
4299 enable-multibyte-characters directly here without taking
4300 care of marker adjustment. By this way, we can run Lisp
4301 program safely before decoding the inserted text. */
4302 Lisp_Object unwind_data
;
4303 ptrdiff_t count1
= SPECPDL_INDEX ();
4305 unwind_data
= Fcons (BVAR (current_buffer
, enable_multibyte_characters
),
4306 Fcons (BVAR (current_buffer
, undo_list
),
4307 Fcurrent_buffer ()));
4308 bset_enable_multibyte_characters (current_buffer
, Qnil
);
4309 bset_undo_list (current_buffer
, Qt
);
4310 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4312 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4314 coding_system
= call2 (Vset_auto_coding_function
,
4315 filename
, make_number (inserted
));
4318 if (NILP (coding_system
))
4320 /* If the coding system is not yet decided, check
4321 file-coding-system-alist. */
4322 Lisp_Object args
[6];
4324 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4325 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4326 coding_system
= Ffind_operation_coding_system (6, args
);
4327 if (CONSP (coding_system
))
4328 coding_system
= XCAR (coding_system
);
4330 unbind_to (count1
, Qnil
);
4331 inserted
= Z_BYTE
- BEG_BYTE
;
4334 if (NILP (coding_system
))
4335 coding_system
= Qundecided
;
4337 CHECK_CODING_SYSTEM (coding_system
);
4339 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4340 /* We must suppress all character code conversion except for
4341 end-of-line conversion. */
4342 coding_system
= raw_text_coding_system (coding_system
);
4343 setup_coding_system (coding_system
, &coding
);
4344 /* Ensure we set Vlast_coding_system_used. */
4345 set_coding_system
= 1;
4350 /* When we visit a file by raw-text, we change the buffer to
4352 if (CODING_FOR_UNIBYTE (&coding
)
4353 /* Can't do this if part of the buffer might be preserved. */
4355 /* Visiting a file with these coding system makes the buffer
4357 bset_enable_multibyte_characters (current_buffer
, Qnil
);
4360 coding
.dst_multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
4361 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4362 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4364 move_gap_both (PT
, PT_BYTE
);
4365 GAP_SIZE
+= inserted
;
4366 ZV_BYTE
-= inserted
;
4370 decode_coding_gap (&coding
, inserted
, inserted
);
4371 inserted
= coding
.produced_char
;
4372 coding_system
= CODING_ID_NAME (coding
.id
);
4374 else if (inserted
> 0)
4375 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4378 /* Call after-change hooks for the inserted text, aside from the case
4379 of normal visiting (not with REPLACE), which is done in a new buffer
4380 "before" the buffer is changed. */
4381 if (inserted
> 0 && total
> 0
4382 && (NILP (visit
) || !NILP (replace
)))
4384 signal_after_change (PT
, 0, inserted
);
4385 update_compositions (PT
, PT
, CHECK_BORDER
);
4388 /* Now INSERTED is measured in characters. */
4392 if (deferred_remove_unwind_protect
)
4393 /* If requested above, discard the unwind protect for closing the
4399 if (!EQ (BVAR (current_buffer
, undo_list
), Qt
) && !nochange
)
4400 bset_undo_list (current_buffer
, Qnil
);
4404 current_buffer
->modtime
= mtime
;
4405 current_buffer
->modtime_size
= st
.st_size
;
4406 bset_filename (current_buffer
, orig_filename
);
4409 SAVE_MODIFF
= MODIFF
;
4410 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
4411 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4412 #ifdef CLASH_DETECTION
4415 if (!NILP (BVAR (current_buffer
, file_truename
)))
4416 unlock_file (BVAR (current_buffer
, file_truename
));
4417 unlock_file (filename
);
4419 #endif /* CLASH_DETECTION */
4421 xsignal2 (Qfile_error
,
4422 build_string ("not a regular file"), orig_filename
);
4425 if (set_coding_system
)
4426 Vlast_coding_system_used
= coding_system
;
4428 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4430 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4432 if (! NILP (insval
))
4434 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4435 wrong_type_argument (intern ("inserted-chars"), insval
);
4436 inserted
= XFASTINT (insval
);
4440 /* Decode file format. */
4443 /* Don't run point motion or modification hooks when decoding. */
4444 ptrdiff_t count1
= SPECPDL_INDEX ();
4445 ptrdiff_t old_inserted
= inserted
;
4446 specbind (Qinhibit_point_motion_hooks
, Qt
);
4447 specbind (Qinhibit_modification_hooks
, Qt
);
4449 /* Save old undo list and don't record undo for decoding. */
4450 old_undo
= BVAR (current_buffer
, undo_list
);
4451 bset_undo_list (current_buffer
, Qt
);
4455 insval
= call3 (Qformat_decode
,
4456 Qnil
, make_number (inserted
), visit
);
4457 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4458 wrong_type_argument (intern ("inserted-chars"), insval
);
4459 inserted
= XFASTINT (insval
);
4463 /* If REPLACE is non-nil and we succeeded in not replacing the
4464 beginning or end of the buffer text with the file's contents,
4465 call format-decode with `point' positioned at the beginning
4466 of the buffer and `inserted' equaling the number of
4467 characters in the buffer. Otherwise, format-decode might
4468 fail to correctly analyze the beginning or end of the buffer.
4469 Hence we temporarily save `point' and `inserted' here and
4470 restore `point' iff format-decode did not insert or delete
4471 any text. Otherwise we leave `point' at point-min. */
4472 ptrdiff_t opoint
= PT
;
4473 ptrdiff_t opoint_byte
= PT_BYTE
;
4474 ptrdiff_t oinserted
= ZV
- BEGV
;
4475 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4477 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4478 insval
= call3 (Qformat_decode
,
4479 Qnil
, make_number (oinserted
), visit
);
4480 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4481 wrong_type_argument (intern ("inserted-chars"), insval
);
4482 if (ochars_modiff
== CHARS_MODIFF
)
4483 /* format_decode didn't modify buffer's characters => move
4484 point back to position before inserted text and leave
4485 value of inserted alone. */
4486 SET_PT_BOTH (opoint
, opoint_byte
);
4488 /* format_decode modified buffer's characters => consider
4489 entire buffer changed and leave point at point-min. */
4490 inserted
= XFASTINT (insval
);
4493 /* For consistency with format-decode call these now iff inserted > 0
4494 (martin 2007-06-28). */
4495 p
= Vafter_insert_file_functions
;
4500 insval
= call1 (XCAR (p
), make_number (inserted
));
4503 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4504 wrong_type_argument (intern ("inserted-chars"), insval
);
4505 inserted
= XFASTINT (insval
);
4510 /* For the rationale of this see the comment on
4511 format-decode above. */
4512 ptrdiff_t opoint
= PT
;
4513 ptrdiff_t opoint_byte
= PT_BYTE
;
4514 ptrdiff_t oinserted
= ZV
- BEGV
;
4515 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4517 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4518 insval
= call1 (XCAR (p
), make_number (oinserted
));
4521 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4522 wrong_type_argument (intern ("inserted-chars"), insval
);
4523 if (ochars_modiff
== CHARS_MODIFF
)
4524 /* after_insert_file_functions didn't modify
4525 buffer's characters => move point back to
4526 position before inserted text and leave value of
4528 SET_PT_BOTH (opoint
, opoint_byte
);
4530 /* after_insert_file_functions did modify buffer's
4531 characters => consider entire buffer changed and
4532 leave point at point-min. */
4533 inserted
= XFASTINT (insval
);
4543 bset_undo_list (current_buffer
, old_undo
);
4544 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4546 /* Adjust the last undo record for the size change during
4547 the format conversion. */
4548 Lisp_Object tem
= XCAR (old_undo
);
4549 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4550 && INTEGERP (XCDR (tem
))
4551 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4552 XSETCDR (tem
, make_number (PT
+ inserted
));
4556 /* If undo_list was Qt before, keep it that way.
4557 Otherwise start with an empty undo_list. */
4558 bset_undo_list (current_buffer
, EQ (old_undo
, Qt
) ? Qt
: Qnil
);
4560 unbind_to (count1
, Qnil
);
4564 && EMACS_NSECS (current_buffer
->modtime
) == NONEXISTENT_MODTIME_NSECS
)
4566 /* If visiting nonexistent file, return nil. */
4568 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4571 /* There was an error reading file. */
4573 error ("IO error reading %s: %s",
4574 SDATA (orig_filename
), emacs_strerror (read_errno
));
4576 /* Quit was signaled. */
4578 Fsignal (Qquit
, Qnil
);
4581 val
= list2 (orig_filename
, make_number (inserted
));
4583 RETURN_UNGCPRO (unbind_to (count
, val
));
4586 static Lisp_Object
build_annotations (Lisp_Object
, Lisp_Object
);
4589 build_annotations_unwind (Lisp_Object arg
)
4591 Vwrite_region_annotation_buffers
= arg
;
4595 /* Decide the coding-system to encode the data with. */
4598 choose_write_coding_system (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4599 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
,
4600 struct coding_system
*coding
)
4603 Lisp_Object eol_parent
= Qnil
;
4606 && NILP (Fstring_equal (BVAR (current_buffer
, filename
),
4607 BVAR (current_buffer
, auto_save_file_name
))))
4612 else if (!NILP (Vcoding_system_for_write
))
4614 val
= Vcoding_system_for_write
;
4615 if (coding_system_require_warning
4616 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4617 /* Confirm that VAL can surely encode the current region. */
4618 val
= call5 (Vselect_safe_coding_system_function
,
4619 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4624 /* If the variable `buffer-file-coding-system' is set locally,
4625 it means that the file was read with some kind of code
4626 conversion or the variable is explicitly set by users. We
4627 had better write it out with the same coding system even if
4628 `enable-multibyte-characters' is nil.
4630 If it is not set locally, we anyway have to convert EOL
4631 format if the default value of `buffer-file-coding-system'
4632 tells that it is not Unix-like (LF only) format. */
4633 bool using_default_coding
= 0;
4634 bool force_raw_text
= 0;
4636 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4638 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4641 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4647 /* Check file-coding-system-alist. */
4648 Lisp_Object args
[7], coding_systems
;
4650 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4651 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4653 coding_systems
= Ffind_operation_coding_system (7, args
);
4654 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4655 val
= XCDR (coding_systems
);
4660 /* If we still have not decided a coding system, use the
4661 default value of buffer-file-coding-system. */
4662 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4663 using_default_coding
= 1;
4666 if (! NILP (val
) && ! force_raw_text
)
4668 Lisp_Object spec
, attrs
;
4670 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4671 attrs
= AREF (spec
, 0);
4672 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4677 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4678 /* Confirm that VAL can surely encode the current region. */
4679 val
= call5 (Vselect_safe_coding_system_function
,
4680 start
, end
, val
, Qnil
, filename
);
4682 /* If the decided coding-system doesn't specify end-of-line
4683 format, we use that of
4684 `default-buffer-file-coding-system'. */
4685 if (! using_default_coding
4686 && ! NILP (BVAR (&buffer_defaults
, buffer_file_coding_system
)))
4687 val
= (coding_inherit_eol_type
4688 (val
, BVAR (&buffer_defaults
, buffer_file_coding_system
)));
4690 /* If we decide not to encode text, use `raw-text' or one of its
4693 val
= raw_text_coding_system (val
);
4696 val
= coding_inherit_eol_type (val
, eol_parent
);
4697 setup_coding_system (val
, coding
);
4699 if (!STRINGP (start
) && !NILP (BVAR (current_buffer
, selective_display
)))
4700 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4704 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4705 "r\nFWrite region to file: \ni\ni\ni\np",
4706 doc
: /* Write current region into specified file.
4707 When called from a program, requires three arguments:
4708 START, END and FILENAME. START and END are normally buffer positions
4709 specifying the part of the buffer to write.
4710 If START is nil, that means to use the entire buffer contents.
4711 If START is a string, then output that string to the file
4712 instead of any buffer contents; END is ignored.
4714 Optional fourth argument APPEND if non-nil means
4715 append to existing file contents (if any). If it is a number,
4716 seek to that offset in the file before writing.
4717 Optional fifth argument VISIT, if t or a string, means
4718 set the last-save-file-modtime of buffer to this file's modtime
4719 and mark buffer not modified.
4720 If VISIT is a string, it is a second file name;
4721 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4722 VISIT is also the file name to lock and unlock for clash detection.
4723 If VISIT is neither t nor nil nor a string,
4724 that means do not display the \"Wrote file\" message.
4725 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4726 use for locking and unlocking, overriding FILENAME and VISIT.
4727 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4728 for an existing file with the same name. If MUSTBENEW is `excl',
4729 that means to get an error if the file already exists; never overwrite.
4730 If MUSTBENEW is neither nil nor `excl', that means ask for
4731 confirmation before overwriting, but do go ahead and overwrite the file
4732 if the user confirms.
4734 This does code conversion according to the value of
4735 `coding-system-for-write', `buffer-file-coding-system', or
4736 `file-coding-system-alist', and sets the variable
4737 `last-coding-system-used' to the coding system actually used.
4739 This calls `write-region-annotate-functions' at the start, and
4740 `write-region-post-annotation-function' at the end. */)
4741 (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
, Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
, Lisp_Object mustbenew
)
4750 ptrdiff_t count
= SPECPDL_INDEX ();
4752 Lisp_Object handler
;
4753 Lisp_Object visit_file
;
4754 Lisp_Object annotations
;
4755 Lisp_Object encoded_filename
;
4756 bool visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4757 bool quietly
= !NILP (visit
);
4758 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4759 struct buffer
*given_buffer
;
4760 struct coding_system coding
;
4762 if (current_buffer
->base_buffer
&& visiting
)
4763 error ("Cannot do file visiting in an indirect buffer");
4765 if (!NILP (start
) && !STRINGP (start
))
4766 validate_region (&start
, &end
);
4769 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4771 filename
= Fexpand_file_name (filename
, Qnil
);
4773 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4774 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4776 if (STRINGP (visit
))
4777 visit_file
= Fexpand_file_name (visit
, Qnil
);
4779 visit_file
= filename
;
4781 if (NILP (lockname
))
4782 lockname
= visit_file
;
4786 /* If the file name has special constructs in it,
4787 call the corresponding file handler. */
4788 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4789 /* If FILENAME has no handler, see if VISIT has one. */
4790 if (NILP (handler
) && STRINGP (visit
))
4791 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4793 if (!NILP (handler
))
4796 val
= call6 (handler
, Qwrite_region
, start
, end
,
4797 filename
, append
, visit
);
4801 SAVE_MODIFF
= MODIFF
;
4802 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4803 bset_filename (current_buffer
, visit_file
);
4809 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4811 /* Special kludge to simplify auto-saving. */
4814 /* Do it later, so write-region-annotate-function can work differently
4815 if we save "the buffer" vs "a region".
4816 This is useful in tar-mode. --Stef
4817 XSETFASTINT (start, BEG);
4818 XSETFASTINT (end, Z); */
4822 record_unwind_protect (build_annotations_unwind
,
4823 Vwrite_region_annotation_buffers
);
4824 Vwrite_region_annotation_buffers
= Fcons (Fcurrent_buffer (), Qnil
);
4825 count1
= SPECPDL_INDEX ();
4827 given_buffer
= current_buffer
;
4829 if (!STRINGP (start
))
4831 annotations
= build_annotations (start
, end
);
4833 if (current_buffer
!= given_buffer
)
4835 XSETFASTINT (start
, BEGV
);
4836 XSETFASTINT (end
, ZV
);
4842 XSETFASTINT (start
, BEGV
);
4843 XSETFASTINT (end
, ZV
);
4848 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4850 /* Decide the coding-system to encode the data with.
4851 We used to make this choice before calling build_annotations, but that
4852 leads to problems when a write-annotate-function takes care of
4853 unsavable chars (as was the case with X-Symbol). */
4854 Vlast_coding_system_used
4855 = choose_write_coding_system (start
, end
, filename
,
4856 append
, visit
, lockname
, &coding
);
4858 #ifdef CLASH_DETECTION
4860 lock_file (lockname
);
4861 #endif /* CLASH_DETECTION */
4863 encoded_filename
= ENCODE_FILE (filename
);
4865 fn
= SSDATA (encoded_filename
);
4870 if (NUMBERP (append
))
4871 offset
= file_offset (append
);
4872 desc
= emacs_open (fn
, O_WRONLY
| O_BINARY
, 0);
4875 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4877 desc
= emacs_open (fn
,
4878 O_WRONLY
| O_CREAT
| O_BINARY
4879 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4880 S_IREAD
| S_IWRITE
);
4881 #else /* not DOS_NT */
4882 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4883 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4884 auto_saving
? auto_save_mode_bits
: 0666);
4885 #endif /* not DOS_NT */
4889 #ifdef CLASH_DETECTION
4891 if (!auto_saving
) unlock_file (lockname
);
4893 #endif /* CLASH_DETECTION */
4895 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4898 record_unwind_protect (close_file_unwind
, make_number (desc
));
4902 off_t ret
= lseek (desc
, offset
, NUMBERP (append
) ? SEEK_SET
: SEEK_END
);
4905 #ifdef CLASH_DETECTION
4907 if (!auto_saving
) unlock_file (lockname
);
4909 #endif /* CLASH_DETECTION */
4911 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4919 if (STRINGP (start
))
4920 ok
= a_write (desc
, start
, 0, SCHARS (start
), &annotations
, &coding
);
4921 else if (XINT (start
) != XINT (end
))
4922 ok
= a_write (desc
, Qnil
, XINT (start
), XINT (end
) - XINT (start
),
4923 &annotations
, &coding
);
4926 /* If file was empty, still need to write the annotations. */
4927 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4928 ok
= a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4932 if (ok
&& CODING_REQUIRE_FLUSHING (&coding
)
4933 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
))
4935 /* We have to flush out a data. */
4936 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4937 ok
= e_write (desc
, Qnil
, 1, 1, &coding
);
4944 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4945 Disk full in NFS may be reported here. */
4946 /* mib says that closing the file will try to write as fast as NFS can do
4947 it, and that means the fsync here is not crucial for autosave files. */
4948 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
4950 /* If fsync fails with EINTR, don't treat that as serious. Also
4951 ignore EINVAL which happens when fsync is not supported on this
4953 if (errno
!= EINTR
&& errno
!= EINVAL
)
4954 ok
= 0, save_errno
= errno
;
4958 modtime
= invalid_emacs_time ();
4961 if (fstat (desc
, &st
) == 0)
4962 modtime
= get_stat_mtime (&st
);
4964 ok
= 0, save_errno
= errno
;
4967 /* NFS can report a write failure now. */
4968 if (emacs_close (desc
) < 0)
4969 ok
= 0, save_errno
= errno
;
4971 /* Discard the unwind protect for close_file_unwind. */
4972 specpdl_ptr
= specpdl
+ count1
;
4974 /* Some file systems have a bug where st_mtime is not updated
4975 properly after a write. For example, CIFS might not see the
4976 st_mtime change until after the file is opened again.
4978 Attempt to detect this file system bug, and update MODTIME to the
4979 newer st_mtime if the bug appears to be present. This introduces
4980 a race condition, so to avoid most instances of the race condition
4981 on non-buggy file systems, skip this check if the most recently
4982 encountered non-buggy file system was the current file system.
4984 A race condition can occur if some other process modifies the
4985 file between the fstat above and the fstat below, but the race is
4986 unlikely and a similar race between the last write and the fstat
4987 above cannot possibly be closed anyway. */
4989 if (EMACS_TIME_VALID_P (modtime
)
4990 && ! (valid_timestamp_file_system
&& st
.st_dev
== timestamp_file_system
))
4992 int desc1
= emacs_open (fn
, O_WRONLY
| O_BINARY
, 0);
4996 if (fstat (desc1
, &st1
) == 0
4997 && st
.st_dev
== st1
.st_dev
&& st
.st_ino
== st1
.st_ino
)
4999 EMACS_TIME modtime1
= get_stat_mtime (&st1
);
5000 if (EMACS_TIME_EQ (modtime
, modtime1
)
5001 && st
.st_size
== st1
.st_size
)
5003 timestamp_file_system
= st
.st_dev
;
5004 valid_timestamp_file_system
= 1;
5008 st
.st_size
= st1
.st_size
;
5012 emacs_close (desc1
);
5016 /* Call write-region-post-annotation-function. */
5017 while (CONSP (Vwrite_region_annotation_buffers
))
5019 Lisp_Object buf
= XCAR (Vwrite_region_annotation_buffers
);
5020 if (!NILP (Fbuffer_live_p (buf
)))
5023 if (FUNCTIONP (Vwrite_region_post_annotation_function
))
5024 call0 (Vwrite_region_post_annotation_function
);
5026 Vwrite_region_annotation_buffers
5027 = XCDR (Vwrite_region_annotation_buffers
);
5030 unbind_to (count
, Qnil
);
5032 #ifdef CLASH_DETECTION
5034 unlock_file (lockname
);
5035 #endif /* CLASH_DETECTION */
5037 /* Do this before reporting IO error
5038 to avoid a "file has changed on disk" warning on
5039 next attempt to save. */
5040 if (EMACS_TIME_VALID_P (modtime
))
5042 current_buffer
->modtime
= modtime
;
5043 current_buffer
->modtime_size
= st
.st_size
;
5047 error ("IO error writing %s: %s", SDATA (filename
),
5048 emacs_strerror (save_errno
));
5052 SAVE_MODIFF
= MODIFF
;
5053 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5054 bset_filename (current_buffer
, visit_file
);
5055 update_mode_lines
++;
5060 && ! NILP (Fstring_equal (BVAR (current_buffer
, filename
),
5061 BVAR (current_buffer
, auto_save_file_name
))))
5062 SAVE_MODIFF
= MODIFF
;
5068 message_with_string ((NUMBERP (append
)
5078 Lisp_Object
merge (Lisp_Object
, Lisp_Object
, Lisp_Object
);
5080 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5081 doc
: /* Return t if (car A) is numerically less than (car B). */)
5082 (Lisp_Object a
, Lisp_Object b
)
5084 return Flss (Fcar (a
), Fcar (b
));
5087 /* Build the complete list of annotations appropriate for writing out
5088 the text between START and END, by calling all the functions in
5089 write-region-annotate-functions and merging the lists they return.
5090 If one of these functions switches to a different buffer, we assume
5091 that buffer contains altered text. Therefore, the caller must
5092 make sure to restore the current buffer in all cases,
5093 as save-excursion would do. */
5096 build_annotations (Lisp_Object start
, Lisp_Object end
)
5098 Lisp_Object annotations
;
5100 struct gcpro gcpro1
, gcpro2
;
5101 Lisp_Object original_buffer
;
5103 bool used_global
= 0;
5105 XSETBUFFER (original_buffer
, current_buffer
);
5108 p
= Vwrite_region_annotate_functions
;
5109 GCPRO2 (annotations
, p
);
5112 struct buffer
*given_buffer
= current_buffer
;
5113 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5114 { /* Use the global value of the hook. */
5117 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5119 p
= Fappend (2, arg
);
5122 Vwrite_region_annotations_so_far
= annotations
;
5123 res
= call2 (XCAR (p
), start
, end
);
5124 /* If the function makes a different buffer current,
5125 assume that means this buffer contains altered text to be output.
5126 Reset START and END from the buffer bounds
5127 and discard all previous annotations because they should have
5128 been dealt with by this function. */
5129 if (current_buffer
!= given_buffer
)
5131 Vwrite_region_annotation_buffers
5132 = Fcons (Fcurrent_buffer (),
5133 Vwrite_region_annotation_buffers
);
5134 XSETFASTINT (start
, BEGV
);
5135 XSETFASTINT (end
, ZV
);
5138 Flength (res
); /* Check basic validity of return value */
5139 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5143 /* Now do the same for annotation functions implied by the file-format */
5144 if (auto_saving
&& (!EQ (BVAR (current_buffer
, auto_save_file_format
), Qt
)))
5145 p
= BVAR (current_buffer
, auto_save_file_format
);
5147 p
= BVAR (current_buffer
, file_format
);
5148 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5150 struct buffer
*given_buffer
= current_buffer
;
5152 Vwrite_region_annotations_so_far
= annotations
;
5154 /* Value is either a list of annotations or nil if the function
5155 has written annotations to a temporary buffer, which is now
5157 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5158 original_buffer
, make_number (i
));
5159 if (current_buffer
!= given_buffer
)
5161 XSETFASTINT (start
, BEGV
);
5162 XSETFASTINT (end
, ZV
);
5167 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5175 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5176 If STRING is nil, POS is the character position in the current buffer.
5177 Intersperse with them the annotations from *ANNOT
5178 which fall within the range of POS to POS + NCHARS,
5179 each at its appropriate position.
5181 We modify *ANNOT by discarding elements as we use them up.
5183 Return true if successful. */
5186 a_write (int desc
, Lisp_Object string
, ptrdiff_t pos
,
5187 ptrdiff_t nchars
, Lisp_Object
*annot
,
5188 struct coding_system
*coding
)
5192 ptrdiff_t lastpos
= pos
+ nchars
;
5194 while (NILP (*annot
) || CONSP (*annot
))
5196 tem
= Fcar_safe (Fcar (*annot
));
5199 nextpos
= XFASTINT (tem
);
5201 /* If there are no more annotations in this range,
5202 output the rest of the range all at once. */
5203 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5204 return e_write (desc
, string
, pos
, lastpos
, coding
);
5206 /* Output buffer text up to the next annotation's position. */
5209 if (!e_write (desc
, string
, pos
, nextpos
, coding
))
5213 /* Output the annotation. */
5214 tem
= Fcdr (Fcar (*annot
));
5217 if (!e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5220 *annot
= Fcdr (*annot
);
5226 /* Write text in the range START and END into descriptor DESC,
5227 encoding them with coding system CODING. If STRING is nil, START
5228 and END are character positions of the current buffer, else they
5229 are indexes to the string STRING. Return true if successful. */
5232 e_write (int desc
, Lisp_Object string
, ptrdiff_t start
, ptrdiff_t end
,
5233 struct coding_system
*coding
)
5235 if (STRINGP (string
))
5238 end
= SCHARS (string
);
5241 /* We used to have a code for handling selective display here. But,
5242 now it is handled within encode_coding. */
5246 if (STRINGP (string
))
5248 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5249 if (CODING_REQUIRE_ENCODING (coding
))
5251 encode_coding_object (coding
, string
,
5252 start
, string_char_to_byte (string
, start
),
5253 end
, string_char_to_byte (string
, end
), Qt
);
5257 coding
->dst_object
= string
;
5258 coding
->consumed_char
= SCHARS (string
);
5259 coding
->produced
= SBYTES (string
);
5264 ptrdiff_t start_byte
= CHAR_TO_BYTE (start
);
5265 ptrdiff_t end_byte
= CHAR_TO_BYTE (end
);
5267 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5268 if (CODING_REQUIRE_ENCODING (coding
))
5270 encode_coding_object (coding
, Fcurrent_buffer (),
5271 start
, start_byte
, end
, end_byte
, Qt
);
5275 coding
->dst_object
= Qnil
;
5276 coding
->dst_pos_byte
= start_byte
;
5277 if (start
>= GPT
|| end
<= GPT
)
5279 coding
->consumed_char
= end
- start
;
5280 coding
->produced
= end_byte
- start_byte
;
5284 coding
->consumed_char
= GPT
- start
;
5285 coding
->produced
= GPT_BYTE
- start_byte
;
5290 if (coding
->produced
> 0)
5293 -= emacs_write (desc
,
5294 STRINGP (coding
->dst_object
)
5295 ? SSDATA (coding
->dst_object
)
5296 : (char *) BYTE_POS_ADDR (coding
->dst_pos_byte
),
5299 if (coding
->produced
)
5302 start
+= coding
->consumed_char
;
5308 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5309 Sverify_visited_file_modtime
, 0, 1, 0,
5310 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5311 This means that the file has not been changed since it was visited or saved.
5312 If BUF is omitted or nil, it defaults to the current buffer.
5313 See Info node `(elisp)Modification Time' for more details. */)
5318 Lisp_Object handler
;
5319 Lisp_Object filename
;
5330 if (!STRINGP (BVAR (b
, filename
))) return Qt
;
5331 if (EMACS_NSECS (b
->modtime
) == UNKNOWN_MODTIME_NSECS
) return Qt
;
5333 /* If the file name has special constructs in it,
5334 call the corresponding file handler. */
5335 handler
= Ffind_file_name_handler (BVAR (b
, filename
),
5336 Qverify_visited_file_modtime
);
5337 if (!NILP (handler
))
5338 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5340 filename
= ENCODE_FILE (BVAR (b
, filename
));
5342 mtime
= (stat (SSDATA (filename
), &st
) == 0
5343 ? get_stat_mtime (&st
)
5344 : time_error_value (errno
));
5345 if (EMACS_TIME_EQ (mtime
, b
->modtime
)
5346 && (b
->modtime_size
< 0
5347 || st
.st_size
== b
->modtime_size
))
5352 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5353 Sclear_visited_file_modtime
, 0, 0, 0,
5354 doc
: /* Clear out records of last mod time of visited file.
5355 Next attempt to save will certainly not complain of a discrepancy. */)
5358 current_buffer
->modtime
= make_emacs_time (0, UNKNOWN_MODTIME_NSECS
);
5359 current_buffer
->modtime_size
= -1;
5363 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5364 Svisited_file_modtime
, 0, 0, 0,
5365 doc
: /* Return the current buffer's recorded visited file modification time.
5366 The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
5367 `file-attributes' returns. If the current buffer has no recorded file
5368 modification time, this function returns 0. If the visited file
5369 doesn't exist, HIGH will be -1.
5370 See Info node `(elisp)Modification Time' for more details. */)
5373 if (EMACS_NSECS (current_buffer
->modtime
) < 0)
5375 if (EMACS_NSECS (current_buffer
->modtime
) == NONEXISTENT_MODTIME_NSECS
)
5377 /* make_lisp_time won't work here if time_t is unsigned. */
5378 return list4 (make_number (-1), make_number (65535),
5379 make_number (0), make_number (0));
5381 return make_number (0);
5383 return make_lisp_time (current_buffer
->modtime
);
5386 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5387 Sset_visited_file_modtime
, 0, 1, 0,
5388 doc
: /* Update buffer's recorded modification time from the visited file's time.
5389 Useful if the buffer was not read from the file normally
5390 or if the file itself has been changed for some known benign reason.
5391 An argument specifies the modification time value to use
5392 \(instead of that of the visited file), in the form of a list
5393 \(HIGH LOW USEC PSEC) as returned by `current-time'. */)
5394 (Lisp_Object time_list
)
5396 if (!NILP (time_list
))
5398 current_buffer
->modtime
= lisp_time_argument (time_list
);
5399 current_buffer
->modtime_size
= -1;
5403 register Lisp_Object filename
;
5405 Lisp_Object handler
;
5407 filename
= Fexpand_file_name (BVAR (current_buffer
, filename
), Qnil
);
5409 /* If the file name has special constructs in it,
5410 call the corresponding file handler. */
5411 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5412 if (!NILP (handler
))
5413 /* The handler can find the file name the same way we did. */
5414 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5416 filename
= ENCODE_FILE (filename
);
5418 if (stat (SSDATA (filename
), &st
) >= 0)
5420 current_buffer
->modtime
= get_stat_mtime (&st
);
5421 current_buffer
->modtime_size
= st
.st_size
;
5429 auto_save_error (Lisp_Object error_val
)
5431 Lisp_Object args
[3], msg
;
5433 struct gcpro gcpro1
;
5437 auto_save_error_occurred
= 1;
5439 ring_bell (XFRAME (selected_frame
));
5441 args
[0] = build_string ("Auto-saving %s: %s");
5442 args
[1] = BVAR (current_buffer
, name
);
5443 args
[2] = Ferror_message_string (error_val
);
5444 msg
= Fformat (3, args
);
5446 nbytes
= SBYTES (msg
);
5447 msgbuf
= SAFE_ALLOCA (nbytes
);
5448 memcpy (msgbuf
, SDATA (msg
), nbytes
);
5450 for (i
= 0; i
< 3; ++i
)
5453 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5455 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5456 Fsleep_for (make_number (1), Qnil
);
5470 auto_save_mode_bits
= 0666;
5472 /* Get visited file's mode to become the auto save file's mode. */
5473 if (! NILP (BVAR (current_buffer
, filename
)))
5475 if (stat (SSDATA (BVAR (current_buffer
, filename
)), &st
) >= 0)
5476 /* But make sure we can overwrite it later! */
5477 auto_save_mode_bits
= (st
.st_mode
| 0600) & 0777;
5478 else if (modes
= Ffile_modes (BVAR (current_buffer
, filename
)),
5480 /* Remote files don't cooperate with stat. */
5481 auto_save_mode_bits
= (XINT (modes
) | 0600) & 0777;
5485 Fwrite_region (Qnil
, Qnil
, BVAR (current_buffer
, auto_save_file_name
), Qnil
,
5486 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5491 do_auto_save_unwind (Lisp_Object arg
) /* used as unwind-protect function */
5494 FILE *stream
= XSAVE_POINTER (arg
, 0);
5506 do_auto_save_unwind_1 (Lisp_Object value
) /* used as unwind-protect function */
5509 minibuffer_auto_raise
= XINT (value
);
5514 do_auto_save_make_dir (Lisp_Object dir
)
5518 auto_saving_dir_umask
= 077;
5519 result
= call2 (Qmake_directory
, dir
, Qt
);
5520 auto_saving_dir_umask
= 0;
5525 do_auto_save_eh (Lisp_Object ignore
)
5527 auto_saving_dir_umask
= 0;
5531 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5532 doc
: /* Auto-save all buffers that need it.
5533 This is all buffers that have auto-saving enabled
5534 and are changed since last auto-saved.
5535 Auto-saving writes the buffer into a file
5536 so that your editing is not lost if the system crashes.
5537 This file is not the file you visited; that changes only when you save.
5538 Normally we run the normal hook `auto-save-hook' before saving.
5540 A non-nil NO-MESSAGE argument means do not print any message if successful.
5541 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5542 (Lisp_Object no_message
, Lisp_Object current_only
)
5544 struct buffer
*old
= current_buffer
, *b
;
5545 Lisp_Object tail
, buf
, hook
;
5546 bool auto_saved
= 0;
5547 int do_handled_files
;
5549 FILE *stream
= NULL
;
5550 ptrdiff_t count
= SPECPDL_INDEX ();
5551 bool orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5552 bool old_message_p
= 0;
5553 struct gcpro gcpro1
, gcpro2
;
5555 if (max_specpdl_size
< specpdl_size
+ 40)
5556 max_specpdl_size
= specpdl_size
+ 40;
5561 if (NILP (no_message
))
5563 old_message_p
= push_message ();
5564 record_unwind_protect (pop_message_unwind
, Qnil
);
5567 /* Ordinarily don't quit within this function,
5568 but don't make it impossible to quit (in case we get hung in I/O). */
5572 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5573 point to non-strings reached from Vbuffer_alist. */
5575 hook
= intern ("auto-save-hook");
5576 Frun_hooks (1, &hook
);
5578 if (STRINGP (Vauto_save_list_file_name
))
5580 Lisp_Object listfile
;
5582 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5584 /* Don't try to create the directory when shutting down Emacs,
5585 because creating the directory might signal an error, and
5586 that would leave Emacs in a strange state. */
5587 if (!NILP (Vrun_hooks
))
5591 GCPRO2 (dir
, listfile
);
5592 dir
= Ffile_name_directory (listfile
);
5593 if (NILP (Ffile_directory_p (dir
)))
5594 internal_condition_case_1 (do_auto_save_make_dir
,
5600 stream
= fopen (SSDATA (listfile
), "w");
5603 record_unwind_protect (do_auto_save_unwind
,
5604 make_save_pointer (stream
));
5605 record_unwind_protect (do_auto_save_unwind_1
,
5606 make_number (minibuffer_auto_raise
));
5607 minibuffer_auto_raise
= 0;
5609 auto_save_error_occurred
= 0;
5611 /* On first pass, save all files that don't have handlers.
5612 On second pass, save all files that do have handlers.
5614 If Emacs is crashing, the handlers may tweak what is causing
5615 Emacs to crash in the first place, and it would be a shame if
5616 Emacs failed to autosave perfectly ordinary files because it
5617 couldn't handle some ange-ftp'd file. */
5619 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5620 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5622 buf
= XCDR (XCAR (tail
));
5625 /* Record all the buffers that have auto save mode
5626 in the special file that lists them. For each of these buffers,
5627 Record visited name (if any) and auto save name. */
5628 if (STRINGP (BVAR (b
, auto_save_file_name
))
5629 && stream
!= NULL
&& do_handled_files
== 0)
5632 if (!NILP (BVAR (b
, filename
)))
5634 fwrite (SDATA (BVAR (b
, filename
)), 1,
5635 SBYTES (BVAR (b
, filename
)), stream
);
5637 putc ('\n', stream
);
5638 fwrite (SDATA (BVAR (b
, auto_save_file_name
)), 1,
5639 SBYTES (BVAR (b
, auto_save_file_name
)), stream
);
5640 putc ('\n', stream
);
5644 if (!NILP (current_only
)
5645 && b
!= current_buffer
)
5648 /* Don't auto-save indirect buffers.
5649 The base buffer takes care of it. */
5653 /* Check for auto save enabled
5654 and file changed since last auto save
5655 and file changed since last real save. */
5656 if (STRINGP (BVAR (b
, auto_save_file_name
))
5657 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5658 && BUF_AUTOSAVE_MODIFF (b
) < BUF_MODIFF (b
)
5659 /* -1 means we've turned off autosaving for a while--see below. */
5660 && XINT (BVAR (b
, save_length
)) >= 0
5661 && (do_handled_files
5662 || NILP (Ffind_file_name_handler (BVAR (b
, auto_save_file_name
),
5665 EMACS_TIME before_time
= current_emacs_time ();
5666 EMACS_TIME after_time
;
5668 /* If we had a failure, don't try again for 20 minutes. */
5669 if (b
->auto_save_failure_time
> 0
5670 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5673 set_buffer_internal (b
);
5674 if (NILP (Vauto_save_include_big_deletions
)
5675 && (XFASTINT (BVAR (b
, save_length
)) * 10
5676 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5677 /* A short file is likely to change a large fraction;
5678 spare the user annoying messages. */
5679 && XFASTINT (BVAR (b
, save_length
)) > 5000
5680 /* These messages are frequent and annoying for `*mail*'. */
5681 && !EQ (BVAR (b
, filename
), Qnil
)
5682 && NILP (no_message
))
5684 /* It has shrunk too much; turn off auto-saving here. */
5685 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5686 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5688 minibuffer_auto_raise
= 0;
5689 /* Turn off auto-saving until there's a real save,
5690 and prevent any more warnings. */
5691 XSETINT (BVAR (b
, save_length
), -1);
5692 Fsleep_for (make_number (1), Qnil
);
5695 if (!auto_saved
&& NILP (no_message
))
5696 message1 ("Auto-saving...");
5697 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5699 BUF_AUTOSAVE_MODIFF (b
) = BUF_MODIFF (b
);
5700 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5701 set_buffer_internal (old
);
5703 after_time
= current_emacs_time ();
5705 /* If auto-save took more than 60 seconds,
5706 assume it was an NFS failure that got a timeout. */
5707 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5708 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5712 /* Prevent another auto save till enough input events come in. */
5713 record_auto_save ();
5715 if (auto_saved
&& NILP (no_message
))
5719 /* If we are going to restore an old message,
5720 give time to read ours. */
5721 sit_for (make_number (1), 0, 0);
5724 else if (!auto_save_error_occurred
)
5725 /* Don't overwrite the error message if an error occurred.
5726 If we displayed a message and then restored a state
5727 with no message, leave a "done" message on the screen. */
5728 message1 ("Auto-saving...done");
5733 /* This restores the message-stack status. */
5734 unbind_to (count
, Qnil
);
5738 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5739 Sset_buffer_auto_saved
, 0, 0, 0,
5740 doc
: /* Mark current buffer as auto-saved with its current text.
5741 No auto-save file will be written until the buffer changes again. */)
5744 /* FIXME: This should not be called in indirect buffers, since
5745 they're not autosaved. */
5746 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
5747 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5748 current_buffer
->auto_save_failure_time
= 0;
5752 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5753 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5754 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5757 current_buffer
->auto_save_failure_time
= 0;
5761 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5763 doc
: /* Return t if current buffer has been auto-saved recently.
5764 More precisely, if it has been auto-saved since last read from or saved
5765 in the visited file. If the buffer has no visited file,
5766 then any auto-save counts as "recent". */)
5769 /* FIXME: maybe we should return nil for indirect buffers since
5770 they're never autosaved. */
5771 return (SAVE_MODIFF
< BUF_AUTOSAVE_MODIFF (current_buffer
) ? Qt
: Qnil
);
5774 /* Reading and completing file names */
5776 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5777 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5778 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5779 The return value is only relevant for a call to `read-file-name' that happens
5780 before any other event (mouse or keypress) is handled. */)
5783 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) \
5784 || defined (HAVE_NS)
5785 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5795 Fread_file_name (Lisp_Object prompt
, Lisp_Object dir
, Lisp_Object default_filename
, Lisp_Object mustmatch
, Lisp_Object initial
, Lisp_Object predicate
)
5797 struct gcpro gcpro1
;
5798 Lisp_Object args
[7];
5800 GCPRO1 (default_filename
);
5801 args
[0] = intern ("read-file-name");
5804 args
[3] = default_filename
;
5805 args
[4] = mustmatch
;
5807 args
[6] = predicate
;
5808 RETURN_UNGCPRO (Ffuncall (7, args
));
5815 valid_timestamp_file_system
= 0;
5819 syms_of_fileio (void)
5821 DEFSYM (Qoperations
, "operations");
5822 DEFSYM (Qexpand_file_name
, "expand-file-name");
5823 DEFSYM (Qsubstitute_in_file_name
, "substitute-in-file-name");
5824 DEFSYM (Qdirectory_file_name
, "directory-file-name");
5825 DEFSYM (Qfile_name_directory
, "file-name-directory");
5826 DEFSYM (Qfile_name_nondirectory
, "file-name-nondirectory");
5827 DEFSYM (Qunhandled_file_name_directory
, "unhandled-file-name-directory");
5828 DEFSYM (Qfile_name_as_directory
, "file-name-as-directory");
5829 DEFSYM (Qcopy_file
, "copy-file");
5830 DEFSYM (Qmake_directory_internal
, "make-directory-internal");
5831 DEFSYM (Qmake_directory
, "make-directory");
5832 DEFSYM (Qdelete_directory_internal
, "delete-directory-internal");
5833 DEFSYM (Qdelete_file
, "delete-file");
5834 DEFSYM (Qrename_file
, "rename-file");
5835 DEFSYM (Qadd_name_to_file
, "add-name-to-file");
5836 DEFSYM (Qmake_symbolic_link
, "make-symbolic-link");
5837 DEFSYM (Qfile_exists_p
, "file-exists-p");
5838 DEFSYM (Qfile_executable_p
, "file-executable-p");
5839 DEFSYM (Qfile_readable_p
, "file-readable-p");
5840 DEFSYM (Qfile_writable_p
, "file-writable-p");
5841 DEFSYM (Qfile_symlink_p
, "file-symlink-p");
5842 DEFSYM (Qaccess_file
, "access-file");
5843 DEFSYM (Qfile_directory_p
, "file-directory-p");
5844 DEFSYM (Qfile_regular_p
, "file-regular-p");
5845 DEFSYM (Qfile_accessible_directory_p
, "file-accessible-directory-p");
5846 DEFSYM (Qfile_modes
, "file-modes");
5847 DEFSYM (Qset_file_modes
, "set-file-modes");
5848 DEFSYM (Qset_file_times
, "set-file-times");
5849 DEFSYM (Qfile_selinux_context
, "file-selinux-context");
5850 DEFSYM (Qset_file_selinux_context
, "set-file-selinux-context");
5851 DEFSYM (Qfile_acl
, "file-acl");
5852 DEFSYM (Qset_file_acl
, "set-file-acl");
5853 DEFSYM (Qfile_newer_than_file_p
, "file-newer-than-file-p");
5854 DEFSYM (Qinsert_file_contents
, "insert-file-contents");
5855 DEFSYM (Qwrite_region
, "write-region");
5856 DEFSYM (Qverify_visited_file_modtime
, "verify-visited-file-modtime");
5857 DEFSYM (Qset_visited_file_modtime
, "set-visited-file-modtime");
5858 DEFSYM (Qauto_save_coding
, "auto-save-coding");
5860 DEFSYM (Qfile_name_history
, "file-name-history");
5861 Fset (Qfile_name_history
, Qnil
);
5863 DEFSYM (Qfile_error
, "file-error");
5864 DEFSYM (Qfile_already_exists
, "file-already-exists");
5865 DEFSYM (Qfile_date_error
, "file-date-error");
5866 DEFSYM (Qexcl
, "excl");
5868 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system
,
5869 doc
: /* Coding system for encoding file names.
5870 If it is nil, `default-file-name-coding-system' (which see) is used. */);
5871 Vfile_name_coding_system
= Qnil
;
5873 DEFVAR_LISP ("default-file-name-coding-system",
5874 Vdefault_file_name_coding_system
,
5875 doc
: /* Default coding system for encoding file names.
5876 This variable is used only when `file-name-coding-system' is nil.
5878 This variable is set/changed by the command `set-language-environment'.
5879 User should not set this variable manually,
5880 instead use `file-name-coding-system' to get a constant encoding
5881 of file names regardless of the current language environment. */);
5882 Vdefault_file_name_coding_system
= Qnil
;
5884 DEFSYM (Qformat_decode
, "format-decode");
5885 DEFSYM (Qformat_annotate_function
, "format-annotate-function");
5886 DEFSYM (Qafter_insert_file_set_coding
, "after-insert-file-set-coding");
5887 DEFSYM (Qcar_less_than_car
, "car-less-than-car");
5889 Fput (Qfile_error
, Qerror_conditions
,
5890 Fpurecopy (list2 (Qfile_error
, Qerror
)));
5891 Fput (Qfile_error
, Qerror_message
,
5892 build_pure_c_string ("File error"));
5894 Fput (Qfile_already_exists
, Qerror_conditions
,
5895 Fpurecopy (list3 (Qfile_already_exists
, Qfile_error
, Qerror
)));
5896 Fput (Qfile_already_exists
, Qerror_message
,
5897 build_pure_c_string ("File already exists"));
5899 Fput (Qfile_date_error
, Qerror_conditions
,
5900 Fpurecopy (list3 (Qfile_date_error
, Qfile_error
, Qerror
)));
5901 Fput (Qfile_date_error
, Qerror_message
,
5902 build_pure_c_string ("Cannot set file date"));
5904 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist
,
5905 doc
: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
5906 If a file name matches REGEXP, all I/O on that file is done by calling
5907 HANDLER. If a file name matches more than one handler, the handler
5908 whose match starts last in the file name gets precedence. The
5909 function `find-file-name-handler' checks this list for a handler for
5912 HANDLER should be a function. The first argument given to it is the
5913 name of the I/O primitive to be handled; the remaining arguments are
5914 the arguments that were passed to that primitive. For example, if you
5915 do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
5916 HANDLER is called like this:
5918 (funcall HANDLER 'file-exists-p FILENAME)
5920 Note that HANDLER must be able to handle all I/O primitives; if it has
5921 nothing special to do for a primitive, it should reinvoke the
5922 primitive to handle the operation \"the usual way\".
5923 See Info node `(elisp)Magic File Names' for more details. */);
5924 Vfile_name_handler_alist
= Qnil
;
5926 DEFVAR_LISP ("set-auto-coding-function",
5927 Vset_auto_coding_function
,
5928 doc
: /* If non-nil, a function to call to decide a coding system of file.
5929 Two arguments are passed to this function: the file name
5930 and the length of a file contents following the point.
5931 This function should return a coding system to decode the file contents.
5932 It should check the file name against `auto-coding-alist'.
5933 If no coding system is decided, it should check a coding system
5934 specified in the heading lines with the format:
5935 -*- ... coding: CODING-SYSTEM; ... -*-
5936 or local variable spec of the tailing lines with `coding:' tag. */);
5937 Vset_auto_coding_function
= Qnil
;
5939 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions
,
5940 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
5941 Each is passed one argument, the number of characters inserted,
5942 with point at the start of the inserted text. Each function
5943 should leave point the same, and return the new character count.
5944 If `insert-file-contents' is intercepted by a handler from
5945 `file-name-handler-alist', that handler is responsible for calling the
5946 functions in `after-insert-file-functions' if appropriate. */);
5947 Vafter_insert_file_functions
= Qnil
;
5949 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions
,
5950 doc
: /* A list of functions to be called at the start of `write-region'.
5951 Each is passed two arguments, START and END as for `write-region'.
5952 These are usually two numbers but not always; see the documentation
5953 for `write-region'. The function should return a list of pairs
5954 of the form (POSITION . STRING), consisting of strings to be effectively
5955 inserted at the specified positions of the file being written (1 means to
5956 insert before the first byte written). The POSITIONs must be sorted into
5959 If there are several annotation functions, the lists returned by these
5960 functions are merged destructively. As each annotation function runs,
5961 the variable `write-region-annotations-so-far' contains a list of all
5962 annotations returned by previous annotation functions.
5964 An annotation function can return with a different buffer current.
5965 Doing so removes the annotations returned by previous functions, and
5966 resets START and END to `point-min' and `point-max' of the new buffer.
5968 After `write-region' completes, Emacs calls the function stored in
5969 `write-region-post-annotation-function', once for each buffer that was
5970 current when building the annotations (i.e., at least once), with that
5971 buffer current. */);
5972 Vwrite_region_annotate_functions
= Qnil
;
5973 DEFSYM (Qwrite_region_annotate_functions
, "write-region-annotate-functions");
5975 DEFVAR_LISP ("write-region-post-annotation-function",
5976 Vwrite_region_post_annotation_function
,
5977 doc
: /* Function to call after `write-region' completes.
5978 The function is called with no arguments. If one or more of the
5979 annotation functions in `write-region-annotate-functions' changed the
5980 current buffer, the function stored in this variable is called for
5981 each of those additional buffers as well, in addition to the original
5982 buffer. The relevant buffer is current during each function call. */);
5983 Vwrite_region_post_annotation_function
= Qnil
;
5984 staticpro (&Vwrite_region_annotation_buffers
);
5986 DEFVAR_LISP ("write-region-annotations-so-far",
5987 Vwrite_region_annotations_so_far
,
5988 doc
: /* When an annotation function is called, this holds the previous annotations.
5989 These are the annotations made by other annotation functions
5990 that were already called. See also `write-region-annotate-functions'. */);
5991 Vwrite_region_annotations_so_far
= Qnil
;
5993 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers
,
5994 doc
: /* A list of file name handlers that temporarily should not be used.
5995 This applies only to the operation `inhibit-file-name-operation'. */);
5996 Vinhibit_file_name_handlers
= Qnil
;
5998 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation
,
5999 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6000 Vinhibit_file_name_operation
= Qnil
;
6002 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name
,
6003 doc
: /* File name in which we write a list of all auto save file names.
6004 This variable is initialized automatically from `auto-save-list-file-prefix'
6005 shortly after Emacs reads your init file, if you have not yet given it
6006 a non-nil value. */);
6007 Vauto_save_list_file_name
= Qnil
;
6009 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name
,
6010 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
6011 Normally auto-save files are written under other names. */);
6012 Vauto_save_visited_file_name
= Qnil
;
6014 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions
,
6015 doc
: /* If non-nil, auto-save even if a large part of the text is deleted.
6016 If nil, deleting a substantial portion of the text disables auto-save
6017 in the buffer; this is the default behavior, because the auto-save
6018 file is usually more useful if it contains the deleted text. */);
6019 Vauto_save_include_big_deletions
= Qnil
;
6022 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync
,
6023 doc
: /* Non-nil means don't call fsync in `write-region'.
6024 This variable affects calls to `write-region' as well as save commands.
6025 A non-nil value may result in data loss! */);
6026 write_region_inhibit_fsync
= 0;
6029 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash
,
6030 doc
: /* Specifies whether to use the system's trash can.
6031 When non-nil, certain file deletion commands use the function
6032 `move-file-to-trash' instead of deleting files outright.
6033 This includes interactive calls to `delete-file' and
6034 `delete-directory' and the Dired deletion commands. */);
6035 delete_by_moving_to_trash
= 0;
6036 Qdelete_by_moving_to_trash
= intern_c_string ("delete-by-moving-to-trash");
6038 DEFSYM (Qmove_file_to_trash
, "move-file-to-trash");
6039 DEFSYM (Qcopy_directory
, "copy-directory");
6040 DEFSYM (Qdelete_directory
, "delete-directory");
6042 defsubr (&Sfind_file_name_handler
);
6043 defsubr (&Sfile_name_directory
);
6044 defsubr (&Sfile_name_nondirectory
);
6045 defsubr (&Sunhandled_file_name_directory
);
6046 defsubr (&Sfile_name_as_directory
);
6047 defsubr (&Sdirectory_file_name
);
6048 defsubr (&Smake_temp_name
);
6049 defsubr (&Sexpand_file_name
);
6050 defsubr (&Ssubstitute_in_file_name
);
6051 defsubr (&Scopy_file
);
6052 defsubr (&Smake_directory_internal
);
6053 defsubr (&Sdelete_directory_internal
);
6054 defsubr (&Sdelete_file
);
6055 defsubr (&Srename_file
);
6056 defsubr (&Sadd_name_to_file
);
6057 defsubr (&Smake_symbolic_link
);
6058 defsubr (&Sfile_name_absolute_p
);
6059 defsubr (&Sfile_exists_p
);
6060 defsubr (&Sfile_executable_p
);
6061 defsubr (&Sfile_readable_p
);
6062 defsubr (&Sfile_writable_p
);
6063 defsubr (&Saccess_file
);
6064 defsubr (&Sfile_symlink_p
);
6065 defsubr (&Sfile_directory_p
);
6066 defsubr (&Sfile_accessible_directory_p
);
6067 defsubr (&Sfile_regular_p
);
6068 defsubr (&Sfile_modes
);
6069 defsubr (&Sset_file_modes
);
6070 defsubr (&Sset_file_times
);
6071 defsubr (&Sfile_selinux_context
);
6072 defsubr (&Sfile_acl
);
6073 defsubr (&Sset_file_acl
);
6074 defsubr (&Sset_file_selinux_context
);
6075 defsubr (&Sset_default_file_modes
);
6076 defsubr (&Sdefault_file_modes
);
6077 defsubr (&Sfile_newer_than_file_p
);
6078 defsubr (&Sinsert_file_contents
);
6079 defsubr (&Swrite_region
);
6080 defsubr (&Scar_less_than_car
);
6081 defsubr (&Sverify_visited_file_modtime
);
6082 defsubr (&Sclear_visited_file_modtime
);
6083 defsubr (&Svisited_file_modtime
);
6084 defsubr (&Sset_visited_file_modtime
);
6085 defsubr (&Sdo_auto_save
);
6086 defsubr (&Sset_buffer_auto_saved
);
6087 defsubr (&Sclear_buffer_auto_save_failure
);
6088 defsubr (&Srecent_auto_save_p
);
6090 defsubr (&Snext_read_file_uses_dialog_p
);
6093 defsubr (&Sunix_sync
);