1 /* File IO for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-2011 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
29 #if !defined (S_ISLNK) && defined (S_IFLNK)
30 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
33 #if !defined (S_ISFIFO) && defined (S_IFIFO)
34 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
37 #if !defined (S_ISREG) && defined (S_IFREG)
38 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
48 #ifdef HAVE_LIBSELINUX
49 #include <selinux/selinux.h>
50 #include <selinux/context.h>
54 #include "intervals.h"
56 #include "character.h"
59 #include "blockinput.h"
61 #include "dispextern.h"
67 #endif /* not WINDOWSNT */
71 #include <sys/param.h>
76 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
77 redirector allows the six letters between 'Z' and 'a' as well. */
79 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
82 #define IS_DRIVE(x) isalpha ((unsigned char) (x))
84 /* Need to lower-case the drive letter, or else expanded
85 filenames will sometimes compare inequal, because
86 `expand-file-name' doesn't always down-case the drive letter. */
87 #define DRIVE_LETTER(x) (tolower ((unsigned char) (x)))
102 #ifndef FILE_SYSTEM_CASE
103 #define FILE_SYSTEM_CASE(filename) (filename)
106 /* Nonzero during writing of auto-save files */
109 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
110 a new file with the same mode as the original */
111 int auto_save_mode_bits
;
113 /* Set by auto_save_1 if an error occurred during the last auto-save. */
114 int auto_save_error_occurred
;
116 /* The symbol bound to coding-system-for-read when
117 insert-file-contents is called for recovering a file. This is not
118 an actual coding system name, but just an indicator to tell
119 insert-file-contents to use `emacs-mule' with a special flag for
120 auto saving and recovering a file. */
121 Lisp_Object Qauto_save_coding
;
123 /* Property name of a file name handler,
124 which gives a list of operations it handles.. */
125 Lisp_Object Qoperations
;
127 /* Lisp functions for translating file formats */
128 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
130 /* Lisp function for setting buffer-file-coding-system and the
131 multibyteness of the current buffer after inserting a file. */
132 Lisp_Object Qafter_insert_file_set_coding
;
134 Lisp_Object Qwrite_region_annotate_functions
;
135 /* Each time an annotation function changes the buffer, the new buffer
137 Lisp_Object Vwrite_region_annotation_buffers
;
142 Lisp_Object Qdelete_by_moving_to_trash
;
144 /* Lisp function for moving files to trash. */
145 Lisp_Object Qmove_file_to_trash
;
147 /* Lisp function for recursively copying directories. */
148 Lisp_Object Qcopy_directory
;
150 /* Lisp function for recursively deleting directories. */
151 Lisp_Object Qdelete_directory
;
156 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
158 Lisp_Object Qfile_name_history
;
160 Lisp_Object Qcar_less_than_car
;
162 static int a_write (int, Lisp_Object
, int, int,
163 Lisp_Object
*, struct coding_system
*);
164 static int e_write (int, Lisp_Object
, int, int, struct coding_system
*);
168 report_file_error (const char *string
, Lisp_Object data
)
170 Lisp_Object errstring
;
174 synchronize_system_messages_locale ();
175 str
= strerror (errorno
);
176 errstring
= code_convert_string_norecord (make_unibyte_string (str
,
178 Vlocale_coding_system
, 0);
184 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
187 /* System error messages are capitalized. Downcase the initial
188 unless it is followed by a slash. (The slash case caters to
189 error messages that begin with "I/O" or, in German, "E/A".) */
190 if (STRING_MULTIBYTE (errstring
)
191 && ! EQ (Faref (errstring
, make_number (1)), make_number ('/')))
195 str
= SSDATA (errstring
);
196 c
= STRING_CHAR ((unsigned char *) str
);
197 Faset (errstring
, make_number (0), make_number (DOWNCASE (c
)));
200 xsignal (Qfile_error
,
201 Fcons (build_string (string
), Fcons (errstring
, data
)));
206 close_file_unwind (Lisp_Object fd
)
208 emacs_close (XFASTINT (fd
));
212 /* Restore point, having saved it as a marker. */
215 restore_point_unwind (Lisp_Object location
)
217 Fgoto_char (location
);
218 Fset_marker (location
, Qnil
, Qnil
);
223 Lisp_Object Qexpand_file_name
;
224 Lisp_Object Qsubstitute_in_file_name
;
225 Lisp_Object Qdirectory_file_name
;
226 Lisp_Object Qfile_name_directory
;
227 Lisp_Object Qfile_name_nondirectory
;
228 Lisp_Object Qunhandled_file_name_directory
;
229 Lisp_Object Qfile_name_as_directory
;
230 Lisp_Object Qcopy_file
;
231 Lisp_Object Qmake_directory_internal
;
232 Lisp_Object Qmake_directory
;
233 Lisp_Object Qdelete_directory_internal
;
234 Lisp_Object Qdelete_file
;
235 Lisp_Object Qrename_file
;
236 Lisp_Object Qadd_name_to_file
;
237 Lisp_Object Qmake_symbolic_link
;
238 Lisp_Object Qfile_exists_p
;
239 Lisp_Object Qfile_executable_p
;
240 Lisp_Object Qfile_readable_p
;
241 Lisp_Object Qfile_writable_p
;
242 Lisp_Object Qfile_symlink_p
;
243 Lisp_Object Qaccess_file
;
244 Lisp_Object Qfile_directory_p
;
245 Lisp_Object Qfile_regular_p
;
246 Lisp_Object Qfile_accessible_directory_p
;
247 Lisp_Object Qfile_modes
;
248 Lisp_Object Qset_file_modes
;
249 Lisp_Object Qset_file_times
;
250 Lisp_Object Qfile_selinux_context
;
251 Lisp_Object Qset_file_selinux_context
;
252 Lisp_Object Qfile_newer_than_file_p
;
253 Lisp_Object Qinsert_file_contents
;
254 Lisp_Object Qwrite_region
;
255 Lisp_Object Qverify_visited_file_modtime
;
256 Lisp_Object Qset_visited_file_modtime
;
258 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
259 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
260 Otherwise, return nil.
261 A file name is handled if one of the regular expressions in
262 `file-name-handler-alist' matches it.
264 If OPERATION equals `inhibit-file-name-operation', then we ignore
265 any handlers that are members of `inhibit-file-name-handlers',
266 but we still do run any other handlers. This lets handlers
267 use the standard functions without calling themselves recursively. */)
268 (Lisp_Object filename
, Lisp_Object operation
)
270 /* This function must not munge the match data. */
271 Lisp_Object chain
, inhibited_handlers
, result
;
275 CHECK_STRING (filename
);
277 if (EQ (operation
, Vinhibit_file_name_operation
))
278 inhibited_handlers
= Vinhibit_file_name_handlers
;
280 inhibited_handlers
= Qnil
;
282 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
283 chain
= XCDR (chain
))
289 Lisp_Object string
= XCAR (elt
);
291 Lisp_Object handler
= XCDR (elt
);
292 Lisp_Object operations
= Qnil
;
294 if (SYMBOLP (handler
))
295 operations
= Fget (handler
, Qoperations
);
298 && (match_pos
= fast_string_match (string
, filename
)) > pos
299 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
303 handler
= XCDR (elt
);
304 tem
= Fmemq (handler
, inhibited_handlers
);
318 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
320 doc
: /* Return the directory component in file name FILENAME.
321 Return nil if FILENAME does not include a directory.
322 Otherwise return a directory name.
323 Given a Unix syntax file name, returns a string ending in slash. */)
324 (Lisp_Object filename
)
327 register const char *beg
;
331 register const char *p
;
334 CHECK_STRING (filename
);
336 /* If the file name has special constructs in it,
337 call the corresponding file handler. */
338 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
340 return call2 (handler
, Qfile_name_directory
, filename
);
342 filename
= FILE_SYSTEM_CASE (filename
);
344 beg
= (char *) alloca (SBYTES (filename
) + 1);
345 memcpy (beg
, SSDATA (filename
), SBYTES (filename
) + 1);
347 beg
= SSDATA (filename
);
349 p
= beg
+ SBYTES (filename
);
351 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
353 /* only recognise drive specifier at the beginning */
355 /* handle the "/:d:foo" and "/:foo" cases correctly */
356 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
357 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
364 /* Expansion of "c:" to drive and default directory. */
367 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
368 char *res
= alloca (MAXPATHLEN
+ 1);
371 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
373 strncpy (res
, beg
, 2);
378 if (getdefdir (toupper ((unsigned char) *beg
) - 'A' + 1, r
))
380 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
383 p
= beg
+ strlen (beg
);
386 dostounix_filename (beg
);
389 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
392 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
393 Sfile_name_nondirectory
, 1, 1, 0,
394 doc
: /* Return file name FILENAME sans its directory.
395 For example, in a Unix-syntax file name,
396 this is everything after the last slash,
397 or the entire name if it contains no slash. */)
398 (Lisp_Object filename
)
400 register const char *beg
, *p
, *end
;
403 CHECK_STRING (filename
);
405 /* If the file name has special constructs in it,
406 call the corresponding file handler. */
407 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
409 return call2 (handler
, Qfile_name_nondirectory
, filename
);
411 beg
= SSDATA (filename
);
412 end
= p
= beg
+ SBYTES (filename
);
414 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
416 /* only recognise drive specifier at beginning */
418 /* handle the "/:d:foo" case correctly */
419 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
424 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
427 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
428 Sunhandled_file_name_directory
, 1, 1, 0,
429 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
430 A `directly usable' directory name is one that may be used without the
431 intervention of any file handler.
432 If FILENAME is a directly usable file itself, return
433 \(file-name-directory FILENAME).
434 If FILENAME refers to a file which is not accessible from a local process,
435 then this should return nil.
436 The `call-process' and `start-process' functions use this function to
437 get a current directory to run processes in. */)
438 (Lisp_Object filename
)
442 /* If the file name has special constructs in it,
443 call the corresponding file handler. */
444 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
446 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
448 return Ffile_name_directory (filename
);
453 file_name_as_directory (char *out
, char *in
)
455 int size
= strlen (in
) - 1;
467 /* For Unix syntax, Append a slash if necessary */
468 if (!IS_DIRECTORY_SEP (out
[size
]))
470 out
[size
+ 1] = DIRECTORY_SEP
;
471 out
[size
+ 2] = '\0';
474 dostounix_filename (out
);
479 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
480 Sfile_name_as_directory
, 1, 1, 0,
481 doc
: /* Return a string representing the file name FILE interpreted as a directory.
482 This operation exists because a directory is also a file, but its name as
483 a directory is different from its name as a file.
484 The result can be used as the value of `default-directory'
485 or passed as second argument to `expand-file-name'.
486 For a Unix-syntax file name, just appends a slash. */)
496 /* If the file name has special constructs in it,
497 call the corresponding file handler. */
498 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
500 return call2 (handler
, Qfile_name_as_directory
, file
);
502 buf
= (char *) alloca (SBYTES (file
) + 10);
503 file_name_as_directory (buf
, SSDATA (file
));
504 return make_specified_string (buf
, -1, strlen (buf
),
505 STRING_MULTIBYTE (file
));
509 * Convert from directory name to filename.
510 * On UNIX, it's simple: just make sure there isn't a terminating /
512 * Value is nonzero if the string output is different from the input.
516 directory_file_name (char *src
, char *dst
)
522 /* Process as Unix format: just remove any final slash.
523 But leave "/" unchanged; do not change it to "". */
526 && IS_DIRECTORY_SEP (dst
[slen
- 1])
528 && !IS_ANY_SEP (dst
[slen
- 2])
533 dostounix_filename (dst
);
538 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
540 doc
: /* Returns the file name of the directory named DIRECTORY.
541 This is the name of the file that holds the data for the directory DIRECTORY.
542 This operation exists because a directory is also a file, but its name as
543 a directory is different from its name as a file.
544 In Unix-syntax, this function just removes the final slash. */)
545 (Lisp_Object directory
)
550 CHECK_STRING (directory
);
552 if (NILP (directory
))
555 /* If the file name has special constructs in it,
556 call the corresponding file handler. */
557 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
559 return call2 (handler
, Qdirectory_file_name
, directory
);
561 buf
= (char *) alloca (SBYTES (directory
) + 20);
562 directory_file_name (SSDATA (directory
), buf
);
563 return make_specified_string (buf
, -1, strlen (buf
),
564 STRING_MULTIBYTE (directory
));
567 static const char make_temp_name_tbl
[64] =
569 'A','B','C','D','E','F','G','H',
570 'I','J','K','L','M','N','O','P',
571 'Q','R','S','T','U','V','W','X',
572 'Y','Z','a','b','c','d','e','f',
573 'g','h','i','j','k','l','m','n',
574 'o','p','q','r','s','t','u','v',
575 'w','x','y','z','0','1','2','3',
576 '4','5','6','7','8','9','-','_'
579 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
581 /* Value is a temporary file name starting with PREFIX, a string.
583 The Emacs process number forms part of the result, so there is
584 no danger of generating a name being used by another process.
585 In addition, this function makes an attempt to choose a name
586 which has no existing file. To make this work, PREFIX should be
587 an absolute file name.
589 BASE64_P non-zero means add the pid as 3 characters in base64
590 encoding. In this case, 6 characters will be added to PREFIX to
591 form the file name. Otherwise, if Emacs is running on a system
592 with long file names, add the pid as a decimal number.
594 This function signals an error if no unique file name could be
598 make_temp_name (Lisp_Object prefix
, int base64_p
)
607 CHECK_STRING (prefix
);
609 /* VAL is created by adding 6 characters to PREFIX. The first
610 three are the PID of this process, in base 64, and the second
611 three are incremented if the file already exists. This ensures
612 262144 unique file names per PID per PREFIX. */
614 pid
= (int) getpid ();
618 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
619 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
620 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
625 #ifdef HAVE_LONG_FILE_NAMES
626 sprintf (pidbuf
, "%d", pid
);
627 pidlen
= strlen (pidbuf
);
629 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
630 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
631 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
636 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
637 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
638 if (!STRING_MULTIBYTE (prefix
))
639 STRING_SET_UNIBYTE (val
);
641 memcpy (data
, SSDATA (prefix
), len
);
644 memcpy (p
, pidbuf
, pidlen
);
647 /* Here we try to minimize useless stat'ing when this function is
648 invoked many times successively with the same PREFIX. We achieve
649 this by initializing count to a random value, and incrementing it
652 We don't want make-temp-name to be called while dumping,
653 because then make_temp_name_count_initialized_p would get set
654 and then make_temp_name_count would not be set when Emacs starts. */
656 if (!make_temp_name_count_initialized_p
)
658 make_temp_name_count
= (unsigned) time (NULL
);
659 make_temp_name_count_initialized_p
= 1;
665 unsigned num
= make_temp_name_count
;
667 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
668 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
669 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
671 /* Poor man's congruential RN generator. Replace with
672 ++make_temp_name_count for debugging. */
673 make_temp_name_count
+= 25229;
674 make_temp_name_count
%= 225307;
676 if (stat (data
, &ignored
) < 0)
678 /* We want to return only if errno is ENOENT. */
682 /* The error here is dubious, but there is little else we
683 can do. The alternatives are to return nil, which is
684 as bad as (and in many cases worse than) throwing the
685 error, or to ignore the error, which will likely result
686 in looping through 225307 stat's, which is not only
687 dog-slow, but also useless since eventually nil would
688 have to be returned anyway. */
689 report_file_error ("Cannot create temporary name for prefix",
690 Fcons (prefix
, Qnil
));
697 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
698 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
699 The Emacs process number forms part of the result,
700 so there is no danger of generating a name being used by another process.
702 In addition, this function makes an attempt to choose a name
703 which has no existing file. To make this work,
704 PREFIX should be an absolute file name.
706 There is a race condition between calling `make-temp-name' and creating the
707 file which opens all kinds of security holes. For that reason, you should
708 probably use `make-temp-file' instead, except in three circumstances:
710 * If you are creating the file in the user's home directory.
711 * If you are creating a directory rather than an ordinary file.
712 * If you are taking special precautions as `make-temp-file' does. */)
715 return make_temp_name (prefix
, 0);
720 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
721 doc
: /* Convert filename NAME to absolute, and canonicalize it.
722 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
723 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
724 the current buffer's value of `default-directory' is used.
725 NAME should be a string that is a valid file name for the underlying
727 File name components that are `.' are removed, and
728 so are file name components followed by `..', along with the `..' itself;
729 note that these simplifications are done without checking the resulting
730 file names in the file system.
731 Multiple consecutive slashes are collapsed into a single slash,
732 except at the beginning of the file name when they are significant (e.g.,
733 UNC file names on MS-Windows.)
734 An initial `~/' expands to your home directory.
735 An initial `~USER/' expands to USER's home directory.
736 See also the function `substitute-in-file-name'.
738 For technical reasons, this function can return correct but
739 non-intuitive results for the root directory; for instance,
740 \(expand-file-name ".." "/") returns "/..". For this reason, use
741 \(directory-file-name (file-name-directory dirname)) to traverse a
742 filesystem tree, not (expand-file-name ".." dirname). */)
743 (Lisp_Object name
, Lisp_Object default_directory
)
745 /* These point to SDATA and need to be careful with string-relocation
746 during GC (via DECODE_FILE). */
748 /* This should only point to alloca'd data. */
755 int collapse_newdir
= 1;
759 Lisp_Object handler
, result
;
765 /* If the file name has special constructs in it,
766 call the corresponding file handler. */
767 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
769 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
771 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
772 if (NILP (default_directory
))
773 default_directory
= current_buffer
->directory
;
774 if (! STRINGP (default_directory
))
777 /* "/" is not considered a root directory on DOS_NT, so using "/"
778 here causes an infinite recursion in, e.g., the following:
780 (let (default-directory)
781 (expand-file-name "a"))
783 To avoid this, we set default_directory to the root of the
785 default_directory
= build_string (emacs_root_dir ());
787 default_directory
= build_string ("/");
791 if (!NILP (default_directory
))
793 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
795 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
799 char *o
= SSDATA (default_directory
);
801 /* Make sure DEFAULT_DIRECTORY is properly expanded.
802 It would be better to do this down below where we actually use
803 default_directory. Unfortunately, calling Fexpand_file_name recursively
804 could invoke GC, and the strings might be relocated. This would
805 be annoying because we have pointers into strings lying around
806 that would need adjusting, and people would add new pointers to
807 the code and forget to adjust them, resulting in intermittent bugs.
808 Putting this call here avoids all that crud.
810 The EQ test avoids infinite recursion. */
811 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
812 /* Save time in some common cases - as long as default_directory
813 is not relative, it can be canonicalized with name below (if it
814 is needed at all) without requiring it to be expanded now. */
816 /* Detect MSDOS file names with drive specifiers. */
817 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
818 && IS_DIRECTORY_SEP (o
[2]))
820 /* Detect Windows file names in UNC format. */
821 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
823 #else /* not DOS_NT */
824 /* Detect Unix absolute file names (/... alone is not absolute on
826 && ! (IS_DIRECTORY_SEP (o
[0]))
827 #endif /* not DOS_NT */
833 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
837 name
= FILE_SYSTEM_CASE (name
);
838 multibyte
= STRING_MULTIBYTE (name
);
839 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
842 default_directory
= string_to_multibyte (default_directory
);
845 name
= string_to_multibyte (name
);
850 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
851 nm
= (char *) alloca (SBYTES (name
) + 1);
852 memcpy (nm
, SSDATA (name
), SBYTES (name
) + 1);
855 /* Note if special escape prefix is present, but remove for now. */
856 if (nm
[0] == '/' && nm
[1] == ':')
862 /* Find and remove drive specifier if present; this makes nm absolute
863 even if the rest of the name appears to be relative. Only look for
864 drive specifier at the beginning. */
865 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
867 drive
= (unsigned char) nm
[0];
872 /* If we see "c://somedir", we want to strip the first slash after the
873 colon when stripping the drive letter. Otherwise, this expands to
875 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
878 /* Discard any previous drive specifier if nm is now in UNC format. */
879 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
883 #endif /* WINDOWSNT */
886 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
887 none are found, we can probably return right away. We will avoid
888 allocating a new string if name is already fully expanded. */
890 IS_DIRECTORY_SEP (nm
[0])
892 && drive
&& !is_escaped
895 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
899 /* If it turns out that the filename we want to return is just a
900 suffix of FILENAME, we don't need to go through and edit
901 things; we just need to construct a new string using data
902 starting at the middle of FILENAME. If we set lose to a
903 non-zero value, that means we've discovered that we can't do
910 /* Since we know the name is absolute, we can assume that each
911 element starts with a "/". */
913 /* "." and ".." are hairy. */
914 if (IS_DIRECTORY_SEP (p
[0])
916 && (IS_DIRECTORY_SEP (p
[2])
918 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
921 /* We want to replace multiple `/' in a row with a single
924 && IS_DIRECTORY_SEP (p
[0])
925 && IS_DIRECTORY_SEP (p
[1]))
932 /* Make sure directories are all separated with /, but
933 avoid allocation of a new string when not required. */
934 dostounix_filename (nm
);
936 if (IS_DIRECTORY_SEP (nm
[1]))
938 if (strcmp (nm
, SSDATA (name
)) != 0)
939 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
943 /* drive must be set, so this is okay */
944 if (strcmp (nm
- 2, SSDATA (name
)) != 0)
948 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
949 temp
[0] = DRIVE_LETTER (drive
);
950 name
= concat2 (build_string (temp
), name
);
953 #else /* not DOS_NT */
954 if (strcmp (nm
, SSDATA (name
)) == 0)
956 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
957 #endif /* not DOS_NT */
961 /* At this point, nm might or might not be an absolute file name. We
962 need to expand ~ or ~user if present, otherwise prefix nm with
963 default_directory if nm is not absolute, and finally collapse /./
964 and /foo/../ sequences.
966 We set newdir to be the appropriate prefix if one is needed:
967 - the relevant user directory if nm starts with ~ or ~user
968 - the specified drive's working dir (DOS/NT only) if nm does not
970 - the value of default_directory.
972 Note that these prefixes are not guaranteed to be absolute (except
973 for the working dir of a drive). Therefore, to ensure we always
974 return an absolute name, if the final prefix is not absolute we
975 append it to the current working directory. */
979 if (nm
[0] == '~') /* prefix ~ */
981 if (IS_DIRECTORY_SEP (nm
[1])
982 || nm
[1] == 0) /* ~ by itself */
986 if (!(newdir
= egetenv ("HOME")))
989 /* egetenv may return a unibyte string, which will bite us since
990 we expect the directory to be multibyte. */
991 tem
= build_string (newdir
);
992 if (!STRING_MULTIBYTE (tem
))
994 hdir
= DECODE_FILE (tem
);
995 newdir
= SSDATA (hdir
);
1001 else /* ~user/filename */
1004 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)); p
++);
1005 o
= alloca (p
- nm
+ 1);
1006 memcpy (o
, nm
, p
- nm
);
1010 pw
= (struct passwd
*) getpwnam (o
+ 1);
1014 newdir
= pw
->pw_dir
;
1017 collapse_newdir
= 0;
1021 /* If we don't find a user of that name, leave the name
1022 unchanged; don't move nm forward to p. */
1027 /* On DOS and Windows, nm is absolute if a drive name was specified;
1028 use the drive's current directory as the prefix if needed. */
1029 if (!newdir
&& drive
)
1031 /* Get default directory if needed to make nm absolute. */
1032 if (!IS_DIRECTORY_SEP (nm
[0]))
1034 newdir
= alloca (MAXPATHLEN
+ 1);
1035 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1040 /* Either nm starts with /, or drive isn't mounted. */
1041 newdir
= alloca (4);
1042 newdir
[0] = DRIVE_LETTER (drive
);
1050 /* Finally, if no prefix has been specified and nm is not absolute,
1051 then it must be expanded relative to default_directory. */
1055 /* /... alone is not absolute on DOS and Windows. */
1056 && !IS_DIRECTORY_SEP (nm
[0])
1059 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1063 newdir
= SSDATA (default_directory
);
1065 /* Note if special escape prefix is present, but remove for now. */
1066 if (newdir
[0] == '/' && newdir
[1] == ':')
1077 /* First ensure newdir is an absolute name. */
1079 /* Detect MSDOS file names with drive specifiers. */
1080 ! (IS_DRIVE (newdir
[0])
1081 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1083 /* Detect Windows file names in UNC format. */
1084 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1088 /* Effectively, let newdir be (expand-file-name newdir cwd).
1089 Because of the admonition against calling expand-file-name
1090 when we have pointers into lisp strings, we accomplish this
1091 indirectly by prepending newdir to nm if necessary, and using
1092 cwd (or the wd of newdir's drive) as the new newdir. */
1094 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1096 drive
= (unsigned char) newdir
[0];
1099 if (!IS_DIRECTORY_SEP (nm
[0]))
1101 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1102 file_name_as_directory (tmp
, newdir
);
1106 newdir
= alloca (MAXPATHLEN
+ 1);
1109 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1116 /* Strip off drive name from prefix, if present. */
1117 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1123 /* Keep only a prefix from newdir if nm starts with slash
1124 (//server/share for UNC, nothing otherwise). */
1125 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1128 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1131 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1133 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1135 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1147 /* Get rid of any slash at the end of newdir, unless newdir is
1148 just / or // (an incomplete UNC name). */
1149 length
= strlen (newdir
);
1150 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1152 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1156 char *temp
= (char *) alloca (length
);
1157 memcpy (temp
, newdir
, length
- 1);
1158 temp
[length
- 1] = 0;
1166 /* Now concatenate the directory and name to new space in the stack frame */
1167 tlen
+= strlen (nm
) + 1;
1169 /* Reserve space for drive specifier and escape prefix, since either
1170 or both may need to be inserted. (The Microsoft x86 compiler
1171 produces incorrect code if the following two lines are combined.) */
1172 target
= (char *) alloca (tlen
+ 4);
1174 #else /* not DOS_NT */
1175 target
= (char *) alloca (tlen
);
1176 #endif /* not DOS_NT */
1181 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1184 /* If newdir is effectively "C:/", then the drive letter will have
1185 been stripped and newdir will be "/". Concatenating with an
1186 absolute directory in nm produces "//", which will then be
1187 incorrectly treated as a network share. Ignore newdir in
1188 this case (keeping the drive letter). */
1189 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1190 && newdir
[1] == '\0'))
1192 strcpy (target
, newdir
);
1195 file_name_as_directory (target
, newdir
);
1198 strcat (target
, nm
);
1200 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1208 if (!IS_DIRECTORY_SEP (*p
))
1212 else if (p
[1] == '.'
1213 && (IS_DIRECTORY_SEP (p
[2])
1216 /* If "/." is the entire filename, keep the "/". Otherwise,
1217 just delete the whole "/.". */
1218 if (o
== target
&& p
[2] == '\0')
1222 else if (p
[1] == '.' && p
[2] == '.'
1223 /* `/../' is the "superroot" on certain file systems.
1224 Turned off on DOS_NT systems because they have no
1225 "superroot" and because this causes us to produce
1226 file names like "d:/../foo" which fail file-related
1227 functions of the underlying OS. (To reproduce, try a
1228 long series of "../../" in default_directory, longer
1229 than the number of levels from the root.) */
1233 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1238 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1241 /* Don't go below server level in UNC filenames. */
1242 if (o
== target
+ 1 && IS_DIRECTORY_SEP (*o
)
1243 && IS_DIRECTORY_SEP (*target
))
1247 /* Keep initial / only if this is the whole name. */
1248 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1252 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1253 /* Collapse multiple `/' in a row. */
1262 /* At last, set drive name. */
1264 /* Except for network file name. */
1265 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1266 #endif /* WINDOWSNT */
1268 if (!drive
) abort ();
1270 target
[0] = DRIVE_LETTER (drive
);
1273 /* Reinsert the escape prefix if required. */
1280 dostounix_filename (target
);
1283 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1286 /* Again look to see if the file name has special constructs in it
1287 and perhaps call the corresponding file handler. This is needed
1288 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1289 the ".." component gives us "/user@host:/bar/../baz" which needs
1290 to be expanded again. */
1291 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1292 if (!NILP (handler
))
1293 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1299 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1300 This is the old version of expand-file-name, before it was thoroughly
1301 rewritten for Emacs 10.31. We leave this version here commented-out,
1302 because the code is very complex and likely to have subtle bugs. If
1303 bugs _are_ found, it might be of interest to look at the old code and
1304 see what did it do in the relevant situation.
1306 Don't remove this code: it's true that it will be accessible
1307 from the repository, but a few years from deletion, people will
1308 forget it is there. */
1310 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1311 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1312 "Convert FILENAME to absolute, and canonicalize it.\n\
1313 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1314 \(does not start with slash); if DEFAULT is nil or missing,\n\
1315 the current buffer's value of default-directory is used.\n\
1316 Filenames containing `.' or `..' as components are simplified;\n\
1317 initial `~/' expands to your home directory.\n\
1318 See also the function `substitute-in-file-name'.")
1320 Lisp_Object name
, defalt
;
1324 register unsigned char *newdir
, *p
, *o
;
1326 unsigned char *target
;
1330 CHECK_STRING (name
);
1333 /* If nm is absolute, flush ...// and detect /./ and /../.
1334 If no /./ or /../ we can return right away. */
1341 if (p
[0] == '/' && p
[1] == '/'
1344 if (p
[0] == '/' && p
[1] == '~')
1345 nm
= p
+ 1, lose
= 1;
1346 if (p
[0] == '/' && p
[1] == '.'
1347 && (p
[2] == '/' || p
[2] == 0
1348 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1354 if (nm
== SDATA (name
))
1356 return build_string (nm
);
1360 /* Now determine directory to start with and put it in NEWDIR */
1364 if (nm
[0] == '~') /* prefix ~ */
1365 if (nm
[1] == '/' || nm
[1] == 0)/* ~/filename */
1367 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1368 newdir
= (unsigned char *) "";
1371 else /* ~user/filename */
1373 /* Get past ~ to user */
1374 unsigned char *user
= nm
+ 1;
1375 /* Find end of name. */
1376 unsigned char *ptr
= (unsigned char *) strchr (user
, '/');
1377 int len
= ptr
? ptr
- user
: strlen (user
);
1378 /* Copy the user name into temp storage. */
1379 o
= (unsigned char *) alloca (len
+ 1);
1380 memcpy (o
, user
, len
);
1383 /* Look up the user name. */
1385 pw
= (struct passwd
*) getpwnam (o
+ 1);
1388 error ("\"%s\" isn't a registered user", o
+ 1);
1390 newdir
= (unsigned char *) pw
->pw_dir
;
1392 /* Discard the user name from NM. */
1396 if (nm
[0] != '/' && !newdir
)
1399 defalt
= current_buffer
->directory
;
1400 CHECK_STRING (defalt
);
1401 newdir
= SDATA (defalt
);
1404 /* Now concatenate the directory and name to new space in the stack frame */
1406 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1407 target
= (unsigned char *) alloca (tlen
);
1412 if (nm
[0] == 0 || nm
[0] == '/')
1413 strcpy (target
, newdir
);
1415 file_name_as_directory (target
, newdir
);
1418 strcat (target
, nm
);
1420 /* Now canonicalize by removing /. and /foo/.. if they appear */
1431 else if (!strncmp (p
, "//", 2)
1437 else if (p
[0] == '/' && p
[1] == '.'
1438 && (p
[2] == '/' || p
[2] == 0))
1440 else if (!strncmp (p
, "/..", 3)
1441 /* `/../' is the "superroot" on certain file systems. */
1443 && (p
[3] == '/' || p
[3] == 0))
1445 while (o
!= target
&& *--o
!= '/')
1447 if (o
== target
&& *o
== '/')
1457 return make_string (target
, o
- target
);
1461 /* If /~ or // appears, discard everything through first slash. */
1463 file_name_absolute_p (const char *filename
)
1466 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
1468 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
1469 && IS_DIRECTORY_SEP (filename
[2]))
1475 search_embedded_absfilename (char *nm
, char *endp
)
1479 for (p
= nm
+ 1; p
< endp
; p
++)
1482 || IS_DIRECTORY_SEP (p
[-1]))
1483 && file_name_absolute_p (p
)
1484 #if defined (WINDOWSNT) || defined(CYGWIN)
1485 /* // at start of file name is meaningful in Apollo,
1486 WindowsNT and Cygwin systems. */
1487 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
1488 #endif /* not (WINDOWSNT || CYGWIN) */
1491 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)); s
++);
1492 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
1494 char *o
= alloca (s
- p
+ 1);
1496 memcpy (o
, p
, s
- p
);
1499 /* If we have ~user and `user' exists, discard
1500 everything up to ~. But if `user' does not exist, leave
1501 ~user alone, it might be a literal file name. */
1503 pw
= getpwnam (o
+ 1);
1515 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1516 Ssubstitute_in_file_name
, 1, 1, 0,
1517 doc
: /* Substitute environment variables referred to in FILENAME.
1518 `$FOO' where FOO is an environment variable name means to substitute
1519 the value of that variable. The variable name should be terminated
1520 with a character not a letter, digit or underscore; otherwise, enclose
1521 the entire variable name in braces.
1523 If `/~' appears, all of FILENAME through that `/' is discarded.
1524 If `//' appears, everything up to and including the first of
1525 those `/' is discarded. */)
1526 (Lisp_Object filename
)
1530 register char *s
, *p
, *o
, *x
, *endp
;
1531 char *target
= NULL
;
1533 int substituted
= 0;
1536 Lisp_Object handler
;
1538 CHECK_STRING (filename
);
1540 multibyte
= STRING_MULTIBYTE (filename
);
1542 /* If the file name has special constructs in it,
1543 call the corresponding file handler. */
1544 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1545 if (!NILP (handler
))
1546 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1548 /* Always work on a copy of the string, in case GC happens during
1549 decode of environment variables, causing the original Lisp_String
1550 data to be relocated. */
1551 nm
= (char *) alloca (SBYTES (filename
) + 1);
1552 memcpy (nm
, SDATA (filename
), SBYTES (filename
) + 1);
1555 dostounix_filename (nm
);
1556 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
1558 endp
= nm
+ SBYTES (filename
);
1560 /* If /~ or // appears, discard everything through first slash. */
1561 p
= search_embedded_absfilename (nm
, endp
);
1563 /* Start over with the new string, so we check the file-name-handler
1564 again. Important with filenames like "/home/foo//:/hello///there"
1565 which whould substitute to "/:/hello///there" rather than "/there". */
1566 return Fsubstitute_in_file_name
1567 (make_specified_string (p
, -1, endp
- p
, multibyte
));
1569 /* See if any variables are substituted into the string
1570 and find the total length of their values in `total' */
1572 for (p
= nm
; p
!= endp
;)
1582 /* "$$" means a single "$" */
1591 while (p
!= endp
&& *p
!= '}') p
++;
1592 if (*p
!= '}') goto missingclose
;
1598 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1602 /* Copy out the variable name */
1603 target
= (char *) alloca (s
- o
+ 1);
1604 strncpy (target
, o
, s
- o
);
1607 strupr (target
); /* $home == $HOME etc. */
1610 /* Get variable value */
1611 o
= egetenv (target
);
1614 /* Don't try to guess a maximum length - UTF8 can use up to
1615 four bytes per character. This code is unlikely to run
1616 in a situation that requires performance, so decoding the
1617 env variables twice should be acceptable. Note that
1618 decoding may cause a garbage collect. */
1619 Lisp_Object orig
, decoded
;
1620 orig
= make_unibyte_string (o
, strlen (o
));
1621 decoded
= DECODE_FILE (orig
);
1622 total
+= SBYTES (decoded
);
1632 /* If substitution required, recopy the string and do it */
1633 /* Make space in stack frame for the new copy */
1634 xnm
= (char *) alloca (SBYTES (filename
) + total
+ 1);
1637 /* Copy the rest of the name through, replacing $ constructs with values */
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
= (char *) alloca (s
- o
+ 1);
1667 strncpy (target
, o
, s
- o
);
1670 strupr (target
); /* $home == $HOME etc. */
1673 /* Get variable value */
1674 o
= egetenv (target
);
1678 strcpy (x
, target
); x
+= strlen (target
);
1682 Lisp_Object orig
, decoded
;
1683 int orig_length
, decoded_length
;
1684 orig_length
= strlen (o
);
1685 orig
= make_unibyte_string (o
, orig_length
);
1686 decoded
= DECODE_FILE (orig
);
1687 decoded_length
= SBYTES (decoded
);
1688 strncpy (x
, SSDATA (decoded
), decoded_length
);
1689 x
+= decoded_length
;
1691 /* If environment variable needed decoding, return value
1692 needs to be multibyte. */
1693 if (decoded_length
!= orig_length
1694 || strncmp (SSDATA (decoded
), o
, orig_length
))
1701 /* If /~ or // appears, discard everything through first slash. */
1702 while ((p
= search_embedded_absfilename (xnm
, x
)))
1703 /* This time we do not start over because we've already expanded envvars
1704 and replaced $$ with $. Maybe we should start over as well, but we'd
1705 need to quote some $ to $$ first. */
1708 return make_specified_string (xnm
, -1, x
- xnm
, multibyte
);
1711 error ("Bad format environment-variable substitution");
1713 error ("Missing \"}\" in environment-variable substitution");
1715 error ("Substituting nonexistent environment variable \"%s\"", target
);
1721 /* A slightly faster and more convenient way to get
1722 (directory-file-name (expand-file-name FOO)). */
1725 expand_and_dir_to_file (Lisp_Object filename
, Lisp_Object defdir
)
1727 register Lisp_Object absname
;
1729 absname
= Fexpand_file_name (filename
, defdir
);
1731 /* Remove final slash, if any (unless this is the root dir).
1732 stat behaves differently depending! */
1733 if (SCHARS (absname
) > 1
1734 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
1735 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
1736 /* We cannot take shortcuts; they might be wrong for magic file names. */
1737 absname
= Fdirectory_file_name (absname
);
1741 /* Signal an error if the file ABSNAME already exists.
1742 If INTERACTIVE is nonzero, ask the user whether to proceed,
1743 and bypass the error if the user says to go ahead.
1744 QUERYSTRING is a name for the action that is being considered
1747 *STATPTR is used to store the stat information if the file exists.
1748 If the file does not exist, STATPTR->st_mode is set to 0.
1749 If STATPTR is null, we don't store into it.
1751 If QUICK is nonzero, we ask for y or n, not yes or no. */
1754 barf_or_query_if_file_exists (Lisp_Object absname
, const char *querystring
,
1755 int interactive
, struct stat
*statptr
, int quick
)
1757 register Lisp_Object tem
, encoded_filename
;
1758 struct stat statbuf
;
1759 struct gcpro gcpro1
;
1761 encoded_filename
= ENCODE_FILE (absname
);
1763 /* stat is a good way to tell whether the file exists,
1764 regardless of what access permissions it has. */
1765 if (lstat (SSDATA (encoded_filename
), &statbuf
) >= 0)
1768 xsignal2 (Qfile_already_exists
,
1769 build_string ("File already exists"), absname
);
1771 tem
= format2 ("File %s already exists; %s anyway? ",
1772 absname
, build_string (querystring
));
1774 tem
= call1 (intern ("y-or-n-p"), tem
);
1776 tem
= do_yes_or_no_p (tem
);
1779 xsignal2 (Qfile_already_exists
,
1780 build_string ("File already exists"), absname
);
1787 statptr
->st_mode
= 0;
1792 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
1793 "fCopy file: \nGCopy %s to file: \np\nP",
1794 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
1795 If NEWNAME names a directory, copy FILE there.
1797 This function always sets the file modes of the output file to match
1800 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1801 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1802 signal a `file-already-exists' error without overwriting. If
1803 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1804 about overwriting; this is what happens in interactive use with M-x.
1805 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1808 Fourth arg KEEP-TIME non-nil means give the output file the same
1809 last-modified time as the old one. (This works on only some systems.)
1811 A prefix arg makes KEEP-TIME non-nil.
1813 If PRESERVE-UID-GID is non-nil, we try to transfer the
1814 uid and gid of FILE to NEWNAME.
1816 If PRESERVE-SELINUX-CONTEXT is non-nil and SELinux is enabled
1817 on the system, we copy the SELinux context of FILE to NEWNAME. */)
1818 (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
)
1821 char buf
[16 * 1024];
1822 struct stat st
, out_st
;
1823 Lisp_Object handler
;
1824 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1825 int count
= SPECPDL_INDEX ();
1826 int input_file_statable_p
;
1827 Lisp_Object encoded_file
, encoded_newname
;
1829 security_context_t con
;
1830 int fail
, conlength
= 0;
1833 encoded_file
= encoded_newname
= Qnil
;
1834 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
1835 CHECK_STRING (file
);
1836 CHECK_STRING (newname
);
1838 if (!NILP (Ffile_directory_p (newname
)))
1839 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
1841 newname
= Fexpand_file_name (newname
, Qnil
);
1843 file
= Fexpand_file_name (file
, Qnil
);
1845 /* If the input file name has special constructs in it,
1846 call the corresponding file handler. */
1847 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1848 /* Likewise for output file name. */
1850 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1851 if (!NILP (handler
))
1852 RETURN_UNGCPRO (call7 (handler
, Qcopy_file
, file
, newname
,
1853 ok_if_already_exists
, keep_time
, preserve_uid_gid
,
1854 preserve_selinux_context
));
1856 encoded_file
= ENCODE_FILE (file
);
1857 encoded_newname
= ENCODE_FILE (newname
);
1859 if (NILP (ok_if_already_exists
)
1860 || INTEGERP (ok_if_already_exists
))
1861 barf_or_query_if_file_exists (newname
, "copy to it",
1862 INTEGERP (ok_if_already_exists
), &out_st
, 0);
1863 else if (stat (SSDATA (encoded_newname
), &out_st
) < 0)
1867 if (!CopyFile (SDATA (encoded_file
),
1868 SDATA (encoded_newname
),
1870 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
1871 /* CopyFile retains the timestamp by default. */
1872 else if (NILP (keep_time
))
1878 EMACS_GET_TIME (now
);
1879 filename
= SDATA (encoded_newname
);
1881 /* Ensure file is writable while its modified time is set. */
1882 attributes
= GetFileAttributes (filename
);
1883 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
1884 if (set_file_times (filename
, now
, now
))
1886 /* Restore original attributes. */
1887 SetFileAttributes (filename
, attributes
);
1888 xsignal2 (Qfile_date_error
,
1889 build_string ("Cannot set file date"), newname
);
1891 /* Restore original attributes. */
1892 SetFileAttributes (filename
, attributes
);
1894 #else /* not WINDOWSNT */
1896 ifd
= emacs_open (SSDATA (encoded_file
), O_RDONLY
, 0);
1900 report_file_error ("Opening input file", Fcons (file
, Qnil
));
1902 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1904 /* We can only copy regular files and symbolic links. Other files are not
1906 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1909 if (!NILP (preserve_selinux_context
) && is_selinux_enabled ())
1911 conlength
= fgetfilecon (ifd
, &con
);
1912 if (conlength
== -1)
1913 report_file_error ("Doing fgetfilecon", Fcons (file
, Qnil
));
1917 if (out_st
.st_mode
!= 0
1918 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
1921 report_file_error ("Input and output files are the same",
1922 Fcons (file
, Fcons (newname
, Qnil
)));
1925 #if defined (S_ISREG) && defined (S_ISLNK)
1926 if (input_file_statable_p
)
1928 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1930 #if defined (EISDIR)
1931 /* Get a better looking error message. */
1934 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
1937 #endif /* S_ISREG && S_ISLNK */
1940 /* System's default file type was set to binary by _fmode in emacs.c. */
1941 ofd
= emacs_open (SDATA (encoded_newname
),
1942 O_WRONLY
| O_TRUNC
| O_CREAT
1943 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
1944 S_IREAD
| S_IWRITE
);
1945 #else /* not MSDOS */
1946 ofd
= emacs_open (SSDATA (encoded_newname
),
1947 O_WRONLY
| O_TRUNC
| O_CREAT
1948 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
1950 #endif /* not MSDOS */
1952 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1954 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1958 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
1959 if (emacs_write (ofd
, buf
, n
) != n
)
1960 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1964 /* Preserve the original file modes, and if requested, also its
1966 if (input_file_statable_p
)
1968 if (! NILP (preserve_uid_gid
))
1969 fchown (ofd
, st
.st_uid
, st
.st_gid
);
1970 fchmod (ofd
, st
.st_mode
& 07777);
1972 #endif /* not MSDOS */
1977 /* Set the modified context back to the file. */
1978 fail
= fsetfilecon (ofd
, con
);
1980 report_file_error ("Doing fsetfilecon", Fcons (newname
, Qnil
));
1986 /* Closing the output clobbers the file times on some systems. */
1987 if (emacs_close (ofd
) < 0)
1988 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1990 if (input_file_statable_p
)
1992 if (!NILP (keep_time
))
1994 EMACS_TIME atime
, mtime
;
1995 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1996 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1997 if (set_file_times (SSDATA (encoded_newname
),
1999 xsignal2 (Qfile_date_error
,
2000 build_string ("Cannot set file date"), newname
);
2007 if (input_file_statable_p
)
2009 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2010 and if it can't, it tells so. Otherwise, under MSDOS we usually
2011 get only the READ bit, which will make the copied file read-only,
2012 so it's better not to chmod at all. */
2013 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2014 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2017 #endif /* not WINDOWSNT */
2019 /* Discard the unwind protects. */
2020 specpdl_ptr
= specpdl
+ count
;
2026 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2027 Smake_directory_internal
, 1, 1, 0,
2028 doc
: /* Create a new directory named DIRECTORY. */)
2029 (Lisp_Object directory
)
2032 Lisp_Object handler
;
2033 Lisp_Object encoded_dir
;
2035 CHECK_STRING (directory
);
2036 directory
= Fexpand_file_name (directory
, Qnil
);
2038 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2039 if (!NILP (handler
))
2040 return call2 (handler
, Qmake_directory_internal
, directory
);
2042 encoded_dir
= ENCODE_FILE (directory
);
2044 dir
= SSDATA (encoded_dir
);
2047 if (mkdir (dir
) != 0)
2049 if (mkdir (dir
, 0777) != 0)
2051 report_file_error ("Creating directory", list1 (directory
));
2056 DEFUN ("delete-directory-internal", Fdelete_directory_internal
,
2057 Sdelete_directory_internal
, 1, 1, 0,
2058 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2059 (Lisp_Object directory
)
2062 Lisp_Object handler
;
2063 Lisp_Object encoded_dir
;
2065 CHECK_STRING (directory
);
2066 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2067 encoded_dir
= ENCODE_FILE (directory
);
2068 dir
= SSDATA (encoded_dir
);
2070 if (rmdir (dir
) != 0)
2071 report_file_error ("Removing directory", list1 (directory
));
2076 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 2,
2077 "(list (read-file-name \
2078 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2079 \"Move file to trash: \" \"Delete file: \") \
2080 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2081 (null current-prefix-arg))",
2082 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2083 If file has multiple names, it continues to exist with the other names.
2084 TRASH non-nil means to trash the file instead of deleting, provided
2085 `delete-by-moving-to-trash' is non-nil.
2087 When called interactively, TRASH is t if no prefix argument is given.
2088 With a prefix argument, TRASH is nil. */)
2089 (Lisp_Object filename
, Lisp_Object trash
)
2091 Lisp_Object handler
;
2092 Lisp_Object encoded_file
;
2093 struct gcpro gcpro1
;
2096 if (!NILP (Ffile_directory_p (filename
))
2097 && NILP (Ffile_symlink_p (filename
)))
2098 xsignal2 (Qfile_error
,
2099 build_string ("Removing old name: is a directory"),
2102 filename
= Fexpand_file_name (filename
, Qnil
);
2104 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2105 if (!NILP (handler
))
2106 return call3 (handler
, Qdelete_file
, filename
, trash
);
2108 if (delete_by_moving_to_trash
&& !NILP (trash
))
2109 return call1 (Qmove_file_to_trash
, filename
);
2111 encoded_file
= ENCODE_FILE (filename
);
2113 if (0 > unlink (SSDATA (encoded_file
)))
2114 report_file_error ("Removing old name", list1 (filename
));
2119 internal_delete_file_1 (Lisp_Object ignore
)
2124 /* Delete file FILENAME, returning 1 if successful and 0 if failed.
2125 This ignores `delete-by-moving-to-trash'. */
2128 internal_delete_file (Lisp_Object filename
)
2132 tem
= internal_condition_case_2 (Fdelete_file
, filename
, Qnil
,
2133 Qt
, internal_delete_file_1
);
2137 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2138 "fRename file: \nGRename %s to file: \np",
2139 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2140 If file has names other than FILE, it continues to have those names.
2141 Signals a `file-already-exists' error if a file NEWNAME already exists
2142 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2143 A number as third arg means request confirmation if NEWNAME already exists.
2144 This is what happens in interactive use with M-x. */)
2145 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2147 Lisp_Object handler
;
2148 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2149 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2151 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2152 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2153 CHECK_STRING (file
);
2154 CHECK_STRING (newname
);
2155 file
= Fexpand_file_name (file
, Qnil
);
2157 if ((!NILP (Ffile_directory_p (newname
)))
2159 /* If the file names are identical but for the case,
2160 don't attempt to move directory to itself. */
2161 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2165 Lisp_Object fname
= NILP (Ffile_directory_p (file
))
2166 ? file
: Fdirectory_file_name (file
);
2167 newname
= Fexpand_file_name (Ffile_name_nondirectory (fname
), newname
);
2170 newname
= Fexpand_file_name (newname
, Qnil
);
2172 /* If the file name has special constructs in it,
2173 call the corresponding file handler. */
2174 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2176 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2177 if (!NILP (handler
))
2178 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2179 file
, newname
, ok_if_already_exists
));
2181 encoded_file
= ENCODE_FILE (file
);
2182 encoded_newname
= ENCODE_FILE (newname
);
2185 /* If the file names are identical but for the case, don't ask for
2186 confirmation: they simply want to change the letter-case of the
2188 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2190 if (NILP (ok_if_already_exists
)
2191 || INTEGERP (ok_if_already_exists
))
2192 barf_or_query_if_file_exists (newname
, "rename to it",
2193 INTEGERP (ok_if_already_exists
), 0, 0);
2194 if (0 > rename (SSDATA (encoded_file
), SSDATA (encoded_newname
)))
2200 symlink_target
= Ffile_symlink_p (file
);
2201 if (! NILP (symlink_target
))
2202 Fmake_symbolic_link (symlink_target
, newname
,
2203 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2206 if (!NILP (Ffile_directory_p (file
)))
2207 call4 (Qcopy_directory
, file
, newname
, Qt
, Qnil
);
2209 /* We have already prompted if it was an integer, so don't
2210 have copy-file prompt again. */
2211 Fcopy_file (file
, newname
,
2212 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2215 count
= SPECPDL_INDEX ();
2216 specbind (Qdelete_by_moving_to_trash
, Qnil
);
2218 if (!NILP (Ffile_directory_p (file
))
2220 && NILP (symlink_target
)
2223 call2 (Qdelete_directory
, file
, Qt
);
2225 Fdelete_file (file
, Qnil
);
2226 unbind_to (count
, Qnil
);
2229 report_file_error ("Renaming", list2 (file
, newname
));
2235 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2236 "fAdd name to file: \nGName to add to %s: \np",
2237 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2238 Signals a `file-already-exists' error if a file NEWNAME already exists
2239 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2240 A number as third arg means request confirmation if NEWNAME already exists.
2241 This is what happens in interactive use with M-x. */)
2242 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2244 Lisp_Object handler
;
2245 Lisp_Object encoded_file
, encoded_newname
;
2246 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2248 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2249 encoded_file
= encoded_newname
= Qnil
;
2250 CHECK_STRING (file
);
2251 CHECK_STRING (newname
);
2252 file
= Fexpand_file_name (file
, Qnil
);
2254 if (!NILP (Ffile_directory_p (newname
)))
2255 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2257 newname
= Fexpand_file_name (newname
, Qnil
);
2259 /* If the file name has special constructs in it,
2260 call the corresponding file handler. */
2261 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2262 if (!NILP (handler
))
2263 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2264 newname
, ok_if_already_exists
));
2266 /* If the new name has special constructs in it,
2267 call the corresponding file handler. */
2268 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2269 if (!NILP (handler
))
2270 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2271 newname
, ok_if_already_exists
));
2273 encoded_file
= ENCODE_FILE (file
);
2274 encoded_newname
= ENCODE_FILE (newname
);
2276 if (NILP (ok_if_already_exists
)
2277 || INTEGERP (ok_if_already_exists
))
2278 barf_or_query_if_file_exists (newname
, "make it a new name",
2279 INTEGERP (ok_if_already_exists
), 0, 0);
2281 unlink (SSDATA (newname
));
2282 if (0 > link (SSDATA (encoded_file
), SSDATA (encoded_newname
)))
2283 report_file_error ("Adding new name", list2 (file
, newname
));
2289 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2290 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2291 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2292 Both args must be strings.
2293 Signals a `file-already-exists' error if a file LINKNAME already exists
2294 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2295 A number as third arg means request confirmation if LINKNAME already exists.
2296 This happens for interactive use with M-x. */)
2297 (Lisp_Object filename
, Lisp_Object linkname
, Lisp_Object ok_if_already_exists
)
2299 Lisp_Object handler
;
2300 Lisp_Object encoded_filename
, encoded_linkname
;
2301 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2303 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2304 encoded_filename
= encoded_linkname
= Qnil
;
2305 CHECK_STRING (filename
);
2306 CHECK_STRING (linkname
);
2307 /* If the link target has a ~, we must expand it to get
2308 a truly valid file name. Otherwise, do not expand;
2309 we want to permit links to relative file names. */
2310 if (SREF (filename
, 0) == '~')
2311 filename
= Fexpand_file_name (filename
, Qnil
);
2313 if (!NILP (Ffile_directory_p (linkname
)))
2314 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2316 linkname
= Fexpand_file_name (linkname
, Qnil
);
2318 /* If the file name has special constructs in it,
2319 call the corresponding file handler. */
2320 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2321 if (!NILP (handler
))
2322 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2323 linkname
, ok_if_already_exists
));
2325 /* If the new link name has special constructs in it,
2326 call the corresponding file handler. */
2327 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2328 if (!NILP (handler
))
2329 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2330 linkname
, ok_if_already_exists
));
2333 encoded_filename
= ENCODE_FILE (filename
);
2334 encoded_linkname
= ENCODE_FILE (linkname
);
2336 if (NILP (ok_if_already_exists
)
2337 || INTEGERP (ok_if_already_exists
))
2338 barf_or_query_if_file_exists (linkname
, "make it a link",
2339 INTEGERP (ok_if_already_exists
), 0, 0);
2340 if (0 > symlink (SSDATA (encoded_filename
),
2341 SSDATA (encoded_linkname
)))
2343 /* If we didn't complain already, silently delete existing file. */
2344 if (errno
== EEXIST
)
2346 unlink (SSDATA (encoded_linkname
));
2347 if (0 <= symlink (SSDATA (encoded_filename
),
2348 SSDATA (encoded_linkname
)))
2355 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2362 xsignal1 (Qfile_error
, build_string ("Symbolic links are not supported"));
2364 #endif /* S_IFLNK */
2368 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2370 doc
: /* Return t if file FILENAME specifies an absolute file name.
2371 On Unix, this is a name starting with a `/' or a `~'. */)
2372 (Lisp_Object filename
)
2374 CHECK_STRING (filename
);
2375 return file_name_absolute_p (SSDATA (filename
)) ? Qt
: Qnil
;
2378 /* Return nonzero if file FILENAME exists and can be executed. */
2381 check_executable (char *filename
)
2384 int len
= strlen (filename
);
2387 if (stat (filename
, &st
) < 0)
2389 return ((st
.st_mode
& S_IEXEC
) != 0);
2390 #else /* not DOS_NT */
2391 #ifdef HAVE_EUIDACCESS
2392 return (euidaccess (filename
, 1) >= 0);
2394 /* Access isn't quite right because it uses the real uid
2395 and we really want to test with the effective uid.
2396 But Unix doesn't give us a right way to do it. */
2397 return (access (filename
, 1) >= 0);
2399 #endif /* not DOS_NT */
2402 /* Return nonzero if file FILENAME exists and can be written. */
2405 check_writable (const char *filename
)
2409 if (stat (filename
, &st
) < 0)
2411 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2412 #else /* not MSDOS */
2413 #ifdef HAVE_EUIDACCESS
2414 return (euidaccess (filename
, 2) >= 0);
2416 /* Access isn't quite right because it uses the real uid
2417 and we really want to test with the effective uid.
2418 But Unix doesn't give us a right way to do it.
2419 Opening with O_WRONLY could work for an ordinary file,
2420 but would lose for directories. */
2421 return (access (filename
, 2) >= 0);
2423 #endif /* not MSDOS */
2426 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2427 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
2428 See also `file-readable-p' and `file-attributes'.
2429 This returns nil for a symlink to a nonexistent file.
2430 Use `file-symlink-p' to test for such links. */)
2431 (Lisp_Object filename
)
2433 Lisp_Object absname
;
2434 Lisp_Object handler
;
2435 struct stat statbuf
;
2437 CHECK_STRING (filename
);
2438 absname
= Fexpand_file_name (filename
, Qnil
);
2440 /* If the file name has special constructs in it,
2441 call the corresponding file handler. */
2442 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2443 if (!NILP (handler
))
2444 return call2 (handler
, Qfile_exists_p
, absname
);
2446 absname
= ENCODE_FILE (absname
);
2448 return (stat (SSDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
2451 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2452 doc
: /* Return t if FILENAME can be executed by you.
2453 For a directory, this means you can access files in that directory. */)
2454 (Lisp_Object filename
)
2456 Lisp_Object absname
;
2457 Lisp_Object handler
;
2459 CHECK_STRING (filename
);
2460 absname
= Fexpand_file_name (filename
, Qnil
);
2462 /* If the file name has special constructs in it,
2463 call the corresponding file handler. */
2464 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2465 if (!NILP (handler
))
2466 return call2 (handler
, Qfile_executable_p
, absname
);
2468 absname
= ENCODE_FILE (absname
);
2470 return (check_executable (SSDATA (absname
)) ? Qt
: Qnil
);
2473 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2474 doc
: /* Return t if file FILENAME exists and you can read it.
2475 See also `file-exists-p' and `file-attributes'. */)
2476 (Lisp_Object filename
)
2478 Lisp_Object absname
;
2479 Lisp_Object handler
;
2482 struct stat statbuf
;
2484 CHECK_STRING (filename
);
2485 absname
= Fexpand_file_name (filename
, Qnil
);
2487 /* If the file name has special constructs in it,
2488 call the corresponding file handler. */
2489 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2490 if (!NILP (handler
))
2491 return call2 (handler
, Qfile_readable_p
, absname
);
2493 absname
= ENCODE_FILE (absname
);
2495 #if defined(DOS_NT) || defined(macintosh)
2496 /* Under MS-DOS, Windows, and Macintosh, open does not work for
2498 if (access (SDATA (absname
), 0) == 0)
2501 #else /* not DOS_NT and not macintosh */
2503 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2504 /* Opening a fifo without O_NONBLOCK can wait.
2505 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2506 except in the case of a fifo, on a system which handles it. */
2507 desc
= stat (SSDATA (absname
), &statbuf
);
2510 if (S_ISFIFO (statbuf
.st_mode
))
2511 flags
|= O_NONBLOCK
;
2513 desc
= emacs_open (SSDATA (absname
), flags
, 0);
2518 #endif /* not DOS_NT and not macintosh */
2521 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2523 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2524 doc
: /* Return t if file FILENAME can be written or created by you. */)
2525 (Lisp_Object filename
)
2527 Lisp_Object absname
, dir
, encoded
;
2528 Lisp_Object handler
;
2529 struct stat statbuf
;
2531 CHECK_STRING (filename
);
2532 absname
= Fexpand_file_name (filename
, Qnil
);
2534 /* If the file name has special constructs in it,
2535 call the corresponding file handler. */
2536 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2537 if (!NILP (handler
))
2538 return call2 (handler
, Qfile_writable_p
, absname
);
2540 encoded
= ENCODE_FILE (absname
);
2541 if (stat (SSDATA (encoded
), &statbuf
) >= 0)
2542 return (check_writable (SSDATA (encoded
))
2545 dir
= Ffile_name_directory (absname
);
2548 dir
= Fdirectory_file_name (dir
);
2551 dir
= ENCODE_FILE (dir
);
2553 /* The read-only attribute of the parent directory doesn't affect
2554 whether a file or directory can be created within it. Some day we
2555 should check ACLs though, which do affect this. */
2556 if (stat (SDATA (dir
), &statbuf
) < 0)
2558 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2560 return (check_writable (!NILP (dir
) ? SSDATA (dir
) : "")
2565 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2566 doc
: /* Access file FILENAME, and get an error if that does not work.
2567 The second argument STRING is used in the error message.
2568 If there is no error, returns nil. */)
2569 (Lisp_Object filename
, Lisp_Object string
)
2571 Lisp_Object handler
, encoded_filename
, absname
;
2574 CHECK_STRING (filename
);
2575 absname
= Fexpand_file_name (filename
, Qnil
);
2577 CHECK_STRING (string
);
2579 /* If the file name has special constructs in it,
2580 call the corresponding file handler. */
2581 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
2582 if (!NILP (handler
))
2583 return call3 (handler
, Qaccess_file
, absname
, string
);
2585 encoded_filename
= ENCODE_FILE (absname
);
2587 fd
= emacs_open (SSDATA (encoded_filename
), O_RDONLY
, 0);
2589 report_file_error (SSDATA (string
), Fcons (filename
, Qnil
));
2595 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2596 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
2597 The value is the link target, as a string.
2598 Otherwise it returns nil.
2600 This function returns t when given the name of a symlink that
2601 points to a nonexistent file. */)
2602 (Lisp_Object filename
)
2604 Lisp_Object handler
;
2606 CHECK_STRING (filename
);
2607 filename
= Fexpand_file_name (filename
, Qnil
);
2609 /* If the file name has special constructs in it,
2610 call the corresponding file handler. */
2611 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2612 if (!NILP (handler
))
2613 return call2 (handler
, Qfile_symlink_p
, filename
);
2622 filename
= ENCODE_FILE (filename
);
2629 buf
= (char *) xrealloc (buf
, bufsize
);
2630 memset (buf
, 0, bufsize
);
2633 valsize
= readlink (SSDATA (filename
), buf
, bufsize
);
2637 /* HP-UX reports ERANGE if buffer is too small. */
2638 if (errno
== ERANGE
)
2648 while (valsize
>= bufsize
);
2650 val
= make_string (buf
, valsize
);
2651 if (buf
[0] == '/' && strchr (buf
, ':'))
2652 val
= concat2 (build_string ("/:"), val
);
2654 val
= DECODE_FILE (val
);
2657 #else /* not S_IFLNK */
2659 #endif /* not S_IFLNK */
2662 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2663 doc
: /* Return t if FILENAME names an existing directory.
2664 Symbolic links to directories count as directories.
2665 See `file-symlink-p' to distinguish symlinks. */)
2666 (Lisp_Object filename
)
2668 register Lisp_Object absname
;
2670 Lisp_Object handler
;
2672 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2674 /* If the file name has special constructs in it,
2675 call the corresponding file handler. */
2676 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2677 if (!NILP (handler
))
2678 return call2 (handler
, Qfile_directory_p
, absname
);
2680 absname
= ENCODE_FILE (absname
);
2682 if (stat (SSDATA (absname
), &st
) < 0)
2684 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2687 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2688 doc
: /* Return t if file FILENAME names a directory you can open.
2689 For the value to be t, FILENAME must specify the name of a directory as a file,
2690 and the directory must allow you to open files in it. In order to use a
2691 directory as a buffer's current directory, this predicate must return true.
2692 A directory name spec may be given instead; then the value is t
2693 if the directory so specified exists and really is a readable and
2694 searchable directory. */)
2695 (Lisp_Object filename
)
2697 Lisp_Object handler
;
2699 struct gcpro gcpro1
;
2701 /* If the file name has special constructs in it,
2702 call the corresponding file handler. */
2703 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2704 if (!NILP (handler
))
2705 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2708 tem
= (NILP (Ffile_directory_p (filename
))
2709 || NILP (Ffile_executable_p (filename
)));
2711 return tem
? Qnil
: Qt
;
2714 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2715 doc
: /* Return t if FILENAME names a regular file.
2716 This is the sort of file that holds an ordinary stream of data bytes.
2717 Symbolic links to regular files count as regular files.
2718 See `file-symlink-p' to distinguish symlinks. */)
2719 (Lisp_Object filename
)
2721 register Lisp_Object absname
;
2723 Lisp_Object handler
;
2725 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2727 /* If the file name has special constructs in it,
2728 call the corresponding file handler. */
2729 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2730 if (!NILP (handler
))
2731 return call2 (handler
, Qfile_regular_p
, absname
);
2733 absname
= ENCODE_FILE (absname
);
2738 Lisp_Object tem
= Vw32_get_true_file_attributes
;
2740 /* Tell stat to use expensive method to get accurate info. */
2741 Vw32_get_true_file_attributes
= Qt
;
2742 result
= stat (SDATA (absname
), &st
);
2743 Vw32_get_true_file_attributes
= tem
;
2747 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2750 if (stat (SSDATA (absname
), &st
) < 0)
2752 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2756 DEFUN ("file-selinux-context", Ffile_selinux_context
,
2757 Sfile_selinux_context
, 1, 1, 0,
2758 doc
: /* Return SELinux context of file named FILENAME,
2759 as a list ("user", "role", "type", "range"). Return (nil, nil, nil, nil)
2760 if file does not exist, is not accessible, or SELinux is disabled */)
2761 (Lisp_Object filename
)
2763 Lisp_Object absname
;
2764 Lisp_Object values
[4];
2765 Lisp_Object handler
;
2767 security_context_t con
;
2772 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2774 /* If the file name has special constructs in it,
2775 call the corresponding file handler. */
2776 handler
= Ffind_file_name_handler (absname
, Qfile_selinux_context
);
2777 if (!NILP (handler
))
2778 return call2 (handler
, Qfile_selinux_context
, absname
);
2780 absname
= ENCODE_FILE (absname
);
2787 if (is_selinux_enabled ())
2789 conlength
= lgetfilecon (SDATA (absname
), &con
);
2792 context
= context_new (con
);
2793 if (context_user_get (context
))
2794 values
[0] = build_string (context_user_get (context
));
2795 if (context_role_get (context
))
2796 values
[1] = build_string (context_role_get (context
));
2797 if (context_type_get (context
))
2798 values
[2] = build_string (context_type_get (context
));
2799 if (context_range_get (context
))
2800 values
[3] = build_string (context_range_get (context
));
2801 context_free (context
);
2808 return Flist (sizeof(values
) / sizeof(values
[0]), values
);
2811 DEFUN ("set-file-selinux-context", Fset_file_selinux_context
,
2812 Sset_file_selinux_context
, 2, 2, 0,
2813 doc
: /* Set SELinux context of file named FILENAME to CONTEXT
2814 as a list ("user", "role", "type", "range"). Has no effect if SELinux
2816 (Lisp_Object filename
, Lisp_Object context
)
2818 Lisp_Object absname
, encoded_absname
;
2819 Lisp_Object handler
;
2820 Lisp_Object user
= CAR_SAFE (context
);
2821 Lisp_Object role
= CAR_SAFE (CDR_SAFE (context
));
2822 Lisp_Object type
= CAR_SAFE (CDR_SAFE (CDR_SAFE (context
)));
2823 Lisp_Object range
= CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context
))));
2825 security_context_t con
;
2826 int fail
, conlength
;
2827 context_t parsed_con
;
2830 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2832 /* If the file name has special constructs in it,
2833 call the corresponding file handler. */
2834 handler
= Ffind_file_name_handler (absname
, Qset_file_selinux_context
);
2835 if (!NILP (handler
))
2836 return call3 (handler
, Qset_file_selinux_context
, absname
, context
);
2838 encoded_absname
= ENCODE_FILE (absname
);
2841 if (is_selinux_enabled ())
2843 /* Get current file context. */
2844 conlength
= lgetfilecon (SDATA (encoded_absname
), &con
);
2847 parsed_con
= context_new (con
);
2848 /* Change the parts defined in the parameter.*/
2851 if (context_user_set (parsed_con
, SDATA (user
)))
2852 error ("Doing context_user_set");
2856 if (context_role_set (parsed_con
, SDATA (role
)))
2857 error ("Doing context_role_set");
2861 if (context_type_set (parsed_con
, SDATA (type
)))
2862 error ("Doing context_type_set");
2864 if (STRINGP (range
))
2866 if (context_range_set (parsed_con
, SDATA (range
)))
2867 error ("Doing context_range_set");
2870 /* Set the modified context back to the file. */
2871 fail
= lsetfilecon (SDATA (encoded_absname
), context_str (parsed_con
));
2873 report_file_error ("Doing lsetfilecon", Fcons (absname
, Qnil
));
2875 context_free (parsed_con
);
2878 report_file_error("Doing lgetfilecon", Fcons (absname
, Qnil
));
2888 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2889 doc
: /* Return mode bits of file named FILENAME, as an integer.
2890 Return nil, if file does not exist or is not accessible. */)
2891 (Lisp_Object filename
)
2893 Lisp_Object absname
;
2895 Lisp_Object handler
;
2897 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2899 /* If the file name has special constructs in it,
2900 call the corresponding file handler. */
2901 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2902 if (!NILP (handler
))
2903 return call2 (handler
, Qfile_modes
, absname
);
2905 absname
= ENCODE_FILE (absname
);
2907 if (stat (SSDATA (absname
), &st
) < 0)
2910 return make_number (st
.st_mode
& 07777);
2913 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
2914 "(let ((file (read-file-name \"File: \"))) \
2915 (list file (read-file-modes nil file)))",
2916 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
2917 Only the 12 low bits of MODE are used.
2919 Interactively, mode bits are read by `read-file-modes', which accepts
2920 symbolic notation, like the `chmod' command from GNU Coreutils. */)
2921 (Lisp_Object filename
, Lisp_Object mode
)
2923 Lisp_Object absname
, encoded_absname
;
2924 Lisp_Object handler
;
2926 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2927 CHECK_NUMBER (mode
);
2929 /* If the file name has special constructs in it,
2930 call the corresponding file handler. */
2931 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2932 if (!NILP (handler
))
2933 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2935 encoded_absname
= ENCODE_FILE (absname
);
2937 if (chmod (SSDATA (encoded_absname
), XINT (mode
)) < 0)
2938 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2943 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2944 doc
: /* Set the file permission bits for newly created files.
2945 The argument MODE should be an integer; only the low 9 bits are used.
2946 This setting is inherited by subprocesses. */)
2949 CHECK_NUMBER (mode
);
2951 umask ((~ XINT (mode
)) & 0777);
2956 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2957 doc
: /* Return the default file protection for created files.
2958 The value is an integer. */)
2964 realmask
= umask (0);
2967 XSETINT (value
, (~ realmask
) & 0777);
2972 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
2973 doc
: /* Set times of file FILENAME to TIME.
2974 Set both access and modification times.
2975 Return t on success, else nil.
2976 Use the current time if TIME is nil. TIME is in the format of
2978 (Lisp_Object filename
, Lisp_Object time
)
2980 Lisp_Object absname
, encoded_absname
;
2981 Lisp_Object handler
;
2985 if (! lisp_time_argument (time
, &sec
, &usec
))
2986 error ("Invalid time specification");
2988 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2990 /* If the file name has special constructs in it,
2991 call the corresponding file handler. */
2992 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
2993 if (!NILP (handler
))
2994 return call3 (handler
, Qset_file_times
, absname
, time
);
2996 encoded_absname
= ENCODE_FILE (absname
);
3001 EMACS_SET_SECS (t
, sec
);
3002 EMACS_SET_USECS (t
, usec
);
3004 if (set_file_times (SSDATA (encoded_absname
), t
, t
))
3009 /* Setting times on a directory always fails. */
3010 if (stat (SDATA (encoded_absname
), &st
) == 0
3011 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3014 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3023 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3024 doc
: /* Tell Unix to finish all pending disk updates. */)
3031 #endif /* HAVE_SYNC */
3033 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3034 doc
: /* Return t if file FILE1 is newer than file FILE2.
3035 If FILE1 does not exist, the answer is nil;
3036 otherwise, if FILE2 does not exist, the answer is t. */)
3037 (Lisp_Object file1
, Lisp_Object file2
)
3039 Lisp_Object absname1
, absname2
;
3042 Lisp_Object handler
;
3043 struct gcpro gcpro1
, gcpro2
;
3045 CHECK_STRING (file1
);
3046 CHECK_STRING (file2
);
3049 GCPRO2 (absname1
, file2
);
3050 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3051 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3054 /* If the file name has special constructs in it,
3055 call the corresponding file handler. */
3056 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3058 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3059 if (!NILP (handler
))
3060 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3062 GCPRO2 (absname1
, absname2
);
3063 absname1
= ENCODE_FILE (absname1
);
3064 absname2
= ENCODE_FILE (absname2
);
3067 if (stat (SSDATA (absname1
), &st
) < 0)
3070 mtime1
= st
.st_mtime
;
3072 if (stat (SSDATA (absname2
), &st
) < 0)
3075 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3079 Lisp_Object Qfind_buffer_file_type
;
3082 #ifndef READ_BUF_SIZE
3083 #define READ_BUF_SIZE (64 << 10)
3086 /* This function is called after Lisp functions to decide a coding
3087 system are called, or when they cause an error. Before they are
3088 called, the current buffer is set unibyte and it contains only a
3089 newly inserted text (thus the buffer was empty before the
3092 The functions may set markers, overlays, text properties, or even
3093 alter the buffer contents, change the current buffer.
3095 Here, we reset all those changes by:
3096 o set back the current buffer.
3097 o move all markers and overlays to BEG.
3098 o remove all text properties.
3099 o set back the buffer multibyteness. */
3102 decide_coding_unwind (Lisp_Object unwind_data
)
3104 Lisp_Object multibyte
, undo_list
, buffer
;
3106 multibyte
= XCAR (unwind_data
);
3107 unwind_data
= XCDR (unwind_data
);
3108 undo_list
= XCAR (unwind_data
);
3109 buffer
= XCDR (unwind_data
);
3111 if (current_buffer
!= XBUFFER (buffer
))
3112 set_buffer_internal (XBUFFER (buffer
));
3113 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3114 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3115 BUF_INTERVALS (current_buffer
) = 0;
3116 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3118 /* Now we are safe to change the buffer's multibyteness directly. */
3119 current_buffer
->enable_multibyte_characters
= multibyte
;
3120 current_buffer
->undo_list
= undo_list
;
3126 /* Used to pass values from insert-file-contents to read_non_regular. */
3128 static int non_regular_fd
;
3129 static EMACS_INT non_regular_inserted
;
3130 static EMACS_INT non_regular_nbytes
;
3133 /* Read from a non-regular file.
3134 Read non_regular_nbytes bytes max from non_regular_fd.
3135 Non_regular_inserted specifies where to put the read bytes.
3136 Value is the number of bytes read. */
3139 read_non_regular (Lisp_Object ignore
)
3145 nbytes
= emacs_read (non_regular_fd
,
3146 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
3147 + non_regular_inserted
),
3148 non_regular_nbytes
);
3150 return make_number (nbytes
);
3154 /* Condition-case handler used when reading from non-regular files
3155 in insert-file-contents. */
3158 read_non_regular_quit (Lisp_Object ignore
)
3164 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3166 doc
: /* Insert contents of file FILENAME after point.
3167 Returns list of absolute file name and number of characters inserted.
3168 If second argument VISIT is non-nil, the buffer's visited filename and
3169 last save file modtime are set, and it is marked unmodified. If
3170 visiting and the file does not exist, visiting is completed before the
3173 The optional third and fourth arguments BEG and END specify what portion
3174 of the file to insert. These arguments count bytes in the file, not
3175 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3177 If optional fifth argument REPLACE is non-nil, replace the current
3178 buffer contents (in the accessible portion) with the file contents.
3179 This is better than simply deleting and inserting the whole thing
3180 because (1) it preserves some marker positions and (2) it puts less data
3181 in the undo list. When REPLACE is non-nil, the second return value is
3182 the number of characters that replace previous buffer contents.
3184 This function does code conversion according to the value of
3185 `coding-system-for-read' or `file-coding-system-alist', and sets the
3186 variable `last-coding-system-used' to the coding system actually used. */)
3187 (Lisp_Object filename
, Lisp_Object visit
, Lisp_Object beg
, Lisp_Object end
, Lisp_Object replace
)
3191 EMACS_INT inserted
= 0;
3193 register EMACS_INT how_much
;
3194 register EMACS_INT unprocessed
;
3195 int count
= SPECPDL_INDEX ();
3196 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3197 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3199 EMACS_INT total
= 0;
3200 int not_regular
= 0;
3201 char read_buf
[READ_BUF_SIZE
];
3202 struct coding_system coding
;
3203 char buffer
[1 << 14];
3204 int replace_handled
= 0;
3205 int set_coding_system
= 0;
3206 Lisp_Object coding_system
;
3208 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3209 int we_locked_file
= 0;
3210 int deferred_remove_unwind_protect
= 0;
3212 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3213 error ("Cannot do file visiting in an indirect buffer");
3215 if (!NILP (current_buffer
->read_only
))
3216 Fbarf_if_buffer_read_only ();
3220 orig_filename
= Qnil
;
3223 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3225 CHECK_STRING (filename
);
3226 filename
= Fexpand_file_name (filename
, Qnil
);
3228 /* The value Qnil means that the coding system is not yet
3230 coding_system
= Qnil
;
3232 /* If the file name has special constructs in it,
3233 call the corresponding file handler. */
3234 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3235 if (!NILP (handler
))
3237 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3238 visit
, beg
, end
, replace
);
3239 if (CONSP (val
) && CONSP (XCDR (val
)))
3240 inserted
= XINT (XCAR (XCDR (val
)));
3244 orig_filename
= filename
;
3245 filename
= ENCODE_FILE (filename
);
3251 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3253 /* Tell stat to use expensive method to get accurate info. */
3254 Vw32_get_true_file_attributes
= Qt
;
3255 total
= stat (SSDATA (filename
), &st
);
3256 Vw32_get_true_file_attributes
= tem
;
3260 if (stat (SSDATA (filename
), &st
) < 0)
3261 #endif /* WINDOWSNT */
3263 if (fd
>= 0) emacs_close (fd
);
3266 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3269 if (!NILP (Vcoding_system_for_read
))
3270 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3275 /* This code will need to be changed in order to work on named
3276 pipes, and it's probably just not worth it. So we should at
3277 least signal an error. */
3278 if (!S_ISREG (st
.st_mode
))
3285 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3286 xsignal2 (Qfile_error
,
3287 build_string ("not a regular file"), orig_filename
);
3292 if ((fd
= emacs_open (SSDATA (filename
), O_RDONLY
, 0)) < 0)
3295 /* Replacement should preserve point as it preserves markers. */
3296 if (!NILP (replace
))
3297 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3299 record_unwind_protect (close_file_unwind
, make_number (fd
));
3301 /* Can happen on any platform that uses long as type of off_t, but allows
3302 file sizes to exceed 2Gb, so give a suitable message. */
3303 if (! not_regular
&& st
.st_size
< 0)
3304 error ("Maximum buffer size exceeded");
3306 /* Prevent redisplay optimizations. */
3307 current_buffer
->clip_changed
= 1;
3311 if (!NILP (beg
) || !NILP (end
))
3312 error ("Attempt to visit less than an entire file");
3313 if (BEG
< Z
&& NILP (replace
))
3314 error ("Cannot do file visiting in a non-empty buffer");
3320 XSETFASTINT (beg
, 0);
3328 XSETINT (end
, st
.st_size
);
3330 /* Arithmetic overflow can occur if an Emacs integer cannot
3331 represent the file size, or if the calculations below
3332 overflow. The calculations below double the file size
3333 twice, so check that it can be multiplied by 4 safely. */
3334 if (XINT (end
) != st
.st_size
3335 /* Actually, it should test either INT_MAX or LONG_MAX
3336 depending on which one is used for EMACS_INT. But in
3337 any case, in practice, this test is redundant with the
3339 || st.st_size > INT_MAX / 4 */)
3340 error ("Maximum buffer size exceeded");
3342 /* The file size returned from stat may be zero, but data
3343 may be readable nonetheless, for example when this is a
3344 file in the /proc filesystem. */
3345 if (st
.st_size
== 0)
3346 XSETINT (end
, READ_BUF_SIZE
);
3350 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3352 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3353 setup_coding_system (coding_system
, &coding
);
3354 /* Ensure we set Vlast_coding_system_used. */
3355 set_coding_system
= 1;
3359 /* Decide the coding system to use for reading the file now
3360 because we can't use an optimized method for handling
3361 `coding:' tag if the current buffer is not empty. */
3362 if (!NILP (Vcoding_system_for_read
))
3363 coding_system
= Vcoding_system_for_read
;
3366 /* Don't try looking inside a file for a coding system
3367 specification if it is not seekable. */
3368 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3370 /* Find a coding system specified in the heading two
3371 lines or in the tailing several lines of the file.
3372 We assume that the 1K-byte and 3K-byte for heading
3373 and tailing respectively are sufficient for this
3377 if (st
.st_size
<= (1024 * 4))
3378 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3381 nread
= emacs_read (fd
, read_buf
, 1024);
3384 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3385 report_file_error ("Setting file position",
3386 Fcons (orig_filename
, Qnil
));
3387 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3392 error ("IO error reading %s: %s",
3393 SDATA (orig_filename
), emacs_strerror (errno
));
3396 struct buffer
*prev
= current_buffer
;
3400 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3402 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3403 buf
= XBUFFER (buffer
);
3405 delete_all_overlays (buf
);
3406 buf
->directory
= current_buffer
->directory
;
3407 buf
->read_only
= Qnil
;
3408 buf
->filename
= Qnil
;
3409 buf
->undo_list
= Qt
;
3410 eassert (buf
->overlays_before
== NULL
);
3411 eassert (buf
->overlays_after
== NULL
);
3413 set_buffer_internal (buf
);
3415 buf
->enable_multibyte_characters
= Qnil
;
3417 insert_1_both ((char *) read_buf
, nread
, nread
, 0, 0, 0);
3418 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3419 coding_system
= call2 (Vset_auto_coding_function
,
3420 filename
, make_number (nread
));
3421 set_buffer_internal (prev
);
3423 /* Discard the unwind protect for recovering the
3427 /* Rewind the file for the actual read done later. */
3428 if (lseek (fd
, 0, 0) < 0)
3429 report_file_error ("Setting file position",
3430 Fcons (orig_filename
, Qnil
));
3434 if (NILP (coding_system
))
3436 /* If we have not yet decided a coding system, check
3437 file-coding-system-alist. */
3438 Lisp_Object args
[6];
3440 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3441 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3442 coding_system
= Ffind_operation_coding_system (6, args
);
3443 if (CONSP (coding_system
))
3444 coding_system
= XCAR (coding_system
);
3448 if (NILP (coding_system
))
3449 coding_system
= Qundecided
;
3451 CHECK_CODING_SYSTEM (coding_system
);
3453 if (NILP (current_buffer
->enable_multibyte_characters
))
3454 /* We must suppress all character code conversion except for
3455 end-of-line conversion. */
3456 coding_system
= raw_text_coding_system (coding_system
);
3458 setup_coding_system (coding_system
, &coding
);
3459 /* Ensure we set Vlast_coding_system_used. */
3460 set_coding_system
= 1;
3463 /* If requested, replace the accessible part of the buffer
3464 with the file contents. Avoid replacing text at the
3465 beginning or end of the buffer that matches the file contents;
3466 that preserves markers pointing to the unchanged parts.
3468 Here we implement this feature in an optimized way
3469 for the case where code conversion is NOT needed.
3470 The following if-statement handles the case of conversion
3471 in a less optimal way.
3473 If the code conversion is "automatic" then we try using this
3474 method and hope for the best.
3475 But if we discover the need for conversion, we give up on this method
3476 and let the following if-statement handle the replace job. */
3479 && (NILP (coding_system
)
3480 || ! CODING_REQUIRE_DECODING (&coding
)))
3482 /* same_at_start and same_at_end count bytes,
3483 because file access counts bytes
3484 and BEG and END count bytes. */
3485 EMACS_INT same_at_start
= BEGV_BYTE
;
3486 EMACS_INT same_at_end
= ZV_BYTE
;
3488 /* There is still a possibility we will find the need to do code
3489 conversion. If that happens, we set this variable to 1 to
3490 give up on handling REPLACE in the optimized way. */
3491 int giveup_match_end
= 0;
3493 if (XINT (beg
) != 0)
3495 if (lseek (fd
, XINT (beg
), 0) < 0)
3496 report_file_error ("Setting file position",
3497 Fcons (orig_filename
, Qnil
));
3502 /* Count how many chars at the start of the file
3503 match the text at the beginning of the buffer. */
3506 EMACS_INT nread
, bufpos
;
3508 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3510 error ("IO error reading %s: %s",
3511 SSDATA (orig_filename
), emacs_strerror (errno
));
3512 else if (nread
== 0)
3515 if (CODING_REQUIRE_DETECTION (&coding
))
3517 coding_system
= detect_coding_system ((unsigned char *) buffer
,
3520 setup_coding_system (coding_system
, &coding
);
3523 if (CODING_REQUIRE_DECODING (&coding
))
3524 /* We found that the file should be decoded somehow.
3525 Let's give up here. */
3527 giveup_match_end
= 1;
3532 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3533 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3534 same_at_start
++, bufpos
++;
3535 /* If we found a discrepancy, stop the scan.
3536 Otherwise loop around and scan the next bufferful. */
3537 if (bufpos
!= nread
)
3541 /* If the file matches the buffer completely,
3542 there's no need to replace anything. */
3543 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3547 /* Truncate the buffer to the size of the file. */
3548 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3553 /* Count how many chars at the end of the file
3554 match the text at the end of the buffer. But, if we have
3555 already found that decoding is necessary, don't waste time. */
3556 while (!giveup_match_end
)
3558 EMACS_INT total_read
, nread
, bufpos
, curpos
, trial
;
3560 /* At what file position are we now scanning? */
3561 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3562 /* If the entire file matches the buffer tail, stop the scan. */
3565 /* How much can we scan in the next step? */
3566 trial
= min (curpos
, sizeof buffer
);
3567 if (lseek (fd
, curpos
- trial
, 0) < 0)
3568 report_file_error ("Setting file position",
3569 Fcons (orig_filename
, Qnil
));
3571 total_read
= nread
= 0;
3572 while (total_read
< trial
)
3574 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3576 error ("IO error reading %s: %s",
3577 SDATA (orig_filename
), emacs_strerror (errno
));
3578 else if (nread
== 0)
3580 total_read
+= nread
;
3583 /* Scan this bufferful from the end, comparing with
3584 the Emacs buffer. */
3585 bufpos
= total_read
;
3587 /* Compare with same_at_start to avoid counting some buffer text
3588 as matching both at the file's beginning and at the end. */
3589 while (bufpos
> 0 && same_at_end
> same_at_start
3590 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3591 same_at_end
--, bufpos
--;
3593 /* If we found a discrepancy, stop the scan.
3594 Otherwise loop around and scan the preceding bufferful. */
3597 /* If this discrepancy is because of code conversion,
3598 we cannot use this method; giveup and try the other. */
3599 if (same_at_end
> same_at_start
3600 && FETCH_BYTE (same_at_end
- 1) >= 0200
3601 && ! NILP (current_buffer
->enable_multibyte_characters
)
3602 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3603 giveup_match_end
= 1;
3612 if (! giveup_match_end
)
3616 /* We win! We can handle REPLACE the optimized way. */
3618 /* Extend the start of non-matching text area to multibyte
3619 character boundary. */
3620 if (! NILP (current_buffer
->enable_multibyte_characters
))
3621 while (same_at_start
> BEGV_BYTE
3622 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3625 /* Extend the end of non-matching text area to multibyte
3626 character boundary. */
3627 if (! NILP (current_buffer
->enable_multibyte_characters
))
3628 while (same_at_end
< ZV_BYTE
3629 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3632 /* Don't try to reuse the same piece of text twice. */
3633 overlap
= (same_at_start
- BEGV_BYTE
3634 - (same_at_end
+ st
.st_size
- ZV
));
3636 same_at_end
+= overlap
;
3638 /* Arrange to read only the nonmatching middle part of the file. */
3639 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3640 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3642 del_range_byte (same_at_start
, same_at_end
, 0);
3643 /* Insert from the file at the proper position. */
3644 temp
= BYTE_TO_CHAR (same_at_start
);
3645 SET_PT_BOTH (temp
, same_at_start
);
3647 /* If display currently starts at beginning of line,
3648 keep it that way. */
3649 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3650 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3652 replace_handled
= 1;
3656 /* If requested, replace the accessible part of the buffer
3657 with the file contents. Avoid replacing text at the
3658 beginning or end of the buffer that matches the file contents;
3659 that preserves markers pointing to the unchanged parts.
3661 Here we implement this feature for the case where code conversion
3662 is needed, in a simple way that needs a lot of memory.
3663 The preceding if-statement handles the case of no conversion
3664 in a more optimized way. */
3665 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3667 EMACS_INT same_at_start
= BEGV_BYTE
;
3668 EMACS_INT same_at_end
= ZV_BYTE
;
3669 EMACS_INT same_at_start_charpos
;
3670 EMACS_INT inserted_chars
;
3673 unsigned char *decoded
;
3675 int this_count
= SPECPDL_INDEX ();
3676 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3677 Lisp_Object conversion_buffer
;
3679 conversion_buffer
= code_conversion_save (1, multibyte
);
3681 /* First read the whole file, performing code conversion into
3682 CONVERSION_BUFFER. */
3684 if (lseek (fd
, XINT (beg
), 0) < 0)
3685 report_file_error ("Setting file position",
3686 Fcons (orig_filename
, Qnil
));
3688 total
= st
.st_size
; /* Total bytes in the file. */
3689 how_much
= 0; /* Bytes read from file so far. */
3690 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3691 unprocessed
= 0; /* Bytes not processed in previous loop. */
3693 GCPRO1 (conversion_buffer
);
3694 while (how_much
< total
)
3696 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
3697 quitting while reading a huge while. */
3698 /* try is reserved in some compilers (Microsoft C) */
3699 EMACS_INT trytry
= min (total
- how_much
,
3700 READ_BUF_SIZE
- unprocessed
);
3703 /* Allow quitting out of the actual I/O. */
3706 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
3718 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
3719 BUF_Z (XBUFFER (conversion_buffer
)));
3720 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3721 unprocessed
+ this, conversion_buffer
);
3722 unprocessed
= coding
.carryover_bytes
;
3723 if (coding
.carryover_bytes
> 0)
3724 memcpy (read_buf
, coding
.carryover
, unprocessed
);
3729 /* We should remove the unwind_protect calling
3730 close_file_unwind, but other stuff has been added the stack,
3731 so defer the removal till we reach the `handled' label. */
3732 deferred_remove_unwind_protect
= 1;
3734 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
3735 if we couldn't read the file. */
3738 error ("IO error reading %s: %s",
3739 SDATA (orig_filename
), emacs_strerror (errno
));
3741 if (unprocessed
> 0)
3743 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3744 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3745 unprocessed
, conversion_buffer
);
3746 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
3749 coding_system
= CODING_ID_NAME (coding
.id
);
3750 set_coding_system
= 1;
3751 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
3752 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
3753 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3755 /* Compare the beginning of the converted string with the buffer
3759 while (bufpos
< inserted
&& same_at_start
< same_at_end
3760 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
3761 same_at_start
++, bufpos
++;
3763 /* If the file matches the head of buffer completely,
3764 there's no need to replace anything. */
3766 if (bufpos
== inserted
)
3768 /* Truncate the buffer to the size of the file. */
3769 if (same_at_start
== same_at_end
)
3772 del_range_byte (same_at_start
, same_at_end
, 0);
3775 unbind_to (this_count
, Qnil
);
3779 /* Extend the start of non-matching text area to the previous
3780 multibyte character boundary. */
3781 if (! NILP (current_buffer
->enable_multibyte_characters
))
3782 while (same_at_start
> BEGV_BYTE
3783 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3786 /* Scan this bufferful from the end, comparing with
3787 the Emacs buffer. */
3790 /* Compare with same_at_start to avoid counting some buffer text
3791 as matching both at the file's beginning and at the end. */
3792 while (bufpos
> 0 && same_at_end
> same_at_start
3793 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
3794 same_at_end
--, bufpos
--;
3796 /* Extend the end of non-matching text area to the next
3797 multibyte character boundary. */
3798 if (! NILP (current_buffer
->enable_multibyte_characters
))
3799 while (same_at_end
< ZV_BYTE
3800 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3803 /* Don't try to reuse the same piece of text twice. */
3804 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3806 same_at_end
+= overlap
;
3808 /* If display currently starts at beginning of line,
3809 keep it that way. */
3810 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3811 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3813 /* Replace the chars that we need to replace,
3814 and update INSERTED to equal the number of bytes
3815 we are taking from the decoded string. */
3816 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
3818 if (same_at_end
!= same_at_start
)
3820 del_range_byte (same_at_start
, same_at_end
, 0);
3822 same_at_start
= GPT_BYTE
;
3826 temp
= BYTE_TO_CHAR (same_at_start
);
3828 /* Insert from the file at the proper position. */
3829 SET_PT_BOTH (temp
, same_at_start
);
3830 same_at_start_charpos
3831 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3832 same_at_start
- BEGV_BYTE
3833 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3835 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3836 same_at_start
+ inserted
- BEGV_BYTE
3837 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
3838 - same_at_start_charpos
);
3839 /* This binding is to avoid ask-user-about-supersession-threat
3840 being called in insert_from_buffer (via in
3841 prepare_to_modify_buffer). */
3842 specbind (intern ("buffer-file-name"), Qnil
);
3843 insert_from_buffer (XBUFFER (conversion_buffer
),
3844 same_at_start_charpos
, inserted_chars
, 0);
3845 /* Set `inserted' to the number of inserted characters. */
3846 inserted
= PT
- temp
;
3847 /* Set point before the inserted characters. */
3848 SET_PT_BOTH (temp
, same_at_start
);
3850 unbind_to (this_count
, Qnil
);
3857 register Lisp_Object temp
;
3859 total
= XINT (end
) - XINT (beg
);
3861 /* Make sure point-max won't overflow after this insertion. */
3862 XSETINT (temp
, total
);
3863 if (total
!= XINT (temp
))
3864 error ("Maximum buffer size exceeded");
3867 /* For a special file, all we can do is guess. */
3868 total
= READ_BUF_SIZE
;
3870 if (NILP (visit
) && inserted
> 0)
3872 #ifdef CLASH_DETECTION
3873 if (!NILP (current_buffer
->file_truename
)
3874 /* Make binding buffer-file-name to nil effective. */
3875 && !NILP (current_buffer
->filename
)
3876 && SAVE_MODIFF
>= MODIFF
)
3878 #endif /* CLASH_DETECTION */
3879 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
3883 if (GAP_SIZE
< total
)
3884 make_gap (total
- GAP_SIZE
);
3886 if (XINT (beg
) != 0 || !NILP (replace
))
3888 if (lseek (fd
, XINT (beg
), 0) < 0)
3889 report_file_error ("Setting file position",
3890 Fcons (orig_filename
, Qnil
));
3893 /* In the following loop, HOW_MUCH contains the total bytes read so
3894 far for a regular file, and not changed for a special file. But,
3895 before exiting the loop, it is set to a negative value if I/O
3899 /* Total bytes inserted. */
3902 /* Here, we don't do code conversion in the loop. It is done by
3903 decode_coding_gap after all data are read into the buffer. */
3905 EMACS_INT gap_size
= GAP_SIZE
;
3907 while (how_much
< total
)
3909 /* try is reserved in some compilers (Microsoft C) */
3910 EMACS_INT trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3917 /* Maybe make more room. */
3918 if (gap_size
< trytry
)
3920 make_gap (total
- gap_size
);
3921 gap_size
= GAP_SIZE
;
3924 /* Read from the file, capturing `quit'. When an
3925 error occurs, end the loop, and arrange for a quit
3926 to be signaled after decoding the text we read. */
3927 non_regular_fd
= fd
;
3928 non_regular_inserted
= inserted
;
3929 non_regular_nbytes
= trytry
;
3930 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
3931 read_non_regular_quit
);
3942 /* Allow quitting out of the actual I/O. We don't make text
3943 part of the buffer until all the reading is done, so a C-g
3944 here doesn't do any harm. */
3947 this = emacs_read (fd
,
3948 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
3962 /* For a regular file, where TOTAL is the real size,
3963 count HOW_MUCH to compare with it.
3964 For a special file, where TOTAL is just a buffer size,
3965 so don't bother counting in HOW_MUCH.
3966 (INSERTED is where we count the number of characters inserted.) */
3973 /* Now we have read all the file data into the gap.
3974 If it was empty, undo marking the buffer modified. */
3978 #ifdef CLASH_DETECTION
3980 unlock_file (current_buffer
->file_truename
);
3982 Vdeactivate_mark
= old_Vdeactivate_mark
;
3985 Vdeactivate_mark
= Qt
;
3987 /* Make the text read part of the buffer. */
3988 GAP_SIZE
-= inserted
;
3990 GPT_BYTE
+= inserted
;
3992 ZV_BYTE
+= inserted
;
3997 /* Put an anchor to ensure multi-byte form ends at gap. */
4002 /* Discard the unwind protect for closing the file. */
4006 error ("IO error reading %s: %s",
4007 SDATA (orig_filename
), emacs_strerror (errno
));
4011 if (NILP (coding_system
))
4013 /* The coding system is not yet decided. Decide it by an
4014 optimized method for handling `coding:' tag.
4016 Note that we can get here only if the buffer was empty
4017 before the insertion. */
4019 if (!NILP (Vcoding_system_for_read
))
4020 coding_system
= Vcoding_system_for_read
;
4023 /* Since we are sure that the current buffer was empty
4024 before the insertion, we can toggle
4025 enable-multibyte-characters directly here without taking
4026 care of marker adjustment. By this way, we can run Lisp
4027 program safely before decoding the inserted text. */
4028 Lisp_Object unwind_data
;
4029 int count
= SPECPDL_INDEX ();
4031 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4032 Fcons (current_buffer
->undo_list
,
4033 Fcurrent_buffer ()));
4034 current_buffer
->enable_multibyte_characters
= Qnil
;
4035 current_buffer
->undo_list
= Qt
;
4036 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4038 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4040 coding_system
= call2 (Vset_auto_coding_function
,
4041 filename
, make_number (inserted
));
4044 if (NILP (coding_system
))
4046 /* If the coding system is not yet decided, check
4047 file-coding-system-alist. */
4048 Lisp_Object args
[6];
4050 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4051 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4052 coding_system
= Ffind_operation_coding_system (6, args
);
4053 if (CONSP (coding_system
))
4054 coding_system
= XCAR (coding_system
);
4056 unbind_to (count
, Qnil
);
4057 inserted
= Z_BYTE
- BEG_BYTE
;
4060 if (NILP (coding_system
))
4061 coding_system
= Qundecided
;
4063 CHECK_CODING_SYSTEM (coding_system
);
4065 if (NILP (current_buffer
->enable_multibyte_characters
))
4066 /* We must suppress all character code conversion except for
4067 end-of-line conversion. */
4068 coding_system
= raw_text_coding_system (coding_system
);
4069 setup_coding_system (coding_system
, &coding
);
4070 /* Ensure we set Vlast_coding_system_used. */
4071 set_coding_system
= 1;
4076 /* When we visit a file by raw-text, we change the buffer to
4078 if (CODING_FOR_UNIBYTE (&coding
)
4079 /* Can't do this if part of the buffer might be preserved. */
4081 /* Visiting a file with these coding system makes the buffer
4083 current_buffer
->enable_multibyte_characters
= Qnil
;
4086 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4087 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4088 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4090 move_gap_both (PT
, PT_BYTE
);
4091 GAP_SIZE
+= inserted
;
4092 ZV_BYTE
-= inserted
;
4096 decode_coding_gap (&coding
, inserted
, inserted
);
4097 inserted
= coding
.produced_char
;
4098 coding_system
= CODING_ID_NAME (coding
.id
);
4100 else if (inserted
> 0)
4101 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4104 /* Now INSERTED is measured in characters. */
4107 /* Use the conversion type to determine buffer-file-type
4108 (find-buffer-file-type is now used to help determine the
4110 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4111 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4112 && ! CODING_REQUIRE_DECODING (&coding
))
4113 current_buffer
->buffer_file_type
= Qt
;
4115 current_buffer
->buffer_file_type
= Qnil
;
4120 if (deferred_remove_unwind_protect
)
4121 /* If requested above, discard the unwind protect for closing the
4127 if (!EQ (current_buffer
->undo_list
, Qt
) && !nochange
)
4128 current_buffer
->undo_list
= Qnil
;
4132 current_buffer
->modtime
= st
.st_mtime
;
4133 current_buffer
->modtime_size
= st
.st_size
;
4134 current_buffer
->filename
= orig_filename
;
4137 SAVE_MODIFF
= MODIFF
;
4138 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
4139 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4140 #ifdef CLASH_DETECTION
4143 if (!NILP (current_buffer
->file_truename
))
4144 unlock_file (current_buffer
->file_truename
);
4145 unlock_file (filename
);
4147 #endif /* CLASH_DETECTION */
4149 xsignal2 (Qfile_error
,
4150 build_string ("not a regular file"), orig_filename
);
4153 if (set_coding_system
)
4154 Vlast_coding_system_used
= coding_system
;
4156 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4158 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4160 if (! NILP (insval
))
4162 CHECK_NUMBER (insval
);
4163 inserted
= XFASTINT (insval
);
4167 /* Decode file format. */
4170 /* Don't run point motion or modification hooks when decoding. */
4171 int count
= SPECPDL_INDEX ();
4172 EMACS_INT old_inserted
= inserted
;
4173 specbind (Qinhibit_point_motion_hooks
, Qt
);
4174 specbind (Qinhibit_modification_hooks
, Qt
);
4176 /* Save old undo list and don't record undo for decoding. */
4177 old_undo
= current_buffer
->undo_list
;
4178 current_buffer
->undo_list
= Qt
;
4182 insval
= call3 (Qformat_decode
,
4183 Qnil
, make_number (inserted
), visit
);
4184 CHECK_NUMBER (insval
);
4185 inserted
= XFASTINT (insval
);
4189 /* If REPLACE is non-nil and we succeeded in not replacing the
4190 beginning or end of the buffer text with the file's contents,
4191 call format-decode with `point' positioned at the beginning
4192 of the buffer and `inserted' equalling the number of
4193 characters in the buffer. Otherwise, format-decode might
4194 fail to correctly analyze the beginning or end of the buffer.
4195 Hence we temporarily save `point' and `inserted' here and
4196 restore `point' iff format-decode did not insert or delete
4197 any text. Otherwise we leave `point' at point-min. */
4198 EMACS_INT opoint
= PT
;
4199 EMACS_INT opoint_byte
= PT_BYTE
;
4200 EMACS_INT oinserted
= ZV
- BEGV
;
4201 int ochars_modiff
= CHARS_MODIFF
;
4203 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4204 insval
= call3 (Qformat_decode
,
4205 Qnil
, make_number (oinserted
), visit
);
4206 CHECK_NUMBER (insval
);
4207 if (ochars_modiff
== CHARS_MODIFF
)
4208 /* format_decode didn't modify buffer's characters => move
4209 point back to position before inserted text and leave
4210 value of inserted alone. */
4211 SET_PT_BOTH (opoint
, opoint_byte
);
4213 /* format_decode modified buffer's characters => consider
4214 entire buffer changed and leave point at point-min. */
4215 inserted
= XFASTINT (insval
);
4218 /* For consistency with format-decode call these now iff inserted > 0
4219 (martin 2007-06-28). */
4220 p
= Vafter_insert_file_functions
;
4225 insval
= call1 (XCAR (p
), make_number (inserted
));
4228 CHECK_NUMBER (insval
);
4229 inserted
= XFASTINT (insval
);
4234 /* For the rationale of this see the comment on
4235 format-decode above. */
4236 EMACS_INT opoint
= PT
;
4237 EMACS_INT opoint_byte
= PT_BYTE
;
4238 EMACS_INT oinserted
= ZV
- BEGV
;
4239 int ochars_modiff
= CHARS_MODIFF
;
4241 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4242 insval
= call1 (XCAR (p
), make_number (oinserted
));
4245 CHECK_NUMBER (insval
);
4246 if (ochars_modiff
== CHARS_MODIFF
)
4247 /* after_insert_file_functions didn't modify
4248 buffer's characters => move point back to
4249 position before inserted text and leave value of
4251 SET_PT_BOTH (opoint
, opoint_byte
);
4253 /* after_insert_file_functions did modify buffer's
4254 characters => consider entire buffer changed and
4255 leave point at point-min. */
4256 inserted
= XFASTINT (insval
);
4266 current_buffer
->undo_list
= old_undo
;
4267 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4269 /* Adjust the last undo record for the size change during
4270 the format conversion. */
4271 Lisp_Object tem
= XCAR (old_undo
);
4272 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4273 && INTEGERP (XCDR (tem
))
4274 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4275 XSETCDR (tem
, make_number (PT
+ inserted
));
4279 /* If undo_list was Qt before, keep it that way.
4280 Otherwise start with an empty undo_list. */
4281 current_buffer
->undo_list
= EQ (old_undo
, Qt
) ? Qt
: Qnil
;
4283 unbind_to (count
, Qnil
);
4286 /* Call after-change hooks for the inserted text, aside from the case
4287 of normal visiting (not with REPLACE), which is done in a new buffer
4288 "before" the buffer is changed. */
4289 if (inserted
> 0 && total
> 0
4290 && (NILP (visit
) || !NILP (replace
)))
4292 signal_after_change (PT
, 0, inserted
);
4293 update_compositions (PT
, PT
, CHECK_BORDER
);
4297 && current_buffer
->modtime
== -1)
4299 /* If visiting nonexistent file, return nil. */
4300 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4304 Fsignal (Qquit
, Qnil
);
4306 /* ??? Retval needs to be dealt with in all cases consistently. */
4308 val
= Fcons (orig_filename
,
4309 Fcons (make_number (inserted
),
4312 RETURN_UNGCPRO (unbind_to (count
, val
));
4315 static Lisp_Object
build_annotations (Lisp_Object
, Lisp_Object
);
4318 build_annotations_unwind (Lisp_Object arg
)
4320 Vwrite_region_annotation_buffers
= arg
;
4324 /* Decide the coding-system to encode the data with. */
4327 choose_write_coding_system (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4328 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
,
4329 struct coding_system
*coding
)
4332 Lisp_Object eol_parent
= Qnil
;
4335 && NILP (Fstring_equal (current_buffer
->filename
,
4336 current_buffer
->auto_save_file_name
)))
4341 else if (!NILP (Vcoding_system_for_write
))
4343 val
= Vcoding_system_for_write
;
4344 if (coding_system_require_warning
4345 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4346 /* Confirm that VAL can surely encode the current region. */
4347 val
= call5 (Vselect_safe_coding_system_function
,
4348 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4353 /* If the variable `buffer-file-coding-system' is set locally,
4354 it means that the file was read with some kind of code
4355 conversion or the variable is explicitly set by users. We
4356 had better write it out with the same coding system even if
4357 `enable-multibyte-characters' is nil.
4359 If it is not set locally, we anyway have to convert EOL
4360 format if the default value of `buffer-file-coding-system'
4361 tells that it is not Unix-like (LF only) format. */
4362 int using_default_coding
= 0;
4363 int force_raw_text
= 0;
4365 val
= current_buffer
->buffer_file_coding_system
;
4367 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4370 if (NILP (current_buffer
->enable_multibyte_characters
))
4376 /* Check file-coding-system-alist. */
4377 Lisp_Object args
[7], coding_systems
;
4379 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4380 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4382 coding_systems
= Ffind_operation_coding_system (7, args
);
4383 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4384 val
= XCDR (coding_systems
);
4389 /* If we still have not decided a coding system, use the
4390 default value of buffer-file-coding-system. */
4391 val
= current_buffer
->buffer_file_coding_system
;
4392 using_default_coding
= 1;
4395 if (! NILP (val
) && ! force_raw_text
)
4397 Lisp_Object spec
, attrs
;
4399 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4400 attrs
= AREF (spec
, 0);
4401 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4406 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4407 /* Confirm that VAL can surely encode the current region. */
4408 val
= call5 (Vselect_safe_coding_system_function
,
4409 start
, end
, val
, Qnil
, filename
);
4411 /* If the decided coding-system doesn't specify end-of-line
4412 format, we use that of
4413 `default-buffer-file-coding-system'. */
4414 if (! using_default_coding
4415 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4416 val
= (coding_inherit_eol_type
4417 (val
, buffer_defaults
.buffer_file_coding_system
));
4419 /* If we decide not to encode text, use `raw-text' or one of its
4422 val
= raw_text_coding_system (val
);
4425 val
= coding_inherit_eol_type (val
, eol_parent
);
4426 setup_coding_system (val
, coding
);
4428 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4429 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4433 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4434 "r\nFWrite region to file: \ni\ni\ni\np",
4435 doc
: /* Write current region into specified file.
4436 When called from a program, requires three arguments:
4437 START, END and FILENAME. START and END are normally buffer positions
4438 specifying the part of the buffer to write.
4439 If START is nil, that means to use the entire buffer contents.
4440 If START is a string, then output that string to the file
4441 instead of any buffer contents; END is ignored.
4443 Optional fourth argument APPEND if non-nil means
4444 append to existing file contents (if any). If it is an integer,
4445 seek to that offset in the file before writing.
4446 Optional fifth argument VISIT, if t or a string, means
4447 set the last-save-file-modtime of buffer to this file's modtime
4448 and mark buffer not modified.
4449 If VISIT is a string, it is a second file name;
4450 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4451 VISIT is also the file name to lock and unlock for clash detection.
4452 If VISIT is neither t nor nil nor a string,
4453 that means do not display the \"Wrote file\" message.
4454 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4455 use for locking and unlocking, overriding FILENAME and VISIT.
4456 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4457 for an existing file with the same name. If MUSTBENEW is `excl',
4458 that means to get an error if the file already exists; never overwrite.
4459 If MUSTBENEW is neither nil nor `excl', that means ask for
4460 confirmation before overwriting, but do go ahead and overwrite the file
4461 if the user confirms.
4463 This does code conversion according to the value of
4464 `coding-system-for-write', `buffer-file-coding-system', or
4465 `file-coding-system-alist', and sets the variable
4466 `last-coding-system-used' to the coding system actually used.
4468 This calls `write-region-annotate-functions' at the start, and
4469 `write-region-post-annotation-function' at the end. */)
4470 (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
, Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
, Lisp_Object mustbenew
)
4477 int count
= SPECPDL_INDEX ();
4479 Lisp_Object handler
;
4480 Lisp_Object visit_file
;
4481 Lisp_Object annotations
;
4482 Lisp_Object encoded_filename
;
4483 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4484 int quietly
= !NILP (visit
);
4485 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4486 struct buffer
*given_buffer
;
4488 int buffer_file_type
= O_BINARY
;
4490 struct coding_system coding
;
4492 if (current_buffer
->base_buffer
&& visiting
)
4493 error ("Cannot do file visiting in an indirect buffer");
4495 if (!NILP (start
) && !STRINGP (start
))
4496 validate_region (&start
, &end
);
4499 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4501 filename
= Fexpand_file_name (filename
, Qnil
);
4503 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4504 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4506 if (STRINGP (visit
))
4507 visit_file
= Fexpand_file_name (visit
, Qnil
);
4509 visit_file
= filename
;
4511 if (NILP (lockname
))
4512 lockname
= visit_file
;
4516 /* If the file name has special constructs in it,
4517 call the corresponding file handler. */
4518 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4519 /* If FILENAME has no handler, see if VISIT has one. */
4520 if (NILP (handler
) && STRINGP (visit
))
4521 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4523 if (!NILP (handler
))
4526 val
= call6 (handler
, Qwrite_region
, start
, end
,
4527 filename
, append
, visit
);
4531 SAVE_MODIFF
= MODIFF
;
4532 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4533 current_buffer
->filename
= visit_file
;
4539 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4541 /* Special kludge to simplify auto-saving. */
4544 /* Do it later, so write-region-annotate-function can work differently
4545 if we save "the buffer" vs "a region".
4546 This is useful in tar-mode. --Stef
4547 XSETFASTINT (start, BEG);
4548 XSETFASTINT (end, Z); */
4552 record_unwind_protect (build_annotations_unwind
,
4553 Vwrite_region_annotation_buffers
);
4554 Vwrite_region_annotation_buffers
= Fcons (Fcurrent_buffer (), Qnil
);
4555 count1
= SPECPDL_INDEX ();
4557 given_buffer
= current_buffer
;
4559 if (!STRINGP (start
))
4561 annotations
= build_annotations (start
, end
);
4563 if (current_buffer
!= given_buffer
)
4565 XSETFASTINT (start
, BEGV
);
4566 XSETFASTINT (end
, ZV
);
4572 XSETFASTINT (start
, BEGV
);
4573 XSETFASTINT (end
, ZV
);
4578 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4580 /* Decide the coding-system to encode the data with.
4581 We used to make this choice before calling build_annotations, but that
4582 leads to problems when a write-annotate-function takes care of
4583 unsavable chars (as was the case with X-Symbol). */
4584 Vlast_coding_system_used
4585 = choose_write_coding_system (start
, end
, filename
,
4586 append
, visit
, lockname
, &coding
);
4588 #ifdef CLASH_DETECTION
4590 lock_file (lockname
);
4591 #endif /* CLASH_DETECTION */
4593 encoded_filename
= ENCODE_FILE (filename
);
4595 fn
= SSDATA (encoded_filename
);
4599 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4600 #else /* not DOS_NT */
4601 desc
= emacs_open (fn
, O_WRONLY
, 0);
4602 #endif /* not DOS_NT */
4604 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4606 desc
= emacs_open (fn
,
4607 O_WRONLY
| O_CREAT
| buffer_file_type
4608 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4609 S_IREAD
| S_IWRITE
);
4610 #else /* not DOS_NT */
4611 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4612 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4613 auto_saving
? auto_save_mode_bits
: 0666);
4614 #endif /* not DOS_NT */
4618 #ifdef CLASH_DETECTION
4620 if (!auto_saving
) unlock_file (lockname
);
4622 #endif /* CLASH_DETECTION */
4624 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4627 record_unwind_protect (close_file_unwind
, make_number (desc
));
4629 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4633 if (NUMBERP (append
))
4634 ret
= lseek (desc
, XINT (append
), 1);
4636 ret
= lseek (desc
, 0, 2);
4639 #ifdef CLASH_DETECTION
4640 if (!auto_saving
) unlock_file (lockname
);
4641 #endif /* CLASH_DETECTION */
4643 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4652 if (STRINGP (start
))
4654 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
4655 &annotations
, &coding
);
4658 else if (XINT (start
) != XINT (end
))
4660 failure
= 0 > a_write (desc
, Qnil
,
4661 XINT (start
), XINT (end
) - XINT (start
),
4662 &annotations
, &coding
);
4667 /* If file was empty, still need to write the annotations */
4668 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4669 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4673 if (CODING_REQUIRE_FLUSHING (&coding
)
4674 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4677 /* We have to flush out a data. */
4678 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4679 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
4686 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4687 Disk full in NFS may be reported here. */
4688 /* mib says that closing the file will try to write as fast as NFS can do
4689 it, and that means the fsync here is not crucial for autosave files. */
4690 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
4692 /* If fsync fails with EINTR, don't treat that as serious. Also
4693 ignore EINVAL which happens when fsync is not supported on this
4695 if (errno
!= EINTR
&& errno
!= EINVAL
)
4696 failure
= 1, save_errno
= errno
;
4700 /* NFS can report a write failure now. */
4701 if (emacs_close (desc
) < 0)
4702 failure
= 1, save_errno
= errno
;
4706 /* Discard the unwind protect for close_file_unwind. */
4707 specpdl_ptr
= specpdl
+ count1
;
4709 /* Call write-region-post-annotation-function. */
4710 while (CONSP (Vwrite_region_annotation_buffers
))
4712 Lisp_Object buf
= XCAR (Vwrite_region_annotation_buffers
);
4713 if (!NILP (Fbuffer_live_p (buf
)))
4716 if (FUNCTIONP (Vwrite_region_post_annotation_function
))
4717 call0 (Vwrite_region_post_annotation_function
);
4719 Vwrite_region_annotation_buffers
4720 = XCDR (Vwrite_region_annotation_buffers
);
4723 unbind_to (count
, Qnil
);
4725 #ifdef CLASH_DETECTION
4727 unlock_file (lockname
);
4728 #endif /* CLASH_DETECTION */
4730 /* Do this before reporting IO error
4731 to avoid a "file has changed on disk" warning on
4732 next attempt to save. */
4735 current_buffer
->modtime
= st
.st_mtime
;
4736 current_buffer
->modtime_size
= st
.st_size
;
4740 error ("IO error writing %s: %s", SDATA (filename
),
4741 emacs_strerror (save_errno
));
4745 SAVE_MODIFF
= MODIFF
;
4746 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4747 current_buffer
->filename
= visit_file
;
4748 update_mode_lines
++;
4753 && ! NILP (Fstring_equal (current_buffer
->filename
,
4754 current_buffer
->auto_save_file_name
)))
4755 SAVE_MODIFF
= MODIFF
;
4761 message_with_string ((INTEGERP (append
)
4771 Lisp_Object
merge (Lisp_Object
, Lisp_Object
, Lisp_Object
);
4773 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4774 doc
: /* Return t if (car A) is numerically less than (car B). */)
4775 (Lisp_Object a
, Lisp_Object b
)
4777 return Flss (Fcar (a
), Fcar (b
));
4780 /* Build the complete list of annotations appropriate for writing out
4781 the text between START and END, by calling all the functions in
4782 write-region-annotate-functions and merging the lists they return.
4783 If one of these functions switches to a different buffer, we assume
4784 that buffer contains altered text. Therefore, the caller must
4785 make sure to restore the current buffer in all cases,
4786 as save-excursion would do. */
4789 build_annotations (Lisp_Object start
, Lisp_Object end
)
4791 Lisp_Object annotations
;
4793 struct gcpro gcpro1
, gcpro2
;
4794 Lisp_Object original_buffer
;
4795 int i
, used_global
= 0;
4797 XSETBUFFER (original_buffer
, current_buffer
);
4800 p
= Vwrite_region_annotate_functions
;
4801 GCPRO2 (annotations
, p
);
4804 struct buffer
*given_buffer
= current_buffer
;
4805 if (EQ (Qt
, XCAR (p
)) && !used_global
)
4806 { /* Use the global value of the hook. */
4809 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
4811 p
= Fappend (2, arg
);
4814 Vwrite_region_annotations_so_far
= annotations
;
4815 res
= call2 (XCAR (p
), start
, end
);
4816 /* If the function makes a different buffer current,
4817 assume that means this buffer contains altered text to be output.
4818 Reset START and END from the buffer bounds
4819 and discard all previous annotations because they should have
4820 been dealt with by this function. */
4821 if (current_buffer
!= given_buffer
)
4823 Vwrite_region_annotation_buffers
4824 = Fcons (Fcurrent_buffer (),
4825 Vwrite_region_annotation_buffers
);
4826 XSETFASTINT (start
, BEGV
);
4827 XSETFASTINT (end
, ZV
);
4830 Flength (res
); /* Check basic validity of return value */
4831 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4835 /* Now do the same for annotation functions implied by the file-format */
4836 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
4837 p
= current_buffer
->auto_save_file_format
;
4839 p
= current_buffer
->file_format
;
4840 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
4842 struct buffer
*given_buffer
= current_buffer
;
4844 Vwrite_region_annotations_so_far
= annotations
;
4846 /* Value is either a list of annotations or nil if the function
4847 has written annotations to a temporary buffer, which is now
4849 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
4850 original_buffer
, make_number (i
));
4851 if (current_buffer
!= given_buffer
)
4853 XSETFASTINT (start
, BEGV
);
4854 XSETFASTINT (end
, ZV
);
4859 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4867 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
4868 If STRING is nil, POS is the character position in the current buffer.
4869 Intersperse with them the annotations from *ANNOT
4870 which fall within the range of POS to POS + NCHARS,
4871 each at its appropriate position.
4873 We modify *ANNOT by discarding elements as we use them up.
4875 The return value is negative in case of system call failure. */
4878 a_write (int desc
, Lisp_Object string
, int pos
, register int nchars
, Lisp_Object
*annot
, struct coding_system
*coding
)
4882 int lastpos
= pos
+ nchars
;
4884 while (NILP (*annot
) || CONSP (*annot
))
4886 tem
= Fcar_safe (Fcar (*annot
));
4889 nextpos
= XFASTINT (tem
);
4891 /* If there are no more annotations in this range,
4892 output the rest of the range all at once. */
4893 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
4894 return e_write (desc
, string
, pos
, lastpos
, coding
);
4896 /* Output buffer text up to the next annotation's position. */
4899 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
4903 /* Output the annotation. */
4904 tem
= Fcdr (Fcar (*annot
));
4907 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
4910 *annot
= Fcdr (*annot
);
4916 /* Write text in the range START and END into descriptor DESC,
4917 encoding them with coding system CODING. If STRING is nil, START
4918 and END are character positions of the current buffer, else they
4919 are indexes to the string STRING. */
4922 e_write (int desc
, Lisp_Object string
, int start
, int end
, struct coding_system
*coding
)
4924 if (STRINGP (string
))
4927 end
= SCHARS (string
);
4930 /* We used to have a code for handling selective display here. But,
4931 now it is handled within encode_coding. */
4935 if (STRINGP (string
))
4937 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
4938 if (CODING_REQUIRE_ENCODING (coding
))
4940 encode_coding_object (coding
, string
,
4941 start
, string_char_to_byte (string
, start
),
4942 end
, string_char_to_byte (string
, end
), Qt
);
4946 coding
->dst_object
= string
;
4947 coding
->consumed_char
= SCHARS (string
);
4948 coding
->produced
= SBYTES (string
);
4953 int start_byte
= CHAR_TO_BYTE (start
);
4954 int end_byte
= CHAR_TO_BYTE (end
);
4956 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
4957 if (CODING_REQUIRE_ENCODING (coding
))
4959 encode_coding_object (coding
, Fcurrent_buffer (),
4960 start
, start_byte
, end
, end_byte
, Qt
);
4964 coding
->dst_object
= Qnil
;
4965 coding
->dst_pos_byte
= start_byte
;
4966 if (start
>= GPT
|| end
<= GPT
)
4968 coding
->consumed_char
= end
- start
;
4969 coding
->produced
= end_byte
- start_byte
;
4973 coding
->consumed_char
= GPT
- start
;
4974 coding
->produced
= GPT_BYTE
- start_byte
;
4979 if (coding
->produced
> 0)
4983 STRINGP (coding
->dst_object
)
4984 ? SSDATA (coding
->dst_object
)
4985 : (char *) BYTE_POS_ADDR (coding
->dst_pos_byte
),
4988 if (coding
->produced
)
4991 start
+= coding
->consumed_char
;
4997 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4998 Sverify_visited_file_modtime
, 0, 1, 0,
4999 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5000 This means that the file has not been changed since it was visited or saved.
5001 If BUF is omitted or nil, it defaults to the current buffer.
5002 See Info node `(elisp)Modification Time' for more details. */)
5007 Lisp_Object handler
;
5008 Lisp_Object filename
;
5018 if (!STRINGP (b
->filename
)) return Qt
;
5019 if (b
->modtime
== 0) return Qt
;
5021 /* If the file name has special constructs in it,
5022 call the corresponding file handler. */
5023 handler
= Ffind_file_name_handler (b
->filename
,
5024 Qverify_visited_file_modtime
);
5025 if (!NILP (handler
))
5026 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5028 filename
= ENCODE_FILE (b
->filename
);
5030 if (stat (SSDATA (filename
), &st
) < 0)
5032 /* If the file doesn't exist now and didn't exist before,
5033 we say that it isn't modified, provided the error is a tame one. */
5034 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5039 if ((st
.st_mtime
== b
->modtime
5040 /* If both are positive, accept them if they are off by one second. */
5041 || (st
.st_mtime
> 0 && b
->modtime
> 0
5042 && (st
.st_mtime
== b
->modtime
+ 1
5043 || st
.st_mtime
== b
->modtime
- 1)))
5044 && (st
.st_size
== b
->modtime_size
5045 || b
->modtime_size
< 0))
5050 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5051 Sclear_visited_file_modtime
, 0, 0, 0,
5052 doc
: /* Clear out records of last mod time of visited file.
5053 Next attempt to save will certainly not complain of a discrepancy. */)
5056 current_buffer
->modtime
= 0;
5057 current_buffer
->modtime_size
= -1;
5061 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5062 Svisited_file_modtime
, 0, 0, 0,
5063 doc
: /* Return the current buffer's recorded visited file modification time.
5064 The value is a list of the form (HIGH LOW), like the time values
5065 that `file-attributes' returns. If the current buffer has no recorded
5066 file modification time, this function returns 0.
5067 See Info node `(elisp)Modification Time' for more details. */)
5070 if (! current_buffer
->modtime
)
5071 return make_number (0);
5072 return make_time ((time_t) current_buffer
->modtime
);
5075 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5076 Sset_visited_file_modtime
, 0, 1, 0,
5077 doc
: /* Update buffer's recorded modification time from the visited file's time.
5078 Useful if the buffer was not read from the file normally
5079 or if the file itself has been changed for some known benign reason.
5080 An argument specifies the modification time value to use
5081 \(instead of that of the visited file), in the form of a list
5082 \(HIGH . LOW) or (HIGH LOW). */)
5083 (Lisp_Object time_list
)
5085 if (!NILP (time_list
))
5087 current_buffer
->modtime
= cons_to_long (time_list
);
5088 current_buffer
->modtime_size
= -1;
5092 register Lisp_Object filename
;
5094 Lisp_Object handler
;
5096 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5098 /* If the file name has special constructs in it,
5099 call the corresponding file handler. */
5100 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5101 if (!NILP (handler
))
5102 /* The handler can find the file name the same way we did. */
5103 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5105 filename
= ENCODE_FILE (filename
);
5107 if (stat (SSDATA (filename
), &st
) >= 0)
5109 current_buffer
->modtime
= st
.st_mtime
;
5110 current_buffer
->modtime_size
= st
.st_size
;
5118 auto_save_error (Lisp_Object error
)
5120 Lisp_Object args
[3], msg
;
5122 struct gcpro gcpro1
;
5126 auto_save_error_occurred
= 1;
5128 ring_bell (XFRAME (selected_frame
));
5130 args
[0] = build_string ("Auto-saving %s: %s");
5131 args
[1] = current_buffer
->name
;
5132 args
[2] = Ferror_message_string (error
);
5133 msg
= Fformat (3, args
);
5135 nbytes
= SBYTES (msg
);
5136 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5137 memcpy (msgbuf
, SDATA (msg
), nbytes
);
5139 for (i
= 0; i
< 3; ++i
)
5142 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5144 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5145 Fsleep_for (make_number (1), Qnil
);
5159 auto_save_mode_bits
= 0666;
5161 /* Get visited file's mode to become the auto save file's mode. */
5162 if (! NILP (current_buffer
->filename
))
5164 if (stat (SSDATA (current_buffer
->filename
), &st
) >= 0)
5165 /* But make sure we can overwrite it later! */
5166 auto_save_mode_bits
= st
.st_mode
| 0600;
5167 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5169 /* Remote files don't cooperate with stat. */
5170 auto_save_mode_bits
= XINT (modes
) | 0600;
5174 Fwrite_region (Qnil
, Qnil
, current_buffer
->auto_save_file_name
, Qnil
,
5175 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5180 do_auto_save_unwind (Lisp_Object arg
) /* used as unwind-protect function */
5183 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5195 do_auto_save_unwind_1 (Lisp_Object value
) /* used as unwind-protect function */
5198 minibuffer_auto_raise
= XINT (value
);
5203 do_auto_save_make_dir (Lisp_Object dir
)
5207 call2 (Qmake_directory
, dir
, Qt
);
5208 XSETFASTINT (mode
, 0700);
5209 return Fset_file_modes (dir
, mode
);
5213 do_auto_save_eh (Lisp_Object ignore
)
5218 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5219 doc
: /* Auto-save all buffers that need it.
5220 This is all buffers that have auto-saving enabled
5221 and are changed since last auto-saved.
5222 Auto-saving writes the buffer into a file
5223 so that your editing is not lost if the system crashes.
5224 This file is not the file you visited; that changes only when you save.
5225 Normally we run the normal hook `auto-save-hook' before saving.
5227 A non-nil NO-MESSAGE argument means do not print any message if successful.
5228 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5229 (Lisp_Object no_message
, Lisp_Object current_only
)
5231 struct buffer
*old
= current_buffer
, *b
;
5232 Lisp_Object tail
, buf
;
5234 int do_handled_files
;
5236 FILE *stream
= NULL
;
5237 int count
= SPECPDL_INDEX ();
5238 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5239 int old_message_p
= 0;
5240 struct gcpro gcpro1
, gcpro2
;
5242 if (max_specpdl_size
< specpdl_size
+ 40)
5243 max_specpdl_size
= specpdl_size
+ 40;
5248 if (NILP (no_message
))
5250 old_message_p
= push_message ();
5251 record_unwind_protect (pop_message_unwind
, Qnil
);
5254 /* Ordinarily don't quit within this function,
5255 but don't make it impossible to quit (in case we get hung in I/O). */
5259 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5260 point to non-strings reached from Vbuffer_alist. */
5262 if (!NILP (Vrun_hooks
))
5263 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5265 if (STRINGP (Vauto_save_list_file_name
))
5267 Lisp_Object listfile
;
5269 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5271 /* Don't try to create the directory when shutting down Emacs,
5272 because creating the directory might signal an error, and
5273 that would leave Emacs in a strange state. */
5274 if (!NILP (Vrun_hooks
))
5278 GCPRO2 (dir
, listfile
);
5279 dir
= Ffile_name_directory (listfile
);
5280 if (NILP (Ffile_directory_p (dir
)))
5281 internal_condition_case_1 (do_auto_save_make_dir
,
5282 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5287 stream
= fopen (SSDATA (listfile
), "w");
5290 record_unwind_protect (do_auto_save_unwind
,
5291 make_save_value (stream
, 0));
5292 record_unwind_protect (do_auto_save_unwind_1
,
5293 make_number (minibuffer_auto_raise
));
5294 minibuffer_auto_raise
= 0;
5296 auto_save_error_occurred
= 0;
5298 /* On first pass, save all files that don't have handlers.
5299 On second pass, save all files that do have handlers.
5301 If Emacs is crashing, the handlers may tweak what is causing
5302 Emacs to crash in the first place, and it would be a shame if
5303 Emacs failed to autosave perfectly ordinary files because it
5304 couldn't handle some ange-ftp'd file. */
5306 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5307 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5309 buf
= XCDR (XCAR (tail
));
5312 /* Record all the buffers that have auto save mode
5313 in the special file that lists them. For each of these buffers,
5314 Record visited name (if any) and auto save name. */
5315 if (STRINGP (b
->auto_save_file_name
)
5316 && stream
!= NULL
&& do_handled_files
== 0)
5319 if (!NILP (b
->filename
))
5321 fwrite (SDATA (b
->filename
), 1,
5322 SBYTES (b
->filename
), stream
);
5324 putc ('\n', stream
);
5325 fwrite (SDATA (b
->auto_save_file_name
), 1,
5326 SBYTES (b
->auto_save_file_name
), stream
);
5327 putc ('\n', stream
);
5331 if (!NILP (current_only
)
5332 && b
!= current_buffer
)
5335 /* Don't auto-save indirect buffers.
5336 The base buffer takes care of it. */
5340 /* Check for auto save enabled
5341 and file changed since last auto save
5342 and file changed since last real save. */
5343 if (STRINGP (b
->auto_save_file_name
)
5344 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5345 && BUF_AUTOSAVE_MODIFF (b
) < BUF_MODIFF (b
)
5346 /* -1 means we've turned off autosaving for a while--see below. */
5347 && XINT (b
->save_length
) >= 0
5348 && (do_handled_files
5349 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5352 EMACS_TIME before_time
, after_time
;
5354 EMACS_GET_TIME (before_time
);
5356 /* If we had a failure, don't try again for 20 minutes. */
5357 if (b
->auto_save_failure_time
>= 0
5358 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5361 set_buffer_internal (b
);
5362 if (NILP (Vauto_save_include_big_deletions
)
5363 && (XFASTINT (b
->save_length
) * 10
5364 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5365 /* A short file is likely to change a large fraction;
5366 spare the user annoying messages. */
5367 && XFASTINT (b
->save_length
) > 5000
5368 /* These messages are frequent and annoying for `*mail*'. */
5369 && !EQ (b
->filename
, Qnil
)
5370 && NILP (no_message
))
5372 /* It has shrunk too much; turn off auto-saving here. */
5373 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5374 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5376 minibuffer_auto_raise
= 0;
5377 /* Turn off auto-saving until there's a real save,
5378 and prevent any more warnings. */
5379 XSETINT (b
->save_length
, -1);
5380 Fsleep_for (make_number (1), Qnil
);
5383 if (!auto_saved
&& NILP (no_message
))
5384 message1 ("Auto-saving...");
5385 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5387 BUF_AUTOSAVE_MODIFF (b
) = BUF_MODIFF (b
);
5388 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5389 set_buffer_internal (old
);
5391 EMACS_GET_TIME (after_time
);
5393 /* If auto-save took more than 60 seconds,
5394 assume it was an NFS failure that got a timeout. */
5395 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5396 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5400 /* Prevent another auto save till enough input events come in. */
5401 record_auto_save ();
5403 if (auto_saved
&& NILP (no_message
))
5407 /* If we are going to restore an old message,
5408 give time to read ours. */
5409 sit_for (make_number (1), 0, 0);
5412 else if (!auto_save_error_occurred
)
5413 /* Don't overwrite the error message if an error occurred.
5414 If we displayed a message and then restored a state
5415 with no message, leave a "done" message on the screen. */
5416 message1 ("Auto-saving...done");
5421 /* This restores the message-stack status. */
5422 unbind_to (count
, Qnil
);
5426 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5427 Sset_buffer_auto_saved
, 0, 0, 0,
5428 doc
: /* Mark current buffer as auto-saved with its current text.
5429 No auto-save file will be written until the buffer changes again. */)
5432 /* FIXME: This should not be called in indirect buffers, since
5433 they're not autosaved. */
5434 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
5435 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5436 current_buffer
->auto_save_failure_time
= -1;
5440 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5441 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5442 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5445 current_buffer
->auto_save_failure_time
= -1;
5449 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5451 doc
: /* Return t if current buffer has been auto-saved recently.
5452 More precisely, if it has been auto-saved since last read from or saved
5453 in the visited file. If the buffer has no visited file,
5454 then any auto-save counts as "recent". */)
5457 /* FIXME: maybe we should return nil for indirect buffers since
5458 they're never autosaved. */
5459 return (SAVE_MODIFF
< BUF_AUTOSAVE_MODIFF (current_buffer
) ? Qt
: Qnil
);
5462 /* Reading and completing file names */
5464 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5465 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5466 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5467 The return value is only relevant for a call to `read-file-name' that happens
5468 before any other event (mouse or keypress) is handled. */)
5471 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
5472 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5482 Fread_file_name (Lisp_Object prompt
, Lisp_Object dir
, Lisp_Object default_filename
, Lisp_Object mustmatch
, Lisp_Object initial
, Lisp_Object predicate
)
5484 struct gcpro gcpro1
, gcpro2
;
5485 Lisp_Object args
[7];
5487 GCPRO1 (default_filename
);
5488 args
[0] = intern ("read-file-name");
5491 args
[3] = default_filename
;
5492 args
[4] = mustmatch
;
5494 args
[6] = predicate
;
5495 RETURN_UNGCPRO (Ffuncall (7, args
));
5500 syms_of_fileio (void)
5502 Qoperations
= intern_c_string ("operations");
5503 Qexpand_file_name
= intern_c_string ("expand-file-name");
5504 Qsubstitute_in_file_name
= intern_c_string ("substitute-in-file-name");
5505 Qdirectory_file_name
= intern_c_string ("directory-file-name");
5506 Qfile_name_directory
= intern_c_string ("file-name-directory");
5507 Qfile_name_nondirectory
= intern_c_string ("file-name-nondirectory");
5508 Qunhandled_file_name_directory
= intern_c_string ("unhandled-file-name-directory");
5509 Qfile_name_as_directory
= intern_c_string ("file-name-as-directory");
5510 Qcopy_file
= intern_c_string ("copy-file");
5511 Qmake_directory_internal
= intern_c_string ("make-directory-internal");
5512 Qmake_directory
= intern_c_string ("make-directory");
5513 Qdelete_directory_internal
= intern_c_string ("delete-directory-internal");
5514 Qdelete_file
= intern_c_string ("delete-file");
5515 Qrename_file
= intern_c_string ("rename-file");
5516 Qadd_name_to_file
= intern_c_string ("add-name-to-file");
5517 Qmake_symbolic_link
= intern_c_string ("make-symbolic-link");
5518 Qfile_exists_p
= intern_c_string ("file-exists-p");
5519 Qfile_executable_p
= intern_c_string ("file-executable-p");
5520 Qfile_readable_p
= intern_c_string ("file-readable-p");
5521 Qfile_writable_p
= intern_c_string ("file-writable-p");
5522 Qfile_symlink_p
= intern_c_string ("file-symlink-p");
5523 Qaccess_file
= intern_c_string ("access-file");
5524 Qfile_directory_p
= intern_c_string ("file-directory-p");
5525 Qfile_regular_p
= intern_c_string ("file-regular-p");
5526 Qfile_accessible_directory_p
= intern_c_string ("file-accessible-directory-p");
5527 Qfile_modes
= intern_c_string ("file-modes");
5528 Qset_file_modes
= intern_c_string ("set-file-modes");
5529 Qset_file_times
= intern_c_string ("set-file-times");
5530 Qfile_selinux_context
= intern_c_string("file-selinux-context");
5531 Qset_file_selinux_context
= intern_c_string("set-file-selinux-context");
5532 Qfile_newer_than_file_p
= intern_c_string ("file-newer-than-file-p");
5533 Qinsert_file_contents
= intern_c_string ("insert-file-contents");
5534 Qwrite_region
= intern_c_string ("write-region");
5535 Qverify_visited_file_modtime
= intern_c_string ("verify-visited-file-modtime");
5536 Qset_visited_file_modtime
= intern_c_string ("set-visited-file-modtime");
5537 Qauto_save_coding
= intern_c_string ("auto-save-coding");
5539 staticpro (&Qoperations
);
5540 staticpro (&Qexpand_file_name
);
5541 staticpro (&Qsubstitute_in_file_name
);
5542 staticpro (&Qdirectory_file_name
);
5543 staticpro (&Qfile_name_directory
);
5544 staticpro (&Qfile_name_nondirectory
);
5545 staticpro (&Qunhandled_file_name_directory
);
5546 staticpro (&Qfile_name_as_directory
);
5547 staticpro (&Qcopy_file
);
5548 staticpro (&Qmake_directory_internal
);
5549 staticpro (&Qmake_directory
);
5550 staticpro (&Qdelete_directory_internal
);
5551 staticpro (&Qdelete_file
);
5552 staticpro (&Qrename_file
);
5553 staticpro (&Qadd_name_to_file
);
5554 staticpro (&Qmake_symbolic_link
);
5555 staticpro (&Qfile_exists_p
);
5556 staticpro (&Qfile_executable_p
);
5557 staticpro (&Qfile_readable_p
);
5558 staticpro (&Qfile_writable_p
);
5559 staticpro (&Qaccess_file
);
5560 staticpro (&Qfile_symlink_p
);
5561 staticpro (&Qfile_directory_p
);
5562 staticpro (&Qfile_regular_p
);
5563 staticpro (&Qfile_accessible_directory_p
);
5564 staticpro (&Qfile_modes
);
5565 staticpro (&Qset_file_modes
);
5566 staticpro (&Qset_file_times
);
5567 staticpro (&Qfile_selinux_context
);
5568 staticpro (&Qset_file_selinux_context
);
5569 staticpro (&Qfile_newer_than_file_p
);
5570 staticpro (&Qinsert_file_contents
);
5571 staticpro (&Qwrite_region
);
5572 staticpro (&Qverify_visited_file_modtime
);
5573 staticpro (&Qset_visited_file_modtime
);
5574 staticpro (&Qauto_save_coding
);
5576 Qfile_name_history
= intern_c_string ("file-name-history");
5577 Fset (Qfile_name_history
, Qnil
);
5578 staticpro (&Qfile_name_history
);
5580 Qfile_error
= intern_c_string ("file-error");
5581 staticpro (&Qfile_error
);
5582 Qfile_already_exists
= intern_c_string ("file-already-exists");
5583 staticpro (&Qfile_already_exists
);
5584 Qfile_date_error
= intern_c_string ("file-date-error");
5585 staticpro (&Qfile_date_error
);
5586 Qexcl
= intern_c_string ("excl");
5590 Qfind_buffer_file_type
= intern_c_string ("find-buffer-file-type");
5591 staticpro (&Qfind_buffer_file_type
);
5594 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system
,
5595 doc
: /* *Coding system for encoding file names.
5596 If it is nil, `default-file-name-coding-system' (which see) is used. */);
5597 Vfile_name_coding_system
= Qnil
;
5599 DEFVAR_LISP ("default-file-name-coding-system",
5600 Vdefault_file_name_coding_system
,
5601 doc
: /* Default coding system for encoding file names.
5602 This variable is used only when `file-name-coding-system' is nil.
5604 This variable is set/changed by the command `set-language-environment'.
5605 User should not set this variable manually,
5606 instead use `file-name-coding-system' to get a constant encoding
5607 of file names regardless of the current language environment. */);
5608 Vdefault_file_name_coding_system
= Qnil
;
5610 Qformat_decode
= intern_c_string ("format-decode");
5611 staticpro (&Qformat_decode
);
5612 Qformat_annotate_function
= intern_c_string ("format-annotate-function");
5613 staticpro (&Qformat_annotate_function
);
5614 Qafter_insert_file_set_coding
= intern_c_string ("after-insert-file-set-coding");
5615 staticpro (&Qafter_insert_file_set_coding
);
5617 Qcar_less_than_car
= intern_c_string ("car-less-than-car");
5618 staticpro (&Qcar_less_than_car
);
5620 Fput (Qfile_error
, Qerror_conditions
,
5621 Fpurecopy (list2 (Qfile_error
, Qerror
)));
5622 Fput (Qfile_error
, Qerror_message
,
5623 make_pure_c_string ("File error"));
5625 Fput (Qfile_already_exists
, Qerror_conditions
,
5626 Fpurecopy (list3 (Qfile_already_exists
, Qfile_error
, Qerror
)));
5627 Fput (Qfile_already_exists
, Qerror_message
,
5628 make_pure_c_string ("File already exists"));
5630 Fput (Qfile_date_error
, Qerror_conditions
,
5631 Fpurecopy (list3 (Qfile_date_error
, Qfile_error
, Qerror
)));
5632 Fput (Qfile_date_error
, Qerror_message
,
5633 make_pure_c_string ("Cannot set file date"));
5635 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist
,
5636 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
5637 If a file name matches REGEXP, then all I/O on that file is done by calling
5640 The first argument given to HANDLER is the name of the I/O primitive
5641 to be handled; the remaining arguments are the arguments that were
5642 passed to that primitive. For example, if you do
5643 (file-exists-p FILENAME)
5644 and FILENAME is handled by HANDLER, then HANDLER is called like this:
5645 (funcall HANDLER 'file-exists-p FILENAME)
5646 The function `find-file-name-handler' checks this list for a handler
5647 for its argument. */);
5648 Vfile_name_handler_alist
= Qnil
;
5650 DEFVAR_LISP ("set-auto-coding-function",
5651 Vset_auto_coding_function
,
5652 doc
: /* If non-nil, a function to call to decide a coding system of file.
5653 Two arguments are passed to this function: the file name
5654 and the length of a file contents following the point.
5655 This function should return a coding system to decode the file contents.
5656 It should check the file name against `auto-coding-alist'.
5657 If no coding system is decided, it should check a coding system
5658 specified in the heading lines with the format:
5659 -*- ... coding: CODING-SYSTEM; ... -*-
5660 or local variable spec of the tailing lines with `coding:' tag. */);
5661 Vset_auto_coding_function
= Qnil
;
5663 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions
,
5664 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
5665 Each is passed one argument, the number of characters inserted,
5666 with point at the start of the inserted text. Each function
5667 should leave point the same, and return the new character count.
5668 If `insert-file-contents' is intercepted by a handler from
5669 `file-name-handler-alist', that handler is responsible for calling the
5670 functions in `after-insert-file-functions' if appropriate. */);
5671 Vafter_insert_file_functions
= Qnil
;
5673 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions
,
5674 doc
: /* A list of functions to be called at the start of `write-region'.
5675 Each is passed two arguments, START and END as for `write-region'.
5676 These are usually two numbers but not always; see the documentation
5677 for `write-region'. The function should return a list of pairs
5678 of the form (POSITION . STRING), consisting of strings to be effectively
5679 inserted at the specified positions of the file being written (1 means to
5680 insert before the first byte written). The POSITIONs must be sorted into
5683 If there are several annotation functions, the lists returned by these
5684 functions are merged destructively. As each annotation function runs,
5685 the variable `write-region-annotations-so-far' contains a list of all
5686 annotations returned by previous annotation functions.
5688 An annotation function can return with a different buffer current.
5689 Doing so removes the annotations returned by previous functions, and
5690 resets START and END to `point-min' and `point-max' of the new buffer.
5692 After `write-region' completes, Emacs calls the function stored in
5693 `write-region-post-annotation-function', once for each buffer that was
5694 current when building the annotations (i.e., at least once), with that
5695 buffer current. */);
5696 Vwrite_region_annotate_functions
= Qnil
;
5697 staticpro (&Qwrite_region_annotate_functions
);
5698 Qwrite_region_annotate_functions
5699 = intern_c_string ("write-region-annotate-functions");
5701 DEFVAR_LISP ("write-region-post-annotation-function",
5702 Vwrite_region_post_annotation_function
,
5703 doc
: /* Function to call after `write-region' completes.
5704 The function is called with no arguments. If one or more of the
5705 annotation functions in `write-region-annotate-functions' changed the
5706 current buffer, the function stored in this variable is called for
5707 each of those additional buffers as well, in addition to the original
5708 buffer. The relevant buffer is current during each function call. */);
5709 Vwrite_region_post_annotation_function
= Qnil
;
5710 staticpro (&Vwrite_region_annotation_buffers
);
5712 DEFVAR_LISP ("write-region-annotations-so-far",
5713 Vwrite_region_annotations_so_far
,
5714 doc
: /* When an annotation function is called, this holds the previous annotations.
5715 These are the annotations made by other annotation functions
5716 that were already called. See also `write-region-annotate-functions'. */);
5717 Vwrite_region_annotations_so_far
= Qnil
;
5719 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers
,
5720 doc
: /* A list of file name handlers that temporarily should not be used.
5721 This applies only to the operation `inhibit-file-name-operation'. */);
5722 Vinhibit_file_name_handlers
= Qnil
;
5724 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation
,
5725 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5726 Vinhibit_file_name_operation
= Qnil
;
5728 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name
,
5729 doc
: /* File name in which we write a list of all auto save file names.
5730 This variable is initialized automatically from `auto-save-list-file-prefix'
5731 shortly after Emacs reads your `.emacs' file, if you have not yet given it
5732 a non-nil value. */);
5733 Vauto_save_list_file_name
= Qnil
;
5735 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name
,
5736 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
5737 Normally auto-save files are written under other names. */);
5738 Vauto_save_visited_file_name
= Qnil
;
5740 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions
,
5741 doc
: /* If non-nil, auto-save even if a large part of the text is deleted.
5742 If nil, deleting a substantial portion of the text disables auto-save
5743 in the buffer; this is the default behavior, because the auto-save
5744 file is usually more useful if it contains the deleted text. */);
5745 Vauto_save_include_big_deletions
= Qnil
;
5748 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync
,
5749 doc
: /* *Non-nil means don't call fsync in `write-region'.
5750 This variable affects calls to `write-region' as well as save commands.
5751 A non-nil value may result in data loss! */);
5752 write_region_inhibit_fsync
= 0;
5755 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash
,
5756 doc
: /* Specifies whether to use the system's trash can.
5757 When non-nil, certain file deletion commands use the function
5758 `move-file-to-trash' instead of deleting files outright.
5759 This includes interactive calls to `delete-file' and
5760 `delete-directory' and the Dired deletion commands. */);
5761 delete_by_moving_to_trash
= 0;
5762 Qdelete_by_moving_to_trash
= intern_c_string ("delete-by-moving-to-trash");
5763 Qmove_file_to_trash
= intern_c_string ("move-file-to-trash");
5764 staticpro (&Qmove_file_to_trash
);
5765 Qcopy_directory
= intern_c_string ("copy-directory");
5766 staticpro (&Qcopy_directory
);
5767 Qdelete_directory
= intern_c_string ("delete-directory");
5768 staticpro (&Qdelete_directory
);
5770 defsubr (&Sfind_file_name_handler
);
5771 defsubr (&Sfile_name_directory
);
5772 defsubr (&Sfile_name_nondirectory
);
5773 defsubr (&Sunhandled_file_name_directory
);
5774 defsubr (&Sfile_name_as_directory
);
5775 defsubr (&Sdirectory_file_name
);
5776 defsubr (&Smake_temp_name
);
5777 defsubr (&Sexpand_file_name
);
5778 defsubr (&Ssubstitute_in_file_name
);
5779 defsubr (&Scopy_file
);
5780 defsubr (&Smake_directory_internal
);
5781 defsubr (&Sdelete_directory_internal
);
5782 defsubr (&Sdelete_file
);
5783 defsubr (&Srename_file
);
5784 defsubr (&Sadd_name_to_file
);
5785 defsubr (&Smake_symbolic_link
);
5786 defsubr (&Sfile_name_absolute_p
);
5787 defsubr (&Sfile_exists_p
);
5788 defsubr (&Sfile_executable_p
);
5789 defsubr (&Sfile_readable_p
);
5790 defsubr (&Sfile_writable_p
);
5791 defsubr (&Saccess_file
);
5792 defsubr (&Sfile_symlink_p
);
5793 defsubr (&Sfile_directory_p
);
5794 defsubr (&Sfile_accessible_directory_p
);
5795 defsubr (&Sfile_regular_p
);
5796 defsubr (&Sfile_modes
);
5797 defsubr (&Sset_file_modes
);
5798 defsubr (&Sset_file_times
);
5799 defsubr (&Sfile_selinux_context
);
5800 defsubr (&Sset_file_selinux_context
);
5801 defsubr (&Sset_default_file_modes
);
5802 defsubr (&Sdefault_file_modes
);
5803 defsubr (&Sfile_newer_than_file_p
);
5804 defsubr (&Sinsert_file_contents
);
5805 defsubr (&Swrite_region
);
5806 defsubr (&Scar_less_than_car
);
5807 defsubr (&Sverify_visited_file_modtime
);
5808 defsubr (&Sclear_visited_file_modtime
);
5809 defsubr (&Svisited_file_modtime
);
5810 defsubr (&Sset_visited_file_modtime
);
5811 defsubr (&Sdo_auto_save
);
5812 defsubr (&Sset_buffer_auto_saved
);
5813 defsubr (&Sclear_buffer_auto_save_failure
);
5814 defsubr (&Srecent_auto_save_p
);
5816 defsubr (&Snext_read_file_uses_dialog_p
);
5819 defsubr (&Sunix_sync
);