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 /* Read from a non-regular 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_non_regular (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
);
3439 /* Condition-case handler used when reading from non-regular files
3440 in insert-file-contents. */
3443 read_non_regular_quit (Lisp_Object ignore
)
3448 /* Return the file offset that VAL represents, checking for type
3449 errors and overflow. */
3451 file_offset (Lisp_Object val
)
3453 if (RANGED_INTEGERP (0, val
, TYPE_MAXIMUM (off_t
)))
3458 double v
= XFLOAT_DATA (val
);
3460 && (sizeof (off_t
) < sizeof v
3461 ? v
<= TYPE_MAXIMUM (off_t
)
3462 : v
< TYPE_MAXIMUM (off_t
)))
3466 wrong_type_argument (intern ("file-offset"), val
);
3469 /* Return a special time value indicating the error number ERRNUM. */
3471 time_error_value (int errnum
)
3473 int ns
= (errnum
== ENOENT
|| errnum
== EACCES
|| errnum
== ENOTDIR
3474 ? NONEXISTENT_MODTIME_NSECS
3475 : UNKNOWN_MODTIME_NSECS
);
3476 return make_emacs_time (0, ns
);
3479 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3481 doc
: /* Insert contents of file FILENAME after point.
3482 Returns list of absolute file name and number of characters inserted.
3483 If second argument VISIT is non-nil, the buffer's visited filename and
3484 last save file modtime are set, and it is marked unmodified. If
3485 visiting and the file does not exist, visiting is completed before the
3488 The optional third and fourth arguments BEG and END specify what portion
3489 of the file to insert. These arguments count bytes in the file, not
3490 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3492 If optional fifth argument REPLACE is non-nil, replace the current
3493 buffer contents (in the accessible portion) with the file contents.
3494 This is better than simply deleting and inserting the whole thing
3495 because (1) it preserves some marker positions and (2) it puts less data
3496 in the undo list. When REPLACE is non-nil, the second return value is
3497 the number of characters that replace previous buffer contents.
3499 This function does code conversion according to the value of
3500 `coding-system-for-read' or `file-coding-system-alist', and sets the
3501 variable `last-coding-system-used' to the coding system actually used.
3503 In addition, this function decodes the inserted text from known formats
3504 by calling `format-decode', which see. */)
3505 (Lisp_Object filename
, Lisp_Object visit
, Lisp_Object beg
, Lisp_Object end
, Lisp_Object replace
)
3510 ptrdiff_t inserted
= 0;
3513 off_t beg_offset
, end_offset
;
3515 ptrdiff_t count
= SPECPDL_INDEX ();
3516 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3517 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3519 ptrdiff_t total
= 0;
3520 bool not_regular
= 0;
3522 char read_buf
[READ_BUF_SIZE
];
3523 struct coding_system coding
;
3524 bool replace_handled
= 0;
3525 bool set_coding_system
= 0;
3526 Lisp_Object coding_system
;
3528 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3529 bool we_locked_file
= 0;
3530 bool deferred_remove_unwind_protect
= 0;
3532 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3533 error ("Cannot do file visiting in an indirect buffer");
3535 if (!NILP (BVAR (current_buffer
, read_only
)))
3536 Fbarf_if_buffer_read_only ();
3540 orig_filename
= Qnil
;
3543 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3545 CHECK_STRING (filename
);
3546 filename
= Fexpand_file_name (filename
, Qnil
);
3548 /* The value Qnil means that the coding system is not yet
3550 coding_system
= Qnil
;
3552 /* If the file name has special constructs in it,
3553 call the corresponding file handler. */
3554 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3555 if (!NILP (handler
))
3557 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3558 visit
, beg
, end
, replace
);
3559 if (CONSP (val
) && CONSP (XCDR (val
))
3560 && RANGED_INTEGERP (0, XCAR (XCDR (val
)), ZV
- PT
))
3561 inserted
= XINT (XCAR (XCDR (val
)));
3565 orig_filename
= filename
;
3566 filename
= ENCODE_FILE (filename
);
3568 fd
= emacs_open (SSDATA (filename
), O_RDONLY
, 0);
3573 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3574 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
, read_buf
, sizeof read_buf
);
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 *) read_buf
,
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
) == read_buf
[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 read_buf
);
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
, read_buf
+ 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) == read_buf
[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 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4011 unprocessed
= 0; /* Bytes not processed in previous loop. */
4013 GCPRO1 (conversion_buffer
);
4016 /* Read at most READ_BUF_SIZE bytes at a time, to allow
4017 quitting while reading a huge file. */
4019 /* Allow quitting out of the actual I/O. */
4022 this = emacs_read (fd
, read_buf
+ unprocessed
,
4023 READ_BUF_SIZE
- unprocessed
);
4029 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
4030 BUF_Z (XBUFFER (conversion_buffer
)));
4031 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
4032 unprocessed
+ this, conversion_buffer
);
4033 unprocessed
= coding
.carryover_bytes
;
4034 if (coding
.carryover_bytes
> 0)
4035 memcpy (read_buf
, coding
.carryover
, unprocessed
);
4040 /* We should remove the unwind_protect calling
4041 close_file_unwind, but other stuff has been added the stack,
4042 so defer the removal till we reach the `handled' label. */
4043 deferred_remove_unwind_protect
= 1;
4046 error ("IO error reading %s: %s",
4047 SDATA (orig_filename
), emacs_strerror (errno
));
4049 if (unprocessed
> 0)
4051 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4052 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
4053 unprocessed
, conversion_buffer
);
4054 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
4057 coding_system
= CODING_ID_NAME (coding
.id
);
4058 set_coding_system
= 1;
4059 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
4060 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
4061 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4063 /* Compare the beginning of the converted string with the buffer
4067 while (bufpos
< inserted
&& same_at_start
< same_at_end
4068 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
4069 same_at_start
++, bufpos
++;
4071 /* If the file matches the head of buffer completely,
4072 there's no need to replace anything. */
4074 if (bufpos
== inserted
)
4076 /* Truncate the buffer to the size of the file. */
4077 if (same_at_start
== same_at_end
)
4080 del_range_byte (same_at_start
, same_at_end
, 0);
4083 unbind_to (this_count
, Qnil
);
4087 /* Extend the start of non-matching text area to the previous
4088 multibyte character boundary. */
4089 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4090 while (same_at_start
> BEGV_BYTE
4091 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4094 /* Scan this bufferful from the end, comparing with
4095 the Emacs buffer. */
4098 /* Compare with same_at_start to avoid counting some buffer text
4099 as matching both at the file's beginning and at the end. */
4100 while (bufpos
> 0 && same_at_end
> same_at_start
4101 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
4102 same_at_end
--, bufpos
--;
4104 /* Extend the end of non-matching text area to the next
4105 multibyte character boundary. */
4106 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4107 while (same_at_end
< ZV_BYTE
4108 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4111 /* Don't try to reuse the same piece of text twice. */
4112 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4114 same_at_end
+= overlap
;
4116 /* If display currently starts at beginning of line,
4117 keep it that way. */
4118 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4119 XWINDOW (selected_window
)->start_at_line_beg
= !NILP (Fbolp ());
4121 /* Replace the chars that we need to replace,
4122 and update INSERTED to equal the number of bytes
4123 we are taking from the decoded string. */
4124 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4126 if (same_at_end
!= same_at_start
)
4128 del_range_byte (same_at_start
, same_at_end
, 0);
4130 same_at_start
= GPT_BYTE
;
4134 temp
= BYTE_TO_CHAR (same_at_start
);
4136 /* Insert from the file at the proper position. */
4137 SET_PT_BOTH (temp
, same_at_start
);
4138 same_at_start_charpos
4139 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4140 same_at_start
- BEGV_BYTE
4141 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4143 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4144 same_at_start
+ inserted
- BEGV_BYTE
4145 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
4146 - same_at_start_charpos
);
4147 /* This binding is to avoid ask-user-about-supersession-threat
4148 being called in insert_from_buffer (via in
4149 prepare_to_modify_buffer). */
4150 specbind (intern ("buffer-file-name"), Qnil
);
4151 insert_from_buffer (XBUFFER (conversion_buffer
),
4152 same_at_start_charpos
, inserted_chars
, 0);
4153 /* Set `inserted' to the number of inserted characters. */
4154 inserted
= PT
- temp
;
4155 /* Set point before the inserted characters. */
4156 SET_PT_BOTH (temp
, same_at_start
);
4158 unbind_to (this_count
, Qnil
);
4164 total
= end_offset
- beg_offset
;
4166 /* For a special file, all we can do is guess. */
4167 total
= READ_BUF_SIZE
;
4169 if (NILP (visit
) && total
> 0)
4171 #ifdef CLASH_DETECTION
4172 if (!NILP (BVAR (current_buffer
, file_truename
))
4173 /* Make binding buffer-file-name to nil effective. */
4174 && !NILP (BVAR (current_buffer
, filename
))
4175 && SAVE_MODIFF
>= MODIFF
)
4177 #endif /* CLASH_DETECTION */
4178 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4181 move_gap_both (PT
, PT_BYTE
);
4182 if (GAP_SIZE
< total
)
4183 make_gap (total
- GAP_SIZE
);
4185 if (beg_offset
!= 0 || !NILP (replace
))
4187 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
4188 report_file_error ("Setting file position",
4189 Fcons (orig_filename
, Qnil
));
4192 /* In the following loop, HOW_MUCH contains the total bytes read so
4193 far for a regular file, and not changed for a special file. But,
4194 before exiting the loop, it is set to a negative value if I/O
4198 /* Total bytes inserted. */
4201 /* Here, we don't do code conversion in the loop. It is done by
4202 decode_coding_gap after all data are read into the buffer. */
4204 ptrdiff_t gap_size
= GAP_SIZE
;
4206 while (how_much
< total
)
4208 /* try is reserved in some compilers (Microsoft C) */
4209 ptrdiff_t trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4216 /* Maybe make more room. */
4217 if (gap_size
< trytry
)
4219 make_gap (trytry
- gap_size
);
4220 gap_size
= GAP_SIZE
- inserted
;
4223 /* Read from the file, capturing `quit'. When an
4224 error occurs, end the loop, and arrange for a quit
4225 to be signaled after decoding the text we read. */
4226 nbytes
= internal_condition_case_1
4228 make_save_value ("iii", (ptrdiff_t) fd
, inserted
, trytry
),
4229 Qerror
, read_non_regular_quit
);
4237 this = XINT (nbytes
);
4241 /* Allow quitting out of the actual I/O. We don't make text
4242 part of the buffer until all the reading is done, so a C-g
4243 here doesn't do any harm. */
4246 this = emacs_read (fd
,
4247 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
4261 /* For a regular file, where TOTAL is the real size,
4262 count HOW_MUCH to compare with it.
4263 For a special file, where TOTAL is just a buffer size,
4264 so don't bother counting in HOW_MUCH.
4265 (INSERTED is where we count the number of characters inserted.) */
4272 /* Now we have either read all the file data into the gap,
4273 or stop reading on I/O error or quit. If nothing was
4274 read, undo marking the buffer modified. */
4278 #ifdef CLASH_DETECTION
4280 unlock_file (BVAR (current_buffer
, file_truename
));
4282 Vdeactivate_mark
= old_Vdeactivate_mark
;
4285 Vdeactivate_mark
= Qt
;
4289 /* Discard the unwind protect for closing the file. */
4293 error ("IO error reading %s: %s",
4294 SDATA (orig_filename
), emacs_strerror (errno
));
4296 /* Make the text read part of the buffer. */
4297 GAP_SIZE
-= inserted
;
4299 GPT_BYTE
+= inserted
;
4301 ZV_BYTE
+= inserted
;
4306 /* Put an anchor to ensure multi-byte form ends at gap. */
4311 if (NILP (coding_system
))
4313 /* The coding system is not yet decided. Decide it by an
4314 optimized method for handling `coding:' tag.
4316 Note that we can get here only if the buffer was empty
4317 before the insertion. */
4319 if (!NILP (Vcoding_system_for_read
))
4320 coding_system
= Vcoding_system_for_read
;
4323 /* Since we are sure that the current buffer was empty
4324 before the insertion, we can toggle
4325 enable-multibyte-characters directly here without taking
4326 care of marker adjustment. By this way, we can run Lisp
4327 program safely before decoding the inserted text. */
4328 Lisp_Object unwind_data
;
4329 ptrdiff_t count1
= SPECPDL_INDEX ();
4331 unwind_data
= Fcons (BVAR (current_buffer
, enable_multibyte_characters
),
4332 Fcons (BVAR (current_buffer
, undo_list
),
4333 Fcurrent_buffer ()));
4334 bset_enable_multibyte_characters (current_buffer
, Qnil
);
4335 bset_undo_list (current_buffer
, Qt
);
4336 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4338 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4340 coding_system
= call2 (Vset_auto_coding_function
,
4341 filename
, make_number (inserted
));
4344 if (NILP (coding_system
))
4346 /* If the coding system is not yet decided, check
4347 file-coding-system-alist. */
4348 Lisp_Object args
[6];
4350 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4351 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4352 coding_system
= Ffind_operation_coding_system (6, args
);
4353 if (CONSP (coding_system
))
4354 coding_system
= XCAR (coding_system
);
4356 unbind_to (count1
, Qnil
);
4357 inserted
= Z_BYTE
- BEG_BYTE
;
4360 if (NILP (coding_system
))
4361 coding_system
= Qundecided
;
4363 CHECK_CODING_SYSTEM (coding_system
);
4365 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4366 /* We must suppress all character code conversion except for
4367 end-of-line conversion. */
4368 coding_system
= raw_text_coding_system (coding_system
);
4369 setup_coding_system (coding_system
, &coding
);
4370 /* Ensure we set Vlast_coding_system_used. */
4371 set_coding_system
= 1;
4376 /* When we visit a file by raw-text, we change the buffer to
4378 if (CODING_FOR_UNIBYTE (&coding
)
4379 /* Can't do this if part of the buffer might be preserved. */
4381 /* Visiting a file with these coding system makes the buffer
4383 bset_enable_multibyte_characters (current_buffer
, Qnil
);
4386 coding
.dst_multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
4387 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4388 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4390 move_gap_both (PT
, PT_BYTE
);
4391 GAP_SIZE
+= inserted
;
4392 ZV_BYTE
-= inserted
;
4396 decode_coding_gap (&coding
, inserted
, inserted
);
4397 inserted
= coding
.produced_char
;
4398 coding_system
= CODING_ID_NAME (coding
.id
);
4400 else if (inserted
> 0)
4401 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4404 /* Call after-change hooks for the inserted text, aside from the case
4405 of normal visiting (not with REPLACE), which is done in a new buffer
4406 "before" the buffer is changed. */
4407 if (inserted
> 0 && total
> 0
4408 && (NILP (visit
) || !NILP (replace
)))
4410 signal_after_change (PT
, 0, inserted
);
4411 update_compositions (PT
, PT
, CHECK_BORDER
);
4414 /* Now INSERTED is measured in characters. */
4418 if (deferred_remove_unwind_protect
)
4419 /* If requested above, discard the unwind protect for closing the
4425 if (!EQ (BVAR (current_buffer
, undo_list
), Qt
) && !nochange
)
4426 bset_undo_list (current_buffer
, Qnil
);
4430 current_buffer
->modtime
= mtime
;
4431 current_buffer
->modtime_size
= st
.st_size
;
4432 bset_filename (current_buffer
, orig_filename
);
4435 SAVE_MODIFF
= MODIFF
;
4436 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
4437 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4438 #ifdef CLASH_DETECTION
4441 if (!NILP (BVAR (current_buffer
, file_truename
)))
4442 unlock_file (BVAR (current_buffer
, file_truename
));
4443 unlock_file (filename
);
4445 #endif /* CLASH_DETECTION */
4447 xsignal2 (Qfile_error
,
4448 build_string ("not a regular file"), orig_filename
);
4451 if (set_coding_system
)
4452 Vlast_coding_system_used
= coding_system
;
4454 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4456 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4458 if (! NILP (insval
))
4460 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4461 wrong_type_argument (intern ("inserted-chars"), insval
);
4462 inserted
= XFASTINT (insval
);
4466 /* Decode file format. */
4469 /* Don't run point motion or modification hooks when decoding. */
4470 ptrdiff_t count1
= SPECPDL_INDEX ();
4471 ptrdiff_t old_inserted
= inserted
;
4472 specbind (Qinhibit_point_motion_hooks
, Qt
);
4473 specbind (Qinhibit_modification_hooks
, Qt
);
4475 /* Save old undo list and don't record undo for decoding. */
4476 old_undo
= BVAR (current_buffer
, undo_list
);
4477 bset_undo_list (current_buffer
, Qt
);
4481 insval
= call3 (Qformat_decode
,
4482 Qnil
, make_number (inserted
), visit
);
4483 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4484 wrong_type_argument (intern ("inserted-chars"), insval
);
4485 inserted
= XFASTINT (insval
);
4489 /* If REPLACE is non-nil and we succeeded in not replacing the
4490 beginning or end of the buffer text with the file's contents,
4491 call format-decode with `point' positioned at the beginning
4492 of the buffer and `inserted' equaling the number of
4493 characters in the buffer. Otherwise, format-decode might
4494 fail to correctly analyze the beginning or end of the buffer.
4495 Hence we temporarily save `point' and `inserted' here and
4496 restore `point' iff format-decode did not insert or delete
4497 any text. Otherwise we leave `point' at point-min. */
4498 ptrdiff_t opoint
= PT
;
4499 ptrdiff_t opoint_byte
= PT_BYTE
;
4500 ptrdiff_t oinserted
= ZV
- BEGV
;
4501 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4503 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4504 insval
= call3 (Qformat_decode
,
4505 Qnil
, make_number (oinserted
), visit
);
4506 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4507 wrong_type_argument (intern ("inserted-chars"), insval
);
4508 if (ochars_modiff
== CHARS_MODIFF
)
4509 /* format_decode didn't modify buffer's characters => move
4510 point back to position before inserted text and leave
4511 value of inserted alone. */
4512 SET_PT_BOTH (opoint
, opoint_byte
);
4514 /* format_decode modified buffer's characters => consider
4515 entire buffer changed and leave point at point-min. */
4516 inserted
= XFASTINT (insval
);
4519 /* For consistency with format-decode call these now iff inserted > 0
4520 (martin 2007-06-28). */
4521 p
= Vafter_insert_file_functions
;
4526 insval
= call1 (XCAR (p
), make_number (inserted
));
4529 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4530 wrong_type_argument (intern ("inserted-chars"), insval
);
4531 inserted
= XFASTINT (insval
);
4536 /* For the rationale of this see the comment on
4537 format-decode above. */
4538 ptrdiff_t opoint
= PT
;
4539 ptrdiff_t opoint_byte
= PT_BYTE
;
4540 ptrdiff_t oinserted
= ZV
- BEGV
;
4541 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4543 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4544 insval
= call1 (XCAR (p
), make_number (oinserted
));
4547 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4548 wrong_type_argument (intern ("inserted-chars"), insval
);
4549 if (ochars_modiff
== CHARS_MODIFF
)
4550 /* after_insert_file_functions didn't modify
4551 buffer's characters => move point back to
4552 position before inserted text and leave value of
4554 SET_PT_BOTH (opoint
, opoint_byte
);
4556 /* after_insert_file_functions did modify buffer's
4557 characters => consider entire buffer changed and
4558 leave point at point-min. */
4559 inserted
= XFASTINT (insval
);
4569 bset_undo_list (current_buffer
, old_undo
);
4570 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4572 /* Adjust the last undo record for the size change during
4573 the format conversion. */
4574 Lisp_Object tem
= XCAR (old_undo
);
4575 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4576 && INTEGERP (XCDR (tem
))
4577 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4578 XSETCDR (tem
, make_number (PT
+ inserted
));
4582 /* If undo_list was Qt before, keep it that way.
4583 Otherwise start with an empty undo_list. */
4584 bset_undo_list (current_buffer
, EQ (old_undo
, Qt
) ? Qt
: Qnil
);
4586 unbind_to (count1
, Qnil
);
4590 && EMACS_NSECS (current_buffer
->modtime
) == NONEXISTENT_MODTIME_NSECS
)
4592 /* If visiting nonexistent file, return nil. */
4594 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4598 Fsignal (Qquit
, Qnil
);
4600 /* Retval needs to be dealt with in all cases consistently. */
4602 val
= list2 (orig_filename
, make_number (inserted
));
4604 RETURN_UNGCPRO (unbind_to (count
, val
));
4607 static Lisp_Object
build_annotations (Lisp_Object
, Lisp_Object
);
4610 build_annotations_unwind (Lisp_Object arg
)
4612 Vwrite_region_annotation_buffers
= arg
;
4616 /* Decide the coding-system to encode the data with. */
4619 choose_write_coding_system (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4620 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
,
4621 struct coding_system
*coding
)
4624 Lisp_Object eol_parent
= Qnil
;
4627 && NILP (Fstring_equal (BVAR (current_buffer
, filename
),
4628 BVAR (current_buffer
, auto_save_file_name
))))
4633 else if (!NILP (Vcoding_system_for_write
))
4635 val
= Vcoding_system_for_write
;
4636 if (coding_system_require_warning
4637 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4638 /* Confirm that VAL can surely encode the current region. */
4639 val
= call5 (Vselect_safe_coding_system_function
,
4640 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4645 /* If the variable `buffer-file-coding-system' is set locally,
4646 it means that the file was read with some kind of code
4647 conversion or the variable is explicitly set by users. We
4648 had better write it out with the same coding system even if
4649 `enable-multibyte-characters' is nil.
4651 If it is not set locally, we anyway have to convert EOL
4652 format if the default value of `buffer-file-coding-system'
4653 tells that it is not Unix-like (LF only) format. */
4654 bool using_default_coding
= 0;
4655 bool force_raw_text
= 0;
4657 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4659 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4662 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4668 /* Check file-coding-system-alist. */
4669 Lisp_Object args
[7], coding_systems
;
4671 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4672 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4674 coding_systems
= Ffind_operation_coding_system (7, args
);
4675 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4676 val
= XCDR (coding_systems
);
4681 /* If we still have not decided a coding system, use the
4682 default value of buffer-file-coding-system. */
4683 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4684 using_default_coding
= 1;
4687 if (! NILP (val
) && ! force_raw_text
)
4689 Lisp_Object spec
, attrs
;
4691 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4692 attrs
= AREF (spec
, 0);
4693 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4698 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4699 /* Confirm that VAL can surely encode the current region. */
4700 val
= call5 (Vselect_safe_coding_system_function
,
4701 start
, end
, val
, Qnil
, filename
);
4703 /* If the decided coding-system doesn't specify end-of-line
4704 format, we use that of
4705 `default-buffer-file-coding-system'. */
4706 if (! using_default_coding
4707 && ! NILP (BVAR (&buffer_defaults
, buffer_file_coding_system
)))
4708 val
= (coding_inherit_eol_type
4709 (val
, BVAR (&buffer_defaults
, buffer_file_coding_system
)));
4711 /* If we decide not to encode text, use `raw-text' or one of its
4714 val
= raw_text_coding_system (val
);
4717 val
= coding_inherit_eol_type (val
, eol_parent
);
4718 setup_coding_system (val
, coding
);
4720 if (!STRINGP (start
) && !NILP (BVAR (current_buffer
, selective_display
)))
4721 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4725 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4726 "r\nFWrite region to file: \ni\ni\ni\np",
4727 doc
: /* Write current region into specified file.
4728 When called from a program, requires three arguments:
4729 START, END and FILENAME. START and END are normally buffer positions
4730 specifying the part of the buffer to write.
4731 If START is nil, that means to use the entire buffer contents.
4732 If START is a string, then output that string to the file
4733 instead of any buffer contents; END is ignored.
4735 Optional fourth argument APPEND if non-nil means
4736 append to existing file contents (if any). If it is a number,
4737 seek to that offset in the file before writing.
4738 Optional fifth argument VISIT, if t or a string, means
4739 set the last-save-file-modtime of buffer to this file's modtime
4740 and mark buffer not modified.
4741 If VISIT is a string, it is a second file name;
4742 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4743 VISIT is also the file name to lock and unlock for clash detection.
4744 If VISIT is neither t nor nil nor a string,
4745 that means do not display the \"Wrote file\" message.
4746 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4747 use for locking and unlocking, overriding FILENAME and VISIT.
4748 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4749 for an existing file with the same name. If MUSTBENEW is `excl',
4750 that means to get an error if the file already exists; never overwrite.
4751 If MUSTBENEW is neither nil nor `excl', that means ask for
4752 confirmation before overwriting, but do go ahead and overwrite the file
4753 if the user confirms.
4755 This does code conversion according to the value of
4756 `coding-system-for-write', `buffer-file-coding-system', or
4757 `file-coding-system-alist', and sets the variable
4758 `last-coding-system-used' to the coding system actually used.
4760 This calls `write-region-annotate-functions' at the start, and
4761 `write-region-post-annotation-function' at the end. */)
4762 (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
, Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
, Lisp_Object mustbenew
)
4767 off_t offset
IF_LINT (= 0);
4773 ptrdiff_t count
= SPECPDL_INDEX ();
4775 Lisp_Object handler
;
4776 Lisp_Object visit_file
;
4777 Lisp_Object annotations
;
4778 Lisp_Object encoded_filename
;
4779 bool visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4780 bool quietly
= !NILP (visit
);
4781 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4782 struct buffer
*given_buffer
;
4783 struct coding_system coding
;
4785 if (current_buffer
->base_buffer
&& visiting
)
4786 error ("Cannot do file visiting in an indirect buffer");
4788 if (!NILP (start
) && !STRINGP (start
))
4789 validate_region (&start
, &end
);
4792 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4794 filename
= Fexpand_file_name (filename
, Qnil
);
4796 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4797 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4799 if (STRINGP (visit
))
4800 visit_file
= Fexpand_file_name (visit
, Qnil
);
4802 visit_file
= filename
;
4804 if (NILP (lockname
))
4805 lockname
= visit_file
;
4809 /* If the file name has special constructs in it,
4810 call the corresponding file handler. */
4811 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4812 /* If FILENAME has no handler, see if VISIT has one. */
4813 if (NILP (handler
) && STRINGP (visit
))
4814 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4816 if (!NILP (handler
))
4819 val
= call6 (handler
, Qwrite_region
, start
, end
,
4820 filename
, append
, visit
);
4824 SAVE_MODIFF
= MODIFF
;
4825 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4826 bset_filename (current_buffer
, visit_file
);
4832 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4834 /* Special kludge to simplify auto-saving. */
4837 /* Do it later, so write-region-annotate-function can work differently
4838 if we save "the buffer" vs "a region".
4839 This is useful in tar-mode. --Stef
4840 XSETFASTINT (start, BEG);
4841 XSETFASTINT (end, Z); */
4845 record_unwind_protect (build_annotations_unwind
,
4846 Vwrite_region_annotation_buffers
);
4847 Vwrite_region_annotation_buffers
= Fcons (Fcurrent_buffer (), Qnil
);
4848 count1
= SPECPDL_INDEX ();
4850 given_buffer
= current_buffer
;
4852 if (!STRINGP (start
))
4854 annotations
= build_annotations (start
, end
);
4856 if (current_buffer
!= given_buffer
)
4858 XSETFASTINT (start
, BEGV
);
4859 XSETFASTINT (end
, ZV
);
4865 XSETFASTINT (start
, BEGV
);
4866 XSETFASTINT (end
, ZV
);
4871 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4873 /* Decide the coding-system to encode the data with.
4874 We used to make this choice before calling build_annotations, but that
4875 leads to problems when a write-annotate-function takes care of
4876 unsavable chars (as was the case with X-Symbol). */
4877 Vlast_coding_system_used
4878 = choose_write_coding_system (start
, end
, filename
,
4879 append
, visit
, lockname
, &coding
);
4881 #ifdef CLASH_DETECTION
4883 lock_file (lockname
);
4884 #endif /* CLASH_DETECTION */
4886 encoded_filename
= ENCODE_FILE (filename
);
4887 fn
= SSDATA (encoded_filename
);
4888 open_flags
= O_WRONLY
| O_BINARY
| O_CREAT
;
4889 open_flags
|= EQ (mustbenew
, Qexcl
) ? O_EXCL
: !NILP (append
) ? 0 : O_TRUNC
;
4890 if (NUMBERP (append
))
4891 offset
= file_offset (append
);
4892 else if (!NILP (append
))
4893 open_flags
|= O_APPEND
;
4895 mode
= S_IREAD
| S_IWRITE
;
4897 mode
= auto_saving
? auto_save_mode_bits
: 0666;
4900 desc
= emacs_open (fn
, open_flags
, mode
);
4904 #ifdef CLASH_DETECTION
4906 if (!auto_saving
) unlock_file (lockname
);
4908 #endif /* CLASH_DETECTION */
4910 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4913 record_unwind_protect (close_file_unwind
, make_number (desc
));
4915 if (NUMBERP (append
))
4917 off_t ret
= lseek (desc
, offset
, SEEK_SET
);
4920 #ifdef CLASH_DETECTION
4922 if (!auto_saving
) unlock_file (lockname
);
4924 #endif /* CLASH_DETECTION */
4926 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4934 if (STRINGP (start
))
4935 ok
= a_write (desc
, start
, 0, SCHARS (start
), &annotations
, &coding
);
4936 else if (XINT (start
) != XINT (end
))
4937 ok
= a_write (desc
, Qnil
, XINT (start
), XINT (end
) - XINT (start
),
4938 &annotations
, &coding
);
4941 /* If file was empty, still need to write the annotations. */
4942 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4943 ok
= a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4947 if (ok
&& CODING_REQUIRE_FLUSHING (&coding
)
4948 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
))
4950 /* We have to flush out a data. */
4951 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4952 ok
= e_write (desc
, Qnil
, 1, 1, &coding
);
4959 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4960 Disk full in NFS may be reported here. */
4961 /* mib says that closing the file will try to write as fast as NFS can do
4962 it, and that means the fsync here is not crucial for autosave files. */
4963 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
4965 /* If fsync fails with EINTR, don't treat that as serious. Also
4966 ignore EINVAL which happens when fsync is not supported on this
4968 if (errno
!= EINTR
&& errno
!= EINVAL
)
4969 ok
= 0, save_errno
= errno
;
4973 modtime
= invalid_emacs_time ();
4976 if (fstat (desc
, &st
) == 0)
4977 modtime
= get_stat_mtime (&st
);
4979 ok
= 0, save_errno
= errno
;
4982 /* NFS can report a write failure now. */
4983 if (emacs_close (desc
) < 0)
4984 ok
= 0, save_errno
= errno
;
4986 /* Discard the unwind protect for close_file_unwind. */
4987 specpdl_ptr
= specpdl
+ count1
;
4989 /* Some file systems have a bug where st_mtime is not updated
4990 properly after a write. For example, CIFS might not see the
4991 st_mtime change until after the file is opened again.
4993 Attempt to detect this file system bug, and update MODTIME to the
4994 newer st_mtime if the bug appears to be present. This introduces
4995 a race condition, so to avoid most instances of the race condition
4996 on non-buggy file systems, skip this check if the most recently
4997 encountered non-buggy file system was the current file system.
4999 A race condition can occur if some other process modifies the
5000 file between the fstat above and the fstat below, but the race is
5001 unlikely and a similar race between the last write and the fstat
5002 above cannot possibly be closed anyway. */
5004 if (EMACS_TIME_VALID_P (modtime
)
5005 && ! (valid_timestamp_file_system
&& st
.st_dev
== timestamp_file_system
))
5007 int desc1
= emacs_open (fn
, O_WRONLY
| O_BINARY
, 0);
5011 if (fstat (desc1
, &st1
) == 0
5012 && st
.st_dev
== st1
.st_dev
&& st
.st_ino
== st1
.st_ino
)
5014 EMACS_TIME modtime1
= get_stat_mtime (&st1
);
5015 if (EMACS_TIME_EQ (modtime
, modtime1
)
5016 && st
.st_size
== st1
.st_size
)
5018 timestamp_file_system
= st
.st_dev
;
5019 valid_timestamp_file_system
= 1;
5023 st
.st_size
= st1
.st_size
;
5027 emacs_close (desc1
);
5031 /* Call write-region-post-annotation-function. */
5032 while (CONSP (Vwrite_region_annotation_buffers
))
5034 Lisp_Object buf
= XCAR (Vwrite_region_annotation_buffers
);
5035 if (!NILP (Fbuffer_live_p (buf
)))
5038 if (FUNCTIONP (Vwrite_region_post_annotation_function
))
5039 call0 (Vwrite_region_post_annotation_function
);
5041 Vwrite_region_annotation_buffers
5042 = XCDR (Vwrite_region_annotation_buffers
);
5045 unbind_to (count
, Qnil
);
5047 #ifdef CLASH_DETECTION
5049 unlock_file (lockname
);
5050 #endif /* CLASH_DETECTION */
5052 /* Do this before reporting IO error
5053 to avoid a "file has changed on disk" warning on
5054 next attempt to save. */
5055 if (EMACS_TIME_VALID_P (modtime
))
5057 current_buffer
->modtime
= modtime
;
5058 current_buffer
->modtime_size
= st
.st_size
;
5062 error ("IO error writing %s: %s", SDATA (filename
),
5063 emacs_strerror (save_errno
));
5067 SAVE_MODIFF
= MODIFF
;
5068 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5069 bset_filename (current_buffer
, visit_file
);
5070 update_mode_lines
++;
5075 && ! NILP (Fstring_equal (BVAR (current_buffer
, filename
),
5076 BVAR (current_buffer
, auto_save_file_name
))))
5077 SAVE_MODIFF
= MODIFF
;
5083 message_with_string ((NUMBERP (append
)
5093 Lisp_Object
merge (Lisp_Object
, Lisp_Object
, Lisp_Object
);
5095 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5096 doc
: /* Return t if (car A) is numerically less than (car B). */)
5097 (Lisp_Object a
, Lisp_Object b
)
5099 return Flss (Fcar (a
), Fcar (b
));
5102 /* Build the complete list of annotations appropriate for writing out
5103 the text between START and END, by calling all the functions in
5104 write-region-annotate-functions and merging the lists they return.
5105 If one of these functions switches to a different buffer, we assume
5106 that buffer contains altered text. Therefore, the caller must
5107 make sure to restore the current buffer in all cases,
5108 as save-excursion would do. */
5111 build_annotations (Lisp_Object start
, Lisp_Object end
)
5113 Lisp_Object annotations
;
5115 struct gcpro gcpro1
, gcpro2
;
5116 Lisp_Object original_buffer
;
5118 bool used_global
= 0;
5120 XSETBUFFER (original_buffer
, current_buffer
);
5123 p
= Vwrite_region_annotate_functions
;
5124 GCPRO2 (annotations
, p
);
5127 struct buffer
*given_buffer
= current_buffer
;
5128 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5129 { /* Use the global value of the hook. */
5132 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5134 p
= Fappend (2, arg
);
5137 Vwrite_region_annotations_so_far
= annotations
;
5138 res
= call2 (XCAR (p
), start
, end
);
5139 /* If the function makes a different buffer current,
5140 assume that means this buffer contains altered text to be output.
5141 Reset START and END from the buffer bounds
5142 and discard all previous annotations because they should have
5143 been dealt with by this function. */
5144 if (current_buffer
!= given_buffer
)
5146 Vwrite_region_annotation_buffers
5147 = Fcons (Fcurrent_buffer (),
5148 Vwrite_region_annotation_buffers
);
5149 XSETFASTINT (start
, BEGV
);
5150 XSETFASTINT (end
, ZV
);
5153 Flength (res
); /* Check basic validity of return value */
5154 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5158 /* Now do the same for annotation functions implied by the file-format */
5159 if (auto_saving
&& (!EQ (BVAR (current_buffer
, auto_save_file_format
), Qt
)))
5160 p
= BVAR (current_buffer
, auto_save_file_format
);
5162 p
= BVAR (current_buffer
, file_format
);
5163 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5165 struct buffer
*given_buffer
= current_buffer
;
5167 Vwrite_region_annotations_so_far
= annotations
;
5169 /* Value is either a list of annotations or nil if the function
5170 has written annotations to a temporary buffer, which is now
5172 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5173 original_buffer
, make_number (i
));
5174 if (current_buffer
!= given_buffer
)
5176 XSETFASTINT (start
, BEGV
);
5177 XSETFASTINT (end
, ZV
);
5182 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5190 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5191 If STRING is nil, POS is the character position in the current buffer.
5192 Intersperse with them the annotations from *ANNOT
5193 which fall within the range of POS to POS + NCHARS,
5194 each at its appropriate position.
5196 We modify *ANNOT by discarding elements as we use them up.
5198 Return true if successful. */
5201 a_write (int desc
, Lisp_Object string
, ptrdiff_t pos
,
5202 ptrdiff_t nchars
, Lisp_Object
*annot
,
5203 struct coding_system
*coding
)
5207 ptrdiff_t lastpos
= pos
+ nchars
;
5209 while (NILP (*annot
) || CONSP (*annot
))
5211 tem
= Fcar_safe (Fcar (*annot
));
5214 nextpos
= XFASTINT (tem
);
5216 /* If there are no more annotations in this range,
5217 output the rest of the range all at once. */
5218 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5219 return e_write (desc
, string
, pos
, lastpos
, coding
);
5221 /* Output buffer text up to the next annotation's position. */
5224 if (!e_write (desc
, string
, pos
, nextpos
, coding
))
5228 /* Output the annotation. */
5229 tem
= Fcdr (Fcar (*annot
));
5232 if (!e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5235 *annot
= Fcdr (*annot
);
5241 /* Write text in the range START and END into descriptor DESC,
5242 encoding them with coding system CODING. If STRING is nil, START
5243 and END are character positions of the current buffer, else they
5244 are indexes to the string STRING. Return true if successful. */
5247 e_write (int desc
, Lisp_Object string
, ptrdiff_t start
, ptrdiff_t end
,
5248 struct coding_system
*coding
)
5250 if (STRINGP (string
))
5253 end
= SCHARS (string
);
5256 /* We used to have a code for handling selective display here. But,
5257 now it is handled within encode_coding. */
5261 if (STRINGP (string
))
5263 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5264 if (CODING_REQUIRE_ENCODING (coding
))
5266 encode_coding_object (coding
, string
,
5267 start
, string_char_to_byte (string
, start
),
5268 end
, string_char_to_byte (string
, end
), Qt
);
5272 coding
->dst_object
= string
;
5273 coding
->consumed_char
= SCHARS (string
);
5274 coding
->produced
= SBYTES (string
);
5279 ptrdiff_t start_byte
= CHAR_TO_BYTE (start
);
5280 ptrdiff_t end_byte
= CHAR_TO_BYTE (end
);
5282 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5283 if (CODING_REQUIRE_ENCODING (coding
))
5285 encode_coding_object (coding
, Fcurrent_buffer (),
5286 start
, start_byte
, end
, end_byte
, Qt
);
5290 coding
->dst_object
= Qnil
;
5291 coding
->dst_pos_byte
= start_byte
;
5292 if (start
>= GPT
|| end
<= GPT
)
5294 coding
->consumed_char
= end
- start
;
5295 coding
->produced
= end_byte
- start_byte
;
5299 coding
->consumed_char
= GPT
- start
;
5300 coding
->produced
= GPT_BYTE
- start_byte
;
5305 if (coding
->produced
> 0)
5308 -= emacs_write (desc
,
5309 STRINGP (coding
->dst_object
)
5310 ? SSDATA (coding
->dst_object
)
5311 : (char *) BYTE_POS_ADDR (coding
->dst_pos_byte
),
5314 if (coding
->produced
)
5317 start
+= coding
->consumed_char
;
5323 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5324 Sverify_visited_file_modtime
, 0, 1, 0,
5325 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5326 This means that the file has not been changed since it was visited or saved.
5327 If BUF is omitted or nil, it defaults to the current buffer.
5328 See Info node `(elisp)Modification Time' for more details. */)
5333 Lisp_Object handler
;
5334 Lisp_Object filename
;
5345 if (!STRINGP (BVAR (b
, filename
))) return Qt
;
5346 if (EMACS_NSECS (b
->modtime
) == UNKNOWN_MODTIME_NSECS
) return Qt
;
5348 /* If the file name has special constructs in it,
5349 call the corresponding file handler. */
5350 handler
= Ffind_file_name_handler (BVAR (b
, filename
),
5351 Qverify_visited_file_modtime
);
5352 if (!NILP (handler
))
5353 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5355 filename
= ENCODE_FILE (BVAR (b
, filename
));
5357 mtime
= (stat (SSDATA (filename
), &st
) == 0
5358 ? get_stat_mtime (&st
)
5359 : time_error_value (errno
));
5360 if (EMACS_TIME_EQ (mtime
, b
->modtime
)
5361 && (b
->modtime_size
< 0
5362 || st
.st_size
== b
->modtime_size
))
5367 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5368 Sclear_visited_file_modtime
, 0, 0, 0,
5369 doc
: /* Clear out records of last mod time of visited file.
5370 Next attempt to save will certainly not complain of a discrepancy. */)
5373 current_buffer
->modtime
= make_emacs_time (0, UNKNOWN_MODTIME_NSECS
);
5374 current_buffer
->modtime_size
= -1;
5378 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5379 Svisited_file_modtime
, 0, 0, 0,
5380 doc
: /* Return the current buffer's recorded visited file modification time.
5381 The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
5382 `file-attributes' returns. If the current buffer has no recorded file
5383 modification time, this function returns 0. If the visited file
5384 doesn't exist, HIGH will be -1.
5385 See Info node `(elisp)Modification Time' for more details. */)
5388 if (EMACS_NSECS (current_buffer
->modtime
) < 0)
5390 if (EMACS_NSECS (current_buffer
->modtime
) == NONEXISTENT_MODTIME_NSECS
)
5392 /* make_lisp_time won't work here if time_t is unsigned. */
5393 return list4 (make_number (-1), make_number (65535),
5394 make_number (0), make_number (0));
5396 return make_number (0);
5398 return make_lisp_time (current_buffer
->modtime
);
5401 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5402 Sset_visited_file_modtime
, 0, 1, 0,
5403 doc
: /* Update buffer's recorded modification time from the visited file's time.
5404 Useful if the buffer was not read from the file normally
5405 or if the file itself has been changed for some known benign reason.
5406 An argument specifies the modification time value to use
5407 \(instead of that of the visited file), in the form of a list
5408 \(HIGH LOW USEC PSEC) as returned by `current-time'. */)
5409 (Lisp_Object time_list
)
5411 if (!NILP (time_list
))
5413 current_buffer
->modtime
= lisp_time_argument (time_list
);
5414 current_buffer
->modtime_size
= -1;
5418 register Lisp_Object filename
;
5420 Lisp_Object handler
;
5422 filename
= Fexpand_file_name (BVAR (current_buffer
, filename
), Qnil
);
5424 /* If the file name has special constructs in it,
5425 call the corresponding file handler. */
5426 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5427 if (!NILP (handler
))
5428 /* The handler can find the file name the same way we did. */
5429 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5431 filename
= ENCODE_FILE (filename
);
5433 if (stat (SSDATA (filename
), &st
) >= 0)
5435 current_buffer
->modtime
= get_stat_mtime (&st
);
5436 current_buffer
->modtime_size
= st
.st_size
;
5444 auto_save_error (Lisp_Object error_val
)
5446 Lisp_Object args
[3], msg
;
5448 struct gcpro gcpro1
;
5450 auto_save_error_occurred
= 1;
5452 ring_bell (XFRAME (selected_frame
));
5454 args
[0] = build_string ("Auto-saving %s: %s");
5455 args
[1] = BVAR (current_buffer
, name
);
5456 args
[2] = Ferror_message_string (error_val
);
5457 msg
= Fformat (3, args
);
5460 for (i
= 0; i
< 3; ++i
)
5465 message3_nolog (msg
);
5466 Fsleep_for (make_number (1), Qnil
);
5479 auto_save_mode_bits
= 0666;
5481 /* Get visited file's mode to become the auto save file's mode. */
5482 if (! NILP (BVAR (current_buffer
, filename
)))
5484 if (stat (SSDATA (BVAR (current_buffer
, filename
)), &st
) >= 0)
5485 /* But make sure we can overwrite it later! */
5486 auto_save_mode_bits
= (st
.st_mode
| 0600) & 0777;
5487 else if (modes
= Ffile_modes (BVAR (current_buffer
, filename
)),
5489 /* Remote files don't cooperate with stat. */
5490 auto_save_mode_bits
= (XINT (modes
) | 0600) & 0777;
5494 Fwrite_region (Qnil
, Qnil
, BVAR (current_buffer
, auto_save_file_name
), Qnil
,
5495 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5500 do_auto_save_unwind (Lisp_Object arg
) /* used as unwind-protect function */
5503 FILE *stream
= XSAVE_POINTER (arg
, 0);
5515 do_auto_save_unwind_1 (Lisp_Object value
) /* used as unwind-protect function */
5518 minibuffer_auto_raise
= XINT (value
);
5523 do_auto_save_make_dir (Lisp_Object dir
)
5527 auto_saving_dir_umask
= 077;
5528 result
= call2 (Qmake_directory
, dir
, Qt
);
5529 auto_saving_dir_umask
= 0;
5534 do_auto_save_eh (Lisp_Object ignore
)
5536 auto_saving_dir_umask
= 0;
5540 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5541 doc
: /* Auto-save all buffers that need it.
5542 This is all buffers that have auto-saving enabled
5543 and are changed since last auto-saved.
5544 Auto-saving writes the buffer into a file
5545 so that your editing is not lost if the system crashes.
5546 This file is not the file you visited; that changes only when you save.
5547 Normally we run the normal hook `auto-save-hook' before saving.
5549 A non-nil NO-MESSAGE argument means do not print any message if successful.
5550 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5551 (Lisp_Object no_message
, Lisp_Object current_only
)
5553 struct buffer
*old
= current_buffer
, *b
;
5554 Lisp_Object tail
, buf
, hook
;
5555 bool auto_saved
= 0;
5556 int do_handled_files
;
5558 FILE *stream
= NULL
;
5559 ptrdiff_t count
= SPECPDL_INDEX ();
5560 bool orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5561 bool old_message_p
= 0;
5562 struct gcpro gcpro1
, gcpro2
;
5564 if (max_specpdl_size
< specpdl_size
+ 40)
5565 max_specpdl_size
= specpdl_size
+ 40;
5570 if (NILP (no_message
))
5572 old_message_p
= push_message ();
5573 record_unwind_protect (pop_message_unwind
, Qnil
);
5576 /* Ordinarily don't quit within this function,
5577 but don't make it impossible to quit (in case we get hung in I/O). */
5581 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5582 point to non-strings reached from Vbuffer_alist. */
5584 hook
= intern ("auto-save-hook");
5585 Frun_hooks (1, &hook
);
5587 if (STRINGP (Vauto_save_list_file_name
))
5589 Lisp_Object listfile
;
5591 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5593 /* Don't try to create the directory when shutting down Emacs,
5594 because creating the directory might signal an error, and
5595 that would leave Emacs in a strange state. */
5596 if (!NILP (Vrun_hooks
))
5600 GCPRO2 (dir
, listfile
);
5601 dir
= Ffile_name_directory (listfile
);
5602 if (NILP (Ffile_directory_p (dir
)))
5603 internal_condition_case_1 (do_auto_save_make_dir
,
5609 stream
= fopen (SSDATA (listfile
), "w");
5612 record_unwind_protect (do_auto_save_unwind
,
5613 make_save_pointer (stream
));
5614 record_unwind_protect (do_auto_save_unwind_1
,
5615 make_number (minibuffer_auto_raise
));
5616 minibuffer_auto_raise
= 0;
5618 auto_save_error_occurred
= 0;
5620 /* On first pass, save all files that don't have handlers.
5621 On second pass, save all files that do have handlers.
5623 If Emacs is crashing, the handlers may tweak what is causing
5624 Emacs to crash in the first place, and it would be a shame if
5625 Emacs failed to autosave perfectly ordinary files because it
5626 couldn't handle some ange-ftp'd file. */
5628 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5629 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5631 buf
= XCDR (XCAR (tail
));
5634 /* Record all the buffers that have auto save mode
5635 in the special file that lists them. For each of these buffers,
5636 Record visited name (if any) and auto save name. */
5637 if (STRINGP (BVAR (b
, auto_save_file_name
))
5638 && stream
!= NULL
&& do_handled_files
== 0)
5641 if (!NILP (BVAR (b
, filename
)))
5643 fwrite (SDATA (BVAR (b
, filename
)), 1,
5644 SBYTES (BVAR (b
, filename
)), stream
);
5646 putc ('\n', stream
);
5647 fwrite (SDATA (BVAR (b
, auto_save_file_name
)), 1,
5648 SBYTES (BVAR (b
, auto_save_file_name
)), stream
);
5649 putc ('\n', stream
);
5653 if (!NILP (current_only
)
5654 && b
!= current_buffer
)
5657 /* Don't auto-save indirect buffers.
5658 The base buffer takes care of it. */
5662 /* Check for auto save enabled
5663 and file changed since last auto save
5664 and file changed since last real save. */
5665 if (STRINGP (BVAR (b
, auto_save_file_name
))
5666 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5667 && BUF_AUTOSAVE_MODIFF (b
) < BUF_MODIFF (b
)
5668 /* -1 means we've turned off autosaving for a while--see below. */
5669 && XINT (BVAR (b
, save_length
)) >= 0
5670 && (do_handled_files
5671 || NILP (Ffind_file_name_handler (BVAR (b
, auto_save_file_name
),
5674 EMACS_TIME before_time
= current_emacs_time ();
5675 EMACS_TIME after_time
;
5677 /* If we had a failure, don't try again for 20 minutes. */
5678 if (b
->auto_save_failure_time
> 0
5679 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5682 set_buffer_internal (b
);
5683 if (NILP (Vauto_save_include_big_deletions
)
5684 && (XFASTINT (BVAR (b
, save_length
)) * 10
5685 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5686 /* A short file is likely to change a large fraction;
5687 spare the user annoying messages. */
5688 && XFASTINT (BVAR (b
, save_length
)) > 5000
5689 /* These messages are frequent and annoying for `*mail*'. */
5690 && !EQ (BVAR (b
, filename
), Qnil
)
5691 && NILP (no_message
))
5693 /* It has shrunk too much; turn off auto-saving here. */
5694 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5695 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5697 minibuffer_auto_raise
= 0;
5698 /* Turn off auto-saving until there's a real save,
5699 and prevent any more warnings. */
5700 XSETINT (BVAR (b
, save_length
), -1);
5701 Fsleep_for (make_number (1), Qnil
);
5704 if (!auto_saved
&& NILP (no_message
))
5705 message1 ("Auto-saving...");
5706 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5708 BUF_AUTOSAVE_MODIFF (b
) = BUF_MODIFF (b
);
5709 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5710 set_buffer_internal (old
);
5712 after_time
= current_emacs_time ();
5714 /* If auto-save took more than 60 seconds,
5715 assume it was an NFS failure that got a timeout. */
5716 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5717 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5721 /* Prevent another auto save till enough input events come in. */
5722 record_auto_save ();
5724 if (auto_saved
&& NILP (no_message
))
5728 /* If we are going to restore an old message,
5729 give time to read ours. */
5730 sit_for (make_number (1), 0, 0);
5733 else if (!auto_save_error_occurred
)
5734 /* Don't overwrite the error message if an error occurred.
5735 If we displayed a message and then restored a state
5736 with no message, leave a "done" message on the screen. */
5737 message1 ("Auto-saving...done");
5742 /* This restores the message-stack status. */
5743 unbind_to (count
, Qnil
);
5747 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5748 Sset_buffer_auto_saved
, 0, 0, 0,
5749 doc
: /* Mark current buffer as auto-saved with its current text.
5750 No auto-save file will be written until the buffer changes again. */)
5753 /* FIXME: This should not be called in indirect buffers, since
5754 they're not autosaved. */
5755 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
5756 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5757 current_buffer
->auto_save_failure_time
= 0;
5761 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5762 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5763 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5766 current_buffer
->auto_save_failure_time
= 0;
5770 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5772 doc
: /* Return t if current buffer has been auto-saved recently.
5773 More precisely, if it has been auto-saved since last read from or saved
5774 in the visited file. If the buffer has no visited file,
5775 then any auto-save counts as "recent". */)
5778 /* FIXME: maybe we should return nil for indirect buffers since
5779 they're never autosaved. */
5780 return (SAVE_MODIFF
< BUF_AUTOSAVE_MODIFF (current_buffer
) ? Qt
: Qnil
);
5783 /* Reading and completing file names */
5785 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5786 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5787 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5788 The return value is only relevant for a call to `read-file-name' that happens
5789 before any other event (mouse or keypress) is handled. */)
5792 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) \
5793 || defined (HAVE_NS)
5794 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5804 Fread_file_name (Lisp_Object prompt
, Lisp_Object dir
, Lisp_Object default_filename
, Lisp_Object mustmatch
, Lisp_Object initial
, Lisp_Object predicate
)
5806 struct gcpro gcpro1
;
5807 Lisp_Object args
[7];
5809 GCPRO1 (default_filename
);
5810 args
[0] = intern ("read-file-name");
5813 args
[3] = default_filename
;
5814 args
[4] = mustmatch
;
5816 args
[6] = predicate
;
5817 RETURN_UNGCPRO (Ffuncall (7, args
));
5824 valid_timestamp_file_system
= 0;
5828 syms_of_fileio (void)
5830 DEFSYM (Qoperations
, "operations");
5831 DEFSYM (Qexpand_file_name
, "expand-file-name");
5832 DEFSYM (Qsubstitute_in_file_name
, "substitute-in-file-name");
5833 DEFSYM (Qdirectory_file_name
, "directory-file-name");
5834 DEFSYM (Qfile_name_directory
, "file-name-directory");
5835 DEFSYM (Qfile_name_nondirectory
, "file-name-nondirectory");
5836 DEFSYM (Qunhandled_file_name_directory
, "unhandled-file-name-directory");
5837 DEFSYM (Qfile_name_as_directory
, "file-name-as-directory");
5838 DEFSYM (Qcopy_file
, "copy-file");
5839 DEFSYM (Qmake_directory_internal
, "make-directory-internal");
5840 DEFSYM (Qmake_directory
, "make-directory");
5841 DEFSYM (Qdelete_directory_internal
, "delete-directory-internal");
5842 DEFSYM (Qdelete_file
, "delete-file");
5843 DEFSYM (Qrename_file
, "rename-file");
5844 DEFSYM (Qadd_name_to_file
, "add-name-to-file");
5845 DEFSYM (Qmake_symbolic_link
, "make-symbolic-link");
5846 DEFSYM (Qfile_exists_p
, "file-exists-p");
5847 DEFSYM (Qfile_executable_p
, "file-executable-p");
5848 DEFSYM (Qfile_readable_p
, "file-readable-p");
5849 DEFSYM (Qfile_writable_p
, "file-writable-p");
5850 DEFSYM (Qfile_symlink_p
, "file-symlink-p");
5851 DEFSYM (Qaccess_file
, "access-file");
5852 DEFSYM (Qfile_directory_p
, "file-directory-p");
5853 DEFSYM (Qfile_regular_p
, "file-regular-p");
5854 DEFSYM (Qfile_accessible_directory_p
, "file-accessible-directory-p");
5855 DEFSYM (Qfile_modes
, "file-modes");
5856 DEFSYM (Qset_file_modes
, "set-file-modes");
5857 DEFSYM (Qset_file_times
, "set-file-times");
5858 DEFSYM (Qfile_selinux_context
, "file-selinux-context");
5859 DEFSYM (Qset_file_selinux_context
, "set-file-selinux-context");
5860 DEFSYM (Qfile_acl
, "file-acl");
5861 DEFSYM (Qset_file_acl
, "set-file-acl");
5862 DEFSYM (Qfile_newer_than_file_p
, "file-newer-than-file-p");
5863 DEFSYM (Qinsert_file_contents
, "insert-file-contents");
5864 DEFSYM (Qwrite_region
, "write-region");
5865 DEFSYM (Qverify_visited_file_modtime
, "verify-visited-file-modtime");
5866 DEFSYM (Qset_visited_file_modtime
, "set-visited-file-modtime");
5867 DEFSYM (Qauto_save_coding
, "auto-save-coding");
5869 DEFSYM (Qfile_name_history
, "file-name-history");
5870 Fset (Qfile_name_history
, Qnil
);
5872 DEFSYM (Qfile_error
, "file-error");
5873 DEFSYM (Qfile_already_exists
, "file-already-exists");
5874 DEFSYM (Qfile_date_error
, "file-date-error");
5875 DEFSYM (Qexcl
, "excl");
5877 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system
,
5878 doc
: /* Coding system for encoding file names.
5879 If it is nil, `default-file-name-coding-system' (which see) is used. */);
5880 Vfile_name_coding_system
= Qnil
;
5882 DEFVAR_LISP ("default-file-name-coding-system",
5883 Vdefault_file_name_coding_system
,
5884 doc
: /* Default coding system for encoding file names.
5885 This variable is used only when `file-name-coding-system' is nil.
5887 This variable is set/changed by the command `set-language-environment'.
5888 User should not set this variable manually,
5889 instead use `file-name-coding-system' to get a constant encoding
5890 of file names regardless of the current language environment. */);
5891 Vdefault_file_name_coding_system
= Qnil
;
5893 DEFSYM (Qformat_decode
, "format-decode");
5894 DEFSYM (Qformat_annotate_function
, "format-annotate-function");
5895 DEFSYM (Qafter_insert_file_set_coding
, "after-insert-file-set-coding");
5896 DEFSYM (Qcar_less_than_car
, "car-less-than-car");
5898 Fput (Qfile_error
, Qerror_conditions
,
5899 Fpurecopy (list2 (Qfile_error
, Qerror
)));
5900 Fput (Qfile_error
, Qerror_message
,
5901 build_pure_c_string ("File error"));
5903 Fput (Qfile_already_exists
, Qerror_conditions
,
5904 Fpurecopy (list3 (Qfile_already_exists
, Qfile_error
, Qerror
)));
5905 Fput (Qfile_already_exists
, Qerror_message
,
5906 build_pure_c_string ("File already exists"));
5908 Fput (Qfile_date_error
, Qerror_conditions
,
5909 Fpurecopy (list3 (Qfile_date_error
, Qfile_error
, Qerror
)));
5910 Fput (Qfile_date_error
, Qerror_message
,
5911 build_pure_c_string ("Cannot set file date"));
5913 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist
,
5914 doc
: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
5915 If a file name matches REGEXP, all I/O on that file is done by calling
5916 HANDLER. If a file name matches more than one handler, the handler
5917 whose match starts last in the file name gets precedence. The
5918 function `find-file-name-handler' checks this list for a handler for
5921 HANDLER should be a function. The first argument given to it is the
5922 name of the I/O primitive to be handled; the remaining arguments are
5923 the arguments that were passed to that primitive. For example, if you
5924 do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
5925 HANDLER is called like this:
5927 (funcall HANDLER 'file-exists-p FILENAME)
5929 Note that HANDLER must be able to handle all I/O primitives; if it has
5930 nothing special to do for a primitive, it should reinvoke the
5931 primitive to handle the operation \"the usual way\".
5932 See Info node `(elisp)Magic File Names' for more details. */);
5933 Vfile_name_handler_alist
= Qnil
;
5935 DEFVAR_LISP ("set-auto-coding-function",
5936 Vset_auto_coding_function
,
5937 doc
: /* If non-nil, a function to call to decide a coding system of file.
5938 Two arguments are passed to this function: the file name
5939 and the length of a file contents following the point.
5940 This function should return a coding system to decode the file contents.
5941 It should check the file name against `auto-coding-alist'.
5942 If no coding system is decided, it should check a coding system
5943 specified in the heading lines with the format:
5944 -*- ... coding: CODING-SYSTEM; ... -*-
5945 or local variable spec of the tailing lines with `coding:' tag. */);
5946 Vset_auto_coding_function
= Qnil
;
5948 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions
,
5949 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
5950 Each is passed one argument, the number of characters inserted,
5951 with point at the start of the inserted text. Each function
5952 should leave point the same, and return the new character count.
5953 If `insert-file-contents' is intercepted by a handler from
5954 `file-name-handler-alist', that handler is responsible for calling the
5955 functions in `after-insert-file-functions' if appropriate. */);
5956 Vafter_insert_file_functions
= Qnil
;
5958 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions
,
5959 doc
: /* A list of functions to be called at the start of `write-region'.
5960 Each is passed two arguments, START and END as for `write-region'.
5961 These are usually two numbers but not always; see the documentation
5962 for `write-region'. The function should return a list of pairs
5963 of the form (POSITION . STRING), consisting of strings to be effectively
5964 inserted at the specified positions of the file being written (1 means to
5965 insert before the first byte written). The POSITIONs must be sorted into
5968 If there are several annotation functions, the lists returned by these
5969 functions are merged destructively. As each annotation function runs,
5970 the variable `write-region-annotations-so-far' contains a list of all
5971 annotations returned by previous annotation functions.
5973 An annotation function can return with a different buffer current.
5974 Doing so removes the annotations returned by previous functions, and
5975 resets START and END to `point-min' and `point-max' of the new buffer.
5977 After `write-region' completes, Emacs calls the function stored in
5978 `write-region-post-annotation-function', once for each buffer that was
5979 current when building the annotations (i.e., at least once), with that
5980 buffer current. */);
5981 Vwrite_region_annotate_functions
= Qnil
;
5982 DEFSYM (Qwrite_region_annotate_functions
, "write-region-annotate-functions");
5984 DEFVAR_LISP ("write-region-post-annotation-function",
5985 Vwrite_region_post_annotation_function
,
5986 doc
: /* Function to call after `write-region' completes.
5987 The function is called with no arguments. If one or more of the
5988 annotation functions in `write-region-annotate-functions' changed the
5989 current buffer, the function stored in this variable is called for
5990 each of those additional buffers as well, in addition to the original
5991 buffer. The relevant buffer is current during each function call. */);
5992 Vwrite_region_post_annotation_function
= Qnil
;
5993 staticpro (&Vwrite_region_annotation_buffers
);
5995 DEFVAR_LISP ("write-region-annotations-so-far",
5996 Vwrite_region_annotations_so_far
,
5997 doc
: /* When an annotation function is called, this holds the previous annotations.
5998 These are the annotations made by other annotation functions
5999 that were already called. See also `write-region-annotate-functions'. */);
6000 Vwrite_region_annotations_so_far
= Qnil
;
6002 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers
,
6003 doc
: /* A list of file name handlers that temporarily should not be used.
6004 This applies only to the operation `inhibit-file-name-operation'. */);
6005 Vinhibit_file_name_handlers
= Qnil
;
6007 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation
,
6008 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6009 Vinhibit_file_name_operation
= Qnil
;
6011 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name
,
6012 doc
: /* File name in which we write a list of all auto save file names.
6013 This variable is initialized automatically from `auto-save-list-file-prefix'
6014 shortly after Emacs reads your init file, if you have not yet given it
6015 a non-nil value. */);
6016 Vauto_save_list_file_name
= Qnil
;
6018 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name
,
6019 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
6020 Normally auto-save files are written under other names. */);
6021 Vauto_save_visited_file_name
= Qnil
;
6023 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions
,
6024 doc
: /* If non-nil, auto-save even if a large part of the text is deleted.
6025 If nil, deleting a substantial portion of the text disables auto-save
6026 in the buffer; this is the default behavior, because the auto-save
6027 file is usually more useful if it contains the deleted text. */);
6028 Vauto_save_include_big_deletions
= Qnil
;
6031 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync
,
6032 doc
: /* Non-nil means don't call fsync in `write-region'.
6033 This variable affects calls to `write-region' as well as save commands.
6034 A non-nil value may result in data loss! */);
6035 write_region_inhibit_fsync
= 0;
6038 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash
,
6039 doc
: /* Specifies whether to use the system's trash can.
6040 When non-nil, certain file deletion commands use the function
6041 `move-file-to-trash' instead of deleting files outright.
6042 This includes interactive calls to `delete-file' and
6043 `delete-directory' and the Dired deletion commands. */);
6044 delete_by_moving_to_trash
= 0;
6045 Qdelete_by_moving_to_trash
= intern_c_string ("delete-by-moving-to-trash");
6047 DEFSYM (Qmove_file_to_trash
, "move-file-to-trash");
6048 DEFSYM (Qcopy_directory
, "copy-directory");
6049 DEFSYM (Qdelete_directory
, "delete-directory");
6051 defsubr (&Sfind_file_name_handler
);
6052 defsubr (&Sfile_name_directory
);
6053 defsubr (&Sfile_name_nondirectory
);
6054 defsubr (&Sunhandled_file_name_directory
);
6055 defsubr (&Sfile_name_as_directory
);
6056 defsubr (&Sdirectory_file_name
);
6057 defsubr (&Smake_temp_name
);
6058 defsubr (&Sexpand_file_name
);
6059 defsubr (&Ssubstitute_in_file_name
);
6060 defsubr (&Scopy_file
);
6061 defsubr (&Smake_directory_internal
);
6062 defsubr (&Sdelete_directory_internal
);
6063 defsubr (&Sdelete_file
);
6064 defsubr (&Srename_file
);
6065 defsubr (&Sadd_name_to_file
);
6066 defsubr (&Smake_symbolic_link
);
6067 defsubr (&Sfile_name_absolute_p
);
6068 defsubr (&Sfile_exists_p
);
6069 defsubr (&Sfile_executable_p
);
6070 defsubr (&Sfile_readable_p
);
6071 defsubr (&Sfile_writable_p
);
6072 defsubr (&Saccess_file
);
6073 defsubr (&Sfile_symlink_p
);
6074 defsubr (&Sfile_directory_p
);
6075 defsubr (&Sfile_accessible_directory_p
);
6076 defsubr (&Sfile_regular_p
);
6077 defsubr (&Sfile_modes
);
6078 defsubr (&Sset_file_modes
);
6079 defsubr (&Sset_file_times
);
6080 defsubr (&Sfile_selinux_context
);
6081 defsubr (&Sfile_acl
);
6082 defsubr (&Sset_file_acl
);
6083 defsubr (&Sset_file_selinux_context
);
6084 defsubr (&Sset_default_file_modes
);
6085 defsubr (&Sdefault_file_modes
);
6086 defsubr (&Sfile_newer_than_file_p
);
6087 defsubr (&Sinsert_file_contents
);
6088 defsubr (&Swrite_region
);
6089 defsubr (&Scar_less_than_car
);
6090 defsubr (&Sverify_visited_file_modtime
);
6091 defsubr (&Sclear_visited_file_modtime
);
6092 defsubr (&Svisited_file_modtime
);
6093 defsubr (&Sset_visited_file_modtime
);
6094 defsubr (&Sdo_auto_save
);
6095 defsubr (&Sset_buffer_auto_saved
);
6096 defsubr (&Sclear_buffer_auto_save_failure
);
6097 defsubr (&Srecent_auto_save_p
);
6099 defsubr (&Snext_read_file_uses_dialog_p
);
6102 defsubr (&Sunix_sync
);