1 /* File IO for GNU Emacs.
3 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997,
4 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
5 2009, 2010, 2011 Free Software Foundation, Inc.
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
26 #include <sys/types.h>
31 #if !defined (S_ISLNK) && defined (S_IFLNK)
32 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
35 #if !defined (S_ISFIFO) && defined (S_IFIFO)
36 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
39 #if !defined (S_ISREG) && defined (S_IFREG)
40 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
50 #ifdef HAVE_LIBSELINUX
51 #include <selinux/selinux.h>
52 #include <selinux/context.h>
56 #include "intervals.h"
58 #include "character.h"
61 #include "blockinput.h"
63 #include "dispextern.h"
69 #endif /* not WINDOWSNT */
73 #include <sys/param.h>
78 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
79 redirector allows the six letters between 'Z' and 'a' as well. */
81 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
84 #define IS_DRIVE(x) isalpha (x)
86 /* Need to lower-case the drive letter, or else expanded
87 filenames will sometimes compare inequal, because
88 `expand-file-name' doesn't always down-case the drive letter. */
89 #define DRIVE_LETTER(x) (tolower (x))
104 #ifndef FILE_SYSTEM_CASE
105 #define FILE_SYSTEM_CASE(filename) (filename)
108 /* Nonzero during writing of auto-save files */
111 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
112 a new file with the same mode as the original */
113 int auto_save_mode_bits
;
115 /* Set by auto_save_1 if an error occurred during the last auto-save. */
116 int auto_save_error_occurred
;
118 /* The symbol bound to coding-system-for-read when
119 insert-file-contents is called for recovering a file. This is not
120 an actual coding system name, but just an indicator to tell
121 insert-file-contents to use `emacs-mule' with a special flag for
122 auto saving and recovering a file. */
123 Lisp_Object Qauto_save_coding
;
125 /* Property name of a file name handler,
126 which gives a list of operations it handles.. */
127 Lisp_Object Qoperations
;
129 /* Lisp functions for translating file formats */
130 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
132 /* Lisp function for setting buffer-file-coding-system and the
133 multibyteness of the current buffer after inserting a file. */
134 Lisp_Object Qafter_insert_file_set_coding
;
136 Lisp_Object Qwrite_region_annotate_functions
;
137 /* Each time an annotation function changes the buffer, the new buffer
139 Lisp_Object Vwrite_region_annotation_buffers
;
144 Lisp_Object Qdelete_by_moving_to_trash
;
146 /* Lisp function for moving files to trash. */
147 Lisp_Object Qmove_file_to_trash
;
149 /* Lisp function for recursively copying directories. */
150 Lisp_Object Qcopy_directory
;
152 /* Lisp function for recursively deleting directories. */
153 Lisp_Object Qdelete_directory
;
158 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
160 Lisp_Object Qfile_name_history
;
162 Lisp_Object Qcar_less_than_car
;
164 static int a_write (int, Lisp_Object
, int, int,
165 Lisp_Object
*, struct coding_system
*);
166 static int e_write (int, Lisp_Object
, int, int, struct coding_system
*);
170 report_file_error (const char *string
, Lisp_Object data
)
172 Lisp_Object errstring
;
176 synchronize_system_messages_locale ();
177 str
= strerror (errorno
);
178 errstring
= code_convert_string_norecord (make_unibyte_string (str
,
180 Vlocale_coding_system
, 0);
186 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
189 /* System error messages are capitalized. Downcase the initial
190 unless it is followed by a slash. (The slash case caters to
191 error messages that begin with "I/O" or, in German, "E/A".) */
192 if (STRING_MULTIBYTE (errstring
)
193 && ! EQ (Faref (errstring
, make_number (1)), make_number ('/')))
197 str
= SSDATA (errstring
);
198 c
= STRING_CHAR (str
);
199 Faset (errstring
, make_number (0), make_number (DOWNCASE (c
)));
202 xsignal (Qfile_error
,
203 Fcons (build_string (string
), Fcons (errstring
, data
)));
208 close_file_unwind (Lisp_Object fd
)
210 emacs_close (XFASTINT (fd
));
214 /* Restore point, having saved it as a marker. */
217 restore_point_unwind (Lisp_Object location
)
219 Fgoto_char (location
);
220 Fset_marker (location
, Qnil
, Qnil
);
225 Lisp_Object Qexpand_file_name
;
226 Lisp_Object Qsubstitute_in_file_name
;
227 Lisp_Object Qdirectory_file_name
;
228 Lisp_Object Qfile_name_directory
;
229 Lisp_Object Qfile_name_nondirectory
;
230 Lisp_Object Qunhandled_file_name_directory
;
231 Lisp_Object Qfile_name_as_directory
;
232 Lisp_Object Qcopy_file
;
233 Lisp_Object Qmake_directory_internal
;
234 Lisp_Object Qmake_directory
;
235 Lisp_Object Qdelete_directory_internal
;
236 Lisp_Object Qdelete_file
;
237 Lisp_Object Qrename_file
;
238 Lisp_Object Qadd_name_to_file
;
239 Lisp_Object Qmake_symbolic_link
;
240 Lisp_Object Qfile_exists_p
;
241 Lisp_Object Qfile_executable_p
;
242 Lisp_Object Qfile_readable_p
;
243 Lisp_Object Qfile_writable_p
;
244 Lisp_Object Qfile_symlink_p
;
245 Lisp_Object Qaccess_file
;
246 Lisp_Object Qfile_directory_p
;
247 Lisp_Object Qfile_regular_p
;
248 Lisp_Object Qfile_accessible_directory_p
;
249 Lisp_Object Qfile_modes
;
250 Lisp_Object Qset_file_modes
;
251 Lisp_Object Qset_file_times
;
252 Lisp_Object Qfile_selinux_context
;
253 Lisp_Object Qset_file_selinux_context
;
254 Lisp_Object Qfile_newer_than_file_p
;
255 Lisp_Object Qinsert_file_contents
;
256 Lisp_Object Qwrite_region
;
257 Lisp_Object Qverify_visited_file_modtime
;
258 Lisp_Object Qset_visited_file_modtime
;
260 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
261 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
262 Otherwise, return nil.
263 A file name is handled if one of the regular expressions in
264 `file-name-handler-alist' matches it.
266 If OPERATION equals `inhibit-file-name-operation', then we ignore
267 any handlers that are members of `inhibit-file-name-handlers',
268 but we still do run any other handlers. This lets handlers
269 use the standard functions without calling themselves recursively. */)
270 (Lisp_Object filename
, Lisp_Object operation
)
272 /* This function must not munge the match data. */
273 Lisp_Object chain
, inhibited_handlers
, result
;
277 CHECK_STRING (filename
);
279 if (EQ (operation
, Vinhibit_file_name_operation
))
280 inhibited_handlers
= Vinhibit_file_name_handlers
;
282 inhibited_handlers
= Qnil
;
284 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
285 chain
= XCDR (chain
))
291 Lisp_Object string
= XCAR (elt
);
293 Lisp_Object handler
= XCDR (elt
);
294 Lisp_Object operations
= Qnil
;
296 if (SYMBOLP (handler
))
297 operations
= Fget (handler
, Qoperations
);
300 && (match_pos
= fast_string_match (string
, filename
)) > pos
301 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
305 handler
= XCDR (elt
);
306 tem
= Fmemq (handler
, inhibited_handlers
);
320 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
322 doc
: /* Return the directory component in file name FILENAME.
323 Return nil if FILENAME does not include a directory.
324 Otherwise return a directory name.
325 Given a Unix syntax file name, returns a string ending in slash. */)
326 (Lisp_Object filename
)
329 register const unsigned char *beg
;
331 register unsigned char *beg
;
333 register const unsigned char *p
;
336 CHECK_STRING (filename
);
338 /* If the file name has special constructs in it,
339 call the corresponding file handler. */
340 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
342 return call2 (handler
, Qfile_name_directory
, filename
);
344 filename
= FILE_SYSTEM_CASE (filename
);
346 beg
= (unsigned char *) alloca (SBYTES (filename
) + 1);
347 memcpy (beg
, SDATA (filename
), SBYTES (filename
) + 1);
349 beg
= SDATA (filename
);
351 p
= beg
+ SBYTES (filename
);
353 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
355 /* only recognise drive specifier at the beginning */
357 /* handle the "/:d:foo" and "/:foo" cases correctly */
358 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
359 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
366 /* Expansion of "c:" to drive and default directory. */
369 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
370 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
371 unsigned char *r
= res
;
373 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
375 strncpy (res
, beg
, 2);
380 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
382 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
385 p
= beg
+ strlen (beg
);
388 dostounix_filename (beg
);
391 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
394 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
395 Sfile_name_nondirectory
, 1, 1, 0,
396 doc
: /* Return file name FILENAME sans its directory.
397 For example, in a Unix-syntax file name,
398 this is everything after the last slash,
399 or the entire name if it contains no slash. */)
400 (Lisp_Object filename
)
402 register const unsigned char *beg
, *p
, *end
;
405 CHECK_STRING (filename
);
407 /* If the file name has special constructs in it,
408 call the corresponding file handler. */
409 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
411 return call2 (handler
, Qfile_name_nondirectory
, filename
);
413 beg
= SDATA (filename
);
414 end
= p
= beg
+ SBYTES (filename
);
416 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
418 /* only recognise drive specifier at beginning */
420 /* handle the "/:d:foo" case correctly */
421 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
426 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
429 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
430 Sunhandled_file_name_directory
, 1, 1, 0,
431 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
432 A `directly usable' directory name is one that may be used without the
433 intervention of any file handler.
434 If FILENAME is a directly usable file itself, return
435 \(file-name-directory FILENAME).
436 If FILENAME refers to a file which is not accessible from a local process,
437 then this should return nil.
438 The `call-process' and `start-process' functions use this function to
439 get a current directory to run processes in. */)
440 (Lisp_Object filename
)
444 /* If the file name has special constructs in it,
445 call the corresponding file handler. */
446 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
448 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
450 return Ffile_name_directory (filename
);
455 file_name_as_directory (char *out
, char *in
)
457 int size
= strlen (in
) - 1;
469 /* For Unix syntax, Append a slash if necessary */
470 if (!IS_DIRECTORY_SEP (out
[size
]))
472 out
[size
+ 1] = DIRECTORY_SEP
;
473 out
[size
+ 2] = '\0';
476 dostounix_filename (out
);
481 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
482 Sfile_name_as_directory
, 1, 1, 0,
483 doc
: /* Return a string representing the file name FILE interpreted as a directory.
484 This operation exists because a directory is also a file, but its name as
485 a directory is different from its name as a file.
486 The result can be used as the value of `default-directory'
487 or passed as second argument to `expand-file-name'.
488 For a Unix-syntax file name, just appends a slash. */)
498 /* If the file name has special constructs in it,
499 call the corresponding file handler. */
500 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
502 return call2 (handler
, Qfile_name_as_directory
, file
);
504 buf
= (char *) alloca (SBYTES (file
) + 10);
505 file_name_as_directory (buf
, SDATA (file
));
506 return make_specified_string (buf
, -1, strlen (buf
),
507 STRING_MULTIBYTE (file
));
511 * Convert from directory name to filename.
512 * On UNIX, it's simple: just make sure there isn't a terminating /
514 * Value is nonzero if the string output is different from the input.
518 directory_file_name (char *src
, char *dst
)
524 /* Process as Unix format: just remove any final slash.
525 But leave "/" unchanged; do not change it to "". */
528 && IS_DIRECTORY_SEP (dst
[slen
- 1])
530 && !IS_ANY_SEP (dst
[slen
- 2])
535 dostounix_filename (dst
);
540 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
542 doc
: /* Returns the file name of the directory named DIRECTORY.
543 This is the name of the file that holds the data for the directory DIRECTORY.
544 This operation exists because a directory is also a file, but its name as
545 a directory is different from its name as a file.
546 In Unix-syntax, this function just removes the final slash. */)
547 (Lisp_Object directory
)
552 CHECK_STRING (directory
);
554 if (NILP (directory
))
557 /* If the file name has special constructs in it,
558 call the corresponding file handler. */
559 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
561 return call2 (handler
, Qdirectory_file_name
, directory
);
563 buf
= (char *) alloca (SBYTES (directory
) + 20);
564 directory_file_name (SDATA (directory
), buf
);
565 return make_specified_string (buf
, -1, strlen (buf
),
566 STRING_MULTIBYTE (directory
));
569 static const char make_temp_name_tbl
[64] =
571 'A','B','C','D','E','F','G','H',
572 'I','J','K','L','M','N','O','P',
573 'Q','R','S','T','U','V','W','X',
574 'Y','Z','a','b','c','d','e','f',
575 'g','h','i','j','k','l','m','n',
576 'o','p','q','r','s','t','u','v',
577 'w','x','y','z','0','1','2','3',
578 '4','5','6','7','8','9','-','_'
581 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
583 /* Value is a temporary file name starting with PREFIX, a string.
585 The Emacs process number forms part of the result, so there is
586 no danger of generating a name being used by another process.
587 In addition, this function makes an attempt to choose a name
588 which has no existing file. To make this work, PREFIX should be
589 an absolute file name.
591 BASE64_P non-zero means add the pid as 3 characters in base64
592 encoding. In this case, 6 characters will be added to PREFIX to
593 form the file name. Otherwise, if Emacs is running on a system
594 with long file names, add the pid as a decimal number.
596 This function signals an error if no unique file name could be
600 make_temp_name (Lisp_Object prefix
, int base64_p
)
605 unsigned char *p
, *data
;
609 CHECK_STRING (prefix
);
611 /* VAL is created by adding 6 characters to PREFIX. The first
612 three are the PID of this process, in base 64, and the second
613 three are incremented if the file already exists. This ensures
614 262144 unique file names per PID per PREFIX. */
616 pid
= (int) getpid ();
620 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
621 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
622 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
627 #ifdef HAVE_LONG_FILE_NAMES
628 sprintf (pidbuf
, "%d", pid
);
629 pidlen
= strlen (pidbuf
);
631 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
632 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
633 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
638 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
639 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
640 if (!STRING_MULTIBYTE (prefix
))
641 STRING_SET_UNIBYTE (val
);
643 memcpy (data
, SDATA (prefix
), len
);
646 memcpy (p
, pidbuf
, pidlen
);
649 /* Here we try to minimize useless stat'ing when this function is
650 invoked many times successively with the same PREFIX. We achieve
651 this by initializing count to a random value, and incrementing it
654 We don't want make-temp-name to be called while dumping,
655 because then make_temp_name_count_initialized_p would get set
656 and then make_temp_name_count would not be set when Emacs starts. */
658 if (!make_temp_name_count_initialized_p
)
660 make_temp_name_count
= (unsigned) time (NULL
);
661 make_temp_name_count_initialized_p
= 1;
667 unsigned num
= make_temp_name_count
;
669 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
670 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
671 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
673 /* Poor man's congruential RN generator. Replace with
674 ++make_temp_name_count for debugging. */
675 make_temp_name_count
+= 25229;
676 make_temp_name_count
%= 225307;
678 if (stat (data
, &ignored
) < 0)
680 /* We want to return only if errno is ENOENT. */
684 /* The error here is dubious, but there is little else we
685 can do. The alternatives are to return nil, which is
686 as bad as (and in many cases worse than) throwing the
687 error, or to ignore the error, which will likely result
688 in looping through 225307 stat's, which is not only
689 dog-slow, but also useless since eventually nil would
690 have to be returned anyway. */
691 report_file_error ("Cannot create temporary name for prefix",
692 Fcons (prefix
, Qnil
));
699 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
700 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
701 The Emacs process number forms part of the result,
702 so there is no danger of generating a name being used by another process.
704 In addition, this function makes an attempt to choose a name
705 which has no existing file. To make this work,
706 PREFIX should be an absolute file name.
708 There is a race condition between calling `make-temp-name' and creating the
709 file which opens all kinds of security holes. For that reason, you should
710 probably use `make-temp-file' instead, except in three circumstances:
712 * If you are creating the file in the user's home directory.
713 * If you are creating a directory rather than an ordinary file.
714 * If you are taking special precautions as `make-temp-file' does. */)
717 return make_temp_name (prefix
, 0);
722 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
723 doc
: /* Convert filename NAME to absolute, and canonicalize it.
724 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
725 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
726 the current buffer's value of `default-directory' is used.
727 NAME should be a string that is a valid file name for the underlying
729 File name components that are `.' are removed, and
730 so are file name components followed by `..', along with the `..' itself;
731 note that these simplifications are done without checking the resulting
732 file names in the file system.
733 Multiple consecutive slashes are collapsed into a single slash,
734 except at the beginning of the file name when they are significant (e.g.,
735 UNC file names on MS-Windows.)
736 An initial `~/' expands to your home directory.
737 An initial `~USER/' expands to USER's home directory.
738 See also the function `substitute-in-file-name'.
740 For technical reasons, this function can return correct but
741 non-intuitive results for the root directory; for instance,
742 \(expand-file-name ".." "/") returns "/..". For this reason, use
743 \(directory-file-name (file-name-directory dirname)) to traverse a
744 filesystem tree, not (expand-file-name ".." dirname). */)
745 (Lisp_Object name
, Lisp_Object default_directory
)
747 /* These point to SDATA and need to be careful with string-relocation
748 during GC (via DECODE_FILE). */
749 unsigned char *nm
, *newdir
;
750 /* This should only point to alloca'd data. */
751 unsigned char *target
;
757 int collapse_newdir
= 1;
761 Lisp_Object handler
, result
;
767 /* If the file name has special constructs in it,
768 call the corresponding file handler. */
769 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
771 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
773 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
774 if (NILP (default_directory
))
775 default_directory
= current_buffer
->directory
;
776 if (! STRINGP (default_directory
))
779 /* "/" is not considered a root directory on DOS_NT, so using "/"
780 here causes an infinite recursion in, e.g., the following:
782 (let (default-directory)
783 (expand-file-name "a"))
785 To avoid this, we set default_directory to the root of the
787 default_directory
= build_string (emacs_root_dir ());
789 default_directory
= build_string ("/");
793 if (!NILP (default_directory
))
795 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
797 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
801 unsigned char *o
= SDATA (default_directory
);
803 /* Make sure DEFAULT_DIRECTORY is properly expanded.
804 It would be better to do this down below where we actually use
805 default_directory. Unfortunately, calling Fexpand_file_name recursively
806 could invoke GC, and the strings might be relocated. This would
807 be annoying because we have pointers into strings lying around
808 that would need adjusting, and people would add new pointers to
809 the code and forget to adjust them, resulting in intermittent bugs.
810 Putting this call here avoids all that crud.
812 The EQ test avoids infinite recursion. */
813 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
814 /* Save time in some common cases - as long as default_directory
815 is not relative, it can be canonicalized with name below (if it
816 is needed at all) without requiring it to be expanded now. */
818 /* Detect MSDOS file names with drive specifiers. */
819 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
820 && IS_DIRECTORY_SEP (o
[2]))
822 /* Detect Windows file names in UNC format. */
823 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
825 #else /* not DOS_NT */
826 /* Detect Unix absolute file names (/... alone is not absolute on
828 && ! (IS_DIRECTORY_SEP (o
[0]))
829 #endif /* not DOS_NT */
835 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
839 name
= FILE_SYSTEM_CASE (name
);
840 multibyte
= STRING_MULTIBYTE (name
);
841 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
844 default_directory
= string_to_multibyte (default_directory
);
847 name
= string_to_multibyte (name
);
852 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
853 nm
= (unsigned char *) alloca (SBYTES (name
) + 1);
854 memcpy (nm
, SDATA (name
), SBYTES (name
) + 1);
857 /* Note if special escape prefix is present, but remove for now. */
858 if (nm
[0] == '/' && nm
[1] == ':')
864 /* Find and remove drive specifier if present; this makes nm absolute
865 even if the rest of the name appears to be relative. Only look for
866 drive specifier at the beginning. */
867 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
874 /* If we see "c://somedir", we want to strip the first slash after the
875 colon when stripping the drive letter. Otherwise, this expands to
877 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
880 /* Discard any previous drive specifier if nm is now in UNC format. */
881 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
885 #endif /* WINDOWSNT */
888 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
889 none are found, we can probably return right away. We will avoid
890 allocating a new string if name is already fully expanded. */
892 IS_DIRECTORY_SEP (nm
[0])
894 && drive
&& !is_escaped
897 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
901 /* If it turns out that the filename we want to return is just a
902 suffix of FILENAME, we don't need to go through and edit
903 things; we just need to construct a new string using data
904 starting at the middle of FILENAME. If we set lose to a
905 non-zero value, that means we've discovered that we can't do
908 unsigned char *p
= nm
;
912 /* Since we know the name is absolute, we can assume that each
913 element starts with a "/". */
915 /* "." and ".." are hairy. */
916 if (IS_DIRECTORY_SEP (p
[0])
918 && (IS_DIRECTORY_SEP (p
[2])
920 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
923 /* We want to replace multiple `/' in a row with a single
926 && IS_DIRECTORY_SEP (p
[0])
927 && IS_DIRECTORY_SEP (p
[1]))
934 /* Make sure directories are all separated with /, but
935 avoid allocation of a new string when not required. */
936 dostounix_filename (nm
);
938 if (IS_DIRECTORY_SEP (nm
[1]))
940 if (strcmp (nm
, SDATA (name
)) != 0)
941 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
945 /* drive must be set, so this is okay */
946 if (strcmp (nm
- 2, SDATA (name
)) != 0)
950 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
951 temp
[0] = DRIVE_LETTER (drive
);
952 name
= concat2 (build_string (temp
), name
);
955 #else /* not DOS_NT */
956 if (strcmp (nm
, SDATA (name
)) == 0)
958 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
959 #endif /* not DOS_NT */
963 /* At this point, nm might or might not be an absolute file name. We
964 need to expand ~ or ~user if present, otherwise prefix nm with
965 default_directory if nm is not absolute, and finally collapse /./
966 and /foo/../ sequences.
968 We set newdir to be the appropriate prefix if one is needed:
969 - the relevant user directory if nm starts with ~ or ~user
970 - the specified drive's working dir (DOS/NT only) if nm does not
972 - the value of default_directory.
974 Note that these prefixes are not guaranteed to be absolute (except
975 for the working dir of a drive). Therefore, to ensure we always
976 return an absolute name, if the final prefix is not absolute we
977 append it to the current working directory. */
981 if (nm
[0] == '~') /* prefix ~ */
983 if (IS_DIRECTORY_SEP (nm
[1])
984 || nm
[1] == 0) /* ~ by itself */
988 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
989 newdir
= (unsigned char *) "";
991 /* egetenv may return a unibyte string, which will bite us since
992 we expect the directory to be multibyte. */
993 tem
= build_string (newdir
);
994 if (!STRING_MULTIBYTE (tem
))
996 hdir
= DECODE_FILE (tem
);
997 newdir
= SDATA (hdir
);
1000 collapse_newdir
= 0;
1003 else /* ~user/filename */
1005 unsigned char *o
, *p
;
1006 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)); p
++);
1007 o
= alloca (p
- nm
+ 1);
1008 memcpy (o
, nm
, p
- nm
);
1012 pw
= (struct passwd
*) getpwnam (o
+ 1);
1016 newdir
= (unsigned char *) pw
-> pw_dir
;
1019 collapse_newdir
= 0;
1023 /* If we don't find a user of that name, leave the name
1024 unchanged; don't move nm forward to p. */
1029 /* On DOS and Windows, nm is absolute if a drive name was specified;
1030 use the drive's current directory as the prefix if needed. */
1031 if (!newdir
&& drive
)
1033 /* Get default directory if needed to make nm absolute. */
1034 if (!IS_DIRECTORY_SEP (nm
[0]))
1036 newdir
= alloca (MAXPATHLEN
+ 1);
1037 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1042 /* Either nm starts with /, or drive isn't mounted. */
1043 newdir
= alloca (4);
1044 newdir
[0] = DRIVE_LETTER (drive
);
1052 /* Finally, if no prefix has been specified and nm is not absolute,
1053 then it must be expanded relative to default_directory. */
1057 /* /... alone is not absolute on DOS and Windows. */
1058 && !IS_DIRECTORY_SEP (nm
[0])
1061 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1065 newdir
= SDATA (default_directory
);
1067 /* Note if special escape prefix is present, but remove for now. */
1068 if (newdir
[0] == '/' && newdir
[1] == ':')
1079 /* First ensure newdir is an absolute name. */
1081 /* Detect MSDOS file names with drive specifiers. */
1082 ! (IS_DRIVE (newdir
[0])
1083 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1085 /* Detect Windows file names in UNC format. */
1086 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1090 /* Effectively, let newdir be (expand-file-name newdir cwd).
1091 Because of the admonition against calling expand-file-name
1092 when we have pointers into lisp strings, we accomplish this
1093 indirectly by prepending newdir to nm if necessary, and using
1094 cwd (or the wd of newdir's drive) as the new newdir. */
1096 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1101 if (!IS_DIRECTORY_SEP (nm
[0]))
1103 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1104 file_name_as_directory (tmp
, newdir
);
1108 newdir
= alloca (MAXPATHLEN
+ 1);
1111 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1118 /* Strip off drive name from prefix, if present. */
1119 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1125 /* Keep only a prefix from newdir if nm starts with slash
1126 (//server/share for UNC, nothing otherwise). */
1127 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1130 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1133 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1135 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1137 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1149 /* Get rid of any slash at the end of newdir, unless newdir is
1150 just / or // (an incomplete UNC name). */
1151 length
= strlen (newdir
);
1152 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1154 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1158 unsigned char *temp
= (unsigned char *) alloca (length
);
1159 memcpy (temp
, newdir
, length
- 1);
1160 temp
[length
- 1] = 0;
1168 /* Now concatenate the directory and name to new space in the stack frame */
1169 tlen
+= strlen (nm
) + 1;
1171 /* Reserve space for drive specifier and escape prefix, since either
1172 or both may need to be inserted. (The Microsoft x86 compiler
1173 produces incorrect code if the following two lines are combined.) */
1174 target
= (unsigned char *) alloca (tlen
+ 4);
1176 #else /* not DOS_NT */
1177 target
= (unsigned char *) alloca (tlen
);
1178 #endif /* not DOS_NT */
1183 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1186 /* If newdir is effectively "C:/", then the drive letter will have
1187 been stripped and newdir will be "/". Concatenating with an
1188 absolute directory in nm produces "//", which will then be
1189 incorrectly treated as a network share. Ignore newdir in
1190 this case (keeping the drive letter). */
1191 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1192 && newdir
[1] == '\0'))
1194 strcpy (target
, newdir
);
1197 file_name_as_directory (target
, newdir
);
1200 strcat (target
, nm
);
1202 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1205 unsigned char *p
= target
;
1206 unsigned char *o
= target
;
1210 if (!IS_DIRECTORY_SEP (*p
))
1214 else if (p
[1] == '.'
1215 && (IS_DIRECTORY_SEP (p
[2])
1218 /* If "/." is the entire filename, keep the "/". Otherwise,
1219 just delete the whole "/.". */
1220 if (o
== target
&& p
[2] == '\0')
1224 else if (p
[1] == '.' && p
[2] == '.'
1225 /* `/../' is the "superroot" on certain file systems.
1226 Turned off on DOS_NT systems because they have no
1227 "superroot" and because this causes us to produce
1228 file names like "d:/../foo" which fail file-related
1229 functions of the underlying OS. (To reproduce, try a
1230 long series of "../../" in default_directory, longer
1231 than the number of levels from the root.) */
1235 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1238 unsigned char *prev_o
= o
;
1240 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1243 /* Don't go below server level in UNC filenames. */
1244 if (o
== target
+ 1 && IS_DIRECTORY_SEP (*o
)
1245 && IS_DIRECTORY_SEP (*target
))
1249 /* Keep initial / only if this is the whole name. */
1250 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1254 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1255 /* Collapse multiple `/' in a row. */
1264 /* At last, set drive name. */
1266 /* Except for network file name. */
1267 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1268 #endif /* WINDOWSNT */
1270 if (!drive
) abort ();
1272 target
[0] = DRIVE_LETTER (drive
);
1275 /* Reinsert the escape prefix if required. */
1282 dostounix_filename (target
);
1285 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1288 /* Again look to see if the file name has special constructs in it
1289 and perhaps call the corresponding file handler. This is needed
1290 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1291 the ".." component gives us "/user@host:/bar/../baz" which needs
1292 to be expanded again. */
1293 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1294 if (!NILP (handler
))
1295 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1301 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1302 This is the old version of expand-file-name, before it was thoroughly
1303 rewritten for Emacs 10.31. We leave this version here commented-out,
1304 because the code is very complex and likely to have subtle bugs. If
1305 bugs _are_ found, it might be of interest to look at the old code and
1306 see what did it do in the relevant situation.
1308 Don't remove this code: it's true that it will be accessible
1309 from the repository, but a few years from deletion, people will
1310 forget it is there. */
1312 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1313 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1314 "Convert FILENAME to absolute, and canonicalize it.\n\
1315 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1316 \(does not start with slash); if DEFAULT is nil or missing,\n\
1317 the current buffer's value of default-directory is used.\n\
1318 Filenames containing `.' or `..' as components are simplified;\n\
1319 initial `~/' expands to your home directory.\n\
1320 See also the function `substitute-in-file-name'.")
1322 Lisp_Object name
, defalt
;
1326 register unsigned char *newdir
, *p
, *o
;
1328 unsigned char *target
;
1332 CHECK_STRING (name
);
1335 /* If nm is absolute, flush ...// and detect /./ and /../.
1336 If no /./ or /../ we can return right away. */
1343 if (p
[0] == '/' && p
[1] == '/'
1346 if (p
[0] == '/' && p
[1] == '~')
1347 nm
= p
+ 1, lose
= 1;
1348 if (p
[0] == '/' && p
[1] == '.'
1349 && (p
[2] == '/' || p
[2] == 0
1350 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1356 if (nm
== SDATA (name
))
1358 return build_string (nm
);
1362 /* Now determine directory to start with and put it in NEWDIR */
1366 if (nm
[0] == '~') /* prefix ~ */
1367 if (nm
[1] == '/' || nm
[1] == 0)/* ~/filename */
1369 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1370 newdir
= (unsigned char *) "";
1373 else /* ~user/filename */
1375 /* Get past ~ to user */
1376 unsigned char *user
= nm
+ 1;
1377 /* Find end of name. */
1378 unsigned char *ptr
= (unsigned char *) strchr (user
, '/');
1379 int len
= ptr
? ptr
- user
: strlen (user
);
1380 /* Copy the user name into temp storage. */
1381 o
= (unsigned char *) alloca (len
+ 1);
1382 memcpy (o
, user
, len
);
1385 /* Look up the user name. */
1387 pw
= (struct passwd
*) getpwnam (o
+ 1);
1390 error ("\"%s\" isn't a registered user", o
+ 1);
1392 newdir
= (unsigned char *) pw
->pw_dir
;
1394 /* Discard the user name from NM. */
1398 if (nm
[0] != '/' && !newdir
)
1401 defalt
= current_buffer
->directory
;
1402 CHECK_STRING (defalt
);
1403 newdir
= SDATA (defalt
);
1406 /* Now concatenate the directory and name to new space in the stack frame */
1408 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1409 target
= (unsigned char *) alloca (tlen
);
1414 if (nm
[0] == 0 || nm
[0] == '/')
1415 strcpy (target
, newdir
);
1417 file_name_as_directory (target
, newdir
);
1420 strcat (target
, nm
);
1422 /* Now canonicalize by removing /. and /foo/.. if they appear */
1433 else if (!strncmp (p
, "//", 2)
1439 else if (p
[0] == '/' && p
[1] == '.'
1440 && (p
[2] == '/' || p
[2] == 0))
1442 else if (!strncmp (p
, "/..", 3)
1443 /* `/../' is the "superroot" on certain file systems. */
1445 && (p
[3] == '/' || p
[3] == 0))
1447 while (o
!= target
&& *--o
!= '/')
1449 if (o
== target
&& *o
== '/')
1459 return make_string (target
, o
- target
);
1463 /* If /~ or // appears, discard everything through first slash. */
1465 file_name_absolute_p (const unsigned char *filename
)
1468 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
1470 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
1471 && IS_DIRECTORY_SEP (filename
[2]))
1476 static unsigned char *
1477 search_embedded_absfilename (unsigned char *nm
, unsigned char *endp
)
1479 unsigned char *p
, *s
;
1481 for (p
= nm
+ 1; p
< endp
; p
++)
1484 || IS_DIRECTORY_SEP (p
[-1]))
1485 && file_name_absolute_p (p
)
1486 #if defined (WINDOWSNT) || defined(CYGWIN)
1487 /* // at start of file name is meaningful in Apollo,
1488 WindowsNT and Cygwin systems. */
1489 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
1490 #endif /* not (WINDOWSNT || CYGWIN) */
1493 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)); s
++);
1494 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
1496 unsigned char *o
= alloca (s
- p
+ 1);
1498 memcpy (o
, p
, s
- p
);
1501 /* If we have ~user and `user' exists, discard
1502 everything up to ~. But if `user' does not exist, leave
1503 ~user alone, it might be a literal file name. */
1505 pw
= getpwnam (o
+ 1);
1517 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1518 Ssubstitute_in_file_name
, 1, 1, 0,
1519 doc
: /* Substitute environment variables referred to in FILENAME.
1520 `$FOO' where FOO is an environment variable name means to substitute
1521 the value of that variable. The variable name should be terminated
1522 with a character not a letter, digit or underscore; otherwise, enclose
1523 the entire variable name in braces.
1525 If `/~' appears, all of FILENAME through that `/' is discarded.
1526 If `//' appears, everything up to and including the first of
1527 those `/' is discarded. */)
1528 (Lisp_Object filename
)
1532 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1533 unsigned char *target
= NULL
;
1535 int substituted
= 0;
1538 Lisp_Object handler
;
1540 CHECK_STRING (filename
);
1542 multibyte
= STRING_MULTIBYTE (filename
);
1544 /* If the file name has special constructs in it,
1545 call the corresponding file handler. */
1546 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1547 if (!NILP (handler
))
1548 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1550 /* Always work on a copy of the string, in case GC happens during
1551 decode of environment variables, causing the original Lisp_String
1552 data to be relocated. */
1553 nm
= (unsigned char *) alloca (SBYTES (filename
) + 1);
1554 memcpy (nm
, SDATA (filename
), SBYTES (filename
) + 1);
1557 dostounix_filename (nm
);
1558 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
1560 endp
= nm
+ SBYTES (filename
);
1562 /* If /~ or // appears, discard everything through first slash. */
1563 p
= search_embedded_absfilename (nm
, endp
);
1565 /* Start over with the new string, so we check the file-name-handler
1566 again. Important with filenames like "/home/foo//:/hello///there"
1567 which whould substitute to "/:/hello///there" rather than "/there". */
1568 return Fsubstitute_in_file_name
1569 (make_specified_string (p
, -1, endp
- p
, multibyte
));
1571 /* See if any variables are substituted into the string
1572 and find the total length of their values in `total' */
1574 for (p
= nm
; p
!= endp
;)
1584 /* "$$" means a single "$" */
1593 while (p
!= endp
&& *p
!= '}') p
++;
1594 if (*p
!= '}') goto missingclose
;
1600 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1604 /* Copy out the variable name */
1605 target
= (unsigned char *) alloca (s
- o
+ 1);
1606 strncpy (target
, o
, s
- o
);
1609 strupr (target
); /* $home == $HOME etc. */
1612 /* Get variable value */
1613 o
= (unsigned char *) egetenv (target
);
1616 /* Don't try to guess a maximum length - UTF8 can use up to
1617 four bytes per character. This code is unlikely to run
1618 in a situation that requires performance, so decoding the
1619 env variables twice should be acceptable. Note that
1620 decoding may cause a garbage collect. */
1621 Lisp_Object orig
, decoded
;
1622 orig
= make_unibyte_string (o
, strlen (o
));
1623 decoded
= DECODE_FILE (orig
);
1624 total
+= SBYTES (decoded
);
1634 /* If substitution required, recopy the string and do it */
1635 /* Make space in stack frame for the new copy */
1636 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
1639 /* Copy the rest of the name through, replacing $ constructs with values */
1656 while (p
!= endp
&& *p
!= '}') p
++;
1657 if (*p
!= '}') goto missingclose
;
1663 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1667 /* Copy out the variable name */
1668 target
= (unsigned char *) alloca (s
- o
+ 1);
1669 strncpy (target
, o
, s
- o
);
1672 strupr (target
); /* $home == $HOME etc. */
1675 /* Get variable value */
1676 o
= (unsigned char *) egetenv (target
);
1680 strcpy (x
, target
); x
+= strlen (target
);
1684 Lisp_Object orig
, decoded
;
1685 int orig_length
, decoded_length
;
1686 orig_length
= strlen (o
);
1687 orig
= make_unibyte_string (o
, orig_length
);
1688 decoded
= DECODE_FILE (orig
);
1689 decoded_length
= SBYTES (decoded
);
1690 strncpy (x
, SDATA (decoded
), decoded_length
);
1691 x
+= decoded_length
;
1693 /* If environment variable needed decoding, return value
1694 needs to be multibyte. */
1695 if (decoded_length
!= orig_length
1696 || strncmp (SDATA (decoded
), o
, orig_length
))
1703 /* If /~ or // appears, discard everything through first slash. */
1704 while ((p
= search_embedded_absfilename (xnm
, x
)))
1705 /* This time we do not start over because we've already expanded envvars
1706 and replaced $$ with $. Maybe we should start over as well, but we'd
1707 need to quote some $ to $$ first. */
1710 return make_specified_string (xnm
, -1, x
- xnm
, multibyte
);
1713 error ("Bad format environment-variable substitution");
1715 error ("Missing \"}\" in environment-variable substitution");
1717 error ("Substituting nonexistent environment variable \"%s\"", target
);
1723 /* A slightly faster and more convenient way to get
1724 (directory-file-name (expand-file-name FOO)). */
1727 expand_and_dir_to_file (Lisp_Object filename
, Lisp_Object defdir
)
1729 register Lisp_Object absname
;
1731 absname
= Fexpand_file_name (filename
, defdir
);
1733 /* Remove final slash, if any (unless this is the root dir).
1734 stat behaves differently depending! */
1735 if (SCHARS (absname
) > 1
1736 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
1737 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
1738 /* We cannot take shortcuts; they might be wrong for magic file names. */
1739 absname
= Fdirectory_file_name (absname
);
1743 /* Signal an error if the file ABSNAME already exists.
1744 If INTERACTIVE is nonzero, ask the user whether to proceed,
1745 and bypass the error if the user says to go ahead.
1746 QUERYSTRING is a name for the action that is being considered
1749 *STATPTR is used to store the stat information if the file exists.
1750 If the file does not exist, STATPTR->st_mode is set to 0.
1751 If STATPTR is null, we don't store into it.
1753 If QUICK is nonzero, we ask for y or n, not yes or no. */
1756 barf_or_query_if_file_exists (Lisp_Object absname
, const unsigned char *querystring
, int interactive
, struct stat
*statptr
, int quick
)
1758 register Lisp_Object tem
, encoded_filename
;
1759 struct stat statbuf
;
1760 struct gcpro gcpro1
;
1762 encoded_filename
= ENCODE_FILE (absname
);
1764 /* stat is a good way to tell whether the file exists,
1765 regardless of what access permissions it has. */
1766 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
1769 xsignal2 (Qfile_already_exists
,
1770 build_string ("File already exists"), absname
);
1772 tem
= format2 ("File %s already exists; %s anyway? ",
1773 absname
, build_string (querystring
));
1775 tem
= call1 (intern ("y-or-n-p"), tem
);
1777 tem
= do_yes_or_no_p (tem
);
1780 xsignal2 (Qfile_already_exists
,
1781 build_string ("File already exists"), absname
);
1788 statptr
->st_mode
= 0;
1793 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
1794 "fCopy file: \nGCopy %s to file: \np\nP",
1795 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
1796 If NEWNAME names a directory, copy FILE there.
1798 This function always sets the file modes of the output file to match
1801 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1802 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1803 signal a `file-already-exists' error without overwriting. If
1804 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1805 about overwriting; this is what happens in interactive use with M-x.
1806 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1809 Fourth arg KEEP-TIME non-nil means give the output file the same
1810 last-modified time as the old one. (This works on only some systems.)
1812 A prefix arg makes KEEP-TIME non-nil.
1814 If PRESERVE-UID-GID is non-nil, we try to transfer the
1815 uid and gid of FILE to NEWNAME.
1817 If PRESERVE-SELINUX-CONTEXT is non-nil and SELinux is enabled
1818 on the system, we copy the SELinux context of FILE to NEWNAME. */)
1819 (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
)
1822 char buf
[16 * 1024];
1823 struct stat st
, out_st
;
1824 Lisp_Object handler
;
1825 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1826 int count
= SPECPDL_INDEX ();
1827 int input_file_statable_p
;
1828 Lisp_Object encoded_file
, encoded_newname
;
1830 security_context_t con
;
1831 int fail
, conlength
= 0;
1834 encoded_file
= encoded_newname
= Qnil
;
1835 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
1836 CHECK_STRING (file
);
1837 CHECK_STRING (newname
);
1839 if (!NILP (Ffile_directory_p (newname
)))
1840 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
1842 newname
= Fexpand_file_name (newname
, Qnil
);
1844 file
= Fexpand_file_name (file
, Qnil
);
1846 /* If the input file name has special constructs in it,
1847 call the corresponding file handler. */
1848 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1849 /* Likewise for output file name. */
1851 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1852 if (!NILP (handler
))
1853 RETURN_UNGCPRO (call7 (handler
, Qcopy_file
, file
, newname
,
1854 ok_if_already_exists
, keep_time
, preserve_uid_gid
,
1855 preserve_selinux_context
));
1857 encoded_file
= ENCODE_FILE (file
);
1858 encoded_newname
= ENCODE_FILE (newname
);
1860 if (NILP (ok_if_already_exists
)
1861 || INTEGERP (ok_if_already_exists
))
1862 barf_or_query_if_file_exists (newname
, "copy to it",
1863 INTEGERP (ok_if_already_exists
), &out_st
, 0);
1864 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
1868 if (!CopyFile (SDATA (encoded_file
),
1869 SDATA (encoded_newname
),
1871 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
1872 /* CopyFile retains the timestamp by default. */
1873 else if (NILP (keep_time
))
1879 EMACS_GET_TIME (now
);
1880 filename
= SDATA (encoded_newname
);
1882 /* Ensure file is writable while its modified time is set. */
1883 attributes
= GetFileAttributes (filename
);
1884 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
1885 if (set_file_times (filename
, now
, now
))
1887 /* Restore original attributes. */
1888 SetFileAttributes (filename
, attributes
);
1889 xsignal2 (Qfile_date_error
,
1890 build_string ("Cannot set file date"), newname
);
1892 /* Restore original attributes. */
1893 SetFileAttributes (filename
, attributes
);
1895 #else /* not WINDOWSNT */
1897 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
1901 report_file_error ("Opening input file", Fcons (file
, Qnil
));
1903 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1905 /* We can only copy regular files and symbolic links. Other files are not
1907 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1910 if (!NILP (preserve_selinux_context
) && is_selinux_enabled ())
1912 conlength
= fgetfilecon (ifd
, &con
);
1913 if (conlength
== -1)
1914 report_file_error ("Doing fgetfilecon", Fcons (file
, Qnil
));
1918 if (out_st
.st_mode
!= 0
1919 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
1922 report_file_error ("Input and output files are the same",
1923 Fcons (file
, Fcons (newname
, Qnil
)));
1926 #if defined (S_ISREG) && defined (S_ISLNK)
1927 if (input_file_statable_p
)
1929 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1931 #if defined (EISDIR)
1932 /* Get a better looking error message. */
1935 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
1938 #endif /* S_ISREG && S_ISLNK */
1941 /* System's default file type was set to binary by _fmode in emacs.c. */
1942 ofd
= emacs_open (SDATA (encoded_newname
),
1943 O_WRONLY
| O_TRUNC
| O_CREAT
1944 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
1945 S_IREAD
| S_IWRITE
);
1946 #else /* not MSDOS */
1947 ofd
= emacs_open (SDATA (encoded_newname
),
1948 O_WRONLY
| O_TRUNC
| O_CREAT
1949 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
1951 #endif /* not MSDOS */
1953 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1955 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1959 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
1960 if (emacs_write (ofd
, buf
, n
) != n
)
1961 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1965 /* Preserve the original file modes, and if requested, also its
1967 if (input_file_statable_p
)
1969 if (! NILP (preserve_uid_gid
))
1970 fchown (ofd
, st
.st_uid
, st
.st_gid
);
1971 fchmod (ofd
, st
.st_mode
& 07777);
1973 #endif /* not MSDOS */
1978 /* Set the modified context back to the file. */
1979 fail
= fsetfilecon (ofd
, con
);
1981 report_file_error ("Doing fsetfilecon", Fcons (newname
, Qnil
));
1987 /* Closing the output clobbers the file times on some systems. */
1988 if (emacs_close (ofd
) < 0)
1989 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1991 if (input_file_statable_p
)
1993 if (!NILP (keep_time
))
1995 EMACS_TIME atime
, mtime
;
1996 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1997 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1998 if (set_file_times (SDATA (encoded_newname
),
2000 xsignal2 (Qfile_date_error
,
2001 build_string ("Cannot set file date"), newname
);
2008 if (input_file_statable_p
)
2010 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2011 and if it can't, it tells so. Otherwise, under MSDOS we usually
2012 get only the READ bit, which will make the copied file read-only,
2013 so it's better not to chmod at all. */
2014 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2015 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2018 #endif /* not WINDOWSNT */
2020 /* Discard the unwind protects. */
2021 specpdl_ptr
= specpdl
+ count
;
2027 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2028 Smake_directory_internal
, 1, 1, 0,
2029 doc
: /* Create a new directory named DIRECTORY. */)
2030 (Lisp_Object directory
)
2032 const unsigned char *dir
;
2033 Lisp_Object handler
;
2034 Lisp_Object encoded_dir
;
2036 CHECK_STRING (directory
);
2037 directory
= Fexpand_file_name (directory
, Qnil
);
2039 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2040 if (!NILP (handler
))
2041 return call2 (handler
, Qmake_directory_internal
, directory
);
2043 encoded_dir
= ENCODE_FILE (directory
);
2045 dir
= SDATA (encoded_dir
);
2048 if (mkdir (dir
) != 0)
2050 if (mkdir (dir
, 0777) != 0)
2052 report_file_error ("Creating directory", list1 (directory
));
2057 DEFUN ("delete-directory-internal", Fdelete_directory_internal
,
2058 Sdelete_directory_internal
, 1, 1, 0,
2059 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2060 (Lisp_Object directory
)
2062 const unsigned char *dir
;
2063 Lisp_Object handler
;
2064 Lisp_Object encoded_dir
;
2066 CHECK_STRING (directory
);
2067 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2068 encoded_dir
= ENCODE_FILE (directory
);
2069 dir
= SDATA (encoded_dir
);
2071 if (rmdir (dir
) != 0)
2072 report_file_error ("Removing directory", list1 (directory
));
2077 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 2,
2078 "(list (read-file-name \
2079 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2080 \"Move file to trash: \" \"Delete file: \") \
2081 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2082 (null current-prefix-arg))",
2083 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2084 If file has multiple names, it continues to exist with the other names.
2085 TRASH non-nil means to trash the file instead of deleting, provided
2086 `delete-by-moving-to-trash' is non-nil.
2088 When called interactively, TRASH is t if no prefix argument is given.
2089 With a prefix argument, TRASH is nil. */)
2090 (Lisp_Object filename
, Lisp_Object trash
)
2092 Lisp_Object handler
;
2093 Lisp_Object encoded_file
;
2094 struct gcpro gcpro1
;
2097 if (!NILP (Ffile_directory_p (filename
))
2098 && NILP (Ffile_symlink_p (filename
)))
2099 xsignal2 (Qfile_error
,
2100 build_string ("Removing old name: is a directory"),
2103 filename
= Fexpand_file_name (filename
, Qnil
);
2105 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2106 if (!NILP (handler
))
2107 return call3 (handler
, Qdelete_file
, filename
, trash
);
2109 if (delete_by_moving_to_trash
&& !NILP (trash
))
2110 return call1 (Qmove_file_to_trash
, filename
);
2112 encoded_file
= ENCODE_FILE (filename
);
2114 if (0 > unlink (SDATA (encoded_file
)))
2115 report_file_error ("Removing old name", list1 (filename
));
2120 internal_delete_file_1 (Lisp_Object ignore
)
2125 /* Delete file FILENAME, returning 1 if successful and 0 if failed.
2126 This ignores `delete-by-moving-to-trash'. */
2129 internal_delete_file (Lisp_Object filename
)
2133 tem
= internal_condition_case_2 (Fdelete_file
, filename
, Qnil
,
2134 Qt
, internal_delete_file_1
);
2138 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2139 "fRename file: \nGRename %s to file: \np",
2140 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2141 If file has names other than FILE, it continues to have those names.
2142 Signals a `file-already-exists' error if a file NEWNAME already exists
2143 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2144 A number as third arg means request confirmation if NEWNAME already exists.
2145 This is what happens in interactive use with M-x. */)
2146 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2148 Lisp_Object handler
;
2149 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2150 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2152 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2153 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2154 CHECK_STRING (file
);
2155 CHECK_STRING (newname
);
2156 file
= Fexpand_file_name (file
, Qnil
);
2158 if ((!NILP (Ffile_directory_p (newname
)))
2160 /* If the file names are identical but for the case,
2161 don't attempt to move directory to itself. */
2162 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2166 Lisp_Object fname
= NILP (Ffile_directory_p (file
))
2167 ? file
: Fdirectory_file_name (file
);
2168 newname
= Fexpand_file_name (Ffile_name_nondirectory (fname
), newname
);
2171 newname
= Fexpand_file_name (newname
, Qnil
);
2173 /* If the file name has special constructs in it,
2174 call the corresponding file handler. */
2175 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2177 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2178 if (!NILP (handler
))
2179 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2180 file
, newname
, ok_if_already_exists
));
2182 encoded_file
= ENCODE_FILE (file
);
2183 encoded_newname
= ENCODE_FILE (newname
);
2186 /* If the file names are identical but for the case, don't ask for
2187 confirmation: they simply want to change the letter-case of the
2189 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2191 if (NILP (ok_if_already_exists
)
2192 || INTEGERP (ok_if_already_exists
))
2193 barf_or_query_if_file_exists (newname
, "rename to it",
2194 INTEGERP (ok_if_already_exists
), 0, 0);
2195 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2201 symlink_target
= Ffile_symlink_p (file
);
2202 if (! NILP (symlink_target
))
2203 Fmake_symbolic_link (symlink_target
, newname
,
2204 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2207 if (!NILP (Ffile_directory_p (file
)))
2208 call4 (Qcopy_directory
, file
, newname
, Qt
, Qnil
);
2210 /* We have already prompted if it was an integer, so don't
2211 have copy-file prompt again. */
2212 Fcopy_file (file
, newname
,
2213 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2216 count
= SPECPDL_INDEX ();
2217 specbind (Qdelete_by_moving_to_trash
, Qnil
);
2219 if (!NILP (Ffile_directory_p (file
))
2221 && NILP (symlink_target
)
2224 call2 (Qdelete_directory
, file
, Qt
);
2226 Fdelete_file (file
, Qnil
);
2227 unbind_to (count
, Qnil
);
2230 report_file_error ("Renaming", list2 (file
, newname
));
2236 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2237 "fAdd name to file: \nGName to add to %s: \np",
2238 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2239 Signals a `file-already-exists' error if a file NEWNAME already exists
2240 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2241 A number as third arg means request confirmation if NEWNAME already exists.
2242 This is what happens in interactive use with M-x. */)
2243 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2245 Lisp_Object handler
;
2246 Lisp_Object encoded_file
, encoded_newname
;
2247 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2249 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2250 encoded_file
= encoded_newname
= Qnil
;
2251 CHECK_STRING (file
);
2252 CHECK_STRING (newname
);
2253 file
= Fexpand_file_name (file
, Qnil
);
2255 if (!NILP (Ffile_directory_p (newname
)))
2256 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2258 newname
= Fexpand_file_name (newname
, Qnil
);
2260 /* If the file name has special constructs in it,
2261 call the corresponding file handler. */
2262 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2263 if (!NILP (handler
))
2264 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2265 newname
, ok_if_already_exists
));
2267 /* If the new name has special constructs in it,
2268 call the corresponding file handler. */
2269 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2270 if (!NILP (handler
))
2271 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2272 newname
, ok_if_already_exists
));
2274 encoded_file
= ENCODE_FILE (file
);
2275 encoded_newname
= ENCODE_FILE (newname
);
2277 if (NILP (ok_if_already_exists
)
2278 || INTEGERP (ok_if_already_exists
))
2279 barf_or_query_if_file_exists (newname
, "make it a new name",
2280 INTEGERP (ok_if_already_exists
), 0, 0);
2282 unlink (SDATA (newname
));
2283 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2284 report_file_error ("Adding new name", list2 (file
, newname
));
2290 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2291 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2292 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2293 Both args must be strings.
2294 Signals a `file-already-exists' error if a file LINKNAME already exists
2295 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2296 A number as third arg means request confirmation if LINKNAME already exists.
2297 This happens for interactive use with M-x. */)
2298 (Lisp_Object filename
, Lisp_Object linkname
, Lisp_Object ok_if_already_exists
)
2300 Lisp_Object handler
;
2301 Lisp_Object encoded_filename
, encoded_linkname
;
2302 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2304 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2305 encoded_filename
= encoded_linkname
= Qnil
;
2306 CHECK_STRING (filename
);
2307 CHECK_STRING (linkname
);
2308 /* If the link target has a ~, we must expand it to get
2309 a truly valid file name. Otherwise, do not expand;
2310 we want to permit links to relative file names. */
2311 if (SREF (filename
, 0) == '~')
2312 filename
= Fexpand_file_name (filename
, Qnil
);
2314 if (!NILP (Ffile_directory_p (linkname
)))
2315 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2317 linkname
= Fexpand_file_name (linkname
, Qnil
);
2319 /* If the file name has special constructs in it,
2320 call the corresponding file handler. */
2321 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2322 if (!NILP (handler
))
2323 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2324 linkname
, ok_if_already_exists
));
2326 /* If the new link name has special constructs in it,
2327 call the corresponding file handler. */
2328 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2329 if (!NILP (handler
))
2330 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2331 linkname
, ok_if_already_exists
));
2334 encoded_filename
= ENCODE_FILE (filename
);
2335 encoded_linkname
= ENCODE_FILE (linkname
);
2337 if (NILP (ok_if_already_exists
)
2338 || INTEGERP (ok_if_already_exists
))
2339 barf_or_query_if_file_exists (linkname
, "make it a link",
2340 INTEGERP (ok_if_already_exists
), 0, 0);
2341 if (0 > symlink (SDATA (encoded_filename
),
2342 SDATA (encoded_linkname
)))
2344 /* If we didn't complain already, silently delete existing file. */
2345 if (errno
== EEXIST
)
2347 unlink (SDATA (encoded_linkname
));
2348 if (0 <= symlink (SDATA (encoded_filename
),
2349 SDATA (encoded_linkname
)))
2356 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2363 xsignal1 (Qfile_error
, build_string ("Symbolic links are not supported"));
2365 #endif /* S_IFLNK */
2369 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2371 doc
: /* Return t if file FILENAME specifies an absolute file name.
2372 On Unix, this is a name starting with a `/' or a `~'. */)
2373 (Lisp_Object filename
)
2375 CHECK_STRING (filename
);
2376 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
2379 /* Return nonzero if file FILENAME exists and can be executed. */
2382 check_executable (char *filename
)
2385 int len
= strlen (filename
);
2388 if (stat (filename
, &st
) < 0)
2390 return ((st
.st_mode
& S_IEXEC
) != 0);
2391 #else /* not DOS_NT */
2392 #ifdef HAVE_EUIDACCESS
2393 return (euidaccess (filename
, 1) >= 0);
2395 /* Access isn't quite right because it uses the real uid
2396 and we really want to test with the effective uid.
2397 But Unix doesn't give us a right way to do it. */
2398 return (access (filename
, 1) >= 0);
2400 #endif /* not DOS_NT */
2403 /* Return nonzero if file FILENAME exists and can be written. */
2406 check_writable (const char *filename
)
2410 if (stat (filename
, &st
) < 0)
2412 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2413 #else /* not MSDOS */
2414 #ifdef HAVE_EUIDACCESS
2415 return (euidaccess (filename
, 2) >= 0);
2417 /* Access isn't quite right because it uses the real uid
2418 and we really want to test with the effective uid.
2419 But Unix doesn't give us a right way to do it.
2420 Opening with O_WRONLY could work for an ordinary file,
2421 but would lose for directories. */
2422 return (access (filename
, 2) >= 0);
2424 #endif /* not MSDOS */
2427 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2428 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
2429 See also `file-readable-p' and `file-attributes'.
2430 This returns nil for a symlink to a nonexistent file.
2431 Use `file-symlink-p' to test for such links. */)
2432 (Lisp_Object filename
)
2434 Lisp_Object absname
;
2435 Lisp_Object handler
;
2436 struct stat statbuf
;
2438 CHECK_STRING (filename
);
2439 absname
= Fexpand_file_name (filename
, Qnil
);
2441 /* If the file name has special constructs in it,
2442 call the corresponding file handler. */
2443 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2444 if (!NILP (handler
))
2445 return call2 (handler
, Qfile_exists_p
, absname
);
2447 absname
= ENCODE_FILE (absname
);
2449 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
2452 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2453 doc
: /* Return t if FILENAME can be executed by you.
2454 For a directory, this means you can access files in that directory. */)
2455 (Lisp_Object filename
)
2457 Lisp_Object absname
;
2458 Lisp_Object handler
;
2460 CHECK_STRING (filename
);
2461 absname
= Fexpand_file_name (filename
, Qnil
);
2463 /* If the file name has special constructs in it,
2464 call the corresponding file handler. */
2465 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2466 if (!NILP (handler
))
2467 return call2 (handler
, Qfile_executable_p
, absname
);
2469 absname
= ENCODE_FILE (absname
);
2471 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
2474 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2475 doc
: /* Return t if file FILENAME exists and you can read it.
2476 See also `file-exists-p' and `file-attributes'. */)
2477 (Lisp_Object filename
)
2479 Lisp_Object absname
;
2480 Lisp_Object handler
;
2483 struct stat statbuf
;
2485 CHECK_STRING (filename
);
2486 absname
= Fexpand_file_name (filename
, Qnil
);
2488 /* If the file name has special constructs in it,
2489 call the corresponding file handler. */
2490 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2491 if (!NILP (handler
))
2492 return call2 (handler
, Qfile_readable_p
, absname
);
2494 absname
= ENCODE_FILE (absname
);
2496 #if defined(DOS_NT) || defined(macintosh)
2497 /* Under MS-DOS, Windows, and Macintosh, open does not work for
2499 if (access (SDATA (absname
), 0) == 0)
2502 #else /* not DOS_NT and not macintosh */
2504 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2505 /* Opening a fifo without O_NONBLOCK can wait.
2506 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2507 except in the case of a fifo, on a system which handles it. */
2508 desc
= stat (SDATA (absname
), &statbuf
);
2511 if (S_ISFIFO (statbuf
.st_mode
))
2512 flags
|= O_NONBLOCK
;
2514 desc
= emacs_open (SDATA (absname
), flags
, 0);
2519 #endif /* not DOS_NT and not macintosh */
2522 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2524 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2525 doc
: /* Return t if file FILENAME can be written or created by you. */)
2526 (Lisp_Object filename
)
2528 Lisp_Object absname
, dir
, encoded
;
2529 Lisp_Object handler
;
2530 struct stat statbuf
;
2532 CHECK_STRING (filename
);
2533 absname
= Fexpand_file_name (filename
, Qnil
);
2535 /* If the file name has special constructs in it,
2536 call the corresponding file handler. */
2537 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2538 if (!NILP (handler
))
2539 return call2 (handler
, Qfile_writable_p
, absname
);
2541 encoded
= ENCODE_FILE (absname
);
2542 if (stat (SDATA (encoded
), &statbuf
) >= 0)
2543 return (check_writable (SDATA (encoded
))
2546 dir
= Ffile_name_directory (absname
);
2549 dir
= Fdirectory_file_name (dir
);
2552 dir
= ENCODE_FILE (dir
);
2554 /* The read-only attribute of the parent directory doesn't affect
2555 whether a file or directory can be created within it. Some day we
2556 should check ACLs though, which do affect this. */
2557 if (stat (SDATA (dir
), &statbuf
) < 0)
2559 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2561 return (check_writable (!NILP (dir
) ? SSDATA (dir
) : "")
2566 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2567 doc
: /* Access file FILENAME, and get an error if that does not work.
2568 The second argument STRING is used in the error message.
2569 If there is no error, returns nil. */)
2570 (Lisp_Object filename
, Lisp_Object string
)
2572 Lisp_Object handler
, encoded_filename
, absname
;
2575 CHECK_STRING (filename
);
2576 absname
= Fexpand_file_name (filename
, Qnil
);
2578 CHECK_STRING (string
);
2580 /* If the file name has special constructs in it,
2581 call the corresponding file handler. */
2582 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
2583 if (!NILP (handler
))
2584 return call3 (handler
, Qaccess_file
, absname
, string
);
2586 encoded_filename
= ENCODE_FILE (absname
);
2588 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
2590 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
2596 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2597 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
2598 The value is the link target, as a string.
2599 Otherwise it returns nil.
2601 This function returns t when given the name of a symlink that
2602 points to a nonexistent file. */)
2603 (Lisp_Object filename
)
2605 Lisp_Object handler
;
2607 CHECK_STRING (filename
);
2608 filename
= Fexpand_file_name (filename
, Qnil
);
2610 /* If the file name has special constructs in it,
2611 call the corresponding file handler. */
2612 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2613 if (!NILP (handler
))
2614 return call2 (handler
, Qfile_symlink_p
, filename
);
2623 filename
= ENCODE_FILE (filename
);
2630 buf
= (char *) xrealloc (buf
, bufsize
);
2631 memset (buf
, 0, bufsize
);
2634 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
2638 /* HP-UX reports ERANGE if buffer is too small. */
2639 if (errno
== ERANGE
)
2649 while (valsize
>= bufsize
);
2651 val
= make_string (buf
, valsize
);
2652 if (buf
[0] == '/' && strchr (buf
, ':'))
2653 val
= concat2 (build_string ("/:"), val
);
2655 val
= DECODE_FILE (val
);
2658 #else /* not S_IFLNK */
2660 #endif /* not S_IFLNK */
2663 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2664 doc
: /* Return t if FILENAME names an existing directory.
2665 Symbolic links to directories count as directories.
2666 See `file-symlink-p' to distinguish symlinks. */)
2667 (Lisp_Object filename
)
2669 register Lisp_Object absname
;
2671 Lisp_Object handler
;
2673 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2675 /* If the file name has special constructs in it,
2676 call the corresponding file handler. */
2677 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2678 if (!NILP (handler
))
2679 return call2 (handler
, Qfile_directory_p
, absname
);
2681 absname
= ENCODE_FILE (absname
);
2683 if (stat (SDATA (absname
), &st
) < 0)
2685 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2688 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2689 doc
: /* Return t if file FILENAME names a directory you can open.
2690 For the value to be t, FILENAME must specify the name of a directory as a file,
2691 and the directory must allow you to open files in it. In order to use a
2692 directory as a buffer's current directory, this predicate must return true.
2693 A directory name spec may be given instead; then the value is t
2694 if the directory so specified exists and really is a readable and
2695 searchable directory. */)
2696 (Lisp_Object filename
)
2698 Lisp_Object handler
;
2700 struct gcpro gcpro1
;
2702 /* If the file name has special constructs in it,
2703 call the corresponding file handler. */
2704 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2705 if (!NILP (handler
))
2706 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2709 tem
= (NILP (Ffile_directory_p (filename
))
2710 || NILP (Ffile_executable_p (filename
)));
2712 return tem
? Qnil
: Qt
;
2715 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2716 doc
: /* Return t if FILENAME names a regular file.
2717 This is the sort of file that holds an ordinary stream of data bytes.
2718 Symbolic links to regular files count as regular files.
2719 See `file-symlink-p' to distinguish symlinks. */)
2720 (Lisp_Object filename
)
2722 register Lisp_Object absname
;
2724 Lisp_Object handler
;
2726 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2728 /* If the file name has special constructs in it,
2729 call the corresponding file handler. */
2730 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2731 if (!NILP (handler
))
2732 return call2 (handler
, Qfile_regular_p
, absname
);
2734 absname
= ENCODE_FILE (absname
);
2739 Lisp_Object tem
= Vw32_get_true_file_attributes
;
2741 /* Tell stat to use expensive method to get accurate info. */
2742 Vw32_get_true_file_attributes
= Qt
;
2743 result
= stat (SDATA (absname
), &st
);
2744 Vw32_get_true_file_attributes
= tem
;
2748 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2751 if (stat (SDATA (absname
), &st
) < 0)
2753 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2757 DEFUN ("file-selinux-context", Ffile_selinux_context
,
2758 Sfile_selinux_context
, 1, 1, 0,
2759 doc
: /* Return SELinux context of file named FILENAME,
2760 as a list ("user", "role", "type", "range"). Return (nil, nil, nil, nil)
2761 if file does not exist, is not accessible, or SELinux is disabled */)
2762 (Lisp_Object filename
)
2764 Lisp_Object absname
;
2765 Lisp_Object values
[4];
2766 Lisp_Object handler
;
2768 security_context_t con
;
2773 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2775 /* If the file name has special constructs in it,
2776 call the corresponding file handler. */
2777 handler
= Ffind_file_name_handler (absname
, Qfile_selinux_context
);
2778 if (!NILP (handler
))
2779 return call2 (handler
, Qfile_selinux_context
, absname
);
2781 absname
= ENCODE_FILE (absname
);
2788 if (is_selinux_enabled ())
2790 conlength
= lgetfilecon (SDATA (absname
), &con
);
2793 context
= context_new (con
);
2794 if (context_user_get (context
))
2795 values
[0] = build_string (context_user_get (context
));
2796 if (context_role_get (context
))
2797 values
[1] = build_string (context_role_get (context
));
2798 if (context_type_get (context
))
2799 values
[2] = build_string (context_type_get (context
));
2800 if (context_range_get (context
))
2801 values
[3] = build_string (context_range_get (context
));
2802 context_free (context
);
2809 return Flist (sizeof(values
) / sizeof(values
[0]), values
);
2812 DEFUN ("set-file-selinux-context", Fset_file_selinux_context
,
2813 Sset_file_selinux_context
, 2, 2, 0,
2814 doc
: /* Set SELinux context of file named FILENAME to CONTEXT
2815 as a list ("user", "role", "type", "range"). Has no effect if SELinux
2817 (Lisp_Object filename
, Lisp_Object context
)
2819 Lisp_Object absname
, encoded_absname
;
2820 Lisp_Object handler
;
2821 Lisp_Object user
= CAR_SAFE (context
);
2822 Lisp_Object role
= CAR_SAFE (CDR_SAFE (context
));
2823 Lisp_Object type
= CAR_SAFE (CDR_SAFE (CDR_SAFE (context
)));
2824 Lisp_Object range
= CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context
))));
2826 security_context_t con
;
2827 int fail
, conlength
;
2828 context_t parsed_con
;
2831 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2833 /* If the file name has special constructs in it,
2834 call the corresponding file handler. */
2835 handler
= Ffind_file_name_handler (absname
, Qset_file_selinux_context
);
2836 if (!NILP (handler
))
2837 return call3 (handler
, Qset_file_selinux_context
, absname
, context
);
2839 encoded_absname
= ENCODE_FILE (absname
);
2842 if (is_selinux_enabled ())
2844 /* Get current file context. */
2845 conlength
= lgetfilecon (SDATA (encoded_absname
), &con
);
2848 parsed_con
= context_new (con
);
2849 /* Change the parts defined in the parameter.*/
2852 if (context_user_set (parsed_con
, SDATA (user
)))
2853 error ("Doing context_user_set");
2857 if (context_role_set (parsed_con
, SDATA (role
)))
2858 error ("Doing context_role_set");
2862 if (context_type_set (parsed_con
, SDATA (type
)))
2863 error ("Doing context_type_set");
2865 if (STRINGP (range
))
2867 if (context_range_set (parsed_con
, SDATA (range
)))
2868 error ("Doing context_range_set");
2871 /* Set the modified context back to the file. */
2872 fail
= lsetfilecon (SDATA (encoded_absname
), context_str (parsed_con
));
2874 report_file_error ("Doing lsetfilecon", Fcons (absname
, Qnil
));
2876 context_free (parsed_con
);
2879 report_file_error("Doing lgetfilecon", Fcons (absname
, Qnil
));
2889 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2890 doc
: /* Return mode bits of file named FILENAME, as an integer.
2891 Return nil, if file does not exist or is not accessible. */)
2892 (Lisp_Object filename
)
2894 Lisp_Object absname
;
2896 Lisp_Object handler
;
2898 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2900 /* If the file name has special constructs in it,
2901 call the corresponding file handler. */
2902 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2903 if (!NILP (handler
))
2904 return call2 (handler
, Qfile_modes
, absname
);
2906 absname
= ENCODE_FILE (absname
);
2908 if (stat (SDATA (absname
), &st
) < 0)
2911 return make_number (st
.st_mode
& 07777);
2914 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
2915 "(let ((file (read-file-name \"File: \"))) \
2916 (list file (read-file-modes nil file)))",
2917 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
2918 Only the 12 low bits of MODE are used.
2920 Interactively, mode bits are read by `read-file-modes', which accepts
2921 symbolic notation, like the `chmod' command from GNU Coreutils. */)
2922 (Lisp_Object filename
, Lisp_Object mode
)
2924 Lisp_Object absname
, encoded_absname
;
2925 Lisp_Object handler
;
2927 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2928 CHECK_NUMBER (mode
);
2930 /* If the file name has special constructs in it,
2931 call the corresponding file handler. */
2932 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2933 if (!NILP (handler
))
2934 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2936 encoded_absname
= ENCODE_FILE (absname
);
2938 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
2939 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2944 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2945 doc
: /* Set the file permission bits for newly created files.
2946 The argument MODE should be an integer; only the low 9 bits are used.
2947 This setting is inherited by subprocesses. */)
2950 CHECK_NUMBER (mode
);
2952 umask ((~ XINT (mode
)) & 0777);
2957 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2958 doc
: /* Return the default file protection for created files.
2959 The value is an integer. */)
2965 realmask
= umask (0);
2968 XSETINT (value
, (~ realmask
) & 0777);
2973 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
2974 doc
: /* Set times of file FILENAME to TIME.
2975 Set both access and modification times.
2976 Return t on success, else nil.
2977 Use the current time if TIME is nil. TIME is in the format of
2979 (Lisp_Object filename
, Lisp_Object time
)
2981 Lisp_Object absname
, encoded_absname
;
2982 Lisp_Object handler
;
2986 if (! lisp_time_argument (time
, &sec
, &usec
))
2987 error ("Invalid time specification");
2989 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2991 /* If the file name has special constructs in it,
2992 call the corresponding file handler. */
2993 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
2994 if (!NILP (handler
))
2995 return call3 (handler
, Qset_file_times
, absname
, time
);
2997 encoded_absname
= ENCODE_FILE (absname
);
3002 EMACS_SET_SECS (t
, sec
);
3003 EMACS_SET_USECS (t
, usec
);
3005 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3010 /* Setting times on a directory always fails. */
3011 if (stat (SDATA (encoded_absname
), &st
) == 0
3012 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3015 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3024 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3025 doc
: /* Tell Unix to finish all pending disk updates. */)
3032 #endif /* HAVE_SYNC */
3034 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3035 doc
: /* Return t if file FILE1 is newer than file FILE2.
3036 If FILE1 does not exist, the answer is nil;
3037 otherwise, if FILE2 does not exist, the answer is t. */)
3038 (Lisp_Object file1
, Lisp_Object file2
)
3040 Lisp_Object absname1
, absname2
;
3043 Lisp_Object handler
;
3044 struct gcpro gcpro1
, gcpro2
;
3046 CHECK_STRING (file1
);
3047 CHECK_STRING (file2
);
3050 GCPRO2 (absname1
, file2
);
3051 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3052 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3055 /* If the file name has special constructs in it,
3056 call the corresponding file handler. */
3057 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3059 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3060 if (!NILP (handler
))
3061 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3063 GCPRO2 (absname1
, absname2
);
3064 absname1
= ENCODE_FILE (absname1
);
3065 absname2
= ENCODE_FILE (absname2
);
3068 if (stat (SDATA (absname1
), &st
) < 0)
3071 mtime1
= st
.st_mtime
;
3073 if (stat (SDATA (absname2
), &st
) < 0)
3076 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3080 Lisp_Object Qfind_buffer_file_type
;
3083 #ifndef READ_BUF_SIZE
3084 #define READ_BUF_SIZE (64 << 10)
3087 /* This function is called after Lisp functions to decide a coding
3088 system are called, or when they cause an error. Before they are
3089 called, the current buffer is set unibyte and it contains only a
3090 newly inserted text (thus the buffer was empty before the
3093 The functions may set markers, overlays, text properties, or even
3094 alter the buffer contents, change the current buffer.
3096 Here, we reset all those changes by:
3097 o set back the current buffer.
3098 o move all markers and overlays to BEG.
3099 o remove all text properties.
3100 o set back the buffer multibyteness. */
3103 decide_coding_unwind (Lisp_Object unwind_data
)
3105 Lisp_Object multibyte
, undo_list
, buffer
;
3107 multibyte
= XCAR (unwind_data
);
3108 unwind_data
= XCDR (unwind_data
);
3109 undo_list
= XCAR (unwind_data
);
3110 buffer
= XCDR (unwind_data
);
3112 if (current_buffer
!= XBUFFER (buffer
))
3113 set_buffer_internal (XBUFFER (buffer
));
3114 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3115 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3116 BUF_INTERVALS (current_buffer
) = 0;
3117 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3119 /* Now we are safe to change the buffer's multibyteness directly. */
3120 current_buffer
->enable_multibyte_characters
= multibyte
;
3121 current_buffer
->undo_list
= undo_list
;
3127 /* Used to pass values from insert-file-contents to read_non_regular. */
3129 static int non_regular_fd
;
3130 static EMACS_INT non_regular_inserted
;
3131 static EMACS_INT non_regular_nbytes
;
3134 /* Read from a non-regular file.
3135 Read non_regular_nbytes bytes max from non_regular_fd.
3136 Non_regular_inserted specifies where to put the read bytes.
3137 Value is the number of bytes read. */
3140 read_non_regular (Lisp_Object ignore
)
3146 nbytes
= emacs_read (non_regular_fd
,
3147 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3148 non_regular_nbytes
);
3150 return make_number (nbytes
);
3154 /* Condition-case handler used when reading from non-regular files
3155 in insert-file-contents. */
3158 read_non_regular_quit (Lisp_Object ignore
)
3164 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3166 doc
: /* Insert contents of file FILENAME after point.
3167 Returns list of absolute file name and number of characters inserted.
3168 If second argument VISIT is non-nil, the buffer's visited filename and
3169 last save file modtime are set, and it is marked unmodified. If
3170 visiting and the file does not exist, visiting is completed before the
3173 The optional third and fourth arguments BEG and END specify what portion
3174 of the file to insert. These arguments count bytes in the file, not
3175 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3177 If optional fifth argument REPLACE is non-nil, replace the current
3178 buffer contents (in the accessible portion) with the file contents.
3179 This is better than simply deleting and inserting the whole thing
3180 because (1) it preserves some marker positions and (2) it puts less data
3181 in the undo list. When REPLACE is non-nil, the second return value is
3182 the number of characters that replace previous buffer contents.
3184 This function does code conversion according to the value of
3185 `coding-system-for-read' or `file-coding-system-alist', and sets the
3186 variable `last-coding-system-used' to the coding system actually used. */)
3187 (Lisp_Object filename
, Lisp_Object visit
, Lisp_Object beg
, Lisp_Object end
, Lisp_Object replace
)
3191 EMACS_INT inserted
= 0;
3193 register EMACS_INT how_much
;
3194 register EMACS_INT unprocessed
;
3195 int count
= SPECPDL_INDEX ();
3196 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3197 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3199 EMACS_INT total
= 0;
3200 int not_regular
= 0;
3201 unsigned char read_buf
[READ_BUF_SIZE
];
3202 struct coding_system coding
;
3203 unsigned char buffer
[1 << 14];
3204 int replace_handled
= 0;
3205 int set_coding_system
= 0;
3206 Lisp_Object coding_system
;
3208 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3209 int we_locked_file
= 0;
3210 int deferred_remove_unwind_protect
= 0;
3212 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3213 error ("Cannot do file visiting in an indirect buffer");
3215 if (!NILP (current_buffer
->read_only
))
3216 Fbarf_if_buffer_read_only ();
3220 orig_filename
= Qnil
;
3223 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3225 CHECK_STRING (filename
);
3226 filename
= Fexpand_file_name (filename
, Qnil
);
3228 /* The value Qnil means that the coding system is not yet
3230 coding_system
= Qnil
;
3232 /* If the file name has special constructs in it,
3233 call the corresponding file handler. */
3234 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3235 if (!NILP (handler
))
3237 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3238 visit
, beg
, end
, replace
);
3239 if (CONSP (val
) && CONSP (XCDR (val
)))
3240 inserted
= XINT (XCAR (XCDR (val
)));
3244 orig_filename
= filename
;
3245 filename
= ENCODE_FILE (filename
);
3251 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3253 /* Tell stat to use expensive method to get accurate info. */
3254 Vw32_get_true_file_attributes
= Qt
;
3255 total
= stat (SDATA (filename
), &st
);
3256 Vw32_get_true_file_attributes
= tem
;
3260 if (stat (SDATA (filename
), &st
) < 0)
3261 #endif /* WINDOWSNT */
3263 if (fd
>= 0) emacs_close (fd
);
3266 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3269 if (!NILP (Vcoding_system_for_read
))
3270 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3275 /* This code will need to be changed in order to work on named
3276 pipes, and it's probably just not worth it. So we should at
3277 least signal an error. */
3278 if (!S_ISREG (st
.st_mode
))
3285 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3286 xsignal2 (Qfile_error
,
3287 build_string ("not a regular file"), orig_filename
);
3292 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3295 /* Replacement should preserve point as it preserves markers. */
3296 if (!NILP (replace
))
3297 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3299 record_unwind_protect (close_file_unwind
, make_number (fd
));
3301 /* Can happen on any platform that uses long as type of off_t, but allows
3302 file sizes to exceed 2Gb, so give a suitable message. */
3303 if (! not_regular
&& st
.st_size
< 0)
3304 error ("Maximum buffer size exceeded");
3306 /* Prevent redisplay optimizations. */
3307 current_buffer
->clip_changed
= 1;
3311 if (!NILP (beg
) || !NILP (end
))
3312 error ("Attempt to visit less than an entire file");
3313 if (BEG
< Z
&& NILP (replace
))
3314 error ("Cannot do file visiting in a non-empty buffer");
3320 XSETFASTINT (beg
, 0);
3328 XSETINT (end
, st
.st_size
);
3330 /* Arithmetic overflow can occur if an Emacs integer cannot
3331 represent the file size, or if the calculations below
3332 overflow. The calculations below double the file size
3333 twice, so check that it can be multiplied by 4 safely. */
3334 if (XINT (end
) != st
.st_size
3335 /* Actually, it should test either INT_MAX or LONG_MAX
3336 depending on which one is used for EMACS_INT. But in
3337 any case, in practice, this test is redundant with the
3339 || st.st_size > INT_MAX / 4 */)
3340 error ("Maximum buffer size exceeded");
3342 /* The file size returned from stat may be zero, but data
3343 may be readable nonetheless, for example when this is a
3344 file in the /proc filesystem. */
3345 if (st
.st_size
== 0)
3346 XSETINT (end
, READ_BUF_SIZE
);
3350 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3352 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3353 setup_coding_system (coding_system
, &coding
);
3354 /* Ensure we set Vlast_coding_system_used. */
3355 set_coding_system
= 1;
3359 /* Decide the coding system to use for reading the file now
3360 because we can't use an optimized method for handling
3361 `coding:' tag if the current buffer is not empty. */
3362 if (!NILP (Vcoding_system_for_read
))
3363 coding_system
= Vcoding_system_for_read
;
3366 /* Don't try looking inside a file for a coding system
3367 specification if it is not seekable. */
3368 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3370 /* Find a coding system specified in the heading two
3371 lines or in the tailing several lines of the file.
3372 We assume that the 1K-byte and 3K-byte for heading
3373 and tailing respectively are sufficient for this
3377 if (st
.st_size
<= (1024 * 4))
3378 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3381 nread
= emacs_read (fd
, read_buf
, 1024);
3384 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3385 report_file_error ("Setting file position",
3386 Fcons (orig_filename
, Qnil
));
3387 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3392 error ("IO error reading %s: %s",
3393 SDATA (orig_filename
), emacs_strerror (errno
));
3396 struct buffer
*prev
= current_buffer
;
3400 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3402 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3403 buf
= XBUFFER (buffer
);
3405 delete_all_overlays (buf
);
3406 buf
->directory
= current_buffer
->directory
;
3407 buf
->read_only
= Qnil
;
3408 buf
->filename
= Qnil
;
3409 buf
->undo_list
= Qt
;
3410 eassert (buf
->overlays_before
== NULL
);
3411 eassert (buf
->overlays_after
== NULL
);
3413 set_buffer_internal (buf
);
3415 buf
->enable_multibyte_characters
= Qnil
;
3417 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3418 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3419 coding_system
= call2 (Vset_auto_coding_function
,
3420 filename
, make_number (nread
));
3421 set_buffer_internal (prev
);
3423 /* Discard the unwind protect for recovering the
3427 /* Rewind the file for the actual read done later. */
3428 if (lseek (fd
, 0, 0) < 0)
3429 report_file_error ("Setting file position",
3430 Fcons (orig_filename
, Qnil
));
3434 if (NILP (coding_system
))
3436 /* If we have not yet decided a coding system, check
3437 file-coding-system-alist. */
3438 Lisp_Object args
[6];
3440 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3441 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3442 coding_system
= Ffind_operation_coding_system (6, args
);
3443 if (CONSP (coding_system
))
3444 coding_system
= XCAR (coding_system
);
3448 if (NILP (coding_system
))
3449 coding_system
= Qundecided
;
3451 CHECK_CODING_SYSTEM (coding_system
);
3453 if (NILP (current_buffer
->enable_multibyte_characters
))
3454 /* We must suppress all character code conversion except for
3455 end-of-line conversion. */
3456 coding_system
= raw_text_coding_system (coding_system
);
3458 setup_coding_system (coding_system
, &coding
);
3459 /* Ensure we set Vlast_coding_system_used. */
3460 set_coding_system
= 1;
3463 /* If requested, replace the accessible part of the buffer
3464 with the file contents. Avoid replacing text at the
3465 beginning or end of the buffer that matches the file contents;
3466 that preserves markers pointing to the unchanged parts.
3468 Here we implement this feature in an optimized way
3469 for the case where code conversion is NOT needed.
3470 The following if-statement handles the case of conversion
3471 in a less optimal way.
3473 If the code conversion is "automatic" then we try using this
3474 method and hope for the best.
3475 But if we discover the need for conversion, we give up on this method
3476 and let the following if-statement handle the replace job. */
3479 && (NILP (coding_system
)
3480 || ! CODING_REQUIRE_DECODING (&coding
)))
3482 /* same_at_start and same_at_end count bytes,
3483 because file access counts bytes
3484 and BEG and END count bytes. */
3485 EMACS_INT same_at_start
= BEGV_BYTE
;
3486 EMACS_INT same_at_end
= ZV_BYTE
;
3488 /* There is still a possibility we will find the need to do code
3489 conversion. If that happens, we set this variable to 1 to
3490 give up on handling REPLACE in the optimized way. */
3491 int giveup_match_end
= 0;
3493 if (XINT (beg
) != 0)
3495 if (lseek (fd
, XINT (beg
), 0) < 0)
3496 report_file_error ("Setting file position",
3497 Fcons (orig_filename
, Qnil
));
3502 /* Count how many chars at the start of the file
3503 match the text at the beginning of the buffer. */
3506 EMACS_INT nread
, bufpos
;
3508 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3510 error ("IO error reading %s: %s",
3511 SDATA (orig_filename
), emacs_strerror (errno
));
3512 else if (nread
== 0)
3515 if (CODING_REQUIRE_DETECTION (&coding
))
3517 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
3519 setup_coding_system (coding_system
, &coding
);
3522 if (CODING_REQUIRE_DECODING (&coding
))
3523 /* We found that the file should be decoded somehow.
3524 Let's give up here. */
3526 giveup_match_end
= 1;
3531 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3532 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3533 same_at_start
++, bufpos
++;
3534 /* If we found a discrepancy, stop the scan.
3535 Otherwise loop around and scan the next bufferful. */
3536 if (bufpos
!= nread
)
3540 /* If the file matches the buffer completely,
3541 there's no need to replace anything. */
3542 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3546 /* Truncate the buffer to the size of the file. */
3547 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3552 /* Count how many chars at the end of the file
3553 match the text at the end of the buffer. But, if we have
3554 already found that decoding is necessary, don't waste time. */
3555 while (!giveup_match_end
)
3557 EMACS_INT total_read
, nread
, bufpos
, curpos
, trial
;
3559 /* At what file position are we now scanning? */
3560 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3561 /* If the entire file matches the buffer tail, stop the scan. */
3564 /* How much can we scan in the next step? */
3565 trial
= min (curpos
, sizeof buffer
);
3566 if (lseek (fd
, curpos
- trial
, 0) < 0)
3567 report_file_error ("Setting file position",
3568 Fcons (orig_filename
, Qnil
));
3570 total_read
= nread
= 0;
3571 while (total_read
< trial
)
3573 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3575 error ("IO error reading %s: %s",
3576 SDATA (orig_filename
), emacs_strerror (errno
));
3577 else if (nread
== 0)
3579 total_read
+= nread
;
3582 /* Scan this bufferful from the end, comparing with
3583 the Emacs buffer. */
3584 bufpos
= total_read
;
3586 /* Compare with same_at_start to avoid counting some buffer text
3587 as matching both at the file's beginning and at the end. */
3588 while (bufpos
> 0 && same_at_end
> same_at_start
3589 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3590 same_at_end
--, bufpos
--;
3592 /* If we found a discrepancy, stop the scan.
3593 Otherwise loop around and scan the preceding bufferful. */
3596 /* If this discrepancy is because of code conversion,
3597 we cannot use this method; giveup and try the other. */
3598 if (same_at_end
> same_at_start
3599 && FETCH_BYTE (same_at_end
- 1) >= 0200
3600 && ! NILP (current_buffer
->enable_multibyte_characters
)
3601 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3602 giveup_match_end
= 1;
3611 if (! giveup_match_end
)
3615 /* We win! We can handle REPLACE the optimized way. */
3617 /* Extend the start of non-matching text area to multibyte
3618 character boundary. */
3619 if (! NILP (current_buffer
->enable_multibyte_characters
))
3620 while (same_at_start
> BEGV_BYTE
3621 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3624 /* Extend the end of non-matching text area to multibyte
3625 character boundary. */
3626 if (! NILP (current_buffer
->enable_multibyte_characters
))
3627 while (same_at_end
< ZV_BYTE
3628 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3631 /* Don't try to reuse the same piece of text twice. */
3632 overlap
= (same_at_start
- BEGV_BYTE
3633 - (same_at_end
+ st
.st_size
- ZV
));
3635 same_at_end
+= overlap
;
3637 /* Arrange to read only the nonmatching middle part of the file. */
3638 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3639 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3641 del_range_byte (same_at_start
, same_at_end
, 0);
3642 /* Insert from the file at the proper position. */
3643 temp
= BYTE_TO_CHAR (same_at_start
);
3644 SET_PT_BOTH (temp
, same_at_start
);
3646 /* If display currently starts at beginning of line,
3647 keep it that way. */
3648 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3649 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3651 replace_handled
= 1;
3655 /* If requested, replace the accessible part of the buffer
3656 with the file contents. Avoid replacing text at the
3657 beginning or end of the buffer that matches the file contents;
3658 that preserves markers pointing to the unchanged parts.
3660 Here we implement this feature for the case where code conversion
3661 is needed, in a simple way that needs a lot of memory.
3662 The preceding if-statement handles the case of no conversion
3663 in a more optimized way. */
3664 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3666 EMACS_INT same_at_start
= BEGV_BYTE
;
3667 EMACS_INT same_at_end
= ZV_BYTE
;
3668 EMACS_INT same_at_start_charpos
;
3669 EMACS_INT inserted_chars
;
3672 unsigned char *decoded
;
3674 int this_count
= SPECPDL_INDEX ();
3675 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3676 Lisp_Object conversion_buffer
;
3678 conversion_buffer
= code_conversion_save (1, multibyte
);
3680 /* First read the whole file, performing code conversion into
3681 CONVERSION_BUFFER. */
3683 if (lseek (fd
, XINT (beg
), 0) < 0)
3684 report_file_error ("Setting file position",
3685 Fcons (orig_filename
, Qnil
));
3687 total
= st
.st_size
; /* Total bytes in the file. */
3688 how_much
= 0; /* Bytes read from file so far. */
3689 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3690 unprocessed
= 0; /* Bytes not processed in previous loop. */
3692 GCPRO1 (conversion_buffer
);
3693 while (how_much
< total
)
3695 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
3696 quitting while reading a huge while. */
3697 /* try is reserved in some compilers (Microsoft C) */
3698 EMACS_INT trytry
= min (total
- how_much
,
3699 READ_BUF_SIZE
- unprocessed
);
3702 /* Allow quitting out of the actual I/O. */
3705 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
3717 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
3718 BUF_Z (XBUFFER (conversion_buffer
)));
3719 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
3721 unprocessed
= coding
.carryover_bytes
;
3722 if (coding
.carryover_bytes
> 0)
3723 memcpy (read_buf
, coding
.carryover
, unprocessed
);
3728 /* We should remove the unwind_protect calling
3729 close_file_unwind, but other stuff has been added the stack,
3730 so defer the removal till we reach the `handled' label. */
3731 deferred_remove_unwind_protect
= 1;
3733 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
3734 if we couldn't read the file. */
3737 error ("IO error reading %s: %s",
3738 SDATA (orig_filename
), emacs_strerror (errno
));
3740 if (unprocessed
> 0)
3742 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3743 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
3745 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
3748 coding_system
= CODING_ID_NAME (coding
.id
);
3749 set_coding_system
= 1;
3750 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
3751 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
3752 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3754 /* Compare the beginning of the converted string with the buffer
3758 while (bufpos
< inserted
&& same_at_start
< same_at_end
3759 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
3760 same_at_start
++, bufpos
++;
3762 /* If the file matches the head of buffer completely,
3763 there's no need to replace anything. */
3765 if (bufpos
== inserted
)
3767 /* Truncate the buffer to the size of the file. */
3768 if (same_at_start
== same_at_end
)
3771 del_range_byte (same_at_start
, same_at_end
, 0);
3774 unbind_to (this_count
, Qnil
);
3778 /* Extend the start of non-matching text area to the previous
3779 multibyte character boundary. */
3780 if (! NILP (current_buffer
->enable_multibyte_characters
))
3781 while (same_at_start
> BEGV_BYTE
3782 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3785 /* Scan this bufferful from the end, comparing with
3786 the Emacs buffer. */
3789 /* Compare with same_at_start to avoid counting some buffer text
3790 as matching both at the file's beginning and at the end. */
3791 while (bufpos
> 0 && same_at_end
> same_at_start
3792 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
3793 same_at_end
--, bufpos
--;
3795 /* Extend the end of non-matching text area to the next
3796 multibyte character boundary. */
3797 if (! NILP (current_buffer
->enable_multibyte_characters
))
3798 while (same_at_end
< ZV_BYTE
3799 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3802 /* Don't try to reuse the same piece of text twice. */
3803 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3805 same_at_end
+= overlap
;
3807 /* If display currently starts at beginning of line,
3808 keep it that way. */
3809 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3810 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3812 /* Replace the chars that we need to replace,
3813 and update INSERTED to equal the number of bytes
3814 we are taking from the decoded string. */
3815 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
3817 if (same_at_end
!= same_at_start
)
3819 del_range_byte (same_at_start
, same_at_end
, 0);
3821 same_at_start
= GPT_BYTE
;
3825 temp
= BYTE_TO_CHAR (same_at_start
);
3827 /* Insert from the file at the proper position. */
3828 SET_PT_BOTH (temp
, same_at_start
);
3829 same_at_start_charpos
3830 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3831 same_at_start
- BEGV_BYTE
3832 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3834 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3835 same_at_start
+ inserted
- BEGV_BYTE
3836 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
3837 - same_at_start_charpos
);
3838 /* This binding is to avoid ask-user-about-supersession-threat
3839 being called in insert_from_buffer (via in
3840 prepare_to_modify_buffer). */
3841 specbind (intern ("buffer-file-name"), Qnil
);
3842 insert_from_buffer (XBUFFER (conversion_buffer
),
3843 same_at_start_charpos
, inserted_chars
, 0);
3844 /* Set `inserted' to the number of inserted characters. */
3845 inserted
= PT
- temp
;
3846 /* Set point before the inserted characters. */
3847 SET_PT_BOTH (temp
, same_at_start
);
3849 unbind_to (this_count
, Qnil
);
3856 register Lisp_Object temp
;
3858 total
= XINT (end
) - XINT (beg
);
3860 /* Make sure point-max won't overflow after this insertion. */
3861 XSETINT (temp
, total
);
3862 if (total
!= XINT (temp
))
3863 error ("Maximum buffer size exceeded");
3866 /* For a special file, all we can do is guess. */
3867 total
= READ_BUF_SIZE
;
3869 if (NILP (visit
) && inserted
> 0)
3871 #ifdef CLASH_DETECTION
3872 if (!NILP (current_buffer
->file_truename
)
3873 /* Make binding buffer-file-name to nil effective. */
3874 && !NILP (current_buffer
->filename
)
3875 && SAVE_MODIFF
>= MODIFF
)
3877 #endif /* CLASH_DETECTION */
3878 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
3882 if (GAP_SIZE
< total
)
3883 make_gap (total
- GAP_SIZE
);
3885 if (XINT (beg
) != 0 || !NILP (replace
))
3887 if (lseek (fd
, XINT (beg
), 0) < 0)
3888 report_file_error ("Setting file position",
3889 Fcons (orig_filename
, Qnil
));
3892 /* In the following loop, HOW_MUCH contains the total bytes read so
3893 far for a regular file, and not changed for a special file. But,
3894 before exiting the loop, it is set to a negative value if I/O
3898 /* Total bytes inserted. */
3901 /* Here, we don't do code conversion in the loop. It is done by
3902 decode_coding_gap after all data are read into the buffer. */
3904 EMACS_INT gap_size
= GAP_SIZE
;
3906 while (how_much
< total
)
3908 /* try is reserved in some compilers (Microsoft C) */
3909 EMACS_INT trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3916 /* Maybe make more room. */
3917 if (gap_size
< trytry
)
3919 make_gap (total
- gap_size
);
3920 gap_size
= GAP_SIZE
;
3923 /* Read from the file, capturing `quit'. When an
3924 error occurs, end the loop, and arrange for a quit
3925 to be signaled after decoding the text we read. */
3926 non_regular_fd
= fd
;
3927 non_regular_inserted
= inserted
;
3928 non_regular_nbytes
= trytry
;
3929 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
3930 read_non_regular_quit
);
3941 /* Allow quitting out of the actual I/O. We don't make text
3942 part of the buffer until all the reading is done, so a C-g
3943 here doesn't do any harm. */
3946 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
3958 /* For a regular file, where TOTAL is the real size,
3959 count HOW_MUCH to compare with it.
3960 For a special file, where TOTAL is just a buffer size,
3961 so don't bother counting in HOW_MUCH.
3962 (INSERTED is where we count the number of characters inserted.) */
3969 /* Now we have read all the file data into the gap.
3970 If it was empty, undo marking the buffer modified. */
3974 #ifdef CLASH_DETECTION
3976 unlock_file (current_buffer
->file_truename
);
3978 Vdeactivate_mark
= old_Vdeactivate_mark
;
3981 Vdeactivate_mark
= Qt
;
3983 /* Make the text read part of the buffer. */
3984 GAP_SIZE
-= inserted
;
3986 GPT_BYTE
+= inserted
;
3988 ZV_BYTE
+= inserted
;
3993 /* Put an anchor to ensure multi-byte form ends at gap. */
3998 /* Discard the unwind protect for closing the file. */
4002 error ("IO error reading %s: %s",
4003 SDATA (orig_filename
), emacs_strerror (errno
));
4007 if (NILP (coding_system
))
4009 /* The coding system is not yet decided. Decide it by an
4010 optimized method for handling `coding:' tag.
4012 Note that we can get here only if the buffer was empty
4013 before the insertion. */
4015 if (!NILP (Vcoding_system_for_read
))
4016 coding_system
= Vcoding_system_for_read
;
4019 /* Since we are sure that the current buffer was empty
4020 before the insertion, we can toggle
4021 enable-multibyte-characters directly here without taking
4022 care of marker adjustment. By this way, we can run Lisp
4023 program safely before decoding the inserted text. */
4024 Lisp_Object unwind_data
;
4025 int count
= SPECPDL_INDEX ();
4027 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4028 Fcons (current_buffer
->undo_list
,
4029 Fcurrent_buffer ()));
4030 current_buffer
->enable_multibyte_characters
= Qnil
;
4031 current_buffer
->undo_list
= Qt
;
4032 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4034 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4036 coding_system
= call2 (Vset_auto_coding_function
,
4037 filename
, make_number (inserted
));
4040 if (NILP (coding_system
))
4042 /* If the coding system is not yet decided, check
4043 file-coding-system-alist. */
4044 Lisp_Object args
[6];
4046 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4047 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4048 coding_system
= Ffind_operation_coding_system (6, args
);
4049 if (CONSP (coding_system
))
4050 coding_system
= XCAR (coding_system
);
4052 unbind_to (count
, Qnil
);
4053 inserted
= Z_BYTE
- BEG_BYTE
;
4056 if (NILP (coding_system
))
4057 coding_system
= Qundecided
;
4059 CHECK_CODING_SYSTEM (coding_system
);
4061 if (NILP (current_buffer
->enable_multibyte_characters
))
4062 /* We must suppress all character code conversion except for
4063 end-of-line conversion. */
4064 coding_system
= raw_text_coding_system (coding_system
);
4065 setup_coding_system (coding_system
, &coding
);
4066 /* Ensure we set Vlast_coding_system_used. */
4067 set_coding_system
= 1;
4072 /* When we visit a file by raw-text, we change the buffer to
4074 if (CODING_FOR_UNIBYTE (&coding
)
4075 /* Can't do this if part of the buffer might be preserved. */
4077 /* Visiting a file with these coding system makes the buffer
4079 current_buffer
->enable_multibyte_characters
= Qnil
;
4082 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4083 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4084 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4086 move_gap_both (PT
, PT_BYTE
);
4087 GAP_SIZE
+= inserted
;
4088 ZV_BYTE
-= inserted
;
4092 decode_coding_gap (&coding
, inserted
, inserted
);
4093 inserted
= coding
.produced_char
;
4094 coding_system
= CODING_ID_NAME (coding
.id
);
4096 else if (inserted
> 0)
4097 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4100 /* Now INSERTED is measured in characters. */
4103 /* Use the conversion type to determine buffer-file-type
4104 (find-buffer-file-type is now used to help determine the
4106 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4107 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4108 && ! CODING_REQUIRE_DECODING (&coding
))
4109 current_buffer
->buffer_file_type
= Qt
;
4111 current_buffer
->buffer_file_type
= Qnil
;
4116 if (deferred_remove_unwind_protect
)
4117 /* If requested above, discard the unwind protect for closing the
4123 if (!EQ (current_buffer
->undo_list
, Qt
) && !nochange
)
4124 current_buffer
->undo_list
= Qnil
;
4128 current_buffer
->modtime
= st
.st_mtime
;
4129 current_buffer
->modtime_size
= st
.st_size
;
4130 current_buffer
->filename
= orig_filename
;
4133 SAVE_MODIFF
= MODIFF
;
4134 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
4135 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4136 #ifdef CLASH_DETECTION
4139 if (!NILP (current_buffer
->file_truename
))
4140 unlock_file (current_buffer
->file_truename
);
4141 unlock_file (filename
);
4143 #endif /* CLASH_DETECTION */
4145 xsignal2 (Qfile_error
,
4146 build_string ("not a regular file"), orig_filename
);
4149 if (set_coding_system
)
4150 Vlast_coding_system_used
= coding_system
;
4152 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4154 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4156 if (! NILP (insval
))
4158 CHECK_NUMBER (insval
);
4159 inserted
= XFASTINT (insval
);
4163 /* Decode file format. */
4166 /* Don't run point motion or modification hooks when decoding. */
4167 int count
= SPECPDL_INDEX ();
4168 EMACS_INT old_inserted
= inserted
;
4169 specbind (Qinhibit_point_motion_hooks
, Qt
);
4170 specbind (Qinhibit_modification_hooks
, Qt
);
4172 /* Save old undo list and don't record undo for decoding. */
4173 old_undo
= current_buffer
->undo_list
;
4174 current_buffer
->undo_list
= Qt
;
4178 insval
= call3 (Qformat_decode
,
4179 Qnil
, make_number (inserted
), visit
);
4180 CHECK_NUMBER (insval
);
4181 inserted
= XFASTINT (insval
);
4185 /* If REPLACE is non-nil and we succeeded in not replacing the
4186 beginning or end of the buffer text with the file's contents,
4187 call format-decode with `point' positioned at the beginning
4188 of the buffer and `inserted' equalling the number of
4189 characters in the buffer. Otherwise, format-decode might
4190 fail to correctly analyze the beginning or end of the buffer.
4191 Hence we temporarily save `point' and `inserted' here and
4192 restore `point' iff format-decode did not insert or delete
4193 any text. Otherwise we leave `point' at point-min. */
4194 EMACS_INT opoint
= PT
;
4195 EMACS_INT opoint_byte
= PT_BYTE
;
4196 EMACS_INT oinserted
= ZV
- BEGV
;
4197 int ochars_modiff
= CHARS_MODIFF
;
4199 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4200 insval
= call3 (Qformat_decode
,
4201 Qnil
, make_number (oinserted
), visit
);
4202 CHECK_NUMBER (insval
);
4203 if (ochars_modiff
== CHARS_MODIFF
)
4204 /* format_decode didn't modify buffer's characters => move
4205 point back to position before inserted text and leave
4206 value of inserted alone. */
4207 SET_PT_BOTH (opoint
, opoint_byte
);
4209 /* format_decode modified buffer's characters => consider
4210 entire buffer changed and leave point at point-min. */
4211 inserted
= XFASTINT (insval
);
4214 /* For consistency with format-decode call these now iff inserted > 0
4215 (martin 2007-06-28). */
4216 p
= Vafter_insert_file_functions
;
4221 insval
= call1 (XCAR (p
), make_number (inserted
));
4224 CHECK_NUMBER (insval
);
4225 inserted
= XFASTINT (insval
);
4230 /* For the rationale of this see the comment on
4231 format-decode above. */
4232 EMACS_INT opoint
= PT
;
4233 EMACS_INT opoint_byte
= PT_BYTE
;
4234 EMACS_INT oinserted
= ZV
- BEGV
;
4235 int ochars_modiff
= CHARS_MODIFF
;
4237 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4238 insval
= call1 (XCAR (p
), make_number (oinserted
));
4241 CHECK_NUMBER (insval
);
4242 if (ochars_modiff
== CHARS_MODIFF
)
4243 /* after_insert_file_functions didn't modify
4244 buffer's characters => move point back to
4245 position before inserted text and leave value of
4247 SET_PT_BOTH (opoint
, opoint_byte
);
4249 /* after_insert_file_functions did modify buffer's
4250 characters => consider entire buffer changed and
4251 leave point at point-min. */
4252 inserted
= XFASTINT (insval
);
4262 current_buffer
->undo_list
= old_undo
;
4263 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4265 /* Adjust the last undo record for the size change during
4266 the format conversion. */
4267 Lisp_Object tem
= XCAR (old_undo
);
4268 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4269 && INTEGERP (XCDR (tem
))
4270 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4271 XSETCDR (tem
, make_number (PT
+ inserted
));
4275 /* If undo_list was Qt before, keep it that way.
4276 Otherwise start with an empty undo_list. */
4277 current_buffer
->undo_list
= EQ (old_undo
, Qt
) ? Qt
: Qnil
;
4279 unbind_to (count
, Qnil
);
4282 /* Call after-change hooks for the inserted text, aside from the case
4283 of normal visiting (not with REPLACE), which is done in a new buffer
4284 "before" the buffer is changed. */
4285 if (inserted
> 0 && total
> 0
4286 && (NILP (visit
) || !NILP (replace
)))
4288 signal_after_change (PT
, 0, inserted
);
4289 update_compositions (PT
, PT
, CHECK_BORDER
);
4293 && current_buffer
->modtime
== -1)
4295 /* If visiting nonexistent file, return nil. */
4296 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4300 Fsignal (Qquit
, Qnil
);
4302 /* ??? Retval needs to be dealt with in all cases consistently. */
4304 val
= Fcons (orig_filename
,
4305 Fcons (make_number (inserted
),
4308 RETURN_UNGCPRO (unbind_to (count
, val
));
4311 static Lisp_Object
build_annotations (Lisp_Object
, Lisp_Object
);
4314 build_annotations_unwind (Lisp_Object arg
)
4316 Vwrite_region_annotation_buffers
= arg
;
4320 /* Decide the coding-system to encode the data with. */
4323 choose_write_coding_system (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4324 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
,
4325 struct coding_system
*coding
)
4328 Lisp_Object eol_parent
= Qnil
;
4331 && NILP (Fstring_equal (current_buffer
->filename
,
4332 current_buffer
->auto_save_file_name
)))
4337 else if (!NILP (Vcoding_system_for_write
))
4339 val
= Vcoding_system_for_write
;
4340 if (coding_system_require_warning
4341 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4342 /* Confirm that VAL can surely encode the current region. */
4343 val
= call5 (Vselect_safe_coding_system_function
,
4344 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4349 /* If the variable `buffer-file-coding-system' is set locally,
4350 it means that the file was read with some kind of code
4351 conversion or the variable is explicitly set by users. We
4352 had better write it out with the same coding system even if
4353 `enable-multibyte-characters' is nil.
4355 If it is not set locally, we anyway have to convert EOL
4356 format if the default value of `buffer-file-coding-system'
4357 tells that it is not Unix-like (LF only) format. */
4358 int using_default_coding
= 0;
4359 int force_raw_text
= 0;
4361 val
= current_buffer
->buffer_file_coding_system
;
4363 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4366 if (NILP (current_buffer
->enable_multibyte_characters
))
4372 /* Check file-coding-system-alist. */
4373 Lisp_Object args
[7], coding_systems
;
4375 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4376 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4378 coding_systems
= Ffind_operation_coding_system (7, args
);
4379 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4380 val
= XCDR (coding_systems
);
4385 /* If we still have not decided a coding system, use the
4386 default value of buffer-file-coding-system. */
4387 val
= current_buffer
->buffer_file_coding_system
;
4388 using_default_coding
= 1;
4391 if (! NILP (val
) && ! force_raw_text
)
4393 Lisp_Object spec
, attrs
;
4395 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4396 attrs
= AREF (spec
, 0);
4397 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4402 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4403 /* Confirm that VAL can surely encode the current region. */
4404 val
= call5 (Vselect_safe_coding_system_function
,
4405 start
, end
, val
, Qnil
, filename
);
4407 /* If the decided coding-system doesn't specify end-of-line
4408 format, we use that of
4409 `default-buffer-file-coding-system'. */
4410 if (! using_default_coding
4411 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4412 val
= (coding_inherit_eol_type
4413 (val
, buffer_defaults
.buffer_file_coding_system
));
4415 /* If we decide not to encode text, use `raw-text' or one of its
4418 val
= raw_text_coding_system (val
);
4421 val
= coding_inherit_eol_type (val
, eol_parent
);
4422 setup_coding_system (val
, coding
);
4424 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4425 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4429 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4430 "r\nFWrite region to file: \ni\ni\ni\np",
4431 doc
: /* Write current region into specified file.
4432 When called from a program, requires three arguments:
4433 START, END and FILENAME. START and END are normally buffer positions
4434 specifying the part of the buffer to write.
4435 If START is nil, that means to use the entire buffer contents.
4436 If START is a string, then output that string to the file
4437 instead of any buffer contents; END is ignored.
4439 Optional fourth argument APPEND if non-nil means
4440 append to existing file contents (if any). If it is an integer,
4441 seek to that offset in the file before writing.
4442 Optional fifth argument VISIT, if t or a string, means
4443 set the last-save-file-modtime of buffer to this file's modtime
4444 and mark buffer not modified.
4445 If VISIT is a string, it is a second file name;
4446 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4447 VISIT is also the file name to lock and unlock for clash detection.
4448 If VISIT is neither t nor nil nor a string,
4449 that means do not display the \"Wrote file\" message.
4450 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4451 use for locking and unlocking, overriding FILENAME and VISIT.
4452 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4453 for an existing file with the same name. If MUSTBENEW is `excl',
4454 that means to get an error if the file already exists; never overwrite.
4455 If MUSTBENEW is neither nil nor `excl', that means ask for
4456 confirmation before overwriting, but do go ahead and overwrite the file
4457 if the user confirms.
4459 This does code conversion according to the value of
4460 `coding-system-for-write', `buffer-file-coding-system', or
4461 `file-coding-system-alist', and sets the variable
4462 `last-coding-system-used' to the coding system actually used.
4464 This calls `write-region-annotate-functions' at the start, and
4465 `write-region-post-annotation-function' at the end. */)
4466 (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
, Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
, Lisp_Object mustbenew
)
4471 const unsigned char *fn
;
4473 int count
= SPECPDL_INDEX ();
4475 Lisp_Object handler
;
4476 Lisp_Object visit_file
;
4477 Lisp_Object annotations
;
4478 Lisp_Object encoded_filename
;
4479 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4480 int quietly
= !NILP (visit
);
4481 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4482 struct buffer
*given_buffer
;
4484 int buffer_file_type
= O_BINARY
;
4486 struct coding_system coding
;
4488 if (current_buffer
->base_buffer
&& visiting
)
4489 error ("Cannot do file visiting in an indirect buffer");
4491 if (!NILP (start
) && !STRINGP (start
))
4492 validate_region (&start
, &end
);
4495 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4497 filename
= Fexpand_file_name (filename
, Qnil
);
4499 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4500 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4502 if (STRINGP (visit
))
4503 visit_file
= Fexpand_file_name (visit
, Qnil
);
4505 visit_file
= filename
;
4507 if (NILP (lockname
))
4508 lockname
= visit_file
;
4512 /* If the file name has special constructs in it,
4513 call the corresponding file handler. */
4514 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4515 /* If FILENAME has no handler, see if VISIT has one. */
4516 if (NILP (handler
) && STRINGP (visit
))
4517 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4519 if (!NILP (handler
))
4522 val
= call6 (handler
, Qwrite_region
, start
, end
,
4523 filename
, append
, visit
);
4527 SAVE_MODIFF
= MODIFF
;
4528 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4529 current_buffer
->filename
= visit_file
;
4535 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4537 /* Special kludge to simplify auto-saving. */
4540 /* Do it later, so write-region-annotate-function can work differently
4541 if we save "the buffer" vs "a region".
4542 This is useful in tar-mode. --Stef
4543 XSETFASTINT (start, BEG);
4544 XSETFASTINT (end, Z); */
4548 record_unwind_protect (build_annotations_unwind
,
4549 Vwrite_region_annotation_buffers
);
4550 Vwrite_region_annotation_buffers
= Fcons (Fcurrent_buffer (), Qnil
);
4551 count1
= SPECPDL_INDEX ();
4553 given_buffer
= current_buffer
;
4555 if (!STRINGP (start
))
4557 annotations
= build_annotations (start
, end
);
4559 if (current_buffer
!= given_buffer
)
4561 XSETFASTINT (start
, BEGV
);
4562 XSETFASTINT (end
, ZV
);
4568 XSETFASTINT (start
, BEGV
);
4569 XSETFASTINT (end
, ZV
);
4574 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4576 /* Decide the coding-system to encode the data with.
4577 We used to make this choice before calling build_annotations, but that
4578 leads to problems when a write-annotate-function takes care of
4579 unsavable chars (as was the case with X-Symbol). */
4580 Vlast_coding_system_used
4581 = choose_write_coding_system (start
, end
, filename
,
4582 append
, visit
, lockname
, &coding
);
4584 #ifdef CLASH_DETECTION
4586 lock_file (lockname
);
4587 #endif /* CLASH_DETECTION */
4589 encoded_filename
= ENCODE_FILE (filename
);
4591 fn
= SDATA (encoded_filename
);
4595 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4596 #else /* not DOS_NT */
4597 desc
= emacs_open (fn
, O_WRONLY
, 0);
4598 #endif /* not DOS_NT */
4600 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4602 desc
= emacs_open (fn
,
4603 O_WRONLY
| O_CREAT
| buffer_file_type
4604 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4605 S_IREAD
| S_IWRITE
);
4606 #else /* not DOS_NT */
4607 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4608 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4609 auto_saving
? auto_save_mode_bits
: 0666);
4610 #endif /* not DOS_NT */
4614 #ifdef CLASH_DETECTION
4616 if (!auto_saving
) unlock_file (lockname
);
4618 #endif /* CLASH_DETECTION */
4620 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4623 record_unwind_protect (close_file_unwind
, make_number (desc
));
4625 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4629 if (NUMBERP (append
))
4630 ret
= lseek (desc
, XINT (append
), 1);
4632 ret
= lseek (desc
, 0, 2);
4635 #ifdef CLASH_DETECTION
4636 if (!auto_saving
) unlock_file (lockname
);
4637 #endif /* CLASH_DETECTION */
4639 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4648 if (STRINGP (start
))
4650 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
4651 &annotations
, &coding
);
4654 else if (XINT (start
) != XINT (end
))
4656 failure
= 0 > a_write (desc
, Qnil
,
4657 XINT (start
), XINT (end
) - XINT (start
),
4658 &annotations
, &coding
);
4663 /* If file was empty, still need to write the annotations */
4664 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4665 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4669 if (CODING_REQUIRE_FLUSHING (&coding
)
4670 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4673 /* We have to flush out a data. */
4674 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4675 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
4682 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4683 Disk full in NFS may be reported here. */
4684 /* mib says that closing the file will try to write as fast as NFS can do
4685 it, and that means the fsync here is not crucial for autosave files. */
4686 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
4688 /* If fsync fails with EINTR, don't treat that as serious. Also
4689 ignore EINVAL which happens when fsync is not supported on this
4691 if (errno
!= EINTR
&& errno
!= EINVAL
)
4692 failure
= 1, save_errno
= errno
;
4696 /* NFS can report a write failure now. */
4697 if (emacs_close (desc
) < 0)
4698 failure
= 1, save_errno
= errno
;
4702 /* Discard the unwind protect for close_file_unwind. */
4703 specpdl_ptr
= specpdl
+ count1
;
4705 /* Call write-region-post-annotation-function. */
4706 while (CONSP (Vwrite_region_annotation_buffers
))
4708 Lisp_Object buf
= XCAR (Vwrite_region_annotation_buffers
);
4709 if (!NILP (Fbuffer_live_p (buf
)))
4712 if (FUNCTIONP (Vwrite_region_post_annotation_function
))
4713 call0 (Vwrite_region_post_annotation_function
);
4715 Vwrite_region_annotation_buffers
4716 = XCDR (Vwrite_region_annotation_buffers
);
4719 unbind_to (count
, Qnil
);
4721 #ifdef CLASH_DETECTION
4723 unlock_file (lockname
);
4724 #endif /* CLASH_DETECTION */
4726 /* Do this before reporting IO error
4727 to avoid a "file has changed on disk" warning on
4728 next attempt to save. */
4731 current_buffer
->modtime
= st
.st_mtime
;
4732 current_buffer
->modtime_size
= st
.st_size
;
4736 error ("IO error writing %s: %s", SDATA (filename
),
4737 emacs_strerror (save_errno
));
4741 SAVE_MODIFF
= MODIFF
;
4742 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4743 current_buffer
->filename
= visit_file
;
4744 update_mode_lines
++;
4749 && ! NILP (Fstring_equal (current_buffer
->filename
,
4750 current_buffer
->auto_save_file_name
)))
4751 SAVE_MODIFF
= MODIFF
;
4757 message_with_string ((INTEGERP (append
)
4767 Lisp_Object
merge (Lisp_Object
, Lisp_Object
, Lisp_Object
);
4769 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4770 doc
: /* Return t if (car A) is numerically less than (car B). */)
4771 (Lisp_Object a
, Lisp_Object b
)
4773 return Flss (Fcar (a
), Fcar (b
));
4776 /* Build the complete list of annotations appropriate for writing out
4777 the text between START and END, by calling all the functions in
4778 write-region-annotate-functions and merging the lists they return.
4779 If one of these functions switches to a different buffer, we assume
4780 that buffer contains altered text. Therefore, the caller must
4781 make sure to restore the current buffer in all cases,
4782 as save-excursion would do. */
4785 build_annotations (Lisp_Object start
, Lisp_Object end
)
4787 Lisp_Object annotations
;
4789 struct gcpro gcpro1
, gcpro2
;
4790 Lisp_Object original_buffer
;
4791 int i
, used_global
= 0;
4793 XSETBUFFER (original_buffer
, current_buffer
);
4796 p
= Vwrite_region_annotate_functions
;
4797 GCPRO2 (annotations
, p
);
4800 struct buffer
*given_buffer
= current_buffer
;
4801 if (EQ (Qt
, XCAR (p
)) && !used_global
)
4802 { /* Use the global value of the hook. */
4805 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
4807 p
= Fappend (2, arg
);
4810 Vwrite_region_annotations_so_far
= annotations
;
4811 res
= call2 (XCAR (p
), start
, end
);
4812 /* If the function makes a different buffer current,
4813 assume that means this buffer contains altered text to be output.
4814 Reset START and END from the buffer bounds
4815 and discard all previous annotations because they should have
4816 been dealt with by this function. */
4817 if (current_buffer
!= given_buffer
)
4819 Vwrite_region_annotation_buffers
4820 = Fcons (Fcurrent_buffer (),
4821 Vwrite_region_annotation_buffers
);
4822 XSETFASTINT (start
, BEGV
);
4823 XSETFASTINT (end
, ZV
);
4826 Flength (res
); /* Check basic validity of return value */
4827 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4831 /* Now do the same for annotation functions implied by the file-format */
4832 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
4833 p
= current_buffer
->auto_save_file_format
;
4835 p
= current_buffer
->file_format
;
4836 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
4838 struct buffer
*given_buffer
= current_buffer
;
4840 Vwrite_region_annotations_so_far
= annotations
;
4842 /* Value is either a list of annotations or nil if the function
4843 has written annotations to a temporary buffer, which is now
4845 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
4846 original_buffer
, make_number (i
));
4847 if (current_buffer
!= given_buffer
)
4849 XSETFASTINT (start
, BEGV
);
4850 XSETFASTINT (end
, ZV
);
4855 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4863 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
4864 If STRING is nil, POS is the character position in the current buffer.
4865 Intersperse with them the annotations from *ANNOT
4866 which fall within the range of POS to POS + NCHARS,
4867 each at its appropriate position.
4869 We modify *ANNOT by discarding elements as we use them up.
4871 The return value is negative in case of system call failure. */
4874 a_write (int desc
, Lisp_Object string
, int pos
, register int nchars
, Lisp_Object
*annot
, struct coding_system
*coding
)
4878 int lastpos
= pos
+ nchars
;
4880 while (NILP (*annot
) || CONSP (*annot
))
4882 tem
= Fcar_safe (Fcar (*annot
));
4885 nextpos
= XFASTINT (tem
);
4887 /* If there are no more annotations in this range,
4888 output the rest of the range all at once. */
4889 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
4890 return e_write (desc
, string
, pos
, lastpos
, coding
);
4892 /* Output buffer text up to the next annotation's position. */
4895 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
4899 /* Output the annotation. */
4900 tem
= Fcdr (Fcar (*annot
));
4903 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
4906 *annot
= Fcdr (*annot
);
4912 /* Write text in the range START and END into descriptor DESC,
4913 encoding them with coding system CODING. If STRING is nil, START
4914 and END are character positions of the current buffer, else they
4915 are indexes to the string STRING. */
4918 e_write (int desc
, Lisp_Object string
, int start
, int end
, struct coding_system
*coding
)
4920 if (STRINGP (string
))
4923 end
= SCHARS (string
);
4926 /* We used to have a code for handling selective display here. But,
4927 now it is handled within encode_coding. */
4931 if (STRINGP (string
))
4933 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
4934 if (CODING_REQUIRE_ENCODING (coding
))
4936 encode_coding_object (coding
, string
,
4937 start
, string_char_to_byte (string
, start
),
4938 end
, string_char_to_byte (string
, end
), Qt
);
4942 coding
->dst_object
= string
;
4943 coding
->consumed_char
= SCHARS (string
);
4944 coding
->produced
= SBYTES (string
);
4949 int start_byte
= CHAR_TO_BYTE (start
);
4950 int end_byte
= CHAR_TO_BYTE (end
);
4952 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
4953 if (CODING_REQUIRE_ENCODING (coding
))
4955 encode_coding_object (coding
, Fcurrent_buffer (),
4956 start
, start_byte
, end
, end_byte
, Qt
);
4960 coding
->dst_object
= Qnil
;
4961 coding
->dst_pos_byte
= start_byte
;
4962 if (start
>= GPT
|| end
<= GPT
)
4964 coding
->consumed_char
= end
- start
;
4965 coding
->produced
= end_byte
- start_byte
;
4969 coding
->consumed_char
= GPT
- start
;
4970 coding
->produced
= GPT_BYTE
- start_byte
;
4975 if (coding
->produced
> 0)
4979 STRINGP (coding
->dst_object
)
4980 ? SDATA (coding
->dst_object
)
4981 : BYTE_POS_ADDR (coding
->dst_pos_byte
),
4984 if (coding
->produced
)
4987 start
+= coding
->consumed_char
;
4993 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4994 Sverify_visited_file_modtime
, 0, 1, 0,
4995 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
4996 This means that the file has not been changed since it was visited or saved.
4997 If BUF is omitted or nil, it defaults to the current buffer.
4998 See Info node `(elisp)Modification Time' for more details. */)
5003 Lisp_Object handler
;
5004 Lisp_Object filename
;
5014 if (!STRINGP (b
->filename
)) return Qt
;
5015 if (b
->modtime
== 0) return Qt
;
5017 /* If the file name has special constructs in it,
5018 call the corresponding file handler. */
5019 handler
= Ffind_file_name_handler (b
->filename
,
5020 Qverify_visited_file_modtime
);
5021 if (!NILP (handler
))
5022 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5024 filename
= ENCODE_FILE (b
->filename
);
5026 if (stat (SDATA (filename
), &st
) < 0)
5028 /* If the file doesn't exist now and didn't exist before,
5029 we say that it isn't modified, provided the error is a tame one. */
5030 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5035 if ((st
.st_mtime
== b
->modtime
5036 /* If both are positive, accept them if they are off by one second. */
5037 || (st
.st_mtime
> 0 && b
->modtime
> 0
5038 && (st
.st_mtime
== b
->modtime
+ 1
5039 || st
.st_mtime
== b
->modtime
- 1)))
5040 && (st
.st_size
== b
->modtime_size
5041 || b
->modtime_size
< 0))
5046 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5047 Sclear_visited_file_modtime
, 0, 0, 0,
5048 doc
: /* Clear out records of last mod time of visited file.
5049 Next attempt to save will certainly not complain of a discrepancy. */)
5052 current_buffer
->modtime
= 0;
5053 current_buffer
->modtime_size
= -1;
5057 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5058 Svisited_file_modtime
, 0, 0, 0,
5059 doc
: /* Return the current buffer's recorded visited file modification time.
5060 The value is a list of the form (HIGH LOW), like the time values
5061 that `file-attributes' returns. If the current buffer has no recorded
5062 file modification time, this function returns 0.
5063 See Info node `(elisp)Modification Time' for more details. */)
5066 if (! current_buffer
->modtime
)
5067 return make_number (0);
5068 return make_time ((time_t) current_buffer
->modtime
);
5071 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5072 Sset_visited_file_modtime
, 0, 1, 0,
5073 doc
: /* Update buffer's recorded modification time from the visited file's time.
5074 Useful if the buffer was not read from the file normally
5075 or if the file itself has been changed for some known benign reason.
5076 An argument specifies the modification time value to use
5077 \(instead of that of the visited file), in the form of a list
5078 \(HIGH . LOW) or (HIGH LOW). */)
5079 (Lisp_Object time_list
)
5081 if (!NILP (time_list
))
5083 current_buffer
->modtime
= cons_to_long (time_list
);
5084 current_buffer
->modtime_size
= -1;
5088 register Lisp_Object filename
;
5090 Lisp_Object handler
;
5092 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5094 /* If the file name has special constructs in it,
5095 call the corresponding file handler. */
5096 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5097 if (!NILP (handler
))
5098 /* The handler can find the file name the same way we did. */
5099 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5101 filename
= ENCODE_FILE (filename
);
5103 if (stat (SDATA (filename
), &st
) >= 0)
5105 current_buffer
->modtime
= st
.st_mtime
;
5106 current_buffer
->modtime_size
= st
.st_size
;
5114 auto_save_error (Lisp_Object error
)
5116 Lisp_Object args
[3], msg
;
5118 struct gcpro gcpro1
;
5122 auto_save_error_occurred
= 1;
5124 ring_bell (XFRAME (selected_frame
));
5126 args
[0] = build_string ("Auto-saving %s: %s");
5127 args
[1] = current_buffer
->name
;
5128 args
[2] = Ferror_message_string (error
);
5129 msg
= Fformat (3, args
);
5131 nbytes
= SBYTES (msg
);
5132 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5133 memcpy (msgbuf
, SDATA (msg
), nbytes
);
5135 for (i
= 0; i
< 3; ++i
)
5138 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5140 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5141 Fsleep_for (make_number (1), Qnil
);
5155 auto_save_mode_bits
= 0666;
5157 /* Get visited file's mode to become the auto save file's mode. */
5158 if (! NILP (current_buffer
->filename
))
5160 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5161 /* But make sure we can overwrite it later! */
5162 auto_save_mode_bits
= st
.st_mode
| 0600;
5163 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5165 /* Remote files don't cooperate with stat. */
5166 auto_save_mode_bits
= XINT (modes
) | 0600;
5170 Fwrite_region (Qnil
, Qnil
, current_buffer
->auto_save_file_name
, Qnil
,
5171 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5176 do_auto_save_unwind (Lisp_Object arg
) /* used as unwind-protect function */
5179 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5191 do_auto_save_unwind_1 (Lisp_Object value
) /* used as unwind-protect function */
5194 minibuffer_auto_raise
= XINT (value
);
5199 do_auto_save_make_dir (Lisp_Object dir
)
5203 call2 (Qmake_directory
, dir
, Qt
);
5204 XSETFASTINT (mode
, 0700);
5205 return Fset_file_modes (dir
, mode
);
5209 do_auto_save_eh (Lisp_Object ignore
)
5214 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5215 doc
: /* Auto-save all buffers that need it.
5216 This is all buffers that have auto-saving enabled
5217 and are changed since last auto-saved.
5218 Auto-saving writes the buffer into a file
5219 so that your editing is not lost if the system crashes.
5220 This file is not the file you visited; that changes only when you save.
5221 Normally we run the normal hook `auto-save-hook' before saving.
5223 A non-nil NO-MESSAGE argument means do not print any message if successful.
5224 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5225 (Lisp_Object no_message
, Lisp_Object current_only
)
5227 struct buffer
*old
= current_buffer
, *b
;
5228 Lisp_Object tail
, buf
;
5230 int do_handled_files
;
5232 FILE *stream
= NULL
;
5233 int count
= SPECPDL_INDEX ();
5234 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5235 int old_message_p
= 0;
5236 struct gcpro gcpro1
, gcpro2
;
5238 if (max_specpdl_size
< specpdl_size
+ 40)
5239 max_specpdl_size
= specpdl_size
+ 40;
5244 if (NILP (no_message
))
5246 old_message_p
= push_message ();
5247 record_unwind_protect (pop_message_unwind
, Qnil
);
5250 /* Ordinarily don't quit within this function,
5251 but don't make it impossible to quit (in case we get hung in I/O). */
5255 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5256 point to non-strings reached from Vbuffer_alist. */
5258 if (!NILP (Vrun_hooks
))
5259 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5261 if (STRINGP (Vauto_save_list_file_name
))
5263 Lisp_Object listfile
;
5265 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5267 /* Don't try to create the directory when shutting down Emacs,
5268 because creating the directory might signal an error, and
5269 that would leave Emacs in a strange state. */
5270 if (!NILP (Vrun_hooks
))
5274 GCPRO2 (dir
, listfile
);
5275 dir
= Ffile_name_directory (listfile
);
5276 if (NILP (Ffile_directory_p (dir
)))
5277 internal_condition_case_1 (do_auto_save_make_dir
,
5278 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5283 stream
= fopen (SDATA (listfile
), "w");
5286 record_unwind_protect (do_auto_save_unwind
,
5287 make_save_value (stream
, 0));
5288 record_unwind_protect (do_auto_save_unwind_1
,
5289 make_number (minibuffer_auto_raise
));
5290 minibuffer_auto_raise
= 0;
5292 auto_save_error_occurred
= 0;
5294 /* On first pass, save all files that don't have handlers.
5295 On second pass, save all files that do have handlers.
5297 If Emacs is crashing, the handlers may tweak what is causing
5298 Emacs to crash in the first place, and it would be a shame if
5299 Emacs failed to autosave perfectly ordinary files because it
5300 couldn't handle some ange-ftp'd file. */
5302 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5303 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5305 buf
= XCDR (XCAR (tail
));
5308 /* Record all the buffers that have auto save mode
5309 in the special file that lists them. For each of these buffers,
5310 Record visited name (if any) and auto save name. */
5311 if (STRINGP (b
->auto_save_file_name
)
5312 && stream
!= NULL
&& do_handled_files
== 0)
5315 if (!NILP (b
->filename
))
5317 fwrite (SDATA (b
->filename
), 1,
5318 SBYTES (b
->filename
), stream
);
5320 putc ('\n', stream
);
5321 fwrite (SDATA (b
->auto_save_file_name
), 1,
5322 SBYTES (b
->auto_save_file_name
), stream
);
5323 putc ('\n', stream
);
5327 if (!NILP (current_only
)
5328 && b
!= current_buffer
)
5331 /* Don't auto-save indirect buffers.
5332 The base buffer takes care of it. */
5336 /* Check for auto save enabled
5337 and file changed since last auto save
5338 and file changed since last real save. */
5339 if (STRINGP (b
->auto_save_file_name
)
5340 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5341 && BUF_AUTOSAVE_MODIFF (b
) < BUF_MODIFF (b
)
5342 /* -1 means we've turned off autosaving for a while--see below. */
5343 && XINT (b
->save_length
) >= 0
5344 && (do_handled_files
5345 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5348 EMACS_TIME before_time
, after_time
;
5350 EMACS_GET_TIME (before_time
);
5352 /* If we had a failure, don't try again for 20 minutes. */
5353 if (b
->auto_save_failure_time
>= 0
5354 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5357 set_buffer_internal (b
);
5358 if (NILP (Vauto_save_include_big_deletions
)
5359 && (XFASTINT (b
->save_length
) * 10
5360 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5361 /* A short file is likely to change a large fraction;
5362 spare the user annoying messages. */
5363 && XFASTINT (b
->save_length
) > 5000
5364 /* These messages are frequent and annoying for `*mail*'. */
5365 && !EQ (b
->filename
, Qnil
)
5366 && NILP (no_message
))
5368 /* It has shrunk too much; turn off auto-saving here. */
5369 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5370 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5372 minibuffer_auto_raise
= 0;
5373 /* Turn off auto-saving until there's a real save,
5374 and prevent any more warnings. */
5375 XSETINT (b
->save_length
, -1);
5376 Fsleep_for (make_number (1), Qnil
);
5379 if (!auto_saved
&& NILP (no_message
))
5380 message1 ("Auto-saving...");
5381 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5383 BUF_AUTOSAVE_MODIFF (b
) = BUF_MODIFF (b
);
5384 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5385 set_buffer_internal (old
);
5387 EMACS_GET_TIME (after_time
);
5389 /* If auto-save took more than 60 seconds,
5390 assume it was an NFS failure that got a timeout. */
5391 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5392 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5396 /* Prevent another auto save till enough input events come in. */
5397 record_auto_save ();
5399 if (auto_saved
&& NILP (no_message
))
5403 /* If we are going to restore an old message,
5404 give time to read ours. */
5405 sit_for (make_number (1), 0, 0);
5408 else if (!auto_save_error_occurred
)
5409 /* Don't overwrite the error message if an error occurred.
5410 If we displayed a message and then restored a state
5411 with no message, leave a "done" message on the screen. */
5412 message1 ("Auto-saving...done");
5417 /* This restores the message-stack status. */
5418 unbind_to (count
, Qnil
);
5422 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5423 Sset_buffer_auto_saved
, 0, 0, 0,
5424 doc
: /* Mark current buffer as auto-saved with its current text.
5425 No auto-save file will be written until the buffer changes again. */)
5428 /* FIXME: This should not be called in indirect buffers, since
5429 they're not autosaved. */
5430 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
5431 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5432 current_buffer
->auto_save_failure_time
= -1;
5436 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5437 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5438 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5441 current_buffer
->auto_save_failure_time
= -1;
5445 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5447 doc
: /* Return t if current buffer has been auto-saved recently.
5448 More precisely, if it has been auto-saved since last read from or saved
5449 in the visited file. If the buffer has no visited file,
5450 then any auto-save counts as "recent". */)
5453 /* FIXME: maybe we should return nil for indirect buffers since
5454 they're never autosaved. */
5455 return (SAVE_MODIFF
< BUF_AUTOSAVE_MODIFF (current_buffer
) ? Qt
: Qnil
);
5458 /* Reading and completing file names */
5460 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5461 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5462 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5463 The return value is only relevant for a call to `read-file-name' that happens
5464 before any other event (mouse or keypress) is handled. */)
5467 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
5468 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5478 Fread_file_name (Lisp_Object prompt
, Lisp_Object dir
, Lisp_Object default_filename
, Lisp_Object mustmatch
, Lisp_Object initial
, Lisp_Object predicate
)
5480 struct gcpro gcpro1
, gcpro2
;
5481 Lisp_Object args
[7];
5483 GCPRO1 (default_filename
);
5484 args
[0] = intern ("read-file-name");
5487 args
[3] = default_filename
;
5488 args
[4] = mustmatch
;
5490 args
[6] = predicate
;
5491 RETURN_UNGCPRO (Ffuncall (7, args
));
5496 syms_of_fileio (void)
5498 Qoperations
= intern_c_string ("operations");
5499 Qexpand_file_name
= intern_c_string ("expand-file-name");
5500 Qsubstitute_in_file_name
= intern_c_string ("substitute-in-file-name");
5501 Qdirectory_file_name
= intern_c_string ("directory-file-name");
5502 Qfile_name_directory
= intern_c_string ("file-name-directory");
5503 Qfile_name_nondirectory
= intern_c_string ("file-name-nondirectory");
5504 Qunhandled_file_name_directory
= intern_c_string ("unhandled-file-name-directory");
5505 Qfile_name_as_directory
= intern_c_string ("file-name-as-directory");
5506 Qcopy_file
= intern_c_string ("copy-file");
5507 Qmake_directory_internal
= intern_c_string ("make-directory-internal");
5508 Qmake_directory
= intern_c_string ("make-directory");
5509 Qdelete_directory_internal
= intern_c_string ("delete-directory-internal");
5510 Qdelete_file
= intern_c_string ("delete-file");
5511 Qrename_file
= intern_c_string ("rename-file");
5512 Qadd_name_to_file
= intern_c_string ("add-name-to-file");
5513 Qmake_symbolic_link
= intern_c_string ("make-symbolic-link");
5514 Qfile_exists_p
= intern_c_string ("file-exists-p");
5515 Qfile_executable_p
= intern_c_string ("file-executable-p");
5516 Qfile_readable_p
= intern_c_string ("file-readable-p");
5517 Qfile_writable_p
= intern_c_string ("file-writable-p");
5518 Qfile_symlink_p
= intern_c_string ("file-symlink-p");
5519 Qaccess_file
= intern_c_string ("access-file");
5520 Qfile_directory_p
= intern_c_string ("file-directory-p");
5521 Qfile_regular_p
= intern_c_string ("file-regular-p");
5522 Qfile_accessible_directory_p
= intern_c_string ("file-accessible-directory-p");
5523 Qfile_modes
= intern_c_string ("file-modes");
5524 Qset_file_modes
= intern_c_string ("set-file-modes");
5525 Qset_file_times
= intern_c_string ("set-file-times");
5526 Qfile_selinux_context
= intern_c_string("file-selinux-context");
5527 Qset_file_selinux_context
= intern_c_string("set-file-selinux-context");
5528 Qfile_newer_than_file_p
= intern_c_string ("file-newer-than-file-p");
5529 Qinsert_file_contents
= intern_c_string ("insert-file-contents");
5530 Qwrite_region
= intern_c_string ("write-region");
5531 Qverify_visited_file_modtime
= intern_c_string ("verify-visited-file-modtime");
5532 Qset_visited_file_modtime
= intern_c_string ("set-visited-file-modtime");
5533 Qauto_save_coding
= intern_c_string ("auto-save-coding");
5535 staticpro (&Qoperations
);
5536 staticpro (&Qexpand_file_name
);
5537 staticpro (&Qsubstitute_in_file_name
);
5538 staticpro (&Qdirectory_file_name
);
5539 staticpro (&Qfile_name_directory
);
5540 staticpro (&Qfile_name_nondirectory
);
5541 staticpro (&Qunhandled_file_name_directory
);
5542 staticpro (&Qfile_name_as_directory
);
5543 staticpro (&Qcopy_file
);
5544 staticpro (&Qmake_directory_internal
);
5545 staticpro (&Qmake_directory
);
5546 staticpro (&Qdelete_directory_internal
);
5547 staticpro (&Qdelete_file
);
5548 staticpro (&Qrename_file
);
5549 staticpro (&Qadd_name_to_file
);
5550 staticpro (&Qmake_symbolic_link
);
5551 staticpro (&Qfile_exists_p
);
5552 staticpro (&Qfile_executable_p
);
5553 staticpro (&Qfile_readable_p
);
5554 staticpro (&Qfile_writable_p
);
5555 staticpro (&Qaccess_file
);
5556 staticpro (&Qfile_symlink_p
);
5557 staticpro (&Qfile_directory_p
);
5558 staticpro (&Qfile_regular_p
);
5559 staticpro (&Qfile_accessible_directory_p
);
5560 staticpro (&Qfile_modes
);
5561 staticpro (&Qset_file_modes
);
5562 staticpro (&Qset_file_times
);
5563 staticpro (&Qfile_selinux_context
);
5564 staticpro (&Qset_file_selinux_context
);
5565 staticpro (&Qfile_newer_than_file_p
);
5566 staticpro (&Qinsert_file_contents
);
5567 staticpro (&Qwrite_region
);
5568 staticpro (&Qverify_visited_file_modtime
);
5569 staticpro (&Qset_visited_file_modtime
);
5570 staticpro (&Qauto_save_coding
);
5572 Qfile_name_history
= intern_c_string ("file-name-history");
5573 Fset (Qfile_name_history
, Qnil
);
5574 staticpro (&Qfile_name_history
);
5576 Qfile_error
= intern_c_string ("file-error");
5577 staticpro (&Qfile_error
);
5578 Qfile_already_exists
= intern_c_string ("file-already-exists");
5579 staticpro (&Qfile_already_exists
);
5580 Qfile_date_error
= intern_c_string ("file-date-error");
5581 staticpro (&Qfile_date_error
);
5582 Qexcl
= intern_c_string ("excl");
5586 Qfind_buffer_file_type
= intern_c_string ("find-buffer-file-type");
5587 staticpro (&Qfind_buffer_file_type
);
5590 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system
,
5591 doc
: /* *Coding system for encoding file names.
5592 If it is nil, `default-file-name-coding-system' (which see) is used. */);
5593 Vfile_name_coding_system
= Qnil
;
5595 DEFVAR_LISP ("default-file-name-coding-system",
5596 Vdefault_file_name_coding_system
,
5597 doc
: /* Default coding system for encoding file names.
5598 This variable is used only when `file-name-coding-system' is nil.
5600 This variable is set/changed by the command `set-language-environment'.
5601 User should not set this variable manually,
5602 instead use `file-name-coding-system' to get a constant encoding
5603 of file names regardless of the current language environment. */);
5604 Vdefault_file_name_coding_system
= Qnil
;
5606 Qformat_decode
= intern_c_string ("format-decode");
5607 staticpro (&Qformat_decode
);
5608 Qformat_annotate_function
= intern_c_string ("format-annotate-function");
5609 staticpro (&Qformat_annotate_function
);
5610 Qafter_insert_file_set_coding
= intern_c_string ("after-insert-file-set-coding");
5611 staticpro (&Qafter_insert_file_set_coding
);
5613 Qcar_less_than_car
= intern_c_string ("car-less-than-car");
5614 staticpro (&Qcar_less_than_car
);
5616 Fput (Qfile_error
, Qerror_conditions
,
5617 Fpurecopy (list2 (Qfile_error
, Qerror
)));
5618 Fput (Qfile_error
, Qerror_message
,
5619 make_pure_c_string ("File error"));
5621 Fput (Qfile_already_exists
, Qerror_conditions
,
5622 Fpurecopy (list3 (Qfile_already_exists
, Qfile_error
, Qerror
)));
5623 Fput (Qfile_already_exists
, Qerror_message
,
5624 make_pure_c_string ("File already exists"));
5626 Fput (Qfile_date_error
, Qerror_conditions
,
5627 Fpurecopy (list3 (Qfile_date_error
, Qfile_error
, Qerror
)));
5628 Fput (Qfile_date_error
, Qerror_message
,
5629 make_pure_c_string ("Cannot set file date"));
5631 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist
,
5632 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
5633 If a file name matches REGEXP, then all I/O on that file is done by calling
5636 The first argument given to HANDLER is the name of the I/O primitive
5637 to be handled; the remaining arguments are the arguments that were
5638 passed to that primitive. For example, if you do
5639 (file-exists-p FILENAME)
5640 and FILENAME is handled by HANDLER, then HANDLER is called like this:
5641 (funcall HANDLER 'file-exists-p FILENAME)
5642 The function `find-file-name-handler' checks this list for a handler
5643 for its argument. */);
5644 Vfile_name_handler_alist
= Qnil
;
5646 DEFVAR_LISP ("set-auto-coding-function",
5647 Vset_auto_coding_function
,
5648 doc
: /* If non-nil, a function to call to decide a coding system of file.
5649 Two arguments are passed to this function: the file name
5650 and the length of a file contents following the point.
5651 This function should return a coding system to decode the file contents.
5652 It should check the file name against `auto-coding-alist'.
5653 If no coding system is decided, it should check a coding system
5654 specified in the heading lines with the format:
5655 -*- ... coding: CODING-SYSTEM; ... -*-
5656 or local variable spec of the tailing lines with `coding:' tag. */);
5657 Vset_auto_coding_function
= Qnil
;
5659 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions
,
5660 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
5661 Each is passed one argument, the number of characters inserted,
5662 with point at the start of the inserted text. Each function
5663 should leave point the same, and return the new character count.
5664 If `insert-file-contents' is intercepted by a handler from
5665 `file-name-handler-alist', that handler is responsible for calling the
5666 functions in `after-insert-file-functions' if appropriate. */);
5667 Vafter_insert_file_functions
= Qnil
;
5669 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions
,
5670 doc
: /* A list of functions to be called at the start of `write-region'.
5671 Each is passed two arguments, START and END as for `write-region'.
5672 These are usually two numbers but not always; see the documentation
5673 for `write-region'. The function should return a list of pairs
5674 of the form (POSITION . STRING), consisting of strings to be effectively
5675 inserted at the specified positions of the file being written (1 means to
5676 insert before the first byte written). The POSITIONs must be sorted into
5679 If there are several annotation functions, the lists returned by these
5680 functions are merged destructively. As each annotation function runs,
5681 the variable `write-region-annotations-so-far' contains a list of all
5682 annotations returned by previous annotation functions.
5684 An annotation function can return with a different buffer current.
5685 Doing so removes the annotations returned by previous functions, and
5686 resets START and END to `point-min' and `point-max' of the new buffer.
5688 After `write-region' completes, Emacs calls the function stored in
5689 `write-region-post-annotation-function', once for each buffer that was
5690 current when building the annotations (i.e., at least once), with that
5691 buffer current. */);
5692 Vwrite_region_annotate_functions
= Qnil
;
5693 staticpro (&Qwrite_region_annotate_functions
);
5694 Qwrite_region_annotate_functions
5695 = intern_c_string ("write-region-annotate-functions");
5697 DEFVAR_LISP ("write-region-post-annotation-function",
5698 Vwrite_region_post_annotation_function
,
5699 doc
: /* Function to call after `write-region' completes.
5700 The function is called with no arguments. If one or more of the
5701 annotation functions in `write-region-annotate-functions' changed the
5702 current buffer, the function stored in this variable is called for
5703 each of those additional buffers as well, in addition to the original
5704 buffer. The relevant buffer is current during each function call. */);
5705 Vwrite_region_post_annotation_function
= Qnil
;
5706 staticpro (&Vwrite_region_annotation_buffers
);
5708 DEFVAR_LISP ("write-region-annotations-so-far",
5709 Vwrite_region_annotations_so_far
,
5710 doc
: /* When an annotation function is called, this holds the previous annotations.
5711 These are the annotations made by other annotation functions
5712 that were already called. See also `write-region-annotate-functions'. */);
5713 Vwrite_region_annotations_so_far
= Qnil
;
5715 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers
,
5716 doc
: /* A list of file name handlers that temporarily should not be used.
5717 This applies only to the operation `inhibit-file-name-operation'. */);
5718 Vinhibit_file_name_handlers
= Qnil
;
5720 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation
,
5721 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5722 Vinhibit_file_name_operation
= Qnil
;
5724 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name
,
5725 doc
: /* File name in which we write a list of all auto save file names.
5726 This variable is initialized automatically from `auto-save-list-file-prefix'
5727 shortly after Emacs reads your `.emacs' file, if you have not yet given it
5728 a non-nil value. */);
5729 Vauto_save_list_file_name
= Qnil
;
5731 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name
,
5732 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
5733 Normally auto-save files are written under other names. */);
5734 Vauto_save_visited_file_name
= Qnil
;
5736 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions
,
5737 doc
: /* If non-nil, auto-save even if a large part of the text is deleted.
5738 If nil, deleting a substantial portion of the text disables auto-save
5739 in the buffer; this is the default behavior, because the auto-save
5740 file is usually more useful if it contains the deleted text. */);
5741 Vauto_save_include_big_deletions
= Qnil
;
5744 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync
,
5745 doc
: /* *Non-nil means don't call fsync in `write-region'.
5746 This variable affects calls to `write-region' as well as save commands.
5747 A non-nil value may result in data loss! */);
5748 write_region_inhibit_fsync
= 0;
5751 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash
,
5752 doc
: /* Specifies whether to use the system's trash can.
5753 When non-nil, certain file deletion commands use the function
5754 `move-file-to-trash' instead of deleting files outright.
5755 This includes interactive calls to `delete-file' and
5756 `delete-directory' and the Dired deletion commands. */);
5757 delete_by_moving_to_trash
= 0;
5758 Qdelete_by_moving_to_trash
= intern_c_string ("delete-by-moving-to-trash");
5759 Qmove_file_to_trash
= intern_c_string ("move-file-to-trash");
5760 staticpro (&Qmove_file_to_trash
);
5761 Qcopy_directory
= intern_c_string ("copy-directory");
5762 staticpro (&Qcopy_directory
);
5763 Qdelete_directory
= intern_c_string ("delete-directory");
5764 staticpro (&Qdelete_directory
);
5766 defsubr (&Sfind_file_name_handler
);
5767 defsubr (&Sfile_name_directory
);
5768 defsubr (&Sfile_name_nondirectory
);
5769 defsubr (&Sunhandled_file_name_directory
);
5770 defsubr (&Sfile_name_as_directory
);
5771 defsubr (&Sdirectory_file_name
);
5772 defsubr (&Smake_temp_name
);
5773 defsubr (&Sexpand_file_name
);
5774 defsubr (&Ssubstitute_in_file_name
);
5775 defsubr (&Scopy_file
);
5776 defsubr (&Smake_directory_internal
);
5777 defsubr (&Sdelete_directory_internal
);
5778 defsubr (&Sdelete_file
);
5779 defsubr (&Srename_file
);
5780 defsubr (&Sadd_name_to_file
);
5781 defsubr (&Smake_symbolic_link
);
5782 defsubr (&Sfile_name_absolute_p
);
5783 defsubr (&Sfile_exists_p
);
5784 defsubr (&Sfile_executable_p
);
5785 defsubr (&Sfile_readable_p
);
5786 defsubr (&Sfile_writable_p
);
5787 defsubr (&Saccess_file
);
5788 defsubr (&Sfile_symlink_p
);
5789 defsubr (&Sfile_directory_p
);
5790 defsubr (&Sfile_accessible_directory_p
);
5791 defsubr (&Sfile_regular_p
);
5792 defsubr (&Sfile_modes
);
5793 defsubr (&Sset_file_modes
);
5794 defsubr (&Sset_file_times
);
5795 defsubr (&Sfile_selinux_context
);
5796 defsubr (&Sset_file_selinux_context
);
5797 defsubr (&Sset_default_file_modes
);
5798 defsubr (&Sdefault_file_modes
);
5799 defsubr (&Sfile_newer_than_file_p
);
5800 defsubr (&Sinsert_file_contents
);
5801 defsubr (&Swrite_region
);
5802 defsubr (&Scar_less_than_car
);
5803 defsubr (&Sverify_visited_file_modtime
);
5804 defsubr (&Sclear_visited_file_modtime
);
5805 defsubr (&Svisited_file_modtime
);
5806 defsubr (&Sset_visited_file_modtime
);
5807 defsubr (&Sdo_auto_save
);
5808 defsubr (&Sset_buffer_auto_saved
);
5809 defsubr (&Sclear_buffer_auto_save_failure
);
5810 defsubr (&Srecent_auto_save_p
);
5812 defsubr (&Snext_read_file_uses_dialog_p
);
5815 defsubr (&Sunix_sync
);