1 /* File IO for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-2012 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>
35 #ifdef HAVE_LIBSELINUX
36 #include <selinux/selinux.h>
37 #include <selinux/context.h>
43 #include "intervals.h"
44 #include "character.h"
48 #include "blockinput.h"
50 #include "dispextern.h"
56 #endif /* not WINDOWSNT */
60 #include <sys/param.h>
65 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
66 redirector allows the six letters between 'Z' and 'a' as well. */
68 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
71 #define IS_DRIVE(x) c_isalpha (x)
73 /* Need to lower-case the drive letter, or else expanded
74 filenames will sometimes compare unequal, because
75 `expand-file-name' doesn't always down-case the drive letter. */
76 #define DRIVE_LETTER(x) c_tolower (x)
80 #include <stat-time.h>
88 /* True during writing of auto-save files. */
89 static bool auto_saving
;
91 /* Nonzero umask during creation of auto-save directories. */
92 static mode_t auto_saving_dir_umask
;
94 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
95 a new file with the same mode as the original. */
96 static mode_t auto_save_mode_bits
;
98 /* Set by auto_save_1 if an error occurred during the last auto-save. */
99 static bool auto_save_error_occurred
;
101 /* The symbol bound to coding-system-for-read when
102 insert-file-contents is called for recovering a file. This is not
103 an actual coding system name, but just an indicator to tell
104 insert-file-contents to use `emacs-mule' with a special flag for
105 auto saving and recovering a file. */
106 static Lisp_Object Qauto_save_coding
;
108 /* Property name of a file name handler,
109 which gives a list of operations it handles.. */
110 static Lisp_Object Qoperations
;
112 /* Lisp functions for translating file formats. */
113 static Lisp_Object Qformat_decode
, Qformat_annotate_function
;
115 /* Lisp function for setting buffer-file-coding-system and the
116 multibyteness of the current buffer after inserting a file. */
117 static Lisp_Object Qafter_insert_file_set_coding
;
119 static Lisp_Object Qwrite_region_annotate_functions
;
120 /* Each time an annotation function changes the buffer, the new buffer
122 static Lisp_Object Vwrite_region_annotation_buffers
;
127 static Lisp_Object Qdelete_by_moving_to_trash
;
129 /* Lisp function for moving files to trash. */
130 static Lisp_Object Qmove_file_to_trash
;
132 /* Lisp function for recursively copying directories. */
133 static Lisp_Object Qcopy_directory
;
135 /* Lisp function for recursively deleting directories. */
136 static Lisp_Object Qdelete_directory
;
141 Lisp_Object Qfile_error
;
142 static Lisp_Object Qfile_already_exists
, Qfile_date_error
;
143 static Lisp_Object Qexcl
;
144 Lisp_Object Qfile_name_history
;
146 static Lisp_Object Qcar_less_than_car
;
148 static bool a_write (int, Lisp_Object
, ptrdiff_t, ptrdiff_t,
149 Lisp_Object
*, struct coding_system
*);
150 static bool e_write (int, Lisp_Object
, ptrdiff_t, ptrdiff_t,
151 struct coding_system
*);
155 report_file_error (const char *string
, Lisp_Object data
)
157 Lisp_Object errstring
;
161 synchronize_system_messages_locale ();
162 str
= strerror (errorno
);
163 errstring
= code_convert_string_norecord (build_unibyte_string (str
),
164 Vlocale_coding_system
, 0);
170 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
173 /* System error messages are capitalized. Downcase the initial
174 unless it is followed by a slash. (The slash case caters to
175 error messages that begin with "I/O" or, in German, "E/A".) */
176 if (STRING_MULTIBYTE (errstring
)
177 && ! EQ (Faref (errstring
, make_number (1)), make_number ('/')))
181 str
= SSDATA (errstring
);
182 c
= STRING_CHAR ((unsigned char *) str
);
183 Faset (errstring
, make_number (0), make_number (downcase (c
)));
186 xsignal (Qfile_error
,
187 Fcons (build_string (string
), Fcons (errstring
, data
)));
192 close_file_unwind (Lisp_Object fd
)
194 emacs_close (XFASTINT (fd
));
198 /* Restore point, having saved it as a marker. */
201 restore_point_unwind (Lisp_Object location
)
203 Fgoto_char (location
);
204 Fset_marker (location
, Qnil
, Qnil
);
209 static Lisp_Object Qexpand_file_name
;
210 static Lisp_Object Qsubstitute_in_file_name
;
211 static Lisp_Object Qdirectory_file_name
;
212 static Lisp_Object Qfile_name_directory
;
213 static Lisp_Object Qfile_name_nondirectory
;
214 static Lisp_Object Qunhandled_file_name_directory
;
215 static Lisp_Object Qfile_name_as_directory
;
216 static Lisp_Object Qcopy_file
;
217 static Lisp_Object Qmake_directory_internal
;
218 static Lisp_Object Qmake_directory
;
219 static Lisp_Object Qdelete_directory_internal
;
220 Lisp_Object Qdelete_file
;
221 static Lisp_Object Qrename_file
;
222 static Lisp_Object Qadd_name_to_file
;
223 static Lisp_Object Qmake_symbolic_link
;
224 Lisp_Object Qfile_exists_p
;
225 static Lisp_Object Qfile_executable_p
;
226 static Lisp_Object Qfile_readable_p
;
227 static Lisp_Object Qfile_writable_p
;
228 static Lisp_Object Qfile_symlink_p
;
229 static Lisp_Object Qaccess_file
;
230 Lisp_Object Qfile_directory_p
;
231 static Lisp_Object Qfile_regular_p
;
232 static Lisp_Object Qfile_accessible_directory_p
;
233 static Lisp_Object Qfile_modes
;
234 static Lisp_Object Qset_file_modes
;
235 static Lisp_Object Qset_file_times
;
236 static Lisp_Object Qfile_selinux_context
;
237 static Lisp_Object Qset_file_selinux_context
;
238 static Lisp_Object Qfile_newer_than_file_p
;
239 Lisp_Object Qinsert_file_contents
;
240 Lisp_Object Qwrite_region
;
241 static Lisp_Object Qverify_visited_file_modtime
;
242 static Lisp_Object Qset_visited_file_modtime
;
244 DEFUN ("find-file-name-handler", Ffind_file_name_handler
,
245 Sfind_file_name_handler
, 2, 2, 0,
246 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
247 Otherwise, return nil.
248 A file name is handled if one of the regular expressions in
249 `file-name-handler-alist' matches it.
251 If OPERATION equals `inhibit-file-name-operation', then we ignore
252 any handlers that are members of `inhibit-file-name-handlers',
253 but we still do run any other handlers. This lets handlers
254 use the standard functions without calling themselves recursively. */)
255 (Lisp_Object filename
, Lisp_Object operation
)
257 /* This function must not munge the match data. */
258 Lisp_Object chain
, inhibited_handlers
, result
;
262 CHECK_STRING (filename
);
264 if (EQ (operation
, Vinhibit_file_name_operation
))
265 inhibited_handlers
= Vinhibit_file_name_handlers
;
267 inhibited_handlers
= Qnil
;
269 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
270 chain
= XCDR (chain
))
276 Lisp_Object string
= XCAR (elt
);
278 Lisp_Object handler
= XCDR (elt
);
279 Lisp_Object operations
= Qnil
;
281 if (SYMBOLP (handler
))
282 operations
= Fget (handler
, Qoperations
);
285 && (match_pos
= fast_string_match (string
, filename
)) > pos
286 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
290 handler
= XCDR (elt
);
291 tem
= Fmemq (handler
, inhibited_handlers
);
305 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
307 doc
: /* Return the directory component in file name FILENAME.
308 Return nil if FILENAME does not include a directory.
309 Otherwise return a directory name.
310 Given a Unix syntax file name, returns a string ending in slash. */)
311 (Lisp_Object filename
)
314 register const char *beg
;
318 register const char *p
;
321 CHECK_STRING (filename
);
323 /* If the file name has special constructs in it,
324 call the corresponding file handler. */
325 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
328 Lisp_Object handled_name
= call2 (handler
, Qfile_name_directory
,
330 return STRINGP (handled_name
) ? handled_name
: Qnil
;
334 beg
= alloca (SBYTES (filename
) + 1);
335 memcpy (beg
, SSDATA (filename
), SBYTES (filename
) + 1);
337 beg
= SSDATA (filename
);
339 p
= beg
+ SBYTES (filename
);
341 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
343 /* only recognize drive specifier at the beginning */
345 /* handle the "/:d:foo" and "/:foo" cases correctly */
346 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
347 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
354 /* Expansion of "c:" to drive and default directory. */
357 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
358 char *res
= alloca (MAXPATHLEN
+ 1);
361 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
363 memcpy (res
, beg
, 2);
368 if (getdefdir (c_toupper (*beg
) - 'A' + 1, r
))
370 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
373 p
= beg
+ strlen (beg
);
376 dostounix_filename (beg
);
379 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
382 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
383 Sfile_name_nondirectory
, 1, 1, 0,
384 doc
: /* Return file name FILENAME sans its directory.
385 For example, in a Unix-syntax file name,
386 this is everything after the last slash,
387 or the entire name if it contains no slash. */)
388 (Lisp_Object filename
)
390 register const char *beg
, *p
, *end
;
393 CHECK_STRING (filename
);
395 /* If the file name has special constructs in it,
396 call the corresponding file handler. */
397 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
400 Lisp_Object handled_name
= call2 (handler
, Qfile_name_nondirectory
,
402 if (STRINGP (handled_name
))
404 error ("Invalid handler in `file-name-handler-alist'");
407 beg
= SSDATA (filename
);
408 end
= p
= beg
+ SBYTES (filename
);
410 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
412 /* only recognize drive specifier at beginning */
414 /* handle the "/:d:foo" case correctly */
415 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
420 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
423 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
424 Sunhandled_file_name_directory
, 1, 1, 0,
425 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
426 A `directly usable' directory name is one that may be used without the
427 intervention of any file handler.
428 If FILENAME is a directly usable file itself, return
429 \(file-name-directory FILENAME).
430 If FILENAME refers to a file which is not accessible from a local process,
431 then this should return nil.
432 The `call-process' and `start-process' functions use this function to
433 get a current directory to run processes in. */)
434 (Lisp_Object filename
)
438 /* If the file name has special constructs in it,
439 call the corresponding file handler. */
440 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
443 Lisp_Object handled_name
= call2 (handler
, Qunhandled_file_name_directory
,
445 return STRINGP (handled_name
) ? handled_name
: Qnil
;
448 return Ffile_name_directory (filename
);
451 /* Convert from file name SRC of length SRCLEN to directory name
452 in DST. On UNIX, just make sure there is a terminating /.
453 Return the length of DST. */
456 file_name_as_directory (char *dst
, const char *src
, ptrdiff_t srclen
)
468 if (!IS_DIRECTORY_SEP (dst
[srclen
- 1]))
470 dst
[srclen
] = DIRECTORY_SEP
;
471 dst
[srclen
+ 1] = '\0';
475 dostounix_filename (dst
);
480 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
481 Sfile_name_as_directory
, 1, 1, 0,
482 doc
: /* Return a string representing the file name FILE interpreted as a directory.
483 This operation exists because a directory is also a file, but its name as
484 a directory is different from its name as a file.
485 The result can be used as the value of `default-directory'
486 or passed as second argument to `expand-file-name'.
487 For a Unix-syntax file name, just appends a slash. */)
498 /* If the file name has special constructs in it,
499 call the corresponding file handler. */
500 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
503 Lisp_Object handled_name
= call2 (handler
, Qfile_name_as_directory
,
505 if (STRINGP (handled_name
))
507 error ("Invalid handler in `file-name-handler-alist'");
510 buf
= alloca (SBYTES (file
) + 10);
511 length
= file_name_as_directory (buf
, SSDATA (file
), SBYTES (file
));
512 return make_specified_string (buf
, -1, length
, STRING_MULTIBYTE (file
));
515 /* Convert from directory name SRC of length SRCLEN to
516 file name in DST. On UNIX, just make sure there isn't
517 a terminating /. Return the length of DST. */
520 directory_file_name (char *dst
, char *src
, ptrdiff_t srclen
)
522 /* Process as Unix format: just remove any final slash.
523 But leave "/" unchanged; do not change it to "". */
526 && IS_DIRECTORY_SEP (dst
[srclen
- 1])
528 && !IS_ANY_SEP (dst
[srclen
- 2])
536 dostounix_filename (dst
);
541 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
543 doc
: /* Returns the file name of the directory named DIRECTORY.
544 This is the name of the file that holds the data for the directory DIRECTORY.
545 This operation exists because a directory is also a file, but its name as
546 a directory is different from its name as a file.
547 In Unix-syntax, this function just removes the final slash. */)
548 (Lisp_Object directory
)
554 CHECK_STRING (directory
);
556 if (NILP (directory
))
559 /* If the file name has special constructs in it,
560 call the corresponding file handler. */
561 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
564 Lisp_Object handled_name
= call2 (handler
, Qdirectory_file_name
,
566 if (STRINGP (handled_name
))
568 error ("Invalid handler in `file-name-handler-alist'");
571 buf
= alloca (SBYTES (directory
) + 20);
572 length
= directory_file_name (buf
, SSDATA (directory
), SBYTES (directory
));
573 return make_specified_string (buf
, -1, length
, STRING_MULTIBYTE (directory
));
576 static const char make_temp_name_tbl
[64] =
578 'A','B','C','D','E','F','G','H',
579 'I','J','K','L','M','N','O','P',
580 'Q','R','S','T','U','V','W','X',
581 'Y','Z','a','b','c','d','e','f',
582 'g','h','i','j','k','l','m','n',
583 'o','p','q','r','s','t','u','v',
584 'w','x','y','z','0','1','2','3',
585 '4','5','6','7','8','9','-','_'
588 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
590 /* Value is a temporary file name starting with PREFIX, a string.
592 The Emacs process number forms part of the result, so there is
593 no danger of generating a name being used by another process.
594 In addition, this function makes an attempt to choose a name
595 which has no existing file. To make this work, PREFIX should be
596 an absolute file name.
598 BASE64_P means add the pid as 3 characters in base64
599 encoding. In this case, 6 characters will be added to PREFIX to
600 form the file name. Otherwise, if Emacs is running on a system
601 with long file names, add the pid as a decimal number.
603 This function signals an error if no unique file name could be
607 make_temp_name (Lisp_Object prefix
, bool base64_p
)
613 char pidbuf
[INT_BUFSIZE_BOUND (printmax_t
)];
616 CHECK_STRING (prefix
);
618 /* VAL is created by adding 6 characters to PREFIX. The first
619 three are the PID of this process, in base 64, and the second
620 three are incremented if the file already exists. This ensures
621 262144 unique file names per PID per PREFIX. */
627 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
628 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
629 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
634 #ifdef HAVE_LONG_FILE_NAMES
635 pidlen
= sprintf (pidbuf
, "%"pMd
, pid
);
637 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
638 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
639 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
644 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
645 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
646 if (!STRING_MULTIBYTE (prefix
))
647 STRING_SET_UNIBYTE (val
);
649 memcpy (data
, SSDATA (prefix
), len
);
652 memcpy (p
, pidbuf
, pidlen
);
655 /* Here we try to minimize useless stat'ing when this function is
656 invoked many times successively with the same PREFIX. We achieve
657 this by initializing count to a random value, and incrementing it
660 We don't want make-temp-name to be called while dumping,
661 because then make_temp_name_count_initialized_p would get set
662 and then make_temp_name_count would not be set when Emacs starts. */
664 if (!make_temp_name_count_initialized_p
)
666 make_temp_name_count
= time (NULL
);
667 make_temp_name_count_initialized_p
= 1;
673 unsigned num
= make_temp_name_count
;
675 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
676 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
677 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
679 /* Poor man's congruential RN generator. Replace with
680 ++make_temp_name_count for debugging. */
681 make_temp_name_count
+= 25229;
682 make_temp_name_count
%= 225307;
684 if (stat (data
, &ignored
) < 0)
686 /* We want to return only if errno is ENOENT. */
690 /* The error here is dubious, but there is little else we
691 can do. The alternatives are to return nil, which is
692 as bad as (and in many cases worse than) throwing the
693 error, or to ignore the error, which will likely result
694 in looping through 225307 stat's, which is not only
695 dog-slow, but also useless since eventually nil would
696 have to be returned anyway. */
697 report_file_error ("Cannot create temporary name for prefix",
698 Fcons (prefix
, Qnil
));
705 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
706 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
707 The Emacs process number forms part of the result,
708 so there is no danger of generating a name being used by another process.
710 In addition, this function makes an attempt to choose a name
711 which has no existing file. To make this work,
712 PREFIX should be an absolute file name.
714 There is a race condition between calling `make-temp-name' and creating the
715 file which opens all kinds of security holes. For that reason, you should
716 probably use `make-temp-file' instead, except in three circumstances:
718 * If you are creating the file in the user's home directory.
719 * If you are creating a directory rather than an ordinary file.
720 * If you are taking special precautions as `make-temp-file' does. */)
723 return make_temp_name (prefix
, 0);
728 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
729 doc
: /* Convert filename NAME to absolute, and canonicalize it.
730 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
731 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
732 the current buffer's value of `default-directory' is used.
733 NAME should be a string that is a valid file name for the underlying
735 File name components that are `.' are removed, and
736 so are file name components followed by `..', along with the `..' itself;
737 note that these simplifications are done without checking the resulting
738 file names in the file system.
739 Multiple consecutive slashes are collapsed into a single slash,
740 except at the beginning of the file name when they are significant (e.g.,
741 UNC file names on MS-Windows.)
742 An initial `~/' expands to your home directory.
743 An initial `~USER/' expands to USER's home directory.
744 See also the function `substitute-in-file-name'.
746 For technical reasons, this function can return correct but
747 non-intuitive results for the root directory; for instance,
748 \(expand-file-name ".." "/") returns "/..". For this reason, use
749 \(directory-file-name (file-name-directory dirname)) to traverse a
750 filesystem tree, not (expand-file-name ".." dirname). */)
751 (Lisp_Object name
, Lisp_Object default_directory
)
753 /* These point to SDATA and need to be careful with string-relocation
754 during GC (via DECODE_FILE). */
757 /* This should only point to alloca'd data. */
764 bool collapse_newdir
= 1;
768 Lisp_Object handler
, result
, handled_name
;
774 /* If the file name has special constructs in it,
775 call the corresponding file handler. */
776 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
779 handled_name
= call3 (handler
, Qexpand_file_name
,
780 name
, default_directory
);
781 if (STRINGP (handled_name
))
783 error ("Invalid handler in `file-name-handler-alist'");
787 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
788 if (NILP (default_directory
))
789 default_directory
= BVAR (current_buffer
, directory
);
790 if (! STRINGP (default_directory
))
793 /* "/" is not considered a root directory on DOS_NT, so using "/"
794 here causes an infinite recursion in, e.g., the following:
796 (let (default-directory)
797 (expand-file-name "a"))
799 To avoid this, we set default_directory to the root of the
801 default_directory
= build_string (emacs_root_dir ());
803 default_directory
= build_string ("/");
807 if (!NILP (default_directory
))
809 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
812 handled_name
= call3 (handler
, Qexpand_file_name
,
813 name
, default_directory
);
814 if (STRINGP (handled_name
))
816 error ("Invalid handler in `file-name-handler-alist'");
821 char *o
= SSDATA (default_directory
);
823 /* Make sure DEFAULT_DIRECTORY is properly expanded.
824 It would be better to do this down below where we actually use
825 default_directory. Unfortunately, calling Fexpand_file_name recursively
826 could invoke GC, and the strings might be relocated. This would
827 be annoying because we have pointers into strings lying around
828 that would need adjusting, and people would add new pointers to
829 the code and forget to adjust them, resulting in intermittent bugs.
830 Putting this call here avoids all that crud.
832 The EQ test avoids infinite recursion. */
833 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
834 /* Save time in some common cases - as long as default_directory
835 is not relative, it can be canonicalized with name below (if it
836 is needed at all) without requiring it to be expanded now. */
838 /* Detect MSDOS file names with drive specifiers. */
839 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
840 && IS_DIRECTORY_SEP (o
[2]))
842 /* Detect Windows file names in UNC format. */
843 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
845 #else /* not DOS_NT */
846 /* Detect Unix absolute file names (/... alone is not absolute on
848 && ! (IS_DIRECTORY_SEP (o
[0]))
849 #endif /* not DOS_NT */
855 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
859 multibyte
= STRING_MULTIBYTE (name
);
860 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
863 default_directory
= string_to_multibyte (default_directory
);
866 name
= string_to_multibyte (name
);
871 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
872 nm
= alloca (SBYTES (name
) + 1);
873 memcpy (nm
, SSDATA (name
), SBYTES (name
) + 1);
876 /* Note if special escape prefix is present, but remove for now. */
877 if (nm
[0] == '/' && nm
[1] == ':')
883 /* Find and remove drive specifier if present; this makes nm absolute
884 even if the rest of the name appears to be relative. Only look for
885 drive specifier at the beginning. */
886 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
888 drive
= (unsigned char) nm
[0];
893 /* If we see "c://somedir", we want to strip the first slash after the
894 colon when stripping the drive letter. Otherwise, this expands to
896 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
899 /* Discard any previous drive specifier if nm is now in UNC format. */
900 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
904 #endif /* WINDOWSNT */
907 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
908 none are found, we can probably return right away. We will avoid
909 allocating a new string if name is already fully expanded. */
911 IS_DIRECTORY_SEP (nm
[0])
913 && drive
&& !is_escaped
916 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
920 /* If it turns out that the filename we want to return is just a
921 suffix of FILENAME, we don't need to go through and edit
922 things; we just need to construct a new string using data
923 starting at the middle of FILENAME. If we set LOSE, that
924 means we've discovered that we can't do that cool trick. */
930 /* Since we know the name is absolute, we can assume that each
931 element starts with a "/". */
933 /* "." and ".." are hairy. */
934 if (IS_DIRECTORY_SEP (p
[0])
936 && (IS_DIRECTORY_SEP (p
[2])
938 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
941 /* We want to replace multiple `/' in a row with a single
944 && IS_DIRECTORY_SEP (p
[0])
945 && IS_DIRECTORY_SEP (p
[1]))
952 /* Make sure directories are all separated with /, but
953 avoid allocation of a new string when not required. */
954 dostounix_filename (nm
);
956 if (IS_DIRECTORY_SEP (nm
[1]))
958 if (strcmp (nm
, SSDATA (name
)) != 0)
959 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
963 /* Drive must be set, so this is okay. */
964 if (strcmp (nm
- 2, SSDATA (name
)) != 0)
968 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
969 temp
[0] = DRIVE_LETTER (drive
);
970 name
= concat2 (build_string (temp
), name
);
973 #else /* not DOS_NT */
974 if (strcmp (nm
, SSDATA (name
)) == 0)
976 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
977 #endif /* not DOS_NT */
981 /* At this point, nm might or might not be an absolute file name. We
982 need to expand ~ or ~user if present, otherwise prefix nm with
983 default_directory if nm is not absolute, and finally collapse /./
984 and /foo/../ sequences.
986 We set newdir to be the appropriate prefix if one is needed:
987 - the relevant user directory if nm starts with ~ or ~user
988 - the specified drive's working dir (DOS/NT only) if nm does not
990 - the value of default_directory.
992 Note that these prefixes are not guaranteed to be absolute (except
993 for the working dir of a drive). Therefore, to ensure we always
994 return an absolute name, if the final prefix is not absolute we
995 append it to the current working directory. */
999 if (nm
[0] == '~') /* prefix ~ */
1001 if (IS_DIRECTORY_SEP (nm
[1])
1002 || nm
[1] == 0) /* ~ by itself */
1006 if (!(newdir
= egetenv ("HOME")))
1009 /* `egetenv' may return a unibyte string, which will bite us since
1010 we expect the directory to be multibyte. */
1011 tem
= build_string (newdir
);
1012 if (!STRING_MULTIBYTE (tem
))
1014 hdir
= DECODE_FILE (tem
);
1015 newdir
= SSDATA (hdir
);
1018 collapse_newdir
= 0;
1021 else /* ~user/filename */
1024 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)); p
++);
1025 o
= alloca (p
- nm
+ 1);
1026 memcpy (o
, nm
, p
- nm
);
1030 pw
= (struct passwd
*) getpwnam (o
+ 1);
1034 newdir
= pw
->pw_dir
;
1037 collapse_newdir
= 0;
1041 /* If we don't find a user of that name, leave the name
1042 unchanged; don't move nm forward to p. */
1047 /* On DOS and Windows, nm is absolute if a drive name was specified;
1048 use the drive's current directory as the prefix if needed. */
1049 if (!newdir
&& drive
)
1051 /* Get default directory if needed to make nm absolute. */
1053 if (!IS_DIRECTORY_SEP (nm
[0]))
1055 adir
= alloca (MAXPATHLEN
+ 1);
1056 if (!getdefdir (c_toupper (drive
) - 'A' + 1, adir
))
1061 /* Either nm starts with /, or drive isn't mounted. */
1063 adir
[0] = DRIVE_LETTER (drive
);
1072 /* Finally, if no prefix has been specified and nm is not absolute,
1073 then it must be expanded relative to default_directory. */
1077 /* /... alone is not absolute on DOS and Windows. */
1078 && !IS_DIRECTORY_SEP (nm
[0])
1081 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1085 newdir
= SSDATA (default_directory
);
1087 /* Note if special escape prefix is present, but remove for now. */
1088 if (newdir
[0] == '/' && newdir
[1] == ':')
1099 /* First ensure newdir is an absolute name. */
1101 /* Detect MSDOS file names with drive specifiers. */
1102 ! (IS_DRIVE (newdir
[0])
1103 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1105 /* Detect Windows file names in UNC format. */
1106 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1110 /* Effectively, let newdir be (expand-file-name newdir cwd).
1111 Because of the admonition against calling expand-file-name
1112 when we have pointers into lisp strings, we accomplish this
1113 indirectly by prepending newdir to nm if necessary, and using
1114 cwd (or the wd of newdir's drive) as the new newdir. */
1116 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1118 drive
= (unsigned char) newdir
[0];
1121 if (!IS_DIRECTORY_SEP (nm
[0]))
1123 ptrdiff_t newlen
= strlen (newdir
);
1124 char *tmp
= alloca (newlen
+ strlen (nm
) + 2);
1125 file_name_as_directory (tmp
, newdir
, newlen
);
1129 adir
= alloca (MAXPATHLEN
+ 1);
1132 if (!getdefdir (c_toupper (drive
) - 'A' + 1, adir
))
1140 /* Strip off drive name from prefix, if present. */
1141 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1147 /* Keep only a prefix from newdir if nm starts with slash
1148 (//server/share for UNC, nothing otherwise). */
1149 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1152 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1154 char *adir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1156 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1158 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1171 /* Get rid of any slash at the end of newdir, unless newdir is
1172 just / or // (an incomplete UNC name). */
1173 length
= strlen (newdir
);
1175 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1177 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1181 char *temp
= alloca (length
);
1182 memcpy (temp
, newdir
, length
- 1);
1183 temp
[length
- 1] = 0;
1194 /* Now concatenate the directory and name to new space in the stack frame. */
1195 tlen
+= strlen (nm
) + 1;
1197 /* Reserve space for drive specifier and escape prefix, since either
1198 or both may need to be inserted. (The Microsoft x86 compiler
1199 produces incorrect code if the following two lines are combined.) */
1200 target
= alloca (tlen
+ 4);
1202 #else /* not DOS_NT */
1203 target
= alloca (tlen
);
1204 #endif /* not DOS_NT */
1209 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1212 /* If newdir is effectively "C:/", then the drive letter will have
1213 been stripped and newdir will be "/". Concatenating with an
1214 absolute directory in nm produces "//", which will then be
1215 incorrectly treated as a network share. Ignore newdir in
1216 this case (keeping the drive letter). */
1217 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1218 && newdir
[1] == '\0'))
1220 strcpy (target
, newdir
);
1223 file_name_as_directory (target
, newdir
, length
);
1226 strcat (target
, nm
);
1228 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1236 if (!IS_DIRECTORY_SEP (*p
))
1240 else if (p
[1] == '.'
1241 && (IS_DIRECTORY_SEP (p
[2])
1244 /* If "/." is the entire filename, keep the "/". Otherwise,
1245 just delete the whole "/.". */
1246 if (o
== target
&& p
[2] == '\0')
1250 else if (p
[1] == '.' && p
[2] == '.'
1251 /* `/../' is the "superroot" on certain file systems.
1252 Turned off on DOS_NT systems because they have no
1253 "superroot" and because this causes us to produce
1254 file names like "d:/../foo" which fail file-related
1255 functions of the underlying OS. (To reproduce, try a
1256 long series of "../../" in default_directory, longer
1257 than the number of levels from the root.) */
1261 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1266 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1269 /* Don't go below server level in UNC filenames. */
1270 if (o
== target
+ 1 && IS_DIRECTORY_SEP (*o
)
1271 && IS_DIRECTORY_SEP (*target
))
1275 /* Keep initial / only if this is the whole name. */
1276 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1280 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1281 /* Collapse multiple `/' in a row. */
1290 /* At last, set drive name. */
1292 /* Except for network file name. */
1293 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1294 #endif /* WINDOWSNT */
1296 if (!drive
) emacs_abort ();
1298 target
[0] = DRIVE_LETTER (drive
);
1301 /* Reinsert the escape prefix if required. */
1308 dostounix_filename (target
);
1311 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1314 /* Again look to see if the file name has special constructs in it
1315 and perhaps call the corresponding file handler. This is needed
1316 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1317 the ".." component gives us "/user@host:/bar/../baz" which needs
1318 to be expanded again. */
1319 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1320 if (!NILP (handler
))
1322 handled_name
= call3 (handler
, Qexpand_file_name
,
1323 result
, default_directory
);
1324 if (STRINGP (handled_name
))
1325 return handled_name
;
1326 error ("Invalid handler in `file-name-handler-alist'");
1333 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1334 This is the old version of expand-file-name, before it was thoroughly
1335 rewritten for Emacs 10.31. We leave this version here commented-out,
1336 because the code is very complex and likely to have subtle bugs. If
1337 bugs _are_ found, it might be of interest to look at the old code and
1338 see what did it do in the relevant situation.
1340 Don't remove this code: it's true that it will be accessible
1341 from the repository, but a few years from deletion, people will
1342 forget it is there. */
1344 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1345 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1346 "Convert FILENAME to absolute, and canonicalize it.\n\
1347 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1348 \(does not start with slash); if DEFAULT is nil or missing,\n\
1349 the current buffer's value of default-directory is used.\n\
1350 Filenames containing `.' or `..' as components are simplified;\n\
1351 initial `~/' expands to your home directory.\n\
1352 See also the function `substitute-in-file-name'.")
1354 Lisp_Object name
, defalt
;
1358 register unsigned char *newdir
, *p
, *o
;
1360 unsigned char *target
;
1363 CHECK_STRING (name
);
1366 /* If nm is absolute, flush ...// and detect /./ and /../.
1367 If no /./ or /../ we can return right away. */
1374 if (p
[0] == '/' && p
[1] == '/'
1377 if (p
[0] == '/' && p
[1] == '~')
1378 nm
= p
+ 1, lose
= 1;
1379 if (p
[0] == '/' && p
[1] == '.'
1380 && (p
[2] == '/' || p
[2] == 0
1381 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1387 if (nm
== SDATA (name
))
1389 return build_string (nm
);
1393 /* Now determine directory to start with and put it in NEWDIR. */
1397 if (nm
[0] == '~') /* prefix ~ */
1398 if (nm
[1] == '/' || nm
[1] == 0)/* ~/filename */
1400 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1401 newdir
= (unsigned char *) "";
1404 else /* ~user/filename */
1406 /* Get past ~ to user. */
1407 unsigned char *user
= nm
+ 1;
1408 /* Find end of name. */
1409 unsigned char *ptr
= (unsigned char *) strchr (user
, '/');
1410 ptrdiff_t len
= ptr
? ptr
- user
: strlen (user
);
1411 /* Copy the user name into temp storage. */
1412 o
= alloca (len
+ 1);
1413 memcpy (o
, user
, len
);
1416 /* Look up the user name. */
1418 pw
= (struct passwd
*) getpwnam (o
+ 1);
1421 error ("\"%s\" isn't a registered user", o
+ 1);
1423 newdir
= (unsigned char *) pw
->pw_dir
;
1425 /* Discard the user name from NM. */
1429 if (nm
[0] != '/' && !newdir
)
1432 defalt
= current_buffer
->directory
;
1433 CHECK_STRING (defalt
);
1434 newdir
= SDATA (defalt
);
1437 /* Now concatenate the directory and name to new space in the stack frame. */
1439 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1440 target
= alloca (tlen
);
1445 if (nm
[0] == 0 || nm
[0] == '/')
1446 strcpy (target
, newdir
);
1448 file_name_as_directory (target
, newdir
);
1451 strcat (target
, nm
);
1453 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1464 else if (!strncmp (p
, "//", 2)
1470 else if (p
[0] == '/' && p
[1] == '.'
1471 && (p
[2] == '/' || p
[2] == 0))
1473 else if (!strncmp (p
, "/..", 3)
1474 /* `/../' is the "superroot" on certain file systems. */
1476 && (p
[3] == '/' || p
[3] == 0))
1478 while (o
!= target
&& *--o
!= '/')
1480 if (o
== target
&& *o
== '/')
1490 return make_string (target
, o
- target
);
1494 /* If /~ or // appears, discard everything through first slash. */
1496 file_name_absolute_p (const char *filename
)
1499 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
1501 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
1502 && IS_DIRECTORY_SEP (filename
[2]))
1508 search_embedded_absfilename (char *nm
, char *endp
)
1512 for (p
= nm
+ 1; p
< endp
; p
++)
1515 || IS_DIRECTORY_SEP (p
[-1]))
1516 && file_name_absolute_p (p
)
1517 #if defined (WINDOWSNT) || defined (CYGWIN)
1518 /* // at start of file name is meaningful in Apollo,
1519 WindowsNT and Cygwin systems. */
1520 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
1521 #endif /* not (WINDOWSNT || CYGWIN) */
1524 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)); s
++);
1525 if (p
[0] == '~' && s
> p
+ 1) /* We've got "/~something/". */
1527 char *o
= alloca (s
- p
+ 1);
1529 memcpy (o
, p
, s
- p
);
1532 /* If we have ~user and `user' exists, discard
1533 everything up to ~. But if `user' does not exist, leave
1534 ~user alone, it might be a literal file name. */
1536 pw
= getpwnam (o
+ 1);
1548 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1549 Ssubstitute_in_file_name
, 1, 1, 0,
1550 doc
: /* Substitute environment variables referred to in FILENAME.
1551 `$FOO' where FOO is an environment variable name means to substitute
1552 the value of that variable. The variable name should be terminated
1553 with a character not a letter, digit or underscore; otherwise, enclose
1554 the entire variable name in braces.
1556 If `/~' appears, all of FILENAME through that `/' is discarded.
1557 If `//' appears, everything up to and including the first of
1558 those `/' is discarded. */)
1559 (Lisp_Object filename
)
1561 char *nm
, *s
, *p
, *o
, *x
, *endp
;
1562 char *target
= NULL
;
1564 bool substituted
= 0;
1567 Lisp_Object handler
;
1569 CHECK_STRING (filename
);
1571 multibyte
= STRING_MULTIBYTE (filename
);
1573 /* If the file name has special constructs in it,
1574 call the corresponding file handler. */
1575 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1576 if (!NILP (handler
))
1578 Lisp_Object handled_name
= call2 (handler
, Qsubstitute_in_file_name
,
1580 if (STRINGP (handled_name
))
1581 return handled_name
;
1582 error ("Invalid handler in `file-name-handler-alist'");
1585 /* Always work on a copy of the string, in case GC happens during
1586 decode of environment variables, causing the original Lisp_String
1587 data to be relocated. */
1588 nm
= alloca (SBYTES (filename
) + 1);
1589 memcpy (nm
, SDATA (filename
), SBYTES (filename
) + 1);
1592 dostounix_filename (nm
);
1593 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
1595 endp
= nm
+ SBYTES (filename
);
1597 /* If /~ or // appears, discard everything through first slash. */
1598 p
= search_embedded_absfilename (nm
, endp
);
1600 /* Start over with the new string, so we check the file-name-handler
1601 again. Important with filenames like "/home/foo//:/hello///there"
1602 which would substitute to "/:/hello///there" rather than "/there". */
1603 return Fsubstitute_in_file_name
1604 (make_specified_string (p
, -1, endp
- p
, multibyte
));
1606 /* See if any variables are substituted into the string
1607 and find the total length of their values in `total'. */
1609 for (p
= nm
; p
!= endp
;)
1619 /* "$$" means a single "$". */
1628 while (p
!= endp
&& *p
!= '}') p
++;
1629 if (*p
!= '}') goto missingclose
;
1635 while (p
!= endp
&& (c_isalnum (*p
) || *p
== '_')) p
++;
1639 /* Copy out the variable name. */
1640 target
= alloca (s
- o
+ 1);
1641 memcpy (target
, o
, s
- o
);
1644 strupr (target
); /* $home == $HOME etc. */
1647 /* Get variable value. */
1648 o
= egetenv (target
);
1651 /* Don't try to guess a maximum length - UTF8 can use up to
1652 four bytes per character. This code is unlikely to run
1653 in a situation that requires performance, so decoding the
1654 env variables twice should be acceptable. Note that
1655 decoding may cause a garbage collect. */
1656 Lisp_Object orig
, decoded
;
1657 orig
= build_unibyte_string (o
);
1658 decoded
= DECODE_FILE (orig
);
1659 total
+= SBYTES (decoded
);
1669 /* If substitution required, recopy the string and do it. */
1670 /* Make space in stack frame for the new copy. */
1671 xnm
= alloca (SBYTES (filename
) + total
+ 1);
1674 /* Copy the rest of the name through, replacing $ constructs with values. */
1691 while (p
!= endp
&& *p
!= '}') p
++;
1692 if (*p
!= '}') goto missingclose
;
1698 while (p
!= endp
&& (c_isalnum (*p
) || *p
== '_')) p
++;
1702 /* Copy out the variable name. */
1703 target
= alloca (s
- o
+ 1);
1704 memcpy (target
, o
, s
- o
);
1707 strupr (target
); /* $home == $HOME etc. */
1710 /* Get variable value. */
1711 o
= egetenv (target
);
1715 strcpy (x
, target
); x
+= strlen (target
);
1719 Lisp_Object orig
, decoded
;
1720 ptrdiff_t orig_length
, decoded_length
;
1721 orig_length
= strlen (o
);
1722 orig
= make_unibyte_string (o
, orig_length
);
1723 decoded
= DECODE_FILE (orig
);
1724 decoded_length
= SBYTES (decoded
);
1725 memcpy (x
, SDATA (decoded
), decoded_length
);
1726 x
+= decoded_length
;
1728 /* If environment variable needed decoding, return value
1729 needs to be multibyte. */
1730 if (decoded_length
!= orig_length
1731 || memcmp (SDATA (decoded
), o
, orig_length
))
1738 /* If /~ or // appears, discard everything through first slash. */
1739 while ((p
= search_embedded_absfilename (xnm
, x
)))
1740 /* This time we do not start over because we've already expanded envvars
1741 and replaced $$ with $. Maybe we should start over as well, but we'd
1742 need to quote some $ to $$ first. */
1745 return make_specified_string (xnm
, -1, x
- xnm
, multibyte
);
1748 error ("Bad format environment-variable substitution");
1750 error ("Missing \"}\" in environment-variable substitution");
1752 error ("Substituting nonexistent environment variable \"%s\"", target
);
1758 /* A slightly faster and more convenient way to get
1759 (directory-file-name (expand-file-name FOO)). */
1762 expand_and_dir_to_file (Lisp_Object filename
, Lisp_Object defdir
)
1764 register Lisp_Object absname
;
1766 absname
= Fexpand_file_name (filename
, defdir
);
1768 /* Remove final slash, if any (unless this is the root dir).
1769 stat behaves differently depending! */
1770 if (SCHARS (absname
) > 1
1771 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
1772 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
) - 2)))
1773 /* We cannot take shortcuts; they might be wrong for magic file names. */
1774 absname
= Fdirectory_file_name (absname
);
1778 /* Signal an error if the file ABSNAME already exists.
1779 If INTERACTIVE, ask the user whether to proceed,
1780 and bypass the error if the user says to go ahead.
1781 QUERYSTRING is a name for the action that is being considered
1784 *STATPTR is used to store the stat information if the file exists.
1785 If the file does not exist, STATPTR->st_mode is set to 0.
1786 If STATPTR is null, we don't store into it.
1788 If QUICK, ask for y or n, not yes or no. */
1791 barf_or_query_if_file_exists (Lisp_Object absname
, const char *querystring
,
1792 bool interactive
, struct stat
*statptr
,
1795 Lisp_Object tem
, encoded_filename
;
1796 struct stat statbuf
;
1797 struct gcpro gcpro1
;
1799 encoded_filename
= ENCODE_FILE (absname
);
1801 /* `stat' is a good way to tell whether the file exists,
1802 regardless of what access permissions it has. */
1803 if (lstat (SSDATA (encoded_filename
), &statbuf
) >= 0)
1805 if (S_ISDIR (statbuf
.st_mode
))
1806 xsignal2 (Qfile_error
,
1807 build_string ("File is a directory"), absname
);
1810 xsignal2 (Qfile_already_exists
,
1811 build_string ("File already exists"), absname
);
1813 tem
= format2 ("File %s already exists; %s anyway? ",
1814 absname
, build_string (querystring
));
1816 tem
= call1 (intern ("y-or-n-p"), tem
);
1818 tem
= do_yes_or_no_p (tem
);
1821 xsignal2 (Qfile_already_exists
,
1822 build_string ("File already exists"), absname
);
1829 statptr
->st_mode
= 0;
1834 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
1835 "fCopy file: \nGCopy %s to file: \np\nP",
1836 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
1837 If NEWNAME names a directory, copy FILE there.
1839 This function always sets the file modes of the output file to match
1842 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1843 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1844 signal a `file-already-exists' error without overwriting. If
1845 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1846 about overwriting; this is what happens in interactive use with M-x.
1847 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1850 Fourth arg KEEP-TIME non-nil means give the output file the same
1851 last-modified time as the old one. (This works on only some systems.)
1853 A prefix arg makes KEEP-TIME non-nil.
1855 If PRESERVE-UID-GID is non-nil, we try to transfer the
1856 uid and gid of FILE to NEWNAME.
1858 If PRESERVE-SELINUX-CONTEXT is non-nil and SELinux is enabled
1859 on the system, we copy the SELinux context of FILE to NEWNAME. */)
1860 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
, Lisp_Object keep_time
, Lisp_Object preserve_uid_gid
, Lisp_Object preserve_selinux_context
)
1864 char buf
[16 * 1024];
1865 struct stat st
, out_st
;
1866 Lisp_Object handler
;
1867 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1868 ptrdiff_t count
= SPECPDL_INDEX ();
1869 bool input_file_statable_p
;
1870 Lisp_Object encoded_file
, encoded_newname
;
1872 security_context_t con
;
1876 encoded_file
= encoded_newname
= Qnil
;
1877 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
1878 CHECK_STRING (file
);
1879 CHECK_STRING (newname
);
1881 if (!NILP (Ffile_directory_p (newname
)))
1882 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
1884 newname
= Fexpand_file_name (newname
, Qnil
);
1886 file
= Fexpand_file_name (file
, Qnil
);
1888 /* If the input file name has special constructs in it,
1889 call the corresponding file handler. */
1890 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1891 /* Likewise for output file name. */
1893 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1894 if (!NILP (handler
))
1895 RETURN_UNGCPRO (call7 (handler
, Qcopy_file
, file
, newname
,
1896 ok_if_already_exists
, keep_time
, preserve_uid_gid
,
1897 preserve_selinux_context
));
1899 encoded_file
= ENCODE_FILE (file
);
1900 encoded_newname
= ENCODE_FILE (newname
);
1902 if (NILP (ok_if_already_exists
)
1903 || INTEGERP (ok_if_already_exists
))
1904 barf_or_query_if_file_exists (newname
, "copy to it",
1905 INTEGERP (ok_if_already_exists
), &out_st
, 0);
1906 else if (stat (SSDATA (encoded_newname
), &out_st
) < 0)
1910 if (!CopyFile (SDATA (encoded_file
),
1911 SDATA (encoded_newname
),
1913 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
1914 /* CopyFile retains the timestamp by default. */
1915 else if (NILP (keep_time
))
1921 filename
= SDATA (encoded_newname
);
1923 /* Ensure file is writable while its modified time is set. */
1924 attributes
= GetFileAttributes (filename
);
1925 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
1926 now
= current_emacs_time ();
1927 if (set_file_times (-1, filename
, now
, now
))
1929 /* Restore original attributes. */
1930 SetFileAttributes (filename
, attributes
);
1931 xsignal2 (Qfile_date_error
,
1932 build_string ("Cannot set file date"), newname
);
1934 /* Restore original attributes. */
1935 SetFileAttributes (filename
, attributes
);
1937 #else /* not WINDOWSNT */
1939 ifd
= emacs_open (SSDATA (encoded_file
), O_RDONLY
, 0);
1943 report_file_error ("Opening input file", Fcons (file
, Qnil
));
1945 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1947 /* We can only copy regular files and symbolic links. Other files are not
1949 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1952 if (!NILP (preserve_selinux_context
) && is_selinux_enabled ())
1954 conlength
= fgetfilecon (ifd
, &con
);
1955 if (conlength
== -1)
1956 report_file_error ("Doing fgetfilecon", Fcons (file
, Qnil
));
1960 if (out_st
.st_mode
!= 0
1961 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
1964 report_file_error ("Input and output files are the same",
1965 Fcons (file
, Fcons (newname
, Qnil
)));
1968 if (input_file_statable_p
)
1970 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1972 #if defined (EISDIR)
1973 /* Get a better looking error message. */
1976 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
1981 /* System's default file type was set to binary by _fmode in emacs.c. */
1982 ofd
= emacs_open (SDATA (encoded_newname
),
1983 O_WRONLY
| O_TRUNC
| O_CREAT
1984 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
1985 S_IREAD
| S_IWRITE
);
1986 #else /* not MSDOS */
1988 mode_t new_mask
= 0666;
1989 if (input_file_statable_p
)
1991 if (!NILP (preserve_uid_gid
))
1993 new_mask
&= st
.st_mode
;
1995 ofd
= emacs_open (SSDATA (encoded_newname
),
1996 (O_WRONLY
| O_TRUNC
| O_CREAT
1997 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0)),
2000 #endif /* not MSDOS */
2002 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2004 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2008 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2009 if (emacs_write (ofd
, buf
, n
) != n
)
2010 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2014 /* Preserve the original file modes, and if requested, also its
2016 if (input_file_statable_p
)
2018 mode_t mode_mask
= 07777;
2019 if (!NILP (preserve_uid_gid
))
2021 /* Attempt to change owner and group. If that doesn't work
2022 attempt to change just the group, as that is sometimes allowed.
2023 Adjust the mode mask to eliminate setuid or setgid bits
2024 that are inappropriate if the owner and group are wrong. */
2025 if (fchown (ofd
, st
.st_uid
, st
.st_gid
) != 0)
2027 mode_mask
&= ~06000;
2028 if (fchown (ofd
, -1, st
.st_gid
) == 0)
2032 if (fchmod (ofd
, st
.st_mode
& mode_mask
) != 0)
2033 report_file_error ("Doing chmod", Fcons (newname
, Qnil
));
2035 #endif /* not MSDOS */
2040 /* Set the modified context back to the file. */
2041 bool fail
= fsetfilecon (ofd
, con
) != 0;
2042 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2043 if (fail
&& errno
!= ENOTSUP
)
2044 report_file_error ("Doing fsetfilecon", Fcons (newname
, Qnil
));
2050 if (input_file_statable_p
)
2052 if (!NILP (keep_time
))
2054 EMACS_TIME atime
= get_stat_atime (&st
);
2055 EMACS_TIME mtime
= get_stat_mtime (&st
);
2056 if (set_file_times (ofd
, SSDATA (encoded_newname
), atime
, mtime
))
2057 xsignal2 (Qfile_date_error
,
2058 build_string ("Cannot set file date"), newname
);
2062 if (emacs_close (ofd
) < 0)
2063 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2068 if (input_file_statable_p
)
2070 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2071 and if it can't, it tells so. Otherwise, under MSDOS we usually
2072 get only the READ bit, which will make the copied file read-only,
2073 so it's better not to chmod at all. */
2074 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2075 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2078 #endif /* not WINDOWSNT */
2080 /* Discard the unwind protects. */
2081 specpdl_ptr
= specpdl
+ count
;
2087 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2088 Smake_directory_internal
, 1, 1, 0,
2089 doc
: /* Create a new directory named DIRECTORY. */)
2090 (Lisp_Object directory
)
2093 Lisp_Object handler
;
2094 Lisp_Object encoded_dir
;
2096 CHECK_STRING (directory
);
2097 directory
= Fexpand_file_name (directory
, Qnil
);
2099 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2100 if (!NILP (handler
))
2101 return call2 (handler
, Qmake_directory_internal
, directory
);
2103 encoded_dir
= ENCODE_FILE (directory
);
2105 dir
= SSDATA (encoded_dir
);
2108 if (mkdir (dir
) != 0)
2110 if (mkdir (dir
, 0777 & ~auto_saving_dir_umask
) != 0)
2112 report_file_error ("Creating directory", list1 (directory
));
2117 DEFUN ("delete-directory-internal", Fdelete_directory_internal
,
2118 Sdelete_directory_internal
, 1, 1, 0,
2119 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2120 (Lisp_Object directory
)
2123 Lisp_Object encoded_dir
;
2125 CHECK_STRING (directory
);
2126 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2127 encoded_dir
= ENCODE_FILE (directory
);
2128 dir
= SSDATA (encoded_dir
);
2130 if (rmdir (dir
) != 0)
2131 report_file_error ("Removing directory", list1 (directory
));
2136 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 2,
2137 "(list (read-file-name \
2138 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2139 \"Move file to trash: \" \"Delete file: \") \
2140 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2141 (null current-prefix-arg))",
2142 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2143 If file has multiple names, it continues to exist with the other names.
2144 TRASH non-nil means to trash the file instead of deleting, provided
2145 `delete-by-moving-to-trash' is non-nil.
2147 When called interactively, TRASH is t if no prefix argument is given.
2148 With a prefix argument, TRASH is nil. */)
2149 (Lisp_Object filename
, Lisp_Object trash
)
2151 Lisp_Object handler
;
2152 Lisp_Object encoded_file
;
2153 struct gcpro gcpro1
;
2156 if (!NILP (Ffile_directory_p (filename
))
2157 && NILP (Ffile_symlink_p (filename
)))
2158 xsignal2 (Qfile_error
,
2159 build_string ("Removing old name: is a directory"),
2162 filename
= Fexpand_file_name (filename
, Qnil
);
2164 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2165 if (!NILP (handler
))
2166 return call3 (handler
, Qdelete_file
, filename
, trash
);
2168 if (delete_by_moving_to_trash
&& !NILP (trash
))
2169 return call1 (Qmove_file_to_trash
, filename
);
2171 encoded_file
= ENCODE_FILE (filename
);
2173 if (0 > unlink (SSDATA (encoded_file
)))
2174 report_file_error ("Removing old name", list1 (filename
));
2179 internal_delete_file_1 (Lisp_Object ignore
)
2184 /* Delete file FILENAME.
2185 This ignores `delete-by-moving-to-trash'. */
2188 internal_delete_file (Lisp_Object filename
)
2190 internal_condition_case_2 (Fdelete_file
, filename
, Qnil
,
2191 Qt
, internal_delete_file_1
);
2194 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2195 "fRename file: \nGRename %s to file: \np",
2196 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2197 If file has names other than FILE, it continues to have those names.
2198 Signals a `file-already-exists' error if a file NEWNAME already exists
2199 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2200 A number as third arg means request confirmation if NEWNAME already exists.
2201 This is what happens in interactive use with M-x. */)
2202 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2204 Lisp_Object handler
;
2205 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2206 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2208 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2209 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2210 CHECK_STRING (file
);
2211 CHECK_STRING (newname
);
2212 file
= Fexpand_file_name (file
, Qnil
);
2214 if ((!NILP (Ffile_directory_p (newname
)))
2216 /* If the file names are identical but for the case,
2217 don't attempt to move directory to itself. */
2218 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2222 Lisp_Object fname
= NILP (Ffile_directory_p (file
))
2223 ? file
: Fdirectory_file_name (file
);
2224 newname
= Fexpand_file_name (Ffile_name_nondirectory (fname
), newname
);
2227 newname
= Fexpand_file_name (newname
, Qnil
);
2229 /* If the file name has special constructs in it,
2230 call the corresponding file handler. */
2231 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2233 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2234 if (!NILP (handler
))
2235 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2236 file
, newname
, ok_if_already_exists
));
2238 encoded_file
= ENCODE_FILE (file
);
2239 encoded_newname
= ENCODE_FILE (newname
);
2242 /* If the file names are identical but for the case, don't ask for
2243 confirmation: they simply want to change the letter-case of the
2245 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2247 if (NILP (ok_if_already_exists
)
2248 || INTEGERP (ok_if_already_exists
))
2249 barf_or_query_if_file_exists (newname
, "rename to it",
2250 INTEGERP (ok_if_already_exists
), 0, 0);
2251 if (0 > rename (SSDATA (encoded_file
), SSDATA (encoded_newname
)))
2256 symlink_target
= Ffile_symlink_p (file
);
2257 if (! NILP (symlink_target
))
2258 Fmake_symbolic_link (symlink_target
, newname
,
2259 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2260 else if (!NILP (Ffile_directory_p (file
)))
2261 call4 (Qcopy_directory
, file
, newname
, Qt
, Qnil
);
2263 /* We have already prompted if it was an integer, so don't
2264 have copy-file prompt again. */
2265 Fcopy_file (file
, newname
,
2266 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2269 count
= SPECPDL_INDEX ();
2270 specbind (Qdelete_by_moving_to_trash
, Qnil
);
2272 if (!NILP (Ffile_directory_p (file
)) && NILP (symlink_target
))
2273 call2 (Qdelete_directory
, file
, Qt
);
2275 Fdelete_file (file
, Qnil
);
2276 unbind_to (count
, Qnil
);
2279 report_file_error ("Renaming", list2 (file
, newname
));
2285 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2286 "fAdd name to file: \nGName to add to %s: \np",
2287 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2288 Signals a `file-already-exists' error if a file NEWNAME already exists
2289 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2290 A number as third arg means request confirmation if NEWNAME already exists.
2291 This is what happens in interactive use with M-x. */)
2292 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2294 Lisp_Object handler
;
2295 Lisp_Object encoded_file
, encoded_newname
;
2296 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2298 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2299 encoded_file
= encoded_newname
= Qnil
;
2300 CHECK_STRING (file
);
2301 CHECK_STRING (newname
);
2302 file
= Fexpand_file_name (file
, Qnil
);
2304 if (!NILP (Ffile_directory_p (newname
)))
2305 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2307 newname
= Fexpand_file_name (newname
, Qnil
);
2309 /* If the file name has special constructs in it,
2310 call the corresponding file handler. */
2311 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2312 if (!NILP (handler
))
2313 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2314 newname
, ok_if_already_exists
));
2316 /* If the new name has special constructs in it,
2317 call the corresponding file handler. */
2318 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2319 if (!NILP (handler
))
2320 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2321 newname
, ok_if_already_exists
));
2323 encoded_file
= ENCODE_FILE (file
);
2324 encoded_newname
= ENCODE_FILE (newname
);
2326 if (NILP (ok_if_already_exists
)
2327 || INTEGERP (ok_if_already_exists
))
2328 barf_or_query_if_file_exists (newname
, "make it a new name",
2329 INTEGERP (ok_if_already_exists
), 0, 0);
2331 unlink (SSDATA (newname
));
2332 if (0 > link (SSDATA (encoded_file
), SSDATA (encoded_newname
)))
2333 report_file_error ("Adding new name", list2 (file
, newname
));
2339 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2340 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2341 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2342 Both args must be strings.
2343 Signals a `file-already-exists' error if a file LINKNAME already exists
2344 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2345 A number as third arg means request confirmation if LINKNAME already exists.
2346 This happens for interactive use with M-x. */)
2347 (Lisp_Object filename
, Lisp_Object linkname
, Lisp_Object ok_if_already_exists
)
2349 Lisp_Object handler
;
2350 Lisp_Object encoded_filename
, encoded_linkname
;
2351 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2353 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2354 encoded_filename
= encoded_linkname
= Qnil
;
2355 CHECK_STRING (filename
);
2356 CHECK_STRING (linkname
);
2357 /* If the link target has a ~, we must expand it to get
2358 a truly valid file name. Otherwise, do not expand;
2359 we want to permit links to relative file names. */
2360 if (SREF (filename
, 0) == '~')
2361 filename
= Fexpand_file_name (filename
, Qnil
);
2363 if (!NILP (Ffile_directory_p (linkname
)))
2364 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2366 linkname
= Fexpand_file_name (linkname
, Qnil
);
2368 /* If the file name has special constructs in it,
2369 call the corresponding file handler. */
2370 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2371 if (!NILP (handler
))
2372 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2373 linkname
, ok_if_already_exists
));
2375 /* If the new link name has special constructs in it,
2376 call the corresponding file handler. */
2377 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2378 if (!NILP (handler
))
2379 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2380 linkname
, ok_if_already_exists
));
2382 encoded_filename
= ENCODE_FILE (filename
);
2383 encoded_linkname
= ENCODE_FILE (linkname
);
2385 if (NILP (ok_if_already_exists
)
2386 || INTEGERP (ok_if_already_exists
))
2387 barf_or_query_if_file_exists (linkname
, "make it a link",
2388 INTEGERP (ok_if_already_exists
), 0, 0);
2389 if (0 > symlink (SSDATA (encoded_filename
),
2390 SSDATA (encoded_linkname
)))
2392 /* If we didn't complain already, silently delete existing file. */
2393 if (errno
== EEXIST
)
2395 unlink (SSDATA (encoded_linkname
));
2396 if (0 <= symlink (SSDATA (encoded_filename
),
2397 SSDATA (encoded_linkname
)))
2403 if (errno
== ENOSYS
)
2406 xsignal1 (Qfile_error
,
2407 build_string ("Symbolic links are not supported"));
2410 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2417 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2419 doc
: /* Return t if file FILENAME specifies an absolute file name.
2420 On Unix, this is a name starting with a `/' or a `~'. */)
2421 (Lisp_Object filename
)
2423 CHECK_STRING (filename
);
2424 return file_name_absolute_p (SSDATA (filename
)) ? Qt
: Qnil
;
2427 /* Return true if file FILENAME exists and can be executed. */
2430 check_executable (char *filename
)
2434 if (stat (filename
, &st
) < 0)
2436 return ((st
.st_mode
& S_IEXEC
) != 0);
2437 #else /* not DOS_NT */
2438 #ifdef HAVE_EUIDACCESS
2439 return (euidaccess (filename
, 1) >= 0);
2441 /* Access isn't quite right because it uses the real uid
2442 and we really want to test with the effective uid.
2443 But Unix doesn't give us a right way to do it. */
2444 return (access (filename
, 1) >= 0);
2446 #endif /* not DOS_NT */
2449 /* Return true if file FILENAME exists and can be written. */
2452 check_writable (const char *filename
)
2456 if (stat (filename
, &st
) < 0)
2458 return (st
.st_mode
& S_IWRITE
|| S_ISDIR (st
.st_mode
));
2459 #else /* not MSDOS */
2460 #ifdef HAVE_EUIDACCESS
2461 bool res
= (euidaccess (filename
, 2) >= 0);
2463 /* euidaccess may have returned failure because Cygwin couldn't
2464 determine the file's UID or GID; if so, we return success. */
2468 if (stat (filename
, &st
) < 0)
2470 res
= (st
.st_uid
== -1 || st
.st_gid
== -1);
2474 #else /* not HAVE_EUIDACCESS */
2475 /* Access isn't quite right because it uses the real uid
2476 and we really want to test with the effective uid.
2477 But Unix doesn't give us a right way to do it.
2478 Opening with O_WRONLY could work for an ordinary file,
2479 but would lose for directories. */
2480 return (access (filename
, 2) >= 0);
2481 #endif /* not HAVE_EUIDACCESS */
2482 #endif /* not MSDOS */
2485 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2486 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
2487 See also `file-readable-p' and `file-attributes'.
2488 This returns nil for a symlink to a nonexistent file.
2489 Use `file-symlink-p' to test for such links. */)
2490 (Lisp_Object filename
)
2492 Lisp_Object absname
;
2493 Lisp_Object handler
;
2494 struct stat statbuf
;
2496 CHECK_STRING (filename
);
2497 absname
= Fexpand_file_name (filename
, Qnil
);
2499 /* If the file name has special constructs in it,
2500 call the corresponding file handler. */
2501 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2502 if (!NILP (handler
))
2503 return call2 (handler
, Qfile_exists_p
, absname
);
2505 absname
= ENCODE_FILE (absname
);
2507 return (stat (SSDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
2510 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2511 doc
: /* Return t if FILENAME can be executed by you.
2512 For a directory, this means you can access files in that directory. */)
2513 (Lisp_Object filename
)
2515 Lisp_Object absname
;
2516 Lisp_Object handler
;
2518 CHECK_STRING (filename
);
2519 absname
= Fexpand_file_name (filename
, Qnil
);
2521 /* If the file name has special constructs in it,
2522 call the corresponding file handler. */
2523 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2524 if (!NILP (handler
))
2525 return call2 (handler
, Qfile_executable_p
, absname
);
2527 absname
= ENCODE_FILE (absname
);
2529 return (check_executable (SSDATA (absname
)) ? Qt
: Qnil
);
2532 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2533 doc
: /* Return t if file FILENAME exists and you can read it.
2534 See also `file-exists-p' and `file-attributes'. */)
2535 (Lisp_Object filename
)
2537 Lisp_Object absname
;
2538 Lisp_Object handler
;
2541 struct stat statbuf
;
2543 CHECK_STRING (filename
);
2544 absname
= Fexpand_file_name (filename
, Qnil
);
2546 /* If the file name has special constructs in it,
2547 call the corresponding file handler. */
2548 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2549 if (!NILP (handler
))
2550 return call2 (handler
, Qfile_readable_p
, absname
);
2552 absname
= ENCODE_FILE (absname
);
2554 #if defined (DOS_NT) || defined (macintosh)
2555 /* Under MS-DOS, Windows, and Macintosh, open does not work for
2557 if (access (SDATA (absname
), 0) == 0)
2560 #else /* not DOS_NT and not macintosh */
2563 /* Opening a fifo without O_NONBLOCK can wait.
2564 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2565 except in the case of a fifo, on a system which handles it. */
2566 desc
= stat (SSDATA (absname
), &statbuf
);
2569 if (S_ISFIFO (statbuf
.st_mode
))
2570 flags
|= O_NONBLOCK
;
2572 desc
= emacs_open (SSDATA (absname
), flags
, 0);
2577 #endif /* not DOS_NT and not macintosh */
2580 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2582 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2583 doc
: /* Return t if file FILENAME can be written or created by you. */)
2584 (Lisp_Object filename
)
2586 Lisp_Object absname
, dir
, encoded
;
2587 Lisp_Object handler
;
2588 struct stat statbuf
;
2590 CHECK_STRING (filename
);
2591 absname
= Fexpand_file_name (filename
, Qnil
);
2593 /* If the file name has special constructs in it,
2594 call the corresponding file handler. */
2595 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2596 if (!NILP (handler
))
2597 return call2 (handler
, Qfile_writable_p
, absname
);
2599 encoded
= ENCODE_FILE (absname
);
2600 if (stat (SSDATA (encoded
), &statbuf
) >= 0)
2601 return (check_writable (SSDATA (encoded
))
2604 dir
= Ffile_name_directory (absname
);
2607 dir
= Fdirectory_file_name (dir
);
2610 dir
= ENCODE_FILE (dir
);
2612 /* The read-only attribute of the parent directory doesn't affect
2613 whether a file or directory can be created within it. Some day we
2614 should check ACLs though, which do affect this. */
2615 if (stat (SDATA (dir
), &statbuf
) < 0)
2617 return S_ISDIR (statbuf
.st_mode
) ? Qt
: Qnil
;
2619 return (check_writable (!NILP (dir
) ? SSDATA (dir
) : "")
2624 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2625 doc
: /* Access file FILENAME, and get an error if that does not work.
2626 The second argument STRING is used in the error message.
2627 If there is no error, returns nil. */)
2628 (Lisp_Object filename
, Lisp_Object string
)
2630 Lisp_Object handler
, encoded_filename
, absname
;
2633 CHECK_STRING (filename
);
2634 absname
= Fexpand_file_name (filename
, Qnil
);
2636 CHECK_STRING (string
);
2638 /* If the file name has special constructs in it,
2639 call the corresponding file handler. */
2640 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
2641 if (!NILP (handler
))
2642 return call3 (handler
, Qaccess_file
, absname
, string
);
2644 encoded_filename
= ENCODE_FILE (absname
);
2646 fd
= emacs_open (SSDATA (encoded_filename
), O_RDONLY
, 0);
2648 report_file_error (SSDATA (string
), Fcons (filename
, Qnil
));
2654 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2655 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
2656 The value is the link target, as a string.
2657 Otherwise it returns nil.
2659 This function returns t when given the name of a symlink that
2660 points to a nonexistent file. */)
2661 (Lisp_Object filename
)
2663 Lisp_Object handler
;
2666 char readlink_buf
[READLINK_BUFSIZE
];
2668 CHECK_STRING (filename
);
2669 filename
= Fexpand_file_name (filename
, Qnil
);
2671 /* If the file name has special constructs in it,
2672 call the corresponding file handler. */
2673 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2674 if (!NILP (handler
))
2675 return call2 (handler
, Qfile_symlink_p
, filename
);
2677 filename
= ENCODE_FILE (filename
);
2679 buf
= emacs_readlink (SSDATA (filename
), readlink_buf
);
2683 val
= build_string (buf
);
2684 if (buf
[0] == '/' && strchr (buf
, ':'))
2685 val
= concat2 (build_string ("/:"), val
);
2686 if (buf
!= readlink_buf
)
2688 val
= DECODE_FILE (val
);
2692 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2693 doc
: /* Return t if FILENAME names an existing directory.
2694 Symbolic links to directories count as directories.
2695 See `file-symlink-p' to distinguish symlinks. */)
2696 (Lisp_Object filename
)
2698 register Lisp_Object absname
;
2700 Lisp_Object handler
;
2702 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2704 /* If the file name has special constructs in it,
2705 call the corresponding file handler. */
2706 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2707 if (!NILP (handler
))
2708 return call2 (handler
, Qfile_directory_p
, absname
);
2710 absname
= ENCODE_FILE (absname
);
2712 if (stat (SSDATA (absname
), &st
) < 0)
2714 return S_ISDIR (st
.st_mode
) ? Qt
: Qnil
;
2717 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
,
2718 Sfile_accessible_directory_p
, 1, 1, 0,
2719 doc
: /* Return t if file FILENAME names a directory you can open.
2720 For the value to be t, FILENAME must specify the name of a directory as a file,
2721 and the directory must allow you to open files in it. In order to use a
2722 directory as a buffer's current directory, this predicate must return true.
2723 A directory name spec may be given instead; then the value is t
2724 if the directory so specified exists and really is a readable and
2725 searchable directory. */)
2726 (Lisp_Object filename
)
2728 Lisp_Object handler
;
2730 struct gcpro gcpro1
;
2732 /* If the file name has special constructs in it,
2733 call the corresponding file handler. */
2734 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2735 if (!NILP (handler
))
2736 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2739 tem
= (NILP (Ffile_directory_p (filename
))
2740 || NILP (Ffile_executable_p (filename
)));
2742 return tem
? Qnil
: Qt
;
2745 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2746 doc
: /* Return t if FILENAME names a regular file.
2747 This is the sort of file that holds an ordinary stream of data bytes.
2748 Symbolic links to regular files count as regular files.
2749 See `file-symlink-p' to distinguish symlinks. */)
2750 (Lisp_Object filename
)
2752 register Lisp_Object absname
;
2754 Lisp_Object handler
;
2756 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2758 /* If the file name has special constructs in it,
2759 call the corresponding file handler. */
2760 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2761 if (!NILP (handler
))
2762 return call2 (handler
, Qfile_regular_p
, absname
);
2764 absname
= ENCODE_FILE (absname
);
2769 Lisp_Object tem
= Vw32_get_true_file_attributes
;
2771 /* Tell stat to use expensive method to get accurate info. */
2772 Vw32_get_true_file_attributes
= Qt
;
2773 result
= stat (SDATA (absname
), &st
);
2774 Vw32_get_true_file_attributes
= tem
;
2778 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2781 if (stat (SSDATA (absname
), &st
) < 0)
2783 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2787 DEFUN ("file-selinux-context", Ffile_selinux_context
,
2788 Sfile_selinux_context
, 1, 1, 0,
2789 doc
: /* Return SELinux context of file named FILENAME.
2790 The return value is a list (USER ROLE TYPE RANGE), where the list
2791 elements are strings naming the user, role, type, and range of the
2792 file's SELinux security context.
2794 Return (nil nil nil nil) if the file is nonexistent or inaccessible,
2795 or if SELinux is disabled, or if Emacs lacks SELinux support. */)
2796 (Lisp_Object filename
)
2798 Lisp_Object absname
;
2799 Lisp_Object values
[4];
2800 Lisp_Object handler
;
2802 security_context_t con
;
2807 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2809 /* If the file name has special constructs in it,
2810 call the corresponding file handler. */
2811 handler
= Ffind_file_name_handler (absname
, Qfile_selinux_context
);
2812 if (!NILP (handler
))
2813 return call2 (handler
, Qfile_selinux_context
, absname
);
2815 absname
= ENCODE_FILE (absname
);
2822 if (is_selinux_enabled ())
2824 conlength
= lgetfilecon (SSDATA (absname
), &con
);
2827 context
= context_new (con
);
2828 if (context_user_get (context
))
2829 values
[0] = build_string (context_user_get (context
));
2830 if (context_role_get (context
))
2831 values
[1] = build_string (context_role_get (context
));
2832 if (context_type_get (context
))
2833 values
[2] = build_string (context_type_get (context
));
2834 if (context_range_get (context
))
2835 values
[3] = build_string (context_range_get (context
));
2836 context_free (context
);
2843 return Flist (sizeof (values
) / sizeof (values
[0]), values
);
2846 DEFUN ("set-file-selinux-context", Fset_file_selinux_context
,
2847 Sset_file_selinux_context
, 2, 2, 0,
2848 doc
: /* Set SELinux context of file named FILENAME to CONTEXT.
2849 CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
2850 elements are strings naming the components of a SELinux context.
2852 This function does nothing if SELinux is disabled, or if Emacs was not
2853 compiled with SELinux support. */)
2854 (Lisp_Object filename
, Lisp_Object context
)
2856 Lisp_Object absname
;
2857 Lisp_Object handler
;
2859 Lisp_Object encoded_absname
;
2860 Lisp_Object user
= CAR_SAFE (context
);
2861 Lisp_Object role
= CAR_SAFE (CDR_SAFE (context
));
2862 Lisp_Object type
= CAR_SAFE (CDR_SAFE (CDR_SAFE (context
)));
2863 Lisp_Object range
= CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context
))));
2864 security_context_t con
;
2867 context_t parsed_con
;
2870 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
2872 /* If the file name has special constructs in it,
2873 call the corresponding file handler. */
2874 handler
= Ffind_file_name_handler (absname
, Qset_file_selinux_context
);
2875 if (!NILP (handler
))
2876 return call3 (handler
, Qset_file_selinux_context
, absname
, context
);
2879 if (is_selinux_enabled ())
2881 /* Get current file context. */
2882 encoded_absname
= ENCODE_FILE (absname
);
2883 conlength
= lgetfilecon (SSDATA (encoded_absname
), &con
);
2886 parsed_con
= context_new (con
);
2887 /* Change the parts defined in the parameter.*/
2890 if (context_user_set (parsed_con
, SSDATA (user
)))
2891 error ("Doing context_user_set");
2895 if (context_role_set (parsed_con
, SSDATA (role
)))
2896 error ("Doing context_role_set");
2900 if (context_type_set (parsed_con
, SSDATA (type
)))
2901 error ("Doing context_type_set");
2903 if (STRINGP (range
))
2905 if (context_range_set (parsed_con
, SSDATA (range
)))
2906 error ("Doing context_range_set");
2909 /* Set the modified context back to the file. */
2910 fail
= (lsetfilecon (SSDATA (encoded_absname
),
2911 context_str (parsed_con
))
2913 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2914 if (fail
&& errno
!= ENOTSUP
)
2915 report_file_error ("Doing lsetfilecon", Fcons (absname
, Qnil
));
2917 context_free (parsed_con
);
2920 report_file_error ("Doing lgetfilecon", Fcons (absname
, Qnil
));
2930 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2931 doc
: /* Return mode bits of file named FILENAME, as an integer.
2932 Return nil, if file does not exist or is not accessible. */)
2933 (Lisp_Object filename
)
2935 Lisp_Object absname
;
2937 Lisp_Object handler
;
2939 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2941 /* If the file name has special constructs in it,
2942 call the corresponding file handler. */
2943 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2944 if (!NILP (handler
))
2945 return call2 (handler
, Qfile_modes
, absname
);
2947 absname
= ENCODE_FILE (absname
);
2949 if (stat (SSDATA (absname
), &st
) < 0)
2952 return make_number (st
.st_mode
& 07777);
2955 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
2956 "(let ((file (read-file-name \"File: \"))) \
2957 (list file (read-file-modes nil file)))",
2958 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
2959 Only the 12 low bits of MODE are used.
2961 Interactively, mode bits are read by `read-file-modes', which accepts
2962 symbolic notation, like the `chmod' command from GNU Coreutils. */)
2963 (Lisp_Object filename
, Lisp_Object mode
)
2965 Lisp_Object absname
, encoded_absname
;
2966 Lisp_Object handler
;
2968 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
2969 CHECK_NUMBER (mode
);
2971 /* If the file name has special constructs in it,
2972 call the corresponding file handler. */
2973 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2974 if (!NILP (handler
))
2975 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2977 encoded_absname
= ENCODE_FILE (absname
);
2979 if (chmod (SSDATA (encoded_absname
), XINT (mode
) & 07777) < 0)
2980 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2985 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2986 doc
: /* Set the file permission bits for newly created files.
2987 The argument MODE should be an integer; only the low 9 bits are used.
2988 This setting is inherited by subprocesses. */)
2991 CHECK_NUMBER (mode
);
2993 umask ((~ XINT (mode
)) & 0777);
2998 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2999 doc
: /* Return the default file protection for created files.
3000 The value is an integer. */)
3007 realmask
= umask (0);
3011 XSETINT (value
, (~ realmask
) & 0777);
3016 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3017 doc
: /* Set times of file FILENAME to TIMESTAMP.
3018 Set both access and modification times.
3019 Return t on success, else nil.
3020 Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
3022 (Lisp_Object filename
, Lisp_Object timestamp
)
3024 Lisp_Object absname
, encoded_absname
;
3025 Lisp_Object handler
;
3026 EMACS_TIME t
= lisp_time_argument (timestamp
);
3028 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3030 /* If the file name has special constructs in it,
3031 call the corresponding file handler. */
3032 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3033 if (!NILP (handler
))
3034 return call3 (handler
, Qset_file_times
, absname
, timestamp
);
3036 encoded_absname
= ENCODE_FILE (absname
);
3039 if (set_file_times (-1, SSDATA (encoded_absname
), t
, t
))
3044 /* Setting times on a directory always fails. */
3045 if (stat (SSDATA (encoded_absname
), &st
) == 0 && S_ISDIR (st
.st_mode
))
3048 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3057 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3058 doc
: /* Tell Unix to finish all pending disk updates. */)
3065 #endif /* HAVE_SYNC */
3067 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3068 doc
: /* Return t if file FILE1 is newer than file FILE2.
3069 If FILE1 does not exist, the answer is nil;
3070 otherwise, if FILE2 does not exist, the answer is t. */)
3071 (Lisp_Object file1
, Lisp_Object file2
)
3073 Lisp_Object absname1
, absname2
;
3074 struct stat st1
, st2
;
3075 Lisp_Object handler
;
3076 struct gcpro gcpro1
, gcpro2
;
3078 CHECK_STRING (file1
);
3079 CHECK_STRING (file2
);
3082 GCPRO2 (absname1
, file2
);
3083 absname1
= expand_and_dir_to_file (file1
, BVAR (current_buffer
, directory
));
3084 absname2
= expand_and_dir_to_file (file2
, BVAR (current_buffer
, directory
));
3087 /* If the file name has special constructs in it,
3088 call the corresponding file handler. */
3089 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3091 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3092 if (!NILP (handler
))
3093 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3095 GCPRO2 (absname1
, absname2
);
3096 absname1
= ENCODE_FILE (absname1
);
3097 absname2
= ENCODE_FILE (absname2
);
3100 if (stat (SSDATA (absname1
), &st1
) < 0)
3103 if (stat (SSDATA (absname2
), &st2
) < 0)
3106 return (EMACS_TIME_GT (get_stat_mtime (&st1
), get_stat_mtime (&st2
))
3110 #ifndef READ_BUF_SIZE
3111 #define READ_BUF_SIZE (64 << 10)
3113 /* Some buffer offsets are stored in 'int' variables. */
3114 verify (READ_BUF_SIZE
<= INT_MAX
);
3116 /* This function is called after Lisp functions to decide a coding
3117 system are called, or when they cause an error. Before they are
3118 called, the current buffer is set unibyte and it contains only a
3119 newly inserted text (thus the buffer was empty before the
3122 The functions may set markers, overlays, text properties, or even
3123 alter the buffer contents, change the current buffer.
3125 Here, we reset all those changes by:
3126 o set back the current buffer.
3127 o move all markers and overlays to BEG.
3128 o remove all text properties.
3129 o set back the buffer multibyteness. */
3132 decide_coding_unwind (Lisp_Object unwind_data
)
3134 Lisp_Object multibyte
, undo_list
, buffer
;
3136 multibyte
= XCAR (unwind_data
);
3137 unwind_data
= XCDR (unwind_data
);
3138 undo_list
= XCAR (unwind_data
);
3139 buffer
= XCDR (unwind_data
);
3141 set_buffer_internal (XBUFFER (buffer
));
3142 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3143 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3144 set_buffer_intervals (current_buffer
, NULL
);
3145 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3147 /* Now we are safe to change the buffer's multibyteness directly. */
3148 bset_enable_multibyte_characters (current_buffer
, multibyte
);
3149 bset_undo_list (current_buffer
, undo_list
);
3155 /* Used to pass values from insert-file-contents to read_non_regular. */
3157 static int non_regular_fd
;
3158 static ptrdiff_t non_regular_inserted
;
3159 static int non_regular_nbytes
;
3162 /* Read from a non-regular file.
3163 Read non_regular_nbytes bytes max from non_regular_fd.
3164 Non_regular_inserted specifies where to put the read bytes.
3165 Value is the number of bytes read. */
3168 read_non_regular (Lisp_Object ignore
)
3174 nbytes
= emacs_read (non_regular_fd
,
3175 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
3176 + non_regular_inserted
),
3177 non_regular_nbytes
);
3179 return make_number (nbytes
);
3183 /* Condition-case handler used when reading from non-regular files
3184 in insert-file-contents. */
3187 read_non_regular_quit (Lisp_Object ignore
)
3192 /* Reposition FD to OFFSET, based on WHENCE. This acts like lseek
3193 except that it also tests for OFFSET being out of lseek's range. */
3195 emacs_lseek (int fd
, EMACS_INT offset
, int whence
)
3197 /* Use "&" rather than "&&" to suppress a bogus GCC warning; see
3198 <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43772>. */
3199 if (! ((TYPE_MINIMUM (off_t
) <= offset
) & (offset
<= TYPE_MAXIMUM (off_t
))))
3204 return lseek (fd
, offset
, whence
);
3207 /* Return a special time value indicating the error number ERRNUM. */
3209 time_error_value (int errnum
)
3211 int ns
= (errnum
== ENOENT
|| errnum
== EACCES
|| errnum
== ENOTDIR
3212 ? NONEXISTENT_MODTIME_NSECS
3213 : UNKNOWN_MODTIME_NSECS
);
3214 return make_emacs_time (0, ns
);
3217 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3219 doc
: /* Insert contents of file FILENAME after point.
3220 Returns list of absolute file name and number of characters inserted.
3221 If second argument VISIT is non-nil, the buffer's visited filename and
3222 last save file modtime are set, and it is marked unmodified. If
3223 visiting and the file does not exist, visiting is completed before the
3226 The optional third and fourth arguments BEG and END specify what portion
3227 of the file to insert. These arguments count bytes in the file, not
3228 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3230 If optional fifth argument REPLACE is non-nil, replace the current
3231 buffer contents (in the accessible portion) with the file contents.
3232 This is better than simply deleting and inserting the whole thing
3233 because (1) it preserves some marker positions and (2) it puts less data
3234 in the undo list. When REPLACE is non-nil, the second return value is
3235 the number of characters that replace previous buffer contents.
3237 This function does code conversion according to the value of
3238 `coding-system-for-read' or `file-coding-system-alist', and sets the
3239 variable `last-coding-system-used' to the coding system actually used. */)
3240 (Lisp_Object filename
, Lisp_Object visit
, Lisp_Object beg
, Lisp_Object end
, Lisp_Object replace
)
3246 ptrdiff_t inserted
= 0;
3249 off_t beg_offset
, end_offset
;
3251 ptrdiff_t count
= SPECPDL_INDEX ();
3252 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3253 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3255 ptrdiff_t total
= 0;
3256 bool not_regular
= 0;
3258 char read_buf
[READ_BUF_SIZE
];
3259 struct coding_system coding
;
3260 char buffer
[1 << 14];
3261 bool replace_handled
= 0;
3262 bool set_coding_system
= 0;
3263 Lisp_Object coding_system
;
3265 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3266 bool we_locked_file
= 0;
3267 bool deferred_remove_unwind_protect
= 0;
3269 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3270 error ("Cannot do file visiting in an indirect buffer");
3272 if (!NILP (BVAR (current_buffer
, read_only
)))
3273 Fbarf_if_buffer_read_only ();
3277 orig_filename
= Qnil
;
3280 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3282 CHECK_STRING (filename
);
3283 filename
= Fexpand_file_name (filename
, Qnil
);
3285 /* The value Qnil means that the coding system is not yet
3287 coding_system
= Qnil
;
3289 /* If the file name has special constructs in it,
3290 call the corresponding file handler. */
3291 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3292 if (!NILP (handler
))
3294 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3295 visit
, beg
, end
, replace
);
3296 if (CONSP (val
) && CONSP (XCDR (val
))
3297 && RANGED_INTEGERP (0, XCAR (XCDR (val
)), ZV
- PT
))
3298 inserted
= XINT (XCAR (XCDR (val
)));
3302 orig_filename
= filename
;
3303 filename
= ENCODE_FILE (filename
);
3309 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3311 /* Tell stat to use expensive method to get accurate info. */
3312 Vw32_get_true_file_attributes
= Qt
;
3313 file_status
= stat (SSDATA (filename
), &st
);
3314 Vw32_get_true_file_attributes
= tem
;
3317 file_status
= stat (SSDATA (filename
), &st
);
3318 #endif /* WINDOWSNT */
3320 if (file_status
== 0)
3321 mtime
= get_stat_mtime (&st
);
3327 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3328 mtime
= time_error_value (save_errno
);
3331 if (!NILP (Vcoding_system_for_read
))
3332 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3336 /* This code will need to be changed in order to work on named
3337 pipes, and it's probably just not worth it. So we should at
3338 least signal an error. */
3339 if (!S_ISREG (st
.st_mode
))
3346 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3347 xsignal2 (Qfile_error
,
3348 build_string ("not a regular file"), orig_filename
);
3352 if ((fd
= emacs_open (SSDATA (filename
), O_RDONLY
, 0)) < 0)
3355 /* Replacement should preserve point as it preserves markers. */
3356 if (!NILP (replace
))
3357 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3359 record_unwind_protect (close_file_unwind
, make_number (fd
));
3364 if (!NILP (beg
) || !NILP (end
))
3365 error ("Attempt to visit less than an entire file");
3366 if (BEG
< Z
&& NILP (replace
))
3367 error ("Cannot do file visiting in a non-empty buffer");
3372 if (! (RANGED_INTEGERP (0, beg
, TYPE_MAXIMUM (off_t
))))
3373 wrong_type_argument (intern ("file-offset"), beg
);
3374 beg_offset
= XFASTINT (beg
);
3381 if (! (RANGED_INTEGERP (0, end
, TYPE_MAXIMUM (off_t
))))
3382 wrong_type_argument (intern ("file-offset"), end
);
3383 end_offset
= XFASTINT (end
);
3388 end_offset
= TYPE_MAXIMUM (off_t
);
3391 end_offset
= st
.st_size
;
3393 /* A negative size can happen on a platform that allows file
3394 sizes greater than the maximum off_t value. */
3398 /* The file size returned from stat may be zero, but data
3399 may be readable nonetheless, for example when this is a
3400 file in the /proc filesystem. */
3401 if (end_offset
== 0)
3402 end_offset
= READ_BUF_SIZE
;
3406 /* Check now whether the buffer will become too large,
3407 in the likely case where the file's length is not changing.
3408 This saves a lot of needless work before a buffer overflow. */
3411 /* The likely offset where we will stop reading. We could read
3412 more (or less), if the file grows (or shrinks) as we read it. */
3413 off_t likely_end
= min (end_offset
, st
.st_size
);
3415 if (beg_offset
< likely_end
)
3417 ptrdiff_t buf_bytes
=
3418 Z_BYTE
- (!NILP (replace
) ? ZV_BYTE
- BEGV_BYTE
: 0);
3419 ptrdiff_t buf_growth_max
= BUF_BYTES_MAX
- buf_bytes
;
3420 off_t likely_growth
= likely_end
- beg_offset
;
3421 if (buf_growth_max
< likely_growth
)
3426 /* Prevent redisplay optimizations. */
3427 current_buffer
->clip_changed
= 1;
3429 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3431 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3432 setup_coding_system (coding_system
, &coding
);
3433 /* Ensure we set Vlast_coding_system_used. */
3434 set_coding_system
= 1;
3438 /* Decide the coding system to use for reading the file now
3439 because we can't use an optimized method for handling
3440 `coding:' tag if the current buffer is not empty. */
3441 if (!NILP (Vcoding_system_for_read
))
3442 coding_system
= Vcoding_system_for_read
;
3445 /* Don't try looking inside a file for a coding system
3446 specification if it is not seekable. */
3447 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3449 /* Find a coding system specified in the heading two
3450 lines or in the tailing several lines of the file.
3451 We assume that the 1K-byte and 3K-byte for heading
3452 and tailing respectively are sufficient for this
3456 if (st
.st_size
<= (1024 * 4))
3457 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3460 nread
= emacs_read (fd
, read_buf
, 1024);
3463 if (lseek (fd
, st
.st_size
- (1024 * 3), SEEK_SET
) < 0)
3464 report_file_error ("Setting file position",
3465 Fcons (orig_filename
, Qnil
));
3466 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3471 error ("IO error reading %s: %s",
3472 SDATA (orig_filename
), emacs_strerror (errno
));
3475 struct buffer
*prev
= current_buffer
;
3476 Lisp_Object workbuf
;
3479 record_unwind_current_buffer ();
3481 workbuf
= Fget_buffer_create (build_string (" *code-converting-work*"));
3482 buf
= XBUFFER (workbuf
);
3484 delete_all_overlays (buf
);
3485 bset_directory (buf
, BVAR (current_buffer
, directory
));
3486 bset_read_only (buf
, Qnil
);
3487 bset_filename (buf
, Qnil
);
3488 bset_undo_list (buf
, Qt
);
3489 eassert (buf
->overlays_before
== NULL
);
3490 eassert (buf
->overlays_after
== NULL
);
3492 set_buffer_internal (buf
);
3494 bset_enable_multibyte_characters (buf
, Qnil
);
3496 insert_1_both ((char *) read_buf
, nread
, nread
, 0, 0, 0);
3497 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3498 coding_system
= call2 (Vset_auto_coding_function
,
3499 filename
, make_number (nread
));
3500 set_buffer_internal (prev
);
3502 /* Discard the unwind protect for recovering the
3506 /* Rewind the file for the actual read done later. */
3507 if (lseek (fd
, 0, SEEK_SET
) < 0)
3508 report_file_error ("Setting file position",
3509 Fcons (orig_filename
, Qnil
));
3513 if (NILP (coding_system
))
3515 /* If we have not yet decided a coding system, check
3516 file-coding-system-alist. */
3517 Lisp_Object args
[6];
3519 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3520 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3521 coding_system
= Ffind_operation_coding_system (6, args
);
3522 if (CONSP (coding_system
))
3523 coding_system
= XCAR (coding_system
);
3527 if (NILP (coding_system
))
3528 coding_system
= Qundecided
;
3530 CHECK_CODING_SYSTEM (coding_system
);
3532 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3533 /* We must suppress all character code conversion except for
3534 end-of-line conversion. */
3535 coding_system
= raw_text_coding_system (coding_system
);
3537 setup_coding_system (coding_system
, &coding
);
3538 /* Ensure we set Vlast_coding_system_used. */
3539 set_coding_system
= 1;
3542 /* If requested, replace the accessible part of the buffer
3543 with the file contents. Avoid replacing text at the
3544 beginning or end of the buffer that matches the file contents;
3545 that preserves markers pointing to the unchanged parts.
3547 Here we implement this feature in an optimized way
3548 for the case where code conversion is NOT needed.
3549 The following if-statement handles the case of conversion
3550 in a less optimal way.
3552 If the code conversion is "automatic" then we try using this
3553 method and hope for the best.
3554 But if we discover the need for conversion, we give up on this method
3555 and let the following if-statement handle the replace job. */
3558 && (NILP (coding_system
)
3559 || ! CODING_REQUIRE_DECODING (&coding
)))
3561 /* same_at_start and same_at_end count bytes,
3562 because file access counts bytes
3563 and BEG and END count bytes. */
3564 ptrdiff_t same_at_start
= BEGV_BYTE
;
3565 ptrdiff_t same_at_end
= ZV_BYTE
;
3567 /* There is still a possibility we will find the need to do code
3568 conversion. If that happens, set this variable to
3569 give up on handling REPLACE in the optimized way. */
3570 bool giveup_match_end
= 0;
3572 if (beg_offset
!= 0)
3574 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
3575 report_file_error ("Setting file position",
3576 Fcons (orig_filename
, Qnil
));
3581 /* Count how many chars at the start of the file
3582 match the text at the beginning of the buffer. */
3587 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3589 error ("IO error reading %s: %s",
3590 SSDATA (orig_filename
), emacs_strerror (errno
));
3591 else if (nread
== 0)
3594 if (CODING_REQUIRE_DETECTION (&coding
))
3596 coding_system
= detect_coding_system ((unsigned char *) buffer
,
3599 setup_coding_system (coding_system
, &coding
);
3602 if (CODING_REQUIRE_DECODING (&coding
))
3603 /* We found that the file should be decoded somehow.
3604 Let's give up here. */
3606 giveup_match_end
= 1;
3611 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3612 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3613 same_at_start
++, bufpos
++;
3614 /* If we found a discrepancy, stop the scan.
3615 Otherwise loop around and scan the next bufferful. */
3616 if (bufpos
!= nread
)
3620 /* If the file matches the buffer completely,
3621 there's no need to replace anything. */
3622 if (same_at_start
- BEGV_BYTE
== end_offset
- beg_offset
)
3626 /* Truncate the buffer to the size of the file. */
3627 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3632 /* Count how many chars at the end of the file
3633 match the text at the end of the buffer. But, if we have
3634 already found that decoding is necessary, don't waste time. */
3635 while (!giveup_match_end
)
3637 int total_read
, nread
, bufpos
, trial
;
3640 /* At what file position are we now scanning? */
3641 curpos
= end_offset
- (ZV_BYTE
- same_at_end
);
3642 /* If the entire file matches the buffer tail, stop the scan. */
3645 /* How much can we scan in the next step? */
3646 trial
= min (curpos
, sizeof buffer
);
3647 if (lseek (fd
, curpos
- trial
, SEEK_SET
) < 0)
3648 report_file_error ("Setting file position",
3649 Fcons (orig_filename
, Qnil
));
3651 total_read
= nread
= 0;
3652 while (total_read
< trial
)
3654 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3656 error ("IO error reading %s: %s",
3657 SDATA (orig_filename
), emacs_strerror (errno
));
3658 else if (nread
== 0)
3660 total_read
+= nread
;
3663 /* Scan this bufferful from the end, comparing with
3664 the Emacs buffer. */
3665 bufpos
= total_read
;
3667 /* Compare with same_at_start to avoid counting some buffer text
3668 as matching both at the file's beginning and at the end. */
3669 while (bufpos
> 0 && same_at_end
> same_at_start
3670 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3671 same_at_end
--, bufpos
--;
3673 /* If we found a discrepancy, stop the scan.
3674 Otherwise loop around and scan the preceding bufferful. */
3677 /* If this discrepancy is because of code conversion,
3678 we cannot use this method; giveup and try the other. */
3679 if (same_at_end
> same_at_start
3680 && FETCH_BYTE (same_at_end
- 1) >= 0200
3681 && ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3682 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3683 giveup_match_end
= 1;
3692 if (! giveup_match_end
)
3696 /* We win! We can handle REPLACE the optimized way. */
3698 /* Extend the start of non-matching text area to multibyte
3699 character boundary. */
3700 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3701 while (same_at_start
> BEGV_BYTE
3702 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3705 /* Extend the end of non-matching text area to multibyte
3706 character boundary. */
3707 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3708 while (same_at_end
< ZV_BYTE
3709 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3712 /* Don't try to reuse the same piece of text twice. */
3713 overlap
= (same_at_start
- BEGV_BYTE
3715 + (! NILP (end
) ? end_offset
: st
.st_size
) - ZV_BYTE
));
3717 same_at_end
+= overlap
;
3719 /* Arrange to read only the nonmatching middle part of the file. */
3720 beg_offset
+= same_at_start
- BEGV_BYTE
;
3721 end_offset
-= ZV_BYTE
- same_at_end
;
3723 del_range_byte (same_at_start
, same_at_end
, 0);
3724 /* Insert from the file at the proper position. */
3725 temp
= BYTE_TO_CHAR (same_at_start
);
3726 SET_PT_BOTH (temp
, same_at_start
);
3728 /* If display currently starts at beginning of line,
3729 keep it that way. */
3730 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3731 XWINDOW (selected_window
)->start_at_line_beg
= !NILP (Fbolp ());
3733 replace_handled
= 1;
3737 /* If requested, replace the accessible part of the buffer
3738 with the file contents. Avoid replacing text at the
3739 beginning or end of the buffer that matches the file contents;
3740 that preserves markers pointing to the unchanged parts.
3742 Here we implement this feature for the case where code conversion
3743 is needed, in a simple way that needs a lot of memory.
3744 The preceding if-statement handles the case of no conversion
3745 in a more optimized way. */
3746 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3748 ptrdiff_t same_at_start
= BEGV_BYTE
;
3749 ptrdiff_t same_at_end
= ZV_BYTE
;
3750 ptrdiff_t same_at_start_charpos
;
3751 ptrdiff_t inserted_chars
;
3754 unsigned char *decoded
;
3757 ptrdiff_t this_count
= SPECPDL_INDEX ();
3759 = ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
3760 Lisp_Object conversion_buffer
;
3761 struct gcpro gcpro1
;
3763 conversion_buffer
= code_conversion_save (1, multibyte
);
3765 /* First read the whole file, performing code conversion into
3766 CONVERSION_BUFFER. */
3768 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
3769 report_file_error ("Setting file position",
3770 Fcons (orig_filename
, Qnil
));
3772 total
= st
.st_size
; /* Total bytes in the file. */
3773 how_much
= 0; /* Bytes read from file so far. */
3774 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3775 unprocessed
= 0; /* Bytes not processed in previous loop. */
3777 GCPRO1 (conversion_buffer
);
3778 while (how_much
< total
)
3780 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
3781 quitting while reading a huge while. */
3782 /* `try'' is reserved in some compilers (Microsoft C). */
3783 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3785 /* Allow quitting out of the actual I/O. */
3788 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
3796 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
3797 BUF_Z (XBUFFER (conversion_buffer
)));
3798 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3799 unprocessed
+ this, conversion_buffer
);
3800 unprocessed
= coding
.carryover_bytes
;
3801 if (coding
.carryover_bytes
> 0)
3802 memcpy (read_buf
, coding
.carryover
, unprocessed
);
3807 /* We should remove the unwind_protect calling
3808 close_file_unwind, but other stuff has been added the stack,
3809 so defer the removal till we reach the `handled' label. */
3810 deferred_remove_unwind_protect
= 1;
3812 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
3813 if we couldn't read the file. */
3816 error ("IO error reading %s: %s",
3817 SDATA (orig_filename
), emacs_strerror (errno
));
3819 if (unprocessed
> 0)
3821 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3822 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3823 unprocessed
, conversion_buffer
);
3824 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
3827 coding_system
= CODING_ID_NAME (coding
.id
);
3828 set_coding_system
= 1;
3829 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
3830 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
3831 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3833 /* Compare the beginning of the converted string with the buffer
3837 while (bufpos
< inserted
&& same_at_start
< same_at_end
3838 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
3839 same_at_start
++, bufpos
++;
3841 /* If the file matches the head of buffer completely,
3842 there's no need to replace anything. */
3844 if (bufpos
== inserted
)
3846 /* Truncate the buffer to the size of the file. */
3847 if (same_at_start
== same_at_end
)
3850 del_range_byte (same_at_start
, same_at_end
, 0);
3853 unbind_to (this_count
, Qnil
);
3857 /* Extend the start of non-matching text area to the previous
3858 multibyte character boundary. */
3859 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3860 while (same_at_start
> BEGV_BYTE
3861 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3864 /* Scan this bufferful from the end, comparing with
3865 the Emacs buffer. */
3868 /* Compare with same_at_start to avoid counting some buffer text
3869 as matching both at the file's beginning and at the end. */
3870 while (bufpos
> 0 && same_at_end
> same_at_start
3871 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
3872 same_at_end
--, bufpos
--;
3874 /* Extend the end of non-matching text area to the next
3875 multibyte character boundary. */
3876 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3877 while (same_at_end
< ZV_BYTE
3878 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3881 /* Don't try to reuse the same piece of text twice. */
3882 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3884 same_at_end
+= overlap
;
3886 /* If display currently starts at beginning of line,
3887 keep it that way. */
3888 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3889 XWINDOW (selected_window
)->start_at_line_beg
= !NILP (Fbolp ());
3891 /* Replace the chars that we need to replace,
3892 and update INSERTED to equal the number of bytes
3893 we are taking from the decoded string. */
3894 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
3896 if (same_at_end
!= same_at_start
)
3898 del_range_byte (same_at_start
, same_at_end
, 0);
3900 same_at_start
= GPT_BYTE
;
3904 temp
= BYTE_TO_CHAR (same_at_start
);
3906 /* Insert from the file at the proper position. */
3907 SET_PT_BOTH (temp
, same_at_start
);
3908 same_at_start_charpos
3909 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3910 same_at_start
- BEGV_BYTE
3911 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3913 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3914 same_at_start
+ inserted
- BEGV_BYTE
3915 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
3916 - same_at_start_charpos
);
3917 /* This binding is to avoid ask-user-about-supersession-threat
3918 being called in insert_from_buffer (via in
3919 prepare_to_modify_buffer). */
3920 specbind (intern ("buffer-file-name"), Qnil
);
3921 insert_from_buffer (XBUFFER (conversion_buffer
),
3922 same_at_start_charpos
, inserted_chars
, 0);
3923 /* Set `inserted' to the number of inserted characters. */
3924 inserted
= PT
- temp
;
3925 /* Set point before the inserted characters. */
3926 SET_PT_BOTH (temp
, same_at_start
);
3928 unbind_to (this_count
, Qnil
);
3934 total
= end_offset
- beg_offset
;
3936 /* For a special file, all we can do is guess. */
3937 total
= READ_BUF_SIZE
;
3939 if (NILP (visit
) && total
> 0)
3941 #ifdef CLASH_DETECTION
3942 if (!NILP (BVAR (current_buffer
, file_truename
))
3943 /* Make binding buffer-file-name to nil effective. */
3944 && !NILP (BVAR (current_buffer
, filename
))
3945 && SAVE_MODIFF
>= MODIFF
)
3947 #endif /* CLASH_DETECTION */
3948 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
3952 if (GAP_SIZE
< total
)
3953 make_gap (total
- GAP_SIZE
);
3955 if (beg_offset
!= 0 || !NILP (replace
))
3957 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
3958 report_file_error ("Setting file position",
3959 Fcons (orig_filename
, Qnil
));
3962 /* In the following loop, HOW_MUCH contains the total bytes read so
3963 far for a regular file, and not changed for a special file. But,
3964 before exiting the loop, it is set to a negative value if I/O
3968 /* Total bytes inserted. */
3971 /* Here, we don't do code conversion in the loop. It is done by
3972 decode_coding_gap after all data are read into the buffer. */
3974 ptrdiff_t gap_size
= GAP_SIZE
;
3976 while (how_much
< total
)
3978 /* try is reserved in some compilers (Microsoft C) */
3979 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3986 /* Maybe make more room. */
3987 if (gap_size
< trytry
)
3989 make_gap (total
- gap_size
);
3990 gap_size
= GAP_SIZE
;
3993 /* Read from the file, capturing `quit'. When an
3994 error occurs, end the loop, and arrange for a quit
3995 to be signaled after decoding the text we read. */
3996 non_regular_fd
= fd
;
3997 non_regular_inserted
= inserted
;
3998 non_regular_nbytes
= trytry
;
3999 nbytes
= internal_condition_case_1 (read_non_regular
,
4001 read_non_regular_quit
);
4008 this = XINT (nbytes
);
4012 /* Allow quitting out of the actual I/O. We don't make text
4013 part of the buffer until all the reading is done, so a C-g
4014 here doesn't do any harm. */
4017 this = emacs_read (fd
,
4018 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
4032 /* For a regular file, where TOTAL is the real size,
4033 count HOW_MUCH to compare with it.
4034 For a special file, where TOTAL is just a buffer size,
4035 so don't bother counting in HOW_MUCH.
4036 (INSERTED is where we count the number of characters inserted.) */
4043 /* Now we have read all the file data into the gap.
4044 If it was empty, undo marking the buffer modified. */
4048 #ifdef CLASH_DETECTION
4050 unlock_file (BVAR (current_buffer
, file_truename
));
4052 Vdeactivate_mark
= old_Vdeactivate_mark
;
4055 Vdeactivate_mark
= Qt
;
4057 /* Make the text read part of the buffer. */
4058 GAP_SIZE
-= inserted
;
4060 GPT_BYTE
+= inserted
;
4062 ZV_BYTE
+= inserted
;
4067 /* Put an anchor to ensure multi-byte form ends at gap. */
4072 /* Discard the unwind protect for closing the file. */
4076 error ("IO error reading %s: %s",
4077 SDATA (orig_filename
), emacs_strerror (errno
));
4081 if (NILP (coding_system
))
4083 /* The coding system is not yet decided. Decide it by an
4084 optimized method for handling `coding:' tag.
4086 Note that we can get here only if the buffer was empty
4087 before the insertion. */
4089 if (!NILP (Vcoding_system_for_read
))
4090 coding_system
= Vcoding_system_for_read
;
4093 /* Since we are sure that the current buffer was empty
4094 before the insertion, we can toggle
4095 enable-multibyte-characters directly here without taking
4096 care of marker adjustment. By this way, we can run Lisp
4097 program safely before decoding the inserted text. */
4098 Lisp_Object unwind_data
;
4099 ptrdiff_t count1
= SPECPDL_INDEX ();
4101 unwind_data
= Fcons (BVAR (current_buffer
, enable_multibyte_characters
),
4102 Fcons (BVAR (current_buffer
, undo_list
),
4103 Fcurrent_buffer ()));
4104 bset_enable_multibyte_characters (current_buffer
, Qnil
);
4105 bset_undo_list (current_buffer
, Qt
);
4106 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4108 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4110 coding_system
= call2 (Vset_auto_coding_function
,
4111 filename
, make_number (inserted
));
4114 if (NILP (coding_system
))
4116 /* If the coding system is not yet decided, check
4117 file-coding-system-alist. */
4118 Lisp_Object args
[6];
4120 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4121 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4122 coding_system
= Ffind_operation_coding_system (6, args
);
4123 if (CONSP (coding_system
))
4124 coding_system
= XCAR (coding_system
);
4126 unbind_to (count1
, Qnil
);
4127 inserted
= Z_BYTE
- BEG_BYTE
;
4130 if (NILP (coding_system
))
4131 coding_system
= Qundecided
;
4133 CHECK_CODING_SYSTEM (coding_system
);
4135 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4136 /* We must suppress all character code conversion except for
4137 end-of-line conversion. */
4138 coding_system
= raw_text_coding_system (coding_system
);
4139 setup_coding_system (coding_system
, &coding
);
4140 /* Ensure we set Vlast_coding_system_used. */
4141 set_coding_system
= 1;
4146 /* When we visit a file by raw-text, we change the buffer to
4148 if (CODING_FOR_UNIBYTE (&coding
)
4149 /* Can't do this if part of the buffer might be preserved. */
4151 /* Visiting a file with these coding system makes the buffer
4153 bset_enable_multibyte_characters (current_buffer
, Qnil
);
4156 coding
.dst_multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
4157 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4158 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4160 move_gap_both (PT
, PT_BYTE
);
4161 GAP_SIZE
+= inserted
;
4162 ZV_BYTE
-= inserted
;
4166 decode_coding_gap (&coding
, inserted
, inserted
);
4167 inserted
= coding
.produced_char
;
4168 coding_system
= CODING_ID_NAME (coding
.id
);
4170 else if (inserted
> 0)
4171 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4174 /* Call after-change hooks for the inserted text, aside from the case
4175 of normal visiting (not with REPLACE), which is done in a new buffer
4176 "before" the buffer is changed. */
4177 if (inserted
> 0 && total
> 0
4178 && (NILP (visit
) || !NILP (replace
)))
4180 signal_after_change (PT
, 0, inserted
);
4181 update_compositions (PT
, PT
, CHECK_BORDER
);
4184 /* Now INSERTED is measured in characters. */
4188 if (deferred_remove_unwind_protect
)
4189 /* If requested above, discard the unwind protect for closing the
4195 if (!EQ (BVAR (current_buffer
, undo_list
), Qt
) && !nochange
)
4196 bset_undo_list (current_buffer
, Qnil
);
4200 current_buffer
->modtime
= mtime
;
4201 current_buffer
->modtime_size
= st
.st_size
;
4202 bset_filename (current_buffer
, orig_filename
);
4205 SAVE_MODIFF
= MODIFF
;
4206 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
4207 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4208 #ifdef CLASH_DETECTION
4211 if (!NILP (BVAR (current_buffer
, file_truename
)))
4212 unlock_file (BVAR (current_buffer
, file_truename
));
4213 unlock_file (filename
);
4215 #endif /* CLASH_DETECTION */
4217 xsignal2 (Qfile_error
,
4218 build_string ("not a regular file"), orig_filename
);
4221 if (set_coding_system
)
4222 Vlast_coding_system_used
= coding_system
;
4224 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4226 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4228 if (! NILP (insval
))
4230 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4231 wrong_type_argument (intern ("inserted-chars"), insval
);
4232 inserted
= XFASTINT (insval
);
4236 /* Decode file format. */
4239 /* Don't run point motion or modification hooks when decoding. */
4240 ptrdiff_t count1
= SPECPDL_INDEX ();
4241 ptrdiff_t old_inserted
= inserted
;
4242 specbind (Qinhibit_point_motion_hooks
, Qt
);
4243 specbind (Qinhibit_modification_hooks
, Qt
);
4245 /* Save old undo list and don't record undo for decoding. */
4246 old_undo
= BVAR (current_buffer
, undo_list
);
4247 bset_undo_list (current_buffer
, Qt
);
4251 insval
= call3 (Qformat_decode
,
4252 Qnil
, make_number (inserted
), visit
);
4253 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4254 wrong_type_argument (intern ("inserted-chars"), insval
);
4255 inserted
= XFASTINT (insval
);
4259 /* If REPLACE is non-nil and we succeeded in not replacing the
4260 beginning or end of the buffer text with the file's contents,
4261 call format-decode with `point' positioned at the beginning
4262 of the buffer and `inserted' equaling the number of
4263 characters in the buffer. Otherwise, format-decode might
4264 fail to correctly analyze the beginning or end of the buffer.
4265 Hence we temporarily save `point' and `inserted' here and
4266 restore `point' iff format-decode did not insert or delete
4267 any text. Otherwise we leave `point' at point-min. */
4268 ptrdiff_t opoint
= PT
;
4269 ptrdiff_t opoint_byte
= PT_BYTE
;
4270 ptrdiff_t oinserted
= ZV
- BEGV
;
4271 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4273 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4274 insval
= call3 (Qformat_decode
,
4275 Qnil
, make_number (oinserted
), visit
);
4276 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4277 wrong_type_argument (intern ("inserted-chars"), insval
);
4278 if (ochars_modiff
== CHARS_MODIFF
)
4279 /* format_decode didn't modify buffer's characters => move
4280 point back to position before inserted text and leave
4281 value of inserted alone. */
4282 SET_PT_BOTH (opoint
, opoint_byte
);
4284 /* format_decode modified buffer's characters => consider
4285 entire buffer changed and leave point at point-min. */
4286 inserted
= XFASTINT (insval
);
4289 /* For consistency with format-decode call these now iff inserted > 0
4290 (martin 2007-06-28). */
4291 p
= Vafter_insert_file_functions
;
4296 insval
= call1 (XCAR (p
), make_number (inserted
));
4299 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4300 wrong_type_argument (intern ("inserted-chars"), insval
);
4301 inserted
= XFASTINT (insval
);
4306 /* For the rationale of this see the comment on
4307 format-decode above. */
4308 ptrdiff_t opoint
= PT
;
4309 ptrdiff_t opoint_byte
= PT_BYTE
;
4310 ptrdiff_t oinserted
= ZV
- BEGV
;
4311 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4313 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4314 insval
= call1 (XCAR (p
), make_number (oinserted
));
4317 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4318 wrong_type_argument (intern ("inserted-chars"), insval
);
4319 if (ochars_modiff
== CHARS_MODIFF
)
4320 /* after_insert_file_functions didn't modify
4321 buffer's characters => move point back to
4322 position before inserted text and leave value of
4324 SET_PT_BOTH (opoint
, opoint_byte
);
4326 /* after_insert_file_functions did modify buffer's
4327 characters => consider entire buffer changed and
4328 leave point at point-min. */
4329 inserted
= XFASTINT (insval
);
4339 bset_undo_list (current_buffer
, old_undo
);
4340 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4342 /* Adjust the last undo record for the size change during
4343 the format conversion. */
4344 Lisp_Object tem
= XCAR (old_undo
);
4345 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4346 && INTEGERP (XCDR (tem
))
4347 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4348 XSETCDR (tem
, make_number (PT
+ inserted
));
4352 /* If undo_list was Qt before, keep it that way.
4353 Otherwise start with an empty undo_list. */
4354 bset_undo_list (current_buffer
, EQ (old_undo
, Qt
) ? Qt
: Qnil
);
4356 unbind_to (count1
, Qnil
);
4360 && EMACS_NSECS (current_buffer
->modtime
) == NONEXISTENT_MODTIME_NSECS
)
4362 /* If visiting nonexistent file, return nil. */
4364 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4368 Fsignal (Qquit
, Qnil
);
4370 /* ??? Retval needs to be dealt with in all cases consistently. */
4372 val
= Fcons (orig_filename
,
4373 Fcons (make_number (inserted
),
4376 RETURN_UNGCPRO (unbind_to (count
, val
));
4379 static Lisp_Object
build_annotations (Lisp_Object
, Lisp_Object
);
4382 build_annotations_unwind (Lisp_Object arg
)
4384 Vwrite_region_annotation_buffers
= arg
;
4388 /* Decide the coding-system to encode the data with. */
4391 choose_write_coding_system (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4392 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
,
4393 struct coding_system
*coding
)
4396 Lisp_Object eol_parent
= Qnil
;
4399 && NILP (Fstring_equal (BVAR (current_buffer
, filename
),
4400 BVAR (current_buffer
, auto_save_file_name
))))
4405 else if (!NILP (Vcoding_system_for_write
))
4407 val
= Vcoding_system_for_write
;
4408 if (coding_system_require_warning
4409 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4410 /* Confirm that VAL can surely encode the current region. */
4411 val
= call5 (Vselect_safe_coding_system_function
,
4412 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4417 /* If the variable `buffer-file-coding-system' is set locally,
4418 it means that the file was read with some kind of code
4419 conversion or the variable is explicitly set by users. We
4420 had better write it out with the same coding system even if
4421 `enable-multibyte-characters' is nil.
4423 If it is not set locally, we anyway have to convert EOL
4424 format if the default value of `buffer-file-coding-system'
4425 tells that it is not Unix-like (LF only) format. */
4426 bool using_default_coding
= 0;
4427 bool force_raw_text
= 0;
4429 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4431 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4434 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4440 /* Check file-coding-system-alist. */
4441 Lisp_Object args
[7], coding_systems
;
4443 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4444 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4446 coding_systems
= Ffind_operation_coding_system (7, args
);
4447 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4448 val
= XCDR (coding_systems
);
4453 /* If we still have not decided a coding system, use the
4454 default value of buffer-file-coding-system. */
4455 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4456 using_default_coding
= 1;
4459 if (! NILP (val
) && ! force_raw_text
)
4461 Lisp_Object spec
, attrs
;
4463 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4464 attrs
= AREF (spec
, 0);
4465 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4470 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4471 /* Confirm that VAL can surely encode the current region. */
4472 val
= call5 (Vselect_safe_coding_system_function
,
4473 start
, end
, val
, Qnil
, filename
);
4475 /* If the decided coding-system doesn't specify end-of-line
4476 format, we use that of
4477 `default-buffer-file-coding-system'. */
4478 if (! using_default_coding
4479 && ! NILP (BVAR (&buffer_defaults
, buffer_file_coding_system
)))
4480 val
= (coding_inherit_eol_type
4481 (val
, BVAR (&buffer_defaults
, buffer_file_coding_system
)));
4483 /* If we decide not to encode text, use `raw-text' or one of its
4486 val
= raw_text_coding_system (val
);
4489 val
= coding_inherit_eol_type (val
, eol_parent
);
4490 setup_coding_system (val
, coding
);
4492 if (!STRINGP (start
) && !NILP (BVAR (current_buffer
, selective_display
)))
4493 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4497 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4498 "r\nFWrite region to file: \ni\ni\ni\np",
4499 doc
: /* Write current region into specified file.
4500 When called from a program, requires three arguments:
4501 START, END and FILENAME. START and END are normally buffer positions
4502 specifying the part of the buffer to write.
4503 If START is nil, that means to use the entire buffer contents.
4504 If START is a string, then output that string to the file
4505 instead of any buffer contents; END is ignored.
4507 Optional fourth argument APPEND if non-nil means
4508 append to existing file contents (if any). If it is an integer,
4509 seek to that offset in the file before writing.
4510 Optional fifth argument VISIT, if t or a string, means
4511 set the last-save-file-modtime of buffer to this file's modtime
4512 and mark buffer not modified.
4513 If VISIT is a string, it is a second file name;
4514 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4515 VISIT is also the file name to lock and unlock for clash detection.
4516 If VISIT is neither t nor nil nor a string,
4517 that means do not display the \"Wrote file\" message.
4518 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4519 use for locking and unlocking, overriding FILENAME and VISIT.
4520 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4521 for an existing file with the same name. If MUSTBENEW is `excl',
4522 that means to get an error if the file already exists; never overwrite.
4523 If MUSTBENEW is neither nil nor `excl', that means ask for
4524 confirmation before overwriting, but do go ahead and overwrite the file
4525 if the user confirms.
4527 This does code conversion according to the value of
4528 `coding-system-for-write', `buffer-file-coding-system', or
4529 `file-coding-system-alist', and sets the variable
4530 `last-coding-system-used' to the coding system actually used.
4532 This calls `write-region-annotate-functions' at the start, and
4533 `write-region-post-annotation-function' at the end. */)
4534 (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
, Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
, Lisp_Object mustbenew
)
4541 ptrdiff_t count
= SPECPDL_INDEX ();
4543 Lisp_Object handler
;
4544 Lisp_Object visit_file
;
4545 Lisp_Object annotations
;
4546 Lisp_Object encoded_filename
;
4547 bool visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4548 bool quietly
= !NILP (visit
);
4549 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4550 struct buffer
*given_buffer
;
4551 struct coding_system coding
;
4553 if (current_buffer
->base_buffer
&& visiting
)
4554 error ("Cannot do file visiting in an indirect buffer");
4556 if (!NILP (start
) && !STRINGP (start
))
4557 validate_region (&start
, &end
);
4560 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4562 filename
= Fexpand_file_name (filename
, Qnil
);
4564 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4565 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4567 if (STRINGP (visit
))
4568 visit_file
= Fexpand_file_name (visit
, Qnil
);
4570 visit_file
= filename
;
4572 if (NILP (lockname
))
4573 lockname
= visit_file
;
4577 /* If the file name has special constructs in it,
4578 call the corresponding file handler. */
4579 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4580 /* If FILENAME has no handler, see if VISIT has one. */
4581 if (NILP (handler
) && STRINGP (visit
))
4582 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4584 if (!NILP (handler
))
4587 val
= call6 (handler
, Qwrite_region
, start
, end
,
4588 filename
, append
, visit
);
4592 SAVE_MODIFF
= MODIFF
;
4593 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4594 bset_filename (current_buffer
, visit_file
);
4600 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4602 /* Special kludge to simplify auto-saving. */
4605 /* Do it later, so write-region-annotate-function can work differently
4606 if we save "the buffer" vs "a region".
4607 This is useful in tar-mode. --Stef
4608 XSETFASTINT (start, BEG);
4609 XSETFASTINT (end, Z); */
4613 record_unwind_protect (build_annotations_unwind
,
4614 Vwrite_region_annotation_buffers
);
4615 Vwrite_region_annotation_buffers
= Fcons (Fcurrent_buffer (), Qnil
);
4616 count1
= SPECPDL_INDEX ();
4618 given_buffer
= current_buffer
;
4620 if (!STRINGP (start
))
4622 annotations
= build_annotations (start
, end
);
4624 if (current_buffer
!= given_buffer
)
4626 XSETFASTINT (start
, BEGV
);
4627 XSETFASTINT (end
, ZV
);
4633 XSETFASTINT (start
, BEGV
);
4634 XSETFASTINT (end
, ZV
);
4639 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4641 /* Decide the coding-system to encode the data with.
4642 We used to make this choice before calling build_annotations, but that
4643 leads to problems when a write-annotate-function takes care of
4644 unsavable chars (as was the case with X-Symbol). */
4645 Vlast_coding_system_used
4646 = choose_write_coding_system (start
, end
, filename
,
4647 append
, visit
, lockname
, &coding
);
4649 #ifdef CLASH_DETECTION
4651 lock_file (lockname
);
4652 #endif /* CLASH_DETECTION */
4654 encoded_filename
= ENCODE_FILE (filename
);
4656 fn
= SSDATA (encoded_filename
);
4660 desc
= emacs_open (fn
, O_WRONLY
| O_BINARY
, 0);
4661 #else /* not DOS_NT */
4662 desc
= emacs_open (fn
, O_WRONLY
, 0);
4663 #endif /* not DOS_NT */
4665 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4667 desc
= emacs_open (fn
,
4668 O_WRONLY
| O_CREAT
| O_BINARY
4669 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4670 S_IREAD
| S_IWRITE
);
4671 #else /* not DOS_NT */
4672 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4673 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4674 auto_saving
? auto_save_mode_bits
: 0666);
4675 #endif /* not DOS_NT */
4679 #ifdef CLASH_DETECTION
4681 if (!auto_saving
) unlock_file (lockname
);
4683 #endif /* CLASH_DETECTION */
4685 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4688 record_unwind_protect (close_file_unwind
, make_number (desc
));
4690 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4694 if (NUMBERP (append
))
4695 ret
= emacs_lseek (desc
, XINT (append
), SEEK_CUR
);
4697 ret
= lseek (desc
, 0, SEEK_END
);
4700 #ifdef CLASH_DETECTION
4702 if (!auto_saving
) unlock_file (lockname
);
4704 #endif /* CLASH_DETECTION */
4706 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4714 if (STRINGP (start
))
4715 ok
= a_write (desc
, start
, 0, SCHARS (start
), &annotations
, &coding
);
4716 else if (XINT (start
) != XINT (end
))
4717 ok
= a_write (desc
, Qnil
, XINT (start
), XINT (end
) - XINT (start
),
4718 &annotations
, &coding
);
4721 /* If file was empty, still need to write the annotations. */
4722 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4723 ok
= a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4727 if (ok
&& CODING_REQUIRE_FLUSHING (&coding
)
4728 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
))
4730 /* We have to flush out a data. */
4731 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4732 ok
= e_write (desc
, Qnil
, 1, 1, &coding
);
4739 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4740 Disk full in NFS may be reported here. */
4741 /* mib says that closing the file will try to write as fast as NFS can do
4742 it, and that means the fsync here is not crucial for autosave files. */
4743 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
4745 /* If fsync fails with EINTR, don't treat that as serious. Also
4746 ignore EINVAL which happens when fsync is not supported on this
4748 if (errno
!= EINTR
&& errno
!= EINVAL
)
4749 ok
= 0, save_errno
= errno
;
4753 /* NFS can report a write failure now. */
4754 if (emacs_close (desc
) < 0)
4755 ok
= 0, save_errno
= errno
;
4759 /* Discard the unwind protect for close_file_unwind. */
4760 specpdl_ptr
= specpdl
+ count1
;
4762 /* Call write-region-post-annotation-function. */
4763 while (CONSP (Vwrite_region_annotation_buffers
))
4765 Lisp_Object buf
= XCAR (Vwrite_region_annotation_buffers
);
4766 if (!NILP (Fbuffer_live_p (buf
)))
4769 if (FUNCTIONP (Vwrite_region_post_annotation_function
))
4770 call0 (Vwrite_region_post_annotation_function
);
4772 Vwrite_region_annotation_buffers
4773 = XCDR (Vwrite_region_annotation_buffers
);
4776 unbind_to (count
, Qnil
);
4778 #ifdef CLASH_DETECTION
4780 unlock_file (lockname
);
4781 #endif /* CLASH_DETECTION */
4783 /* Do this before reporting IO error
4784 to avoid a "file has changed on disk" warning on
4785 next attempt to save. */
4788 current_buffer
->modtime
= get_stat_mtime (&st
);
4789 current_buffer
->modtime_size
= st
.st_size
;
4793 error ("IO error writing %s: %s", SDATA (filename
),
4794 emacs_strerror (save_errno
));
4798 SAVE_MODIFF
= MODIFF
;
4799 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4800 bset_filename (current_buffer
, visit_file
);
4801 update_mode_lines
++;
4806 && ! NILP (Fstring_equal (BVAR (current_buffer
, filename
),
4807 BVAR (current_buffer
, auto_save_file_name
))))
4808 SAVE_MODIFF
= MODIFF
;
4814 message_with_string ((INTEGERP (append
)
4824 Lisp_Object
merge (Lisp_Object
, Lisp_Object
, Lisp_Object
);
4826 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4827 doc
: /* Return t if (car A) is numerically less than (car B). */)
4828 (Lisp_Object a
, Lisp_Object b
)
4830 return Flss (Fcar (a
), Fcar (b
));
4833 /* Build the complete list of annotations appropriate for writing out
4834 the text between START and END, by calling all the functions in
4835 write-region-annotate-functions and merging the lists they return.
4836 If one of these functions switches to a different buffer, we assume
4837 that buffer contains altered text. Therefore, the caller must
4838 make sure to restore the current buffer in all cases,
4839 as save-excursion would do. */
4842 build_annotations (Lisp_Object start
, Lisp_Object end
)
4844 Lisp_Object annotations
;
4846 struct gcpro gcpro1
, gcpro2
;
4847 Lisp_Object original_buffer
;
4849 bool used_global
= 0;
4851 XSETBUFFER (original_buffer
, current_buffer
);
4854 p
= Vwrite_region_annotate_functions
;
4855 GCPRO2 (annotations
, p
);
4858 struct buffer
*given_buffer
= current_buffer
;
4859 if (EQ (Qt
, XCAR (p
)) && !used_global
)
4860 { /* Use the global value of the hook. */
4863 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
4865 p
= Fappend (2, arg
);
4868 Vwrite_region_annotations_so_far
= annotations
;
4869 res
= call2 (XCAR (p
), start
, end
);
4870 /* If the function makes a different buffer current,
4871 assume that means this buffer contains altered text to be output.
4872 Reset START and END from the buffer bounds
4873 and discard all previous annotations because they should have
4874 been dealt with by this function. */
4875 if (current_buffer
!= given_buffer
)
4877 Vwrite_region_annotation_buffers
4878 = Fcons (Fcurrent_buffer (),
4879 Vwrite_region_annotation_buffers
);
4880 XSETFASTINT (start
, BEGV
);
4881 XSETFASTINT (end
, ZV
);
4884 Flength (res
); /* Check basic validity of return value */
4885 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4889 /* Now do the same for annotation functions implied by the file-format */
4890 if (auto_saving
&& (!EQ (BVAR (current_buffer
, auto_save_file_format
), Qt
)))
4891 p
= BVAR (current_buffer
, auto_save_file_format
);
4893 p
= BVAR (current_buffer
, file_format
);
4894 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
4896 struct buffer
*given_buffer
= current_buffer
;
4898 Vwrite_region_annotations_so_far
= annotations
;
4900 /* Value is either a list of annotations or nil if the function
4901 has written annotations to a temporary buffer, which is now
4903 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
4904 original_buffer
, make_number (i
));
4905 if (current_buffer
!= given_buffer
)
4907 XSETFASTINT (start
, BEGV
);
4908 XSETFASTINT (end
, ZV
);
4913 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4921 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
4922 If STRING is nil, POS is the character position in the current buffer.
4923 Intersperse with them the annotations from *ANNOT
4924 which fall within the range of POS to POS + NCHARS,
4925 each at its appropriate position.
4927 We modify *ANNOT by discarding elements as we use them up.
4929 Return true if successful. */
4932 a_write (int desc
, Lisp_Object string
, ptrdiff_t pos
,
4933 ptrdiff_t nchars
, Lisp_Object
*annot
,
4934 struct coding_system
*coding
)
4938 ptrdiff_t lastpos
= pos
+ nchars
;
4940 while (NILP (*annot
) || CONSP (*annot
))
4942 tem
= Fcar_safe (Fcar (*annot
));
4945 nextpos
= XFASTINT (tem
);
4947 /* If there are no more annotations in this range,
4948 output the rest of the range all at once. */
4949 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
4950 return e_write (desc
, string
, pos
, lastpos
, coding
);
4952 /* Output buffer text up to the next annotation's position. */
4955 if (!e_write (desc
, string
, pos
, nextpos
, coding
))
4959 /* Output the annotation. */
4960 tem
= Fcdr (Fcar (*annot
));
4963 if (!e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
4966 *annot
= Fcdr (*annot
);
4972 /* Write text in the range START and END into descriptor DESC,
4973 encoding them with coding system CODING. If STRING is nil, START
4974 and END are character positions of the current buffer, else they
4975 are indexes to the string STRING. Return true if successful. */
4978 e_write (int desc
, Lisp_Object string
, ptrdiff_t start
, ptrdiff_t end
,
4979 struct coding_system
*coding
)
4981 if (STRINGP (string
))
4984 end
= SCHARS (string
);
4987 /* We used to have a code for handling selective display here. But,
4988 now it is handled within encode_coding. */
4992 if (STRINGP (string
))
4994 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
4995 if (CODING_REQUIRE_ENCODING (coding
))
4997 encode_coding_object (coding
, string
,
4998 start
, string_char_to_byte (string
, start
),
4999 end
, string_char_to_byte (string
, end
), Qt
);
5003 coding
->dst_object
= string
;
5004 coding
->consumed_char
= SCHARS (string
);
5005 coding
->produced
= SBYTES (string
);
5010 ptrdiff_t start_byte
= CHAR_TO_BYTE (start
);
5011 ptrdiff_t end_byte
= CHAR_TO_BYTE (end
);
5013 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5014 if (CODING_REQUIRE_ENCODING (coding
))
5016 encode_coding_object (coding
, Fcurrent_buffer (),
5017 start
, start_byte
, end
, end_byte
, Qt
);
5021 coding
->dst_object
= Qnil
;
5022 coding
->dst_pos_byte
= start_byte
;
5023 if (start
>= GPT
|| end
<= GPT
)
5025 coding
->consumed_char
= end
- start
;
5026 coding
->produced
= end_byte
- start_byte
;
5030 coding
->consumed_char
= GPT
- start
;
5031 coding
->produced
= GPT_BYTE
- start_byte
;
5036 if (coding
->produced
> 0)
5040 STRINGP (coding
->dst_object
)
5041 ? SSDATA (coding
->dst_object
)
5042 : (char *) BYTE_POS_ADDR (coding
->dst_pos_byte
),
5045 if (coding
->produced
)
5048 start
+= coding
->consumed_char
;
5054 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5055 Sverify_visited_file_modtime
, 0, 1, 0,
5056 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5057 This means that the file has not been changed since it was visited or saved.
5058 If BUF is omitted or nil, it defaults to the current buffer.
5059 See Info node `(elisp)Modification Time' for more details. */)
5064 Lisp_Object handler
;
5065 Lisp_Object filename
;
5066 EMACS_TIME mtime
, diff
;
5076 if (!STRINGP (BVAR (b
, filename
))) return Qt
;
5077 if (EMACS_NSECS (b
->modtime
) == UNKNOWN_MODTIME_NSECS
) return Qt
;
5079 /* If the file name has special constructs in it,
5080 call the corresponding file handler. */
5081 handler
= Ffind_file_name_handler (BVAR (b
, filename
),
5082 Qverify_visited_file_modtime
);
5083 if (!NILP (handler
))
5084 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5086 filename
= ENCODE_FILE (BVAR (b
, filename
));
5088 mtime
= (stat (SSDATA (filename
), &st
) == 0
5089 ? get_stat_mtime (&st
)
5090 : time_error_value (errno
));
5091 if ((EMACS_TIME_EQ (mtime
, b
->modtime
)
5092 /* If both exist, accept them if they are off by one second. */
5093 || (EMACS_TIME_VALID_P (mtime
) && EMACS_TIME_VALID_P (b
->modtime
)
5094 && ((diff
= (EMACS_TIME_LT (mtime
, b
->modtime
)
5095 ? sub_emacs_time (b
->modtime
, mtime
)
5096 : sub_emacs_time (mtime
, b
->modtime
))),
5097 EMACS_TIME_LE (diff
, make_emacs_time (1, 0)))))
5098 && (st
.st_size
== b
->modtime_size
5099 || b
->modtime_size
< 0))
5104 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5105 Sclear_visited_file_modtime
, 0, 0, 0,
5106 doc
: /* Clear out records of last mod time of visited file.
5107 Next attempt to save will certainly not complain of a discrepancy. */)
5110 current_buffer
->modtime
= make_emacs_time (0, UNKNOWN_MODTIME_NSECS
);
5111 current_buffer
->modtime_size
= -1;
5115 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5116 Svisited_file_modtime
, 0, 0, 0,
5117 doc
: /* Return the current buffer's recorded visited file modification time.
5118 The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
5119 `file-attributes' returns. If the current buffer has no recorded file
5120 modification time, this function returns 0. If the visited file
5121 doesn't exist, HIGH will be -1.
5122 See Info node `(elisp)Modification Time' for more details. */)
5125 if (EMACS_NSECS (current_buffer
->modtime
) < 0)
5126 return make_number (0);
5127 return make_lisp_time (current_buffer
->modtime
);
5130 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5131 Sset_visited_file_modtime
, 0, 1, 0,
5132 doc
: /* Update buffer's recorded modification time from the visited file's time.
5133 Useful if the buffer was not read from the file normally
5134 or if the file itself has been changed for some known benign reason.
5135 An argument specifies the modification time value to use
5136 \(instead of that of the visited file), in the form of a list
5137 \(HIGH LOW USEC PSEC) as returned by `current-time'. */)
5138 (Lisp_Object time_list
)
5140 if (!NILP (time_list
))
5142 current_buffer
->modtime
= lisp_time_argument (time_list
);
5143 current_buffer
->modtime_size
= -1;
5147 register Lisp_Object filename
;
5149 Lisp_Object handler
;
5151 filename
= Fexpand_file_name (BVAR (current_buffer
, filename
), Qnil
);
5153 /* If the file name has special constructs in it,
5154 call the corresponding file handler. */
5155 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5156 if (!NILP (handler
))
5157 /* The handler can find the file name the same way we did. */
5158 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5160 filename
= ENCODE_FILE (filename
);
5162 if (stat (SSDATA (filename
), &st
) >= 0)
5164 current_buffer
->modtime
= get_stat_mtime (&st
);
5165 current_buffer
->modtime_size
= st
.st_size
;
5173 auto_save_error (Lisp_Object error_val
)
5175 Lisp_Object args
[3], msg
;
5177 struct gcpro gcpro1
;
5181 auto_save_error_occurred
= 1;
5183 ring_bell (XFRAME (selected_frame
));
5185 args
[0] = build_string ("Auto-saving %s: %s");
5186 args
[1] = BVAR (current_buffer
, name
);
5187 args
[2] = Ferror_message_string (error_val
);
5188 msg
= Fformat (3, args
);
5190 nbytes
= SBYTES (msg
);
5191 msgbuf
= SAFE_ALLOCA (nbytes
);
5192 memcpy (msgbuf
, SDATA (msg
), nbytes
);
5194 for (i
= 0; i
< 3; ++i
)
5197 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5199 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5200 Fsleep_for (make_number (1), Qnil
);
5214 auto_save_mode_bits
= 0666;
5216 /* Get visited file's mode to become the auto save file's mode. */
5217 if (! NILP (BVAR (current_buffer
, filename
)))
5219 if (stat (SSDATA (BVAR (current_buffer
, filename
)), &st
) >= 0)
5220 /* But make sure we can overwrite it later! */
5221 auto_save_mode_bits
= (st
.st_mode
| 0600) & 0777;
5222 else if ((modes
= Ffile_modes (BVAR (current_buffer
, filename
)),
5224 /* Remote files don't cooperate with stat. */
5225 auto_save_mode_bits
= (XINT (modes
) | 0600) & 0777;
5229 Fwrite_region (Qnil
, Qnil
, BVAR (current_buffer
, auto_save_file_name
), Qnil
,
5230 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5235 do_auto_save_unwind (Lisp_Object arg
) /* used as unwind-protect function */
5238 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5250 do_auto_save_unwind_1 (Lisp_Object value
) /* used as unwind-protect function */
5253 minibuffer_auto_raise
= XINT (value
);
5258 do_auto_save_make_dir (Lisp_Object dir
)
5262 auto_saving_dir_umask
= 077;
5263 result
= call2 (Qmake_directory
, dir
, Qt
);
5264 auto_saving_dir_umask
= 0;
5269 do_auto_save_eh (Lisp_Object ignore
)
5271 auto_saving_dir_umask
= 0;
5275 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5276 doc
: /* Auto-save all buffers that need it.
5277 This is all buffers that have auto-saving enabled
5278 and are changed since last auto-saved.
5279 Auto-saving writes the buffer into a file
5280 so that your editing is not lost if the system crashes.
5281 This file is not the file you visited; that changes only when you save.
5282 Normally we run the normal hook `auto-save-hook' before saving.
5284 A non-nil NO-MESSAGE argument means do not print any message if successful.
5285 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5286 (Lisp_Object no_message
, Lisp_Object current_only
)
5288 struct buffer
*old
= current_buffer
, *b
;
5289 Lisp_Object tail
, buf
, hook
;
5290 bool auto_saved
= 0;
5291 int do_handled_files
;
5293 FILE *stream
= NULL
;
5294 ptrdiff_t count
= SPECPDL_INDEX ();
5295 bool orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5296 bool old_message_p
= 0;
5297 struct gcpro gcpro1
, gcpro2
;
5299 if (max_specpdl_size
< specpdl_size
+ 40)
5300 max_specpdl_size
= specpdl_size
+ 40;
5305 if (NILP (no_message
))
5307 old_message_p
= push_message ();
5308 record_unwind_protect (pop_message_unwind
, Qnil
);
5311 /* Ordinarily don't quit within this function,
5312 but don't make it impossible to quit (in case we get hung in I/O). */
5316 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5317 point to non-strings reached from Vbuffer_alist. */
5319 hook
= intern ("auto-save-hook");
5320 Frun_hooks (1, &hook
);
5322 if (STRINGP (Vauto_save_list_file_name
))
5324 Lisp_Object listfile
;
5326 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5328 /* Don't try to create the directory when shutting down Emacs,
5329 because creating the directory might signal an error, and
5330 that would leave Emacs in a strange state. */
5331 if (!NILP (Vrun_hooks
))
5335 GCPRO2 (dir
, listfile
);
5336 dir
= Ffile_name_directory (listfile
);
5337 if (NILP (Ffile_directory_p (dir
)))
5338 internal_condition_case_1 (do_auto_save_make_dir
,
5344 stream
= fopen (SSDATA (listfile
), "w");
5347 record_unwind_protect (do_auto_save_unwind
,
5348 make_save_value (stream
, 0));
5349 record_unwind_protect (do_auto_save_unwind_1
,
5350 make_number (minibuffer_auto_raise
));
5351 minibuffer_auto_raise
= 0;
5353 auto_save_error_occurred
= 0;
5355 /* On first pass, save all files that don't have handlers.
5356 On second pass, save all files that do have handlers.
5358 If Emacs is crashing, the handlers may tweak what is causing
5359 Emacs to crash in the first place, and it would be a shame if
5360 Emacs failed to autosave perfectly ordinary files because it
5361 couldn't handle some ange-ftp'd file. */
5363 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5364 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5366 buf
= XCDR (XCAR (tail
));
5369 /* Record all the buffers that have auto save mode
5370 in the special file that lists them. For each of these buffers,
5371 Record visited name (if any) and auto save name. */
5372 if (STRINGP (BVAR (b
, auto_save_file_name
))
5373 && stream
!= NULL
&& do_handled_files
== 0)
5376 if (!NILP (BVAR (b
, filename
)))
5378 fwrite (SDATA (BVAR (b
, filename
)), 1,
5379 SBYTES (BVAR (b
, filename
)), stream
);
5381 putc ('\n', stream
);
5382 fwrite (SDATA (BVAR (b
, auto_save_file_name
)), 1,
5383 SBYTES (BVAR (b
, auto_save_file_name
)), stream
);
5384 putc ('\n', stream
);
5388 if (!NILP (current_only
)
5389 && b
!= current_buffer
)
5392 /* Don't auto-save indirect buffers.
5393 The base buffer takes care of it. */
5397 /* Check for auto save enabled
5398 and file changed since last auto save
5399 and file changed since last real save. */
5400 if (STRINGP (BVAR (b
, auto_save_file_name
))
5401 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5402 && BUF_AUTOSAVE_MODIFF (b
) < BUF_MODIFF (b
)
5403 /* -1 means we've turned off autosaving for a while--see below. */
5404 && XINT (BVAR (b
, save_length
)) >= 0
5405 && (do_handled_files
5406 || NILP (Ffind_file_name_handler (BVAR (b
, auto_save_file_name
),
5409 EMACS_TIME before_time
= current_emacs_time ();
5410 EMACS_TIME after_time
;
5412 /* If we had a failure, don't try again for 20 minutes. */
5413 if (b
->auto_save_failure_time
> 0
5414 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5417 set_buffer_internal (b
);
5418 if (NILP (Vauto_save_include_big_deletions
)
5419 && (XFASTINT (BVAR (b
, save_length
)) * 10
5420 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5421 /* A short file is likely to change a large fraction;
5422 spare the user annoying messages. */
5423 && XFASTINT (BVAR (b
, save_length
)) > 5000
5424 /* These messages are frequent and annoying for `*mail*'. */
5425 && !EQ (BVAR (b
, filename
), Qnil
)
5426 && NILP (no_message
))
5428 /* It has shrunk too much; turn off auto-saving here. */
5429 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5430 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5432 minibuffer_auto_raise
= 0;
5433 /* Turn off auto-saving until there's a real save,
5434 and prevent any more warnings. */
5435 XSETINT (BVAR (b
, save_length
), -1);
5436 Fsleep_for (make_number (1), Qnil
);
5439 if (!auto_saved
&& NILP (no_message
))
5440 message1 ("Auto-saving...");
5441 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5443 BUF_AUTOSAVE_MODIFF (b
) = BUF_MODIFF (b
);
5444 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5445 set_buffer_internal (old
);
5447 after_time
= current_emacs_time ();
5449 /* If auto-save took more than 60 seconds,
5450 assume it was an NFS failure that got a timeout. */
5451 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5452 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5456 /* Prevent another auto save till enough input events come in. */
5457 record_auto_save ();
5459 if (auto_saved
&& NILP (no_message
))
5463 /* If we are going to restore an old message,
5464 give time to read ours. */
5465 sit_for (make_number (1), 0, 0);
5468 else if (!auto_save_error_occurred
)
5469 /* Don't overwrite the error message if an error occurred.
5470 If we displayed a message and then restored a state
5471 with no message, leave a "done" message on the screen. */
5472 message1 ("Auto-saving...done");
5477 /* This restores the message-stack status. */
5478 unbind_to (count
, Qnil
);
5482 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5483 Sset_buffer_auto_saved
, 0, 0, 0,
5484 doc
: /* Mark current buffer as auto-saved with its current text.
5485 No auto-save file will be written until the buffer changes again. */)
5488 /* FIXME: This should not be called in indirect buffers, since
5489 they're not autosaved. */
5490 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
5491 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5492 current_buffer
->auto_save_failure_time
= 0;
5496 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5497 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5498 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5501 current_buffer
->auto_save_failure_time
= 0;
5505 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5507 doc
: /* Return t if current buffer has been auto-saved recently.
5508 More precisely, if it has been auto-saved since last read from or saved
5509 in the visited file. If the buffer has no visited file,
5510 then any auto-save counts as "recent". */)
5513 /* FIXME: maybe we should return nil for indirect buffers since
5514 they're never autosaved. */
5515 return (SAVE_MODIFF
< BUF_AUTOSAVE_MODIFF (current_buffer
) ? Qt
: Qnil
);
5518 /* Reading and completing file names */
5520 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5521 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5522 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5523 The return value is only relevant for a call to `read-file-name' that happens
5524 before any other event (mouse or keypress) is handled. */)
5527 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
5528 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5538 Fread_file_name (Lisp_Object prompt
, Lisp_Object dir
, Lisp_Object default_filename
, Lisp_Object mustmatch
, Lisp_Object initial
, Lisp_Object predicate
)
5540 struct gcpro gcpro1
;
5541 Lisp_Object args
[7];
5543 GCPRO1 (default_filename
);
5544 args
[0] = intern ("read-file-name");
5547 args
[3] = default_filename
;
5548 args
[4] = mustmatch
;
5550 args
[6] = predicate
;
5551 RETURN_UNGCPRO (Ffuncall (7, args
));
5556 syms_of_fileio (void)
5558 DEFSYM (Qoperations
, "operations");
5559 DEFSYM (Qexpand_file_name
, "expand-file-name");
5560 DEFSYM (Qsubstitute_in_file_name
, "substitute-in-file-name");
5561 DEFSYM (Qdirectory_file_name
, "directory-file-name");
5562 DEFSYM (Qfile_name_directory
, "file-name-directory");
5563 DEFSYM (Qfile_name_nondirectory
, "file-name-nondirectory");
5564 DEFSYM (Qunhandled_file_name_directory
, "unhandled-file-name-directory");
5565 DEFSYM (Qfile_name_as_directory
, "file-name-as-directory");
5566 DEFSYM (Qcopy_file
, "copy-file");
5567 DEFSYM (Qmake_directory_internal
, "make-directory-internal");
5568 DEFSYM (Qmake_directory
, "make-directory");
5569 DEFSYM (Qdelete_directory_internal
, "delete-directory-internal");
5570 DEFSYM (Qdelete_file
, "delete-file");
5571 DEFSYM (Qrename_file
, "rename-file");
5572 DEFSYM (Qadd_name_to_file
, "add-name-to-file");
5573 DEFSYM (Qmake_symbolic_link
, "make-symbolic-link");
5574 DEFSYM (Qfile_exists_p
, "file-exists-p");
5575 DEFSYM (Qfile_executable_p
, "file-executable-p");
5576 DEFSYM (Qfile_readable_p
, "file-readable-p");
5577 DEFSYM (Qfile_writable_p
, "file-writable-p");
5578 DEFSYM (Qfile_symlink_p
, "file-symlink-p");
5579 DEFSYM (Qaccess_file
, "access-file");
5580 DEFSYM (Qfile_directory_p
, "file-directory-p");
5581 DEFSYM (Qfile_regular_p
, "file-regular-p");
5582 DEFSYM (Qfile_accessible_directory_p
, "file-accessible-directory-p");
5583 DEFSYM (Qfile_modes
, "file-modes");
5584 DEFSYM (Qset_file_modes
, "set-file-modes");
5585 DEFSYM (Qset_file_times
, "set-file-times");
5586 DEFSYM (Qfile_selinux_context
, "file-selinux-context");
5587 DEFSYM (Qset_file_selinux_context
, "set-file-selinux-context");
5588 DEFSYM (Qfile_newer_than_file_p
, "file-newer-than-file-p");
5589 DEFSYM (Qinsert_file_contents
, "insert-file-contents");
5590 DEFSYM (Qwrite_region
, "write-region");
5591 DEFSYM (Qverify_visited_file_modtime
, "verify-visited-file-modtime");
5592 DEFSYM (Qset_visited_file_modtime
, "set-visited-file-modtime");
5593 DEFSYM (Qauto_save_coding
, "auto-save-coding");
5595 DEFSYM (Qfile_name_history
, "file-name-history");
5596 Fset (Qfile_name_history
, Qnil
);
5598 DEFSYM (Qfile_error
, "file-error");
5599 DEFSYM (Qfile_already_exists
, "file-already-exists");
5600 DEFSYM (Qfile_date_error
, "file-date-error");
5601 DEFSYM (Qexcl
, "excl");
5603 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system
,
5604 doc
: /* Coding system for encoding file names.
5605 If it is nil, `default-file-name-coding-system' (which see) is used. */);
5606 Vfile_name_coding_system
= Qnil
;
5608 DEFVAR_LISP ("default-file-name-coding-system",
5609 Vdefault_file_name_coding_system
,
5610 doc
: /* Default coding system for encoding file names.
5611 This variable is used only when `file-name-coding-system' is nil.
5613 This variable is set/changed by the command `set-language-environment'.
5614 User should not set this variable manually,
5615 instead use `file-name-coding-system' to get a constant encoding
5616 of file names regardless of the current language environment. */);
5617 Vdefault_file_name_coding_system
= Qnil
;
5619 DEFSYM (Qformat_decode
, "format-decode");
5620 DEFSYM (Qformat_annotate_function
, "format-annotate-function");
5621 DEFSYM (Qafter_insert_file_set_coding
, "after-insert-file-set-coding");
5622 DEFSYM (Qcar_less_than_car
, "car-less-than-car");
5624 Fput (Qfile_error
, Qerror_conditions
,
5625 Fpurecopy (list2 (Qfile_error
, Qerror
)));
5626 Fput (Qfile_error
, Qerror_message
,
5627 build_pure_c_string ("File error"));
5629 Fput (Qfile_already_exists
, Qerror_conditions
,
5630 Fpurecopy (list3 (Qfile_already_exists
, Qfile_error
, Qerror
)));
5631 Fput (Qfile_already_exists
, Qerror_message
,
5632 build_pure_c_string ("File already exists"));
5634 Fput (Qfile_date_error
, Qerror_conditions
,
5635 Fpurecopy (list3 (Qfile_date_error
, Qfile_error
, Qerror
)));
5636 Fput (Qfile_date_error
, Qerror_message
,
5637 build_pure_c_string ("Cannot set file date"));
5639 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist
,
5640 doc
: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
5641 If a file name matches REGEXP, all I/O on that file is done by calling
5642 HANDLER. If a file name matches more than one handler, the handler
5643 whose match starts last in the file name gets precedence. The
5644 function `find-file-name-handler' checks this list for a handler for
5647 HANDLER should be a function. The first argument given to it is the
5648 name of the I/O primitive to be handled; the remaining arguments are
5649 the arguments that were passed to that primitive. For example, if you
5650 do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
5651 HANDLER is called like this:
5653 (funcall HANDLER 'file-exists-p FILENAME)
5655 Note that HANDLER must be able to handle all I/O primitives; if it has
5656 nothing special to do for a primitive, it should reinvoke the
5657 primitive to handle the operation \"the usual way\".
5658 See Info node `(elisp)Magic File Names' for more details. */);
5659 Vfile_name_handler_alist
= Qnil
;
5661 DEFVAR_LISP ("set-auto-coding-function",
5662 Vset_auto_coding_function
,
5663 doc
: /* If non-nil, a function to call to decide a coding system of file.
5664 Two arguments are passed to this function: the file name
5665 and the length of a file contents following the point.
5666 This function should return a coding system to decode the file contents.
5667 It should check the file name against `auto-coding-alist'.
5668 If no coding system is decided, it should check a coding system
5669 specified in the heading lines with the format:
5670 -*- ... coding: CODING-SYSTEM; ... -*-
5671 or local variable spec of the tailing lines with `coding:' tag. */);
5672 Vset_auto_coding_function
= Qnil
;
5674 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions
,
5675 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
5676 Each is passed one argument, the number of characters inserted,
5677 with point at the start of the inserted text. Each function
5678 should leave point the same, and return the new character count.
5679 If `insert-file-contents' is intercepted by a handler from
5680 `file-name-handler-alist', that handler is responsible for calling the
5681 functions in `after-insert-file-functions' if appropriate. */);
5682 Vafter_insert_file_functions
= Qnil
;
5684 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions
,
5685 doc
: /* A list of functions to be called at the start of `write-region'.
5686 Each is passed two arguments, START and END as for `write-region'.
5687 These are usually two numbers but not always; see the documentation
5688 for `write-region'. The function should return a list of pairs
5689 of the form (POSITION . STRING), consisting of strings to be effectively
5690 inserted at the specified positions of the file being written (1 means to
5691 insert before the first byte written). The POSITIONs must be sorted into
5694 If there are several annotation functions, the lists returned by these
5695 functions are merged destructively. As each annotation function runs,
5696 the variable `write-region-annotations-so-far' contains a list of all
5697 annotations returned by previous annotation functions.
5699 An annotation function can return with a different buffer current.
5700 Doing so removes the annotations returned by previous functions, and
5701 resets START and END to `point-min' and `point-max' of the new buffer.
5703 After `write-region' completes, Emacs calls the function stored in
5704 `write-region-post-annotation-function', once for each buffer that was
5705 current when building the annotations (i.e., at least once), with that
5706 buffer current. */);
5707 Vwrite_region_annotate_functions
= Qnil
;
5708 DEFSYM (Qwrite_region_annotate_functions
, "write-region-annotate-functions");
5710 DEFVAR_LISP ("write-region-post-annotation-function",
5711 Vwrite_region_post_annotation_function
,
5712 doc
: /* Function to call after `write-region' completes.
5713 The function is called with no arguments. If one or more of the
5714 annotation functions in `write-region-annotate-functions' changed the
5715 current buffer, the function stored in this variable is called for
5716 each of those additional buffers as well, in addition to the original
5717 buffer. The relevant buffer is current during each function call. */);
5718 Vwrite_region_post_annotation_function
= Qnil
;
5719 staticpro (&Vwrite_region_annotation_buffers
);
5721 DEFVAR_LISP ("write-region-annotations-so-far",
5722 Vwrite_region_annotations_so_far
,
5723 doc
: /* When an annotation function is called, this holds the previous annotations.
5724 These are the annotations made by other annotation functions
5725 that were already called. See also `write-region-annotate-functions'. */);
5726 Vwrite_region_annotations_so_far
= Qnil
;
5728 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers
,
5729 doc
: /* A list of file name handlers that temporarily should not be used.
5730 This applies only to the operation `inhibit-file-name-operation'. */);
5731 Vinhibit_file_name_handlers
= Qnil
;
5733 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation
,
5734 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5735 Vinhibit_file_name_operation
= Qnil
;
5737 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name
,
5738 doc
: /* File name in which we write a list of all auto save file names.
5739 This variable is initialized automatically from `auto-save-list-file-prefix'
5740 shortly after Emacs reads your `.emacs' file, if you have not yet given it
5741 a non-nil value. */);
5742 Vauto_save_list_file_name
= Qnil
;
5744 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name
,
5745 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
5746 Normally auto-save files are written under other names. */);
5747 Vauto_save_visited_file_name
= Qnil
;
5749 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions
,
5750 doc
: /* If non-nil, auto-save even if a large part of the text is deleted.
5751 If nil, deleting a substantial portion of the text disables auto-save
5752 in the buffer; this is the default behavior, because the auto-save
5753 file is usually more useful if it contains the deleted text. */);
5754 Vauto_save_include_big_deletions
= Qnil
;
5757 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync
,
5758 doc
: /* Non-nil means don't call fsync in `write-region'.
5759 This variable affects calls to `write-region' as well as save commands.
5760 A non-nil value may result in data loss! */);
5761 write_region_inhibit_fsync
= 0;
5764 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash
,
5765 doc
: /* Specifies whether to use the system's trash can.
5766 When non-nil, certain file deletion commands use the function
5767 `move-file-to-trash' instead of deleting files outright.
5768 This includes interactive calls to `delete-file' and
5769 `delete-directory' and the Dired deletion commands. */);
5770 delete_by_moving_to_trash
= 0;
5771 Qdelete_by_moving_to_trash
= intern_c_string ("delete-by-moving-to-trash");
5773 DEFSYM (Qmove_file_to_trash
, "move-file-to-trash");
5774 DEFSYM (Qcopy_directory
, "copy-directory");
5775 DEFSYM (Qdelete_directory
, "delete-directory");
5777 defsubr (&Sfind_file_name_handler
);
5778 defsubr (&Sfile_name_directory
);
5779 defsubr (&Sfile_name_nondirectory
);
5780 defsubr (&Sunhandled_file_name_directory
);
5781 defsubr (&Sfile_name_as_directory
);
5782 defsubr (&Sdirectory_file_name
);
5783 defsubr (&Smake_temp_name
);
5784 defsubr (&Sexpand_file_name
);
5785 defsubr (&Ssubstitute_in_file_name
);
5786 defsubr (&Scopy_file
);
5787 defsubr (&Smake_directory_internal
);
5788 defsubr (&Sdelete_directory_internal
);
5789 defsubr (&Sdelete_file
);
5790 defsubr (&Srename_file
);
5791 defsubr (&Sadd_name_to_file
);
5792 defsubr (&Smake_symbolic_link
);
5793 defsubr (&Sfile_name_absolute_p
);
5794 defsubr (&Sfile_exists_p
);
5795 defsubr (&Sfile_executable_p
);
5796 defsubr (&Sfile_readable_p
);
5797 defsubr (&Sfile_writable_p
);
5798 defsubr (&Saccess_file
);
5799 defsubr (&Sfile_symlink_p
);
5800 defsubr (&Sfile_directory_p
);
5801 defsubr (&Sfile_accessible_directory_p
);
5802 defsubr (&Sfile_regular_p
);
5803 defsubr (&Sfile_modes
);
5804 defsubr (&Sset_file_modes
);
5805 defsubr (&Sset_file_times
);
5806 defsubr (&Sfile_selinux_context
);
5807 defsubr (&Sset_file_selinux_context
);
5808 defsubr (&Sset_default_file_modes
);
5809 defsubr (&Sdefault_file_modes
);
5810 defsubr (&Sfile_newer_than_file_p
);
5811 defsubr (&Sinsert_file_contents
);
5812 defsubr (&Swrite_region
);
5813 defsubr (&Scar_less_than_car
);
5814 defsubr (&Sverify_visited_file_modtime
);
5815 defsubr (&Sclear_visited_file_modtime
);
5816 defsubr (&Svisited_file_modtime
);
5817 defsubr (&Sset_visited_file_modtime
);
5818 defsubr (&Sdo_auto_save
);
5819 defsubr (&Sset_buffer_auto_saved
);
5820 defsubr (&Sclear_buffer_auto_save_failure
);
5821 defsubr (&Srecent_auto_save_p
);
5823 defsubr (&Snext_read_file_uses_dialog_p
);
5826 defsubr (&Sunix_sync
);