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 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>
34 #if !defined (S_ISLNK) && defined (S_IFLNK)
35 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
38 #if !defined (S_ISFIFO) && defined (S_IFIFO)
39 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
42 #if !defined (S_ISREG) && defined (S_IFREG)
43 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
53 #ifdef HAVE_LIBSELINUX
54 #include <selinux/selinux.h>
55 #include <selinux/context.h>
59 #include "intervals.h"
61 #include "character.h"
64 #include "blockinput.h"
66 #include "dispextern.h"
72 #endif /* not WINDOWSNT */
76 #include <sys/param.h>
81 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
82 redirector allows the six letters between 'Z' and 'a' as well. */
84 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
87 #define IS_DRIVE(x) isalpha (x)
89 /* Need to lower-case the drive letter, or else expanded
90 filenames will sometimes compare inequal, because
91 `expand-file-name' doesn't always down-case the drive letter. */
92 #define DRIVE_LETTER(x) (tolower (x))
101 #include "commands.h"
115 #ifndef FILE_SYSTEM_CASE
116 #define FILE_SYSTEM_CASE(filename) (filename)
119 /* Nonzero during writing of auto-save files */
122 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
123 a new file with the same mode as the original */
124 int auto_save_mode_bits
;
126 /* Set by auto_save_1 if an error occurred during the last auto-save. */
127 int auto_save_error_occurred
;
129 /* The symbol bound to coding-system-for-read when
130 insert-file-contents is called for recovering a file. This is not
131 an actual coding system name, but just an indicator to tell
132 insert-file-contents to use `emacs-mule' with a special flag for
133 auto saving and recovering a file. */
134 Lisp_Object Qauto_save_coding
;
136 /* Coding system for file names, or nil if none. */
137 Lisp_Object Vfile_name_coding_system
;
139 /* Coding system for file names used only when
140 Vfile_name_coding_system is nil. */
141 Lisp_Object Vdefault_file_name_coding_system
;
143 /* Alist of elements (REGEXP . HANDLER) for file names
144 whose I/O is done with a special handler. */
145 Lisp_Object Vfile_name_handler_alist
;
147 /* Property name of a file name handler,
148 which gives a list of operations it handles.. */
149 Lisp_Object Qoperations
;
151 /* Lisp functions for translating file formats */
152 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
154 /* Function to be called to decide a coding system of a reading file. */
155 Lisp_Object Vset_auto_coding_function
;
157 /* Functions to be called to process text properties in inserted file. */
158 Lisp_Object Vafter_insert_file_functions
;
160 /* Lisp function for setting buffer-file-coding-system and the
161 multibyteness of the current buffer after inserting a file. */
162 Lisp_Object Qafter_insert_file_set_coding
;
164 /* Functions to be called to create text property annotations for file. */
165 Lisp_Object Vwrite_region_annotate_functions
;
166 Lisp_Object Qwrite_region_annotate_functions
;
167 Lisp_Object Vwrite_region_post_annotation_function
;
169 /* During build_annotations, each time an annotation function is called,
170 this holds the annotations made by the previous functions. */
171 Lisp_Object Vwrite_region_annotations_so_far
;
173 /* Each time an annotation function changes the buffer, the new buffer
175 Lisp_Object Vwrite_region_annotation_buffers
;
177 /* File name in which we write a list of all our auto save files. */
178 Lisp_Object Vauto_save_list_file_name
;
180 /* Whether or not files are auto-saved into themselves. */
181 Lisp_Object Vauto_save_visited_file_name
;
183 /* Whether or not to continue auto-saving after a large deletion. */
184 Lisp_Object Vauto_save_include_big_deletions
;
187 /* Nonzero means skip the call to fsync in Fwrite-region. */
188 int write_region_inhibit_fsync
;
191 /* Non-zero means call move-file-to-trash in Fdelete_file or
192 Fdelete_directory_internal. */
193 int delete_by_moving_to_trash
;
195 Lisp_Object Qdelete_by_moving_to_trash
;
197 /* Lisp function for moving files to trash. */
198 Lisp_Object Qmove_file_to_trash
;
200 /* Lisp function for recursively copying directories. */
201 Lisp_Object Qcopy_directory
;
203 /* Lisp function for recursively deleting directories. */
204 Lisp_Object Qdelete_directory
;
207 extern Lisp_Object Vw32_get_true_file_attributes
;
210 /* These variables describe handlers that have "already" had a chance
211 to handle the current operation.
213 Vinhibit_file_name_handlers is a list of file name handlers.
214 Vinhibit_file_name_operation is the operation being handled.
215 If we try to handle that operation, we ignore those handlers. */
217 static Lisp_Object Vinhibit_file_name_handlers
;
218 static Lisp_Object Vinhibit_file_name_operation
;
220 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
222 Lisp_Object Qfile_name_history
;
224 Lisp_Object Qcar_less_than_car
;
226 static int a_write (int, Lisp_Object
, int, int,
227 Lisp_Object
*, struct coding_system
*);
228 static int e_write (int, Lisp_Object
, int, int, struct coding_system
*);
232 report_file_error (const char *string
, Lisp_Object data
)
234 Lisp_Object errstring
;
238 synchronize_system_messages_locale ();
239 str
= strerror (errorno
);
240 errstring
= code_convert_string_norecord (make_unibyte_string (str
,
242 Vlocale_coding_system
, 0);
248 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
251 /* System error messages are capitalized. Downcase the initial
252 unless it is followed by a slash. (The slash case caters to
253 error messages that begin with "I/O" or, in German, "E/A".) */
254 if (STRING_MULTIBYTE (errstring
)
255 && ! EQ (Faref (errstring
, make_number (1)), make_number ('/')))
259 str
= (char *) SDATA (errstring
);
260 c
= STRING_CHAR (str
);
261 Faset (errstring
, make_number (0), make_number (DOWNCASE (c
)));
264 xsignal (Qfile_error
,
265 Fcons (build_string (string
), Fcons (errstring
, data
)));
270 close_file_unwind (Lisp_Object fd
)
272 emacs_close (XFASTINT (fd
));
276 /* Restore point, having saved it as a marker. */
279 restore_point_unwind (Lisp_Object location
)
281 Fgoto_char (location
);
282 Fset_marker (location
, Qnil
, Qnil
);
287 Lisp_Object Qexpand_file_name
;
288 Lisp_Object Qsubstitute_in_file_name
;
289 Lisp_Object Qdirectory_file_name
;
290 Lisp_Object Qfile_name_directory
;
291 Lisp_Object Qfile_name_nondirectory
;
292 Lisp_Object Qunhandled_file_name_directory
;
293 Lisp_Object Qfile_name_as_directory
;
294 Lisp_Object Qcopy_file
;
295 Lisp_Object Qmake_directory_internal
;
296 Lisp_Object Qmake_directory
;
297 Lisp_Object Qdelete_directory_internal
;
298 Lisp_Object Qdelete_file
;
299 Lisp_Object Qrename_file
;
300 Lisp_Object Qadd_name_to_file
;
301 Lisp_Object Qmake_symbolic_link
;
302 Lisp_Object Qfile_exists_p
;
303 Lisp_Object Qfile_executable_p
;
304 Lisp_Object Qfile_readable_p
;
305 Lisp_Object Qfile_writable_p
;
306 Lisp_Object Qfile_symlink_p
;
307 Lisp_Object Qaccess_file
;
308 Lisp_Object Qfile_directory_p
;
309 Lisp_Object Qfile_regular_p
;
310 Lisp_Object Qfile_accessible_directory_p
;
311 Lisp_Object Qfile_modes
;
312 Lisp_Object Qset_file_modes
;
313 Lisp_Object Qset_file_times
;
314 Lisp_Object Qfile_selinux_context
;
315 Lisp_Object Qset_file_selinux_context
;
316 Lisp_Object Qfile_newer_than_file_p
;
317 Lisp_Object Qinsert_file_contents
;
318 Lisp_Object Qwrite_region
;
319 Lisp_Object Qverify_visited_file_modtime
;
320 Lisp_Object Qset_visited_file_modtime
;
322 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
323 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
324 Otherwise, return nil.
325 A file name is handled if one of the regular expressions in
326 `file-name-handler-alist' matches it.
328 If OPERATION equals `inhibit-file-name-operation', then we ignore
329 any handlers that are members of `inhibit-file-name-handlers',
330 but we still do run any other handlers. This lets handlers
331 use the standard functions without calling themselves recursively. */)
332 (Lisp_Object filename
, Lisp_Object operation
)
334 /* This function must not munge the match data. */
335 Lisp_Object chain
, inhibited_handlers
, result
;
339 CHECK_STRING (filename
);
341 if (EQ (operation
, Vinhibit_file_name_operation
))
342 inhibited_handlers
= Vinhibit_file_name_handlers
;
344 inhibited_handlers
= Qnil
;
346 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
347 chain
= XCDR (chain
))
353 Lisp_Object string
= XCAR (elt
);
355 Lisp_Object handler
= XCDR (elt
);
356 Lisp_Object operations
= Qnil
;
358 if (SYMBOLP (handler
))
359 operations
= Fget (handler
, Qoperations
);
362 && (match_pos
= fast_string_match (string
, filename
)) > pos
363 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
367 handler
= XCDR (elt
);
368 tem
= Fmemq (handler
, inhibited_handlers
);
382 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
384 doc
: /* Return the directory component in file name FILENAME.
385 Return nil if FILENAME does not include a directory.
386 Otherwise return a directory name.
387 Given a Unix syntax file name, returns a string ending in slash. */)
388 (Lisp_Object filename
)
391 register const unsigned char *beg
;
393 register unsigned char *beg
;
395 register const unsigned char *p
;
398 CHECK_STRING (filename
);
400 /* If the file name has special constructs in it,
401 call the corresponding file handler. */
402 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
404 return call2 (handler
, Qfile_name_directory
, filename
);
406 filename
= FILE_SYSTEM_CASE (filename
);
408 beg
= (unsigned char *) alloca (SBYTES (filename
) + 1);
409 memcpy (beg
, SDATA (filename
), SBYTES (filename
) + 1);
411 beg
= SDATA (filename
);
413 p
= beg
+ SBYTES (filename
);
415 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
417 /* only recognise drive specifier at the beginning */
419 /* handle the "/:d:foo" and "/:foo" cases correctly */
420 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
421 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
428 /* Expansion of "c:" to drive and default directory. */
431 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
432 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
433 unsigned char *r
= res
;
435 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
437 strncpy (res
, beg
, 2);
442 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
444 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
447 p
= beg
+ strlen (beg
);
450 dostounix_filename (beg
);
453 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
456 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
457 Sfile_name_nondirectory
, 1, 1, 0,
458 doc
: /* Return file name FILENAME sans its directory.
459 For example, in a Unix-syntax file name,
460 this is everything after the last slash,
461 or the entire name if it contains no slash. */)
462 (Lisp_Object filename
)
464 register const unsigned char *beg
, *p
, *end
;
467 CHECK_STRING (filename
);
469 /* If the file name has special constructs in it,
470 call the corresponding file handler. */
471 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
473 return call2 (handler
, Qfile_name_nondirectory
, filename
);
475 beg
= SDATA (filename
);
476 end
= p
= beg
+ SBYTES (filename
);
478 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
480 /* only recognise drive specifier at beginning */
482 /* handle the "/:d:foo" case correctly */
483 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
488 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
491 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
492 Sunhandled_file_name_directory
, 1, 1, 0,
493 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
494 A `directly usable' directory name is one that may be used without the
495 intervention of any file handler.
496 If FILENAME is a directly usable file itself, return
497 \(file-name-directory FILENAME).
498 If FILENAME refers to a file which is not accessible from a local process,
499 then this should return nil.
500 The `call-process' and `start-process' functions use this function to
501 get a current directory to run processes in. */)
502 (Lisp_Object filename
)
506 /* If the file name has special constructs in it,
507 call the corresponding file handler. */
508 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
510 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
512 return Ffile_name_directory (filename
);
517 file_name_as_directory (char *out
, char *in
)
519 int size
= strlen (in
) - 1;
531 /* For Unix syntax, Append a slash if necessary */
532 if (!IS_DIRECTORY_SEP (out
[size
]))
534 out
[size
+ 1] = DIRECTORY_SEP
;
535 out
[size
+ 2] = '\0';
538 dostounix_filename (out
);
543 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
544 Sfile_name_as_directory
, 1, 1, 0,
545 doc
: /* Return a string representing the file name FILE interpreted as a directory.
546 This operation exists because a directory is also a file, but its name as
547 a directory is different from its name as a file.
548 The result can be used as the value of `default-directory'
549 or passed as second argument to `expand-file-name'.
550 For a Unix-syntax file name, just appends a slash. */)
560 /* If the file name has special constructs in it,
561 call the corresponding file handler. */
562 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
564 return call2 (handler
, Qfile_name_as_directory
, file
);
566 buf
= (char *) alloca (SBYTES (file
) + 10);
567 file_name_as_directory (buf
, SDATA (file
));
568 return make_specified_string (buf
, -1, strlen (buf
),
569 STRING_MULTIBYTE (file
));
573 * Convert from directory name to filename.
574 * On UNIX, it's simple: just make sure there isn't a terminating /
576 * Value is nonzero if the string output is different from the input.
580 directory_file_name (char *src
, char *dst
)
586 /* Process as Unix format: just remove any final slash.
587 But leave "/" unchanged; do not change it to "". */
590 && IS_DIRECTORY_SEP (dst
[slen
- 1])
592 && !IS_ANY_SEP (dst
[slen
- 2])
597 dostounix_filename (dst
);
602 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
604 doc
: /* Returns the file name of the directory named DIRECTORY.
605 This is the name of the file that holds the data for the directory DIRECTORY.
606 This operation exists because a directory is also a file, but its name as
607 a directory is different from its name as a file.
608 In Unix-syntax, this function just removes the final slash. */)
609 (Lisp_Object directory
)
614 CHECK_STRING (directory
);
616 if (NILP (directory
))
619 /* If the file name has special constructs in it,
620 call the corresponding file handler. */
621 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
623 return call2 (handler
, Qdirectory_file_name
, directory
);
625 buf
= (char *) alloca (SBYTES (directory
) + 20);
626 directory_file_name (SDATA (directory
), buf
);
627 return make_specified_string (buf
, -1, strlen (buf
),
628 STRING_MULTIBYTE (directory
));
631 static const char make_temp_name_tbl
[64] =
633 'A','B','C','D','E','F','G','H',
634 'I','J','K','L','M','N','O','P',
635 'Q','R','S','T','U','V','W','X',
636 'Y','Z','a','b','c','d','e','f',
637 'g','h','i','j','k','l','m','n',
638 'o','p','q','r','s','t','u','v',
639 'w','x','y','z','0','1','2','3',
640 '4','5','6','7','8','9','-','_'
643 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
645 /* Value is a temporary file name starting with PREFIX, a string.
647 The Emacs process number forms part of the result, so there is
648 no danger of generating a name being used by another process.
649 In addition, this function makes an attempt to choose a name
650 which has no existing file. To make this work, PREFIX should be
651 an absolute file name.
653 BASE64_P non-zero means add the pid as 3 characters in base64
654 encoding. In this case, 6 characters will be added to PREFIX to
655 form the file name. Otherwise, if Emacs is running on a system
656 with long file names, add the pid as a decimal number.
658 This function signals an error if no unique file name could be
662 make_temp_name (Lisp_Object prefix
, int base64_p
)
667 unsigned char *p
, *data
;
671 CHECK_STRING (prefix
);
673 /* VAL is created by adding 6 characters to PREFIX. The first
674 three are the PID of this process, in base 64, and the second
675 three are incremented if the file already exists. This ensures
676 262144 unique file names per PID per PREFIX. */
678 pid
= (int) getpid ();
682 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
683 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
684 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
689 #ifdef HAVE_LONG_FILE_NAMES
690 sprintf (pidbuf
, "%d", pid
);
691 pidlen
= strlen (pidbuf
);
693 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
694 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
695 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
700 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
701 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
702 if (!STRING_MULTIBYTE (prefix
))
703 STRING_SET_UNIBYTE (val
);
705 memcpy (data
, SDATA (prefix
), len
);
708 memcpy (p
, pidbuf
, pidlen
);
711 /* Here we try to minimize useless stat'ing when this function is
712 invoked many times successively with the same PREFIX. We achieve
713 this by initializing count to a random value, and incrementing it
716 We don't want make-temp-name to be called while dumping,
717 because then make_temp_name_count_initialized_p would get set
718 and then make_temp_name_count would not be set when Emacs starts. */
720 if (!make_temp_name_count_initialized_p
)
722 make_temp_name_count
= (unsigned) time (NULL
);
723 make_temp_name_count_initialized_p
= 1;
729 unsigned num
= make_temp_name_count
;
731 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
732 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
733 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
735 /* Poor man's congruential RN generator. Replace with
736 ++make_temp_name_count for debugging. */
737 make_temp_name_count
+= 25229;
738 make_temp_name_count
%= 225307;
740 if (stat (data
, &ignored
) < 0)
742 /* We want to return only if errno is ENOENT. */
746 /* The error here is dubious, but there is little else we
747 can do. The alternatives are to return nil, which is
748 as bad as (and in many cases worse than) throwing the
749 error, or to ignore the error, which will likely result
750 in looping through 225307 stat's, which is not only
751 dog-slow, but also useless since it will fallback to
752 the errow below, anyway. */
753 report_file_error ("Cannot create temporary name for prefix",
754 Fcons (prefix
, Qnil
));
759 error ("Cannot create temporary name for prefix `%s'",
765 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
766 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
767 The Emacs process number forms part of the result,
768 so there is no danger of generating a name being used by another process.
770 In addition, this function makes an attempt to choose a name
771 which has no existing file. To make this work,
772 PREFIX should be an absolute file name.
774 There is a race condition between calling `make-temp-name' and creating the
775 file which opens all kinds of security holes. For that reason, you should
776 probably use `make-temp-file' instead, except in three circumstances:
778 * If you are creating the file in the user's home directory.
779 * If you are creating a directory rather than an ordinary file.
780 * If you are taking special precautions as `make-temp-file' does. */)
783 return make_temp_name (prefix
, 0);
788 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
789 doc
: /* Convert filename NAME to absolute, and canonicalize it.
790 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
791 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
792 the current buffer's value of `default-directory' is used.
793 File name components that are `.' are removed, and
794 so are file name components followed by `..', along with the `..' itself;
795 note that these simplifications are done without checking the resulting
796 file names in the file system.
797 An initial `~/' expands to your home directory.
798 An initial `~USER/' expands to USER's home directory.
799 See also the function `substitute-in-file-name'.
801 For technical reasons, this function can return correct but
802 non-intuitive results for the root directory; for instance,
803 \(expand-file-name ".." "/") returns "/..". For this reason, use
804 (directory-file-name (file-name-directory dirname)) to traverse a
805 filesystem tree, not (expand-file-name ".." dirname). */)
806 (Lisp_Object name
, Lisp_Object default_directory
)
808 /* These point to SDATA and need to be careful with string-relocation
809 during GC (via DECODE_FILE). */
810 unsigned char *nm
, *newdir
;
811 /* This should only point to alloca'd data. */
812 unsigned char *target
;
818 int collapse_newdir
= 1;
822 Lisp_Object handler
, result
;
828 /* If the file name has special constructs in it,
829 call the corresponding file handler. */
830 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
832 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
834 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
835 if (NILP (default_directory
))
836 default_directory
= current_buffer
->directory
;
837 if (! STRINGP (default_directory
))
840 /* "/" is not considered a root directory on DOS_NT, so using "/"
841 here causes an infinite recursion in, e.g., the following:
843 (let (default-directory)
844 (expand-file-name "a"))
846 To avoid this, we set default_directory to the root of the
848 default_directory
= build_string (emacs_root_dir ());
850 default_directory
= build_string ("/");
854 if (!NILP (default_directory
))
856 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
858 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
862 unsigned char *o
= SDATA (default_directory
);
864 /* Make sure DEFAULT_DIRECTORY is properly expanded.
865 It would be better to do this down below where we actually use
866 default_directory. Unfortunately, calling Fexpand_file_name recursively
867 could invoke GC, and the strings might be relocated. This would
868 be annoying because we have pointers into strings lying around
869 that would need adjusting, and people would add new pointers to
870 the code and forget to adjust them, resulting in intermittent bugs.
871 Putting this call here avoids all that crud.
873 The EQ test avoids infinite recursion. */
874 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
875 /* Save time in some common cases - as long as default_directory
876 is not relative, it can be canonicalized with name below (if it
877 is needed at all) without requiring it to be expanded now. */
879 /* Detect MSDOS file names with drive specifiers. */
880 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
881 && IS_DIRECTORY_SEP (o
[2]))
883 /* Detect Windows file names in UNC format. */
884 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
886 #else /* not DOS_NT */
887 /* Detect Unix absolute file names (/... alone is not absolute on
889 && ! (IS_DIRECTORY_SEP (o
[0]))
890 #endif /* not DOS_NT */
896 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
900 name
= FILE_SYSTEM_CASE (name
);
901 multibyte
= STRING_MULTIBYTE (name
);
902 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
905 default_directory
= string_to_multibyte (default_directory
);
908 name
= string_to_multibyte (name
);
913 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
914 nm
= (unsigned char *) alloca (SBYTES (name
) + 1);
915 memcpy (nm
, SDATA (name
), SBYTES (name
) + 1);
918 /* Note if special escape prefix is present, but remove for now. */
919 if (nm
[0] == '/' && nm
[1] == ':')
925 /* Find and remove drive specifier if present; this makes nm absolute
926 even if the rest of the name appears to be relative. Only look for
927 drive specifier at the beginning. */
928 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
935 /* If we see "c://somedir", we want to strip the first slash after the
936 colon when stripping the drive letter. Otherwise, this expands to
938 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
941 /* Discard any previous drive specifier if nm is now in UNC format. */
942 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
946 #endif /* WINDOWSNT */
949 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
950 none are found, we can probably return right away. We will avoid
951 allocating a new string if name is already fully expanded. */
953 IS_DIRECTORY_SEP (nm
[0])
955 && drive
&& !is_escaped
958 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
962 /* If it turns out that the filename we want to return is just a
963 suffix of FILENAME, we don't need to go through and edit
964 things; we just need to construct a new string using data
965 starting at the middle of FILENAME. If we set lose to a
966 non-zero value, that means we've discovered that we can't do
969 unsigned char *p
= nm
;
973 /* Since we know the name is absolute, we can assume that each
974 element starts with a "/". */
976 /* "." and ".." are hairy. */
977 if (IS_DIRECTORY_SEP (p
[0])
979 && (IS_DIRECTORY_SEP (p
[2])
981 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
984 /* We want to replace multiple `/' in a row with a single
987 && IS_DIRECTORY_SEP (p
[0])
988 && IS_DIRECTORY_SEP (p
[1]))
995 /* Make sure directories are all separated with /, but
996 avoid allocation of a new string when not required. */
997 dostounix_filename (nm
);
999 if (IS_DIRECTORY_SEP (nm
[1]))
1001 if (strcmp (nm
, SDATA (name
)) != 0)
1002 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1006 /* drive must be set, so this is okay */
1007 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1011 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1012 temp
[0] = DRIVE_LETTER (drive
);
1013 name
= concat2 (build_string (temp
), name
);
1016 #else /* not DOS_NT */
1017 if (strcmp (nm
, SDATA (name
)) == 0)
1019 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1020 #endif /* not DOS_NT */
1024 /* At this point, nm might or might not be an absolute file name. We
1025 need to expand ~ or ~user if present, otherwise prefix nm with
1026 default_directory if nm is not absolute, and finally collapse /./
1027 and /foo/../ sequences.
1029 We set newdir to be the appropriate prefix if one is needed:
1030 - the relevant user directory if nm starts with ~ or ~user
1031 - the specified drive's working dir (DOS/NT only) if nm does not
1033 - the value of default_directory.
1035 Note that these prefixes are not guaranteed to be absolute (except
1036 for the working dir of a drive). Therefore, to ensure we always
1037 return an absolute name, if the final prefix is not absolute we
1038 append it to the current working directory. */
1042 if (nm
[0] == '~') /* prefix ~ */
1044 if (IS_DIRECTORY_SEP (nm
[1])
1045 || nm
[1] == 0) /* ~ by itself */
1049 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1050 newdir
= (unsigned char *) "";
1052 /* egetenv may return a unibyte string, which will bite us since
1053 we expect the directory to be multibyte. */
1054 tem
= build_string (newdir
);
1055 if (!STRING_MULTIBYTE (tem
))
1057 hdir
= DECODE_FILE (tem
);
1058 newdir
= SDATA (hdir
);
1061 collapse_newdir
= 0;
1064 else /* ~user/filename */
1066 unsigned char *o
, *p
;
1067 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)); p
++);
1068 o
= alloca (p
- nm
+ 1);
1069 memcpy (o
, nm
, p
- nm
);
1073 pw
= (struct passwd
*) getpwnam (o
+ 1);
1077 newdir
= (unsigned char *) pw
-> pw_dir
;
1080 collapse_newdir
= 0;
1084 /* If we don't find a user of that name, leave the name
1085 unchanged; don't move nm forward to p. */
1090 /* On DOS and Windows, nm is absolute if a drive name was specified;
1091 use the drive's current directory as the prefix if needed. */
1092 if (!newdir
&& drive
)
1094 /* Get default directory if needed to make nm absolute. */
1095 if (!IS_DIRECTORY_SEP (nm
[0]))
1097 newdir
= alloca (MAXPATHLEN
+ 1);
1098 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1103 /* Either nm starts with /, or drive isn't mounted. */
1104 newdir
= alloca (4);
1105 newdir
[0] = DRIVE_LETTER (drive
);
1113 /* Finally, if no prefix has been specified and nm is not absolute,
1114 then it must be expanded relative to default_directory. */
1118 /* /... alone is not absolute on DOS and Windows. */
1119 && !IS_DIRECTORY_SEP (nm
[0])
1122 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1126 newdir
= SDATA (default_directory
);
1128 /* Note if special escape prefix is present, but remove for now. */
1129 if (newdir
[0] == '/' && newdir
[1] == ':')
1140 /* First ensure newdir is an absolute name. */
1142 /* Detect MSDOS file names with drive specifiers. */
1143 ! (IS_DRIVE (newdir
[0])
1144 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1146 /* Detect Windows file names in UNC format. */
1147 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1151 /* Effectively, let newdir be (expand-file-name newdir cwd).
1152 Because of the admonition against calling expand-file-name
1153 when we have pointers into lisp strings, we accomplish this
1154 indirectly by prepending newdir to nm if necessary, and using
1155 cwd (or the wd of newdir's drive) as the new newdir. */
1157 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1162 if (!IS_DIRECTORY_SEP (nm
[0]))
1164 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1165 file_name_as_directory (tmp
, newdir
);
1169 newdir
= alloca (MAXPATHLEN
+ 1);
1172 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1179 /* Strip off drive name from prefix, if present. */
1180 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1186 /* Keep only a prefix from newdir if nm starts with slash
1187 (//server/share for UNC, nothing otherwise). */
1188 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1191 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1194 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1196 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1198 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1210 /* Get rid of any slash at the end of newdir, unless newdir is
1211 just / or // (an incomplete UNC name). */
1212 length
= strlen (newdir
);
1213 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1215 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1219 unsigned char *temp
= (unsigned char *) alloca (length
);
1220 memcpy (temp
, newdir
, length
- 1);
1221 temp
[length
- 1] = 0;
1229 /* Now concatenate the directory and name to new space in the stack frame */
1230 tlen
+= strlen (nm
) + 1;
1232 /* Reserve space for drive specifier and escape prefix, since either
1233 or both may need to be inserted. (The Microsoft x86 compiler
1234 produces incorrect code if the following two lines are combined.) */
1235 target
= (unsigned char *) alloca (tlen
+ 4);
1237 #else /* not DOS_NT */
1238 target
= (unsigned char *) alloca (tlen
);
1239 #endif /* not DOS_NT */
1244 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1247 /* If newdir is effectively "C:/", then the drive letter will have
1248 been stripped and newdir will be "/". Concatenating with an
1249 absolute directory in nm produces "//", which will then be
1250 incorrectly treated as a network share. Ignore newdir in
1251 this case (keeping the drive letter). */
1252 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1253 && newdir
[1] == '\0'))
1255 strcpy (target
, newdir
);
1258 file_name_as_directory (target
, newdir
);
1261 strcat (target
, nm
);
1263 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1266 unsigned char *p
= target
;
1267 unsigned char *o
= target
;
1271 if (!IS_DIRECTORY_SEP (*p
))
1275 else if (p
[1] == '.'
1276 && (IS_DIRECTORY_SEP (p
[2])
1279 /* If "/." is the entire filename, keep the "/". Otherwise,
1280 just delete the whole "/.". */
1281 if (o
== target
&& p
[2] == '\0')
1285 else if (p
[1] == '.' && p
[2] == '.'
1286 /* `/../' is the "superroot" on certain file systems.
1287 Turned off on DOS_NT systems because they have no
1288 "superroot" and because this causes us to produce
1289 file names like "d:/../foo" which fail file-related
1290 functions of the underlying OS. (To reproduce, try a
1291 long series of "../../" in default_directory, longer
1292 than the number of levels from the root.) */
1296 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1299 unsigned char *prev_o
= o
;
1301 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1304 /* Don't go below server level in UNC filenames. */
1305 if (o
== target
+ 1 && IS_DIRECTORY_SEP (*o
)
1306 && IS_DIRECTORY_SEP (*target
))
1310 /* Keep initial / only if this is the whole name. */
1311 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1315 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1316 /* Collapse multiple `/' in a row. */
1325 /* At last, set drive name. */
1327 /* Except for network file name. */
1328 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1329 #endif /* WINDOWSNT */
1331 if (!drive
) abort ();
1333 target
[0] = DRIVE_LETTER (drive
);
1336 /* Reinsert the escape prefix if required. */
1343 dostounix_filename (target
);
1346 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1349 /* Again look to see if the file name has special constructs in it
1350 and perhaps call the corresponding file handler. This is needed
1351 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1352 the ".." component gives us "/user@host:/bar/../baz" which needs
1353 to be expanded again. */
1354 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1355 if (!NILP (handler
))
1356 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1362 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1363 This is the old version of expand-file-name, before it was thoroughly
1364 rewritten for Emacs 10.31. We leave this version here commented-out,
1365 because the code is very complex and likely to have subtle bugs. If
1366 bugs _are_ found, it might be of interest to look at the old code and
1367 see what did it do in the relevant situation.
1369 Don't remove this code: it's true that it will be accessible
1370 from the repository, but a few years from deletion, people will
1371 forget it is there. */
1373 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1374 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1375 "Convert FILENAME to absolute, and canonicalize it.\n\
1376 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1377 \(does not start with slash); if DEFAULT is nil or missing,\n\
1378 the current buffer's value of default-directory is used.\n\
1379 Filenames containing `.' or `..' as components are simplified;\n\
1380 initial `~/' expands to your home directory.\n\
1381 See also the function `substitute-in-file-name'.")
1383 Lisp_Object name
, defalt
;
1387 register unsigned char *newdir
, *p
, *o
;
1389 unsigned char *target
;
1393 CHECK_STRING (name
);
1396 /* If nm is absolute, flush ...// and detect /./ and /../.
1397 If no /./ or /../ we can return right away. */
1404 if (p
[0] == '/' && p
[1] == '/'
1407 if (p
[0] == '/' && p
[1] == '~')
1408 nm
= p
+ 1, lose
= 1;
1409 if (p
[0] == '/' && p
[1] == '.'
1410 && (p
[2] == '/' || p
[2] == 0
1411 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1417 if (nm
== SDATA (name
))
1419 return build_string (nm
);
1423 /* Now determine directory to start with and put it in NEWDIR */
1427 if (nm
[0] == '~') /* prefix ~ */
1428 if (nm
[1] == '/' || nm
[1] == 0)/* ~/filename */
1430 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1431 newdir
= (unsigned char *) "";
1434 else /* ~user/filename */
1436 /* Get past ~ to user */
1437 unsigned char *user
= nm
+ 1;
1438 /* Find end of name. */
1439 unsigned char *ptr
= (unsigned char *) strchr (user
, '/');
1440 int len
= ptr
? ptr
- user
: strlen (user
);
1441 /* Copy the user name into temp storage. */
1442 o
= (unsigned char *) alloca (len
+ 1);
1443 memcpy (o
, user
, len
);
1446 /* Look up the user name. */
1448 pw
= (struct passwd
*) getpwnam (o
+ 1);
1451 error ("\"%s\" isn't a registered user", o
+ 1);
1453 newdir
= (unsigned char *) pw
->pw_dir
;
1455 /* Discard the user name from NM. */
1459 if (nm
[0] != '/' && !newdir
)
1462 defalt
= current_buffer
->directory
;
1463 CHECK_STRING (defalt
);
1464 newdir
= SDATA (defalt
);
1467 /* Now concatenate the directory and name to new space in the stack frame */
1469 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1470 target
= (unsigned char *) alloca (tlen
);
1475 if (nm
[0] == 0 || nm
[0] == '/')
1476 strcpy (target
, newdir
);
1478 file_name_as_directory (target
, newdir
);
1481 strcat (target
, nm
);
1483 /* Now canonicalize by removing /. and /foo/.. if they appear */
1494 else if (!strncmp (p
, "//", 2)
1500 else if (p
[0] == '/' && p
[1] == '.'
1501 && (p
[2] == '/' || p
[2] == 0))
1503 else if (!strncmp (p
, "/..", 3)
1504 /* `/../' is the "superroot" on certain file systems. */
1506 && (p
[3] == '/' || p
[3] == 0))
1508 while (o
!= target
&& *--o
!= '/')
1510 if (o
== target
&& *o
== '/')
1520 return make_string (target
, o
- target
);
1524 /* If /~ or // appears, discard everything through first slash. */
1526 file_name_absolute_p (const unsigned char *filename
)
1529 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
1531 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
1532 && IS_DIRECTORY_SEP (filename
[2]))
1537 static unsigned char *
1538 search_embedded_absfilename (unsigned char *nm
, unsigned char *endp
)
1540 unsigned char *p
, *s
;
1542 for (p
= nm
+ 1; p
< endp
; p
++)
1545 || IS_DIRECTORY_SEP (p
[-1]))
1546 && file_name_absolute_p (p
)
1547 #if defined (WINDOWSNT) || defined(CYGWIN)
1548 /* // at start of file name is meaningful in Apollo,
1549 WindowsNT and Cygwin systems. */
1550 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
1551 #endif /* not (WINDOWSNT || CYGWIN) */
1554 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)); s
++);
1555 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
1557 unsigned char *o
= alloca (s
- p
+ 1);
1559 memcpy (o
, p
, s
- p
);
1562 /* If we have ~user and `user' exists, discard
1563 everything up to ~. But if `user' does not exist, leave
1564 ~user alone, it might be a literal file name. */
1566 pw
= getpwnam (o
+ 1);
1578 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1579 Ssubstitute_in_file_name
, 1, 1, 0,
1580 doc
: /* Substitute environment variables referred to in FILENAME.
1581 `$FOO' where FOO is an environment variable name means to substitute
1582 the value of that variable. The variable name should be terminated
1583 with a character not a letter, digit or underscore; otherwise, enclose
1584 the entire variable name in braces.
1586 If `/~' appears, all of FILENAME through that `/' is discarded.
1587 If `//' appears, everything up to and including the first of
1588 those `/' is discarded. */)
1589 (Lisp_Object filename
)
1593 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1594 unsigned char *target
= NULL
;
1596 int substituted
= 0;
1599 Lisp_Object handler
;
1601 CHECK_STRING (filename
);
1603 multibyte
= STRING_MULTIBYTE (filename
);
1605 /* If the file name has special constructs in it,
1606 call the corresponding file handler. */
1607 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1608 if (!NILP (handler
))
1609 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1611 /* Always work on a copy of the string, in case GC happens during
1612 decode of environment variables, causing the original Lisp_String
1613 data to be relocated. */
1614 nm
= (unsigned char *) alloca (SBYTES (filename
) + 1);
1615 memcpy (nm
, SDATA (filename
), SBYTES (filename
) + 1);
1618 dostounix_filename (nm
);
1619 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
1621 endp
= nm
+ SBYTES (filename
);
1623 /* If /~ or // appears, discard everything through first slash. */
1624 p
= search_embedded_absfilename (nm
, endp
);
1626 /* Start over with the new string, so we check the file-name-handler
1627 again. Important with filenames like "/home/foo//:/hello///there"
1628 which whould substitute to "/:/hello///there" rather than "/there". */
1629 return Fsubstitute_in_file_name
1630 (make_specified_string (p
, -1, endp
- p
, multibyte
));
1632 /* See if any variables are substituted into the string
1633 and find the total length of their values in `total' */
1635 for (p
= nm
; p
!= endp
;)
1645 /* "$$" means a single "$" */
1654 while (p
!= endp
&& *p
!= '}') p
++;
1655 if (*p
!= '}') goto missingclose
;
1661 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1665 /* Copy out the variable name */
1666 target
= (unsigned char *) alloca (s
- o
+ 1);
1667 strncpy (target
, o
, s
- o
);
1670 strupr (target
); /* $home == $HOME etc. */
1673 /* Get variable value */
1674 o
= (unsigned char *) egetenv (target
);
1677 /* Don't try to guess a maximum length - UTF8 can use up to
1678 four bytes per character. This code is unlikely to run
1679 in a situation that requires performance, so decoding the
1680 env variables twice should be acceptable. Note that
1681 decoding may cause a garbage collect. */
1682 Lisp_Object orig
, decoded
;
1683 orig
= make_unibyte_string (o
, strlen (o
));
1684 decoded
= DECODE_FILE (orig
);
1685 total
+= SBYTES (decoded
);
1695 /* If substitution required, recopy the string and do it */
1696 /* Make space in stack frame for the new copy */
1697 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
1700 /* Copy the rest of the name through, replacing $ constructs with values */
1717 while (p
!= endp
&& *p
!= '}') p
++;
1718 if (*p
!= '}') goto missingclose
;
1724 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1728 /* Copy out the variable name */
1729 target
= (unsigned char *) alloca (s
- o
+ 1);
1730 strncpy (target
, o
, s
- o
);
1733 strupr (target
); /* $home == $HOME etc. */
1736 /* Get variable value */
1737 o
= (unsigned char *) egetenv (target
);
1741 strcpy (x
, target
); x
+= strlen (target
);
1745 Lisp_Object orig
, decoded
;
1746 int orig_length
, decoded_length
;
1747 orig_length
= strlen (o
);
1748 orig
= make_unibyte_string (o
, orig_length
);
1749 decoded
= DECODE_FILE (orig
);
1750 decoded_length
= SBYTES (decoded
);
1751 strncpy (x
, SDATA (decoded
), decoded_length
);
1752 x
+= decoded_length
;
1754 /* If environment variable needed decoding, return value
1755 needs to be multibyte. */
1756 if (decoded_length
!= orig_length
1757 || strncmp (SDATA (decoded
), o
, orig_length
))
1764 /* If /~ or // appears, discard everything through first slash. */
1765 while ((p
= search_embedded_absfilename (xnm
, x
)))
1766 /* This time we do not start over because we've already expanded envvars
1767 and replaced $$ with $. Maybe we should start over as well, but we'd
1768 need to quote some $ to $$ first. */
1771 return make_specified_string (xnm
, -1, x
- xnm
, multibyte
);
1774 error ("Bad format environment-variable substitution");
1776 error ("Missing \"}\" in environment-variable substitution");
1778 error ("Substituting nonexistent environment variable \"%s\"", target
);
1784 /* A slightly faster and more convenient way to get
1785 (directory-file-name (expand-file-name FOO)). */
1788 expand_and_dir_to_file (Lisp_Object filename
, Lisp_Object defdir
)
1790 register Lisp_Object absname
;
1792 absname
= Fexpand_file_name (filename
, defdir
);
1794 /* Remove final slash, if any (unless this is the root dir).
1795 stat behaves differently depending! */
1796 if (SCHARS (absname
) > 1
1797 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
1798 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
1799 /* We cannot take shortcuts; they might be wrong for magic file names. */
1800 absname
= Fdirectory_file_name (absname
);
1804 /* Signal an error if the file ABSNAME already exists.
1805 If INTERACTIVE is nonzero, ask the user whether to proceed,
1806 and bypass the error if the user says to go ahead.
1807 QUERYSTRING is a name for the action that is being considered
1810 *STATPTR is used to store the stat information if the file exists.
1811 If the file does not exist, STATPTR->st_mode is set to 0.
1812 If STATPTR is null, we don't store into it.
1814 If QUICK is nonzero, we ask for y or n, not yes or no. */
1817 barf_or_query_if_file_exists (Lisp_Object absname
, const unsigned char *querystring
, int interactive
, struct stat
*statptr
, int quick
)
1819 register Lisp_Object tem
, encoded_filename
;
1820 struct stat statbuf
;
1821 struct gcpro gcpro1
;
1823 encoded_filename
= ENCODE_FILE (absname
);
1825 /* stat is a good way to tell whether the file exists,
1826 regardless of what access permissions it has. */
1827 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
1830 xsignal2 (Qfile_already_exists
,
1831 build_string ("File already exists"), absname
);
1833 tem
= format2 ("File %s already exists; %s anyway? ",
1834 absname
, build_string (querystring
));
1836 tem
= call1 (intern ("y-or-n-p"), tem
);
1838 tem
= do_yes_or_no_p (tem
);
1841 xsignal2 (Qfile_already_exists
,
1842 build_string ("File already exists"), absname
);
1849 statptr
->st_mode
= 0;
1854 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
1855 "fCopy file: \nGCopy %s to file: \np\nP",
1856 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
1857 If NEWNAME names a directory, copy FILE there.
1859 This function always sets the file modes of the output file to match
1862 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1863 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1864 signal a `file-already-exists' error without overwriting. If
1865 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1866 about overwriting; this is what happens in interactive use with M-x.
1867 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1870 Fourth arg KEEP-TIME non-nil means give the output file the same
1871 last-modified time as the old one. (This works on only some systems.)
1873 A prefix arg makes KEEP-TIME non-nil.
1875 If PRESERVE-UID-GID is non-nil, we try to transfer the
1876 uid and gid of FILE to NEWNAME.
1878 If PRESERVE-SELINUX-CONTEXT is non-nil and SELinux is enabled
1879 on the system, we copy the SELinux context of FILE to NEWNAME. */)
1880 (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
)
1883 char buf
[16 * 1024];
1884 struct stat st
, out_st
;
1885 Lisp_Object handler
;
1886 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1887 int count
= SPECPDL_INDEX ();
1888 int input_file_statable_p
;
1889 Lisp_Object encoded_file
, encoded_newname
;
1891 security_context_t con
;
1892 int fail
, conlength
= 0;
1895 encoded_file
= encoded_newname
= Qnil
;
1896 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
1897 CHECK_STRING (file
);
1898 CHECK_STRING (newname
);
1900 if (!NILP (Ffile_directory_p (newname
)))
1901 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
1903 newname
= Fexpand_file_name (newname
, Qnil
);
1905 file
= Fexpand_file_name (file
, Qnil
);
1907 /* If the input file name has special constructs in it,
1908 call the corresponding file handler. */
1909 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1910 /* Likewise for output file name. */
1912 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1913 if (!NILP (handler
))
1914 RETURN_UNGCPRO (call7 (handler
, Qcopy_file
, file
, newname
,
1915 ok_if_already_exists
, keep_time
, preserve_uid_gid
,
1916 preserve_selinux_context
));
1918 encoded_file
= ENCODE_FILE (file
);
1919 encoded_newname
= ENCODE_FILE (newname
);
1921 if (NILP (ok_if_already_exists
)
1922 || INTEGERP (ok_if_already_exists
))
1923 barf_or_query_if_file_exists (newname
, "copy to it",
1924 INTEGERP (ok_if_already_exists
), &out_st
, 0);
1925 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
1929 if (!CopyFile (SDATA (encoded_file
),
1930 SDATA (encoded_newname
),
1932 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
1933 /* CopyFile retains the timestamp by default. */
1934 else if (NILP (keep_time
))
1940 EMACS_GET_TIME (now
);
1941 filename
= SDATA (encoded_newname
);
1943 /* Ensure file is writable while its modified time is set. */
1944 attributes
= GetFileAttributes (filename
);
1945 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
1946 if (set_file_times (filename
, now
, now
))
1948 /* Restore original attributes. */
1949 SetFileAttributes (filename
, attributes
);
1950 xsignal2 (Qfile_date_error
,
1951 build_string ("Cannot set file date"), newname
);
1953 /* Restore original attributes. */
1954 SetFileAttributes (filename
, attributes
);
1956 #else /* not WINDOWSNT */
1958 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
1962 report_file_error ("Opening input file", Fcons (file
, Qnil
));
1964 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1966 /* We can only copy regular files and symbolic links. Other files are not
1968 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1971 if (!NILP (preserve_selinux_context
) && is_selinux_enabled ())
1973 conlength
= fgetfilecon (ifd
, &con
);
1974 if (conlength
== -1)
1975 report_file_error ("Doing fgetfilecon", Fcons (file
, Qnil
));
1979 if (out_st
.st_mode
!= 0
1980 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
1983 report_file_error ("Input and output files are the same",
1984 Fcons (file
, Fcons (newname
, Qnil
)));
1987 #if defined (S_ISREG) && defined (S_ISLNK)
1988 if (input_file_statable_p
)
1990 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1992 #if defined (EISDIR)
1993 /* Get a better looking error message. */
1996 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
1999 #endif /* S_ISREG && S_ISLNK */
2002 /* System's default file type was set to binary by _fmode in emacs.c. */
2003 ofd
= emacs_open (SDATA (encoded_newname
),
2004 O_WRONLY
| O_TRUNC
| O_CREAT
2005 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2006 S_IREAD
| S_IWRITE
);
2007 #else /* not MSDOS */
2008 ofd
= emacs_open (SDATA (encoded_newname
),
2009 O_WRONLY
| O_TRUNC
| O_CREAT
2010 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2012 #endif /* not MSDOS */
2014 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2016 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2020 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2021 if (emacs_write (ofd
, buf
, n
) != n
)
2022 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2026 /* Preserve the original file modes, and if requested, also its
2028 if (input_file_statable_p
)
2030 if (! NILP (preserve_uid_gid
))
2031 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2032 fchmod (ofd
, st
.st_mode
& 07777);
2034 #endif /* not MSDOS */
2039 /* Set the modified context back to the file. */
2040 fail
= fsetfilecon (ofd
, con
);
2042 report_file_error ("Doing fsetfilecon", Fcons (newname
, Qnil
));
2048 /* Closing the output clobbers the file times on some systems. */
2049 if (emacs_close (ofd
) < 0)
2050 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2052 if (input_file_statable_p
)
2054 if (!NILP (keep_time
))
2056 EMACS_TIME atime
, mtime
;
2057 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2058 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2059 if (set_file_times (SDATA (encoded_newname
),
2061 xsignal2 (Qfile_date_error
,
2062 build_string ("Cannot set file date"), newname
);
2069 if (input_file_statable_p
)
2071 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2072 and if it can't, it tells so. Otherwise, under MSDOS we usually
2073 get only the READ bit, which will make the copied file read-only,
2074 so it's better not to chmod at all. */
2075 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2076 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2079 #endif /* not WINDOWSNT */
2081 /* Discard the unwind protects. */
2082 specpdl_ptr
= specpdl
+ count
;
2088 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2089 Smake_directory_internal
, 1, 1, 0,
2090 doc
: /* Create a new directory named DIRECTORY. */)
2091 (Lisp_Object directory
)
2093 const unsigned char *dir
;
2094 Lisp_Object handler
;
2095 Lisp_Object encoded_dir
;
2097 CHECK_STRING (directory
);
2098 directory
= Fexpand_file_name (directory
, Qnil
);
2100 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2101 if (!NILP (handler
))
2102 return call2 (handler
, Qmake_directory_internal
, directory
);
2104 encoded_dir
= ENCODE_FILE (directory
);
2106 dir
= SDATA (encoded_dir
);
2109 if (mkdir (dir
) != 0)
2111 if (mkdir (dir
, 0777) != 0)
2113 report_file_error ("Creating directory", list1 (directory
));
2118 DEFUN ("delete-directory-internal", Fdelete_directory_internal
,
2119 Sdelete_directory_internal
, 1, 1, 0,
2120 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2121 (Lisp_Object directory
)
2123 const unsigned char *dir
;
2124 Lisp_Object handler
;
2125 Lisp_Object encoded_dir
;
2127 CHECK_STRING (directory
);
2128 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2129 encoded_dir
= ENCODE_FILE (directory
);
2130 dir
= SDATA (encoded_dir
);
2132 if (rmdir (dir
) != 0)
2133 report_file_error ("Removing directory", list1 (directory
));
2138 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 2,
2139 "(list (read-file-name \
2140 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2141 \"Move file to trash: \" \"Delete file: \") \
2142 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2143 (null current-prefix-arg))",
2144 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2145 If file has multiple names, it continues to exist with the other names.
2146 TRASH non-nil means to trash the file instead of deleting, provided
2147 `delete-by-moving-to-trash' is non-nil.
2149 When called interactively, TRASH is t if no prefix argument is given.
2150 With a prefix argument, TRASH is nil. */)
2151 (Lisp_Object filename
, Lisp_Object trash
)
2153 Lisp_Object handler
;
2154 Lisp_Object encoded_file
;
2155 struct gcpro gcpro1
;
2158 if (!NILP (Ffile_directory_p (filename
))
2159 && NILP (Ffile_symlink_p (filename
)))
2160 xsignal2 (Qfile_error
,
2161 build_string ("Removing old name: is a directory"),
2164 filename
= Fexpand_file_name (filename
, Qnil
);
2166 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2167 if (!NILP (handler
))
2168 return call3 (handler
, Qdelete_file
, filename
, trash
);
2170 if (delete_by_moving_to_trash
&& !NILP (trash
))
2171 return call1 (Qmove_file_to_trash
, filename
);
2173 encoded_file
= ENCODE_FILE (filename
);
2175 if (0 > unlink (SDATA (encoded_file
)))
2176 report_file_error ("Removing old name", list1 (filename
));
2181 internal_delete_file_1 (Lisp_Object ignore
)
2186 /* Delete file FILENAME, returning 1 if successful and 0 if failed.
2187 This ignores `delete-by-moving-to-trash'. */
2190 internal_delete_file (Lisp_Object filename
)
2194 tem
= internal_condition_case_2 (Fdelete_file
, filename
, Qnil
,
2195 Qt
, internal_delete_file_1
);
2199 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2200 "fRename file: \nGRename %s to file: \np",
2201 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2202 If file has names other than FILE, it continues to have those names.
2203 Signals a `file-already-exists' error if a file NEWNAME already exists
2204 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2205 A number as third arg means request confirmation if NEWNAME already exists.
2206 This is what happens in interactive use with M-x. */)
2207 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2209 Lisp_Object handler
;
2210 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2211 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2213 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2214 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2215 CHECK_STRING (file
);
2216 CHECK_STRING (newname
);
2217 file
= Fexpand_file_name (file
, Qnil
);
2219 if ((!NILP (Ffile_directory_p (newname
)))
2221 /* If the file names are identical but for the case,
2222 don't attempt to move directory to itself. */
2223 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2227 Lisp_Object fname
= NILP (Ffile_directory_p (file
))
2228 ? file
: Fdirectory_file_name (file
);
2229 newname
= Fexpand_file_name (Ffile_name_nondirectory (fname
), newname
);
2232 newname
= Fexpand_file_name (newname
, Qnil
);
2234 /* If the file name has special constructs in it,
2235 call the corresponding file handler. */
2236 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2238 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2239 if (!NILP (handler
))
2240 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2241 file
, newname
, ok_if_already_exists
));
2243 encoded_file
= ENCODE_FILE (file
);
2244 encoded_newname
= ENCODE_FILE (newname
);
2247 /* If the file names are identical but for the case, don't ask for
2248 confirmation: they simply want to change the letter-case of the
2250 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2252 if (NILP (ok_if_already_exists
)
2253 || INTEGERP (ok_if_already_exists
))
2254 barf_or_query_if_file_exists (newname
, "rename to it",
2255 INTEGERP (ok_if_already_exists
), 0, 0);
2256 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2262 symlink_target
= Ffile_symlink_p (file
);
2263 if (! NILP (symlink_target
))
2264 Fmake_symbolic_link (symlink_target
, newname
,
2265 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2268 if (!NILP (Ffile_directory_p (file
)))
2269 call4 (Qcopy_directory
, file
, newname
, Qt
, Qnil
);
2271 /* We have already prompted if it was an integer, so don't
2272 have copy-file prompt again. */
2273 Fcopy_file (file
, newname
,
2274 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2277 count
= SPECPDL_INDEX ();
2278 specbind (Qdelete_by_moving_to_trash
, Qnil
);
2280 if (!NILP (Ffile_directory_p (file
))
2282 && NILP (symlink_target
)
2285 call2 (Qdelete_directory
, file
, Qt
);
2287 Fdelete_file (file
, Qnil
);
2288 unbind_to (count
, Qnil
);
2291 report_file_error ("Renaming", list2 (file
, newname
));
2297 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2298 "fAdd name to file: \nGName to add to %s: \np",
2299 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2300 Signals a `file-already-exists' error if a file NEWNAME already exists
2301 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2302 A number as third arg means request confirmation if NEWNAME already exists.
2303 This is what happens in interactive use with M-x. */)
2304 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2306 Lisp_Object handler
;
2307 Lisp_Object encoded_file
, encoded_newname
;
2308 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2310 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2311 encoded_file
= encoded_newname
= Qnil
;
2312 CHECK_STRING (file
);
2313 CHECK_STRING (newname
);
2314 file
= Fexpand_file_name (file
, Qnil
);
2316 if (!NILP (Ffile_directory_p (newname
)))
2317 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2319 newname
= Fexpand_file_name (newname
, Qnil
);
2321 /* If the file name has special constructs in it,
2322 call the corresponding file handler. */
2323 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2324 if (!NILP (handler
))
2325 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2326 newname
, ok_if_already_exists
));
2328 /* If the new name has special constructs in it,
2329 call the corresponding file handler. */
2330 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2331 if (!NILP (handler
))
2332 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2333 newname
, ok_if_already_exists
));
2335 encoded_file
= ENCODE_FILE (file
);
2336 encoded_newname
= ENCODE_FILE (newname
);
2338 if (NILP (ok_if_already_exists
)
2339 || INTEGERP (ok_if_already_exists
))
2340 barf_or_query_if_file_exists (newname
, "make it a new name",
2341 INTEGERP (ok_if_already_exists
), 0, 0);
2343 unlink (SDATA (newname
));
2344 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2345 report_file_error ("Adding new name", list2 (file
, newname
));
2351 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2352 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2353 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2354 Both args must be strings.
2355 Signals a `file-already-exists' error if a file LINKNAME already exists
2356 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2357 A number as third arg means request confirmation if LINKNAME already exists.
2358 This happens for interactive use with M-x. */)
2359 (Lisp_Object filename
, Lisp_Object linkname
, Lisp_Object ok_if_already_exists
)
2361 Lisp_Object handler
;
2362 Lisp_Object encoded_filename
, encoded_linkname
;
2363 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2365 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2366 encoded_filename
= encoded_linkname
= Qnil
;
2367 CHECK_STRING (filename
);
2368 CHECK_STRING (linkname
);
2369 /* If the link target has a ~, we must expand it to get
2370 a truly valid file name. Otherwise, do not expand;
2371 we want to permit links to relative file names. */
2372 if (SREF (filename
, 0) == '~')
2373 filename
= Fexpand_file_name (filename
, Qnil
);
2375 if (!NILP (Ffile_directory_p (linkname
)))
2376 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2378 linkname
= Fexpand_file_name (linkname
, Qnil
);
2380 /* If the file name has special constructs in it,
2381 call the corresponding file handler. */
2382 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2383 if (!NILP (handler
))
2384 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2385 linkname
, ok_if_already_exists
));
2387 /* If the new link name has special constructs in it,
2388 call the corresponding file handler. */
2389 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2390 if (!NILP (handler
))
2391 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2392 linkname
, ok_if_already_exists
));
2395 encoded_filename
= ENCODE_FILE (filename
);
2396 encoded_linkname
= ENCODE_FILE (linkname
);
2398 if (NILP (ok_if_already_exists
)
2399 || INTEGERP (ok_if_already_exists
))
2400 barf_or_query_if_file_exists (linkname
, "make it a link",
2401 INTEGERP (ok_if_already_exists
), 0, 0);
2402 if (0 > symlink (SDATA (encoded_filename
),
2403 SDATA (encoded_linkname
)))
2405 /* If we didn't complain already, silently delete existing file. */
2406 if (errno
== EEXIST
)
2408 unlink (SDATA (encoded_linkname
));
2409 if (0 <= symlink (SDATA (encoded_filename
),
2410 SDATA (encoded_linkname
)))
2417 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2424 xsignal1 (Qfile_error
, build_string ("Symbolic links are not supported"));
2426 #endif /* S_IFLNK */
2430 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2432 doc
: /* Return t if file FILENAME specifies an absolute file name.
2433 On Unix, this is a name starting with a `/' or a `~'. */)
2434 (Lisp_Object filename
)
2436 CHECK_STRING (filename
);
2437 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
2440 /* Return nonzero if file FILENAME exists and can be executed. */
2443 check_executable (char *filename
)
2446 int len
= strlen (filename
);
2449 if (stat (filename
, &st
) < 0)
2451 return ((st
.st_mode
& S_IEXEC
) != 0);
2452 #else /* not DOS_NT */
2453 #ifdef HAVE_EUIDACCESS
2454 return (euidaccess (filename
, 1) >= 0);
2456 /* Access isn't quite right because it uses the real uid
2457 and we really want to test with the effective uid.
2458 But Unix doesn't give us a right way to do it. */
2459 return (access (filename
, 1) >= 0);
2461 #endif /* not DOS_NT */
2464 /* Return nonzero if file FILENAME exists and can be written. */
2467 check_writable (const char *filename
)
2471 if (stat (filename
, &st
) < 0)
2473 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2474 #else /* not MSDOS */
2475 #ifdef HAVE_EUIDACCESS
2476 return (euidaccess (filename
, 2) >= 0);
2478 /* Access isn't quite right because it uses the real uid
2479 and we really want to test with the effective uid.
2480 But Unix doesn't give us a right way to do it.
2481 Opening with O_WRONLY could work for an ordinary file,
2482 but would lose for directories. */
2483 return (access (filename
, 2) >= 0);
2485 #endif /* not MSDOS */
2488 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2489 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
2490 See also `file-readable-p' and `file-attributes'.
2491 This returns nil for a symlink to a nonexistent file.
2492 Use `file-symlink-p' to test for such links. */)
2493 (Lisp_Object filename
)
2495 Lisp_Object absname
;
2496 Lisp_Object handler
;
2497 struct stat statbuf
;
2499 CHECK_STRING (filename
);
2500 absname
= Fexpand_file_name (filename
, Qnil
);
2502 /* If the file name has special constructs in it,
2503 call the corresponding file handler. */
2504 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2505 if (!NILP (handler
))
2506 return call2 (handler
, Qfile_exists_p
, absname
);
2508 absname
= ENCODE_FILE (absname
);
2510 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
2513 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2514 doc
: /* Return t if FILENAME can be executed by you.
2515 For a directory, this means you can access files in that directory. */)
2516 (Lisp_Object filename
)
2518 Lisp_Object absname
;
2519 Lisp_Object handler
;
2521 CHECK_STRING (filename
);
2522 absname
= Fexpand_file_name (filename
, Qnil
);
2524 /* If the file name has special constructs in it,
2525 call the corresponding file handler. */
2526 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2527 if (!NILP (handler
))
2528 return call2 (handler
, Qfile_executable_p
, absname
);
2530 absname
= ENCODE_FILE (absname
);
2532 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
2535 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2536 doc
: /* Return t if file FILENAME exists and you can read it.
2537 See also `file-exists-p' and `file-attributes'. */)
2538 (Lisp_Object filename
)
2540 Lisp_Object absname
;
2541 Lisp_Object handler
;
2544 struct stat statbuf
;
2546 CHECK_STRING (filename
);
2547 absname
= Fexpand_file_name (filename
, Qnil
);
2549 /* If the file name has special constructs in it,
2550 call the corresponding file handler. */
2551 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2552 if (!NILP (handler
))
2553 return call2 (handler
, Qfile_readable_p
, absname
);
2555 absname
= ENCODE_FILE (absname
);
2557 #if defined(DOS_NT) || defined(macintosh)
2558 /* Under MS-DOS, Windows, and Macintosh, open does not work for
2560 if (access (SDATA (absname
), 0) == 0)
2563 #else /* not DOS_NT and not macintosh */
2565 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2566 /* Opening a fifo without O_NONBLOCK can wait.
2567 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2568 except in the case of a fifo, on a system which handles it. */
2569 desc
= stat (SDATA (absname
), &statbuf
);
2572 if (S_ISFIFO (statbuf
.st_mode
))
2573 flags
|= O_NONBLOCK
;
2575 desc
= emacs_open (SDATA (absname
), flags
, 0);
2580 #endif /* not DOS_NT and not macintosh */
2583 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2585 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2586 doc
: /* Return t if file FILENAME can be written or created by you. */)
2587 (Lisp_Object filename
)
2589 Lisp_Object absname
, dir
, encoded
;
2590 Lisp_Object handler
;
2591 struct stat statbuf
;
2593 CHECK_STRING (filename
);
2594 absname
= Fexpand_file_name (filename
, Qnil
);
2596 /* If the file name has special constructs in it,
2597 call the corresponding file handler. */
2598 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2599 if (!NILP (handler
))
2600 return call2 (handler
, Qfile_writable_p
, absname
);
2602 encoded
= ENCODE_FILE (absname
);
2603 if (stat (SDATA (encoded
), &statbuf
) >= 0)
2604 return (check_writable (SDATA (encoded
))
2607 dir
= Ffile_name_directory (absname
);
2610 dir
= Fdirectory_file_name (dir
);
2613 dir
= ENCODE_FILE (dir
);
2615 /* The read-only attribute of the parent directory doesn't affect
2616 whether a file or directory can be created within it. Some day we
2617 should check ACLs though, which do affect this. */
2618 if (stat (SDATA (dir
), &statbuf
) < 0)
2620 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2622 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
2627 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2628 doc
: /* Access file FILENAME, and get an error if that does not work.
2629 The second argument STRING is used in the error message.
2630 If there is no error, returns nil. */)
2631 (Lisp_Object filename
, Lisp_Object string
)
2633 Lisp_Object handler
, encoded_filename
, absname
;
2636 CHECK_STRING (filename
);
2637 absname
= Fexpand_file_name (filename
, Qnil
);
2639 CHECK_STRING (string
);
2641 /* If the file name has special constructs in it,
2642 call the corresponding file handler. */
2643 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
2644 if (!NILP (handler
))
2645 return call3 (handler
, Qaccess_file
, absname
, string
);
2647 encoded_filename
= ENCODE_FILE (absname
);
2649 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
2651 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
2657 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2658 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
2659 The value is the link target, as a string.
2660 Otherwise it returns nil.
2662 This function returns t when given the name of a symlink that
2663 points to a nonexistent file. */)
2664 (Lisp_Object filename
)
2666 Lisp_Object handler
;
2668 CHECK_STRING (filename
);
2669 filename
= Fexpand_file_name (filename
, Qnil
);
2671 /* If the file name has special constructs in it,
2672 call the corresponding file handler. */
2673 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2674 if (!NILP (handler
))
2675 return call2 (handler
, Qfile_symlink_p
, filename
);
2684 filename
= ENCODE_FILE (filename
);
2691 buf
= (char *) xrealloc (buf
, bufsize
);
2692 memset (buf
, 0, bufsize
);
2695 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
2699 /* HP-UX reports ERANGE if buffer is too small. */
2700 if (errno
== ERANGE
)
2710 while (valsize
>= bufsize
);
2712 val
= make_string (buf
, valsize
);
2713 if (buf
[0] == '/' && strchr (buf
, ':'))
2714 val
= concat2 (build_string ("/:"), val
);
2716 val
= DECODE_FILE (val
);
2719 #else /* not S_IFLNK */
2721 #endif /* not S_IFLNK */
2724 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2725 doc
: /* Return t if FILENAME names an existing directory.
2726 Symbolic links to directories count as directories.
2727 See `file-symlink-p' to distinguish symlinks. */)
2728 (Lisp_Object filename
)
2730 register Lisp_Object absname
;
2732 Lisp_Object handler
;
2734 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2736 /* If the file name has special constructs in it,
2737 call the corresponding file handler. */
2738 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2739 if (!NILP (handler
))
2740 return call2 (handler
, Qfile_directory_p
, absname
);
2742 absname
= ENCODE_FILE (absname
);
2744 if (stat (SDATA (absname
), &st
) < 0)
2746 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2749 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2750 doc
: /* Return t if file FILENAME names a directory you can open.
2751 For the value to be t, FILENAME must specify the name of a directory as a file,
2752 and the directory must allow you to open files in it. In order to use a
2753 directory as a buffer's current directory, this predicate must return true.
2754 A directory name spec may be given instead; then the value is t
2755 if the directory so specified exists and really is a readable and
2756 searchable directory. */)
2757 (Lisp_Object filename
)
2759 Lisp_Object handler
;
2761 struct gcpro gcpro1
;
2763 /* If the file name has special constructs in it,
2764 call the corresponding file handler. */
2765 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2766 if (!NILP (handler
))
2767 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2770 tem
= (NILP (Ffile_directory_p (filename
))
2771 || NILP (Ffile_executable_p (filename
)));
2773 return tem
? Qnil
: Qt
;
2776 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2777 doc
: /* Return t if FILENAME names a regular file.
2778 This is the sort of file that holds an ordinary stream of data bytes.
2779 Symbolic links to regular files count as regular files.
2780 See `file-symlink-p' to distinguish symlinks. */)
2781 (Lisp_Object filename
)
2783 register Lisp_Object absname
;
2785 Lisp_Object handler
;
2787 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2789 /* If the file name has special constructs in it,
2790 call the corresponding file handler. */
2791 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2792 if (!NILP (handler
))
2793 return call2 (handler
, Qfile_regular_p
, absname
);
2795 absname
= ENCODE_FILE (absname
);
2800 Lisp_Object tem
= Vw32_get_true_file_attributes
;
2802 /* Tell stat to use expensive method to get accurate info. */
2803 Vw32_get_true_file_attributes
= Qt
;
2804 result
= stat (SDATA (absname
), &st
);
2805 Vw32_get_true_file_attributes
= tem
;
2809 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2812 if (stat (SDATA (absname
), &st
) < 0)
2814 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2818 DEFUN ("file-selinux-context", Ffile_selinux_context
,
2819 Sfile_selinux_context
, 1, 1, 0,
2820 doc
: /* Return SELinux context of file named FILENAME,
2821 as a list ("user", "role", "type", "range"). Return (nil, nil, nil, nil)
2822 if file does not exist, is not accessible, or SELinux is disabled */)
2823 (Lisp_Object filename
)
2825 Lisp_Object absname
;
2826 Lisp_Object values
[4];
2827 Lisp_Object handler
;
2829 security_context_t con
;
2834 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2836 /* If the file name has special constructs in it,
2837 call the corresponding file handler. */
2838 handler
= Ffind_file_name_handler (absname
, Qfile_selinux_context
);
2839 if (!NILP (handler
))
2840 return call2 (handler
, Qfile_selinux_context
, absname
);
2842 absname
= ENCODE_FILE (absname
);
2849 if (is_selinux_enabled ())
2851 conlength
= lgetfilecon (SDATA (absname
), &con
);
2854 context
= context_new (con
);
2855 if (context_user_get (context
))
2856 values
[0] = build_string (context_user_get (context
));
2857 if (context_role_get (context
))
2858 values
[1] = build_string (context_role_get (context
));
2859 if (context_type_get (context
))
2860 values
[2] = build_string (context_type_get (context
));
2861 if (context_range_get (context
))
2862 values
[3] = build_string (context_range_get (context
));
2863 context_free (context
);
2870 return Flist (sizeof(values
) / sizeof(values
[0]), values
);
2873 DEFUN ("set-file-selinux-context", Fset_file_selinux_context
,
2874 Sset_file_selinux_context
, 2, 2, 0,
2875 doc
: /* Set SELinux context of file named FILENAME to CONTEXT
2876 as a list ("user", "role", "type", "range"). Has no effect if SELinux
2878 (Lisp_Object filename
, Lisp_Object context
)
2880 Lisp_Object absname
, encoded_absname
;
2881 Lisp_Object handler
;
2882 Lisp_Object user
= CAR_SAFE (context
);
2883 Lisp_Object role
= CAR_SAFE (CDR_SAFE (context
));
2884 Lisp_Object type
= CAR_SAFE (CDR_SAFE (CDR_SAFE (context
)));
2885 Lisp_Object range
= CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context
))));
2887 security_context_t con
;
2888 int fail
, conlength
;
2889 context_t parsed_con
;
2892 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2894 /* If the file name has special constructs in it,
2895 call the corresponding file handler. */
2896 handler
= Ffind_file_name_handler (absname
, Qset_file_selinux_context
);
2897 if (!NILP (handler
))
2898 return call3 (handler
, Qset_file_selinux_context
, absname
, context
);
2900 encoded_absname
= ENCODE_FILE (absname
);
2903 if (is_selinux_enabled ())
2905 /* Get current file context. */
2906 conlength
= lgetfilecon (SDATA (encoded_absname
), &con
);
2909 parsed_con
= context_new (con
);
2910 /* Change the parts defined in the parameter.*/
2913 if (context_user_set (parsed_con
, SDATA (user
)))
2914 error ("Doing context_user_set");
2918 if (context_role_set (parsed_con
, SDATA (role
)))
2919 error ("Doing context_role_set");
2923 if (context_type_set (parsed_con
, SDATA (type
)))
2924 error ("Doing context_type_set");
2926 if (STRINGP (range
))
2928 if (context_range_set (parsed_con
, SDATA (range
)))
2929 error ("Doing context_range_set");
2932 /* Set the modified context back to the file. */
2933 fail
= lsetfilecon (SDATA (encoded_absname
), context_str (parsed_con
));
2935 report_file_error ("Doing lsetfilecon", Fcons (absname
, Qnil
));
2937 context_free (parsed_con
);
2940 report_file_error("Doing lgetfilecon", Fcons (absname
, Qnil
));
2950 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2951 doc
: /* Return mode bits of file named FILENAME, as an integer.
2952 Return nil, if file does not exist or is not accessible. */)
2953 (Lisp_Object filename
)
2955 Lisp_Object absname
;
2957 Lisp_Object handler
;
2959 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2961 /* If the file name has special constructs in it,
2962 call the corresponding file handler. */
2963 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2964 if (!NILP (handler
))
2965 return call2 (handler
, Qfile_modes
, absname
);
2967 absname
= ENCODE_FILE (absname
);
2969 if (stat (SDATA (absname
), &st
) < 0)
2972 return make_number (st
.st_mode
& 07777);
2975 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
2976 "(let ((file (read-file-name \"File: \"))) \
2977 (list file (read-file-modes nil file)))",
2978 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
2979 Only the 12 low bits of MODE are used.
2981 Interactively, mode bits are read by `read-file-modes', which accepts
2982 symbolic notation, like the `chmod' command from GNU Coreutils. */)
2983 (Lisp_Object filename
, Lisp_Object mode
)
2985 Lisp_Object absname
, encoded_absname
;
2986 Lisp_Object handler
;
2988 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2989 CHECK_NUMBER (mode
);
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_modes
);
2994 if (!NILP (handler
))
2995 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2997 encoded_absname
= ENCODE_FILE (absname
);
2999 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3000 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3005 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3006 doc
: /* Set the file permission bits for newly created files.
3007 The argument MODE should be an integer; only the low 9 bits are used.
3008 This setting is inherited by subprocesses. */)
3011 CHECK_NUMBER (mode
);
3013 umask ((~ XINT (mode
)) & 0777);
3018 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3019 doc
: /* Return the default file protection for created files.
3020 The value is an integer. */)
3026 realmask
= umask (0);
3029 XSETINT (value
, (~ realmask
) & 0777);
3034 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3035 doc
: /* Set times of file FILENAME to TIME.
3036 Set both access and modification times.
3037 Return t on success, else nil.
3038 Use the current time if TIME is nil. TIME is in the format of
3040 (Lisp_Object filename
, Lisp_Object time
)
3042 Lisp_Object absname
, encoded_absname
;
3043 Lisp_Object handler
;
3047 if (! lisp_time_argument (time
, &sec
, &usec
))
3048 error ("Invalid time specification");
3050 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3052 /* If the file name has special constructs in it,
3053 call the corresponding file handler. */
3054 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3055 if (!NILP (handler
))
3056 return call3 (handler
, Qset_file_times
, absname
, time
);
3058 encoded_absname
= ENCODE_FILE (absname
);
3063 EMACS_SET_SECS (t
, sec
);
3064 EMACS_SET_USECS (t
, usec
);
3066 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3071 /* Setting times on a directory always fails. */
3072 if (stat (SDATA (encoded_absname
), &st
) == 0
3073 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3076 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3085 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3086 doc
: /* Tell Unix to finish all pending disk updates. */)
3093 #endif /* HAVE_SYNC */
3095 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3096 doc
: /* Return t if file FILE1 is newer than file FILE2.
3097 If FILE1 does not exist, the answer is nil;
3098 otherwise, if FILE2 does not exist, the answer is t. */)
3099 (Lisp_Object file1
, Lisp_Object file2
)
3101 Lisp_Object absname1
, absname2
;
3104 Lisp_Object handler
;
3105 struct gcpro gcpro1
, gcpro2
;
3107 CHECK_STRING (file1
);
3108 CHECK_STRING (file2
);
3111 GCPRO2 (absname1
, file2
);
3112 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3113 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3116 /* If the file name has special constructs in it,
3117 call the corresponding file handler. */
3118 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3120 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3121 if (!NILP (handler
))
3122 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3124 GCPRO2 (absname1
, absname2
);
3125 absname1
= ENCODE_FILE (absname1
);
3126 absname2
= ENCODE_FILE (absname2
);
3129 if (stat (SDATA (absname1
), &st
) < 0)
3132 mtime1
= st
.st_mtime
;
3134 if (stat (SDATA (absname2
), &st
) < 0)
3137 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3141 Lisp_Object Qfind_buffer_file_type
;
3144 #ifndef READ_BUF_SIZE
3145 #define READ_BUF_SIZE (64 << 10)
3148 /* This function is called after Lisp functions to decide a coding
3149 system are called, or when they cause an error. Before they are
3150 called, the current buffer is set unibyte and it contains only a
3151 newly inserted text (thus the buffer was empty before the
3154 The functions may set markers, overlays, text properties, or even
3155 alter the buffer contents, change the current buffer.
3157 Here, we reset all those changes by:
3158 o set back the current buffer.
3159 o move all markers and overlays to BEG.
3160 o remove all text properties.
3161 o set back the buffer multibyteness. */
3164 decide_coding_unwind (Lisp_Object unwind_data
)
3166 Lisp_Object multibyte
, undo_list
, buffer
;
3168 multibyte
= XCAR (unwind_data
);
3169 unwind_data
= XCDR (unwind_data
);
3170 undo_list
= XCAR (unwind_data
);
3171 buffer
= XCDR (unwind_data
);
3173 if (current_buffer
!= XBUFFER (buffer
))
3174 set_buffer_internal (XBUFFER (buffer
));
3175 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3176 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3177 BUF_INTERVALS (current_buffer
) = 0;
3178 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3180 /* Now we are safe to change the buffer's multibyteness directly. */
3181 current_buffer
->enable_multibyte_characters
= multibyte
;
3182 current_buffer
->undo_list
= undo_list
;
3188 /* Used to pass values from insert-file-contents to read_non_regular. */
3190 static int non_regular_fd
;
3191 static EMACS_INT non_regular_inserted
;
3192 static EMACS_INT non_regular_nbytes
;
3195 /* Read from a non-regular file.
3196 Read non_regular_nbytes bytes max from non_regular_fd.
3197 Non_regular_inserted specifies where to put the read bytes.
3198 Value is the number of bytes read. */
3201 read_non_regular (Lisp_Object ignore
)
3207 nbytes
= emacs_read (non_regular_fd
,
3208 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3209 non_regular_nbytes
);
3211 return make_number (nbytes
);
3215 /* Condition-case handler used when reading from non-regular files
3216 in insert-file-contents. */
3219 read_non_regular_quit (Lisp_Object ignore
)
3225 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3227 doc
: /* Insert contents of file FILENAME after point.
3228 Returns list of absolute file name and number of characters inserted.
3229 If second argument VISIT is non-nil, the buffer's visited filename and
3230 last save file modtime are set, and it is marked unmodified. If
3231 visiting and the file does not exist, visiting is completed before the
3234 The optional third and fourth arguments BEG and END specify what portion
3235 of the file to insert. These arguments count bytes in the file, not
3236 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3238 If optional fifth argument REPLACE is non-nil, replace the current
3239 buffer contents (in the accessible portion) with the file contents.
3240 This is better than simply deleting and inserting the whole thing
3241 because (1) it preserves some marker positions and (2) it puts less data
3242 in the undo list. When REPLACE is non-nil, the second return value is
3243 the number of characters that replace previous buffer contents.
3245 This function does code conversion according to the value of
3246 `coding-system-for-read' or `file-coding-system-alist', and sets the
3247 variable `last-coding-system-used' to the coding system actually used. */)
3248 (Lisp_Object filename
, Lisp_Object visit
, Lisp_Object beg
, Lisp_Object end
, Lisp_Object replace
)
3252 EMACS_INT inserted
= 0;
3254 register EMACS_INT how_much
;
3255 register EMACS_INT unprocessed
;
3256 int count
= SPECPDL_INDEX ();
3257 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3258 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3260 EMACS_INT total
= 0;
3261 int not_regular
= 0;
3262 unsigned char read_buf
[READ_BUF_SIZE
];
3263 struct coding_system coding
;
3264 unsigned char buffer
[1 << 14];
3265 int replace_handled
= 0;
3266 int set_coding_system
= 0;
3267 Lisp_Object coding_system
;
3269 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3270 int we_locked_file
= 0;
3271 int deferred_remove_unwind_protect
= 0;
3273 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3274 error ("Cannot do file visiting in an indirect buffer");
3276 if (!NILP (current_buffer
->read_only
))
3277 Fbarf_if_buffer_read_only ();
3281 orig_filename
= Qnil
;
3284 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3286 CHECK_STRING (filename
);
3287 filename
= Fexpand_file_name (filename
, Qnil
);
3289 /* The value Qnil means that the coding system is not yet
3291 coding_system
= Qnil
;
3293 /* If the file name has special constructs in it,
3294 call the corresponding file handler. */
3295 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3296 if (!NILP (handler
))
3298 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3299 visit
, beg
, end
, replace
);
3300 if (CONSP (val
) && CONSP (XCDR (val
)))
3301 inserted
= XINT (XCAR (XCDR (val
)));
3305 orig_filename
= filename
;
3306 filename
= ENCODE_FILE (filename
);
3312 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3314 /* Tell stat to use expensive method to get accurate info. */
3315 Vw32_get_true_file_attributes
= Qt
;
3316 total
= stat (SDATA (filename
), &st
);
3317 Vw32_get_true_file_attributes
= tem
;
3321 if (stat (SDATA (filename
), &st
) < 0)
3322 #endif /* WINDOWSNT */
3324 if (fd
>= 0) emacs_close (fd
);
3327 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3330 if (!NILP (Vcoding_system_for_read
))
3331 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3336 /* This code will need to be changed in order to work on named
3337 pipes, and it's probably just not worth it. So we should at
3338 least signal an error. */
3339 if (!S_ISREG (st
.st_mode
))
3346 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3347 xsignal2 (Qfile_error
,
3348 build_string ("not a regular file"), orig_filename
);
3353 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3356 /* Replacement should preserve point as it preserves markers. */
3357 if (!NILP (replace
))
3358 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3360 record_unwind_protect (close_file_unwind
, make_number (fd
));
3362 /* Can happen on any platform that uses long as type of off_t, but allows
3363 file sizes to exceed 2Gb, so give a suitable message. */
3364 if (! not_regular
&& st
.st_size
< 0)
3365 error ("Maximum buffer size exceeded");
3367 /* Prevent redisplay optimizations. */
3368 current_buffer
->clip_changed
= 1;
3372 if (!NILP (beg
) || !NILP (end
))
3373 error ("Attempt to visit less than an entire file");
3374 if (BEG
< Z
&& NILP (replace
))
3375 error ("Cannot do file visiting in a non-empty buffer");
3381 XSETFASTINT (beg
, 0);
3389 XSETINT (end
, st
.st_size
);
3391 /* Arithmetic overflow can occur if an Emacs integer cannot
3392 represent the file size, or if the calculations below
3393 overflow. The calculations below double the file size
3394 twice, so check that it can be multiplied by 4 safely. */
3395 if (XINT (end
) != st
.st_size
3396 /* Actually, it should test either INT_MAX or LONG_MAX
3397 depending on which one is used for EMACS_INT. But in
3398 any case, in practice, this test is redundant with the
3400 || st.st_size > INT_MAX / 4 */)
3401 error ("Maximum buffer size exceeded");
3403 /* The file size returned from stat may be zero, but data
3404 may be readable nonetheless, for example when this is a
3405 file in the /proc filesystem. */
3406 if (st
.st_size
== 0)
3407 XSETINT (end
, READ_BUF_SIZE
);
3411 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3413 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3414 setup_coding_system (coding_system
, &coding
);
3415 /* Ensure we set Vlast_coding_system_used. */
3416 set_coding_system
= 1;
3420 /* Decide the coding system to use for reading the file now
3421 because we can't use an optimized method for handling
3422 `coding:' tag if the current buffer is not empty. */
3423 if (!NILP (Vcoding_system_for_read
))
3424 coding_system
= Vcoding_system_for_read
;
3427 /* Don't try looking inside a file for a coding system
3428 specification if it is not seekable. */
3429 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3431 /* Find a coding system specified in the heading two
3432 lines or in the tailing several lines of the file.
3433 We assume that the 1K-byte and 3K-byte for heading
3434 and tailing respectively are sufficient for this
3438 if (st
.st_size
<= (1024 * 4))
3439 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3442 nread
= emacs_read (fd
, read_buf
, 1024);
3445 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3446 report_file_error ("Setting file position",
3447 Fcons (orig_filename
, Qnil
));
3448 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3453 error ("IO error reading %s: %s",
3454 SDATA (orig_filename
), emacs_strerror (errno
));
3457 struct buffer
*prev
= current_buffer
;
3461 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3463 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3464 buf
= XBUFFER (buffer
);
3466 delete_all_overlays (buf
);
3467 buf
->directory
= current_buffer
->directory
;
3468 buf
->read_only
= Qnil
;
3469 buf
->filename
= Qnil
;
3470 buf
->undo_list
= Qt
;
3471 eassert (buf
->overlays_before
== NULL
);
3472 eassert (buf
->overlays_after
== NULL
);
3474 set_buffer_internal (buf
);
3476 buf
->enable_multibyte_characters
= Qnil
;
3478 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3479 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3480 coding_system
= call2 (Vset_auto_coding_function
,
3481 filename
, make_number (nread
));
3482 set_buffer_internal (prev
);
3484 /* Discard the unwind protect for recovering the
3488 /* Rewind the file for the actual read done later. */
3489 if (lseek (fd
, 0, 0) < 0)
3490 report_file_error ("Setting file position",
3491 Fcons (orig_filename
, Qnil
));
3495 if (NILP (coding_system
))
3497 /* If we have not yet decided a coding system, check
3498 file-coding-system-alist. */
3499 Lisp_Object args
[6];
3501 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3502 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3503 coding_system
= Ffind_operation_coding_system (6, args
);
3504 if (CONSP (coding_system
))
3505 coding_system
= XCAR (coding_system
);
3509 if (NILP (coding_system
))
3510 coding_system
= Qundecided
;
3512 CHECK_CODING_SYSTEM (coding_system
);
3514 if (NILP (current_buffer
->enable_multibyte_characters
))
3515 /* We must suppress all character code conversion except for
3516 end-of-line conversion. */
3517 coding_system
= raw_text_coding_system (coding_system
);
3519 setup_coding_system (coding_system
, &coding
);
3520 /* Ensure we set Vlast_coding_system_used. */
3521 set_coding_system
= 1;
3524 /* If requested, replace the accessible part of the buffer
3525 with the file contents. Avoid replacing text at the
3526 beginning or end of the buffer that matches the file contents;
3527 that preserves markers pointing to the unchanged parts.
3529 Here we implement this feature in an optimized way
3530 for the case where code conversion is NOT needed.
3531 The following if-statement handles the case of conversion
3532 in a less optimal way.
3534 If the code conversion is "automatic" then we try using this
3535 method and hope for the best.
3536 But if we discover the need for conversion, we give up on this method
3537 and let the following if-statement handle the replace job. */
3540 && (NILP (coding_system
)
3541 || ! CODING_REQUIRE_DECODING (&coding
)))
3543 /* same_at_start and same_at_end count bytes,
3544 because file access counts bytes
3545 and BEG and END count bytes. */
3546 EMACS_INT same_at_start
= BEGV_BYTE
;
3547 EMACS_INT same_at_end
= ZV_BYTE
;
3549 /* There is still a possibility we will find the need to do code
3550 conversion. If that happens, we set this variable to 1 to
3551 give up on handling REPLACE in the optimized way. */
3552 int giveup_match_end
= 0;
3554 if (XINT (beg
) != 0)
3556 if (lseek (fd
, XINT (beg
), 0) < 0)
3557 report_file_error ("Setting file position",
3558 Fcons (orig_filename
, Qnil
));
3563 /* Count how many chars at the start of the file
3564 match the text at the beginning of the buffer. */
3567 EMACS_INT nread
, bufpos
;
3569 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3571 error ("IO error reading %s: %s",
3572 SDATA (orig_filename
), emacs_strerror (errno
));
3573 else if (nread
== 0)
3576 if (CODING_REQUIRE_DETECTION (&coding
))
3578 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
3580 setup_coding_system (coding_system
, &coding
);
3583 if (CODING_REQUIRE_DECODING (&coding
))
3584 /* We found that the file should be decoded somehow.
3585 Let's give up here. */
3587 giveup_match_end
= 1;
3592 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3593 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3594 same_at_start
++, bufpos
++;
3595 /* If we found a discrepancy, stop the scan.
3596 Otherwise loop around and scan the next bufferful. */
3597 if (bufpos
!= nread
)
3601 /* If the file matches the buffer completely,
3602 there's no need to replace anything. */
3603 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3607 /* Truncate the buffer to the size of the file. */
3608 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3613 /* Count how many chars at the end of the file
3614 match the text at the end of the buffer. But, if we have
3615 already found that decoding is necessary, don't waste time. */
3616 while (!giveup_match_end
)
3618 EMACS_INT total_read
, nread
, bufpos
, curpos
, trial
;
3620 /* At what file position are we now scanning? */
3621 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3622 /* If the entire file matches the buffer tail, stop the scan. */
3625 /* How much can we scan in the next step? */
3626 trial
= min (curpos
, sizeof buffer
);
3627 if (lseek (fd
, curpos
- trial
, 0) < 0)
3628 report_file_error ("Setting file position",
3629 Fcons (orig_filename
, Qnil
));
3631 total_read
= nread
= 0;
3632 while (total_read
< trial
)
3634 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3636 error ("IO error reading %s: %s",
3637 SDATA (orig_filename
), emacs_strerror (errno
));
3638 else if (nread
== 0)
3640 total_read
+= nread
;
3643 /* Scan this bufferful from the end, comparing with
3644 the Emacs buffer. */
3645 bufpos
= total_read
;
3647 /* Compare with same_at_start to avoid counting some buffer text
3648 as matching both at the file's beginning and at the end. */
3649 while (bufpos
> 0 && same_at_end
> same_at_start
3650 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3651 same_at_end
--, bufpos
--;
3653 /* If we found a discrepancy, stop the scan.
3654 Otherwise loop around and scan the preceding bufferful. */
3657 /* If this discrepancy is because of code conversion,
3658 we cannot use this method; giveup and try the other. */
3659 if (same_at_end
> same_at_start
3660 && FETCH_BYTE (same_at_end
- 1) >= 0200
3661 && ! NILP (current_buffer
->enable_multibyte_characters
)
3662 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3663 giveup_match_end
= 1;
3672 if (! giveup_match_end
)
3676 /* We win! We can handle REPLACE the optimized way. */
3678 /* Extend the start of non-matching text area to multibyte
3679 character boundary. */
3680 if (! NILP (current_buffer
->enable_multibyte_characters
))
3681 while (same_at_start
> BEGV_BYTE
3682 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3685 /* Extend the end of non-matching text area to multibyte
3686 character boundary. */
3687 if (! NILP (current_buffer
->enable_multibyte_characters
))
3688 while (same_at_end
< ZV_BYTE
3689 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3692 /* Don't try to reuse the same piece of text twice. */
3693 overlap
= (same_at_start
- BEGV_BYTE
3694 - (same_at_end
+ st
.st_size
- ZV
));
3696 same_at_end
+= overlap
;
3698 /* Arrange to read only the nonmatching middle part of the file. */
3699 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3700 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3702 del_range_byte (same_at_start
, same_at_end
, 0);
3703 /* Insert from the file at the proper position. */
3704 temp
= BYTE_TO_CHAR (same_at_start
);
3705 SET_PT_BOTH (temp
, same_at_start
);
3707 /* If display currently starts at beginning of line,
3708 keep it that way. */
3709 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3710 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3712 replace_handled
= 1;
3716 /* If requested, replace the accessible part of the buffer
3717 with the file contents. Avoid replacing text at the
3718 beginning or end of the buffer that matches the file contents;
3719 that preserves markers pointing to the unchanged parts.
3721 Here we implement this feature for the case where code conversion
3722 is needed, in a simple way that needs a lot of memory.
3723 The preceding if-statement handles the case of no conversion
3724 in a more optimized way. */
3725 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3727 EMACS_INT same_at_start
= BEGV_BYTE
;
3728 EMACS_INT same_at_end
= ZV_BYTE
;
3729 EMACS_INT same_at_start_charpos
;
3730 EMACS_INT inserted_chars
;
3733 unsigned char *decoded
;
3735 int this_count
= SPECPDL_INDEX ();
3736 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3737 Lisp_Object conversion_buffer
;
3739 conversion_buffer
= code_conversion_save (1, multibyte
);
3741 /* First read the whole file, performing code conversion into
3742 CONVERSION_BUFFER. */
3744 if (lseek (fd
, XINT (beg
), 0) < 0)
3745 report_file_error ("Setting file position",
3746 Fcons (orig_filename
, Qnil
));
3748 total
= st
.st_size
; /* Total bytes in the file. */
3749 how_much
= 0; /* Bytes read from file so far. */
3750 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3751 unprocessed
= 0; /* Bytes not processed in previous loop. */
3753 GCPRO1 (conversion_buffer
);
3754 while (how_much
< total
)
3756 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
3757 quitting while reading a huge while. */
3758 /* try is reserved in some compilers (Microsoft C) */
3759 EMACS_INT trytry
= min (total
- how_much
,
3760 READ_BUF_SIZE
- unprocessed
);
3763 /* Allow quitting out of the actual I/O. */
3766 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
3778 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
3779 BUF_Z (XBUFFER (conversion_buffer
)));
3780 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
3782 unprocessed
= coding
.carryover_bytes
;
3783 if (coding
.carryover_bytes
> 0)
3784 memcpy (read_buf
, coding
.carryover
, unprocessed
);
3789 /* We should remove the unwind_protect calling
3790 close_file_unwind, but other stuff has been added the stack,
3791 so defer the removal till we reach the `handled' label. */
3792 deferred_remove_unwind_protect
= 1;
3794 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
3795 if we couldn't read the file. */
3798 error ("IO error reading %s: %s",
3799 SDATA (orig_filename
), emacs_strerror (errno
));
3801 if (unprocessed
> 0)
3803 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3804 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
3806 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
3809 coding_system
= CODING_ID_NAME (coding
.id
);
3810 set_coding_system
= 1;
3811 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
3812 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
3813 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3815 /* Compare the beginning of the converted string with the buffer
3819 while (bufpos
< inserted
&& same_at_start
< same_at_end
3820 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
3821 same_at_start
++, bufpos
++;
3823 /* If the file matches the head of buffer completely,
3824 there's no need to replace anything. */
3826 if (bufpos
== inserted
)
3828 /* Truncate the buffer to the size of the file. */
3829 if (same_at_start
== same_at_end
)
3832 del_range_byte (same_at_start
, same_at_end
, 0);
3835 unbind_to (this_count
, Qnil
);
3839 /* Extend the start of non-matching text area to the previous
3840 multibyte character boundary. */
3841 if (! NILP (current_buffer
->enable_multibyte_characters
))
3842 while (same_at_start
> BEGV_BYTE
3843 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3846 /* Scan this bufferful from the end, comparing with
3847 the Emacs buffer. */
3850 /* Compare with same_at_start to avoid counting some buffer text
3851 as matching both at the file's beginning and at the end. */
3852 while (bufpos
> 0 && same_at_end
> same_at_start
3853 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
3854 same_at_end
--, bufpos
--;
3856 /* Extend the end of non-matching text area to the next
3857 multibyte character boundary. */
3858 if (! NILP (current_buffer
->enable_multibyte_characters
))
3859 while (same_at_end
< ZV_BYTE
3860 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3863 /* Don't try to reuse the same piece of text twice. */
3864 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3866 same_at_end
+= overlap
;
3868 /* If display currently starts at beginning of line,
3869 keep it that way. */
3870 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3871 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3873 /* Replace the chars that we need to replace,
3874 and update INSERTED to equal the number of bytes
3875 we are taking from the decoded string. */
3876 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
3878 if (same_at_end
!= same_at_start
)
3880 del_range_byte (same_at_start
, same_at_end
, 0);
3882 same_at_start
= GPT_BYTE
;
3886 temp
= BYTE_TO_CHAR (same_at_start
);
3888 /* Insert from the file at the proper position. */
3889 SET_PT_BOTH (temp
, same_at_start
);
3890 same_at_start_charpos
3891 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3892 same_at_start
- BEGV_BYTE
3893 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3895 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3896 same_at_start
+ inserted
- BEGV_BYTE
3897 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
3898 - same_at_start_charpos
);
3899 /* This binding is to avoid ask-user-about-supersession-threat
3900 being called in insert_from_buffer (via in
3901 prepare_to_modify_buffer). */
3902 specbind (intern ("buffer-file-name"), Qnil
);
3903 insert_from_buffer (XBUFFER (conversion_buffer
),
3904 same_at_start_charpos
, inserted_chars
, 0);
3905 /* Set `inserted' to the number of inserted characters. */
3906 inserted
= PT
- temp
;
3907 /* Set point before the inserted characters. */
3908 SET_PT_BOTH (temp
, same_at_start
);
3910 unbind_to (this_count
, Qnil
);
3917 register Lisp_Object temp
;
3919 total
= XINT (end
) - XINT (beg
);
3921 /* Make sure point-max won't overflow after this insertion. */
3922 XSETINT (temp
, total
);
3923 if (total
!= XINT (temp
))
3924 error ("Maximum buffer size exceeded");
3927 /* For a special file, all we can do is guess. */
3928 total
= READ_BUF_SIZE
;
3930 if (NILP (visit
) && inserted
> 0)
3932 #ifdef CLASH_DETECTION
3933 if (!NILP (current_buffer
->file_truename
)
3934 /* Make binding buffer-file-name to nil effective. */
3935 && !NILP (current_buffer
->filename
)
3936 && SAVE_MODIFF
>= MODIFF
)
3938 #endif /* CLASH_DETECTION */
3939 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
3943 if (GAP_SIZE
< total
)
3944 make_gap (total
- GAP_SIZE
);
3946 if (XINT (beg
) != 0 || !NILP (replace
))
3948 if (lseek (fd
, XINT (beg
), 0) < 0)
3949 report_file_error ("Setting file position",
3950 Fcons (orig_filename
, Qnil
));
3953 /* In the following loop, HOW_MUCH contains the total bytes read so
3954 far for a regular file, and not changed for a special file. But,
3955 before exiting the loop, it is set to a negative value if I/O
3959 /* Total bytes inserted. */
3962 /* Here, we don't do code conversion in the loop. It is done by
3963 decode_coding_gap after all data are read into the buffer. */
3965 EMACS_INT gap_size
= GAP_SIZE
;
3967 while (how_much
< total
)
3969 /* try is reserved in some compilers (Microsoft C) */
3970 EMACS_INT trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3977 /* Maybe make more room. */
3978 if (gap_size
< trytry
)
3980 make_gap (total
- gap_size
);
3981 gap_size
= GAP_SIZE
;
3984 /* Read from the file, capturing `quit'. When an
3985 error occurs, end the loop, and arrange for a quit
3986 to be signaled after decoding the text we read. */
3987 non_regular_fd
= fd
;
3988 non_regular_inserted
= inserted
;
3989 non_regular_nbytes
= trytry
;
3990 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
3991 read_non_regular_quit
);
4002 /* Allow quitting out of the actual I/O. We don't make text
4003 part of the buffer until all the reading is done, so a C-g
4004 here doesn't do any harm. */
4007 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4019 /* For a regular file, where TOTAL is the real size,
4020 count HOW_MUCH to compare with it.
4021 For a special file, where TOTAL is just a buffer size,
4022 so don't bother counting in HOW_MUCH.
4023 (INSERTED is where we count the number of characters inserted.) */
4030 /* Now we have read all the file data into the gap.
4031 If it was empty, undo marking the buffer modified. */
4035 #ifdef CLASH_DETECTION
4037 unlock_file (current_buffer
->file_truename
);
4039 Vdeactivate_mark
= old_Vdeactivate_mark
;
4042 Vdeactivate_mark
= Qt
;
4044 /* Make the text read part of the buffer. */
4045 GAP_SIZE
-= inserted
;
4047 GPT_BYTE
+= inserted
;
4049 ZV_BYTE
+= inserted
;
4054 /* Put an anchor to ensure multi-byte form ends at gap. */
4059 /* Discard the unwind protect for closing the file. */
4063 error ("IO error reading %s: %s",
4064 SDATA (orig_filename
), emacs_strerror (errno
));
4068 if (NILP (coding_system
))
4070 /* The coding system is not yet decided. Decide it by an
4071 optimized method for handling `coding:' tag.
4073 Note that we can get here only if the buffer was empty
4074 before the insertion. */
4076 if (!NILP (Vcoding_system_for_read
))
4077 coding_system
= Vcoding_system_for_read
;
4080 /* Since we are sure that the current buffer was empty
4081 before the insertion, we can toggle
4082 enable-multibyte-characters directly here without taking
4083 care of marker adjustment. By this way, we can run Lisp
4084 program safely before decoding the inserted text. */
4085 Lisp_Object unwind_data
;
4086 int count
= SPECPDL_INDEX ();
4088 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4089 Fcons (current_buffer
->undo_list
,
4090 Fcurrent_buffer ()));
4091 current_buffer
->enable_multibyte_characters
= Qnil
;
4092 current_buffer
->undo_list
= Qt
;
4093 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4095 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4097 coding_system
= call2 (Vset_auto_coding_function
,
4098 filename
, make_number (inserted
));
4101 if (NILP (coding_system
))
4103 /* If the coding system is not yet decided, check
4104 file-coding-system-alist. */
4105 Lisp_Object args
[6];
4107 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4108 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4109 coding_system
= Ffind_operation_coding_system (6, args
);
4110 if (CONSP (coding_system
))
4111 coding_system
= XCAR (coding_system
);
4113 unbind_to (count
, Qnil
);
4114 inserted
= Z_BYTE
- BEG_BYTE
;
4117 if (NILP (coding_system
))
4118 coding_system
= Qundecided
;
4120 CHECK_CODING_SYSTEM (coding_system
);
4122 if (NILP (current_buffer
->enable_multibyte_characters
))
4123 /* We must suppress all character code conversion except for
4124 end-of-line conversion. */
4125 coding_system
= raw_text_coding_system (coding_system
);
4126 setup_coding_system (coding_system
, &coding
);
4127 /* Ensure we set Vlast_coding_system_used. */
4128 set_coding_system
= 1;
4133 /* When we visit a file by raw-text, we change the buffer to
4135 if (CODING_FOR_UNIBYTE (&coding
)
4136 /* Can't do this if part of the buffer might be preserved. */
4138 /* Visiting a file with these coding system makes the buffer
4140 current_buffer
->enable_multibyte_characters
= Qnil
;
4143 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4144 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4145 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4147 move_gap_both (PT
, PT_BYTE
);
4148 GAP_SIZE
+= inserted
;
4149 ZV_BYTE
-= inserted
;
4153 decode_coding_gap (&coding
, inserted
, inserted
);
4154 inserted
= coding
.produced_char
;
4155 coding_system
= CODING_ID_NAME (coding
.id
);
4157 else if (inserted
> 0)
4158 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4161 /* Now INSERTED is measured in characters. */
4164 /* Use the conversion type to determine buffer-file-type
4165 (find-buffer-file-type is now used to help determine the
4167 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4168 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4169 && ! CODING_REQUIRE_DECODING (&coding
))
4170 current_buffer
->buffer_file_type
= Qt
;
4172 current_buffer
->buffer_file_type
= Qnil
;
4177 if (deferred_remove_unwind_protect
)
4178 /* If requested above, discard the unwind protect for closing the
4184 if (!EQ (current_buffer
->undo_list
, Qt
) && !nochange
)
4185 current_buffer
->undo_list
= Qnil
;
4189 current_buffer
->modtime
= st
.st_mtime
;
4190 current_buffer
->modtime_size
= st
.st_size
;
4191 current_buffer
->filename
= orig_filename
;
4194 SAVE_MODIFF
= MODIFF
;
4195 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
4196 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4197 #ifdef CLASH_DETECTION
4200 if (!NILP (current_buffer
->file_truename
))
4201 unlock_file (current_buffer
->file_truename
);
4202 unlock_file (filename
);
4204 #endif /* CLASH_DETECTION */
4206 xsignal2 (Qfile_error
,
4207 build_string ("not a regular file"), orig_filename
);
4210 if (set_coding_system
)
4211 Vlast_coding_system_used
= coding_system
;
4213 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4215 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4217 if (! NILP (insval
))
4219 CHECK_NUMBER (insval
);
4220 inserted
= XFASTINT (insval
);
4224 /* Decode file format. */
4227 /* Don't run point motion or modification hooks when decoding. */
4228 int count
= SPECPDL_INDEX ();
4229 EMACS_INT old_inserted
= inserted
;
4230 specbind (Qinhibit_point_motion_hooks
, Qt
);
4231 specbind (Qinhibit_modification_hooks
, Qt
);
4233 /* Save old undo list and don't record undo for decoding. */
4234 old_undo
= current_buffer
->undo_list
;
4235 current_buffer
->undo_list
= Qt
;
4239 insval
= call3 (Qformat_decode
,
4240 Qnil
, make_number (inserted
), visit
);
4241 CHECK_NUMBER (insval
);
4242 inserted
= XFASTINT (insval
);
4246 /* If REPLACE is non-nil and we succeeded in not replacing the
4247 beginning or end of the buffer text with the file's contents,
4248 call format-decode with `point' positioned at the beginning
4249 of the buffer and `inserted' equalling the number of
4250 characters in the buffer. Otherwise, format-decode might
4251 fail to correctly analyze the beginning or end of the buffer.
4252 Hence we temporarily save `point' and `inserted' here and
4253 restore `point' iff format-decode did not insert or delete
4254 any text. Otherwise we leave `point' at point-min. */
4255 EMACS_INT opoint
= PT
;
4256 EMACS_INT opoint_byte
= PT_BYTE
;
4257 EMACS_INT oinserted
= ZV
- BEGV
;
4258 int ochars_modiff
= CHARS_MODIFF
;
4260 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4261 insval
= call3 (Qformat_decode
,
4262 Qnil
, make_number (oinserted
), visit
);
4263 CHECK_NUMBER (insval
);
4264 if (ochars_modiff
== CHARS_MODIFF
)
4265 /* format_decode didn't modify buffer's characters => move
4266 point back to position before inserted text and leave
4267 value of inserted alone. */
4268 SET_PT_BOTH (opoint
, opoint_byte
);
4270 /* format_decode modified buffer's characters => consider
4271 entire buffer changed and leave point at point-min. */
4272 inserted
= XFASTINT (insval
);
4275 /* For consistency with format-decode call these now iff inserted > 0
4276 (martin 2007-06-28). */
4277 p
= Vafter_insert_file_functions
;
4282 insval
= call1 (XCAR (p
), make_number (inserted
));
4285 CHECK_NUMBER (insval
);
4286 inserted
= XFASTINT (insval
);
4291 /* For the rationale of this see the comment on
4292 format-decode above. */
4293 EMACS_INT opoint
= PT
;
4294 EMACS_INT opoint_byte
= PT_BYTE
;
4295 EMACS_INT oinserted
= ZV
- BEGV
;
4296 int ochars_modiff
= CHARS_MODIFF
;
4298 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4299 insval
= call1 (XCAR (p
), make_number (oinserted
));
4302 CHECK_NUMBER (insval
);
4303 if (ochars_modiff
== CHARS_MODIFF
)
4304 /* after_insert_file_functions didn't modify
4305 buffer's characters => move point back to
4306 position before inserted text and leave value of
4308 SET_PT_BOTH (opoint
, opoint_byte
);
4310 /* after_insert_file_functions did modify buffer's
4311 characters => consider entire buffer changed and
4312 leave point at point-min. */
4313 inserted
= XFASTINT (insval
);
4323 current_buffer
->undo_list
= old_undo
;
4324 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4326 /* Adjust the last undo record for the size change during
4327 the format conversion. */
4328 Lisp_Object tem
= XCAR (old_undo
);
4329 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4330 && INTEGERP (XCDR (tem
))
4331 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4332 XSETCDR (tem
, make_number (PT
+ inserted
));
4336 /* If undo_list was Qt before, keep it that way.
4337 Otherwise start with an empty undo_list. */
4338 current_buffer
->undo_list
= EQ (old_undo
, Qt
) ? Qt
: Qnil
;
4340 unbind_to (count
, Qnil
);
4343 /* Call after-change hooks for the inserted text, aside from the case
4344 of normal visiting (not with REPLACE), which is done in a new buffer
4345 "before" the buffer is changed. */
4346 if (inserted
> 0 && total
> 0
4347 && (NILP (visit
) || !NILP (replace
)))
4349 signal_after_change (PT
, 0, inserted
);
4350 update_compositions (PT
, PT
, CHECK_BORDER
);
4354 && current_buffer
->modtime
== -1)
4356 /* If visiting nonexistent file, return nil. */
4357 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4361 Fsignal (Qquit
, Qnil
);
4363 /* ??? Retval needs to be dealt with in all cases consistently. */
4365 val
= Fcons (orig_filename
,
4366 Fcons (make_number (inserted
),
4369 RETURN_UNGCPRO (unbind_to (count
, val
));
4372 static Lisp_Object
build_annotations (Lisp_Object
, Lisp_Object
);
4375 build_annotations_unwind (Lisp_Object arg
)
4377 Vwrite_region_annotation_buffers
= arg
;
4381 /* Decide the coding-system to encode the data with. */
4384 choose_write_coding_system (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4385 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
,
4386 struct coding_system
*coding
)
4389 Lisp_Object eol_parent
= Qnil
;
4392 && NILP (Fstring_equal (current_buffer
->filename
,
4393 current_buffer
->auto_save_file_name
)))
4398 else if (!NILP (Vcoding_system_for_write
))
4400 val
= Vcoding_system_for_write
;
4401 if (coding_system_require_warning
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
, Fcons (Qt
, Fcons (val
, Qnil
)),
4410 /* If the variable `buffer-file-coding-system' is set locally,
4411 it means that the file was read with some kind of code
4412 conversion or the variable is explicitly set by users. We
4413 had better write it out with the same coding system even if
4414 `enable-multibyte-characters' is nil.
4416 If it is not set locally, we anyway have to convert EOL
4417 format if the default value of `buffer-file-coding-system'
4418 tells that it is not Unix-like (LF only) format. */
4419 int using_default_coding
= 0;
4420 int force_raw_text
= 0;
4422 val
= current_buffer
->buffer_file_coding_system
;
4424 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4427 if (NILP (current_buffer
->enable_multibyte_characters
))
4433 /* Check file-coding-system-alist. */
4434 Lisp_Object args
[7], coding_systems
;
4436 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4437 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4439 coding_systems
= Ffind_operation_coding_system (7, args
);
4440 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4441 val
= XCDR (coding_systems
);
4446 /* If we still have not decided a coding system, use the
4447 default value of buffer-file-coding-system. */
4448 val
= current_buffer
->buffer_file_coding_system
;
4449 using_default_coding
= 1;
4452 if (! NILP (val
) && ! force_raw_text
)
4454 Lisp_Object spec
, attrs
;
4456 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4457 attrs
= AREF (spec
, 0);
4458 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4463 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4464 /* Confirm that VAL can surely encode the current region. */
4465 val
= call5 (Vselect_safe_coding_system_function
,
4466 start
, end
, val
, Qnil
, filename
);
4468 /* If the decided coding-system doesn't specify end-of-line
4469 format, we use that of
4470 `default-buffer-file-coding-system'. */
4471 if (! using_default_coding
4472 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4473 val
= (coding_inherit_eol_type
4474 (val
, buffer_defaults
.buffer_file_coding_system
));
4476 /* If we decide not to encode text, use `raw-text' or one of its
4479 val
= raw_text_coding_system (val
);
4482 val
= coding_inherit_eol_type (val
, eol_parent
);
4483 setup_coding_system (val
, coding
);
4485 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4486 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4490 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4491 "r\nFWrite region to file: \ni\ni\ni\np",
4492 doc
: /* Write current region into specified file.
4493 When called from a program, requires three arguments:
4494 START, END and FILENAME. START and END are normally buffer positions
4495 specifying the part of the buffer to write.
4496 If START is nil, that means to use the entire buffer contents.
4497 If START is a string, then output that string to the file
4498 instead of any buffer contents; END is ignored.
4500 Optional fourth argument APPEND if non-nil means
4501 append to existing file contents (if any). If it is an integer,
4502 seek to that offset in the file before writing.
4503 Optional fifth argument VISIT, if t or a string, means
4504 set the last-save-file-modtime of buffer to this file's modtime
4505 and mark buffer not modified.
4506 If VISIT is a string, it is a second file name;
4507 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4508 VISIT is also the file name to lock and unlock for clash detection.
4509 If VISIT is neither t nor nil nor a string,
4510 that means do not display the \"Wrote file\" message.
4511 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4512 use for locking and unlocking, overriding FILENAME and VISIT.
4513 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4514 for an existing file with the same name. If MUSTBENEW is `excl',
4515 that means to get an error if the file already exists; never overwrite.
4516 If MUSTBENEW is neither nil nor `excl', that means ask for
4517 confirmation before overwriting, but do go ahead and overwrite the file
4518 if the user confirms.
4520 This does code conversion according to the value of
4521 `coding-system-for-write', `buffer-file-coding-system', or
4522 `file-coding-system-alist', and sets the variable
4523 `last-coding-system-used' to the coding system actually used.
4525 This calls `write-region-annotate-functions' at the start, and
4526 `write-region-post-annotation-function' at the end. */)
4527 (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
, Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
, Lisp_Object mustbenew
)
4532 const unsigned char *fn
;
4534 int count
= SPECPDL_INDEX ();
4536 Lisp_Object handler
;
4537 Lisp_Object visit_file
;
4538 Lisp_Object annotations
;
4539 Lisp_Object encoded_filename
;
4540 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4541 int quietly
= !NILP (visit
);
4542 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4543 struct buffer
*given_buffer
;
4545 int buffer_file_type
= O_BINARY
;
4547 struct coding_system coding
;
4549 if (current_buffer
->base_buffer
&& visiting
)
4550 error ("Cannot do file visiting in an indirect buffer");
4552 if (!NILP (start
) && !STRINGP (start
))
4553 validate_region (&start
, &end
);
4556 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4558 filename
= Fexpand_file_name (filename
, Qnil
);
4560 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4561 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4563 if (STRINGP (visit
))
4564 visit_file
= Fexpand_file_name (visit
, Qnil
);
4566 visit_file
= filename
;
4568 if (NILP (lockname
))
4569 lockname
= visit_file
;
4573 /* If the file name has special constructs in it,
4574 call the corresponding file handler. */
4575 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4576 /* If FILENAME has no handler, see if VISIT has one. */
4577 if (NILP (handler
) && STRINGP (visit
))
4578 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4580 if (!NILP (handler
))
4583 val
= call6 (handler
, Qwrite_region
, start
, end
,
4584 filename
, append
, visit
);
4588 SAVE_MODIFF
= MODIFF
;
4589 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4590 current_buffer
->filename
= visit_file
;
4596 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4598 /* Special kludge to simplify auto-saving. */
4601 /* Do it later, so write-region-annotate-function can work differently
4602 if we save "the buffer" vs "a region".
4603 This is useful in tar-mode. --Stef
4604 XSETFASTINT (start, BEG);
4605 XSETFASTINT (end, Z); */
4609 record_unwind_protect (build_annotations_unwind
,
4610 Vwrite_region_annotation_buffers
);
4611 Vwrite_region_annotation_buffers
= Fcons (Fcurrent_buffer (), Qnil
);
4612 count1
= SPECPDL_INDEX ();
4614 given_buffer
= current_buffer
;
4616 if (!STRINGP (start
))
4618 annotations
= build_annotations (start
, end
);
4620 if (current_buffer
!= given_buffer
)
4622 XSETFASTINT (start
, BEGV
);
4623 XSETFASTINT (end
, ZV
);
4629 XSETFASTINT (start
, BEGV
);
4630 XSETFASTINT (end
, ZV
);
4635 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4637 /* Decide the coding-system to encode the data with.
4638 We used to make this choice before calling build_annotations, but that
4639 leads to problems when a write-annotate-function takes care of
4640 unsavable chars (as was the case with X-Symbol). */
4641 Vlast_coding_system_used
4642 = choose_write_coding_system (start
, end
, filename
,
4643 append
, visit
, lockname
, &coding
);
4645 #ifdef CLASH_DETECTION
4647 lock_file (lockname
);
4648 #endif /* CLASH_DETECTION */
4650 encoded_filename
= ENCODE_FILE (filename
);
4652 fn
= SDATA (encoded_filename
);
4656 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4657 #else /* not DOS_NT */
4658 desc
= emacs_open (fn
, O_WRONLY
, 0);
4659 #endif /* not DOS_NT */
4661 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4663 desc
= emacs_open (fn
,
4664 O_WRONLY
| O_CREAT
| buffer_file_type
4665 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4666 S_IREAD
| S_IWRITE
);
4667 #else /* not DOS_NT */
4668 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4669 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4670 auto_saving
? auto_save_mode_bits
: 0666);
4671 #endif /* not DOS_NT */
4675 #ifdef CLASH_DETECTION
4677 if (!auto_saving
) unlock_file (lockname
);
4679 #endif /* CLASH_DETECTION */
4681 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4684 record_unwind_protect (close_file_unwind
, make_number (desc
));
4686 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4690 if (NUMBERP (append
))
4691 ret
= lseek (desc
, XINT (append
), 1);
4693 ret
= lseek (desc
, 0, 2);
4696 #ifdef CLASH_DETECTION
4697 if (!auto_saving
) unlock_file (lockname
);
4698 #endif /* CLASH_DETECTION */
4700 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4709 if (STRINGP (start
))
4711 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
4712 &annotations
, &coding
);
4715 else if (XINT (start
) != XINT (end
))
4717 failure
= 0 > a_write (desc
, Qnil
,
4718 XINT (start
), XINT (end
) - XINT (start
),
4719 &annotations
, &coding
);
4724 /* If file was empty, still need to write the annotations */
4725 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4726 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4730 if (CODING_REQUIRE_FLUSHING (&coding
)
4731 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4734 /* We have to flush out a data. */
4735 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4736 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
4743 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4744 Disk full in NFS may be reported here. */
4745 /* mib says that closing the file will try to write as fast as NFS can do
4746 it, and that means the fsync here is not crucial for autosave files. */
4747 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
4749 /* If fsync fails with EINTR, don't treat that as serious. Also
4750 ignore EINVAL which happens when fsync is not supported on this
4752 if (errno
!= EINTR
&& errno
!= EINVAL
)
4753 failure
= 1, save_errno
= errno
;
4757 /* NFS can report a write failure now. */
4758 if (emacs_close (desc
) < 0)
4759 failure
= 1, save_errno
= errno
;
4763 /* Discard the unwind protect for close_file_unwind. */
4764 specpdl_ptr
= specpdl
+ count1
;
4766 /* Call write-region-post-annotation-function. */
4767 while (CONSP (Vwrite_region_annotation_buffers
))
4769 Lisp_Object buf
= XCAR (Vwrite_region_annotation_buffers
);
4770 if (!NILP (Fbuffer_live_p (buf
)))
4773 if (FUNCTIONP (Vwrite_region_post_annotation_function
))
4774 call0 (Vwrite_region_post_annotation_function
);
4776 Vwrite_region_annotation_buffers
4777 = XCDR (Vwrite_region_annotation_buffers
);
4780 unbind_to (count
, Qnil
);
4782 #ifdef CLASH_DETECTION
4784 unlock_file (lockname
);
4785 #endif /* CLASH_DETECTION */
4787 /* Do this before reporting IO error
4788 to avoid a "file has changed on disk" warning on
4789 next attempt to save. */
4792 current_buffer
->modtime
= st
.st_mtime
;
4793 current_buffer
->modtime_size
= st
.st_size
;
4797 error ("IO error writing %s: %s", SDATA (filename
),
4798 emacs_strerror (save_errno
));
4802 SAVE_MODIFF
= MODIFF
;
4803 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4804 current_buffer
->filename
= visit_file
;
4805 update_mode_lines
++;
4810 && ! NILP (Fstring_equal (current_buffer
->filename
,
4811 current_buffer
->auto_save_file_name
)))
4812 SAVE_MODIFF
= MODIFF
;
4818 message_with_string ((INTEGERP (append
)
4828 Lisp_Object
merge (Lisp_Object
, Lisp_Object
, Lisp_Object
);
4830 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4831 doc
: /* Return t if (car A) is numerically less than (car B). */)
4832 (Lisp_Object a
, Lisp_Object b
)
4834 return Flss (Fcar (a
), Fcar (b
));
4837 /* Build the complete list of annotations appropriate for writing out
4838 the text between START and END, by calling all the functions in
4839 write-region-annotate-functions and merging the lists they return.
4840 If one of these functions switches to a different buffer, we assume
4841 that buffer contains altered text. Therefore, the caller must
4842 make sure to restore the current buffer in all cases,
4843 as save-excursion would do. */
4846 build_annotations (Lisp_Object start
, Lisp_Object end
)
4848 Lisp_Object annotations
;
4850 struct gcpro gcpro1
, gcpro2
;
4851 Lisp_Object original_buffer
;
4852 int i
, used_global
= 0;
4854 XSETBUFFER (original_buffer
, current_buffer
);
4857 p
= Vwrite_region_annotate_functions
;
4858 GCPRO2 (annotations
, p
);
4861 struct buffer
*given_buffer
= current_buffer
;
4862 if (EQ (Qt
, XCAR (p
)) && !used_global
)
4863 { /* Use the global value of the hook. */
4866 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
4868 p
= Fappend (2, arg
);
4871 Vwrite_region_annotations_so_far
= annotations
;
4872 res
= call2 (XCAR (p
), start
, end
);
4873 /* If the function makes a different buffer current,
4874 assume that means this buffer contains altered text to be output.
4875 Reset START and END from the buffer bounds
4876 and discard all previous annotations because they should have
4877 been dealt with by this function. */
4878 if (current_buffer
!= given_buffer
)
4880 Vwrite_region_annotation_buffers
4881 = Fcons (Fcurrent_buffer (),
4882 Vwrite_region_annotation_buffers
);
4883 XSETFASTINT (start
, BEGV
);
4884 XSETFASTINT (end
, ZV
);
4887 Flength (res
); /* Check basic validity of return value */
4888 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4892 /* Now do the same for annotation functions implied by the file-format */
4893 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
4894 p
= current_buffer
->auto_save_file_format
;
4896 p
= current_buffer
->file_format
;
4897 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
4899 struct buffer
*given_buffer
= current_buffer
;
4901 Vwrite_region_annotations_so_far
= annotations
;
4903 /* Value is either a list of annotations or nil if the function
4904 has written annotations to a temporary buffer, which is now
4906 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
4907 original_buffer
, make_number (i
));
4908 if (current_buffer
!= given_buffer
)
4910 XSETFASTINT (start
, BEGV
);
4911 XSETFASTINT (end
, ZV
);
4916 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4924 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
4925 If STRING is nil, POS is the character position in the current buffer.
4926 Intersperse with them the annotations from *ANNOT
4927 which fall within the range of POS to POS + NCHARS,
4928 each at its appropriate position.
4930 We modify *ANNOT by discarding elements as we use them up.
4932 The return value is negative in case of system call failure. */
4935 a_write (int desc
, Lisp_Object string
, int pos
, register int nchars
, Lisp_Object
*annot
, struct coding_system
*coding
)
4939 int lastpos
= pos
+ nchars
;
4941 while (NILP (*annot
) || CONSP (*annot
))
4943 tem
= Fcar_safe (Fcar (*annot
));
4946 nextpos
= XFASTINT (tem
);
4948 /* If there are no more annotations in this range,
4949 output the rest of the range all at once. */
4950 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
4951 return e_write (desc
, string
, pos
, lastpos
, coding
);
4953 /* Output buffer text up to the next annotation's position. */
4956 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
4960 /* Output the annotation. */
4961 tem
= Fcdr (Fcar (*annot
));
4964 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
4967 *annot
= Fcdr (*annot
);
4973 /* Write text in the range START and END into descriptor DESC,
4974 encoding them with coding system CODING. If STRING is nil, START
4975 and END are character positions of the current buffer, else they
4976 are indexes to the string STRING. */
4979 e_write (int desc
, Lisp_Object string
, int start
, int end
, struct coding_system
*coding
)
4981 if (STRINGP (string
))
4984 end
= SCHARS (string
);
4987 /* We used to have a code for handling selective display here. But,
4988 now it is handled within encode_coding. */
4992 if (STRINGP (string
))
4994 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
4995 if (CODING_REQUIRE_ENCODING (coding
))
4997 encode_coding_object (coding
, string
,
4998 start
, string_char_to_byte (string
, start
),
4999 end
, string_char_to_byte (string
, end
), Qt
);
5003 coding
->dst_object
= string
;
5004 coding
->consumed_char
= SCHARS (string
);
5005 coding
->produced
= SBYTES (string
);
5010 int start_byte
= CHAR_TO_BYTE (start
);
5011 int end_byte
= CHAR_TO_BYTE (end
);
5013 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5014 if (CODING_REQUIRE_ENCODING (coding
))
5016 encode_coding_object (coding
, Fcurrent_buffer (),
5017 start
, start_byte
, end
, end_byte
, Qt
);
5021 coding
->dst_object
= Qnil
;
5022 coding
->dst_pos_byte
= start_byte
;
5023 if (start
>= GPT
|| end
<= GPT
)
5025 coding
->consumed_char
= end
- start
;
5026 coding
->produced
= end_byte
- start_byte
;
5030 coding
->consumed_char
= GPT
- start
;
5031 coding
->produced
= GPT_BYTE
- start_byte
;
5036 if (coding
->produced
> 0)
5040 STRINGP (coding
->dst_object
)
5041 ? SDATA (coding
->dst_object
)
5042 : BYTE_POS_ADDR (coding
->dst_pos_byte
),
5045 if (coding
->produced
)
5048 start
+= coding
->consumed_char
;
5054 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5055 Sverify_visited_file_modtime
, 1, 1, 0,
5056 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5057 This means that the file has not been changed since it was visited or saved.
5058 See Info node `(elisp)Modification Time' for more details. */)
5063 Lisp_Object handler
;
5064 Lisp_Object filename
;
5069 if (!STRINGP (b
->filename
)) return Qt
;
5070 if (b
->modtime
== 0) return Qt
;
5072 /* If the file name has special constructs in it,
5073 call the corresponding file handler. */
5074 handler
= Ffind_file_name_handler (b
->filename
,
5075 Qverify_visited_file_modtime
);
5076 if (!NILP (handler
))
5077 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5079 filename
= ENCODE_FILE (b
->filename
);
5081 if (stat (SDATA (filename
), &st
) < 0)
5083 /* If the file doesn't exist now and didn't exist before,
5084 we say that it isn't modified, provided the error is a tame one. */
5085 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5090 if ((st
.st_mtime
== b
->modtime
5091 /* If both are positive, accept them if they are off by one second. */
5092 || (st
.st_mtime
> 0 && b
->modtime
> 0
5093 && (st
.st_mtime
== b
->modtime
+ 1
5094 || st
.st_mtime
== b
->modtime
- 1)))
5095 && (st
.st_size
== b
->modtime_size
5096 || b
->modtime_size
< 0))
5101 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5102 Sclear_visited_file_modtime
, 0, 0, 0,
5103 doc
: /* Clear out records of last mod time of visited file.
5104 Next attempt to save will certainly not complain of a discrepancy. */)
5107 current_buffer
->modtime
= 0;
5108 current_buffer
->modtime_size
= -1;
5112 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5113 Svisited_file_modtime
, 0, 0, 0,
5114 doc
: /* Return the current buffer's recorded visited file modification time.
5115 The value is a list of the form (HIGH LOW), like the time values
5116 that `file-attributes' returns. If the current buffer has no recorded
5117 file modification time, this function returns 0.
5118 See Info node `(elisp)Modification Time' for more details. */)
5121 if (! current_buffer
->modtime
)
5122 return make_number (0);
5123 return make_time ((time_t) current_buffer
->modtime
);
5126 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5127 Sset_visited_file_modtime
, 0, 1, 0,
5128 doc
: /* Update buffer's recorded modification time from the visited file's time.
5129 Useful if the buffer was not read from the file normally
5130 or if the file itself has been changed for some known benign reason.
5131 An argument specifies the modification time value to use
5132 \(instead of that of the visited file), in the form of a list
5133 \(HIGH . LOW) or (HIGH LOW). */)
5134 (Lisp_Object time_list
)
5136 if (!NILP (time_list
))
5138 current_buffer
->modtime
= cons_to_long (time_list
);
5139 current_buffer
->modtime_size
= -1;
5143 register Lisp_Object filename
;
5145 Lisp_Object handler
;
5147 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5149 /* If the file name has special constructs in it,
5150 call the corresponding file handler. */
5151 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5152 if (!NILP (handler
))
5153 /* The handler can find the file name the same way we did. */
5154 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5156 filename
= ENCODE_FILE (filename
);
5158 if (stat (SDATA (filename
), &st
) >= 0)
5160 current_buffer
->modtime
= st
.st_mtime
;
5161 current_buffer
->modtime_size
= st
.st_size
;
5169 auto_save_error (Lisp_Object error
)
5171 Lisp_Object args
[3], msg
;
5173 struct gcpro gcpro1
;
5177 auto_save_error_occurred
= 1;
5179 ring_bell (XFRAME (selected_frame
));
5181 args
[0] = build_string ("Auto-saving %s: %s");
5182 args
[1] = current_buffer
->name
;
5183 args
[2] = Ferror_message_string (error
);
5184 msg
= Fformat (3, args
);
5186 nbytes
= SBYTES (msg
);
5187 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5188 memcpy (msgbuf
, SDATA (msg
), nbytes
);
5190 for (i
= 0; i
< 3; ++i
)
5193 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5195 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5196 Fsleep_for (make_number (1), Qnil
);
5210 auto_save_mode_bits
= 0666;
5212 /* Get visited file's mode to become the auto save file's mode. */
5213 if (! NILP (current_buffer
->filename
))
5215 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5216 /* But make sure we can overwrite it later! */
5217 auto_save_mode_bits
= st
.st_mode
| 0600;
5218 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5220 /* Remote files don't cooperate with stat. */
5221 auto_save_mode_bits
= XINT (modes
) | 0600;
5225 Fwrite_region (Qnil
, Qnil
, current_buffer
->auto_save_file_name
, Qnil
,
5226 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5231 do_auto_save_unwind (Lisp_Object arg
) /* used as unwind-protect function */
5234 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5246 do_auto_save_unwind_1 (Lisp_Object value
) /* used as unwind-protect function */
5249 minibuffer_auto_raise
= XINT (value
);
5254 do_auto_save_make_dir (Lisp_Object dir
)
5258 call2 (Qmake_directory
, dir
, Qt
);
5259 XSETFASTINT (mode
, 0700);
5260 return Fset_file_modes (dir
, mode
);
5264 do_auto_save_eh (Lisp_Object ignore
)
5269 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5270 doc
: /* Auto-save all buffers that need it.
5271 This is all buffers that have auto-saving enabled
5272 and are changed since last auto-saved.
5273 Auto-saving writes the buffer into a file
5274 so that your editing is not lost if the system crashes.
5275 This file is not the file you visited; that changes only when you save.
5276 Normally we run the normal hook `auto-save-hook' before saving.
5278 A non-nil NO-MESSAGE argument means do not print any message if successful.
5279 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5280 (Lisp_Object no_message
, Lisp_Object current_only
)
5282 struct buffer
*old
= current_buffer
, *b
;
5283 Lisp_Object tail
, buf
;
5285 int do_handled_files
;
5287 FILE *stream
= NULL
;
5288 int count
= SPECPDL_INDEX ();
5289 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5290 int old_message_p
= 0;
5291 struct gcpro gcpro1
, gcpro2
;
5293 if (max_specpdl_size
< specpdl_size
+ 40)
5294 max_specpdl_size
= specpdl_size
+ 40;
5299 if (NILP (no_message
))
5301 old_message_p
= push_message ();
5302 record_unwind_protect (pop_message_unwind
, Qnil
);
5305 /* Ordinarily don't quit within this function,
5306 but don't make it impossible to quit (in case we get hung in I/O). */
5310 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5311 point to non-strings reached from Vbuffer_alist. */
5313 if (!NILP (Vrun_hooks
))
5314 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5316 if (STRINGP (Vauto_save_list_file_name
))
5318 Lisp_Object listfile
;
5320 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5322 /* Don't try to create the directory when shutting down Emacs,
5323 because creating the directory might signal an error, and
5324 that would leave Emacs in a strange state. */
5325 if (!NILP (Vrun_hooks
))
5329 GCPRO2 (dir
, listfile
);
5330 dir
= Ffile_name_directory (listfile
);
5331 if (NILP (Ffile_directory_p (dir
)))
5332 internal_condition_case_1 (do_auto_save_make_dir
,
5333 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5338 stream
= fopen (SDATA (listfile
), "w");
5341 record_unwind_protect (do_auto_save_unwind
,
5342 make_save_value (stream
, 0));
5343 record_unwind_protect (do_auto_save_unwind_1
,
5344 make_number (minibuffer_auto_raise
));
5345 minibuffer_auto_raise
= 0;
5347 auto_save_error_occurred
= 0;
5349 /* On first pass, save all files that don't have handlers.
5350 On second pass, save all files that do have handlers.
5352 If Emacs is crashing, the handlers may tweak what is causing
5353 Emacs to crash in the first place, and it would be a shame if
5354 Emacs failed to autosave perfectly ordinary files because it
5355 couldn't handle some ange-ftp'd file. */
5357 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5358 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5360 buf
= XCDR (XCAR (tail
));
5363 /* Record all the buffers that have auto save mode
5364 in the special file that lists them. For each of these buffers,
5365 Record visited name (if any) and auto save name. */
5366 if (STRINGP (b
->auto_save_file_name
)
5367 && stream
!= NULL
&& do_handled_files
== 0)
5370 if (!NILP (b
->filename
))
5372 fwrite (SDATA (b
->filename
), 1,
5373 SBYTES (b
->filename
), stream
);
5375 putc ('\n', stream
);
5376 fwrite (SDATA (b
->auto_save_file_name
), 1,
5377 SBYTES (b
->auto_save_file_name
), stream
);
5378 putc ('\n', stream
);
5382 if (!NILP (current_only
)
5383 && b
!= current_buffer
)
5386 /* Don't auto-save indirect buffers.
5387 The base buffer takes care of it. */
5391 /* Check for auto save enabled
5392 and file changed since last auto save
5393 and file changed since last real save. */
5394 if (STRINGP (b
->auto_save_file_name
)
5395 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5396 && BUF_AUTOSAVE_MODIFF (b
) < BUF_MODIFF (b
)
5397 /* -1 means we've turned off autosaving for a while--see below. */
5398 && XINT (b
->save_length
) >= 0
5399 && (do_handled_files
5400 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5403 EMACS_TIME before_time
, after_time
;
5405 EMACS_GET_TIME (before_time
);
5407 /* If we had a failure, don't try again for 20 minutes. */
5408 if (b
->auto_save_failure_time
>= 0
5409 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5412 set_buffer_internal (b
);
5413 if (NILP (Vauto_save_include_big_deletions
)
5414 && (XFASTINT (b
->save_length
) * 10
5415 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5416 /* A short file is likely to change a large fraction;
5417 spare the user annoying messages. */
5418 && XFASTINT (b
->save_length
) > 5000
5419 /* These messages are frequent and annoying for `*mail*'. */
5420 && !EQ (b
->filename
, Qnil
)
5421 && NILP (no_message
))
5423 /* It has shrunk too much; turn off auto-saving here. */
5424 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5425 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5427 minibuffer_auto_raise
= 0;
5428 /* Turn off auto-saving until there's a real save,
5429 and prevent any more warnings. */
5430 XSETINT (b
->save_length
, -1);
5431 Fsleep_for (make_number (1), Qnil
);
5434 if (!auto_saved
&& NILP (no_message
))
5435 message1 ("Auto-saving...");
5436 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5438 BUF_AUTOSAVE_MODIFF (b
) = BUF_MODIFF (b
);
5439 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5440 set_buffer_internal (old
);
5442 EMACS_GET_TIME (after_time
);
5444 /* If auto-save took more than 60 seconds,
5445 assume it was an NFS failure that got a timeout. */
5446 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5447 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5451 /* Prevent another auto save till enough input events come in. */
5452 record_auto_save ();
5454 if (auto_saved
&& NILP (no_message
))
5458 /* If we are going to restore an old message,
5459 give time to read ours. */
5460 sit_for (make_number (1), 0, 0);
5463 else if (!auto_save_error_occurred
)
5464 /* Don't overwrite the error message if an error occurred.
5465 If we displayed a message and then restored a state
5466 with no message, leave a "done" message on the screen. */
5467 message1 ("Auto-saving...done");
5472 /* This restores the message-stack status. */
5473 unbind_to (count
, Qnil
);
5477 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5478 Sset_buffer_auto_saved
, 0, 0, 0,
5479 doc
: /* Mark current buffer as auto-saved with its current text.
5480 No auto-save file will be written until the buffer changes again. */)
5483 /* FIXME: This should not be called in indirect buffers, since
5484 they're not autosaved. */
5485 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
5486 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5487 current_buffer
->auto_save_failure_time
= -1;
5491 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5492 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5493 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5496 current_buffer
->auto_save_failure_time
= -1;
5500 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5502 doc
: /* Return t if current buffer has been auto-saved recently.
5503 More precisely, if it has been auto-saved since last read from or saved
5504 in the visited file. If the buffer has no visited file,
5505 then any auto-save counts as "recent". */)
5508 /* FIXME: maybe we should return nil for indirect buffers since
5509 they're never autosaved. */
5510 return (SAVE_MODIFF
< BUF_AUTOSAVE_MODIFF (current_buffer
) ? Qt
: Qnil
);
5513 /* Reading and completing file names */
5515 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5516 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5517 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5518 The return value is only relevant for a call to `read-file-name' that happens
5519 before any other event (mouse or keypress) is handled. */)
5522 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
5523 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5533 Fread_file_name (Lisp_Object prompt
, Lisp_Object dir
, Lisp_Object default_filename
, Lisp_Object mustmatch
, Lisp_Object initial
, Lisp_Object predicate
)
5535 struct gcpro gcpro1
, gcpro2
;
5536 Lisp_Object args
[7];
5538 GCPRO1 (default_filename
);
5539 args
[0] = intern ("read-file-name");
5542 args
[3] = default_filename
;
5543 args
[4] = mustmatch
;
5545 args
[6] = predicate
;
5546 RETURN_UNGCPRO (Ffuncall (7, args
));
5551 syms_of_fileio (void)
5553 Qoperations
= intern_c_string ("operations");
5554 Qexpand_file_name
= intern_c_string ("expand-file-name");
5555 Qsubstitute_in_file_name
= intern_c_string ("substitute-in-file-name");
5556 Qdirectory_file_name
= intern_c_string ("directory-file-name");
5557 Qfile_name_directory
= intern_c_string ("file-name-directory");
5558 Qfile_name_nondirectory
= intern_c_string ("file-name-nondirectory");
5559 Qunhandled_file_name_directory
= intern_c_string ("unhandled-file-name-directory");
5560 Qfile_name_as_directory
= intern_c_string ("file-name-as-directory");
5561 Qcopy_file
= intern_c_string ("copy-file");
5562 Qmake_directory_internal
= intern_c_string ("make-directory-internal");
5563 Qmake_directory
= intern_c_string ("make-directory");
5564 Qdelete_directory_internal
= intern_c_string ("delete-directory-internal");
5565 Qdelete_file
= intern_c_string ("delete-file");
5566 Qrename_file
= intern_c_string ("rename-file");
5567 Qadd_name_to_file
= intern_c_string ("add-name-to-file");
5568 Qmake_symbolic_link
= intern_c_string ("make-symbolic-link");
5569 Qfile_exists_p
= intern_c_string ("file-exists-p");
5570 Qfile_executable_p
= intern_c_string ("file-executable-p");
5571 Qfile_readable_p
= intern_c_string ("file-readable-p");
5572 Qfile_writable_p
= intern_c_string ("file-writable-p");
5573 Qfile_symlink_p
= intern_c_string ("file-symlink-p");
5574 Qaccess_file
= intern_c_string ("access-file");
5575 Qfile_directory_p
= intern_c_string ("file-directory-p");
5576 Qfile_regular_p
= intern_c_string ("file-regular-p");
5577 Qfile_accessible_directory_p
= intern_c_string ("file-accessible-directory-p");
5578 Qfile_modes
= intern_c_string ("file-modes");
5579 Qset_file_modes
= intern_c_string ("set-file-modes");
5580 Qset_file_times
= intern_c_string ("set-file-times");
5581 Qfile_selinux_context
= intern_c_string("file-selinux-context");
5582 Qset_file_selinux_context
= intern_c_string("set-file-selinux-context");
5583 Qfile_newer_than_file_p
= intern_c_string ("file-newer-than-file-p");
5584 Qinsert_file_contents
= intern_c_string ("insert-file-contents");
5585 Qwrite_region
= intern_c_string ("write-region");
5586 Qverify_visited_file_modtime
= intern_c_string ("verify-visited-file-modtime");
5587 Qset_visited_file_modtime
= intern_c_string ("set-visited-file-modtime");
5588 Qauto_save_coding
= intern_c_string ("auto-save-coding");
5590 staticpro (&Qoperations
);
5591 staticpro (&Qexpand_file_name
);
5592 staticpro (&Qsubstitute_in_file_name
);
5593 staticpro (&Qdirectory_file_name
);
5594 staticpro (&Qfile_name_directory
);
5595 staticpro (&Qfile_name_nondirectory
);
5596 staticpro (&Qunhandled_file_name_directory
);
5597 staticpro (&Qfile_name_as_directory
);
5598 staticpro (&Qcopy_file
);
5599 staticpro (&Qmake_directory_internal
);
5600 staticpro (&Qmake_directory
);
5601 staticpro (&Qdelete_directory_internal
);
5602 staticpro (&Qdelete_file
);
5603 staticpro (&Qrename_file
);
5604 staticpro (&Qadd_name_to_file
);
5605 staticpro (&Qmake_symbolic_link
);
5606 staticpro (&Qfile_exists_p
);
5607 staticpro (&Qfile_executable_p
);
5608 staticpro (&Qfile_readable_p
);
5609 staticpro (&Qfile_writable_p
);
5610 staticpro (&Qaccess_file
);
5611 staticpro (&Qfile_symlink_p
);
5612 staticpro (&Qfile_directory_p
);
5613 staticpro (&Qfile_regular_p
);
5614 staticpro (&Qfile_accessible_directory_p
);
5615 staticpro (&Qfile_modes
);
5616 staticpro (&Qset_file_modes
);
5617 staticpro (&Qset_file_times
);
5618 staticpro (&Qfile_selinux_context
);
5619 staticpro (&Qset_file_selinux_context
);
5620 staticpro (&Qfile_newer_than_file_p
);
5621 staticpro (&Qinsert_file_contents
);
5622 staticpro (&Qwrite_region
);
5623 staticpro (&Qverify_visited_file_modtime
);
5624 staticpro (&Qset_visited_file_modtime
);
5625 staticpro (&Qauto_save_coding
);
5627 Qfile_name_history
= intern_c_string ("file-name-history");
5628 Fset (Qfile_name_history
, Qnil
);
5629 staticpro (&Qfile_name_history
);
5631 Qfile_error
= intern_c_string ("file-error");
5632 staticpro (&Qfile_error
);
5633 Qfile_already_exists
= intern_c_string ("file-already-exists");
5634 staticpro (&Qfile_already_exists
);
5635 Qfile_date_error
= intern_c_string ("file-date-error");
5636 staticpro (&Qfile_date_error
);
5637 Qexcl
= intern_c_string ("excl");
5641 Qfind_buffer_file_type
= intern_c_string ("find-buffer-file-type");
5642 staticpro (&Qfind_buffer_file_type
);
5645 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5646 doc
: /* *Coding system for encoding file names.
5647 If it is nil, `default-file-name-coding-system' (which see) is used. */);
5648 Vfile_name_coding_system
= Qnil
;
5650 DEFVAR_LISP ("default-file-name-coding-system",
5651 &Vdefault_file_name_coding_system
,
5652 doc
: /* Default coding system for encoding file names.
5653 This variable is used only when `file-name-coding-system' is nil.
5655 This variable is set/changed by the command `set-language-environment'.
5656 User should not set this variable manually,
5657 instead use `file-name-coding-system' to get a constant encoding
5658 of file names regardless of the current language environment. */);
5659 Vdefault_file_name_coding_system
= Qnil
;
5661 Qformat_decode
= intern_c_string ("format-decode");
5662 staticpro (&Qformat_decode
);
5663 Qformat_annotate_function
= intern_c_string ("format-annotate-function");
5664 staticpro (&Qformat_annotate_function
);
5665 Qafter_insert_file_set_coding
= intern_c_string ("after-insert-file-set-coding");
5666 staticpro (&Qafter_insert_file_set_coding
);
5668 Qcar_less_than_car
= intern_c_string ("car-less-than-car");
5669 staticpro (&Qcar_less_than_car
);
5671 Fput (Qfile_error
, Qerror_conditions
,
5672 Fpurecopy (list2 (Qfile_error
, Qerror
)));
5673 Fput (Qfile_error
, Qerror_message
,
5674 make_pure_c_string ("File error"));
5676 Fput (Qfile_already_exists
, Qerror_conditions
,
5677 Fpurecopy (list3 (Qfile_already_exists
, Qfile_error
, Qerror
)));
5678 Fput (Qfile_already_exists
, Qerror_message
,
5679 make_pure_c_string ("File already exists"));
5681 Fput (Qfile_date_error
, Qerror_conditions
,
5682 Fpurecopy (list3 (Qfile_date_error
, Qfile_error
, Qerror
)));
5683 Fput (Qfile_date_error
, Qerror_message
,
5684 make_pure_c_string ("Cannot set file date"));
5686 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5687 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
5688 If a file name matches REGEXP, then all I/O on that file is done by calling
5691 The first argument given to HANDLER is the name of the I/O primitive
5692 to be handled; the remaining arguments are the arguments that were
5693 passed to that primitive. For example, if you do
5694 (file-exists-p FILENAME)
5695 and FILENAME is handled by HANDLER, then HANDLER is called like this:
5696 (funcall HANDLER 'file-exists-p FILENAME)
5697 The function `find-file-name-handler' checks this list for a handler
5698 for its argument. */);
5699 Vfile_name_handler_alist
= Qnil
;
5701 DEFVAR_LISP ("set-auto-coding-function",
5702 &Vset_auto_coding_function
,
5703 doc
: /* If non-nil, a function to call to decide a coding system of file.
5704 Two arguments are passed to this function: the file name
5705 and the length of a file contents following the point.
5706 This function should return a coding system to decode the file contents.
5707 It should check the file name against `auto-coding-alist'.
5708 If no coding system is decided, it should check a coding system
5709 specified in the heading lines with the format:
5710 -*- ... coding: CODING-SYSTEM; ... -*-
5711 or local variable spec of the tailing lines with `coding:' tag. */);
5712 Vset_auto_coding_function
= Qnil
;
5714 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5715 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
5716 Each is passed one argument, the number of characters inserted,
5717 with point at the start of the inserted text. Each function
5718 should leave point the same, and return the new character count.
5719 If `insert-file-contents' is intercepted by a handler from
5720 `file-name-handler-alist', that handler is responsible for calling the
5721 functions in `after-insert-file-functions' if appropriate. */);
5722 Vafter_insert_file_functions
= Qnil
;
5724 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5725 doc
: /* A list of functions to be called at the start of `write-region'.
5726 Each is passed two arguments, START and END as for `write-region'.
5727 These are usually two numbers but not always; see the documentation
5728 for `write-region'. The function should return a list of pairs
5729 of the form (POSITION . STRING), consisting of strings to be effectively
5730 inserted at the specified positions of the file being written (1 means to
5731 insert before the first byte written). The POSITIONs must be sorted into
5734 If there are several annotation functions, the lists returned by these
5735 functions are merged destructively. As each annotation function runs,
5736 the variable `write-region-annotations-so-far' contains a list of all
5737 annotations returned by previous annotation functions.
5739 An annotation function can return with a different buffer current.
5740 Doing so removes the annotations returned by previous functions, and
5741 resets START and END to `point-min' and `point-max' of the new buffer.
5743 After `write-region' completes, Emacs calls the function stored in
5744 `write-region-post-annotation-function', once for each buffer that was
5745 current when building the annotations (i.e., at least once), with that
5746 buffer current. */);
5747 Vwrite_region_annotate_functions
= Qnil
;
5748 staticpro (&Qwrite_region_annotate_functions
);
5749 Qwrite_region_annotate_functions
5750 = intern_c_string ("write-region-annotate-functions");
5752 DEFVAR_LISP ("write-region-post-annotation-function",
5753 &Vwrite_region_post_annotation_function
,
5754 doc
: /* Function to call after `write-region' completes.
5755 The function is called with no arguments. If one or more of the
5756 annotation functions in `write-region-annotate-functions' changed the
5757 current buffer, the function stored in this variable is called for
5758 each of those additional buffers as well, in addition to the original
5759 buffer. The relevant buffer is current during each function call. */);
5760 Vwrite_region_post_annotation_function
= Qnil
;
5761 staticpro (&Vwrite_region_annotation_buffers
);
5763 DEFVAR_LISP ("write-region-annotations-so-far",
5764 &Vwrite_region_annotations_so_far
,
5765 doc
: /* When an annotation function is called, this holds the previous annotations.
5766 These are the annotations made by other annotation functions
5767 that were already called. See also `write-region-annotate-functions'. */);
5768 Vwrite_region_annotations_so_far
= Qnil
;
5770 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5771 doc
: /* A list of file name handlers that temporarily should not be used.
5772 This applies only to the operation `inhibit-file-name-operation'. */);
5773 Vinhibit_file_name_handlers
= Qnil
;
5775 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5776 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5777 Vinhibit_file_name_operation
= Qnil
;
5779 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5780 doc
: /* File name in which we write a list of all auto save file names.
5781 This variable is initialized automatically from `auto-save-list-file-prefix'
5782 shortly after Emacs reads your `.emacs' file, if you have not yet given it
5783 a non-nil value. */);
5784 Vauto_save_list_file_name
= Qnil
;
5786 DEFVAR_LISP ("auto-save-visited-file-name", &Vauto_save_visited_file_name
,
5787 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
5788 Normally auto-save files are written under other names. */);
5789 Vauto_save_visited_file_name
= Qnil
;
5791 DEFVAR_LISP ("auto-save-include-big-deletions", &Vauto_save_include_big_deletions
,
5792 doc
: /* If non-nil, auto-save even if a large part of the text is deleted.
5793 If nil, deleting a substantial portion of the text disables auto-save
5794 in the buffer; this is the default behavior, because the auto-save
5795 file is usually more useful if it contains the deleted text. */);
5796 Vauto_save_include_big_deletions
= Qnil
;
5799 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
5800 doc
: /* *Non-nil means don't call fsync in `write-region'.
5801 This variable affects calls to `write-region' as well as save commands.
5802 A non-nil value may result in data loss! */);
5803 write_region_inhibit_fsync
= 0;
5806 DEFVAR_BOOL ("delete-by-moving-to-trash", &delete_by_moving_to_trash
,
5807 doc
: /* Specifies whether to use the system's trash can.
5808 When non-nil, certain file deletion commands use the function
5809 `move-file-to-trash' instead of deleting files outright.
5810 This includes interactive calls to `delete-file' and
5811 `delete-directory' and the Dired deletion commands. */);
5812 delete_by_moving_to_trash
= 0;
5813 Qdelete_by_moving_to_trash
= intern_c_string ("delete-by-moving-to-trash");
5814 Qmove_file_to_trash
= intern_c_string ("move-file-to-trash");
5815 staticpro (&Qmove_file_to_trash
);
5816 Qcopy_directory
= intern_c_string ("copy-directory");
5817 staticpro (&Qcopy_directory
);
5818 Qdelete_directory
= intern_c_string ("delete-directory");
5819 staticpro (&Qdelete_directory
);
5821 defsubr (&Sfind_file_name_handler
);
5822 defsubr (&Sfile_name_directory
);
5823 defsubr (&Sfile_name_nondirectory
);
5824 defsubr (&Sunhandled_file_name_directory
);
5825 defsubr (&Sfile_name_as_directory
);
5826 defsubr (&Sdirectory_file_name
);
5827 defsubr (&Smake_temp_name
);
5828 defsubr (&Sexpand_file_name
);
5829 defsubr (&Ssubstitute_in_file_name
);
5830 defsubr (&Scopy_file
);
5831 defsubr (&Smake_directory_internal
);
5832 defsubr (&Sdelete_directory_internal
);
5833 defsubr (&Sdelete_file
);
5834 defsubr (&Srename_file
);
5835 defsubr (&Sadd_name_to_file
);
5836 defsubr (&Smake_symbolic_link
);
5837 defsubr (&Sfile_name_absolute_p
);
5838 defsubr (&Sfile_exists_p
);
5839 defsubr (&Sfile_executable_p
);
5840 defsubr (&Sfile_readable_p
);
5841 defsubr (&Sfile_writable_p
);
5842 defsubr (&Saccess_file
);
5843 defsubr (&Sfile_symlink_p
);
5844 defsubr (&Sfile_directory_p
);
5845 defsubr (&Sfile_accessible_directory_p
);
5846 defsubr (&Sfile_regular_p
);
5847 defsubr (&Sfile_modes
);
5848 defsubr (&Sset_file_modes
);
5849 defsubr (&Sset_file_times
);
5850 defsubr (&Sfile_selinux_context
);
5851 defsubr (&Sset_file_selinux_context
);
5852 defsubr (&Sset_default_file_modes
);
5853 defsubr (&Sdefault_file_modes
);
5854 defsubr (&Sfile_newer_than_file_p
);
5855 defsubr (&Sinsert_file_contents
);
5856 defsubr (&Swrite_region
);
5857 defsubr (&Scar_less_than_car
);
5858 defsubr (&Sverify_visited_file_modtime
);
5859 defsubr (&Sclear_visited_file_modtime
);
5860 defsubr (&Svisited_file_modtime
);
5861 defsubr (&Sset_visited_file_modtime
);
5862 defsubr (&Sdo_auto_save
);
5863 defsubr (&Sset_buffer_auto_saved
);
5864 defsubr (&Sclear_buffer_auto_save_failure
);
5865 defsubr (&Srecent_auto_save_p
);
5867 defsubr (&Snext_read_file_uses_dialog_p
);
5870 defsubr (&Sunix_sync
);
5874 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
5875 (do not change this comment) */