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>
36 #ifdef HAVE_LIBSELINUX
37 #include <selinux/selinux.h>
38 #include <selinux/context.h>
42 #include "intervals.h"
43 #include "character.h"
47 #include "blockinput.h"
49 #include "dispextern.h"
55 #endif /* not WINDOWSNT */
59 #include <sys/param.h>
64 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
65 redirector allows the six letters between 'Z' and 'a' as well. */
67 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
70 #define IS_DRIVE(x) isalpha ((unsigned char) (x))
72 /* Need to lower-case the drive letter, or else expanded
73 filenames will sometimes compare unequal, because
74 `expand-file-name' doesn't always down-case the drive letter. */
75 #define DRIVE_LETTER(x) (tolower ((unsigned char) (x)))
79 #include <stat-time.h>
87 #ifndef FILE_SYSTEM_CASE
88 #define FILE_SYSTEM_CASE(filename) (filename)
91 /* Nonzero during writing of auto-save files. */
92 static int auto_saving
;
94 /* Nonzero umask during creation of auto-save directories. */
95 static int auto_saving_dir_umask
;
97 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
98 a new file with the same mode as the original. */
99 static int auto_save_mode_bits
;
101 /* Set by auto_save_1 if an error occurred during the last auto-save. */
102 static int auto_save_error_occurred
;
104 /* The symbol bound to coding-system-for-read when
105 insert-file-contents is called for recovering a file. This is not
106 an actual coding system name, but just an indicator to tell
107 insert-file-contents to use `emacs-mule' with a special flag for
108 auto saving and recovering a file. */
109 static Lisp_Object Qauto_save_coding
;
111 /* Property name of a file name handler,
112 which gives a list of operations it handles.. */
113 static Lisp_Object Qoperations
;
115 /* Lisp functions for translating file formats. */
116 static Lisp_Object Qformat_decode
, Qformat_annotate_function
;
118 /* Lisp function for setting buffer-file-coding-system and the
119 multibyteness of the current buffer after inserting a file. */
120 static Lisp_Object Qafter_insert_file_set_coding
;
122 static Lisp_Object Qwrite_region_annotate_functions
;
123 /* Each time an annotation function changes the buffer, the new buffer
125 static Lisp_Object Vwrite_region_annotation_buffers
;
130 static Lisp_Object Qdelete_by_moving_to_trash
;
132 /* Lisp function for moving files to trash. */
133 static Lisp_Object Qmove_file_to_trash
;
135 /* Lisp function for recursively copying directories. */
136 static Lisp_Object Qcopy_directory
;
138 /* Lisp function for recursively deleting directories. */
139 static Lisp_Object Qdelete_directory
;
144 Lisp_Object Qfile_error
;
145 static Lisp_Object Qfile_already_exists
, Qfile_date_error
;
146 static Lisp_Object Qexcl
;
147 Lisp_Object Qfile_name_history
;
149 static Lisp_Object Qcar_less_than_car
;
151 static int a_write (int, Lisp_Object
, ptrdiff_t, ptrdiff_t,
152 Lisp_Object
*, struct coding_system
*);
153 static int e_write (int, Lisp_Object
, ptrdiff_t, ptrdiff_t,
154 struct coding_system
*);
158 report_file_error (const char *string
, Lisp_Object data
)
160 Lisp_Object errstring
;
164 synchronize_system_messages_locale ();
165 str
= strerror (errorno
);
166 errstring
= code_convert_string_norecord (make_unibyte_string (str
,
168 Vlocale_coding_system
, 0);
174 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
177 /* System error messages are capitalized. Downcase the initial
178 unless it is followed by a slash. (The slash case caters to
179 error messages that begin with "I/O" or, in German, "E/A".) */
180 if (STRING_MULTIBYTE (errstring
)
181 && ! EQ (Faref (errstring
, make_number (1)), make_number ('/')))
185 str
= SSDATA (errstring
);
186 c
= STRING_CHAR ((unsigned char *) str
);
187 Faset (errstring
, make_number (0), make_number (downcase (c
)));
190 xsignal (Qfile_error
,
191 Fcons (build_string (string
), Fcons (errstring
, data
)));
196 close_file_unwind (Lisp_Object fd
)
198 emacs_close (XFASTINT (fd
));
202 /* Restore point, having saved it as a marker. */
205 restore_point_unwind (Lisp_Object location
)
207 Fgoto_char (location
);
208 Fset_marker (location
, Qnil
, Qnil
);
213 static Lisp_Object Qexpand_file_name
;
214 static Lisp_Object Qsubstitute_in_file_name
;
215 static Lisp_Object Qdirectory_file_name
;
216 static Lisp_Object Qfile_name_directory
;
217 static Lisp_Object Qfile_name_nondirectory
;
218 static Lisp_Object Qunhandled_file_name_directory
;
219 static Lisp_Object Qfile_name_as_directory
;
220 static Lisp_Object Qcopy_file
;
221 static Lisp_Object Qmake_directory_internal
;
222 static Lisp_Object Qmake_directory
;
223 static Lisp_Object Qdelete_directory_internal
;
224 Lisp_Object Qdelete_file
;
225 static Lisp_Object Qrename_file
;
226 static Lisp_Object Qadd_name_to_file
;
227 static Lisp_Object Qmake_symbolic_link
;
228 Lisp_Object Qfile_exists_p
;
229 static Lisp_Object Qfile_executable_p
;
230 static Lisp_Object Qfile_readable_p
;
231 static Lisp_Object Qfile_writable_p
;
232 static Lisp_Object Qfile_symlink_p
;
233 static Lisp_Object Qaccess_file
;
234 Lisp_Object Qfile_directory_p
;
235 static Lisp_Object Qfile_regular_p
;
236 static Lisp_Object Qfile_accessible_directory_p
;
237 static Lisp_Object Qfile_modes
;
238 static Lisp_Object Qset_file_modes
;
239 static Lisp_Object Qset_file_times
;
240 static Lisp_Object Qfile_selinux_context
;
241 static Lisp_Object Qset_file_selinux_context
;
242 static Lisp_Object Qfile_newer_than_file_p
;
243 Lisp_Object Qinsert_file_contents
;
244 Lisp_Object Qwrite_region
;
245 static Lisp_Object Qverify_visited_file_modtime
;
246 static Lisp_Object Qset_visited_file_modtime
;
248 DEFUN ("find-file-name-handler", Ffind_file_name_handler
,
249 Sfind_file_name_handler
, 2, 2, 0,
250 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
251 Otherwise, return nil.
252 A file name is handled if one of the regular expressions in
253 `file-name-handler-alist' matches it.
255 If OPERATION equals `inhibit-file-name-operation', then we ignore
256 any handlers that are members of `inhibit-file-name-handlers',
257 but we still do run any other handlers. This lets handlers
258 use the standard functions without calling themselves recursively. */)
259 (Lisp_Object filename
, Lisp_Object operation
)
261 /* This function must not munge the match data. */
262 Lisp_Object chain
, inhibited_handlers
, result
;
266 CHECK_STRING (filename
);
268 if (EQ (operation
, Vinhibit_file_name_operation
))
269 inhibited_handlers
= Vinhibit_file_name_handlers
;
271 inhibited_handlers
= Qnil
;
273 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
274 chain
= XCDR (chain
))
280 Lisp_Object string
= XCAR (elt
);
282 Lisp_Object handler
= XCDR (elt
);
283 Lisp_Object operations
= Qnil
;
285 if (SYMBOLP (handler
))
286 operations
= Fget (handler
, Qoperations
);
289 && (match_pos
= fast_string_match (string
, filename
)) > pos
290 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
294 handler
= XCDR (elt
);
295 tem
= Fmemq (handler
, inhibited_handlers
);
309 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
311 doc
: /* Return the directory component in file name FILENAME.
312 Return nil if FILENAME does not include a directory.
313 Otherwise return a directory name.
314 Given a Unix syntax file name, returns a string ending in slash. */)
315 (Lisp_Object filename
)
318 register const char *beg
;
322 register const char *p
;
325 CHECK_STRING (filename
);
327 /* If the file name has special constructs in it,
328 call the corresponding file handler. */
329 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
332 Lisp_Object handled_name
= call2 (handler
, Qfile_name_directory
,
334 return STRINGP (handled_name
) ? handled_name
: Qnil
;
337 filename
= FILE_SYSTEM_CASE (filename
);
339 beg
= alloca (SBYTES (filename
) + 1);
340 memcpy (beg
, SSDATA (filename
), SBYTES (filename
) + 1);
342 beg
= SSDATA (filename
);
344 p
= beg
+ SBYTES (filename
);
346 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
348 /* only recognize drive specifier at the beginning */
350 /* handle the "/:d:foo" and "/:foo" cases correctly */
351 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
352 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
359 /* Expansion of "c:" to drive and default directory. */
362 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
363 char *res
= alloca (MAXPATHLEN
+ 1);
366 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
368 memcpy (res
, beg
, 2);
373 if (getdefdir (toupper ((unsigned char) *beg
) - 'A' + 1, r
))
375 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
378 p
= beg
+ strlen (beg
);
381 dostounix_filename (beg
);
384 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
387 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
388 Sfile_name_nondirectory
, 1, 1, 0,
389 doc
: /* Return file name FILENAME sans its directory.
390 For example, in a Unix-syntax file name,
391 this is everything after the last slash,
392 or the entire name if it contains no slash. */)
393 (Lisp_Object filename
)
395 register const char *beg
, *p
, *end
;
398 CHECK_STRING (filename
);
400 /* If the file name has special constructs in it,
401 call the corresponding file handler. */
402 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
405 Lisp_Object handled_name
= call2 (handler
, Qfile_name_nondirectory
,
407 if (STRINGP (handled_name
))
409 error ("Invalid handler in `file-name-handler-alist'");
412 beg
= SSDATA (filename
);
413 end
= p
= beg
+ SBYTES (filename
);
415 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
417 /* only recognize drive specifier at beginning */
419 /* handle the "/:d:foo" case correctly */
420 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
425 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
428 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
429 Sunhandled_file_name_directory
, 1, 1, 0,
430 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
431 A `directly usable' directory name is one that may be used without the
432 intervention of any file handler.
433 If FILENAME is a directly usable file itself, return
434 \(file-name-directory FILENAME).
435 If FILENAME refers to a file which is not accessible from a local process,
436 then this should return nil.
437 The `call-process' and `start-process' functions use this function to
438 get a current directory to run processes in. */)
439 (Lisp_Object filename
)
443 /* If the file name has special constructs in it,
444 call the corresponding file handler. */
445 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
448 Lisp_Object handled_name
= call2 (handler
, Qunhandled_file_name_directory
,
450 return STRINGP (handled_name
) ? handled_name
: Qnil
;
453 return Ffile_name_directory (filename
);
456 /* Convert from file name SRC of length SRCLEN to directory name
457 in DST. On UNIX, just make sure there is a terminating /.
458 Return the length of DST. */
461 file_name_as_directory (char *dst
, const char *src
, ptrdiff_t srclen
)
473 if (!IS_DIRECTORY_SEP (dst
[srclen
- 1]))
475 dst
[srclen
] = DIRECTORY_SEP
;
476 dst
[srclen
+ 1] = '\0';
480 dostounix_filename (dst
);
485 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
486 Sfile_name_as_directory
, 1, 1, 0,
487 doc
: /* Return a string representing the file name FILE interpreted as a directory.
488 This operation exists because a directory is also a file, but its name as
489 a directory is different from its name as a file.
490 The result can be used as the value of `default-directory'
491 or passed as second argument to `expand-file-name'.
492 For a Unix-syntax file name, just appends a slash. */)
503 /* If the file name has special constructs in it,
504 call the corresponding file handler. */
505 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
508 Lisp_Object handled_name
= call2 (handler
, Qfile_name_as_directory
,
510 if (STRINGP (handled_name
))
512 error ("Invalid handler in `file-name-handler-alist'");
515 buf
= alloca (SBYTES (file
) + 10);
516 length
= file_name_as_directory (buf
, SSDATA (file
), SBYTES (file
));
517 return make_specified_string (buf
, -1, length
, STRING_MULTIBYTE (file
));
520 /* Convert from directory name SRC of length SRCLEN to
521 file name in DST. On UNIX, just make sure there isn't
522 a terminating /. Return the length of DST. */
525 directory_file_name (char *dst
, char *src
, ptrdiff_t srclen
)
527 /* Process as Unix format: just remove any final slash.
528 But leave "/" unchanged; do not change it to "". */
531 && IS_DIRECTORY_SEP (dst
[srclen
- 1])
533 && !IS_ANY_SEP (dst
[srclen
- 2])
541 dostounix_filename (dst
);
546 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
548 doc
: /* Returns the file name of the directory named DIRECTORY.
549 This is the name of the file that holds the data for the directory DIRECTORY.
550 This operation exists because a directory is also a file, but its name as
551 a directory is different from its name as a file.
552 In Unix-syntax, this function just removes the final slash. */)
553 (Lisp_Object directory
)
559 CHECK_STRING (directory
);
561 if (NILP (directory
))
564 /* If the file name has special constructs in it,
565 call the corresponding file handler. */
566 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
569 Lisp_Object handled_name
= call2 (handler
, Qdirectory_file_name
,
571 if (STRINGP (handled_name
))
573 error ("Invalid handler in `file-name-handler-alist'");
576 buf
= alloca (SBYTES (directory
) + 20);
577 length
= directory_file_name (buf
, SSDATA (directory
), SBYTES (directory
));
578 return make_specified_string (buf
, -1, length
, STRING_MULTIBYTE (directory
));
581 static const char make_temp_name_tbl
[64] =
583 'A','B','C','D','E','F','G','H',
584 'I','J','K','L','M','N','O','P',
585 'Q','R','S','T','U','V','W','X',
586 'Y','Z','a','b','c','d','e','f',
587 'g','h','i','j','k','l','m','n',
588 'o','p','q','r','s','t','u','v',
589 'w','x','y','z','0','1','2','3',
590 '4','5','6','7','8','9','-','_'
593 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
595 /* Value is a temporary file name starting with PREFIX, a string.
597 The Emacs process number forms part of the result, so there is
598 no danger of generating a name being used by another process.
599 In addition, this function makes an attempt to choose a name
600 which has no existing file. To make this work, PREFIX should be
601 an absolute file name.
603 BASE64_P non-zero means add the pid as 3 characters in base64
604 encoding. In this case, 6 characters will be added to PREFIX to
605 form the file name. Otherwise, if Emacs is running on a system
606 with long file names, add the pid as a decimal number.
608 This function signals an error if no unique file name could be
612 make_temp_name (Lisp_Object prefix
, int base64_p
)
618 char pidbuf
[INT_BUFSIZE_BOUND (printmax_t
)];
621 CHECK_STRING (prefix
);
623 /* VAL is created by adding 6 characters to PREFIX. The first
624 three are the PID of this process, in base 64, and the second
625 three are incremented if the file already exists. This ensures
626 262144 unique file names per PID per PREFIX. */
632 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
633 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
634 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
639 #ifdef HAVE_LONG_FILE_NAMES
640 pidlen
= sprintf (pidbuf
, "%"pMd
, pid
);
642 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
643 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
644 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
649 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
650 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
651 if (!STRING_MULTIBYTE (prefix
))
652 STRING_SET_UNIBYTE (val
);
654 memcpy (data
, SSDATA (prefix
), len
);
657 memcpy (p
, pidbuf
, pidlen
);
660 /* Here we try to minimize useless stat'ing when this function is
661 invoked many times successively with the same PREFIX. We achieve
662 this by initializing count to a random value, and incrementing it
665 We don't want make-temp-name to be called while dumping,
666 because then make_temp_name_count_initialized_p would get set
667 and then make_temp_name_count would not be set when Emacs starts. */
669 if (!make_temp_name_count_initialized_p
)
671 make_temp_name_count
= time (NULL
);
672 make_temp_name_count_initialized_p
= 1;
678 unsigned num
= make_temp_name_count
;
680 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
681 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
682 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
684 /* Poor man's congruential RN generator. Replace with
685 ++make_temp_name_count for debugging. */
686 make_temp_name_count
+= 25229;
687 make_temp_name_count
%= 225307;
689 if (stat (data
, &ignored
) < 0)
691 /* We want to return only if errno is ENOENT. */
695 /* The error here is dubious, but there is little else we
696 can do. The alternatives are to return nil, which is
697 as bad as (and in many cases worse than) throwing the
698 error, or to ignore the error, which will likely result
699 in looping through 225307 stat's, which is not only
700 dog-slow, but also useless since eventually nil would
701 have to be returned anyway. */
702 report_file_error ("Cannot create temporary name for prefix",
703 Fcons (prefix
, Qnil
));
710 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
711 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
712 The Emacs process number forms part of the result,
713 so there is no danger of generating a name being used by another process.
715 In addition, this function makes an attempt to choose a name
716 which has no existing file. To make this work,
717 PREFIX should be an absolute file name.
719 There is a race condition between calling `make-temp-name' and creating the
720 file which opens all kinds of security holes. For that reason, you should
721 probably use `make-temp-file' instead, except in three circumstances:
723 * If you are creating the file in the user's home directory.
724 * If you are creating a directory rather than an ordinary file.
725 * If you are taking special precautions as `make-temp-file' does. */)
728 return make_temp_name (prefix
, 0);
733 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
734 doc
: /* Convert filename NAME to absolute, and canonicalize it.
735 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
736 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
737 the current buffer's value of `default-directory' is used.
738 NAME should be a string that is a valid file name for the underlying
740 File name components that are `.' are removed, and
741 so are file name components followed by `..', along with the `..' itself;
742 note that these simplifications are done without checking the resulting
743 file names in the file system.
744 Multiple consecutive slashes are collapsed into a single slash,
745 except at the beginning of the file name when they are significant (e.g.,
746 UNC file names on MS-Windows.)
747 An initial `~/' expands to your home directory.
748 An initial `~USER/' expands to USER's home directory.
749 See also the function `substitute-in-file-name'.
751 For technical reasons, this function can return correct but
752 non-intuitive results for the root directory; for instance,
753 \(expand-file-name ".." "/") returns "/..". For this reason, use
754 \(directory-file-name (file-name-directory dirname)) to traverse a
755 filesystem tree, not (expand-file-name ".." dirname). */)
756 (Lisp_Object name
, Lisp_Object default_directory
)
758 /* These point to SDATA and need to be careful with string-relocation
759 during GC (via DECODE_FILE). */
762 /* This should only point to alloca'd data. */
769 int collapse_newdir
= 1;
773 Lisp_Object handler
, result
, handled_name
;
779 /* If the file name has special constructs in it,
780 call the corresponding file handler. */
781 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
784 handled_name
= call3 (handler
, Qexpand_file_name
,
785 name
, default_directory
);
786 if (STRINGP (handled_name
))
788 error ("Invalid handler in `file-name-handler-alist'");
792 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
793 if (NILP (default_directory
))
794 default_directory
= BVAR (current_buffer
, directory
);
795 if (! STRINGP (default_directory
))
798 /* "/" is not considered a root directory on DOS_NT, so using "/"
799 here causes an infinite recursion in, e.g., the following:
801 (let (default-directory)
802 (expand-file-name "a"))
804 To avoid this, we set default_directory to the root of the
806 default_directory
= build_string (emacs_root_dir ());
808 default_directory
= build_string ("/");
812 if (!NILP (default_directory
))
814 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
817 handled_name
= call3 (handler
, Qexpand_file_name
,
818 name
, default_directory
);
819 if (STRINGP (handled_name
))
821 error ("Invalid handler in `file-name-handler-alist'");
826 char *o
= SSDATA (default_directory
);
828 /* Make sure DEFAULT_DIRECTORY is properly expanded.
829 It would be better to do this down below where we actually use
830 default_directory. Unfortunately, calling Fexpand_file_name recursively
831 could invoke GC, and the strings might be relocated. This would
832 be annoying because we have pointers into strings lying around
833 that would need adjusting, and people would add new pointers to
834 the code and forget to adjust them, resulting in intermittent bugs.
835 Putting this call here avoids all that crud.
837 The EQ test avoids infinite recursion. */
838 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
839 /* Save time in some common cases - as long as default_directory
840 is not relative, it can be canonicalized with name below (if it
841 is needed at all) without requiring it to be expanded now. */
843 /* Detect MSDOS file names with drive specifiers. */
844 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
845 && IS_DIRECTORY_SEP (o
[2]))
847 /* Detect Windows file names in UNC format. */
848 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
850 #else /* not DOS_NT */
851 /* Detect Unix absolute file names (/... alone is not absolute on
853 && ! (IS_DIRECTORY_SEP (o
[0]))
854 #endif /* not DOS_NT */
860 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
864 name
= FILE_SYSTEM_CASE (name
);
865 multibyte
= STRING_MULTIBYTE (name
);
866 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
869 default_directory
= string_to_multibyte (default_directory
);
872 name
= string_to_multibyte (name
);
877 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
878 nm
= alloca (SBYTES (name
) + 1);
879 memcpy (nm
, SSDATA (name
), SBYTES (name
) + 1);
882 /* Note if special escape prefix is present, but remove for now. */
883 if (nm
[0] == '/' && nm
[1] == ':')
889 /* Find and remove drive specifier if present; this makes nm absolute
890 even if the rest of the name appears to be relative. Only look for
891 drive specifier at the beginning. */
892 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
894 drive
= (unsigned char) nm
[0];
899 /* If we see "c://somedir", we want to strip the first slash after the
900 colon when stripping the drive letter. Otherwise, this expands to
902 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
905 /* Discard any previous drive specifier if nm is now in UNC format. */
906 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
910 #endif /* WINDOWSNT */
913 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
914 none are found, we can probably return right away. We will avoid
915 allocating a new string if name is already fully expanded. */
917 IS_DIRECTORY_SEP (nm
[0])
919 && drive
&& !is_escaped
922 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
926 /* If it turns out that the filename we want to return is just a
927 suffix of FILENAME, we don't need to go through and edit
928 things; we just need to construct a new string using data
929 starting at the middle of FILENAME. If we set lose to a
930 non-zero value, that means we've discovered that we can't do
937 /* Since we know the name is absolute, we can assume that each
938 element starts with a "/". */
940 /* "." and ".." are hairy. */
941 if (IS_DIRECTORY_SEP (p
[0])
943 && (IS_DIRECTORY_SEP (p
[2])
945 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
948 /* We want to replace multiple `/' in a row with a single
951 && IS_DIRECTORY_SEP (p
[0])
952 && IS_DIRECTORY_SEP (p
[1]))
959 /* Make sure directories are all separated with /, but
960 avoid allocation of a new string when not required. */
961 dostounix_filename (nm
);
963 if (IS_DIRECTORY_SEP (nm
[1]))
965 if (strcmp (nm
, SSDATA (name
)) != 0)
966 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
970 /* Drive must be set, so this is okay. */
971 if (strcmp (nm
- 2, SSDATA (name
)) != 0)
975 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
976 temp
[0] = DRIVE_LETTER (drive
);
977 name
= concat2 (build_string (temp
), name
);
980 #else /* not DOS_NT */
981 if (strcmp (nm
, SSDATA (name
)) == 0)
983 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
984 #endif /* not DOS_NT */
988 /* At this point, nm might or might not be an absolute file name. We
989 need to expand ~ or ~user if present, otherwise prefix nm with
990 default_directory if nm is not absolute, and finally collapse /./
991 and /foo/../ sequences.
993 We set newdir to be the appropriate prefix if one is needed:
994 - the relevant user directory if nm starts with ~ or ~user
995 - the specified drive's working dir (DOS/NT only) if nm does not
997 - the value of default_directory.
999 Note that these prefixes are not guaranteed to be absolute (except
1000 for the working dir of a drive). Therefore, to ensure we always
1001 return an absolute name, if the final prefix is not absolute we
1002 append it to the current working directory. */
1006 if (nm
[0] == '~') /* prefix ~ */
1008 if (IS_DIRECTORY_SEP (nm
[1])
1009 || nm
[1] == 0) /* ~ by itself */
1013 if (!(newdir
= egetenv ("HOME")))
1016 /* `egetenv' may return a unibyte string, which will bite us since
1017 we expect the directory to be multibyte. */
1018 tem
= build_string (newdir
);
1019 if (!STRING_MULTIBYTE (tem
))
1021 hdir
= DECODE_FILE (tem
);
1022 newdir
= SSDATA (hdir
);
1025 collapse_newdir
= 0;
1028 else /* ~user/filename */
1031 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)); p
++);
1032 o
= alloca (p
- nm
+ 1);
1033 memcpy (o
, nm
, p
- nm
);
1037 pw
= (struct passwd
*) getpwnam (o
+ 1);
1041 newdir
= pw
->pw_dir
;
1044 collapse_newdir
= 0;
1048 /* If we don't find a user of that name, leave the name
1049 unchanged; don't move nm forward to p. */
1054 /* On DOS and Windows, nm is absolute if a drive name was specified;
1055 use the drive's current directory as the prefix if needed. */
1056 if (!newdir
&& drive
)
1058 /* Get default directory if needed to make nm absolute. */
1060 if (!IS_DIRECTORY_SEP (nm
[0]))
1062 adir
= alloca (MAXPATHLEN
+ 1);
1063 if (!getdefdir (toupper (drive
) - 'A' + 1, adir
))
1068 /* Either nm starts with /, or drive isn't mounted. */
1070 adir
[0] = DRIVE_LETTER (drive
);
1079 /* Finally, if no prefix has been specified and nm is not absolute,
1080 then it must be expanded relative to default_directory. */
1084 /* /... alone is not absolute on DOS and Windows. */
1085 && !IS_DIRECTORY_SEP (nm
[0])
1088 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1092 newdir
= SSDATA (default_directory
);
1094 /* Note if special escape prefix is present, but remove for now. */
1095 if (newdir
[0] == '/' && newdir
[1] == ':')
1106 /* First ensure newdir is an absolute name. */
1108 /* Detect MSDOS file names with drive specifiers. */
1109 ! (IS_DRIVE (newdir
[0])
1110 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1112 /* Detect Windows file names in UNC format. */
1113 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1117 /* Effectively, let newdir be (expand-file-name newdir cwd).
1118 Because of the admonition against calling expand-file-name
1119 when we have pointers into lisp strings, we accomplish this
1120 indirectly by prepending newdir to nm if necessary, and using
1121 cwd (or the wd of newdir's drive) as the new newdir. */
1123 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1125 drive
= (unsigned char) newdir
[0];
1128 if (!IS_DIRECTORY_SEP (nm
[0]))
1130 ptrdiff_t newlen
= strlen (newdir
);
1131 char *tmp
= alloca (newlen
+ strlen (nm
) + 2);
1132 file_name_as_directory (tmp
, newdir
, newlen
);
1136 adir
= alloca (MAXPATHLEN
+ 1);
1139 if (!getdefdir (toupper (drive
) - 'A' + 1, adir
))
1147 /* Strip off drive name from prefix, if present. */
1148 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1154 /* Keep only a prefix from newdir if nm starts with slash
1155 (//server/share for UNC, nothing otherwise). */
1156 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1159 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1161 char *adir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1163 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1165 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1178 /* Get rid of any slash at the end of newdir, unless newdir is
1179 just / or // (an incomplete UNC name). */
1180 length
= strlen (newdir
);
1182 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1184 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1188 char *temp
= alloca (length
);
1189 memcpy (temp
, newdir
, length
- 1);
1190 temp
[length
- 1] = 0;
1201 /* Now concatenate the directory and name to new space in the stack frame. */
1202 tlen
+= strlen (nm
) + 1;
1204 /* Reserve space for drive specifier and escape prefix, since either
1205 or both may need to be inserted. (The Microsoft x86 compiler
1206 produces incorrect code if the following two lines are combined.) */
1207 target
= alloca (tlen
+ 4);
1209 #else /* not DOS_NT */
1210 target
= alloca (tlen
);
1211 #endif /* not DOS_NT */
1216 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1219 /* If newdir is effectively "C:/", then the drive letter will have
1220 been stripped and newdir will be "/". Concatenating with an
1221 absolute directory in nm produces "//", which will then be
1222 incorrectly treated as a network share. Ignore newdir in
1223 this case (keeping the drive letter). */
1224 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1225 && newdir
[1] == '\0'))
1227 strcpy (target
, newdir
);
1230 file_name_as_directory (target
, newdir
, length
);
1233 strcat (target
, nm
);
1235 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1243 if (!IS_DIRECTORY_SEP (*p
))
1247 else if (p
[1] == '.'
1248 && (IS_DIRECTORY_SEP (p
[2])
1251 /* If "/." is the entire filename, keep the "/". Otherwise,
1252 just delete the whole "/.". */
1253 if (o
== target
&& p
[2] == '\0')
1257 else if (p
[1] == '.' && p
[2] == '.'
1258 /* `/../' is the "superroot" on certain file systems.
1259 Turned off on DOS_NT systems because they have no
1260 "superroot" and because this causes us to produce
1261 file names like "d:/../foo" which fail file-related
1262 functions of the underlying OS. (To reproduce, try a
1263 long series of "../../" in default_directory, longer
1264 than the number of levels from the root.) */
1268 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1273 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1276 /* Don't go below server level in UNC filenames. */
1277 if (o
== target
+ 1 && IS_DIRECTORY_SEP (*o
)
1278 && IS_DIRECTORY_SEP (*target
))
1282 /* Keep initial / only if this is the whole name. */
1283 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1287 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1288 /* Collapse multiple `/' in a row. */
1297 /* At last, set drive name. */
1299 /* Except for network file name. */
1300 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1301 #endif /* WINDOWSNT */
1303 if (!drive
) abort ();
1305 target
[0] = DRIVE_LETTER (drive
);
1308 /* Reinsert the escape prefix if required. */
1315 dostounix_filename (target
);
1318 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1321 /* Again look to see if the file name has special constructs in it
1322 and perhaps call the corresponding file handler. This is needed
1323 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1324 the ".." component gives us "/user@host:/bar/../baz" which needs
1325 to be expanded again. */
1326 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1327 if (!NILP (handler
))
1329 handled_name
= call3 (handler
, Qexpand_file_name
,
1330 result
, default_directory
);
1331 if (STRINGP (handled_name
))
1332 return handled_name
;
1333 error ("Invalid handler in `file-name-handler-alist'");
1340 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1341 This is the old version of expand-file-name, before it was thoroughly
1342 rewritten for Emacs 10.31. We leave this version here commented-out,
1343 because the code is very complex and likely to have subtle bugs. If
1344 bugs _are_ found, it might be of interest to look at the old code and
1345 see what did it do in the relevant situation.
1347 Don't remove this code: it's true that it will be accessible
1348 from the repository, but a few years from deletion, people will
1349 forget it is there. */
1351 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1352 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1353 "Convert FILENAME to absolute, and canonicalize it.\n\
1354 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1355 \(does not start with slash); if DEFAULT is nil or missing,\n\
1356 the current buffer's value of default-directory is used.\n\
1357 Filenames containing `.' or `..' as components are simplified;\n\
1358 initial `~/' expands to your home directory.\n\
1359 See also the function `substitute-in-file-name'.")
1361 Lisp_Object name
, defalt
;
1365 register unsigned char *newdir
, *p
, *o
;
1367 unsigned char *target
;
1371 CHECK_STRING (name
);
1374 /* If nm is absolute, flush ...// and detect /./ and /../.
1375 If no /./ or /../ we can return right away. */
1382 if (p
[0] == '/' && p
[1] == '/'
1385 if (p
[0] == '/' && p
[1] == '~')
1386 nm
= p
+ 1, lose
= 1;
1387 if (p
[0] == '/' && p
[1] == '.'
1388 && (p
[2] == '/' || p
[2] == 0
1389 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1395 if (nm
== SDATA (name
))
1397 return build_string (nm
);
1401 /* Now determine directory to start with and put it in NEWDIR. */
1405 if (nm
[0] == '~') /* prefix ~ */
1406 if (nm
[1] == '/' || nm
[1] == 0)/* ~/filename */
1408 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1409 newdir
= (unsigned char *) "";
1412 else /* ~user/filename */
1414 /* Get past ~ to user. */
1415 unsigned char *user
= nm
+ 1;
1416 /* Find end of name. */
1417 unsigned char *ptr
= (unsigned char *) strchr (user
, '/');
1418 ptrdiff_t len
= ptr
? ptr
- user
: strlen (user
);
1419 /* Copy the user name into temp storage. */
1420 o
= alloca (len
+ 1);
1421 memcpy (o
, user
, len
);
1424 /* Look up the user name. */
1426 pw
= (struct passwd
*) getpwnam (o
+ 1);
1429 error ("\"%s\" isn't a registered user", o
+ 1);
1431 newdir
= (unsigned char *) pw
->pw_dir
;
1433 /* Discard the user name from NM. */
1437 if (nm
[0] != '/' && !newdir
)
1440 defalt
= current_buffer
->directory
;
1441 CHECK_STRING (defalt
);
1442 newdir
= SDATA (defalt
);
1445 /* Now concatenate the directory and name to new space in the stack frame. */
1447 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1448 target
= alloca (tlen
);
1453 if (nm
[0] == 0 || nm
[0] == '/')
1454 strcpy (target
, newdir
);
1456 file_name_as_directory (target
, newdir
);
1459 strcat (target
, nm
);
1461 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1472 else if (!strncmp (p
, "//", 2)
1478 else if (p
[0] == '/' && p
[1] == '.'
1479 && (p
[2] == '/' || p
[2] == 0))
1481 else if (!strncmp (p
, "/..", 3)
1482 /* `/../' is the "superroot" on certain file systems. */
1484 && (p
[3] == '/' || p
[3] == 0))
1486 while (o
!= target
&& *--o
!= '/')
1488 if (o
== target
&& *o
== '/')
1498 return make_string (target
, o
- target
);
1502 /* If /~ or // appears, discard everything through first slash. */
1504 file_name_absolute_p (const char *filename
)
1507 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
1509 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
1510 && IS_DIRECTORY_SEP (filename
[2]))
1516 search_embedded_absfilename (char *nm
, char *endp
)
1520 for (p
= nm
+ 1; p
< endp
; p
++)
1523 || IS_DIRECTORY_SEP (p
[-1]))
1524 && file_name_absolute_p (p
)
1525 #if defined (WINDOWSNT) || defined (CYGWIN)
1526 /* // at start of file name is meaningful in Apollo,
1527 WindowsNT and Cygwin systems. */
1528 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
1529 #endif /* not (WINDOWSNT || CYGWIN) */
1532 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)); s
++);
1533 if (p
[0] == '~' && s
> p
+ 1) /* We've got "/~something/". */
1535 char *o
= alloca (s
- p
+ 1);
1537 memcpy (o
, p
, s
- p
);
1540 /* If we have ~user and `user' exists, discard
1541 everything up to ~. But if `user' does not exist, leave
1542 ~user alone, it might be a literal file name. */
1544 pw
= getpwnam (o
+ 1);
1556 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1557 Ssubstitute_in_file_name
, 1, 1, 0,
1558 doc
: /* Substitute environment variables referred to in FILENAME.
1559 `$FOO' where FOO is an environment variable name means to substitute
1560 the value of that variable. The variable name should be terminated
1561 with a character not a letter, digit or underscore; otherwise, enclose
1562 the entire variable name in braces.
1564 If `/~' appears, all of FILENAME through that `/' is discarded.
1565 If `//' appears, everything up to and including the first of
1566 those `/' is discarded. */)
1567 (Lisp_Object filename
)
1571 register char *s
, *p
, *o
, *x
, *endp
;
1572 char *target
= NULL
;
1574 int substituted
= 0;
1577 Lisp_Object handler
;
1579 CHECK_STRING (filename
);
1581 multibyte
= STRING_MULTIBYTE (filename
);
1583 /* If the file name has special constructs in it,
1584 call the corresponding file handler. */
1585 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1586 if (!NILP (handler
))
1588 Lisp_Object handled_name
= call2 (handler
, Qsubstitute_in_file_name
,
1590 if (STRINGP (handled_name
))
1591 return handled_name
;
1592 error ("Invalid handler in `file-name-handler-alist'");
1595 /* Always work on a copy of the string, in case GC happens during
1596 decode of environment variables, causing the original Lisp_String
1597 data to be relocated. */
1598 nm
= alloca (SBYTES (filename
) + 1);
1599 memcpy (nm
, SDATA (filename
), SBYTES (filename
) + 1);
1602 dostounix_filename (nm
);
1603 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
1605 endp
= nm
+ SBYTES (filename
);
1607 /* If /~ or // appears, discard everything through first slash. */
1608 p
= search_embedded_absfilename (nm
, endp
);
1610 /* Start over with the new string, so we check the file-name-handler
1611 again. Important with filenames like "/home/foo//:/hello///there"
1612 which would substitute to "/:/hello///there" rather than "/there". */
1613 return Fsubstitute_in_file_name
1614 (make_specified_string (p
, -1, endp
- p
, multibyte
));
1616 /* See if any variables are substituted into the string
1617 and find the total length of their values in `total'. */
1619 for (p
= nm
; p
!= endp
;)
1629 /* "$$" means a single "$". */
1638 while (p
!= endp
&& *p
!= '}') p
++;
1639 if (*p
!= '}') goto missingclose
;
1645 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1649 /* Copy out the variable name. */
1650 target
= alloca (s
- o
+ 1);
1651 memcpy (target
, o
, s
- o
);
1654 strupr (target
); /* $home == $HOME etc. */
1657 /* Get variable value. */
1658 o
= egetenv (target
);
1661 /* Don't try to guess a maximum length - UTF8 can use up to
1662 four bytes per character. This code is unlikely to run
1663 in a situation that requires performance, so decoding the
1664 env variables twice should be acceptable. Note that
1665 decoding may cause a garbage collect. */
1666 Lisp_Object orig
, decoded
;
1667 orig
= make_unibyte_string (o
, strlen (o
));
1668 decoded
= DECODE_FILE (orig
);
1669 total
+= SBYTES (decoded
);
1679 /* If substitution required, recopy the string and do it. */
1680 /* Make space in stack frame for the new copy. */
1681 xnm
= alloca (SBYTES (filename
) + total
+ 1);
1684 /* Copy the rest of the name through, replacing $ constructs with values. */
1701 while (p
!= endp
&& *p
!= '}') p
++;
1702 if (*p
!= '}') goto missingclose
;
1708 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1712 /* Copy out the variable name. */
1713 target
= alloca (s
- o
+ 1);
1714 memcpy (target
, o
, s
- o
);
1717 strupr (target
); /* $home == $HOME etc. */
1720 /* Get variable value. */
1721 o
= egetenv (target
);
1725 strcpy (x
, target
); x
+= strlen (target
);
1729 Lisp_Object orig
, decoded
;
1730 ptrdiff_t orig_length
, decoded_length
;
1731 orig_length
= strlen (o
);
1732 orig
= make_unibyte_string (o
, orig_length
);
1733 decoded
= DECODE_FILE (orig
);
1734 decoded_length
= SBYTES (decoded
);
1735 memcpy (x
, SDATA (decoded
), decoded_length
);
1736 x
+= decoded_length
;
1738 /* If environment variable needed decoding, return value
1739 needs to be multibyte. */
1740 if (decoded_length
!= orig_length
1741 || memcmp (SDATA (decoded
), o
, orig_length
))
1748 /* If /~ or // appears, discard everything through first slash. */
1749 while ((p
= search_embedded_absfilename (xnm
, x
)))
1750 /* This time we do not start over because we've already expanded envvars
1751 and replaced $$ with $. Maybe we should start over as well, but we'd
1752 need to quote some $ to $$ first. */
1755 return make_specified_string (xnm
, -1, x
- xnm
, multibyte
);
1758 error ("Bad format environment-variable substitution");
1760 error ("Missing \"}\" in environment-variable substitution");
1762 error ("Substituting nonexistent environment variable \"%s\"", target
);
1768 /* A slightly faster and more convenient way to get
1769 (directory-file-name (expand-file-name FOO)). */
1772 expand_and_dir_to_file (Lisp_Object filename
, Lisp_Object defdir
)
1774 register Lisp_Object absname
;
1776 absname
= Fexpand_file_name (filename
, defdir
);
1778 /* Remove final slash, if any (unless this is the root dir).
1779 stat behaves differently depending! */
1780 if (SCHARS (absname
) > 1
1781 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
1782 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
) - 2)))
1783 /* We cannot take shortcuts; they might be wrong for magic file names. */
1784 absname
= Fdirectory_file_name (absname
);
1788 /* Signal an error if the file ABSNAME already exists.
1789 If INTERACTIVE is nonzero, ask the user whether to proceed,
1790 and bypass the error if the user says to go ahead.
1791 QUERYSTRING is a name for the action that is being considered
1794 *STATPTR is used to store the stat information if the file exists.
1795 If the file does not exist, STATPTR->st_mode is set to 0.
1796 If STATPTR is null, we don't store into it.
1798 If QUICK is nonzero, we ask for y or n, not yes or no. */
1801 barf_or_query_if_file_exists (Lisp_Object absname
, const char *querystring
,
1802 int interactive
, struct stat
*statptr
, int quick
)
1804 register Lisp_Object tem
, encoded_filename
;
1805 struct stat statbuf
;
1806 struct gcpro gcpro1
;
1808 encoded_filename
= ENCODE_FILE (absname
);
1810 /* `stat' is a good way to tell whether the file exists,
1811 regardless of what access permissions it has. */
1812 if (lstat (SSDATA (encoded_filename
), &statbuf
) >= 0)
1814 if (S_ISDIR (statbuf
.st_mode
))
1815 xsignal2 (Qfile_error
,
1816 build_string ("File is a directory"), absname
);
1819 xsignal2 (Qfile_already_exists
,
1820 build_string ("File already exists"), absname
);
1822 tem
= format2 ("File %s already exists; %s anyway? ",
1823 absname
, build_string (querystring
));
1825 tem
= call1 (intern ("y-or-n-p"), tem
);
1827 tem
= do_yes_or_no_p (tem
);
1830 xsignal2 (Qfile_already_exists
,
1831 build_string ("File already exists"), absname
);
1838 statptr
->st_mode
= 0;
1843 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
1844 "fCopy file: \nGCopy %s to file: \np\nP",
1845 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
1846 If NEWNAME names a directory, copy FILE there.
1848 This function always sets the file modes of the output file to match
1851 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1852 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1853 signal a `file-already-exists' error without overwriting. If
1854 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1855 about overwriting; this is what happens in interactive use with M-x.
1856 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1859 Fourth arg KEEP-TIME non-nil means give the output file the same
1860 last-modified time as the old one. (This works on only some systems.)
1862 A prefix arg makes KEEP-TIME non-nil.
1864 If PRESERVE-UID-GID is non-nil, we try to transfer the
1865 uid and gid of FILE to NEWNAME.
1867 If PRESERVE-SELINUX-CONTEXT is non-nil and SELinux is enabled
1868 on the system, we copy the SELinux context of FILE to NEWNAME. */)
1869 (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
)
1873 char buf
[16 * 1024];
1874 struct stat st
, out_st
;
1875 Lisp_Object handler
;
1876 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1877 ptrdiff_t count
= SPECPDL_INDEX ();
1878 int input_file_statable_p
;
1879 Lisp_Object encoded_file
, encoded_newname
;
1881 security_context_t con
;
1882 int fail
, conlength
= 0;
1885 encoded_file
= encoded_newname
= Qnil
;
1886 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
1887 CHECK_STRING (file
);
1888 CHECK_STRING (newname
);
1890 if (!NILP (Ffile_directory_p (newname
)))
1891 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
1893 newname
= Fexpand_file_name (newname
, Qnil
);
1895 file
= Fexpand_file_name (file
, Qnil
);
1897 /* If the input file name has special constructs in it,
1898 call the corresponding file handler. */
1899 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1900 /* Likewise for output file name. */
1902 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1903 if (!NILP (handler
))
1904 RETURN_UNGCPRO (call7 (handler
, Qcopy_file
, file
, newname
,
1905 ok_if_already_exists
, keep_time
, preserve_uid_gid
,
1906 preserve_selinux_context
));
1908 encoded_file
= ENCODE_FILE (file
);
1909 encoded_newname
= ENCODE_FILE (newname
);
1911 if (NILP (ok_if_already_exists
)
1912 || INTEGERP (ok_if_already_exists
))
1913 barf_or_query_if_file_exists (newname
, "copy to it",
1914 INTEGERP (ok_if_already_exists
), &out_st
, 0);
1915 else if (stat (SSDATA (encoded_newname
), &out_st
) < 0)
1919 if (!CopyFile (SDATA (encoded_file
),
1920 SDATA (encoded_newname
),
1922 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
1923 /* CopyFile retains the timestamp by default. */
1924 else if (NILP (keep_time
))
1930 filename
= SDATA (encoded_newname
);
1932 /* Ensure file is writable while its modified time is set. */
1933 attributes
= GetFileAttributes (filename
);
1934 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
1935 now
= current_emacs_time ();
1936 if (set_file_times (-1, filename
, now
, now
))
1938 /* Restore original attributes. */
1939 SetFileAttributes (filename
, attributes
);
1940 xsignal2 (Qfile_date_error
,
1941 build_string ("Cannot set file date"), newname
);
1943 /* Restore original attributes. */
1944 SetFileAttributes (filename
, attributes
);
1946 #else /* not WINDOWSNT */
1948 ifd
= emacs_open (SSDATA (encoded_file
), O_RDONLY
, 0);
1952 report_file_error ("Opening input file", Fcons (file
, Qnil
));
1954 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1956 /* We can only copy regular files and symbolic links. Other files are not
1958 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1961 if (!NILP (preserve_selinux_context
) && is_selinux_enabled ())
1963 conlength
= fgetfilecon (ifd
, &con
);
1964 if (conlength
== -1)
1965 report_file_error ("Doing fgetfilecon", Fcons (file
, Qnil
));
1969 if (out_st
.st_mode
!= 0
1970 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
1973 report_file_error ("Input and output files are the same",
1974 Fcons (file
, Fcons (newname
, Qnil
)));
1977 if (input_file_statable_p
)
1979 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1981 #if defined (EISDIR)
1982 /* Get a better looking error message. */
1985 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
1990 /* System's default file type was set to binary by _fmode in emacs.c. */
1991 ofd
= emacs_open (SDATA (encoded_newname
),
1992 O_WRONLY
| O_TRUNC
| O_CREAT
1993 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
1994 S_IREAD
| S_IWRITE
);
1995 #else /* not MSDOS */
1997 int new_mask
= 0666;
1998 if (input_file_statable_p
)
2000 if (!NILP (preserve_uid_gid
))
2002 new_mask
&= st
.st_mode
;
2004 ofd
= emacs_open (SSDATA (encoded_newname
),
2005 (O_WRONLY
| O_TRUNC
| O_CREAT
2006 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0)),
2009 #endif /* not MSDOS */
2011 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2013 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2017 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2018 if (emacs_write (ofd
, buf
, n
) != n
)
2019 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2023 /* Preserve the original file modes, and if requested, also its
2025 if (input_file_statable_p
)
2027 int mode_mask
= 07777;
2028 if (!NILP (preserve_uid_gid
))
2030 /* Attempt to change owner and group. If that doesn't work
2031 attempt to change just the group, as that is sometimes allowed.
2032 Adjust the mode mask to eliminate setuid or setgid bits
2033 that are inappropriate if the owner and group are wrong. */
2034 if (fchown (ofd
, st
.st_uid
, st
.st_gid
) != 0)
2036 mode_mask
&= ~06000;
2037 if (fchown (ofd
, -1, st
.st_gid
) == 0)
2041 if (fchmod (ofd
, st
.st_mode
& mode_mask
) != 0)
2042 report_file_error ("Doing chmod", Fcons (newname
, Qnil
));
2044 #endif /* not MSDOS */
2049 /* Set the modified context back to the file. */
2050 fail
= fsetfilecon (ofd
, con
);
2051 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2052 if (fail
&& errno
!= ENOTSUP
)
2053 report_file_error ("Doing fsetfilecon", Fcons (newname
, Qnil
));
2059 if (input_file_statable_p
)
2061 if (!NILP (keep_time
))
2063 EMACS_TIME atime
= get_stat_atime (&st
);
2064 EMACS_TIME mtime
= get_stat_mtime (&st
);
2065 if (set_file_times (ofd
, SSDATA (encoded_newname
), atime
, mtime
))
2066 xsignal2 (Qfile_date_error
,
2067 build_string ("Cannot set file date"), newname
);
2071 if (emacs_close (ofd
) < 0)
2072 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2077 if (input_file_statable_p
)
2079 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2080 and if it can't, it tells so. Otherwise, under MSDOS we usually
2081 get only the READ bit, which will make the copied file read-only,
2082 so it's better not to chmod at all. */
2083 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2084 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2087 #endif /* not WINDOWSNT */
2089 /* Discard the unwind protects. */
2090 specpdl_ptr
= specpdl
+ count
;
2096 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2097 Smake_directory_internal
, 1, 1, 0,
2098 doc
: /* Create a new directory named DIRECTORY. */)
2099 (Lisp_Object directory
)
2102 Lisp_Object handler
;
2103 Lisp_Object encoded_dir
;
2105 CHECK_STRING (directory
);
2106 directory
= Fexpand_file_name (directory
, Qnil
);
2108 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2109 if (!NILP (handler
))
2110 return call2 (handler
, Qmake_directory_internal
, directory
);
2112 encoded_dir
= ENCODE_FILE (directory
);
2114 dir
= SSDATA (encoded_dir
);
2117 if (mkdir (dir
) != 0)
2119 if (mkdir (dir
, 0777 & ~auto_saving_dir_umask
) != 0)
2121 report_file_error ("Creating directory", list1 (directory
));
2126 DEFUN ("delete-directory-internal", Fdelete_directory_internal
,
2127 Sdelete_directory_internal
, 1, 1, 0,
2128 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2129 (Lisp_Object directory
)
2132 Lisp_Object encoded_dir
;
2134 CHECK_STRING (directory
);
2135 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2136 encoded_dir
= ENCODE_FILE (directory
);
2137 dir
= SSDATA (encoded_dir
);
2139 if (rmdir (dir
) != 0)
2140 report_file_error ("Removing directory", list1 (directory
));
2145 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 2,
2146 "(list (read-file-name \
2147 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2148 \"Move file to trash: \" \"Delete file: \") \
2149 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2150 (null current-prefix-arg))",
2151 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2152 If file has multiple names, it continues to exist with the other names.
2153 TRASH non-nil means to trash the file instead of deleting, provided
2154 `delete-by-moving-to-trash' is non-nil.
2156 When called interactively, TRASH is t if no prefix argument is given.
2157 With a prefix argument, TRASH is nil. */)
2158 (Lisp_Object filename
, Lisp_Object trash
)
2160 Lisp_Object handler
;
2161 Lisp_Object encoded_file
;
2162 struct gcpro gcpro1
;
2165 if (!NILP (Ffile_directory_p (filename
))
2166 && NILP (Ffile_symlink_p (filename
)))
2167 xsignal2 (Qfile_error
,
2168 build_string ("Removing old name: is a directory"),
2171 filename
= Fexpand_file_name (filename
, Qnil
);
2173 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2174 if (!NILP (handler
))
2175 return call3 (handler
, Qdelete_file
, filename
, trash
);
2177 if (delete_by_moving_to_trash
&& !NILP (trash
))
2178 return call1 (Qmove_file_to_trash
, filename
);
2180 encoded_file
= ENCODE_FILE (filename
);
2182 if (0 > unlink (SSDATA (encoded_file
)))
2183 report_file_error ("Removing old name", list1 (filename
));
2188 internal_delete_file_1 (Lisp_Object ignore
)
2193 /* Delete file FILENAME, returning 1 if successful and 0 if failed.
2194 This ignores `delete-by-moving-to-trash'. */
2197 internal_delete_file (Lisp_Object filename
)
2201 tem
= internal_condition_case_2 (Fdelete_file
, filename
, Qnil
,
2202 Qt
, internal_delete_file_1
);
2206 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2207 "fRename file: \nGRename %s to file: \np",
2208 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2209 If file has names other than FILE, it continues to have those names.
2210 Signals a `file-already-exists' error if a file NEWNAME already exists
2211 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2212 A number as third arg means request confirmation if NEWNAME already exists.
2213 This is what happens in interactive use with M-x. */)
2214 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2216 Lisp_Object handler
;
2217 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2218 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2220 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2221 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2222 CHECK_STRING (file
);
2223 CHECK_STRING (newname
);
2224 file
= Fexpand_file_name (file
, Qnil
);
2226 if ((!NILP (Ffile_directory_p (newname
)))
2228 /* If the file names are identical but for the case,
2229 don't attempt to move directory to itself. */
2230 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2234 Lisp_Object fname
= NILP (Ffile_directory_p (file
))
2235 ? file
: Fdirectory_file_name (file
);
2236 newname
= Fexpand_file_name (Ffile_name_nondirectory (fname
), newname
);
2239 newname
= Fexpand_file_name (newname
, Qnil
);
2241 /* If the file name has special constructs in it,
2242 call the corresponding file handler. */
2243 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2245 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2246 if (!NILP (handler
))
2247 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2248 file
, newname
, ok_if_already_exists
));
2250 encoded_file
= ENCODE_FILE (file
);
2251 encoded_newname
= ENCODE_FILE (newname
);
2254 /* If the file names are identical but for the case, don't ask for
2255 confirmation: they simply want to change the letter-case of the
2257 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2259 if (NILP (ok_if_already_exists
)
2260 || INTEGERP (ok_if_already_exists
))
2261 barf_or_query_if_file_exists (newname
, "rename to it",
2262 INTEGERP (ok_if_already_exists
), 0, 0);
2263 if (0 > rename (SSDATA (encoded_file
), SSDATA (encoded_newname
)))
2268 symlink_target
= Ffile_symlink_p (file
);
2269 if (! NILP (symlink_target
))
2270 Fmake_symbolic_link (symlink_target
, newname
,
2271 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2272 else if (!NILP (Ffile_directory_p (file
)))
2273 call4 (Qcopy_directory
, file
, newname
, Qt
, Qnil
);
2275 /* We have already prompted if it was an integer, so don't
2276 have copy-file prompt again. */
2277 Fcopy_file (file
, newname
,
2278 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2281 count
= SPECPDL_INDEX ();
2282 specbind (Qdelete_by_moving_to_trash
, Qnil
);
2284 if (!NILP (Ffile_directory_p (file
)) && NILP (symlink_target
))
2285 call2 (Qdelete_directory
, file
, Qt
);
2287 Fdelete_file (file
, Qnil
);
2288 unbind_to (count
, Qnil
);
2291 report_file_error ("Renaming", list2 (file
, newname
));
2297 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2298 "fAdd name to file: \nGName to add to %s: \np",
2299 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2300 Signals a `file-already-exists' error if a file NEWNAME already exists
2301 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2302 A number as third arg means request confirmation if NEWNAME already exists.
2303 This is what happens in interactive use with M-x. */)
2304 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2306 Lisp_Object handler
;
2307 Lisp_Object encoded_file
, encoded_newname
;
2308 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2310 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2311 encoded_file
= encoded_newname
= Qnil
;
2312 CHECK_STRING (file
);
2313 CHECK_STRING (newname
);
2314 file
= Fexpand_file_name (file
, Qnil
);
2316 if (!NILP (Ffile_directory_p (newname
)))
2317 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2319 newname
= Fexpand_file_name (newname
, Qnil
);
2321 /* If the file name has special constructs in it,
2322 call the corresponding file handler. */
2323 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2324 if (!NILP (handler
))
2325 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2326 newname
, ok_if_already_exists
));
2328 /* If the new name has special constructs in it,
2329 call the corresponding file handler. */
2330 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2331 if (!NILP (handler
))
2332 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2333 newname
, ok_if_already_exists
));
2335 encoded_file
= ENCODE_FILE (file
);
2336 encoded_newname
= ENCODE_FILE (newname
);
2338 if (NILP (ok_if_already_exists
)
2339 || INTEGERP (ok_if_already_exists
))
2340 barf_or_query_if_file_exists (newname
, "make it a new name",
2341 INTEGERP (ok_if_already_exists
), 0, 0);
2343 unlink (SSDATA (newname
));
2344 if (0 > link (SSDATA (encoded_file
), SSDATA (encoded_newname
)))
2345 report_file_error ("Adding new name", list2 (file
, newname
));
2351 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2352 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2353 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2354 Both args must be strings.
2355 Signals a `file-already-exists' error if a file LINKNAME already exists
2356 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2357 A number as third arg means request confirmation if LINKNAME already exists.
2358 This happens for interactive use with M-x. */)
2359 (Lisp_Object filename
, Lisp_Object linkname
, Lisp_Object ok_if_already_exists
)
2361 Lisp_Object handler
;
2362 Lisp_Object encoded_filename
, encoded_linkname
;
2363 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2365 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2366 encoded_filename
= encoded_linkname
= Qnil
;
2367 CHECK_STRING (filename
);
2368 CHECK_STRING (linkname
);
2369 /* If the link target has a ~, we must expand it to get
2370 a truly valid file name. Otherwise, do not expand;
2371 we want to permit links to relative file names. */
2372 if (SREF (filename
, 0) == '~')
2373 filename
= Fexpand_file_name (filename
, Qnil
);
2375 if (!NILP (Ffile_directory_p (linkname
)))
2376 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2378 linkname
= Fexpand_file_name (linkname
, Qnil
);
2380 /* If the file name has special constructs in it,
2381 call the corresponding file handler. */
2382 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2383 if (!NILP (handler
))
2384 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2385 linkname
, ok_if_already_exists
));
2387 /* If the new link name has special constructs in it,
2388 call the corresponding file handler. */
2389 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2390 if (!NILP (handler
))
2391 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2392 linkname
, ok_if_already_exists
));
2394 encoded_filename
= ENCODE_FILE (filename
);
2395 encoded_linkname
= ENCODE_FILE (linkname
);
2397 if (NILP (ok_if_already_exists
)
2398 || INTEGERP (ok_if_already_exists
))
2399 barf_or_query_if_file_exists (linkname
, "make it a link",
2400 INTEGERP (ok_if_already_exists
), 0, 0);
2401 if (0 > symlink (SSDATA (encoded_filename
),
2402 SSDATA (encoded_linkname
)))
2404 /* If we didn't complain already, silently delete existing file. */
2405 if (errno
== EEXIST
)
2407 unlink (SSDATA (encoded_linkname
));
2408 if (0 <= symlink (SSDATA (encoded_filename
),
2409 SSDATA (encoded_linkname
)))
2415 if (errno
== ENOSYS
)
2418 xsignal1 (Qfile_error
,
2419 build_string ("Symbolic links are not supported"));
2422 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2429 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2431 doc
: /* Return t if file FILENAME specifies an absolute file name.
2432 On Unix, this is a name starting with a `/' or a `~'. */)
2433 (Lisp_Object filename
)
2435 CHECK_STRING (filename
);
2436 return file_name_absolute_p (SSDATA (filename
)) ? Qt
: Qnil
;
2439 /* Return nonzero if file FILENAME exists and can be executed. */
2442 check_executable (char *filename
)
2446 if (stat (filename
, &st
) < 0)
2448 return ((st
.st_mode
& S_IEXEC
) != 0);
2449 #else /* not DOS_NT */
2450 #ifdef HAVE_EUIDACCESS
2451 return (euidaccess (filename
, 1) >= 0);
2453 /* Access isn't quite right because it uses the real uid
2454 and we really want to test with the effective uid.
2455 But Unix doesn't give us a right way to do it. */
2456 return (access (filename
, 1) >= 0);
2458 #endif /* not DOS_NT */
2461 /* Return nonzero if file FILENAME exists and can be written. */
2464 check_writable (const char *filename
)
2468 if (stat (filename
, &st
) < 0)
2470 return (st
.st_mode
& S_IWRITE
|| S_ISDIR (st
.st_mode
));
2471 #else /* not MSDOS */
2472 #ifdef HAVE_EUIDACCESS
2473 int res
= (euidaccess (filename
, 2) >= 0);
2475 /* euidaccess may have returned failure because Cygwin couldn't
2476 determine the file's UID or GID; if so, we return success. */
2480 if (stat (filename
, &st
) < 0)
2482 res
= (st
.st_uid
== -1 || st
.st_gid
== -1);
2486 #else /* not HAVE_EUIDACCESS */
2487 /* Access isn't quite right because it uses the real uid
2488 and we really want to test with the effective uid.
2489 But Unix doesn't give us a right way to do it.
2490 Opening with O_WRONLY could work for an ordinary file,
2491 but would lose for directories. */
2492 return (access (filename
, 2) >= 0);
2493 #endif /* not HAVE_EUIDACCESS */
2494 #endif /* not MSDOS */
2497 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2498 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
2499 See also `file-readable-p' and `file-attributes'.
2500 This returns nil for a symlink to a nonexistent file.
2501 Use `file-symlink-p' to test for such links. */)
2502 (Lisp_Object filename
)
2504 Lisp_Object absname
;
2505 Lisp_Object handler
;
2506 struct stat statbuf
;
2508 CHECK_STRING (filename
);
2509 absname
= Fexpand_file_name (filename
, Qnil
);
2511 /* If the file name has special constructs in it,
2512 call the corresponding file handler. */
2513 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2514 if (!NILP (handler
))
2515 return call2 (handler
, Qfile_exists_p
, absname
);
2517 absname
= ENCODE_FILE (absname
);
2519 return (stat (SSDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
2522 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2523 doc
: /* Return t if FILENAME can be executed by you.
2524 For a directory, this means you can access files in that directory. */)
2525 (Lisp_Object filename
)
2527 Lisp_Object absname
;
2528 Lisp_Object handler
;
2530 CHECK_STRING (filename
);
2531 absname
= Fexpand_file_name (filename
, Qnil
);
2533 /* If the file name has special constructs in it,
2534 call the corresponding file handler. */
2535 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2536 if (!NILP (handler
))
2537 return call2 (handler
, Qfile_executable_p
, absname
);
2539 absname
= ENCODE_FILE (absname
);
2541 return (check_executable (SSDATA (absname
)) ? Qt
: Qnil
);
2544 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2545 doc
: /* Return t if file FILENAME exists and you can read it.
2546 See also `file-exists-p' and `file-attributes'. */)
2547 (Lisp_Object filename
)
2549 Lisp_Object absname
;
2550 Lisp_Object handler
;
2553 struct stat statbuf
;
2555 CHECK_STRING (filename
);
2556 absname
= Fexpand_file_name (filename
, Qnil
);
2558 /* If the file name has special constructs in it,
2559 call the corresponding file handler. */
2560 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2561 if (!NILP (handler
))
2562 return call2 (handler
, Qfile_readable_p
, absname
);
2564 absname
= ENCODE_FILE (absname
);
2566 #if defined (DOS_NT) || defined (macintosh)
2567 /* Under MS-DOS, Windows, and Macintosh, open does not work for
2569 if (access (SDATA (absname
), 0) == 0)
2572 #else /* not DOS_NT and not macintosh */
2575 /* Opening a fifo without O_NONBLOCK can wait.
2576 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2577 except in the case of a fifo, on a system which handles it. */
2578 desc
= stat (SSDATA (absname
), &statbuf
);
2581 if (S_ISFIFO (statbuf
.st_mode
))
2582 flags
|= O_NONBLOCK
;
2584 desc
= emacs_open (SSDATA (absname
), flags
, 0);
2589 #endif /* not DOS_NT and not macintosh */
2592 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2594 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2595 doc
: /* Return t if file FILENAME can be written or created by you. */)
2596 (Lisp_Object filename
)
2598 Lisp_Object absname
, dir
, encoded
;
2599 Lisp_Object handler
;
2600 struct stat statbuf
;
2602 CHECK_STRING (filename
);
2603 absname
= Fexpand_file_name (filename
, Qnil
);
2605 /* If the file name has special constructs in it,
2606 call the corresponding file handler. */
2607 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2608 if (!NILP (handler
))
2609 return call2 (handler
, Qfile_writable_p
, absname
);
2611 encoded
= ENCODE_FILE (absname
);
2612 if (stat (SSDATA (encoded
), &statbuf
) >= 0)
2613 return (check_writable (SSDATA (encoded
))
2616 dir
= Ffile_name_directory (absname
);
2619 dir
= Fdirectory_file_name (dir
);
2622 dir
= ENCODE_FILE (dir
);
2624 /* The read-only attribute of the parent directory doesn't affect
2625 whether a file or directory can be created within it. Some day we
2626 should check ACLs though, which do affect this. */
2627 if (stat (SDATA (dir
), &statbuf
) < 0)
2629 return S_ISDIR (statbuf
.st_mode
) ? Qt
: Qnil
;
2631 return (check_writable (!NILP (dir
) ? SSDATA (dir
) : "")
2636 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2637 doc
: /* Access file FILENAME, and get an error if that does not work.
2638 The second argument STRING is used in the error message.
2639 If there is no error, returns nil. */)
2640 (Lisp_Object filename
, Lisp_Object string
)
2642 Lisp_Object handler
, encoded_filename
, absname
;
2645 CHECK_STRING (filename
);
2646 absname
= Fexpand_file_name (filename
, Qnil
);
2648 CHECK_STRING (string
);
2650 /* If the file name has special constructs in it,
2651 call the corresponding file handler. */
2652 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
2653 if (!NILP (handler
))
2654 return call3 (handler
, Qaccess_file
, absname
, string
);
2656 encoded_filename
= ENCODE_FILE (absname
);
2658 fd
= emacs_open (SSDATA (encoded_filename
), O_RDONLY
, 0);
2660 report_file_error (SSDATA (string
), Fcons (filename
, Qnil
));
2666 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2667 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
2668 The value is the link target, as a string.
2669 Otherwise it returns nil.
2671 This function returns t when given the name of a symlink that
2672 points to a nonexistent file. */)
2673 (Lisp_Object filename
)
2675 Lisp_Object handler
;
2678 char readlink_buf
[READLINK_BUFSIZE
];
2680 CHECK_STRING (filename
);
2681 filename
= Fexpand_file_name (filename
, Qnil
);
2683 /* If the file name has special constructs in it,
2684 call the corresponding file handler. */
2685 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2686 if (!NILP (handler
))
2687 return call2 (handler
, Qfile_symlink_p
, filename
);
2689 filename
= ENCODE_FILE (filename
);
2691 buf
= emacs_readlink (SSDATA (filename
), readlink_buf
);
2695 val
= build_string (buf
);
2696 if (buf
[0] == '/' && strchr (buf
, ':'))
2697 val
= concat2 (build_string ("/:"), val
);
2698 if (buf
!= readlink_buf
)
2700 val
= DECODE_FILE (val
);
2704 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2705 doc
: /* Return t if FILENAME names an existing directory.
2706 Symbolic links to directories count as directories.
2707 See `file-symlink-p' to distinguish symlinks. */)
2708 (Lisp_Object filename
)
2710 register Lisp_Object absname
;
2712 Lisp_Object handler
;
2714 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2716 /* If the file name has special constructs in it,
2717 call the corresponding file handler. */
2718 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2719 if (!NILP (handler
))
2720 return call2 (handler
, Qfile_directory_p
, absname
);
2722 absname
= ENCODE_FILE (absname
);
2724 if (stat (SSDATA (absname
), &st
) < 0)
2726 return S_ISDIR (st
.st_mode
) ? Qt
: Qnil
;
2729 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
,
2730 Sfile_accessible_directory_p
, 1, 1, 0,
2731 doc
: /* Return t if file FILENAME names a directory you can open.
2732 For the value to be t, FILENAME must specify the name of a directory as a file,
2733 and the directory must allow you to open files in it. In order to use a
2734 directory as a buffer's current directory, this predicate must return true.
2735 A directory name spec may be given instead; then the value is t
2736 if the directory so specified exists and really is a readable and
2737 searchable directory. */)
2738 (Lisp_Object filename
)
2740 Lisp_Object handler
;
2742 struct gcpro gcpro1
;
2744 /* If the file name has special constructs in it,
2745 call the corresponding file handler. */
2746 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2747 if (!NILP (handler
))
2748 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2751 tem
= (NILP (Ffile_directory_p (filename
))
2752 || NILP (Ffile_executable_p (filename
)));
2754 return tem
? Qnil
: Qt
;
2757 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2758 doc
: /* Return t if FILENAME names a regular file.
2759 This is the sort of file that holds an ordinary stream of data bytes.
2760 Symbolic links to regular files count as regular files.
2761 See `file-symlink-p' to distinguish symlinks. */)
2762 (Lisp_Object filename
)
2764 register Lisp_Object absname
;
2766 Lisp_Object handler
;
2768 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2770 /* If the file name has special constructs in it,
2771 call the corresponding file handler. */
2772 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2773 if (!NILP (handler
))
2774 return call2 (handler
, Qfile_regular_p
, absname
);
2776 absname
= ENCODE_FILE (absname
);
2781 Lisp_Object tem
= Vw32_get_true_file_attributes
;
2783 /* Tell stat to use expensive method to get accurate info. */
2784 Vw32_get_true_file_attributes
= Qt
;
2785 result
= stat (SDATA (absname
), &st
);
2786 Vw32_get_true_file_attributes
= tem
;
2790 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2793 if (stat (SSDATA (absname
), &st
) < 0)
2795 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2799 DEFUN ("file-selinux-context", Ffile_selinux_context
,
2800 Sfile_selinux_context
, 1, 1, 0,
2801 doc
: /* Return SELinux context of file named FILENAME.
2802 The return value is a list (USER ROLE TYPE RANGE), where the list
2803 elements are strings naming the user, role, type, and range of the
2804 file's SELinux security context.
2806 Return (nil nil nil nil) if the file is nonexistent or inaccessible,
2807 or if SELinux is disabled, or if Emacs lacks SELinux support. */)
2808 (Lisp_Object filename
)
2810 Lisp_Object absname
;
2811 Lisp_Object values
[4];
2812 Lisp_Object handler
;
2814 security_context_t con
;
2819 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2821 /* If the file name has special constructs in it,
2822 call the corresponding file handler. */
2823 handler
= Ffind_file_name_handler (absname
, Qfile_selinux_context
);
2824 if (!NILP (handler
))
2825 return call2 (handler
, Qfile_selinux_context
, absname
);
2827 absname
= ENCODE_FILE (absname
);
2834 if (is_selinux_enabled ())
2836 conlength
= lgetfilecon (SSDATA (absname
), &con
);
2839 context
= context_new (con
);
2840 if (context_user_get (context
))
2841 values
[0] = build_string (context_user_get (context
));
2842 if (context_role_get (context
))
2843 values
[1] = build_string (context_role_get (context
));
2844 if (context_type_get (context
))
2845 values
[2] = build_string (context_type_get (context
));
2846 if (context_range_get (context
))
2847 values
[3] = build_string (context_range_get (context
));
2848 context_free (context
);
2855 return Flist (sizeof (values
) / sizeof (values
[0]), values
);
2858 DEFUN ("set-file-selinux-context", Fset_file_selinux_context
,
2859 Sset_file_selinux_context
, 2, 2, 0,
2860 doc
: /* Set SELinux context of file named FILENAME to CONTEXT.
2861 CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
2862 elements are strings naming the components of a SELinux context.
2864 This function does nothing if SELinux is disabled, or if Emacs was not
2865 compiled with SELinux support. */)
2866 (Lisp_Object filename
, Lisp_Object context
)
2868 Lisp_Object absname
;
2869 Lisp_Object handler
;
2871 Lisp_Object encoded_absname
;
2872 Lisp_Object user
= CAR_SAFE (context
);
2873 Lisp_Object role
= CAR_SAFE (CDR_SAFE (context
));
2874 Lisp_Object type
= CAR_SAFE (CDR_SAFE (CDR_SAFE (context
)));
2875 Lisp_Object range
= CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context
))));
2876 security_context_t con
;
2877 int fail
, conlength
;
2878 context_t parsed_con
;
2881 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
2883 /* If the file name has special constructs in it,
2884 call the corresponding file handler. */
2885 handler
= Ffind_file_name_handler (absname
, Qset_file_selinux_context
);
2886 if (!NILP (handler
))
2887 return call3 (handler
, Qset_file_selinux_context
, absname
, context
);
2890 if (is_selinux_enabled ())
2892 /* Get current file context. */
2893 encoded_absname
= ENCODE_FILE (absname
);
2894 conlength
= lgetfilecon (SSDATA (encoded_absname
), &con
);
2897 parsed_con
= context_new (con
);
2898 /* Change the parts defined in the parameter.*/
2901 if (context_user_set (parsed_con
, SSDATA (user
)))
2902 error ("Doing context_user_set");
2906 if (context_role_set (parsed_con
, SSDATA (role
)))
2907 error ("Doing context_role_set");
2911 if (context_type_set (parsed_con
, SSDATA (type
)))
2912 error ("Doing context_type_set");
2914 if (STRINGP (range
))
2916 if (context_range_set (parsed_con
, SSDATA (range
)))
2917 error ("Doing context_range_set");
2920 /* Set the modified context back to the file. */
2921 fail
= lsetfilecon (SSDATA (encoded_absname
),
2922 context_str (parsed_con
));
2923 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2924 if (fail
&& errno
!= ENOTSUP
)
2925 report_file_error ("Doing lsetfilecon", Fcons (absname
, Qnil
));
2927 context_free (parsed_con
);
2930 report_file_error ("Doing lgetfilecon", Fcons (absname
, Qnil
));
2940 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2941 doc
: /* Return mode bits of file named FILENAME, as an integer.
2942 Return nil, if file does not exist or is not accessible. */)
2943 (Lisp_Object filename
)
2945 Lisp_Object absname
;
2947 Lisp_Object handler
;
2949 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2951 /* If the file name has special constructs in it,
2952 call the corresponding file handler. */
2953 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2954 if (!NILP (handler
))
2955 return call2 (handler
, Qfile_modes
, absname
);
2957 absname
= ENCODE_FILE (absname
);
2959 if (stat (SSDATA (absname
), &st
) < 0)
2962 return make_number (st
.st_mode
& 07777);
2965 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
2966 "(let ((file (read-file-name \"File: \"))) \
2967 (list file (read-file-modes nil file)))",
2968 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
2969 Only the 12 low bits of MODE are used.
2971 Interactively, mode bits are read by `read-file-modes', which accepts
2972 symbolic notation, like the `chmod' command from GNU Coreutils. */)
2973 (Lisp_Object filename
, Lisp_Object mode
)
2975 Lisp_Object absname
, encoded_absname
;
2976 Lisp_Object handler
;
2978 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
2979 CHECK_NUMBER (mode
);
2981 /* If the file name has special constructs in it,
2982 call the corresponding file handler. */
2983 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2984 if (!NILP (handler
))
2985 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2987 encoded_absname
= ENCODE_FILE (absname
);
2989 if (chmod (SSDATA (encoded_absname
), XINT (mode
) & 07777) < 0)
2990 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2995 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2996 doc
: /* Set the file permission bits for newly created files.
2997 The argument MODE should be an integer; only the low 9 bits are used.
2998 This setting is inherited by subprocesses. */)
3001 CHECK_NUMBER (mode
);
3003 umask ((~ XINT (mode
)) & 0777);
3008 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3009 doc
: /* Return the default file protection for created files.
3010 The value is an integer. */)
3017 realmask
= umask (0);
3021 XSETINT (value
, (~ realmask
) & 0777);
3026 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3027 doc
: /* Set times of file FILENAME to TIMESTAMP.
3028 Set both access and modification times.
3029 Return t on success, else nil.
3030 Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
3032 (Lisp_Object filename
, Lisp_Object timestamp
)
3034 Lisp_Object absname
, encoded_absname
;
3035 Lisp_Object handler
;
3036 EMACS_TIME t
= lisp_time_argument (timestamp
);
3038 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3040 /* If the file name has special constructs in it,
3041 call the corresponding file handler. */
3042 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3043 if (!NILP (handler
))
3044 return call3 (handler
, Qset_file_times
, absname
, timestamp
);
3046 encoded_absname
= ENCODE_FILE (absname
);
3049 if (set_file_times (-1, SSDATA (encoded_absname
), t
, t
))
3054 /* Setting times on a directory always fails. */
3055 if (stat (SSDATA (encoded_absname
), &st
) == 0 && S_ISDIR (st
.st_mode
))
3058 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3067 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3068 doc
: /* Tell Unix to finish all pending disk updates. */)
3075 #endif /* HAVE_SYNC */
3077 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3078 doc
: /* Return t if file FILE1 is newer than file FILE2.
3079 If FILE1 does not exist, the answer is nil;
3080 otherwise, if FILE2 does not exist, the answer is t. */)
3081 (Lisp_Object file1
, Lisp_Object file2
)
3083 Lisp_Object absname1
, absname2
;
3084 struct stat st1
, st2
;
3085 Lisp_Object handler
;
3086 struct gcpro gcpro1
, gcpro2
;
3088 CHECK_STRING (file1
);
3089 CHECK_STRING (file2
);
3092 GCPRO2 (absname1
, file2
);
3093 absname1
= expand_and_dir_to_file (file1
, BVAR (current_buffer
, directory
));
3094 absname2
= expand_and_dir_to_file (file2
, BVAR (current_buffer
, directory
));
3097 /* If the file name has special constructs in it,
3098 call the corresponding file handler. */
3099 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3101 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3102 if (!NILP (handler
))
3103 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3105 GCPRO2 (absname1
, absname2
);
3106 absname1
= ENCODE_FILE (absname1
);
3107 absname2
= ENCODE_FILE (absname2
);
3110 if (stat (SSDATA (absname1
), &st1
) < 0)
3113 if (stat (SSDATA (absname2
), &st2
) < 0)
3116 return (EMACS_TIME_GT (get_stat_mtime (&st1
), get_stat_mtime (&st2
))
3120 #ifndef READ_BUF_SIZE
3121 #define READ_BUF_SIZE (64 << 10)
3123 /* Some buffer offsets are stored in 'int' variables. */
3124 verify (READ_BUF_SIZE
<= INT_MAX
);
3126 /* This function is called after Lisp functions to decide a coding
3127 system are called, or when they cause an error. Before they are
3128 called, the current buffer is set unibyte and it contains only a
3129 newly inserted text (thus the buffer was empty before the
3132 The functions may set markers, overlays, text properties, or even
3133 alter the buffer contents, change the current buffer.
3135 Here, we reset all those changes by:
3136 o set back the current buffer.
3137 o move all markers and overlays to BEG.
3138 o remove all text properties.
3139 o set back the buffer multibyteness. */
3142 decide_coding_unwind (Lisp_Object unwind_data
)
3144 Lisp_Object multibyte
, undo_list
, buffer
;
3146 multibyte
= XCAR (unwind_data
);
3147 unwind_data
= XCDR (unwind_data
);
3148 undo_list
= XCAR (unwind_data
);
3149 buffer
= XCDR (unwind_data
);
3151 if (current_buffer
!= XBUFFER (buffer
))
3152 set_buffer_internal (XBUFFER (buffer
));
3153 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3154 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3155 BUF_INTERVALS (current_buffer
) = 0;
3156 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3158 /* Now we are safe to change the buffer's multibyteness directly. */
3159 BVAR (current_buffer
, enable_multibyte_characters
) = multibyte
;
3160 BVAR (current_buffer
, undo_list
) = undo_list
;
3166 /* Used to pass values from insert-file-contents to read_non_regular. */
3168 static int non_regular_fd
;
3169 static ptrdiff_t non_regular_inserted
;
3170 static int non_regular_nbytes
;
3173 /* Read from a non-regular file.
3174 Read non_regular_nbytes bytes max from non_regular_fd.
3175 Non_regular_inserted specifies where to put the read bytes.
3176 Value is the number of bytes read. */
3179 read_non_regular (Lisp_Object ignore
)
3185 nbytes
= emacs_read (non_regular_fd
,
3186 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
3187 + non_regular_inserted
),
3188 non_regular_nbytes
);
3190 return make_number (nbytes
);
3194 /* Condition-case handler used when reading from non-regular files
3195 in insert-file-contents. */
3198 read_non_regular_quit (Lisp_Object ignore
)
3203 /* Reposition FD to OFFSET, based on WHENCE. This acts like lseek
3204 except that it also tests for OFFSET being out of lseek's range. */
3206 emacs_lseek (int fd
, EMACS_INT offset
, int whence
)
3208 /* Use "&" rather than "&&" to suppress a bogus GCC warning; see
3209 <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43772>. */
3210 if (! ((TYPE_MINIMUM (off_t
) <= offset
) & (offset
<= TYPE_MAXIMUM (off_t
))))
3215 return lseek (fd
, offset
, whence
);
3218 /* Return a special time value indicating the error number ERRNUM. */
3220 time_error_value (int errnum
)
3222 int ns
= (errnum
== ENOENT
|| errnum
== EACCES
|| errnum
== ENOTDIR
3223 ? NONEXISTENT_MODTIME_NSECS
3224 : UNKNOWN_MODTIME_NSECS
);
3225 return make_emacs_time (0, ns
);
3228 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3230 doc
: /* Insert contents of file FILENAME after point.
3231 Returns list of absolute file name and number of characters inserted.
3232 If second argument VISIT is non-nil, the buffer's visited filename and
3233 last save file modtime are set, and it is marked unmodified. If
3234 visiting and the file does not exist, visiting is completed before the
3237 The optional third and fourth arguments BEG and END specify what portion
3238 of the file to insert. These arguments count bytes in the file, not
3239 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3241 If optional fifth argument REPLACE is non-nil, replace the current
3242 buffer contents (in the accessible portion) with the file contents.
3243 This is better than simply deleting and inserting the whole thing
3244 because (1) it preserves some marker positions and (2) it puts less data
3245 in the undo list. When REPLACE is non-nil, the second return value is
3246 the number of characters that replace previous buffer contents.
3248 This function does code conversion according to the value of
3249 `coding-system-for-read' or `file-coding-system-alist', and sets the
3250 variable `last-coding-system-used' to the coding system actually used. */)
3251 (Lisp_Object filename
, Lisp_Object visit
, Lisp_Object beg
, Lisp_Object end
, Lisp_Object replace
)
3257 ptrdiff_t inserted
= 0;
3259 register ptrdiff_t how_much
;
3260 off_t beg_offset
, end_offset
;
3261 register int unprocessed
;
3262 ptrdiff_t count
= SPECPDL_INDEX ();
3263 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3264 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3266 ptrdiff_t total
= 0;
3267 int not_regular
= 0;
3269 char read_buf
[READ_BUF_SIZE
];
3270 struct coding_system coding
;
3271 char buffer
[1 << 14];
3272 int replace_handled
= 0;
3273 int set_coding_system
= 0;
3274 Lisp_Object coding_system
;
3276 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3277 int we_locked_file
= 0;
3278 int deferred_remove_unwind_protect
= 0;
3280 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3281 error ("Cannot do file visiting in an indirect buffer");
3283 if (!NILP (BVAR (current_buffer
, read_only
)))
3284 Fbarf_if_buffer_read_only ();
3288 orig_filename
= Qnil
;
3291 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3293 CHECK_STRING (filename
);
3294 filename
= Fexpand_file_name (filename
, Qnil
);
3296 /* The value Qnil means that the coding system is not yet
3298 coding_system
= Qnil
;
3300 /* If the file name has special constructs in it,
3301 call the corresponding file handler. */
3302 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3303 if (!NILP (handler
))
3305 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3306 visit
, beg
, end
, replace
);
3307 if (CONSP (val
) && CONSP (XCDR (val
))
3308 && RANGED_INTEGERP (0, XCAR (XCDR (val
)), ZV
- PT
))
3309 inserted
= XINT (XCAR (XCDR (val
)));
3313 orig_filename
= filename
;
3314 filename
= ENCODE_FILE (filename
);
3320 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3322 /* Tell stat to use expensive method to get accurate info. */
3323 Vw32_get_true_file_attributes
= Qt
;
3324 file_status
= stat (SSDATA (filename
), &st
);
3325 Vw32_get_true_file_attributes
= tem
;
3328 file_status
= stat (SSDATA (filename
), &st
);
3329 #endif /* WINDOWSNT */
3331 if (file_status
== 0)
3332 mtime
= get_stat_mtime (&st
);
3338 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3339 mtime
= time_error_value (save_errno
);
3342 if (!NILP (Vcoding_system_for_read
))
3343 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3347 /* This code will need to be changed in order to work on named
3348 pipes, and it's probably just not worth it. So we should at
3349 least signal an error. */
3350 if (!S_ISREG (st
.st_mode
))
3357 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3358 xsignal2 (Qfile_error
,
3359 build_string ("not a regular file"), orig_filename
);
3363 if ((fd
= emacs_open (SSDATA (filename
), O_RDONLY
, 0)) < 0)
3366 /* Replacement should preserve point as it preserves markers. */
3367 if (!NILP (replace
))
3368 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3370 record_unwind_protect (close_file_unwind
, make_number (fd
));
3375 if (!NILP (beg
) || !NILP (end
))
3376 error ("Attempt to visit less than an entire file");
3377 if (BEG
< Z
&& NILP (replace
))
3378 error ("Cannot do file visiting in a non-empty buffer");
3383 if (! (RANGED_INTEGERP (0, beg
, TYPE_MAXIMUM (off_t
))))
3384 wrong_type_argument (intern ("file-offset"), beg
);
3385 beg_offset
= XFASTINT (beg
);
3392 if (! (RANGED_INTEGERP (0, end
, TYPE_MAXIMUM (off_t
))))
3393 wrong_type_argument (intern ("file-offset"), end
);
3394 end_offset
= XFASTINT (end
);
3399 end_offset
= TYPE_MAXIMUM (off_t
);
3402 end_offset
= st
.st_size
;
3404 /* A negative size can happen on a platform that allows file
3405 sizes greater than the maximum off_t value. */
3409 /* The file size returned from stat may be zero, but data
3410 may be readable nonetheless, for example when this is a
3411 file in the /proc filesystem. */
3412 if (end_offset
== 0)
3413 end_offset
= READ_BUF_SIZE
;
3417 /* Check now whether the buffer will become too large,
3418 in the likely case where the file's length is not changing.
3419 This saves a lot of needless work before a buffer overflow. */
3422 /* The likely offset where we will stop reading. We could read
3423 more (or less), if the file grows (or shrinks) as we read it. */
3424 off_t likely_end
= min (end_offset
, st
.st_size
);
3426 if (beg_offset
< likely_end
)
3428 ptrdiff_t buf_bytes
=
3429 Z_BYTE
- (!NILP (replace
) ? ZV_BYTE
- BEGV_BYTE
: 0);
3430 ptrdiff_t buf_growth_max
= BUF_BYTES_MAX
- buf_bytes
;
3431 off_t likely_growth
= likely_end
- beg_offset
;
3432 if (buf_growth_max
< likely_growth
)
3437 /* Prevent redisplay optimizations. */
3438 current_buffer
->clip_changed
= 1;
3440 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3442 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3443 setup_coding_system (coding_system
, &coding
);
3444 /* Ensure we set Vlast_coding_system_used. */
3445 set_coding_system
= 1;
3449 /* Decide the coding system to use for reading the file now
3450 because we can't use an optimized method for handling
3451 `coding:' tag if the current buffer is not empty. */
3452 if (!NILP (Vcoding_system_for_read
))
3453 coding_system
= Vcoding_system_for_read
;
3456 /* Don't try looking inside a file for a coding system
3457 specification if it is not seekable. */
3458 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3460 /* Find a coding system specified in the heading two
3461 lines or in the tailing several lines of the file.
3462 We assume that the 1K-byte and 3K-byte for heading
3463 and tailing respectively are sufficient for this
3467 if (st
.st_size
<= (1024 * 4))
3468 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3471 nread
= emacs_read (fd
, read_buf
, 1024);
3474 if (lseek (fd
, st
.st_size
- (1024 * 3), SEEK_SET
) < 0)
3475 report_file_error ("Setting file position",
3476 Fcons (orig_filename
, Qnil
));
3477 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3482 error ("IO error reading %s: %s",
3483 SDATA (orig_filename
), emacs_strerror (errno
));
3486 struct buffer
*prev
= current_buffer
;
3487 Lisp_Object workbuf
;
3490 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3492 workbuf
= Fget_buffer_create (build_string (" *code-converting-work*"));
3493 buf
= XBUFFER (workbuf
);
3495 delete_all_overlays (buf
);
3496 BVAR (buf
, directory
) = BVAR (current_buffer
, directory
);
3497 BVAR (buf
, read_only
) = Qnil
;
3498 BVAR (buf
, filename
) = Qnil
;
3499 BVAR (buf
, undo_list
) = Qt
;
3500 eassert (buf
->overlays_before
== NULL
);
3501 eassert (buf
->overlays_after
== NULL
);
3503 set_buffer_internal (buf
);
3505 BVAR (buf
, enable_multibyte_characters
) = Qnil
;
3507 insert_1_both ((char *) read_buf
, nread
, nread
, 0, 0, 0);
3508 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3509 coding_system
= call2 (Vset_auto_coding_function
,
3510 filename
, make_number (nread
));
3511 set_buffer_internal (prev
);
3513 /* Discard the unwind protect for recovering the
3517 /* Rewind the file for the actual read done later. */
3518 if (lseek (fd
, 0, SEEK_SET
) < 0)
3519 report_file_error ("Setting file position",
3520 Fcons (orig_filename
, Qnil
));
3524 if (NILP (coding_system
))
3526 /* If we have not yet decided a coding system, check
3527 file-coding-system-alist. */
3528 Lisp_Object args
[6];
3530 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3531 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3532 coding_system
= Ffind_operation_coding_system (6, args
);
3533 if (CONSP (coding_system
))
3534 coding_system
= XCAR (coding_system
);
3538 if (NILP (coding_system
))
3539 coding_system
= Qundecided
;
3541 CHECK_CODING_SYSTEM (coding_system
);
3543 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3544 /* We must suppress all character code conversion except for
3545 end-of-line conversion. */
3546 coding_system
= raw_text_coding_system (coding_system
);
3548 setup_coding_system (coding_system
, &coding
);
3549 /* Ensure we set Vlast_coding_system_used. */
3550 set_coding_system
= 1;
3553 /* If requested, replace the accessible part of the buffer
3554 with the file contents. Avoid replacing text at the
3555 beginning or end of the buffer that matches the file contents;
3556 that preserves markers pointing to the unchanged parts.
3558 Here we implement this feature in an optimized way
3559 for the case where code conversion is NOT needed.
3560 The following if-statement handles the case of conversion
3561 in a less optimal way.
3563 If the code conversion is "automatic" then we try using this
3564 method and hope for the best.
3565 But if we discover the need for conversion, we give up on this method
3566 and let the following if-statement handle the replace job. */
3569 && (NILP (coding_system
)
3570 || ! CODING_REQUIRE_DECODING (&coding
)))
3572 /* same_at_start and same_at_end count bytes,
3573 because file access counts bytes
3574 and BEG and END count bytes. */
3575 ptrdiff_t same_at_start
= BEGV_BYTE
;
3576 ptrdiff_t same_at_end
= ZV_BYTE
;
3578 /* There is still a possibility we will find the need to do code
3579 conversion. If that happens, we set this variable to 1 to
3580 give up on handling REPLACE in the optimized way. */
3581 int giveup_match_end
= 0;
3583 if (beg_offset
!= 0)
3585 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
3586 report_file_error ("Setting file position",
3587 Fcons (orig_filename
, Qnil
));
3592 /* Count how many chars at the start of the file
3593 match the text at the beginning of the buffer. */
3598 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3600 error ("IO error reading %s: %s",
3601 SSDATA (orig_filename
), emacs_strerror (errno
));
3602 else if (nread
== 0)
3605 if (CODING_REQUIRE_DETECTION (&coding
))
3607 coding_system
= detect_coding_system ((unsigned char *) buffer
,
3610 setup_coding_system (coding_system
, &coding
);
3613 if (CODING_REQUIRE_DECODING (&coding
))
3614 /* We found that the file should be decoded somehow.
3615 Let's give up here. */
3617 giveup_match_end
= 1;
3622 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3623 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3624 same_at_start
++, bufpos
++;
3625 /* If we found a discrepancy, stop the scan.
3626 Otherwise loop around and scan the next bufferful. */
3627 if (bufpos
!= nread
)
3631 /* If the file matches the buffer completely,
3632 there's no need to replace anything. */
3633 if (same_at_start
- BEGV_BYTE
== end_offset
- beg_offset
)
3637 /* Truncate the buffer to the size of the file. */
3638 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3643 /* Count how many chars at the end of the file
3644 match the text at the end of the buffer. But, if we have
3645 already found that decoding is necessary, don't waste time. */
3646 while (!giveup_match_end
)
3648 int total_read
, nread
, bufpos
, trial
;
3651 /* At what file position are we now scanning? */
3652 curpos
= end_offset
- (ZV_BYTE
- same_at_end
);
3653 /* If the entire file matches the buffer tail, stop the scan. */
3656 /* How much can we scan in the next step? */
3657 trial
= min (curpos
, sizeof buffer
);
3658 if (lseek (fd
, curpos
- trial
, SEEK_SET
) < 0)
3659 report_file_error ("Setting file position",
3660 Fcons (orig_filename
, Qnil
));
3662 total_read
= nread
= 0;
3663 while (total_read
< trial
)
3665 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3667 error ("IO error reading %s: %s",
3668 SDATA (orig_filename
), emacs_strerror (errno
));
3669 else if (nread
== 0)
3671 total_read
+= nread
;
3674 /* Scan this bufferful from the end, comparing with
3675 the Emacs buffer. */
3676 bufpos
= total_read
;
3678 /* Compare with same_at_start to avoid counting some buffer text
3679 as matching both at the file's beginning and at the end. */
3680 while (bufpos
> 0 && same_at_end
> same_at_start
3681 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3682 same_at_end
--, bufpos
--;
3684 /* If we found a discrepancy, stop the scan.
3685 Otherwise loop around and scan the preceding bufferful. */
3688 /* If this discrepancy is because of code conversion,
3689 we cannot use this method; giveup and try the other. */
3690 if (same_at_end
> same_at_start
3691 && FETCH_BYTE (same_at_end
- 1) >= 0200
3692 && ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3693 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3694 giveup_match_end
= 1;
3703 if (! giveup_match_end
)
3707 /* We win! We can handle REPLACE the optimized way. */
3709 /* Extend the start of non-matching text area to multibyte
3710 character boundary. */
3711 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3712 while (same_at_start
> BEGV_BYTE
3713 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3716 /* Extend the end of non-matching text area to multibyte
3717 character boundary. */
3718 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3719 while (same_at_end
< ZV_BYTE
3720 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3723 /* Don't try to reuse the same piece of text twice. */
3724 overlap
= (same_at_start
- BEGV_BYTE
3726 + (! NILP (end
) ? end_offset
: st
.st_size
) - ZV_BYTE
));
3728 same_at_end
+= overlap
;
3730 /* Arrange to read only the nonmatching middle part of the file. */
3731 beg_offset
+= same_at_start
- BEGV_BYTE
;
3732 end_offset
-= ZV_BYTE
- same_at_end
;
3734 del_range_byte (same_at_start
, same_at_end
, 0);
3735 /* Insert from the file at the proper position. */
3736 temp
= BYTE_TO_CHAR (same_at_start
);
3737 SET_PT_BOTH (temp
, same_at_start
);
3739 /* If display currently starts at beginning of line,
3740 keep it that way. */
3741 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3742 XWINDOW (selected_window
)->start_at_line_beg
= !NILP (Fbolp ());
3744 replace_handled
= 1;
3748 /* If requested, replace the accessible part of the buffer
3749 with the file contents. Avoid replacing text at the
3750 beginning or end of the buffer that matches the file contents;
3751 that preserves markers pointing to the unchanged parts.
3753 Here we implement this feature for the case where code conversion
3754 is needed, in a simple way that needs a lot of memory.
3755 The preceding if-statement handles the case of no conversion
3756 in a more optimized way. */
3757 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3759 ptrdiff_t same_at_start
= BEGV_BYTE
;
3760 ptrdiff_t same_at_end
= ZV_BYTE
;
3761 ptrdiff_t same_at_start_charpos
;
3762 ptrdiff_t inserted_chars
;
3765 unsigned char *decoded
;
3768 ptrdiff_t this_count
= SPECPDL_INDEX ();
3769 int multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
3770 Lisp_Object conversion_buffer
;
3771 struct gcpro gcpro1
;
3773 conversion_buffer
= code_conversion_save (1, multibyte
);
3775 /* First read the whole file, performing code conversion into
3776 CONVERSION_BUFFER. */
3778 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
3779 report_file_error ("Setting file position",
3780 Fcons (orig_filename
, Qnil
));
3782 total
= st
.st_size
; /* Total bytes in the file. */
3783 how_much
= 0; /* Bytes read from file so far. */
3784 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3785 unprocessed
= 0; /* Bytes not processed in previous loop. */
3787 GCPRO1 (conversion_buffer
);
3788 while (how_much
< total
)
3790 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
3791 quitting while reading a huge while. */
3792 /* `try'' is reserved in some compilers (Microsoft C). */
3793 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3795 /* Allow quitting out of the actual I/O. */
3798 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
3806 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
3807 BUF_Z (XBUFFER (conversion_buffer
)));
3808 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3809 unprocessed
+ this, conversion_buffer
);
3810 unprocessed
= coding
.carryover_bytes
;
3811 if (coding
.carryover_bytes
> 0)
3812 memcpy (read_buf
, coding
.carryover
, unprocessed
);
3817 /* We should remove the unwind_protect calling
3818 close_file_unwind, but other stuff has been added the stack,
3819 so defer the removal till we reach the `handled' label. */
3820 deferred_remove_unwind_protect
= 1;
3822 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
3823 if we couldn't read the file. */
3826 error ("IO error reading %s: %s",
3827 SDATA (orig_filename
), emacs_strerror (errno
));
3829 if (unprocessed
> 0)
3831 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3832 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3833 unprocessed
, conversion_buffer
);
3834 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
3837 coding_system
= CODING_ID_NAME (coding
.id
);
3838 set_coding_system
= 1;
3839 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
3840 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
3841 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3843 /* Compare the beginning of the converted string with the buffer
3847 while (bufpos
< inserted
&& same_at_start
< same_at_end
3848 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
3849 same_at_start
++, bufpos
++;
3851 /* If the file matches the head of buffer completely,
3852 there's no need to replace anything. */
3854 if (bufpos
== inserted
)
3856 /* Truncate the buffer to the size of the file. */
3857 if (same_at_start
== same_at_end
)
3860 del_range_byte (same_at_start
, same_at_end
, 0);
3863 unbind_to (this_count
, Qnil
);
3867 /* Extend the start of non-matching text area to the previous
3868 multibyte character boundary. */
3869 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3870 while (same_at_start
> BEGV_BYTE
3871 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3874 /* Scan this bufferful from the end, comparing with
3875 the Emacs buffer. */
3878 /* Compare with same_at_start to avoid counting some buffer text
3879 as matching both at the file's beginning and at the end. */
3880 while (bufpos
> 0 && same_at_end
> same_at_start
3881 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
3882 same_at_end
--, bufpos
--;
3884 /* Extend the end of non-matching text area to the next
3885 multibyte character boundary. */
3886 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3887 while (same_at_end
< ZV_BYTE
3888 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3891 /* Don't try to reuse the same piece of text twice. */
3892 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3894 same_at_end
+= overlap
;
3896 /* If display currently starts at beginning of line,
3897 keep it that way. */
3898 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3899 XWINDOW (selected_window
)->start_at_line_beg
= !NILP (Fbolp ());
3901 /* Replace the chars that we need to replace,
3902 and update INSERTED to equal the number of bytes
3903 we are taking from the decoded string. */
3904 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
3906 if (same_at_end
!= same_at_start
)
3908 del_range_byte (same_at_start
, same_at_end
, 0);
3910 same_at_start
= GPT_BYTE
;
3914 temp
= BYTE_TO_CHAR (same_at_start
);
3916 /* Insert from the file at the proper position. */
3917 SET_PT_BOTH (temp
, same_at_start
);
3918 same_at_start_charpos
3919 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3920 same_at_start
- BEGV_BYTE
3921 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3923 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3924 same_at_start
+ inserted
- BEGV_BYTE
3925 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
3926 - same_at_start_charpos
);
3927 /* This binding is to avoid ask-user-about-supersession-threat
3928 being called in insert_from_buffer (via in
3929 prepare_to_modify_buffer). */
3930 specbind (intern ("buffer-file-name"), Qnil
);
3931 insert_from_buffer (XBUFFER (conversion_buffer
),
3932 same_at_start_charpos
, inserted_chars
, 0);
3933 /* Set `inserted' to the number of inserted characters. */
3934 inserted
= PT
- temp
;
3935 /* Set point before the inserted characters. */
3936 SET_PT_BOTH (temp
, same_at_start
);
3938 unbind_to (this_count
, Qnil
);
3944 total
= end_offset
- beg_offset
;
3946 /* For a special file, all we can do is guess. */
3947 total
= READ_BUF_SIZE
;
3949 if (NILP (visit
) && total
> 0)
3951 #ifdef CLASH_DETECTION
3952 if (!NILP (BVAR (current_buffer
, file_truename
))
3953 /* Make binding buffer-file-name to nil effective. */
3954 && !NILP (BVAR (current_buffer
, filename
))
3955 && SAVE_MODIFF
>= MODIFF
)
3957 #endif /* CLASH_DETECTION */
3958 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
3962 if (GAP_SIZE
< total
)
3963 make_gap (total
- GAP_SIZE
);
3965 if (beg_offset
!= 0 || !NILP (replace
))
3967 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
3968 report_file_error ("Setting file position",
3969 Fcons (orig_filename
, Qnil
));
3972 /* In the following loop, HOW_MUCH contains the total bytes read so
3973 far for a regular file, and not changed for a special file. But,
3974 before exiting the loop, it is set to a negative value if I/O
3978 /* Total bytes inserted. */
3981 /* Here, we don't do code conversion in the loop. It is done by
3982 decode_coding_gap after all data are read into the buffer. */
3984 ptrdiff_t gap_size
= GAP_SIZE
;
3986 while (how_much
< total
)
3988 /* try is reserved in some compilers (Microsoft C) */
3989 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3996 /* Maybe make more room. */
3997 if (gap_size
< trytry
)
3999 make_gap (total
- gap_size
);
4000 gap_size
= GAP_SIZE
;
4003 /* Read from the file, capturing `quit'. When an
4004 error occurs, end the loop, and arrange for a quit
4005 to be signaled after decoding the text we read. */
4006 non_regular_fd
= fd
;
4007 non_regular_inserted
= inserted
;
4008 non_regular_nbytes
= trytry
;
4009 nbytes
= internal_condition_case_1 (read_non_regular
,
4011 read_non_regular_quit
);
4018 this = XINT (nbytes
);
4022 /* Allow quitting out of the actual I/O. We don't make text
4023 part of the buffer until all the reading is done, so a C-g
4024 here doesn't do any harm. */
4027 this = emacs_read (fd
,
4028 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
4042 /* For a regular file, where TOTAL is the real size,
4043 count HOW_MUCH to compare with it.
4044 For a special file, where TOTAL is just a buffer size,
4045 so don't bother counting in HOW_MUCH.
4046 (INSERTED is where we count the number of characters inserted.) */
4053 /* Now we have read all the file data into the gap.
4054 If it was empty, undo marking the buffer modified. */
4058 #ifdef CLASH_DETECTION
4060 unlock_file (BVAR (current_buffer
, file_truename
));
4062 Vdeactivate_mark
= old_Vdeactivate_mark
;
4065 Vdeactivate_mark
= Qt
;
4067 /* Make the text read part of the buffer. */
4068 GAP_SIZE
-= inserted
;
4070 GPT_BYTE
+= inserted
;
4072 ZV_BYTE
+= inserted
;
4077 /* Put an anchor to ensure multi-byte form ends at gap. */
4082 /* Discard the unwind protect for closing the file. */
4086 error ("IO error reading %s: %s",
4087 SDATA (orig_filename
), emacs_strerror (errno
));
4091 if (NILP (coding_system
))
4093 /* The coding system is not yet decided. Decide it by an
4094 optimized method for handling `coding:' tag.
4096 Note that we can get here only if the buffer was empty
4097 before the insertion. */
4099 if (!NILP (Vcoding_system_for_read
))
4100 coding_system
= Vcoding_system_for_read
;
4103 /* Since we are sure that the current buffer was empty
4104 before the insertion, we can toggle
4105 enable-multibyte-characters directly here without taking
4106 care of marker adjustment. By this way, we can run Lisp
4107 program safely before decoding the inserted text. */
4108 Lisp_Object unwind_data
;
4109 ptrdiff_t count1
= SPECPDL_INDEX ();
4111 unwind_data
= Fcons (BVAR (current_buffer
, enable_multibyte_characters
),
4112 Fcons (BVAR (current_buffer
, undo_list
),
4113 Fcurrent_buffer ()));
4114 BVAR (current_buffer
, enable_multibyte_characters
) = Qnil
;
4115 BVAR (current_buffer
, undo_list
) = Qt
;
4116 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4118 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4120 coding_system
= call2 (Vset_auto_coding_function
,
4121 filename
, make_number (inserted
));
4124 if (NILP (coding_system
))
4126 /* If the coding system is not yet decided, check
4127 file-coding-system-alist. */
4128 Lisp_Object args
[6];
4130 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4131 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4132 coding_system
= Ffind_operation_coding_system (6, args
);
4133 if (CONSP (coding_system
))
4134 coding_system
= XCAR (coding_system
);
4136 unbind_to (count1
, Qnil
);
4137 inserted
= Z_BYTE
- BEG_BYTE
;
4140 if (NILP (coding_system
))
4141 coding_system
= Qundecided
;
4143 CHECK_CODING_SYSTEM (coding_system
);
4145 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4146 /* We must suppress all character code conversion except for
4147 end-of-line conversion. */
4148 coding_system
= raw_text_coding_system (coding_system
);
4149 setup_coding_system (coding_system
, &coding
);
4150 /* Ensure we set Vlast_coding_system_used. */
4151 set_coding_system
= 1;
4156 /* When we visit a file by raw-text, we change the buffer to
4158 if (CODING_FOR_UNIBYTE (&coding
)
4159 /* Can't do this if part of the buffer might be preserved. */
4161 /* Visiting a file with these coding system makes the buffer
4163 BVAR (current_buffer
, enable_multibyte_characters
) = Qnil
;
4166 coding
.dst_multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
4167 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4168 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4170 move_gap_both (PT
, PT_BYTE
);
4171 GAP_SIZE
+= inserted
;
4172 ZV_BYTE
-= inserted
;
4176 decode_coding_gap (&coding
, inserted
, inserted
);
4177 inserted
= coding
.produced_char
;
4178 coding_system
= CODING_ID_NAME (coding
.id
);
4180 else if (inserted
> 0)
4181 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4184 /* Call after-change hooks for the inserted text, aside from the case
4185 of normal visiting (not with REPLACE), which is done in a new buffer
4186 "before" the buffer is changed. */
4187 if (inserted
> 0 && total
> 0
4188 && (NILP (visit
) || !NILP (replace
)))
4190 signal_after_change (PT
, 0, inserted
);
4191 update_compositions (PT
, PT
, CHECK_BORDER
);
4194 /* Now INSERTED is measured in characters. */
4198 if (deferred_remove_unwind_protect
)
4199 /* If requested above, discard the unwind protect for closing the
4205 if (!EQ (BVAR (current_buffer
, undo_list
), Qt
) && !nochange
)
4206 BVAR (current_buffer
, undo_list
) = Qnil
;
4210 current_buffer
->modtime
= mtime
;
4211 current_buffer
->modtime_size
= st
.st_size
;
4212 BVAR (current_buffer
, filename
) = orig_filename
;
4215 SAVE_MODIFF
= MODIFF
;
4216 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
4217 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4218 #ifdef CLASH_DETECTION
4221 if (!NILP (BVAR (current_buffer
, file_truename
)))
4222 unlock_file (BVAR (current_buffer
, file_truename
));
4223 unlock_file (filename
);
4225 #endif /* CLASH_DETECTION */
4227 xsignal2 (Qfile_error
,
4228 build_string ("not a regular file"), orig_filename
);
4231 if (set_coding_system
)
4232 Vlast_coding_system_used
= coding_system
;
4234 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4236 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4238 if (! NILP (insval
))
4240 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4241 wrong_type_argument (intern ("inserted-chars"), insval
);
4242 inserted
= XFASTINT (insval
);
4246 /* Decode file format. */
4249 /* Don't run point motion or modification hooks when decoding. */
4250 ptrdiff_t count1
= SPECPDL_INDEX ();
4251 ptrdiff_t old_inserted
= inserted
;
4252 specbind (Qinhibit_point_motion_hooks
, Qt
);
4253 specbind (Qinhibit_modification_hooks
, Qt
);
4255 /* Save old undo list and don't record undo for decoding. */
4256 old_undo
= BVAR (current_buffer
, undo_list
);
4257 BVAR (current_buffer
, undo_list
) = Qt
;
4261 insval
= call3 (Qformat_decode
,
4262 Qnil
, make_number (inserted
), visit
);
4263 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4264 wrong_type_argument (intern ("inserted-chars"), insval
);
4265 inserted
= XFASTINT (insval
);
4269 /* If REPLACE is non-nil and we succeeded in not replacing the
4270 beginning or end of the buffer text with the file's contents,
4271 call format-decode with `point' positioned at the beginning
4272 of the buffer and `inserted' equaling the number of
4273 characters in the buffer. Otherwise, format-decode might
4274 fail to correctly analyze the beginning or end of the buffer.
4275 Hence we temporarily save `point' and `inserted' here and
4276 restore `point' iff format-decode did not insert or delete
4277 any text. Otherwise we leave `point' at point-min. */
4278 ptrdiff_t opoint
= PT
;
4279 ptrdiff_t opoint_byte
= PT_BYTE
;
4280 ptrdiff_t oinserted
= ZV
- BEGV
;
4281 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4283 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4284 insval
= call3 (Qformat_decode
,
4285 Qnil
, make_number (oinserted
), visit
);
4286 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4287 wrong_type_argument (intern ("inserted-chars"), insval
);
4288 if (ochars_modiff
== CHARS_MODIFF
)
4289 /* format_decode didn't modify buffer's characters => move
4290 point back to position before inserted text and leave
4291 value of inserted alone. */
4292 SET_PT_BOTH (opoint
, opoint_byte
);
4294 /* format_decode modified buffer's characters => consider
4295 entire buffer changed and leave point at point-min. */
4296 inserted
= XFASTINT (insval
);
4299 /* For consistency with format-decode call these now iff inserted > 0
4300 (martin 2007-06-28). */
4301 p
= Vafter_insert_file_functions
;
4306 insval
= call1 (XCAR (p
), make_number (inserted
));
4309 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4310 wrong_type_argument (intern ("inserted-chars"), insval
);
4311 inserted
= XFASTINT (insval
);
4316 /* For the rationale of this see the comment on
4317 format-decode above. */
4318 ptrdiff_t opoint
= PT
;
4319 ptrdiff_t opoint_byte
= PT_BYTE
;
4320 ptrdiff_t oinserted
= ZV
- BEGV
;
4321 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4323 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4324 insval
= call1 (XCAR (p
), make_number (oinserted
));
4327 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4328 wrong_type_argument (intern ("inserted-chars"), insval
);
4329 if (ochars_modiff
== CHARS_MODIFF
)
4330 /* after_insert_file_functions didn't modify
4331 buffer's characters => move point back to
4332 position before inserted text and leave value of
4334 SET_PT_BOTH (opoint
, opoint_byte
);
4336 /* after_insert_file_functions did modify buffer's
4337 characters => consider entire buffer changed and
4338 leave point at point-min. */
4339 inserted
= XFASTINT (insval
);
4349 BVAR (current_buffer
, undo_list
) = old_undo
;
4350 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4352 /* Adjust the last undo record for the size change during
4353 the format conversion. */
4354 Lisp_Object tem
= XCAR (old_undo
);
4355 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4356 && INTEGERP (XCDR (tem
))
4357 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4358 XSETCDR (tem
, make_number (PT
+ inserted
));
4362 /* If undo_list was Qt before, keep it that way.
4363 Otherwise start with an empty undo_list. */
4364 BVAR (current_buffer
, undo_list
) = EQ (old_undo
, Qt
) ? Qt
: Qnil
;
4366 unbind_to (count1
, Qnil
);
4370 && EMACS_NSECS (current_buffer
->modtime
) == NONEXISTENT_MODTIME_NSECS
)
4372 /* If visiting nonexistent file, return nil. */
4374 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4378 Fsignal (Qquit
, Qnil
);
4380 /* ??? Retval needs to be dealt with in all cases consistently. */
4382 val
= Fcons (orig_filename
,
4383 Fcons (make_number (inserted
),
4386 RETURN_UNGCPRO (unbind_to (count
, val
));
4389 static Lisp_Object
build_annotations (Lisp_Object
, Lisp_Object
);
4392 build_annotations_unwind (Lisp_Object arg
)
4394 Vwrite_region_annotation_buffers
= arg
;
4398 /* Decide the coding-system to encode the data with. */
4401 choose_write_coding_system (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4402 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
,
4403 struct coding_system
*coding
)
4406 Lisp_Object eol_parent
= Qnil
;
4409 && NILP (Fstring_equal (BVAR (current_buffer
, filename
),
4410 BVAR (current_buffer
, auto_save_file_name
))))
4415 else if (!NILP (Vcoding_system_for_write
))
4417 val
= Vcoding_system_for_write
;
4418 if (coding_system_require_warning
4419 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4420 /* Confirm that VAL can surely encode the current region. */
4421 val
= call5 (Vselect_safe_coding_system_function
,
4422 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4427 /* If the variable `buffer-file-coding-system' is set locally,
4428 it means that the file was read with some kind of code
4429 conversion or the variable is explicitly set by users. We
4430 had better write it out with the same coding system even if
4431 `enable-multibyte-characters' is nil.
4433 If it is not set locally, we anyway have to convert EOL
4434 format if the default value of `buffer-file-coding-system'
4435 tells that it is not Unix-like (LF only) format. */
4436 int using_default_coding
= 0;
4437 int force_raw_text
= 0;
4439 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4441 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4444 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4450 /* Check file-coding-system-alist. */
4451 Lisp_Object args
[7], coding_systems
;
4453 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4454 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4456 coding_systems
= Ffind_operation_coding_system (7, args
);
4457 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4458 val
= XCDR (coding_systems
);
4463 /* If we still have not decided a coding system, use the
4464 default value of buffer-file-coding-system. */
4465 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4466 using_default_coding
= 1;
4469 if (! NILP (val
) && ! force_raw_text
)
4471 Lisp_Object spec
, attrs
;
4473 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4474 attrs
= AREF (spec
, 0);
4475 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4480 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4481 /* Confirm that VAL can surely encode the current region. */
4482 val
= call5 (Vselect_safe_coding_system_function
,
4483 start
, end
, val
, Qnil
, filename
);
4485 /* If the decided coding-system doesn't specify end-of-line
4486 format, we use that of
4487 `default-buffer-file-coding-system'. */
4488 if (! using_default_coding
4489 && ! NILP (BVAR (&buffer_defaults
, buffer_file_coding_system
)))
4490 val
= (coding_inherit_eol_type
4491 (val
, BVAR (&buffer_defaults
, buffer_file_coding_system
)));
4493 /* If we decide not to encode text, use `raw-text' or one of its
4496 val
= raw_text_coding_system (val
);
4499 val
= coding_inherit_eol_type (val
, eol_parent
);
4500 setup_coding_system (val
, coding
);
4502 if (!STRINGP (start
) && !NILP (BVAR (current_buffer
, selective_display
)))
4503 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4507 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4508 "r\nFWrite region to file: \ni\ni\ni\np",
4509 doc
: /* Write current region into specified file.
4510 When called from a program, requires three arguments:
4511 START, END and FILENAME. START and END are normally buffer positions
4512 specifying the part of the buffer to write.
4513 If START is nil, that means to use the entire buffer contents.
4514 If START is a string, then output that string to the file
4515 instead of any buffer contents; END is ignored.
4517 Optional fourth argument APPEND if non-nil means
4518 append to existing file contents (if any). If it is an integer,
4519 seek to that offset in the file before writing.
4520 Optional fifth argument VISIT, if t or a string, means
4521 set the last-save-file-modtime of buffer to this file's modtime
4522 and mark buffer not modified.
4523 If VISIT is a string, it is a second file name;
4524 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4525 VISIT is also the file name to lock and unlock for clash detection.
4526 If VISIT is neither t nor nil nor a string,
4527 that means do not display the \"Wrote file\" message.
4528 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4529 use for locking and unlocking, overriding FILENAME and VISIT.
4530 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4531 for an existing file with the same name. If MUSTBENEW is `excl',
4532 that means to get an error if the file already exists; never overwrite.
4533 If MUSTBENEW is neither nil nor `excl', that means ask for
4534 confirmation before overwriting, but do go ahead and overwrite the file
4535 if the user confirms.
4537 This does code conversion according to the value of
4538 `coding-system-for-write', `buffer-file-coding-system', or
4539 `file-coding-system-alist', and sets the variable
4540 `last-coding-system-used' to the coding system actually used.
4542 This calls `write-region-annotate-functions' at the start, and
4543 `write-region-post-annotation-function' at the end. */)
4544 (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
, Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
, Lisp_Object mustbenew
)
4551 ptrdiff_t count
= SPECPDL_INDEX ();
4553 Lisp_Object handler
;
4554 Lisp_Object visit_file
;
4555 Lisp_Object annotations
;
4556 Lisp_Object encoded_filename
;
4557 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4558 int quietly
= !NILP (visit
);
4559 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4560 struct buffer
*given_buffer
;
4561 struct coding_system coding
;
4563 if (current_buffer
->base_buffer
&& visiting
)
4564 error ("Cannot do file visiting in an indirect buffer");
4566 if (!NILP (start
) && !STRINGP (start
))
4567 validate_region (&start
, &end
);
4570 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4572 filename
= Fexpand_file_name (filename
, Qnil
);
4574 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4575 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4577 if (STRINGP (visit
))
4578 visit_file
= Fexpand_file_name (visit
, Qnil
);
4580 visit_file
= filename
;
4582 if (NILP (lockname
))
4583 lockname
= visit_file
;
4587 /* If the file name has special constructs in it,
4588 call the corresponding file handler. */
4589 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4590 /* If FILENAME has no handler, see if VISIT has one. */
4591 if (NILP (handler
) && STRINGP (visit
))
4592 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4594 if (!NILP (handler
))
4597 val
= call6 (handler
, Qwrite_region
, start
, end
,
4598 filename
, append
, visit
);
4602 SAVE_MODIFF
= MODIFF
;
4603 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4604 BVAR (current_buffer
, filename
) = visit_file
;
4610 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4612 /* Special kludge to simplify auto-saving. */
4615 /* Do it later, so write-region-annotate-function can work differently
4616 if we save "the buffer" vs "a region".
4617 This is useful in tar-mode. --Stef
4618 XSETFASTINT (start, BEG);
4619 XSETFASTINT (end, Z); */
4623 record_unwind_protect (build_annotations_unwind
,
4624 Vwrite_region_annotation_buffers
);
4625 Vwrite_region_annotation_buffers
= Fcons (Fcurrent_buffer (), Qnil
);
4626 count1
= SPECPDL_INDEX ();
4628 given_buffer
= current_buffer
;
4630 if (!STRINGP (start
))
4632 annotations
= build_annotations (start
, end
);
4634 if (current_buffer
!= given_buffer
)
4636 XSETFASTINT (start
, BEGV
);
4637 XSETFASTINT (end
, ZV
);
4643 XSETFASTINT (start
, BEGV
);
4644 XSETFASTINT (end
, ZV
);
4649 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4651 /* Decide the coding-system to encode the data with.
4652 We used to make this choice before calling build_annotations, but that
4653 leads to problems when a write-annotate-function takes care of
4654 unsavable chars (as was the case with X-Symbol). */
4655 Vlast_coding_system_used
4656 = choose_write_coding_system (start
, end
, filename
,
4657 append
, visit
, lockname
, &coding
);
4659 #ifdef CLASH_DETECTION
4661 lock_file (lockname
);
4662 #endif /* CLASH_DETECTION */
4664 encoded_filename
= ENCODE_FILE (filename
);
4666 fn
= SSDATA (encoded_filename
);
4670 desc
= emacs_open (fn
, O_WRONLY
| O_BINARY
, 0);
4671 #else /* not DOS_NT */
4672 desc
= emacs_open (fn
, O_WRONLY
, 0);
4673 #endif /* not DOS_NT */
4675 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4677 desc
= emacs_open (fn
,
4678 O_WRONLY
| O_CREAT
| O_BINARY
4679 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4680 S_IREAD
| S_IWRITE
);
4681 #else /* not DOS_NT */
4682 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4683 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4684 auto_saving
? auto_save_mode_bits
: 0666);
4685 #endif /* not DOS_NT */
4689 #ifdef CLASH_DETECTION
4691 if (!auto_saving
) unlock_file (lockname
);
4693 #endif /* CLASH_DETECTION */
4695 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4698 record_unwind_protect (close_file_unwind
, make_number (desc
));
4700 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4704 if (NUMBERP (append
))
4705 ret
= emacs_lseek (desc
, XINT (append
), SEEK_CUR
);
4707 ret
= lseek (desc
, 0, SEEK_END
);
4710 #ifdef CLASH_DETECTION
4712 if (!auto_saving
) unlock_file (lockname
);
4714 #endif /* CLASH_DETECTION */
4716 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4725 if (STRINGP (start
))
4727 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
4728 &annotations
, &coding
);
4731 else if (XINT (start
) != XINT (end
))
4733 failure
= 0 > a_write (desc
, Qnil
,
4734 XINT (start
), XINT (end
) - XINT (start
),
4735 &annotations
, &coding
);
4740 /* If file was empty, still need to write the annotations */
4741 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4742 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4746 if (CODING_REQUIRE_FLUSHING (&coding
)
4747 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4750 /* We have to flush out a data. */
4751 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4752 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
4759 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4760 Disk full in NFS may be reported here. */
4761 /* mib says that closing the file will try to write as fast as NFS can do
4762 it, and that means the fsync here is not crucial for autosave files. */
4763 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
4765 /* If fsync fails with EINTR, don't treat that as serious. Also
4766 ignore EINVAL which happens when fsync is not supported on this
4768 if (errno
!= EINTR
&& errno
!= EINVAL
)
4769 failure
= 1, save_errno
= errno
;
4773 /* NFS can report a write failure now. */
4774 if (emacs_close (desc
) < 0)
4775 failure
= 1, save_errno
= errno
;
4779 /* Discard the unwind protect for close_file_unwind. */
4780 specpdl_ptr
= specpdl
+ count1
;
4782 /* Call write-region-post-annotation-function. */
4783 while (CONSP (Vwrite_region_annotation_buffers
))
4785 Lisp_Object buf
= XCAR (Vwrite_region_annotation_buffers
);
4786 if (!NILP (Fbuffer_live_p (buf
)))
4789 if (FUNCTIONP (Vwrite_region_post_annotation_function
))
4790 call0 (Vwrite_region_post_annotation_function
);
4792 Vwrite_region_annotation_buffers
4793 = XCDR (Vwrite_region_annotation_buffers
);
4796 unbind_to (count
, Qnil
);
4798 #ifdef CLASH_DETECTION
4800 unlock_file (lockname
);
4801 #endif /* CLASH_DETECTION */
4803 /* Do this before reporting IO error
4804 to avoid a "file has changed on disk" warning on
4805 next attempt to save. */
4808 current_buffer
->modtime
= get_stat_mtime (&st
);
4809 current_buffer
->modtime_size
= st
.st_size
;
4813 error ("IO error writing %s: %s", SDATA (filename
),
4814 emacs_strerror (save_errno
));
4818 SAVE_MODIFF
= MODIFF
;
4819 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4820 BVAR (current_buffer
, filename
) = visit_file
;
4821 update_mode_lines
++;
4826 && ! NILP (Fstring_equal (BVAR (current_buffer
, filename
),
4827 BVAR (current_buffer
, auto_save_file_name
))))
4828 SAVE_MODIFF
= MODIFF
;
4834 message_with_string ((INTEGERP (append
)
4844 Lisp_Object
merge (Lisp_Object
, Lisp_Object
, Lisp_Object
);
4846 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4847 doc
: /* Return t if (car A) is numerically less than (car B). */)
4848 (Lisp_Object a
, Lisp_Object b
)
4850 return Flss (Fcar (a
), Fcar (b
));
4853 /* Build the complete list of annotations appropriate for writing out
4854 the text between START and END, by calling all the functions in
4855 write-region-annotate-functions and merging the lists they return.
4856 If one of these functions switches to a different buffer, we assume
4857 that buffer contains altered text. Therefore, the caller must
4858 make sure to restore the current buffer in all cases,
4859 as save-excursion would do. */
4862 build_annotations (Lisp_Object start
, Lisp_Object end
)
4864 Lisp_Object annotations
;
4866 struct gcpro gcpro1
, gcpro2
;
4867 Lisp_Object original_buffer
;
4868 int i
, used_global
= 0;
4870 XSETBUFFER (original_buffer
, current_buffer
);
4873 p
= Vwrite_region_annotate_functions
;
4874 GCPRO2 (annotations
, p
);
4877 struct buffer
*given_buffer
= current_buffer
;
4878 if (EQ (Qt
, XCAR (p
)) && !used_global
)
4879 { /* Use the global value of the hook. */
4882 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
4884 p
= Fappend (2, arg
);
4887 Vwrite_region_annotations_so_far
= annotations
;
4888 res
= call2 (XCAR (p
), start
, end
);
4889 /* If the function makes a different buffer current,
4890 assume that means this buffer contains altered text to be output.
4891 Reset START and END from the buffer bounds
4892 and discard all previous annotations because they should have
4893 been dealt with by this function. */
4894 if (current_buffer
!= given_buffer
)
4896 Vwrite_region_annotation_buffers
4897 = Fcons (Fcurrent_buffer (),
4898 Vwrite_region_annotation_buffers
);
4899 XSETFASTINT (start
, BEGV
);
4900 XSETFASTINT (end
, ZV
);
4903 Flength (res
); /* Check basic validity of return value */
4904 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4908 /* Now do the same for annotation functions implied by the file-format */
4909 if (auto_saving
&& (!EQ (BVAR (current_buffer
, auto_save_file_format
), Qt
)))
4910 p
= BVAR (current_buffer
, auto_save_file_format
);
4912 p
= BVAR (current_buffer
, file_format
);
4913 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
4915 struct buffer
*given_buffer
= current_buffer
;
4917 Vwrite_region_annotations_so_far
= annotations
;
4919 /* Value is either a list of annotations or nil if the function
4920 has written annotations to a temporary buffer, which is now
4922 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
4923 original_buffer
, make_number (i
));
4924 if (current_buffer
!= given_buffer
)
4926 XSETFASTINT (start
, BEGV
);
4927 XSETFASTINT (end
, ZV
);
4932 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4940 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
4941 If STRING is nil, POS is the character position in the current buffer.
4942 Intersperse with them the annotations from *ANNOT
4943 which fall within the range of POS to POS + NCHARS,
4944 each at its appropriate position.
4946 We modify *ANNOT by discarding elements as we use them up.
4948 The return value is negative in case of system call failure. */
4951 a_write (int desc
, Lisp_Object string
, ptrdiff_t pos
,
4952 register ptrdiff_t nchars
, Lisp_Object
*annot
,
4953 struct coding_system
*coding
)
4957 ptrdiff_t lastpos
= pos
+ nchars
;
4959 while (NILP (*annot
) || CONSP (*annot
))
4961 tem
= Fcar_safe (Fcar (*annot
));
4964 nextpos
= XFASTINT (tem
);
4966 /* If there are no more annotations in this range,
4967 output the rest of the range all at once. */
4968 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
4969 return e_write (desc
, string
, pos
, lastpos
, coding
);
4971 /* Output buffer text up to the next annotation's position. */
4974 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
4978 /* Output the annotation. */
4979 tem
= Fcdr (Fcar (*annot
));
4982 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
4985 *annot
= Fcdr (*annot
);
4991 /* Write text in the range START and END into descriptor DESC,
4992 encoding them with coding system CODING. If STRING is nil, START
4993 and END are character positions of the current buffer, else they
4994 are indexes to the string STRING. */
4997 e_write (int desc
, Lisp_Object string
, ptrdiff_t start
, ptrdiff_t end
,
4998 struct coding_system
*coding
)
5000 if (STRINGP (string
))
5003 end
= SCHARS (string
);
5006 /* We used to have a code for handling selective display here. But,
5007 now it is handled within encode_coding. */
5011 if (STRINGP (string
))
5013 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5014 if (CODING_REQUIRE_ENCODING (coding
))
5016 encode_coding_object (coding
, string
,
5017 start
, string_char_to_byte (string
, start
),
5018 end
, string_char_to_byte (string
, end
), Qt
);
5022 coding
->dst_object
= string
;
5023 coding
->consumed_char
= SCHARS (string
);
5024 coding
->produced
= SBYTES (string
);
5029 ptrdiff_t start_byte
= CHAR_TO_BYTE (start
);
5030 ptrdiff_t end_byte
= CHAR_TO_BYTE (end
);
5032 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5033 if (CODING_REQUIRE_ENCODING (coding
))
5035 encode_coding_object (coding
, Fcurrent_buffer (),
5036 start
, start_byte
, end
, end_byte
, Qt
);
5040 coding
->dst_object
= Qnil
;
5041 coding
->dst_pos_byte
= start_byte
;
5042 if (start
>= GPT
|| end
<= GPT
)
5044 coding
->consumed_char
= end
- start
;
5045 coding
->produced
= end_byte
- start_byte
;
5049 coding
->consumed_char
= GPT
- start
;
5050 coding
->produced
= GPT_BYTE
- start_byte
;
5055 if (coding
->produced
> 0)
5059 STRINGP (coding
->dst_object
)
5060 ? SSDATA (coding
->dst_object
)
5061 : (char *) BYTE_POS_ADDR (coding
->dst_pos_byte
),
5064 if (coding
->produced
)
5067 start
+= coding
->consumed_char
;
5073 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5074 Sverify_visited_file_modtime
, 0, 1, 0,
5075 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5076 This means that the file has not been changed since it was visited or saved.
5077 If BUF is omitted or nil, it defaults to the current buffer.
5078 See Info node `(elisp)Modification Time' for more details. */)
5083 Lisp_Object handler
;
5084 Lisp_Object filename
;
5085 EMACS_TIME mtime
, diff
;
5095 if (!STRINGP (BVAR (b
, filename
))) return Qt
;
5096 if (EMACS_NSECS (b
->modtime
) == UNKNOWN_MODTIME_NSECS
) return Qt
;
5098 /* If the file name has special constructs in it,
5099 call the corresponding file handler. */
5100 handler
= Ffind_file_name_handler (BVAR (b
, filename
),
5101 Qverify_visited_file_modtime
);
5102 if (!NILP (handler
))
5103 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5105 filename
= ENCODE_FILE (BVAR (b
, filename
));
5107 mtime
= (stat (SSDATA (filename
), &st
) == 0
5108 ? get_stat_mtime (&st
)
5109 : time_error_value (errno
));
5110 if ((EMACS_TIME_EQ (mtime
, b
->modtime
)
5111 /* If both exist, accept them if they are off by one second. */
5112 || (EMACS_TIME_VALID_P (mtime
) && EMACS_TIME_VALID_P (b
->modtime
)
5113 && ((diff
= (EMACS_TIME_LT (mtime
, b
->modtime
)
5114 ? sub_emacs_time (b
->modtime
, mtime
)
5115 : sub_emacs_time (mtime
, b
->modtime
))),
5116 EMACS_TIME_LE (diff
, make_emacs_time (1, 0)))))
5117 && (st
.st_size
== b
->modtime_size
5118 || b
->modtime_size
< 0))
5123 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5124 Sclear_visited_file_modtime
, 0, 0, 0,
5125 doc
: /* Clear out records of last mod time of visited file.
5126 Next attempt to save will certainly not complain of a discrepancy. */)
5129 current_buffer
->modtime
= make_emacs_time (0, UNKNOWN_MODTIME_NSECS
);
5130 current_buffer
->modtime_size
= -1;
5134 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5135 Svisited_file_modtime
, 0, 0, 0,
5136 doc
: /* Return the current buffer's recorded visited file modification time.
5137 The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
5138 `file-attributes' returns. If the current buffer has no recorded file
5139 modification time, this function returns 0. If the visited file
5140 doesn't exist, HIGH will be -1.
5141 See Info node `(elisp)Modification Time' for more details. */)
5144 if (EMACS_NSECS (current_buffer
->modtime
) < 0)
5145 return make_number (0);
5146 return make_lisp_time (current_buffer
->modtime
);
5149 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5150 Sset_visited_file_modtime
, 0, 1, 0,
5151 doc
: /* Update buffer's recorded modification time from the visited file's time.
5152 Useful if the buffer was not read from the file normally
5153 or if the file itself has been changed for some known benign reason.
5154 An argument specifies the modification time value to use
5155 \(instead of that of the visited file), in the form of a list
5156 \(HIGH LOW USEC PSEC) as returned by `current-time'. */)
5157 (Lisp_Object time_list
)
5159 if (!NILP (time_list
))
5161 current_buffer
->modtime
= lisp_time_argument (time_list
);
5162 current_buffer
->modtime_size
= -1;
5166 register Lisp_Object filename
;
5168 Lisp_Object handler
;
5170 filename
= Fexpand_file_name (BVAR (current_buffer
, filename
), Qnil
);
5172 /* If the file name has special constructs in it,
5173 call the corresponding file handler. */
5174 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5175 if (!NILP (handler
))
5176 /* The handler can find the file name the same way we did. */
5177 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5179 filename
= ENCODE_FILE (filename
);
5181 if (stat (SSDATA (filename
), &st
) >= 0)
5183 current_buffer
->modtime
= get_stat_mtime (&st
);
5184 current_buffer
->modtime_size
= st
.st_size
;
5192 auto_save_error (Lisp_Object error_val
)
5194 Lisp_Object args
[3], msg
;
5196 struct gcpro gcpro1
;
5200 auto_save_error_occurred
= 1;
5202 ring_bell (XFRAME (selected_frame
));
5204 args
[0] = build_string ("Auto-saving %s: %s");
5205 args
[1] = BVAR (current_buffer
, name
);
5206 args
[2] = Ferror_message_string (error_val
);
5207 msg
= Fformat (3, args
);
5209 nbytes
= SBYTES (msg
);
5210 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5211 memcpy (msgbuf
, SDATA (msg
), nbytes
);
5213 for (i
= 0; i
< 3; ++i
)
5216 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5218 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5219 Fsleep_for (make_number (1), Qnil
);
5233 auto_save_mode_bits
= 0666;
5235 /* Get visited file's mode to become the auto save file's mode. */
5236 if (! NILP (BVAR (current_buffer
, filename
)))
5238 if (stat (SSDATA (BVAR (current_buffer
, filename
)), &st
) >= 0)
5239 /* But make sure we can overwrite it later! */
5240 auto_save_mode_bits
= (st
.st_mode
| 0600) & 0777;
5241 else if ((modes
= Ffile_modes (BVAR (current_buffer
, filename
)),
5243 /* Remote files don't cooperate with stat. */
5244 auto_save_mode_bits
= (XINT (modes
) | 0600) & 0777;
5248 Fwrite_region (Qnil
, Qnil
, BVAR (current_buffer
, auto_save_file_name
), Qnil
,
5249 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5254 do_auto_save_unwind (Lisp_Object arg
) /* used as unwind-protect function */
5257 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5269 do_auto_save_unwind_1 (Lisp_Object value
) /* used as unwind-protect function */
5272 minibuffer_auto_raise
= XINT (value
);
5277 do_auto_save_make_dir (Lisp_Object dir
)
5281 auto_saving_dir_umask
= 077;
5282 result
= call2 (Qmake_directory
, dir
, Qt
);
5283 auto_saving_dir_umask
= 0;
5288 do_auto_save_eh (Lisp_Object ignore
)
5290 auto_saving_dir_umask
= 0;
5294 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5295 doc
: /* Auto-save all buffers that need it.
5296 This is all buffers that have auto-saving enabled
5297 and are changed since last auto-saved.
5298 Auto-saving writes the buffer into a file
5299 so that your editing is not lost if the system crashes.
5300 This file is not the file you visited; that changes only when you save.
5301 Normally we run the normal hook `auto-save-hook' before saving.
5303 A non-nil NO-MESSAGE argument means do not print any message if successful.
5304 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5305 (Lisp_Object no_message
, Lisp_Object current_only
)
5307 struct buffer
*old
= current_buffer
, *b
;
5308 Lisp_Object tail
, buf
, hook
;
5310 int do_handled_files
;
5312 FILE *stream
= NULL
;
5313 ptrdiff_t count
= SPECPDL_INDEX ();
5314 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5315 int old_message_p
= 0;
5316 struct gcpro gcpro1
, gcpro2
;
5318 if (max_specpdl_size
< specpdl_size
+ 40)
5319 max_specpdl_size
= specpdl_size
+ 40;
5324 if (NILP (no_message
))
5326 old_message_p
= push_message ();
5327 record_unwind_protect (pop_message_unwind
, Qnil
);
5330 /* Ordinarily don't quit within this function,
5331 but don't make it impossible to quit (in case we get hung in I/O). */
5335 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5336 point to non-strings reached from Vbuffer_alist. */
5338 hook
= intern ("auto-save-hook");
5339 Frun_hooks (1, &hook
);
5341 if (STRINGP (Vauto_save_list_file_name
))
5343 Lisp_Object listfile
;
5345 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5347 /* Don't try to create the directory when shutting down Emacs,
5348 because creating the directory might signal an error, and
5349 that would leave Emacs in a strange state. */
5350 if (!NILP (Vrun_hooks
))
5354 GCPRO2 (dir
, listfile
);
5355 dir
= Ffile_name_directory (listfile
);
5356 if (NILP (Ffile_directory_p (dir
)))
5357 internal_condition_case_1 (do_auto_save_make_dir
,
5363 stream
= fopen (SSDATA (listfile
), "w");
5366 record_unwind_protect (do_auto_save_unwind
,
5367 make_save_value (stream
, 0));
5368 record_unwind_protect (do_auto_save_unwind_1
,
5369 make_number (minibuffer_auto_raise
));
5370 minibuffer_auto_raise
= 0;
5372 auto_save_error_occurred
= 0;
5374 /* On first pass, save all files that don't have handlers.
5375 On second pass, save all files that do have handlers.
5377 If Emacs is crashing, the handlers may tweak what is causing
5378 Emacs to crash in the first place, and it would be a shame if
5379 Emacs failed to autosave perfectly ordinary files because it
5380 couldn't handle some ange-ftp'd file. */
5382 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5383 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5385 buf
= XCDR (XCAR (tail
));
5388 /* Record all the buffers that have auto save mode
5389 in the special file that lists them. For each of these buffers,
5390 Record visited name (if any) and auto save name. */
5391 if (STRINGP (BVAR (b
, auto_save_file_name
))
5392 && stream
!= NULL
&& do_handled_files
== 0)
5395 if (!NILP (BVAR (b
, filename
)))
5397 fwrite (SDATA (BVAR (b
, filename
)), 1,
5398 SBYTES (BVAR (b
, filename
)), stream
);
5400 putc ('\n', stream
);
5401 fwrite (SDATA (BVAR (b
, auto_save_file_name
)), 1,
5402 SBYTES (BVAR (b
, auto_save_file_name
)), stream
);
5403 putc ('\n', stream
);
5407 if (!NILP (current_only
)
5408 && b
!= current_buffer
)
5411 /* Don't auto-save indirect buffers.
5412 The base buffer takes care of it. */
5416 /* Check for auto save enabled
5417 and file changed since last auto save
5418 and file changed since last real save. */
5419 if (STRINGP (BVAR (b
, auto_save_file_name
))
5420 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5421 && BUF_AUTOSAVE_MODIFF (b
) < BUF_MODIFF (b
)
5422 /* -1 means we've turned off autosaving for a while--see below. */
5423 && XINT (BVAR (b
, save_length
)) >= 0
5424 && (do_handled_files
5425 || NILP (Ffind_file_name_handler (BVAR (b
, auto_save_file_name
),
5428 EMACS_TIME before_time
= current_emacs_time ();
5429 EMACS_TIME after_time
;
5431 /* If we had a failure, don't try again for 20 minutes. */
5432 if (b
->auto_save_failure_time
> 0
5433 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5436 set_buffer_internal (b
);
5437 if (NILP (Vauto_save_include_big_deletions
)
5438 && (XFASTINT (BVAR (b
, save_length
)) * 10
5439 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5440 /* A short file is likely to change a large fraction;
5441 spare the user annoying messages. */
5442 && XFASTINT (BVAR (b
, save_length
)) > 5000
5443 /* These messages are frequent and annoying for `*mail*'. */
5444 && !EQ (BVAR (b
, filename
), Qnil
)
5445 && NILP (no_message
))
5447 /* It has shrunk too much; turn off auto-saving here. */
5448 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5449 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5451 minibuffer_auto_raise
= 0;
5452 /* Turn off auto-saving until there's a real save,
5453 and prevent any more warnings. */
5454 XSETINT (BVAR (b
, save_length
), -1);
5455 Fsleep_for (make_number (1), Qnil
);
5458 if (!auto_saved
&& NILP (no_message
))
5459 message1 ("Auto-saving...");
5460 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5462 BUF_AUTOSAVE_MODIFF (b
) = BUF_MODIFF (b
);
5463 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5464 set_buffer_internal (old
);
5466 after_time
= current_emacs_time ();
5468 /* If auto-save took more than 60 seconds,
5469 assume it was an NFS failure that got a timeout. */
5470 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5471 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5475 /* Prevent another auto save till enough input events come in. */
5476 record_auto_save ();
5478 if (auto_saved
&& NILP (no_message
))
5482 /* If we are going to restore an old message,
5483 give time to read ours. */
5484 sit_for (make_number (1), 0, 0);
5487 else if (!auto_save_error_occurred
)
5488 /* Don't overwrite the error message if an error occurred.
5489 If we displayed a message and then restored a state
5490 with no message, leave a "done" message on the screen. */
5491 message1 ("Auto-saving...done");
5496 /* This restores the message-stack status. */
5497 unbind_to (count
, Qnil
);
5501 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5502 Sset_buffer_auto_saved
, 0, 0, 0,
5503 doc
: /* Mark current buffer as auto-saved with its current text.
5504 No auto-save file will be written until the buffer changes again. */)
5507 /* FIXME: This should not be called in indirect buffers, since
5508 they're not autosaved. */
5509 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
5510 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5511 current_buffer
->auto_save_failure_time
= 0;
5515 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5516 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5517 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5520 current_buffer
->auto_save_failure_time
= 0;
5524 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5526 doc
: /* Return t if current buffer has been auto-saved recently.
5527 More precisely, if it has been auto-saved since last read from or saved
5528 in the visited file. If the buffer has no visited file,
5529 then any auto-save counts as "recent". */)
5532 /* FIXME: maybe we should return nil for indirect buffers since
5533 they're never autosaved. */
5534 return (SAVE_MODIFF
< BUF_AUTOSAVE_MODIFF (current_buffer
) ? Qt
: Qnil
);
5537 /* Reading and completing file names */
5539 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5540 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5541 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5542 The return value is only relevant for a call to `read-file-name' that happens
5543 before any other event (mouse or keypress) is handled. */)
5546 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
5547 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5557 Fread_file_name (Lisp_Object prompt
, Lisp_Object dir
, Lisp_Object default_filename
, Lisp_Object mustmatch
, Lisp_Object initial
, Lisp_Object predicate
)
5559 struct gcpro gcpro1
;
5560 Lisp_Object args
[7];
5562 GCPRO1 (default_filename
);
5563 args
[0] = intern ("read-file-name");
5566 args
[3] = default_filename
;
5567 args
[4] = mustmatch
;
5569 args
[6] = predicate
;
5570 RETURN_UNGCPRO (Ffuncall (7, args
));
5575 syms_of_fileio (void)
5577 DEFSYM (Qoperations
, "operations");
5578 DEFSYM (Qexpand_file_name
, "expand-file-name");
5579 DEFSYM (Qsubstitute_in_file_name
, "substitute-in-file-name");
5580 DEFSYM (Qdirectory_file_name
, "directory-file-name");
5581 DEFSYM (Qfile_name_directory
, "file-name-directory");
5582 DEFSYM (Qfile_name_nondirectory
, "file-name-nondirectory");
5583 DEFSYM (Qunhandled_file_name_directory
, "unhandled-file-name-directory");
5584 DEFSYM (Qfile_name_as_directory
, "file-name-as-directory");
5585 DEFSYM (Qcopy_file
, "copy-file");
5586 DEFSYM (Qmake_directory_internal
, "make-directory-internal");
5587 DEFSYM (Qmake_directory
, "make-directory");
5588 DEFSYM (Qdelete_directory_internal
, "delete-directory-internal");
5589 DEFSYM (Qdelete_file
, "delete-file");
5590 DEFSYM (Qrename_file
, "rename-file");
5591 DEFSYM (Qadd_name_to_file
, "add-name-to-file");
5592 DEFSYM (Qmake_symbolic_link
, "make-symbolic-link");
5593 DEFSYM (Qfile_exists_p
, "file-exists-p");
5594 DEFSYM (Qfile_executable_p
, "file-executable-p");
5595 DEFSYM (Qfile_readable_p
, "file-readable-p");
5596 DEFSYM (Qfile_writable_p
, "file-writable-p");
5597 DEFSYM (Qfile_symlink_p
, "file-symlink-p");
5598 DEFSYM (Qaccess_file
, "access-file");
5599 DEFSYM (Qfile_directory_p
, "file-directory-p");
5600 DEFSYM (Qfile_regular_p
, "file-regular-p");
5601 DEFSYM (Qfile_accessible_directory_p
, "file-accessible-directory-p");
5602 DEFSYM (Qfile_modes
, "file-modes");
5603 DEFSYM (Qset_file_modes
, "set-file-modes");
5604 DEFSYM (Qset_file_times
, "set-file-times");
5605 DEFSYM (Qfile_selinux_context
, "file-selinux-context");
5606 DEFSYM (Qset_file_selinux_context
, "set-file-selinux-context");
5607 DEFSYM (Qfile_newer_than_file_p
, "file-newer-than-file-p");
5608 DEFSYM (Qinsert_file_contents
, "insert-file-contents");
5609 DEFSYM (Qwrite_region
, "write-region");
5610 DEFSYM (Qverify_visited_file_modtime
, "verify-visited-file-modtime");
5611 DEFSYM (Qset_visited_file_modtime
, "set-visited-file-modtime");
5612 DEFSYM (Qauto_save_coding
, "auto-save-coding");
5614 DEFSYM (Qfile_name_history
, "file-name-history");
5615 Fset (Qfile_name_history
, Qnil
);
5617 DEFSYM (Qfile_error
, "file-error");
5618 DEFSYM (Qfile_already_exists
, "file-already-exists");
5619 DEFSYM (Qfile_date_error
, "file-date-error");
5620 DEFSYM (Qexcl
, "excl");
5622 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system
,
5623 doc
: /* Coding system for encoding file names.
5624 If it is nil, `default-file-name-coding-system' (which see) is used. */);
5625 Vfile_name_coding_system
= Qnil
;
5627 DEFVAR_LISP ("default-file-name-coding-system",
5628 Vdefault_file_name_coding_system
,
5629 doc
: /* Default coding system for encoding file names.
5630 This variable is used only when `file-name-coding-system' is nil.
5632 This variable is set/changed by the command `set-language-environment'.
5633 User should not set this variable manually,
5634 instead use `file-name-coding-system' to get a constant encoding
5635 of file names regardless of the current language environment. */);
5636 Vdefault_file_name_coding_system
= Qnil
;
5638 DEFSYM (Qformat_decode
, "format-decode");
5639 DEFSYM (Qformat_annotate_function
, "format-annotate-function");
5640 DEFSYM (Qafter_insert_file_set_coding
, "after-insert-file-set-coding");
5641 DEFSYM (Qcar_less_than_car
, "car-less-than-car");
5643 Fput (Qfile_error
, Qerror_conditions
,
5644 Fpurecopy (list2 (Qfile_error
, Qerror
)));
5645 Fput (Qfile_error
, Qerror_message
,
5646 build_pure_c_string ("File error"));
5648 Fput (Qfile_already_exists
, Qerror_conditions
,
5649 Fpurecopy (list3 (Qfile_already_exists
, Qfile_error
, Qerror
)));
5650 Fput (Qfile_already_exists
, Qerror_message
,
5651 build_pure_c_string ("File already exists"));
5653 Fput (Qfile_date_error
, Qerror_conditions
,
5654 Fpurecopy (list3 (Qfile_date_error
, Qfile_error
, Qerror
)));
5655 Fput (Qfile_date_error
, Qerror_message
,
5656 build_pure_c_string ("Cannot set file date"));
5658 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist
,
5659 doc
: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
5660 If a file name matches REGEXP, all I/O on that file is done by calling
5661 HANDLER. If a file name matches more than one handler, the handler
5662 whose match starts last in the file name gets precedence. The
5663 function `find-file-name-handler' checks this list for a handler for
5666 HANDLER should be a function. The first argument given to it is the
5667 name of the I/O primitive to be handled; the remaining arguments are
5668 the arguments that were passed to that primitive. For example, if you
5669 do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
5670 HANDLER is called like this:
5672 (funcall HANDLER 'file-exists-p FILENAME)
5674 Note that HANDLER must be able to handle all I/O primitives; if it has
5675 nothing special to do for a primitive, it should reinvoke the
5676 primitive to handle the operation \"the usual way\".
5677 See Info node `(elisp)Magic File Names' for more details. */);
5678 Vfile_name_handler_alist
= Qnil
;
5680 DEFVAR_LISP ("set-auto-coding-function",
5681 Vset_auto_coding_function
,
5682 doc
: /* If non-nil, a function to call to decide a coding system of file.
5683 Two arguments are passed to this function: the file name
5684 and the length of a file contents following the point.
5685 This function should return a coding system to decode the file contents.
5686 It should check the file name against `auto-coding-alist'.
5687 If no coding system is decided, it should check a coding system
5688 specified in the heading lines with the format:
5689 -*- ... coding: CODING-SYSTEM; ... -*-
5690 or local variable spec of the tailing lines with `coding:' tag. */);
5691 Vset_auto_coding_function
= Qnil
;
5693 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions
,
5694 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
5695 Each is passed one argument, the number of characters inserted,
5696 with point at the start of the inserted text. Each function
5697 should leave point the same, and return the new character count.
5698 If `insert-file-contents' is intercepted by a handler from
5699 `file-name-handler-alist', that handler is responsible for calling the
5700 functions in `after-insert-file-functions' if appropriate. */);
5701 Vafter_insert_file_functions
= Qnil
;
5703 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions
,
5704 doc
: /* A list of functions to be called at the start of `write-region'.
5705 Each is passed two arguments, START and END as for `write-region'.
5706 These are usually two numbers but not always; see the documentation
5707 for `write-region'. The function should return a list of pairs
5708 of the form (POSITION . STRING), consisting of strings to be effectively
5709 inserted at the specified positions of the file being written (1 means to
5710 insert before the first byte written). The POSITIONs must be sorted into
5713 If there are several annotation functions, the lists returned by these
5714 functions are merged destructively. As each annotation function runs,
5715 the variable `write-region-annotations-so-far' contains a list of all
5716 annotations returned by previous annotation functions.
5718 An annotation function can return with a different buffer current.
5719 Doing so removes the annotations returned by previous functions, and
5720 resets START and END to `point-min' and `point-max' of the new buffer.
5722 After `write-region' completes, Emacs calls the function stored in
5723 `write-region-post-annotation-function', once for each buffer that was
5724 current when building the annotations (i.e., at least once), with that
5725 buffer current. */);
5726 Vwrite_region_annotate_functions
= Qnil
;
5727 DEFSYM (Qwrite_region_annotate_functions
, "write-region-annotate-functions");
5729 DEFVAR_LISP ("write-region-post-annotation-function",
5730 Vwrite_region_post_annotation_function
,
5731 doc
: /* Function to call after `write-region' completes.
5732 The function is called with no arguments. If one or more of the
5733 annotation functions in `write-region-annotate-functions' changed the
5734 current buffer, the function stored in this variable is called for
5735 each of those additional buffers as well, in addition to the original
5736 buffer. The relevant buffer is current during each function call. */);
5737 Vwrite_region_post_annotation_function
= Qnil
;
5738 staticpro (&Vwrite_region_annotation_buffers
);
5740 DEFVAR_LISP ("write-region-annotations-so-far",
5741 Vwrite_region_annotations_so_far
,
5742 doc
: /* When an annotation function is called, this holds the previous annotations.
5743 These are the annotations made by other annotation functions
5744 that were already called. See also `write-region-annotate-functions'. */);
5745 Vwrite_region_annotations_so_far
= Qnil
;
5747 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers
,
5748 doc
: /* A list of file name handlers that temporarily should not be used.
5749 This applies only to the operation `inhibit-file-name-operation'. */);
5750 Vinhibit_file_name_handlers
= Qnil
;
5752 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation
,
5753 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5754 Vinhibit_file_name_operation
= Qnil
;
5756 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name
,
5757 doc
: /* File name in which we write a list of all auto save file names.
5758 This variable is initialized automatically from `auto-save-list-file-prefix'
5759 shortly after Emacs reads your `.emacs' file, if you have not yet given it
5760 a non-nil value. */);
5761 Vauto_save_list_file_name
= Qnil
;
5763 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name
,
5764 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
5765 Normally auto-save files are written under other names. */);
5766 Vauto_save_visited_file_name
= Qnil
;
5768 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions
,
5769 doc
: /* If non-nil, auto-save even if a large part of the text is deleted.
5770 If nil, deleting a substantial portion of the text disables auto-save
5771 in the buffer; this is the default behavior, because the auto-save
5772 file is usually more useful if it contains the deleted text. */);
5773 Vauto_save_include_big_deletions
= Qnil
;
5776 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync
,
5777 doc
: /* Non-nil means don't call fsync in `write-region'.
5778 This variable affects calls to `write-region' as well as save commands.
5779 A non-nil value may result in data loss! */);
5780 write_region_inhibit_fsync
= 0;
5783 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash
,
5784 doc
: /* Specifies whether to use the system's trash can.
5785 When non-nil, certain file deletion commands use the function
5786 `move-file-to-trash' instead of deleting files outright.
5787 This includes interactive calls to `delete-file' and
5788 `delete-directory' and the Dired deletion commands. */);
5789 delete_by_moving_to_trash
= 0;
5790 Qdelete_by_moving_to_trash
= intern_c_string ("delete-by-moving-to-trash");
5792 DEFSYM (Qmove_file_to_trash
, "move-file-to-trash");
5793 DEFSYM (Qcopy_directory
, "copy-directory");
5794 DEFSYM (Qdelete_directory
, "delete-directory");
5796 defsubr (&Sfind_file_name_handler
);
5797 defsubr (&Sfile_name_directory
);
5798 defsubr (&Sfile_name_nondirectory
);
5799 defsubr (&Sunhandled_file_name_directory
);
5800 defsubr (&Sfile_name_as_directory
);
5801 defsubr (&Sdirectory_file_name
);
5802 defsubr (&Smake_temp_name
);
5803 defsubr (&Sexpand_file_name
);
5804 defsubr (&Ssubstitute_in_file_name
);
5805 defsubr (&Scopy_file
);
5806 defsubr (&Smake_directory_internal
);
5807 defsubr (&Sdelete_directory_internal
);
5808 defsubr (&Sdelete_file
);
5809 defsubr (&Srename_file
);
5810 defsubr (&Sadd_name_to_file
);
5811 defsubr (&Smake_symbolic_link
);
5812 defsubr (&Sfile_name_absolute_p
);
5813 defsubr (&Sfile_exists_p
);
5814 defsubr (&Sfile_executable_p
);
5815 defsubr (&Sfile_readable_p
);
5816 defsubr (&Sfile_writable_p
);
5817 defsubr (&Saccess_file
);
5818 defsubr (&Sfile_symlink_p
);
5819 defsubr (&Sfile_directory_p
);
5820 defsubr (&Sfile_accessible_directory_p
);
5821 defsubr (&Sfile_regular_p
);
5822 defsubr (&Sfile_modes
);
5823 defsubr (&Sset_file_modes
);
5824 defsubr (&Sset_file_times
);
5825 defsubr (&Sfile_selinux_context
);
5826 defsubr (&Sset_file_selinux_context
);
5827 defsubr (&Sset_default_file_modes
);
5828 defsubr (&Sdefault_file_modes
);
5829 defsubr (&Sfile_newer_than_file_p
);
5830 defsubr (&Sinsert_file_contents
);
5831 defsubr (&Swrite_region
);
5832 defsubr (&Scar_less_than_car
);
5833 defsubr (&Sverify_visited_file_modtime
);
5834 defsubr (&Sclear_visited_file_modtime
);
5835 defsubr (&Svisited_file_modtime
);
5836 defsubr (&Sset_visited_file_modtime
);
5837 defsubr (&Sdo_auto_save
);
5838 defsubr (&Sset_buffer_auto_saved
);
5839 defsubr (&Sclear_buffer_auto_save_failure
);
5840 defsubr (&Srecent_auto_save_p
);
5842 defsubr (&Snext_read_file_uses_dialog_p
);
5845 defsubr (&Sunix_sync
);