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>
36 #ifdef HAVE_LIBSELINUX
37 #include <selinux/selinux.h>
38 #include <selinux/context.h>
41 #include <ignore-value.h>
44 #include "intervals.h"
46 #include "character.h"
49 #include "blockinput.h"
51 #include "dispextern.h"
57 #endif /* not WINDOWSNT */
61 #include <sys/param.h>
66 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
67 redirector allows the six letters between 'Z' and 'a' as well. */
69 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
72 #define IS_DRIVE(x) isalpha ((unsigned char) (x))
74 /* Need to lower-case the drive letter, or else expanded
75 filenames will sometimes compare inequal, because
76 `expand-file-name' doesn't always down-case the drive letter. */
77 #define DRIVE_LETTER(x) (tolower ((unsigned char) (x)))
88 #ifndef FILE_SYSTEM_CASE
89 #define FILE_SYSTEM_CASE(filename) (filename)
92 /* Nonzero during writing of auto-save files */
93 static int auto_saving
;
95 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
96 a new file with the same mode as the original */
97 static int auto_save_mode_bits
;
99 /* Set by auto_save_1 if an error occurred during the last auto-save. */
100 static int auto_save_error_occurred
;
102 /* The symbol bound to coding-system-for-read when
103 insert-file-contents is called for recovering a file. This is not
104 an actual coding system name, but just an indicator to tell
105 insert-file-contents to use `emacs-mule' with a special flag for
106 auto saving and recovering a file. */
107 static Lisp_Object Qauto_save_coding
;
109 /* Property name of a file name handler,
110 which gives a list of operations it handles.. */
111 static Lisp_Object Qoperations
;
113 /* Lisp functions for translating file formats */
114 static Lisp_Object Qformat_decode
, Qformat_annotate_function
;
116 /* Lisp function for setting buffer-file-coding-system and the
117 multibyteness of the current buffer after inserting a file. */
118 static Lisp_Object Qafter_insert_file_set_coding
;
120 static Lisp_Object Qwrite_region_annotate_functions
;
121 /* Each time an annotation function changes the buffer, the new buffer
123 static Lisp_Object Vwrite_region_annotation_buffers
;
128 static Lisp_Object Qdelete_by_moving_to_trash
;
130 /* Lisp function for moving files to trash. */
131 static Lisp_Object Qmove_file_to_trash
;
133 /* Lisp function for recursively copying directories. */
134 static Lisp_Object Qcopy_directory
;
136 /* Lisp function for recursively deleting directories. */
137 static Lisp_Object Qdelete_directory
;
142 Lisp_Object Qfile_error
;
143 static Lisp_Object Qfile_already_exists
, Qfile_date_error
;
144 static Lisp_Object Qexcl
;
145 Lisp_Object Qfile_name_history
;
147 static Lisp_Object Qcar_less_than_car
;
149 static Lisp_Object
Fmake_symbolic_link (Lisp_Object
, Lisp_Object
, Lisp_Object
);
150 static int a_write (int, Lisp_Object
, EMACS_INT
, EMACS_INT
,
151 Lisp_Object
*, struct coding_system
*);
152 static int e_write (int, Lisp_Object
, EMACS_INT
, EMACS_INT
,
153 struct coding_system
*);
157 report_file_error (const char *string
, Lisp_Object data
)
159 Lisp_Object errstring
;
163 synchronize_system_messages_locale ();
164 str
= strerror (errorno
);
165 errstring
= code_convert_string_norecord (make_unibyte_string (str
,
167 Vlocale_coding_system
, 0);
173 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
176 /* System error messages are capitalized. Downcase the initial
177 unless it is followed by a slash. (The slash case caters to
178 error messages that begin with "I/O" or, in German, "E/A".) */
179 if (STRING_MULTIBYTE (errstring
)
180 && ! EQ (Faref (errstring
, make_number (1)), make_number ('/')))
184 str
= SSDATA (errstring
);
185 c
= STRING_CHAR ((unsigned char *) str
);
186 Faset (errstring
, make_number (0), make_number (downcase (c
)));
189 xsignal (Qfile_error
,
190 Fcons (build_string (string
), Fcons (errstring
, data
)));
195 close_file_unwind (Lisp_Object fd
)
197 emacs_close (XFASTINT (fd
));
201 /* Restore point, having saved it as a marker. */
204 restore_point_unwind (Lisp_Object location
)
206 Fgoto_char (location
);
207 Fset_marker (location
, Qnil
, Qnil
);
212 static Lisp_Object Qexpand_file_name
;
213 static Lisp_Object Qsubstitute_in_file_name
;
214 static Lisp_Object Qdirectory_file_name
;
215 static Lisp_Object Qfile_name_directory
;
216 static Lisp_Object Qfile_name_nondirectory
;
217 static Lisp_Object Qunhandled_file_name_directory
;
218 static Lisp_Object Qfile_name_as_directory
;
219 static Lisp_Object Qcopy_file
;
220 static Lisp_Object Qmake_directory_internal
;
221 static Lisp_Object Qmake_directory
;
222 static Lisp_Object Qdelete_directory_internal
;
223 Lisp_Object Qdelete_file
;
224 static Lisp_Object Qrename_file
;
225 static Lisp_Object Qadd_name_to_file
;
226 static Lisp_Object Qmake_symbolic_link
;
227 Lisp_Object Qfile_exists_p
;
228 static Lisp_Object Qfile_executable_p
;
229 static Lisp_Object Qfile_readable_p
;
230 static Lisp_Object Qfile_writable_p
;
231 static Lisp_Object Qfile_symlink_p
;
232 static Lisp_Object Qaccess_file
;
233 Lisp_Object Qfile_directory_p
;
234 static Lisp_Object Qfile_regular_p
;
235 static Lisp_Object Qfile_accessible_directory_p
;
236 static Lisp_Object Qfile_modes
;
237 static Lisp_Object Qset_file_modes
;
238 static Lisp_Object Qset_file_times
;
239 static Lisp_Object Qfile_selinux_context
;
240 static Lisp_Object Qset_file_selinux_context
;
241 static Lisp_Object Qfile_newer_than_file_p
;
242 Lisp_Object Qinsert_file_contents
;
243 Lisp_Object Qwrite_region
;
244 static Lisp_Object Qverify_visited_file_modtime
;
245 static Lisp_Object Qset_visited_file_modtime
;
247 DEFUN ("find-file-name-handler", Ffind_file_name_handler
,
248 Sfind_file_name_handler
, 2, 2, 0,
249 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
250 Otherwise, return nil.
251 A file name is handled if one of the regular expressions in
252 `file-name-handler-alist' matches it.
254 If OPERATION equals `inhibit-file-name-operation', then we ignore
255 any handlers that are members of `inhibit-file-name-handlers',
256 but we still do run any other handlers. This lets handlers
257 use the standard functions without calling themselves recursively. */)
258 (Lisp_Object filename
, Lisp_Object operation
)
260 /* This function must not munge the match data. */
261 Lisp_Object chain
, inhibited_handlers
, result
;
265 CHECK_STRING (filename
);
267 if (EQ (operation
, Vinhibit_file_name_operation
))
268 inhibited_handlers
= Vinhibit_file_name_handlers
;
270 inhibited_handlers
= Qnil
;
272 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
273 chain
= XCDR (chain
))
279 Lisp_Object string
= XCAR (elt
);
281 Lisp_Object handler
= XCDR (elt
);
282 Lisp_Object operations
= Qnil
;
284 if (SYMBOLP (handler
))
285 operations
= Fget (handler
, Qoperations
);
288 && (match_pos
= fast_string_match (string
, filename
)) > pos
289 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
293 handler
= XCDR (elt
);
294 tem
= Fmemq (handler
, inhibited_handlers
);
308 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
310 doc
: /* Return the directory component in file name FILENAME.
311 Return nil if FILENAME does not include a directory.
312 Otherwise return a directory name.
313 Given a Unix syntax file name, returns a string ending in slash. */)
314 (Lisp_Object filename
)
317 register const char *beg
;
321 register const char *p
;
324 CHECK_STRING (filename
);
326 /* If the file name has special constructs in it,
327 call the corresponding file handler. */
328 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
330 return call2 (handler
, Qfile_name_directory
, filename
);
332 filename
= FILE_SYSTEM_CASE (filename
);
334 beg
= (char *) alloca (SBYTES (filename
) + 1);
335 memcpy (beg
, SSDATA (filename
), SBYTES (filename
) + 1);
337 beg
= SSDATA (filename
);
339 p
= beg
+ SBYTES (filename
);
341 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
343 /* only recognise drive specifier at the beginning */
345 /* handle the "/:d:foo" and "/:foo" cases correctly */
346 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
347 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
354 /* Expansion of "c:" to drive and default directory. */
357 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
358 char *res
= alloca (MAXPATHLEN
+ 1);
361 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
363 strncpy (res
, beg
, 2);
368 if (getdefdir (toupper ((unsigned char) *beg
) - 'A' + 1, r
))
370 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
373 p
= beg
+ strlen (beg
);
376 dostounix_filename (beg
);
379 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
382 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
383 Sfile_name_nondirectory
, 1, 1, 0,
384 doc
: /* Return file name FILENAME sans its directory.
385 For example, in a Unix-syntax file name,
386 this is everything after the last slash,
387 or the entire name if it contains no slash. */)
388 (Lisp_Object filename
)
390 register const char *beg
, *p
, *end
;
393 CHECK_STRING (filename
);
395 /* If the file name has special constructs in it,
396 call the corresponding file handler. */
397 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
399 return call2 (handler
, Qfile_name_nondirectory
, filename
);
401 beg
= SSDATA (filename
);
402 end
= p
= beg
+ SBYTES (filename
);
404 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
406 /* only recognise drive specifier at beginning */
408 /* handle the "/:d:foo" case correctly */
409 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
414 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
417 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
418 Sunhandled_file_name_directory
, 1, 1, 0,
419 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
420 A `directly usable' directory name is one that may be used without the
421 intervention of any file handler.
422 If FILENAME is a directly usable file itself, return
423 \(file-name-directory FILENAME).
424 If FILENAME refers to a file which is not accessible from a local process,
425 then this should return nil.
426 The `call-process' and `start-process' functions use this function to
427 get a current directory to run processes in. */)
428 (Lisp_Object filename
)
432 /* If the file name has special constructs in it,
433 call the corresponding file handler. */
434 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
436 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
438 return Ffile_name_directory (filename
);
443 file_name_as_directory (char *out
, const char *in
)
445 ptrdiff_t len
= strlen (in
);
457 /* For Unix syntax, Append a slash if necessary */
458 if (!IS_DIRECTORY_SEP (out
[len
- 1]))
460 out
[len
] = DIRECTORY_SEP
;
464 dostounix_filename (out
);
469 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
470 Sfile_name_as_directory
, 1, 1, 0,
471 doc
: /* Return a string representing the file name FILE interpreted as a directory.
472 This operation exists because a directory is also a file, but its name as
473 a directory is different from its name as a file.
474 The result can be used as the value of `default-directory'
475 or passed as second argument to `expand-file-name'.
476 For a Unix-syntax file name, just appends a slash. */)
486 /* If the file name has special constructs in it,
487 call the corresponding file handler. */
488 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
490 return call2 (handler
, Qfile_name_as_directory
, file
);
492 buf
= (char *) alloca (SBYTES (file
) + 10);
493 file_name_as_directory (buf
, SSDATA (file
));
494 return make_specified_string (buf
, -1, strlen (buf
),
495 STRING_MULTIBYTE (file
));
499 * Convert from directory name to filename.
500 * On UNIX, it's simple: just make sure there isn't a terminating /
502 * Value is nonzero if the string output is different from the input.
506 directory_file_name (char *src
, char *dst
)
512 /* Process as Unix format: just remove any final slash.
513 But leave "/" unchanged; do not change it to "". */
516 && IS_DIRECTORY_SEP (dst
[slen
- 1])
518 && !IS_ANY_SEP (dst
[slen
- 2])
523 dostounix_filename (dst
);
528 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
530 doc
: /* Returns the file name of the directory named DIRECTORY.
531 This is the name of the file that holds the data for the directory DIRECTORY.
532 This operation exists because a directory is also a file, but its name as
533 a directory is different from its name as a file.
534 In Unix-syntax, this function just removes the final slash. */)
535 (Lisp_Object directory
)
540 CHECK_STRING (directory
);
542 if (NILP (directory
))
545 /* If the file name has special constructs in it,
546 call the corresponding file handler. */
547 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
549 return call2 (handler
, Qdirectory_file_name
, directory
);
551 buf
= (char *) alloca (SBYTES (directory
) + 20);
552 directory_file_name (SSDATA (directory
), buf
);
553 return make_specified_string (buf
, -1, strlen (buf
),
554 STRING_MULTIBYTE (directory
));
557 static const char make_temp_name_tbl
[64] =
559 'A','B','C','D','E','F','G','H',
560 'I','J','K','L','M','N','O','P',
561 'Q','R','S','T','U','V','W','X',
562 'Y','Z','a','b','c','d','e','f',
563 'g','h','i','j','k','l','m','n',
564 'o','p','q','r','s','t','u','v',
565 'w','x','y','z','0','1','2','3',
566 '4','5','6','7','8','9','-','_'
569 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
571 /* Value is a temporary file name starting with PREFIX, a string.
573 The Emacs process number forms part of the result, so there is
574 no danger of generating a name being used by another process.
575 In addition, this function makes an attempt to choose a name
576 which has no existing file. To make this work, PREFIX should be
577 an absolute file name.
579 BASE64_P non-zero means add the pid as 3 characters in base64
580 encoding. In this case, 6 characters will be added to PREFIX to
581 form the file name. Otherwise, if Emacs is running on a system
582 with long file names, add the pid as a decimal number.
584 This function signals an error if no unique file name could be
588 make_temp_name (Lisp_Object prefix
, int base64_p
)
594 char pidbuf
[INT_BUFSIZE_BOUND (pid_t
)];
597 CHECK_STRING (prefix
);
599 /* VAL is created by adding 6 characters to PREFIX. The first
600 three are the PID of this process, in base 64, and the second
601 three are incremented if the file already exists. This ensures
602 262144 unique file names per PID per PREFIX. */
608 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
609 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
610 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
615 #ifdef HAVE_LONG_FILE_NAMES
616 pidlen
= sprintf (pidbuf
, "%"PRIdMAX
, pid
);
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 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
626 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
627 if (!STRING_MULTIBYTE (prefix
))
628 STRING_SET_UNIBYTE (val
);
630 memcpy (data
, SSDATA (prefix
), len
);
633 memcpy (p
, pidbuf
, pidlen
);
636 /* Here we try to minimize useless stat'ing when this function is
637 invoked many times successively with the same PREFIX. We achieve
638 this by initializing count to a random value, and incrementing it
641 We don't want make-temp-name to be called while dumping,
642 because then make_temp_name_count_initialized_p would get set
643 and then make_temp_name_count would not be set when Emacs starts. */
645 if (!make_temp_name_count_initialized_p
)
647 make_temp_name_count
= time (NULL
);
648 make_temp_name_count_initialized_p
= 1;
654 unsigned num
= make_temp_name_count
;
656 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
657 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
658 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
660 /* Poor man's congruential RN generator. Replace with
661 ++make_temp_name_count for debugging. */
662 make_temp_name_count
+= 25229;
663 make_temp_name_count
%= 225307;
665 if (stat (data
, &ignored
) < 0)
667 /* We want to return only if errno is ENOENT. */
671 /* The error here is dubious, but there is little else we
672 can do. The alternatives are to return nil, which is
673 as bad as (and in many cases worse than) throwing the
674 error, or to ignore the error, which will likely result
675 in looping through 225307 stat's, which is not only
676 dog-slow, but also useless since eventually nil would
677 have to be returned anyway. */
678 report_file_error ("Cannot create temporary name for prefix",
679 Fcons (prefix
, Qnil
));
686 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
687 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
688 The Emacs process number forms part of the result,
689 so there is no danger of generating a name being used by another process.
691 In addition, this function makes an attempt to choose a name
692 which has no existing file. To make this work,
693 PREFIX should be an absolute file name.
695 There is a race condition between calling `make-temp-name' and creating the
696 file which opens all kinds of security holes. For that reason, you should
697 probably use `make-temp-file' instead, except in three circumstances:
699 * If you are creating the file in the user's home directory.
700 * If you are creating a directory rather than an ordinary file.
701 * If you are taking special precautions as `make-temp-file' does. */)
704 return make_temp_name (prefix
, 0);
709 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
710 doc
: /* Convert filename NAME to absolute, and canonicalize it.
711 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
712 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
713 the current buffer's value of `default-directory' is used.
714 NAME should be a string that is a valid file name for the underlying
716 File name components that are `.' are removed, and
717 so are file name components followed by `..', along with the `..' itself;
718 note that these simplifications are done without checking the resulting
719 file names in the file system.
720 Multiple consecutive slashes are collapsed into a single slash,
721 except at the beginning of the file name when they are significant (e.g.,
722 UNC file names on MS-Windows.)
723 An initial `~/' expands to your home directory.
724 An initial `~USER/' expands to USER's home directory.
725 See also the function `substitute-in-file-name'.
727 For technical reasons, this function can return correct but
728 non-intuitive results for the root directory; for instance,
729 \(expand-file-name ".." "/") returns "/..". For this reason, use
730 \(directory-file-name (file-name-directory dirname)) to traverse a
731 filesystem tree, not (expand-file-name ".." dirname). */)
732 (Lisp_Object name
, Lisp_Object default_directory
)
734 /* These point to SDATA and need to be careful with string-relocation
735 during GC (via DECODE_FILE). */
738 /* This should only point to alloca'd data. */
745 int collapse_newdir
= 1;
749 Lisp_Object handler
, result
;
755 /* If the file name has special constructs in it,
756 call the corresponding file handler. */
757 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
759 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
761 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
762 if (NILP (default_directory
))
763 default_directory
= BVAR (current_buffer
, directory
);
764 if (! STRINGP (default_directory
))
767 /* "/" is not considered a root directory on DOS_NT, so using "/"
768 here causes an infinite recursion in, e.g., the following:
770 (let (default-directory)
771 (expand-file-name "a"))
773 To avoid this, we set default_directory to the root of the
775 default_directory
= build_string (emacs_root_dir ());
777 default_directory
= build_string ("/");
781 if (!NILP (default_directory
))
783 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
785 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
789 char *o
= SSDATA (default_directory
);
791 /* Make sure DEFAULT_DIRECTORY is properly expanded.
792 It would be better to do this down below where we actually use
793 default_directory. Unfortunately, calling Fexpand_file_name recursively
794 could invoke GC, and the strings might be relocated. This would
795 be annoying because we have pointers into strings lying around
796 that would need adjusting, and people would add new pointers to
797 the code and forget to adjust them, resulting in intermittent bugs.
798 Putting this call here avoids all that crud.
800 The EQ test avoids infinite recursion. */
801 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
802 /* Save time in some common cases - as long as default_directory
803 is not relative, it can be canonicalized with name below (if it
804 is needed at all) without requiring it to be expanded now. */
806 /* Detect MSDOS file names with drive specifiers. */
807 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
808 && IS_DIRECTORY_SEP (o
[2]))
810 /* Detect Windows file names in UNC format. */
811 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
813 #else /* not DOS_NT */
814 /* Detect Unix absolute file names (/... alone is not absolute on
816 && ! (IS_DIRECTORY_SEP (o
[0]))
817 #endif /* not DOS_NT */
823 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
827 name
= FILE_SYSTEM_CASE (name
);
828 multibyte
= STRING_MULTIBYTE (name
);
829 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
832 default_directory
= string_to_multibyte (default_directory
);
835 name
= string_to_multibyte (name
);
840 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
841 nm
= (char *) alloca (SBYTES (name
) + 1);
842 memcpy (nm
, SSDATA (name
), SBYTES (name
) + 1);
845 /* Note if special escape prefix is present, but remove for now. */
846 if (nm
[0] == '/' && nm
[1] == ':')
852 /* Find and remove drive specifier if present; this makes nm absolute
853 even if the rest of the name appears to be relative. Only look for
854 drive specifier at the beginning. */
855 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
857 drive
= (unsigned char) nm
[0];
862 /* If we see "c://somedir", we want to strip the first slash after the
863 colon when stripping the drive letter. Otherwise, this expands to
865 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
868 /* Discard any previous drive specifier if nm is now in UNC format. */
869 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
873 #endif /* WINDOWSNT */
876 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
877 none are found, we can probably return right away. We will avoid
878 allocating a new string if name is already fully expanded. */
880 IS_DIRECTORY_SEP (nm
[0])
882 && drive
&& !is_escaped
885 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
889 /* If it turns out that the filename we want to return is just a
890 suffix of FILENAME, we don't need to go through and edit
891 things; we just need to construct a new string using data
892 starting at the middle of FILENAME. If we set lose to a
893 non-zero value, that means we've discovered that we can't do
900 /* Since we know the name is absolute, we can assume that each
901 element starts with a "/". */
903 /* "." and ".." are hairy. */
904 if (IS_DIRECTORY_SEP (p
[0])
906 && (IS_DIRECTORY_SEP (p
[2])
908 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
911 /* We want to replace multiple `/' in a row with a single
914 && IS_DIRECTORY_SEP (p
[0])
915 && IS_DIRECTORY_SEP (p
[1]))
922 /* Make sure directories are all separated with /, but
923 avoid allocation of a new string when not required. */
924 dostounix_filename (nm
);
926 if (IS_DIRECTORY_SEP (nm
[1]))
928 if (strcmp (nm
, SSDATA (name
)) != 0)
929 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
933 /* drive must be set, so this is okay */
934 if (strcmp (nm
- 2, SSDATA (name
)) != 0)
938 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
939 temp
[0] = DRIVE_LETTER (drive
);
940 name
= concat2 (build_string (temp
), name
);
943 #else /* not DOS_NT */
944 if (strcmp (nm
, SSDATA (name
)) == 0)
946 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
947 #endif /* not DOS_NT */
951 /* At this point, nm might or might not be an absolute file name. We
952 need to expand ~ or ~user if present, otherwise prefix nm with
953 default_directory if nm is not absolute, and finally collapse /./
954 and /foo/../ sequences.
956 We set newdir to be the appropriate prefix if one is needed:
957 - the relevant user directory if nm starts with ~ or ~user
958 - the specified drive's working dir (DOS/NT only) if nm does not
960 - the value of default_directory.
962 Note that these prefixes are not guaranteed to be absolute (except
963 for the working dir of a drive). Therefore, to ensure we always
964 return an absolute name, if the final prefix is not absolute we
965 append it to the current working directory. */
969 if (nm
[0] == '~') /* prefix ~ */
971 if (IS_DIRECTORY_SEP (nm
[1])
972 || nm
[1] == 0) /* ~ by itself */
976 if (!(newdir
= egetenv ("HOME")))
979 /* egetenv may return a unibyte string, which will bite us since
980 we expect the directory to be multibyte. */
981 tem
= build_string (newdir
);
982 if (!STRING_MULTIBYTE (tem
))
984 hdir
= DECODE_FILE (tem
);
985 newdir
= SSDATA (hdir
);
991 else /* ~user/filename */
994 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)); p
++);
995 o
= alloca (p
- nm
+ 1);
996 memcpy (o
, nm
, p
- nm
);
1000 pw
= (struct passwd
*) getpwnam (o
+ 1);
1004 newdir
= pw
->pw_dir
;
1007 collapse_newdir
= 0;
1011 /* If we don't find a user of that name, leave the name
1012 unchanged; don't move nm forward to p. */
1017 /* On DOS and Windows, nm is absolute if a drive name was specified;
1018 use the drive's current directory as the prefix if needed. */
1019 if (!newdir
&& drive
)
1021 /* Get default directory if needed to make nm absolute. */
1023 if (!IS_DIRECTORY_SEP (nm
[0]))
1025 adir
= alloca (MAXPATHLEN
+ 1);
1026 if (!getdefdir (toupper (drive
) - 'A' + 1, adir
))
1031 /* Either nm starts with /, or drive isn't mounted. */
1033 adir
[0] = DRIVE_LETTER (drive
);
1042 /* Finally, if no prefix has been specified and nm is not absolute,
1043 then it must be expanded relative to default_directory. */
1047 /* /... alone is not absolute on DOS and Windows. */
1048 && !IS_DIRECTORY_SEP (nm
[0])
1051 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1055 newdir
= SSDATA (default_directory
);
1057 /* Note if special escape prefix is present, but remove for now. */
1058 if (newdir
[0] == '/' && newdir
[1] == ':')
1069 /* First ensure newdir is an absolute name. */
1071 /* Detect MSDOS file names with drive specifiers. */
1072 ! (IS_DRIVE (newdir
[0])
1073 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1075 /* Detect Windows file names in UNC format. */
1076 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1080 /* Effectively, let newdir be (expand-file-name newdir cwd).
1081 Because of the admonition against calling expand-file-name
1082 when we have pointers into lisp strings, we accomplish this
1083 indirectly by prepending newdir to nm if necessary, and using
1084 cwd (or the wd of newdir's drive) as the new newdir. */
1086 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1088 drive
= (unsigned char) newdir
[0];
1091 if (!IS_DIRECTORY_SEP (nm
[0]))
1093 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1094 file_name_as_directory (tmp
, newdir
);
1098 adir
= alloca (MAXPATHLEN
+ 1);
1101 if (!getdefdir (toupper (drive
) - 'A' + 1, adir
))
1109 /* Strip off drive name from prefix, if present. */
1110 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1116 /* Keep only a prefix from newdir if nm starts with slash
1117 (//server/share for UNC, nothing otherwise). */
1118 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1121 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1123 char *adir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1125 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1127 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1140 /* Get rid of any slash at the end of newdir, unless newdir is
1141 just / or // (an incomplete UNC name). */
1142 length
= strlen (newdir
);
1143 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1145 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1149 char *temp
= (char *) alloca (length
);
1150 memcpy (temp
, newdir
, length
- 1);
1151 temp
[length
- 1] = 0;
1159 /* Now concatenate the directory and name to new space in the stack frame */
1160 tlen
+= strlen (nm
) + 1;
1162 /* Reserve space for drive specifier and escape prefix, since either
1163 or both may need to be inserted. (The Microsoft x86 compiler
1164 produces incorrect code if the following two lines are combined.) */
1165 target
= (char *) alloca (tlen
+ 4);
1167 #else /* not DOS_NT */
1168 target
= (char *) alloca (tlen
);
1169 #endif /* not DOS_NT */
1174 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1177 /* If newdir is effectively "C:/", then the drive letter will have
1178 been stripped and newdir will be "/". Concatenating with an
1179 absolute directory in nm produces "//", which will then be
1180 incorrectly treated as a network share. Ignore newdir in
1181 this case (keeping the drive letter). */
1182 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1183 && newdir
[1] == '\0'))
1185 strcpy (target
, newdir
);
1188 file_name_as_directory (target
, newdir
);
1191 strcat (target
, nm
);
1193 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1201 if (!IS_DIRECTORY_SEP (*p
))
1205 else if (p
[1] == '.'
1206 && (IS_DIRECTORY_SEP (p
[2])
1209 /* If "/." is the entire filename, keep the "/". Otherwise,
1210 just delete the whole "/.". */
1211 if (o
== target
&& p
[2] == '\0')
1215 else if (p
[1] == '.' && p
[2] == '.'
1216 /* `/../' is the "superroot" on certain file systems.
1217 Turned off on DOS_NT systems because they have no
1218 "superroot" and because this causes us to produce
1219 file names like "d:/../foo" which fail file-related
1220 functions of the underlying OS. (To reproduce, try a
1221 long series of "../../" in default_directory, longer
1222 than the number of levels from the root.) */
1226 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1231 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1234 /* Don't go below server level in UNC filenames. */
1235 if (o
== target
+ 1 && IS_DIRECTORY_SEP (*o
)
1236 && IS_DIRECTORY_SEP (*target
))
1240 /* Keep initial / only if this is the whole name. */
1241 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1245 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1246 /* Collapse multiple `/' in a row. */
1255 /* At last, set drive name. */
1257 /* Except for network file name. */
1258 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1259 #endif /* WINDOWSNT */
1261 if (!drive
) abort ();
1263 target
[0] = DRIVE_LETTER (drive
);
1266 /* Reinsert the escape prefix if required. */
1273 dostounix_filename (target
);
1276 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1279 /* Again look to see if the file name has special constructs in it
1280 and perhaps call the corresponding file handler. This is needed
1281 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1282 the ".." component gives us "/user@host:/bar/../baz" which needs
1283 to be expanded again. */
1284 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1285 if (!NILP (handler
))
1286 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1292 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1293 This is the old version of expand-file-name, before it was thoroughly
1294 rewritten for Emacs 10.31. We leave this version here commented-out,
1295 because the code is very complex and likely to have subtle bugs. If
1296 bugs _are_ found, it might be of interest to look at the old code and
1297 see what did it do in the relevant situation.
1299 Don't remove this code: it's true that it will be accessible
1300 from the repository, but a few years from deletion, people will
1301 forget it is there. */
1303 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1304 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1305 "Convert FILENAME to absolute, and canonicalize it.\n\
1306 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1307 \(does not start with slash); if DEFAULT is nil or missing,\n\
1308 the current buffer's value of default-directory is used.\n\
1309 Filenames containing `.' or `..' as components are simplified;\n\
1310 initial `~/' expands to your home directory.\n\
1311 See also the function `substitute-in-file-name'.")
1313 Lisp_Object name
, defalt
;
1317 register unsigned char *newdir
, *p
, *o
;
1319 unsigned char *target
;
1323 CHECK_STRING (name
);
1326 /* If nm is absolute, flush ...// and detect /./ and /../.
1327 If no /./ or /../ we can return right away. */
1334 if (p
[0] == '/' && p
[1] == '/'
1337 if (p
[0] == '/' && p
[1] == '~')
1338 nm
= p
+ 1, lose
= 1;
1339 if (p
[0] == '/' && p
[1] == '.'
1340 && (p
[2] == '/' || p
[2] == 0
1341 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1347 if (nm
== SDATA (name
))
1349 return build_string (nm
);
1353 /* Now determine directory to start with and put it in NEWDIR */
1357 if (nm
[0] == '~') /* prefix ~ */
1358 if (nm
[1] == '/' || nm
[1] == 0)/* ~/filename */
1360 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1361 newdir
= (unsigned char *) "";
1364 else /* ~user/filename */
1366 /* Get past ~ to user */
1367 unsigned char *user
= nm
+ 1;
1368 /* Find end of name. */
1369 unsigned char *ptr
= (unsigned char *) strchr (user
, '/');
1370 ptrdiff_t len
= ptr
? ptr
- user
: strlen (user
);
1371 /* Copy the user name into temp storage. */
1372 o
= (unsigned char *) alloca (len
+ 1);
1373 memcpy (o
, user
, len
);
1376 /* Look up the user name. */
1378 pw
= (struct passwd
*) getpwnam (o
+ 1);
1381 error ("\"%s\" isn't a registered user", o
+ 1);
1383 newdir
= (unsigned char *) pw
->pw_dir
;
1385 /* Discard the user name from NM. */
1389 if (nm
[0] != '/' && !newdir
)
1392 defalt
= current_buffer
->directory
;
1393 CHECK_STRING (defalt
);
1394 newdir
= SDATA (defalt
);
1397 /* Now concatenate the directory and name to new space in the stack frame */
1399 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1400 target
= (unsigned char *) alloca (tlen
);
1405 if (nm
[0] == 0 || nm
[0] == '/')
1406 strcpy (target
, newdir
);
1408 file_name_as_directory (target
, newdir
);
1411 strcat (target
, nm
);
1413 /* Now canonicalize by removing /. and /foo/.. if they appear */
1424 else if (!strncmp (p
, "//", 2)
1430 else if (p
[0] == '/' && p
[1] == '.'
1431 && (p
[2] == '/' || p
[2] == 0))
1433 else if (!strncmp (p
, "/..", 3)
1434 /* `/../' is the "superroot" on certain file systems. */
1436 && (p
[3] == '/' || p
[3] == 0))
1438 while (o
!= target
&& *--o
!= '/')
1440 if (o
== target
&& *o
== '/')
1450 return make_string (target
, o
- target
);
1454 /* If /~ or // appears, discard everything through first slash. */
1456 file_name_absolute_p (const char *filename
)
1459 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
1461 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
1462 && IS_DIRECTORY_SEP (filename
[2]))
1468 search_embedded_absfilename (char *nm
, char *endp
)
1472 for (p
= nm
+ 1; p
< endp
; p
++)
1475 || IS_DIRECTORY_SEP (p
[-1]))
1476 && file_name_absolute_p (p
)
1477 #if defined (WINDOWSNT) || defined(CYGWIN)
1478 /* // at start of file name is meaningful in Apollo,
1479 WindowsNT and Cygwin systems. */
1480 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
1481 #endif /* not (WINDOWSNT || CYGWIN) */
1484 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)); s
++);
1485 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
1487 char *o
= alloca (s
- p
+ 1);
1489 memcpy (o
, p
, s
- p
);
1492 /* If we have ~user and `user' exists, discard
1493 everything up to ~. But if `user' does not exist, leave
1494 ~user alone, it might be a literal file name. */
1496 pw
= getpwnam (o
+ 1);
1508 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1509 Ssubstitute_in_file_name
, 1, 1, 0,
1510 doc
: /* Substitute environment variables referred to in FILENAME.
1511 `$FOO' where FOO is an environment variable name means to substitute
1512 the value of that variable. The variable name should be terminated
1513 with a character not a letter, digit or underscore; otherwise, enclose
1514 the entire variable name in braces.
1516 If `/~' appears, all of FILENAME through that `/' is discarded.
1517 If `//' appears, everything up to and including the first of
1518 those `/' is discarded. */)
1519 (Lisp_Object filename
)
1523 register char *s
, *p
, *o
, *x
, *endp
;
1524 char *target
= NULL
;
1526 int substituted
= 0;
1529 Lisp_Object handler
;
1531 CHECK_STRING (filename
);
1533 multibyte
= STRING_MULTIBYTE (filename
);
1535 /* If the file name has special constructs in it,
1536 call the corresponding file handler. */
1537 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1538 if (!NILP (handler
))
1539 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1541 /* Always work on a copy of the string, in case GC happens during
1542 decode of environment variables, causing the original Lisp_String
1543 data to be relocated. */
1544 nm
= (char *) alloca (SBYTES (filename
) + 1);
1545 memcpy (nm
, SDATA (filename
), SBYTES (filename
) + 1);
1548 dostounix_filename (nm
);
1549 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
1551 endp
= nm
+ SBYTES (filename
);
1553 /* If /~ or // appears, discard everything through first slash. */
1554 p
= search_embedded_absfilename (nm
, endp
);
1556 /* Start over with the new string, so we check the file-name-handler
1557 again. Important with filenames like "/home/foo//:/hello///there"
1558 which whould substitute to "/:/hello///there" rather than "/there". */
1559 return Fsubstitute_in_file_name
1560 (make_specified_string (p
, -1, endp
- p
, multibyte
));
1562 /* See if any variables are substituted into the string
1563 and find the total length of their values in `total' */
1565 for (p
= nm
; p
!= endp
;)
1575 /* "$$" means a single "$" */
1584 while (p
!= endp
&& *p
!= '}') p
++;
1585 if (*p
!= '}') goto missingclose
;
1591 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1595 /* Copy out the variable name */
1596 target
= (char *) alloca (s
- o
+ 1);
1597 strncpy (target
, o
, s
- o
);
1600 strupr (target
); /* $home == $HOME etc. */
1603 /* Get variable value */
1604 o
= egetenv (target
);
1607 /* Don't try to guess a maximum length - UTF8 can use up to
1608 four bytes per character. This code is unlikely to run
1609 in a situation that requires performance, so decoding the
1610 env variables twice should be acceptable. Note that
1611 decoding may cause a garbage collect. */
1612 Lisp_Object orig
, decoded
;
1613 orig
= make_unibyte_string (o
, strlen (o
));
1614 decoded
= DECODE_FILE (orig
);
1615 total
+= SBYTES (decoded
);
1625 /* If substitution required, recopy the string and do it */
1626 /* Make space in stack frame for the new copy */
1627 xnm
= (char *) alloca (SBYTES (filename
) + total
+ 1);
1630 /* Copy the rest of the name through, replacing $ constructs with values */
1647 while (p
!= endp
&& *p
!= '}') p
++;
1648 if (*p
!= '}') goto missingclose
;
1654 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1658 /* Copy out the variable name */
1659 target
= (char *) alloca (s
- o
+ 1);
1660 strncpy (target
, o
, s
- o
);
1663 strupr (target
); /* $home == $HOME etc. */
1666 /* Get variable value */
1667 o
= egetenv (target
);
1671 strcpy (x
, target
); x
+= strlen (target
);
1675 Lisp_Object orig
, decoded
;
1676 ptrdiff_t orig_length
, decoded_length
;
1677 orig_length
= strlen (o
);
1678 orig
= make_unibyte_string (o
, orig_length
);
1679 decoded
= DECODE_FILE (orig
);
1680 decoded_length
= SBYTES (decoded
);
1681 strncpy (x
, SSDATA (decoded
), decoded_length
);
1682 x
+= decoded_length
;
1684 /* If environment variable needed decoding, return value
1685 needs to be multibyte. */
1686 if (decoded_length
!= orig_length
1687 || strncmp (SSDATA (decoded
), o
, orig_length
))
1694 /* If /~ or // appears, discard everything through first slash. */
1695 while ((p
= search_embedded_absfilename (xnm
, x
)))
1696 /* This time we do not start over because we've already expanded envvars
1697 and replaced $$ with $. Maybe we should start over as well, but we'd
1698 need to quote some $ to $$ first. */
1701 return make_specified_string (xnm
, -1, x
- xnm
, multibyte
);
1704 error ("Bad format environment-variable substitution");
1706 error ("Missing \"}\" in environment-variable substitution");
1708 error ("Substituting nonexistent environment variable \"%s\"", target
);
1714 /* A slightly faster and more convenient way to get
1715 (directory-file-name (expand-file-name FOO)). */
1718 expand_and_dir_to_file (Lisp_Object filename
, Lisp_Object defdir
)
1720 register Lisp_Object absname
;
1722 absname
= Fexpand_file_name (filename
, defdir
);
1724 /* Remove final slash, if any (unless this is the root dir).
1725 stat behaves differently depending! */
1726 if (SCHARS (absname
) > 1
1727 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
1728 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
1729 /* We cannot take shortcuts; they might be wrong for magic file names. */
1730 absname
= Fdirectory_file_name (absname
);
1734 /* Signal an error if the file ABSNAME already exists.
1735 If INTERACTIVE is nonzero, ask the user whether to proceed,
1736 and bypass the error if the user says to go ahead.
1737 QUERYSTRING is a name for the action that is being considered
1740 *STATPTR is used to store the stat information if the file exists.
1741 If the file does not exist, STATPTR->st_mode is set to 0.
1742 If STATPTR is null, we don't store into it.
1744 If QUICK is nonzero, we ask for y or n, not yes or no. */
1747 barf_or_query_if_file_exists (Lisp_Object absname
, const char *querystring
,
1748 int interactive
, struct stat
*statptr
, int quick
)
1750 register Lisp_Object tem
, encoded_filename
;
1751 struct stat statbuf
;
1752 struct gcpro gcpro1
;
1754 encoded_filename
= ENCODE_FILE (absname
);
1756 /* stat is a good way to tell whether the file exists,
1757 regardless of what access permissions it has. */
1758 if (lstat (SSDATA (encoded_filename
), &statbuf
) >= 0)
1760 if (S_ISDIR (statbuf
.st_mode
))
1761 xsignal2 (Qfile_error
,
1762 build_string ("File is a directory"), absname
);
1765 xsignal2 (Qfile_already_exists
,
1766 build_string ("File already exists"), absname
);
1768 tem
= format2 ("File %s already exists; %s anyway? ",
1769 absname
, build_string (querystring
));
1771 tem
= call1 (intern ("y-or-n-p"), tem
);
1773 tem
= do_yes_or_no_p (tem
);
1776 xsignal2 (Qfile_already_exists
,
1777 build_string ("File already exists"), absname
);
1784 statptr
->st_mode
= 0;
1789 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
1790 "fCopy file: \nGCopy %s to file: \np\nP",
1791 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
1792 If NEWNAME names a directory, copy FILE there.
1794 This function always sets the file modes of the output file to match
1797 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1798 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1799 signal a `file-already-exists' error without overwriting. If
1800 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1801 about overwriting; this is what happens in interactive use with M-x.
1802 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1805 Fourth arg KEEP-TIME non-nil means give the output file the same
1806 last-modified time as the old one. (This works on only some systems.)
1808 A prefix arg makes KEEP-TIME non-nil.
1810 If PRESERVE-UID-GID is non-nil, we try to transfer the
1811 uid and gid of FILE to NEWNAME.
1813 If PRESERVE-SELINUX-CONTEXT is non-nil and SELinux is enabled
1814 on the system, we copy the SELinux context of FILE to NEWNAME. */)
1815 (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
)
1819 char buf
[16 * 1024];
1820 struct stat st
, out_st
;
1821 Lisp_Object handler
;
1822 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1823 int count
= SPECPDL_INDEX ();
1824 int input_file_statable_p
;
1825 Lisp_Object encoded_file
, encoded_newname
;
1827 security_context_t con
;
1828 int fail
, conlength
= 0;
1831 encoded_file
= encoded_newname
= Qnil
;
1832 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
1833 CHECK_STRING (file
);
1834 CHECK_STRING (newname
);
1836 if (!NILP (Ffile_directory_p (newname
)))
1837 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
1839 newname
= Fexpand_file_name (newname
, Qnil
);
1841 file
= Fexpand_file_name (file
, Qnil
);
1843 /* If the input file name has special constructs in it,
1844 call the corresponding file handler. */
1845 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1846 /* Likewise for output file name. */
1848 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1849 if (!NILP (handler
))
1850 RETURN_UNGCPRO (call7 (handler
, Qcopy_file
, file
, newname
,
1851 ok_if_already_exists
, keep_time
, preserve_uid_gid
,
1852 preserve_selinux_context
));
1854 encoded_file
= ENCODE_FILE (file
);
1855 encoded_newname
= ENCODE_FILE (newname
);
1857 if (NILP (ok_if_already_exists
)
1858 || INTEGERP (ok_if_already_exists
))
1859 barf_or_query_if_file_exists (newname
, "copy to it",
1860 INTEGERP (ok_if_already_exists
), &out_st
, 0);
1861 else if (stat (SSDATA (encoded_newname
), &out_st
) < 0)
1865 if (!CopyFile (SDATA (encoded_file
),
1866 SDATA (encoded_newname
),
1868 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
1869 /* CopyFile retains the timestamp by default. */
1870 else if (NILP (keep_time
))
1876 EMACS_GET_TIME (now
);
1877 filename
= SDATA (encoded_newname
);
1879 /* Ensure file is writable while its modified time is set. */
1880 attributes
= GetFileAttributes (filename
);
1881 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
1882 if (set_file_times (filename
, now
, now
))
1884 /* Restore original attributes. */
1885 SetFileAttributes (filename
, attributes
);
1886 xsignal2 (Qfile_date_error
,
1887 build_string ("Cannot set file date"), newname
);
1889 /* Restore original attributes. */
1890 SetFileAttributes (filename
, attributes
);
1892 #else /* not WINDOWSNT */
1894 ifd
= emacs_open (SSDATA (encoded_file
), O_RDONLY
, 0);
1898 report_file_error ("Opening input file", Fcons (file
, Qnil
));
1900 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1902 /* We can only copy regular files and symbolic links. Other files are not
1904 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1907 if (!NILP (preserve_selinux_context
) && is_selinux_enabled ())
1909 conlength
= fgetfilecon (ifd
, &con
);
1910 if (conlength
== -1)
1911 report_file_error ("Doing fgetfilecon", Fcons (file
, Qnil
));
1915 if (out_st
.st_mode
!= 0
1916 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
1919 report_file_error ("Input and output files are the same",
1920 Fcons (file
, Fcons (newname
, Qnil
)));
1923 if (input_file_statable_p
)
1925 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1927 #if defined (EISDIR)
1928 /* Get a better looking error message. */
1931 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
1936 /* System's default file type was set to binary by _fmode in emacs.c. */
1937 ofd
= emacs_open (SDATA (encoded_newname
),
1938 O_WRONLY
| O_TRUNC
| O_CREAT
1939 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
1940 S_IREAD
| S_IWRITE
);
1941 #else /* not MSDOS */
1942 ofd
= emacs_open (SSDATA (encoded_newname
),
1943 O_WRONLY
| O_TRUNC
| O_CREAT
1944 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
1946 #endif /* not MSDOS */
1948 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1950 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1954 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
1955 if (emacs_write (ofd
, buf
, n
) != n
)
1956 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1960 /* Preserve the original file modes, and if requested, also its
1962 if (input_file_statable_p
)
1964 if (!NILP (preserve_uid_gid
))
1965 ignore_value (fchown (ofd
, st
.st_uid
, st
.st_gid
));
1966 if (fchmod (ofd
, st
.st_mode
& 07777) != 0)
1967 report_file_error ("Doing chmod", Fcons (newname
, Qnil
));
1969 #endif /* not MSDOS */
1974 /* Set the modified context back to the file. */
1975 fail
= fsetfilecon (ofd
, con
);
1977 report_file_error ("Doing fsetfilecon", Fcons (newname
, Qnil
));
1983 /* Closing the output clobbers the file times on some systems. */
1984 if (emacs_close (ofd
) < 0)
1985 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1987 if (input_file_statable_p
)
1989 if (!NILP (keep_time
))
1991 EMACS_TIME atime
, mtime
;
1992 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1993 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1994 if (set_file_times (SSDATA (encoded_newname
),
1996 xsignal2 (Qfile_date_error
,
1997 build_string ("Cannot set file date"), newname
);
2004 if (input_file_statable_p
)
2006 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2007 and if it can't, it tells so. Otherwise, under MSDOS we usually
2008 get only the READ bit, which will make the copied file read-only,
2009 so it's better not to chmod at all. */
2010 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2011 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2014 #endif /* not WINDOWSNT */
2016 /* Discard the unwind protects. */
2017 specpdl_ptr
= specpdl
+ count
;
2023 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2024 Smake_directory_internal
, 1, 1, 0,
2025 doc
: /* Create a new directory named DIRECTORY. */)
2026 (Lisp_Object directory
)
2029 Lisp_Object handler
;
2030 Lisp_Object encoded_dir
;
2032 CHECK_STRING (directory
);
2033 directory
= Fexpand_file_name (directory
, Qnil
);
2035 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2036 if (!NILP (handler
))
2037 return call2 (handler
, Qmake_directory_internal
, directory
);
2039 encoded_dir
= ENCODE_FILE (directory
);
2041 dir
= SSDATA (encoded_dir
);
2044 if (mkdir (dir
) != 0)
2046 if (mkdir (dir
, 0777) != 0)
2048 report_file_error ("Creating directory", list1 (directory
));
2053 DEFUN ("delete-directory-internal", Fdelete_directory_internal
,
2054 Sdelete_directory_internal
, 1, 1, 0,
2055 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2056 (Lisp_Object directory
)
2059 Lisp_Object encoded_dir
;
2061 CHECK_STRING (directory
);
2062 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2063 encoded_dir
= ENCODE_FILE (directory
);
2064 dir
= SSDATA (encoded_dir
);
2066 if (rmdir (dir
) != 0)
2067 report_file_error ("Removing directory", list1 (directory
));
2072 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 2,
2073 "(list (read-file-name \
2074 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2075 \"Move file to trash: \" \"Delete file: \") \
2076 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2077 (null current-prefix-arg))",
2078 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2079 If file has multiple names, it continues to exist with the other names.
2080 TRASH non-nil means to trash the file instead of deleting, provided
2081 `delete-by-moving-to-trash' is non-nil.
2083 When called interactively, TRASH is t if no prefix argument is given.
2084 With a prefix argument, TRASH is nil. */)
2085 (Lisp_Object filename
, Lisp_Object trash
)
2087 Lisp_Object handler
;
2088 Lisp_Object encoded_file
;
2089 struct gcpro gcpro1
;
2092 if (!NILP (Ffile_directory_p (filename
))
2093 && NILP (Ffile_symlink_p (filename
)))
2094 xsignal2 (Qfile_error
,
2095 build_string ("Removing old name: is a directory"),
2098 filename
= Fexpand_file_name (filename
, Qnil
);
2100 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2101 if (!NILP (handler
))
2102 return call3 (handler
, Qdelete_file
, filename
, trash
);
2104 if (delete_by_moving_to_trash
&& !NILP (trash
))
2105 return call1 (Qmove_file_to_trash
, filename
);
2107 encoded_file
= ENCODE_FILE (filename
);
2109 if (0 > unlink (SSDATA (encoded_file
)))
2110 report_file_error ("Removing old name", list1 (filename
));
2115 internal_delete_file_1 (Lisp_Object ignore
)
2120 /* Delete file FILENAME, returning 1 if successful and 0 if failed.
2121 This ignores `delete-by-moving-to-trash'. */
2124 internal_delete_file (Lisp_Object filename
)
2128 tem
= internal_condition_case_2 (Fdelete_file
, filename
, Qnil
,
2129 Qt
, internal_delete_file_1
);
2133 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2134 "fRename file: \nGRename %s to file: \np",
2135 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2136 If file has names other than FILE, it continues to have those names.
2137 Signals a `file-already-exists' error if a file NEWNAME already exists
2138 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2139 A number as third arg means request confirmation if NEWNAME already exists.
2140 This is what happens in interactive use with M-x. */)
2141 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2143 Lisp_Object handler
;
2144 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2145 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2147 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2148 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2149 CHECK_STRING (file
);
2150 CHECK_STRING (newname
);
2151 file
= Fexpand_file_name (file
, Qnil
);
2153 if ((!NILP (Ffile_directory_p (newname
)))
2155 /* If the file names are identical but for the case,
2156 don't attempt to move directory to itself. */
2157 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2161 Lisp_Object fname
= NILP (Ffile_directory_p (file
))
2162 ? file
: Fdirectory_file_name (file
);
2163 newname
= Fexpand_file_name (Ffile_name_nondirectory (fname
), newname
);
2166 newname
= Fexpand_file_name (newname
, Qnil
);
2168 /* If the file name has special constructs in it,
2169 call the corresponding file handler. */
2170 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2172 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2173 if (!NILP (handler
))
2174 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2175 file
, newname
, ok_if_already_exists
));
2177 encoded_file
= ENCODE_FILE (file
);
2178 encoded_newname
= ENCODE_FILE (newname
);
2181 /* If the file names are identical but for the case, don't ask for
2182 confirmation: they simply want to change the letter-case of the
2184 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2186 if (NILP (ok_if_already_exists
)
2187 || INTEGERP (ok_if_already_exists
))
2188 barf_or_query_if_file_exists (newname
, "rename to it",
2189 INTEGERP (ok_if_already_exists
), 0, 0);
2190 if (0 > rename (SSDATA (encoded_file
), SSDATA (encoded_newname
)))
2195 symlink_target
= Ffile_symlink_p (file
);
2196 if (! NILP (symlink_target
))
2197 Fmake_symbolic_link (symlink_target
, newname
,
2198 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2199 else if (!NILP (Ffile_directory_p (file
)))
2200 call4 (Qcopy_directory
, file
, newname
, Qt
, Qnil
);
2202 /* We have already prompted if it was an integer, so don't
2203 have copy-file prompt again. */
2204 Fcopy_file (file
, newname
,
2205 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2208 count
= SPECPDL_INDEX ();
2209 specbind (Qdelete_by_moving_to_trash
, Qnil
);
2211 if (!NILP (Ffile_directory_p (file
)) && NILP (symlink_target
))
2212 call2 (Qdelete_directory
, file
, Qt
);
2214 Fdelete_file (file
, Qnil
);
2215 unbind_to (count
, Qnil
);
2218 report_file_error ("Renaming", list2 (file
, newname
));
2224 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2225 "fAdd name to file: \nGName to add to %s: \np",
2226 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2227 Signals a `file-already-exists' error if a file NEWNAME already exists
2228 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2229 A number as third arg means request confirmation if NEWNAME already exists.
2230 This is what happens in interactive use with M-x. */)
2231 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2233 Lisp_Object handler
;
2234 Lisp_Object encoded_file
, encoded_newname
;
2235 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2237 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2238 encoded_file
= encoded_newname
= Qnil
;
2239 CHECK_STRING (file
);
2240 CHECK_STRING (newname
);
2241 file
= Fexpand_file_name (file
, Qnil
);
2243 if (!NILP (Ffile_directory_p (newname
)))
2244 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2246 newname
= Fexpand_file_name (newname
, Qnil
);
2248 /* If the file name has special constructs in it,
2249 call the corresponding file handler. */
2250 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2251 if (!NILP (handler
))
2252 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2253 newname
, ok_if_already_exists
));
2255 /* If the new name has special constructs in it,
2256 call the corresponding file handler. */
2257 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2258 if (!NILP (handler
))
2259 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2260 newname
, ok_if_already_exists
));
2262 encoded_file
= ENCODE_FILE (file
);
2263 encoded_newname
= ENCODE_FILE (newname
);
2265 if (NILP (ok_if_already_exists
)
2266 || INTEGERP (ok_if_already_exists
))
2267 barf_or_query_if_file_exists (newname
, "make it a new name",
2268 INTEGERP (ok_if_already_exists
), 0, 0);
2270 unlink (SSDATA (newname
));
2271 if (0 > link (SSDATA (encoded_file
), SSDATA (encoded_newname
)))
2272 report_file_error ("Adding new name", list2 (file
, newname
));
2278 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2279 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2280 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2281 Both args must be strings.
2282 Signals a `file-already-exists' error if a file LINKNAME already exists
2283 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2284 A number as third arg means request confirmation if LINKNAME already exists.
2285 This happens for interactive use with M-x. */)
2286 (Lisp_Object filename
, Lisp_Object linkname
, Lisp_Object ok_if_already_exists
)
2288 Lisp_Object handler
;
2289 Lisp_Object encoded_filename
, encoded_linkname
;
2290 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2292 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2293 encoded_filename
= encoded_linkname
= Qnil
;
2294 CHECK_STRING (filename
);
2295 CHECK_STRING (linkname
);
2296 /* If the link target has a ~, we must expand it to get
2297 a truly valid file name. Otherwise, do not expand;
2298 we want to permit links to relative file names. */
2299 if (SREF (filename
, 0) == '~')
2300 filename
= Fexpand_file_name (filename
, Qnil
);
2302 if (!NILP (Ffile_directory_p (linkname
)))
2303 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2305 linkname
= Fexpand_file_name (linkname
, Qnil
);
2307 /* If the file name has special constructs in it,
2308 call the corresponding file handler. */
2309 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2310 if (!NILP (handler
))
2311 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2312 linkname
, ok_if_already_exists
));
2314 /* If the new link name has special constructs in it,
2315 call the corresponding file handler. */
2316 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2317 if (!NILP (handler
))
2318 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2319 linkname
, ok_if_already_exists
));
2321 encoded_filename
= ENCODE_FILE (filename
);
2322 encoded_linkname
= ENCODE_FILE (linkname
);
2324 if (NILP (ok_if_already_exists
)
2325 || INTEGERP (ok_if_already_exists
))
2326 barf_or_query_if_file_exists (linkname
, "make it a link",
2327 INTEGERP (ok_if_already_exists
), 0, 0);
2328 if (0 > symlink (SSDATA (encoded_filename
),
2329 SSDATA (encoded_linkname
)))
2331 /* If we didn't complain already, silently delete existing file. */
2332 if (errno
== EEXIST
)
2334 unlink (SSDATA (encoded_linkname
));
2335 if (0 <= symlink (SSDATA (encoded_filename
),
2336 SSDATA (encoded_linkname
)))
2342 if (errno
== ENOSYS
)
2345 xsignal1 (Qfile_error
,
2346 build_string ("Symbolic links are not supported"));
2349 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2356 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2358 doc
: /* Return t if file FILENAME specifies an absolute file name.
2359 On Unix, this is a name starting with a `/' or a `~'. */)
2360 (Lisp_Object filename
)
2362 CHECK_STRING (filename
);
2363 return file_name_absolute_p (SSDATA (filename
)) ? Qt
: Qnil
;
2366 /* Return nonzero if file FILENAME exists and can be executed. */
2369 check_executable (char *filename
)
2373 if (stat (filename
, &st
) < 0)
2375 return ((st
.st_mode
& S_IEXEC
) != 0);
2376 #else /* not DOS_NT */
2377 #ifdef HAVE_EUIDACCESS
2378 return (euidaccess (filename
, 1) >= 0);
2380 /* Access isn't quite right because it uses the real uid
2381 and we really want to test with the effective uid.
2382 But Unix doesn't give us a right way to do it. */
2383 return (access (filename
, 1) >= 0);
2385 #endif /* not DOS_NT */
2388 /* Return nonzero if file FILENAME exists and can be written. */
2391 check_writable (const char *filename
)
2395 if (stat (filename
, &st
) < 0)
2397 return (st
.st_mode
& S_IWRITE
|| S_ISDIR (st
.st_mode
));
2398 #else /* not MSDOS */
2399 #ifdef HAVE_EUIDACCESS
2400 return (euidaccess (filename
, 2) >= 0);
2402 /* Access isn't quite right because it uses the real uid
2403 and we really want to test with the effective uid.
2404 But Unix doesn't give us a right way to do it.
2405 Opening with O_WRONLY could work for an ordinary file,
2406 but would lose for directories. */
2407 return (access (filename
, 2) >= 0);
2409 #endif /* not MSDOS */
2412 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2413 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
2414 See also `file-readable-p' and `file-attributes'.
2415 This returns nil for a symlink to a nonexistent file.
2416 Use `file-symlink-p' to test for such links. */)
2417 (Lisp_Object filename
)
2419 Lisp_Object absname
;
2420 Lisp_Object handler
;
2421 struct stat statbuf
;
2423 CHECK_STRING (filename
);
2424 absname
= Fexpand_file_name (filename
, Qnil
);
2426 /* If the file name has special constructs in it,
2427 call the corresponding file handler. */
2428 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2429 if (!NILP (handler
))
2430 return call2 (handler
, Qfile_exists_p
, absname
);
2432 absname
= ENCODE_FILE (absname
);
2434 return (stat (SSDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
2437 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2438 doc
: /* Return t if FILENAME can be executed by you.
2439 For a directory, this means you can access files in that directory. */)
2440 (Lisp_Object filename
)
2442 Lisp_Object absname
;
2443 Lisp_Object handler
;
2445 CHECK_STRING (filename
);
2446 absname
= Fexpand_file_name (filename
, Qnil
);
2448 /* If the file name has special constructs in it,
2449 call the corresponding file handler. */
2450 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2451 if (!NILP (handler
))
2452 return call2 (handler
, Qfile_executable_p
, absname
);
2454 absname
= ENCODE_FILE (absname
);
2456 return (check_executable (SSDATA (absname
)) ? Qt
: Qnil
);
2459 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2460 doc
: /* Return t if file FILENAME exists and you can read it.
2461 See also `file-exists-p' and `file-attributes'. */)
2462 (Lisp_Object filename
)
2464 Lisp_Object absname
;
2465 Lisp_Object handler
;
2468 struct stat statbuf
;
2470 CHECK_STRING (filename
);
2471 absname
= Fexpand_file_name (filename
, Qnil
);
2473 /* If the file name has special constructs in it,
2474 call the corresponding file handler. */
2475 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2476 if (!NILP (handler
))
2477 return call2 (handler
, Qfile_readable_p
, absname
);
2479 absname
= ENCODE_FILE (absname
);
2481 #if defined(DOS_NT) || defined(macintosh)
2482 /* Under MS-DOS, Windows, and Macintosh, open does not work for
2484 if (access (SDATA (absname
), 0) == 0)
2487 #else /* not DOS_NT and not macintosh */
2490 /* Opening a fifo without O_NONBLOCK can wait.
2491 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2492 except in the case of a fifo, on a system which handles it. */
2493 desc
= stat (SSDATA (absname
), &statbuf
);
2496 if (S_ISFIFO (statbuf
.st_mode
))
2497 flags
|= O_NONBLOCK
;
2499 desc
= emacs_open (SSDATA (absname
), flags
, 0);
2504 #endif /* not DOS_NT and not macintosh */
2507 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2509 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2510 doc
: /* Return t if file FILENAME can be written or created by you. */)
2511 (Lisp_Object filename
)
2513 Lisp_Object absname
, dir
, encoded
;
2514 Lisp_Object handler
;
2515 struct stat statbuf
;
2517 CHECK_STRING (filename
);
2518 absname
= Fexpand_file_name (filename
, Qnil
);
2520 /* If the file name has special constructs in it,
2521 call the corresponding file handler. */
2522 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2523 if (!NILP (handler
))
2524 return call2 (handler
, Qfile_writable_p
, absname
);
2526 encoded
= ENCODE_FILE (absname
);
2527 if (stat (SSDATA (encoded
), &statbuf
) >= 0)
2528 return (check_writable (SSDATA (encoded
))
2531 dir
= Ffile_name_directory (absname
);
2534 dir
= Fdirectory_file_name (dir
);
2537 dir
= ENCODE_FILE (dir
);
2539 /* The read-only attribute of the parent directory doesn't affect
2540 whether a file or directory can be created within it. Some day we
2541 should check ACLs though, which do affect this. */
2542 if (stat (SDATA (dir
), &statbuf
) < 0)
2544 return S_ISDIR (statbuf
.st_mode
) ? Qt
: Qnil
;
2546 return (check_writable (!NILP (dir
) ? SSDATA (dir
) : "")
2551 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2552 doc
: /* Access file FILENAME, and get an error if that does not work.
2553 The second argument STRING is used in the error message.
2554 If there is no error, returns nil. */)
2555 (Lisp_Object filename
, Lisp_Object string
)
2557 Lisp_Object handler
, encoded_filename
, absname
;
2560 CHECK_STRING (filename
);
2561 absname
= Fexpand_file_name (filename
, Qnil
);
2563 CHECK_STRING (string
);
2565 /* If the file name has special constructs in it,
2566 call the corresponding file handler. */
2567 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
2568 if (!NILP (handler
))
2569 return call3 (handler
, Qaccess_file
, absname
, string
);
2571 encoded_filename
= ENCODE_FILE (absname
);
2573 fd
= emacs_open (SSDATA (encoded_filename
), O_RDONLY
, 0);
2575 report_file_error (SSDATA (string
), Fcons (filename
, Qnil
));
2581 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2582 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
2583 The value is the link target, as a string.
2584 Otherwise it returns nil.
2586 This function returns t when given the name of a symlink that
2587 points to a nonexistent file. */)
2588 (Lisp_Object filename
)
2590 Lisp_Object handler
;
2593 char readlink_buf
[READLINK_BUFSIZE
];
2595 CHECK_STRING (filename
);
2596 filename
= Fexpand_file_name (filename
, Qnil
);
2598 /* If the file name has special constructs in it,
2599 call the corresponding file handler. */
2600 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2601 if (!NILP (handler
))
2602 return call2 (handler
, Qfile_symlink_p
, filename
);
2604 filename
= ENCODE_FILE (filename
);
2606 buf
= emacs_readlink (SSDATA (filename
), readlink_buf
);
2610 val
= build_string (buf
);
2611 if (buf
[0] == '/' && strchr (buf
, ':'))
2612 val
= concat2 (build_string ("/:"), val
);
2613 if (buf
!= readlink_buf
)
2615 val
= DECODE_FILE (val
);
2619 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2620 doc
: /* Return t if FILENAME names an existing directory.
2621 Symbolic links to directories count as directories.
2622 See `file-symlink-p' to distinguish symlinks. */)
2623 (Lisp_Object filename
)
2625 register Lisp_Object absname
;
2627 Lisp_Object handler
;
2629 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2631 /* If the file name has special constructs in it,
2632 call the corresponding file handler. */
2633 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2634 if (!NILP (handler
))
2635 return call2 (handler
, Qfile_directory_p
, absname
);
2637 absname
= ENCODE_FILE (absname
);
2639 if (stat (SSDATA (absname
), &st
) < 0)
2641 return S_ISDIR (st
.st_mode
) ? Qt
: Qnil
;
2644 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
,
2645 Sfile_accessible_directory_p
, 1, 1, 0,
2646 doc
: /* Return t if file FILENAME names a directory you can open.
2647 For the value to be t, FILENAME must specify the name of a directory as a file,
2648 and the directory must allow you to open files in it. In order to use a
2649 directory as a buffer's current directory, this predicate must return true.
2650 A directory name spec may be given instead; then the value is t
2651 if the directory so specified exists and really is a readable and
2652 searchable directory. */)
2653 (Lisp_Object filename
)
2655 Lisp_Object handler
;
2657 struct gcpro gcpro1
;
2659 /* If the file name has special constructs in it,
2660 call the corresponding file handler. */
2661 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2662 if (!NILP (handler
))
2663 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2666 tem
= (NILP (Ffile_directory_p (filename
))
2667 || NILP (Ffile_executable_p (filename
)));
2669 return tem
? Qnil
: Qt
;
2672 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2673 doc
: /* Return t if FILENAME names a regular file.
2674 This is the sort of file that holds an ordinary stream of data bytes.
2675 Symbolic links to regular files count as regular files.
2676 See `file-symlink-p' to distinguish symlinks. */)
2677 (Lisp_Object filename
)
2679 register Lisp_Object absname
;
2681 Lisp_Object handler
;
2683 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2685 /* If the file name has special constructs in it,
2686 call the corresponding file handler. */
2687 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2688 if (!NILP (handler
))
2689 return call2 (handler
, Qfile_regular_p
, absname
);
2691 absname
= ENCODE_FILE (absname
);
2696 Lisp_Object tem
= Vw32_get_true_file_attributes
;
2698 /* Tell stat to use expensive method to get accurate info. */
2699 Vw32_get_true_file_attributes
= Qt
;
2700 result
= stat (SDATA (absname
), &st
);
2701 Vw32_get_true_file_attributes
= tem
;
2705 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2708 if (stat (SSDATA (absname
), &st
) < 0)
2710 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2714 DEFUN ("file-selinux-context", Ffile_selinux_context
,
2715 Sfile_selinux_context
, 1, 1, 0,
2716 doc
: /* Return SELinux context of file named FILENAME,
2717 as a list ("user", "role", "type", "range"). Return (nil, nil, nil, nil)
2718 if file does not exist, is not accessible, or SELinux is disabled */)
2719 (Lisp_Object filename
)
2721 Lisp_Object absname
;
2722 Lisp_Object values
[4];
2723 Lisp_Object handler
;
2725 security_context_t con
;
2730 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2732 /* If the file name has special constructs in it,
2733 call the corresponding file handler. */
2734 handler
= Ffind_file_name_handler (absname
, Qfile_selinux_context
);
2735 if (!NILP (handler
))
2736 return call2 (handler
, Qfile_selinux_context
, absname
);
2738 absname
= ENCODE_FILE (absname
);
2745 if (is_selinux_enabled ())
2747 conlength
= lgetfilecon (SSDATA (absname
), &con
);
2750 context
= context_new (con
);
2751 if (context_user_get (context
))
2752 values
[0] = build_string (context_user_get (context
));
2753 if (context_role_get (context
))
2754 values
[1] = build_string (context_role_get (context
));
2755 if (context_type_get (context
))
2756 values
[2] = build_string (context_type_get (context
));
2757 if (context_range_get (context
))
2758 values
[3] = build_string (context_range_get (context
));
2759 context_free (context
);
2766 return Flist (sizeof(values
) / sizeof(values
[0]), values
);
2769 DEFUN ("set-file-selinux-context", Fset_file_selinux_context
,
2770 Sset_file_selinux_context
, 2, 2, 0,
2771 doc
: /* Set SELinux context of file named FILENAME to CONTEXT
2772 as a list ("user", "role", "type", "range"). Has no effect if SELinux
2774 (Lisp_Object filename
, Lisp_Object context
)
2776 Lisp_Object absname
;
2777 Lisp_Object handler
;
2779 Lisp_Object encoded_absname
;
2780 Lisp_Object user
= CAR_SAFE (context
);
2781 Lisp_Object role
= CAR_SAFE (CDR_SAFE (context
));
2782 Lisp_Object type
= CAR_SAFE (CDR_SAFE (CDR_SAFE (context
)));
2783 Lisp_Object range
= CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context
))));
2784 security_context_t con
;
2785 int fail
, conlength
;
2786 context_t parsed_con
;
2789 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
2791 /* If the file name has special constructs in it,
2792 call the corresponding file handler. */
2793 handler
= Ffind_file_name_handler (absname
, Qset_file_selinux_context
);
2794 if (!NILP (handler
))
2795 return call3 (handler
, Qset_file_selinux_context
, absname
, context
);
2798 if (is_selinux_enabled ())
2800 /* Get current file context. */
2801 encoded_absname
= ENCODE_FILE (absname
);
2802 conlength
= lgetfilecon (SSDATA (encoded_absname
), &con
);
2805 parsed_con
= context_new (con
);
2806 /* Change the parts defined in the parameter.*/
2809 if (context_user_set (parsed_con
, SSDATA (user
)))
2810 error ("Doing context_user_set");
2814 if (context_role_set (parsed_con
, SSDATA (role
)))
2815 error ("Doing context_role_set");
2819 if (context_type_set (parsed_con
, SSDATA (type
)))
2820 error ("Doing context_type_set");
2822 if (STRINGP (range
))
2824 if (context_range_set (parsed_con
, SSDATA (range
)))
2825 error ("Doing context_range_set");
2828 /* Set the modified context back to the file. */
2829 fail
= lsetfilecon (SSDATA (encoded_absname
),
2830 context_str (parsed_con
));
2832 report_file_error ("Doing lsetfilecon", Fcons (absname
, Qnil
));
2834 context_free (parsed_con
);
2837 report_file_error("Doing lgetfilecon", Fcons (absname
, Qnil
));
2847 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2848 doc
: /* Return mode bits of file named FILENAME, as an integer.
2849 Return nil, if file does not exist or is not accessible. */)
2850 (Lisp_Object filename
)
2852 Lisp_Object absname
;
2854 Lisp_Object handler
;
2856 absname
= expand_and_dir_to_file (filename
, BVAR (current_buffer
, directory
));
2858 /* If the file name has special constructs in it,
2859 call the corresponding file handler. */
2860 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2861 if (!NILP (handler
))
2862 return call2 (handler
, Qfile_modes
, absname
);
2864 absname
= ENCODE_FILE (absname
);
2866 if (stat (SSDATA (absname
), &st
) < 0)
2869 return make_number (st
.st_mode
& 07777);
2872 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
2873 "(let ((file (read-file-name \"File: \"))) \
2874 (list file (read-file-modes nil file)))",
2875 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
2876 Only the 12 low bits of MODE are used.
2878 Interactively, mode bits are read by `read-file-modes', which accepts
2879 symbolic notation, like the `chmod' command from GNU Coreutils. */)
2880 (Lisp_Object filename
, Lisp_Object mode
)
2882 Lisp_Object absname
, encoded_absname
;
2883 Lisp_Object handler
;
2885 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
2886 CHECK_NUMBER (mode
);
2888 /* If the file name has special constructs in it,
2889 call the corresponding file handler. */
2890 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2891 if (!NILP (handler
))
2892 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2894 encoded_absname
= ENCODE_FILE (absname
);
2896 if (chmod (SSDATA (encoded_absname
), XINT (mode
)) < 0)
2897 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2902 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2903 doc
: /* Set the file permission bits for newly created files.
2904 The argument MODE should be an integer; only the low 9 bits are used.
2905 This setting is inherited by subprocesses. */)
2908 CHECK_NUMBER (mode
);
2910 umask ((~ XINT (mode
)) & 0777);
2915 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2916 doc
: /* Return the default file protection for created files.
2917 The value is an integer. */)
2923 realmask
= umask (0);
2926 XSETINT (value
, (~ realmask
) & 0777);
2931 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
2932 doc
: /* Set times of file FILENAME to TIMESTAMP.
2933 Set both access and modification times.
2934 Return t on success, else nil.
2935 Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
2937 (Lisp_Object filename
, Lisp_Object timestamp
)
2939 Lisp_Object absname
, encoded_absname
;
2940 Lisp_Object handler
;
2944 if (! lisp_time_argument (timestamp
, &sec
, &usec
))
2945 error ("Invalid time specification");
2947 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
2949 /* If the file name has special constructs in it,
2950 call the corresponding file handler. */
2951 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
2952 if (!NILP (handler
))
2953 return call3 (handler
, Qset_file_times
, absname
, timestamp
);
2955 encoded_absname
= ENCODE_FILE (absname
);
2960 EMACS_SET_SECS (t
, sec
);
2961 EMACS_SET_USECS (t
, usec
);
2963 if (set_file_times (SSDATA (encoded_absname
), t
, t
))
2968 /* Setting times on a directory always fails. */
2969 if (stat (SSDATA (encoded_absname
), &st
) == 0 && S_ISDIR (st
.st_mode
))
2972 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
2981 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2982 doc
: /* Tell Unix to finish all pending disk updates. */)
2989 #endif /* HAVE_SYNC */
2991 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2992 doc
: /* Return t if file FILE1 is newer than file FILE2.
2993 If FILE1 does not exist, the answer is nil;
2994 otherwise, if FILE2 does not exist, the answer is t. */)
2995 (Lisp_Object file1
, Lisp_Object file2
)
2997 Lisp_Object absname1
, absname2
;
3000 Lisp_Object handler
;
3001 struct gcpro gcpro1
, gcpro2
;
3003 CHECK_STRING (file1
);
3004 CHECK_STRING (file2
);
3007 GCPRO2 (absname1
, file2
);
3008 absname1
= expand_and_dir_to_file (file1
, BVAR (current_buffer
, directory
));
3009 absname2
= expand_and_dir_to_file (file2
, BVAR (current_buffer
, directory
));
3012 /* If the file name has special constructs in it,
3013 call the corresponding file handler. */
3014 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3016 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3017 if (!NILP (handler
))
3018 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3020 GCPRO2 (absname1
, absname2
);
3021 absname1
= ENCODE_FILE (absname1
);
3022 absname2
= ENCODE_FILE (absname2
);
3025 if (stat (SSDATA (absname1
), &st
) < 0)
3028 mtime1
= st
.st_mtime
;
3030 if (stat (SSDATA (absname2
), &st
) < 0)
3033 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3036 #ifndef READ_BUF_SIZE
3037 #define READ_BUF_SIZE (64 << 10)
3040 /* This function is called after Lisp functions to decide a coding
3041 system are called, or when they cause an error. Before they are
3042 called, the current buffer is set unibyte and it contains only a
3043 newly inserted text (thus the buffer was empty before the
3046 The functions may set markers, overlays, text properties, or even
3047 alter the buffer contents, change the current buffer.
3049 Here, we reset all those changes by:
3050 o set back the current buffer.
3051 o move all markers and overlays to BEG.
3052 o remove all text properties.
3053 o set back the buffer multibyteness. */
3056 decide_coding_unwind (Lisp_Object unwind_data
)
3058 Lisp_Object multibyte
, undo_list
, buffer
;
3060 multibyte
= XCAR (unwind_data
);
3061 unwind_data
= XCDR (unwind_data
);
3062 undo_list
= XCAR (unwind_data
);
3063 buffer
= XCDR (unwind_data
);
3065 if (current_buffer
!= XBUFFER (buffer
))
3066 set_buffer_internal (XBUFFER (buffer
));
3067 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3068 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3069 BUF_INTERVALS (current_buffer
) = 0;
3070 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3072 /* Now we are safe to change the buffer's multibyteness directly. */
3073 BVAR (current_buffer
, enable_multibyte_characters
) = multibyte
;
3074 BVAR (current_buffer
, undo_list
) = undo_list
;
3080 /* Used to pass values from insert-file-contents to read_non_regular. */
3082 static int non_regular_fd
;
3083 static EMACS_INT non_regular_inserted
;
3084 static EMACS_INT non_regular_nbytes
;
3087 /* Read from a non-regular file.
3088 Read non_regular_nbytes bytes max from non_regular_fd.
3089 Non_regular_inserted specifies where to put the read bytes.
3090 Value is the number of bytes read. */
3093 read_non_regular (Lisp_Object ignore
)
3099 nbytes
= emacs_read (non_regular_fd
,
3100 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
3101 + non_regular_inserted
),
3102 non_regular_nbytes
);
3104 return make_number (nbytes
);
3108 /* Condition-case handler used when reading from non-regular files
3109 in insert-file-contents. */
3112 read_non_regular_quit (Lisp_Object ignore
)
3117 /* Reposition FD to OFFSET, based on WHENCE. This acts like lseek
3118 except that it also tests for OFFSET being out of lseek's range. */
3120 emacs_lseek (int fd
, EMACS_INT offset
, int whence
)
3122 /* Use "&" rather than "&&" to suppress a bogus GCC warning; see
3123 <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43772>. */
3124 if (! ((TYPE_MINIMUM (off_t
) <= offset
) & (offset
<= TYPE_MAXIMUM (off_t
))))
3129 return lseek (fd
, offset
, whence
);
3133 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3135 doc
: /* Insert contents of file FILENAME after point.
3136 Returns list of absolute file name and number of characters inserted.
3137 If second argument VISIT is non-nil, the buffer's visited filename and
3138 last save file modtime are set, and it is marked unmodified. If
3139 visiting and the file does not exist, visiting is completed before the
3142 The optional third and fourth arguments BEG and END specify what portion
3143 of the file to insert. These arguments count bytes in the file, not
3144 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3146 If optional fifth argument REPLACE is non-nil, replace the current
3147 buffer contents (in the accessible portion) with the file contents.
3148 This is better than simply deleting and inserting the whole thing
3149 because (1) it preserves some marker positions and (2) it puts less data
3150 in the undo list. When REPLACE is non-nil, the second return value is
3151 the number of characters that replace previous buffer contents.
3153 This function does code conversion according to the value of
3154 `coding-system-for-read' or `file-coding-system-alist', and sets the
3155 variable `last-coding-system-used' to the coding system actually used. */)
3156 (Lisp_Object filename
, Lisp_Object visit
, Lisp_Object beg
, Lisp_Object end
, Lisp_Object replace
)
3160 EMACS_INT inserted
= 0;
3162 register EMACS_INT how_much
;
3163 register EMACS_INT unprocessed
;
3164 int count
= SPECPDL_INDEX ();
3165 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3166 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3168 EMACS_INT total
= 0;
3169 int not_regular
= 0;
3170 char read_buf
[READ_BUF_SIZE
];
3171 struct coding_system coding
;
3172 char buffer
[1 << 14];
3173 int replace_handled
= 0;
3174 int set_coding_system
= 0;
3175 Lisp_Object coding_system
;
3177 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3178 int we_locked_file
= 0;
3179 int deferred_remove_unwind_protect
= 0;
3181 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3182 error ("Cannot do file visiting in an indirect buffer");
3184 if (!NILP (BVAR (current_buffer
, read_only
)))
3185 Fbarf_if_buffer_read_only ();
3189 orig_filename
= Qnil
;
3192 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3194 CHECK_STRING (filename
);
3195 filename
= Fexpand_file_name (filename
, Qnil
);
3197 /* The value Qnil means that the coding system is not yet
3199 coding_system
= Qnil
;
3201 /* If the file name has special constructs in it,
3202 call the corresponding file handler. */
3203 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3204 if (!NILP (handler
))
3206 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3207 visit
, beg
, end
, replace
);
3208 if (CONSP (val
) && CONSP (XCDR (val
)))
3209 inserted
= XINT (XCAR (XCDR (val
)));
3213 orig_filename
= filename
;
3214 filename
= ENCODE_FILE (filename
);
3220 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3222 /* Tell stat to use expensive method to get accurate info. */
3223 Vw32_get_true_file_attributes
= Qt
;
3224 total
= stat (SSDATA (filename
), &st
);
3225 Vw32_get_true_file_attributes
= tem
;
3229 if (stat (SSDATA (filename
), &st
) < 0)
3230 #endif /* WINDOWSNT */
3234 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3237 if (!NILP (Vcoding_system_for_read
))
3238 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3242 /* This code will need to be changed in order to work on named
3243 pipes, and it's probably just not worth it. So we should at
3244 least signal an error. */
3245 if (!S_ISREG (st
.st_mode
))
3252 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3253 xsignal2 (Qfile_error
,
3254 build_string ("not a regular file"), orig_filename
);
3258 if ((fd
= emacs_open (SSDATA (filename
), O_RDONLY
, 0)) < 0)
3261 /* Replacement should preserve point as it preserves markers. */
3262 if (!NILP (replace
))
3263 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3265 record_unwind_protect (close_file_unwind
, make_number (fd
));
3268 /* Check whether the size is too large or negative, which can happen on a
3269 platform that allows file sizes greater than the maximum off_t value. */
3271 && ! (0 <= st
.st_size
&& st
.st_size
<= BUF_BYTES_MAX
))
3274 /* Prevent redisplay optimizations. */
3275 current_buffer
->clip_changed
= 1;
3279 if (!NILP (beg
) || !NILP (end
))
3280 error ("Attempt to visit less than an entire file");
3281 if (BEG
< Z
&& NILP (replace
))
3282 error ("Cannot do file visiting in a non-empty buffer");
3288 XSETFASTINT (beg
, 0);
3296 XSETINT (end
, st
.st_size
);
3298 /* The file size returned from stat may be zero, but data
3299 may be readable nonetheless, for example when this is a
3300 file in the /proc filesystem. */
3301 if (st
.st_size
== 0)
3302 XSETINT (end
, READ_BUF_SIZE
);
3306 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3308 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3309 setup_coding_system (coding_system
, &coding
);
3310 /* Ensure we set Vlast_coding_system_used. */
3311 set_coding_system
= 1;
3315 /* Decide the coding system to use for reading the file now
3316 because we can't use an optimized method for handling
3317 `coding:' tag if the current buffer is not empty. */
3318 if (!NILP (Vcoding_system_for_read
))
3319 coding_system
= Vcoding_system_for_read
;
3322 /* Don't try looking inside a file for a coding system
3323 specification if it is not seekable. */
3324 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3326 /* Find a coding system specified in the heading two
3327 lines or in the tailing several lines of the file.
3328 We assume that the 1K-byte and 3K-byte for heading
3329 and tailing respectively are sufficient for this
3333 if (st
.st_size
<= (1024 * 4))
3334 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3337 nread
= emacs_read (fd
, read_buf
, 1024);
3340 if (lseek (fd
, st
.st_size
- (1024 * 3), SEEK_SET
) < 0)
3341 report_file_error ("Setting file position",
3342 Fcons (orig_filename
, Qnil
));
3343 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3348 error ("IO error reading %s: %s",
3349 SDATA (orig_filename
), emacs_strerror (errno
));
3352 struct buffer
*prev
= current_buffer
;
3353 Lisp_Object workbuf
;
3356 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3358 workbuf
= Fget_buffer_create (build_string (" *code-converting-work*"));
3359 buf
= XBUFFER (workbuf
);
3361 delete_all_overlays (buf
);
3362 BVAR (buf
, directory
) = BVAR (current_buffer
, directory
);
3363 BVAR (buf
, read_only
) = Qnil
;
3364 BVAR (buf
, filename
) = Qnil
;
3365 BVAR (buf
, undo_list
) = Qt
;
3366 eassert (buf
->overlays_before
== NULL
);
3367 eassert (buf
->overlays_after
== NULL
);
3369 set_buffer_internal (buf
);
3371 BVAR (buf
, enable_multibyte_characters
) = Qnil
;
3373 insert_1_both ((char *) read_buf
, nread
, nread
, 0, 0, 0);
3374 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3375 coding_system
= call2 (Vset_auto_coding_function
,
3376 filename
, make_number (nread
));
3377 set_buffer_internal (prev
);
3379 /* Discard the unwind protect for recovering the
3383 /* Rewind the file for the actual read done later. */
3384 if (lseek (fd
, 0, SEEK_SET
) < 0)
3385 report_file_error ("Setting file position",
3386 Fcons (orig_filename
, Qnil
));
3390 if (NILP (coding_system
))
3392 /* If we have not yet decided a coding system, check
3393 file-coding-system-alist. */
3394 Lisp_Object args
[6];
3396 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3397 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3398 coding_system
= Ffind_operation_coding_system (6, args
);
3399 if (CONSP (coding_system
))
3400 coding_system
= XCAR (coding_system
);
3404 if (NILP (coding_system
))
3405 coding_system
= Qundecided
;
3407 CHECK_CODING_SYSTEM (coding_system
);
3409 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3410 /* We must suppress all character code conversion except for
3411 end-of-line conversion. */
3412 coding_system
= raw_text_coding_system (coding_system
);
3414 setup_coding_system (coding_system
, &coding
);
3415 /* Ensure we set Vlast_coding_system_used. */
3416 set_coding_system
= 1;
3419 /* If requested, replace the accessible part of the buffer
3420 with the file contents. Avoid replacing text at the
3421 beginning or end of the buffer that matches the file contents;
3422 that preserves markers pointing to the unchanged parts.
3424 Here we implement this feature in an optimized way
3425 for the case where code conversion is NOT needed.
3426 The following if-statement handles the case of conversion
3427 in a less optimal way.
3429 If the code conversion is "automatic" then we try using this
3430 method and hope for the best.
3431 But if we discover the need for conversion, we give up on this method
3432 and let the following if-statement handle the replace job. */
3435 && (NILP (coding_system
)
3436 || ! CODING_REQUIRE_DECODING (&coding
)))
3438 /* same_at_start and same_at_end count bytes,
3439 because file access counts bytes
3440 and BEG and END count bytes. */
3441 EMACS_INT same_at_start
= BEGV_BYTE
;
3442 EMACS_INT same_at_end
= ZV_BYTE
;
3444 /* There is still a possibility we will find the need to do code
3445 conversion. If that happens, we set this variable to 1 to
3446 give up on handling REPLACE in the optimized way. */
3447 int giveup_match_end
= 0;
3449 if (XINT (beg
) != 0)
3451 if (emacs_lseek (fd
, XINT (beg
), SEEK_SET
) < 0)
3452 report_file_error ("Setting file position",
3453 Fcons (orig_filename
, Qnil
));
3458 /* Count how many chars at the start of the file
3459 match the text at the beginning of the buffer. */
3462 EMACS_INT nread
, bufpos
;
3464 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3466 error ("IO error reading %s: %s",
3467 SSDATA (orig_filename
), emacs_strerror (errno
));
3468 else if (nread
== 0)
3471 if (CODING_REQUIRE_DETECTION (&coding
))
3473 coding_system
= detect_coding_system ((unsigned char *) buffer
,
3476 setup_coding_system (coding_system
, &coding
);
3479 if (CODING_REQUIRE_DECODING (&coding
))
3480 /* We found that the file should be decoded somehow.
3481 Let's give up here. */
3483 giveup_match_end
= 1;
3488 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3489 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3490 same_at_start
++, bufpos
++;
3491 /* If we found a discrepancy, stop the scan.
3492 Otherwise loop around and scan the next bufferful. */
3493 if (bufpos
!= nread
)
3497 /* If the file matches the buffer completely,
3498 there's no need to replace anything. */
3499 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3503 /* Truncate the buffer to the size of the file. */
3504 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3509 /* Count how many chars at the end of the file
3510 match the text at the end of the buffer. But, if we have
3511 already found that decoding is necessary, don't waste time. */
3512 while (!giveup_match_end
)
3514 EMACS_INT total_read
, nread
, bufpos
, curpos
, trial
;
3516 /* At what file position are we now scanning? */
3517 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3518 /* If the entire file matches the buffer tail, stop the scan. */
3521 /* How much can we scan in the next step? */
3522 trial
= min (curpos
, sizeof buffer
);
3523 if (emacs_lseek (fd
, curpos
- trial
, SEEK_SET
) < 0)
3524 report_file_error ("Setting file position",
3525 Fcons (orig_filename
, Qnil
));
3527 total_read
= nread
= 0;
3528 while (total_read
< trial
)
3530 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3532 error ("IO error reading %s: %s",
3533 SDATA (orig_filename
), emacs_strerror (errno
));
3534 else if (nread
== 0)
3536 total_read
+= nread
;
3539 /* Scan this bufferful from the end, comparing with
3540 the Emacs buffer. */
3541 bufpos
= total_read
;
3543 /* Compare with same_at_start to avoid counting some buffer text
3544 as matching both at the file's beginning and at the end. */
3545 while (bufpos
> 0 && same_at_end
> same_at_start
3546 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3547 same_at_end
--, bufpos
--;
3549 /* If we found a discrepancy, stop the scan.
3550 Otherwise loop around and scan the preceding bufferful. */
3553 /* If this discrepancy is because of code conversion,
3554 we cannot use this method; giveup and try the other. */
3555 if (same_at_end
> same_at_start
3556 && FETCH_BYTE (same_at_end
- 1) >= 0200
3557 && ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3558 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3559 giveup_match_end
= 1;
3568 if (! giveup_match_end
)
3572 /* We win! We can handle REPLACE the optimized way. */
3574 /* Extend the start of non-matching text area to multibyte
3575 character boundary. */
3576 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3577 while (same_at_start
> BEGV_BYTE
3578 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3581 /* Extend the end of non-matching text area to multibyte
3582 character boundary. */
3583 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3584 while (same_at_end
< ZV_BYTE
3585 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3588 /* Don't try to reuse the same piece of text twice. */
3589 overlap
= (same_at_start
- BEGV_BYTE
3590 - (same_at_end
+ st
.st_size
- ZV
));
3592 same_at_end
+= overlap
;
3594 /* Arrange to read only the nonmatching middle part of the file. */
3595 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3596 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3598 del_range_byte (same_at_start
, same_at_end
, 0);
3599 /* Insert from the file at the proper position. */
3600 temp
= BYTE_TO_CHAR (same_at_start
);
3601 SET_PT_BOTH (temp
, same_at_start
);
3603 /* If display currently starts at beginning of line,
3604 keep it that way. */
3605 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3606 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3608 replace_handled
= 1;
3612 /* If requested, replace the accessible part of the buffer
3613 with the file contents. Avoid replacing text at the
3614 beginning or end of the buffer that matches the file contents;
3615 that preserves markers pointing to the unchanged parts.
3617 Here we implement this feature for the case where code conversion
3618 is needed, in a simple way that needs a lot of memory.
3619 The preceding if-statement handles the case of no conversion
3620 in a more optimized way. */
3621 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3623 EMACS_INT same_at_start
= BEGV_BYTE
;
3624 EMACS_INT same_at_end
= ZV_BYTE
;
3625 EMACS_INT same_at_start_charpos
;
3626 EMACS_INT inserted_chars
;
3629 unsigned char *decoded
;
3632 int this_count
= SPECPDL_INDEX ();
3633 int multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
3634 Lisp_Object conversion_buffer
;
3636 conversion_buffer
= code_conversion_save (1, multibyte
);
3638 /* First read the whole file, performing code conversion into
3639 CONVERSION_BUFFER. */
3641 if (emacs_lseek (fd
, XINT (beg
), SEEK_SET
) < 0)
3642 report_file_error ("Setting file position",
3643 Fcons (orig_filename
, Qnil
));
3645 total
= st
.st_size
; /* Total bytes in the file. */
3646 how_much
= 0; /* Bytes read from file so far. */
3647 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3648 unprocessed
= 0; /* Bytes not processed in previous loop. */
3650 GCPRO1 (conversion_buffer
);
3651 while (how_much
< total
)
3653 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
3654 quitting while reading a huge while. */
3655 /* try is reserved in some compilers (Microsoft C) */
3656 EMACS_INT trytry
= min (total
- how_much
,
3657 READ_BUF_SIZE
- unprocessed
);
3659 /* Allow quitting out of the actual I/O. */
3662 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
3670 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
3671 BUF_Z (XBUFFER (conversion_buffer
)));
3672 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3673 unprocessed
+ this, conversion_buffer
);
3674 unprocessed
= coding
.carryover_bytes
;
3675 if (coding
.carryover_bytes
> 0)
3676 memcpy (read_buf
, coding
.carryover
, unprocessed
);
3681 /* We should remove the unwind_protect calling
3682 close_file_unwind, but other stuff has been added the stack,
3683 so defer the removal till we reach the `handled' label. */
3684 deferred_remove_unwind_protect
= 1;
3686 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
3687 if we couldn't read the file. */
3690 error ("IO error reading %s: %s",
3691 SDATA (orig_filename
), emacs_strerror (errno
));
3693 if (unprocessed
> 0)
3695 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3696 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3697 unprocessed
, conversion_buffer
);
3698 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
3701 coding_system
= CODING_ID_NAME (coding
.id
);
3702 set_coding_system
= 1;
3703 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
3704 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
3705 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3707 /* Compare the beginning of the converted string with the buffer
3711 while (bufpos
< inserted
&& same_at_start
< same_at_end
3712 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
3713 same_at_start
++, bufpos
++;
3715 /* If the file matches the head of buffer completely,
3716 there's no need to replace anything. */
3718 if (bufpos
== inserted
)
3720 /* Truncate the buffer to the size of the file. */
3721 if (same_at_start
== same_at_end
)
3724 del_range_byte (same_at_start
, same_at_end
, 0);
3727 unbind_to (this_count
, Qnil
);
3731 /* Extend the start of non-matching text area to the previous
3732 multibyte character boundary. */
3733 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3734 while (same_at_start
> BEGV_BYTE
3735 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3738 /* Scan this bufferful from the end, comparing with
3739 the Emacs buffer. */
3742 /* Compare with same_at_start to avoid counting some buffer text
3743 as matching both at the file's beginning and at the end. */
3744 while (bufpos
> 0 && same_at_end
> same_at_start
3745 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
3746 same_at_end
--, bufpos
--;
3748 /* Extend the end of non-matching text area to the next
3749 multibyte character boundary. */
3750 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3751 while (same_at_end
< ZV_BYTE
3752 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3755 /* Don't try to reuse the same piece of text twice. */
3756 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3758 same_at_end
+= overlap
;
3760 /* If display currently starts at beginning of line,
3761 keep it that way. */
3762 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3763 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3765 /* Replace the chars that we need to replace,
3766 and update INSERTED to equal the number of bytes
3767 we are taking from the decoded string. */
3768 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
3770 if (same_at_end
!= same_at_start
)
3772 del_range_byte (same_at_start
, same_at_end
, 0);
3774 same_at_start
= GPT_BYTE
;
3778 temp
= BYTE_TO_CHAR (same_at_start
);
3780 /* Insert from the file at the proper position. */
3781 SET_PT_BOTH (temp
, same_at_start
);
3782 same_at_start_charpos
3783 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3784 same_at_start
- BEGV_BYTE
3785 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3787 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3788 same_at_start
+ inserted
- BEGV_BYTE
3789 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
3790 - same_at_start_charpos
);
3791 /* This binding is to avoid ask-user-about-supersession-threat
3792 being called in insert_from_buffer (via in
3793 prepare_to_modify_buffer). */
3794 specbind (intern ("buffer-file-name"), Qnil
);
3795 insert_from_buffer (XBUFFER (conversion_buffer
),
3796 same_at_start_charpos
, inserted_chars
, 0);
3797 /* Set `inserted' to the number of inserted characters. */
3798 inserted
= PT
- temp
;
3799 /* Set point before the inserted characters. */
3800 SET_PT_BOTH (temp
, same_at_start
);
3802 unbind_to (this_count
, Qnil
);
3808 total
= XINT (end
) - XINT (beg
);
3810 /* For a special file, all we can do is guess. */
3811 total
= READ_BUF_SIZE
;
3813 if (NILP (visit
) && total
> 0)
3815 #ifdef CLASH_DETECTION
3816 if (!NILP (BVAR (current_buffer
, file_truename
))
3817 /* Make binding buffer-file-name to nil effective. */
3818 && !NILP (BVAR (current_buffer
, filename
))
3819 && SAVE_MODIFF
>= MODIFF
)
3821 #endif /* CLASH_DETECTION */
3822 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
3826 if (GAP_SIZE
< total
)
3827 make_gap (total
- GAP_SIZE
);
3829 if (XINT (beg
) != 0 || !NILP (replace
))
3831 if (emacs_lseek (fd
, XINT (beg
), SEEK_SET
) < 0)
3832 report_file_error ("Setting file position",
3833 Fcons (orig_filename
, Qnil
));
3836 /* In the following loop, HOW_MUCH contains the total bytes read so
3837 far for a regular file, and not changed for a special file. But,
3838 before exiting the loop, it is set to a negative value if I/O
3842 /* Total bytes inserted. */
3845 /* Here, we don't do code conversion in the loop. It is done by
3846 decode_coding_gap after all data are read into the buffer. */
3848 EMACS_INT gap_size
= GAP_SIZE
;
3850 while (how_much
< total
)
3852 /* try is reserved in some compilers (Microsoft C) */
3853 EMACS_INT trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3860 /* Maybe make more room. */
3861 if (gap_size
< trytry
)
3863 make_gap (total
- gap_size
);
3864 gap_size
= GAP_SIZE
;
3867 /* Read from the file, capturing `quit'. When an
3868 error occurs, end the loop, and arrange for a quit
3869 to be signaled after decoding the text we read. */
3870 non_regular_fd
= fd
;
3871 non_regular_inserted
= inserted
;
3872 non_regular_nbytes
= trytry
;
3873 nbytes
= internal_condition_case_1 (read_non_regular
,
3875 read_non_regular_quit
);
3882 this = XINT (nbytes
);
3886 /* Allow quitting out of the actual I/O. We don't make text
3887 part of the buffer until all the reading is done, so a C-g
3888 here doesn't do any harm. */
3891 this = emacs_read (fd
,
3892 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
3906 /* For a regular file, where TOTAL is the real size,
3907 count HOW_MUCH to compare with it.
3908 For a special file, where TOTAL is just a buffer size,
3909 so don't bother counting in HOW_MUCH.
3910 (INSERTED is where we count the number of characters inserted.) */
3917 /* Now we have read all the file data into the gap.
3918 If it was empty, undo marking the buffer modified. */
3922 #ifdef CLASH_DETECTION
3924 unlock_file (BVAR (current_buffer
, file_truename
));
3926 Vdeactivate_mark
= old_Vdeactivate_mark
;
3929 Vdeactivate_mark
= Qt
;
3931 /* Make the text read part of the buffer. */
3932 GAP_SIZE
-= inserted
;
3934 GPT_BYTE
+= inserted
;
3936 ZV_BYTE
+= inserted
;
3941 /* Put an anchor to ensure multi-byte form ends at gap. */
3946 /* Discard the unwind protect for closing the file. */
3950 error ("IO error reading %s: %s",
3951 SDATA (orig_filename
), emacs_strerror (errno
));
3955 if (NILP (coding_system
))
3957 /* The coding system is not yet decided. Decide it by an
3958 optimized method for handling `coding:' tag.
3960 Note that we can get here only if the buffer was empty
3961 before the insertion. */
3963 if (!NILP (Vcoding_system_for_read
))
3964 coding_system
= Vcoding_system_for_read
;
3967 /* Since we are sure that the current buffer was empty
3968 before the insertion, we can toggle
3969 enable-multibyte-characters directly here without taking
3970 care of marker adjustment. By this way, we can run Lisp
3971 program safely before decoding the inserted text. */
3972 Lisp_Object unwind_data
;
3973 int count1
= SPECPDL_INDEX ();
3975 unwind_data
= Fcons (BVAR (current_buffer
, enable_multibyte_characters
),
3976 Fcons (BVAR (current_buffer
, undo_list
),
3977 Fcurrent_buffer ()));
3978 BVAR (current_buffer
, enable_multibyte_characters
) = Qnil
;
3979 BVAR (current_buffer
, undo_list
) = Qt
;
3980 record_unwind_protect (decide_coding_unwind
, unwind_data
);
3982 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
3984 coding_system
= call2 (Vset_auto_coding_function
,
3985 filename
, make_number (inserted
));
3988 if (NILP (coding_system
))
3990 /* If the coding system is not yet decided, check
3991 file-coding-system-alist. */
3992 Lisp_Object args
[6];
3994 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3995 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
3996 coding_system
= Ffind_operation_coding_system (6, args
);
3997 if (CONSP (coding_system
))
3998 coding_system
= XCAR (coding_system
);
4000 unbind_to (count1
, Qnil
);
4001 inserted
= Z_BYTE
- BEG_BYTE
;
4004 if (NILP (coding_system
))
4005 coding_system
= Qundecided
;
4007 CHECK_CODING_SYSTEM (coding_system
);
4009 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4010 /* We must suppress all character code conversion except for
4011 end-of-line conversion. */
4012 coding_system
= raw_text_coding_system (coding_system
);
4013 setup_coding_system (coding_system
, &coding
);
4014 /* Ensure we set Vlast_coding_system_used. */
4015 set_coding_system
= 1;
4020 /* When we visit a file by raw-text, we change the buffer to
4022 if (CODING_FOR_UNIBYTE (&coding
)
4023 /* Can't do this if part of the buffer might be preserved. */
4025 /* Visiting a file with these coding system makes the buffer
4027 BVAR (current_buffer
, enable_multibyte_characters
) = Qnil
;
4030 coding
.dst_multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
4031 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4032 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4034 move_gap_both (PT
, PT_BYTE
);
4035 GAP_SIZE
+= inserted
;
4036 ZV_BYTE
-= inserted
;
4040 decode_coding_gap (&coding
, inserted
, inserted
);
4041 inserted
= coding
.produced_char
;
4042 coding_system
= CODING_ID_NAME (coding
.id
);
4044 else if (inserted
> 0)
4045 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4048 /* Now INSERTED is measured in characters. */
4052 if (deferred_remove_unwind_protect
)
4053 /* If requested above, discard the unwind protect for closing the
4059 if (!EQ (BVAR (current_buffer
, undo_list
), Qt
) && !nochange
)
4060 BVAR (current_buffer
, undo_list
) = Qnil
;
4064 current_buffer
->modtime
= st
.st_mtime
;
4065 current_buffer
->modtime_size
= st
.st_size
;
4066 BVAR (current_buffer
, filename
) = orig_filename
;
4069 SAVE_MODIFF
= MODIFF
;
4070 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
4071 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4072 #ifdef CLASH_DETECTION
4075 if (!NILP (BVAR (current_buffer
, file_truename
)))
4076 unlock_file (BVAR (current_buffer
, file_truename
));
4077 unlock_file (filename
);
4079 #endif /* CLASH_DETECTION */
4081 xsignal2 (Qfile_error
,
4082 build_string ("not a regular file"), orig_filename
);
4085 if (set_coding_system
)
4086 Vlast_coding_system_used
= coding_system
;
4088 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4090 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4092 if (! NILP (insval
))
4094 CHECK_NUMBER (insval
);
4095 inserted
= XFASTINT (insval
);
4099 /* Decode file format. */
4102 /* Don't run point motion or modification hooks when decoding. */
4103 int count1
= SPECPDL_INDEX ();
4104 EMACS_INT old_inserted
= inserted
;
4105 specbind (Qinhibit_point_motion_hooks
, Qt
);
4106 specbind (Qinhibit_modification_hooks
, Qt
);
4108 /* Save old undo list and don't record undo for decoding. */
4109 old_undo
= BVAR (current_buffer
, undo_list
);
4110 BVAR (current_buffer
, undo_list
) = Qt
;
4114 insval
= call3 (Qformat_decode
,
4115 Qnil
, make_number (inserted
), visit
);
4116 CHECK_NUMBER (insval
);
4117 inserted
= XFASTINT (insval
);
4121 /* If REPLACE is non-nil and we succeeded in not replacing the
4122 beginning or end of the buffer text with the file's contents,
4123 call format-decode with `point' positioned at the beginning
4124 of the buffer and `inserted' equalling the number of
4125 characters in the buffer. Otherwise, format-decode might
4126 fail to correctly analyze the beginning or end of the buffer.
4127 Hence we temporarily save `point' and `inserted' here and
4128 restore `point' iff format-decode did not insert or delete
4129 any text. Otherwise we leave `point' at point-min. */
4130 EMACS_INT opoint
= PT
;
4131 EMACS_INT opoint_byte
= PT_BYTE
;
4132 EMACS_INT oinserted
= ZV
- BEGV
;
4133 int ochars_modiff
= CHARS_MODIFF
;
4135 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4136 insval
= call3 (Qformat_decode
,
4137 Qnil
, make_number (oinserted
), visit
);
4138 CHECK_NUMBER (insval
);
4139 if (ochars_modiff
== CHARS_MODIFF
)
4140 /* format_decode didn't modify buffer's characters => move
4141 point back to position before inserted text and leave
4142 value of inserted alone. */
4143 SET_PT_BOTH (opoint
, opoint_byte
);
4145 /* format_decode modified buffer's characters => consider
4146 entire buffer changed and leave point at point-min. */
4147 inserted
= XFASTINT (insval
);
4150 /* For consistency with format-decode call these now iff inserted > 0
4151 (martin 2007-06-28). */
4152 p
= Vafter_insert_file_functions
;
4157 insval
= call1 (XCAR (p
), make_number (inserted
));
4160 CHECK_NUMBER (insval
);
4161 inserted
= XFASTINT (insval
);
4166 /* For the rationale of this see the comment on
4167 format-decode above. */
4168 EMACS_INT opoint
= PT
;
4169 EMACS_INT opoint_byte
= PT_BYTE
;
4170 EMACS_INT oinserted
= ZV
- BEGV
;
4171 int ochars_modiff
= CHARS_MODIFF
;
4173 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4174 insval
= call1 (XCAR (p
), make_number (oinserted
));
4177 CHECK_NUMBER (insval
);
4178 if (ochars_modiff
== CHARS_MODIFF
)
4179 /* after_insert_file_functions didn't modify
4180 buffer's characters => move point back to
4181 position before inserted text and leave value of
4183 SET_PT_BOTH (opoint
, opoint_byte
);
4185 /* after_insert_file_functions did modify buffer's
4186 characters => consider entire buffer changed and
4187 leave point at point-min. */
4188 inserted
= XFASTINT (insval
);
4198 BVAR (current_buffer
, undo_list
) = old_undo
;
4199 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4201 /* Adjust the last undo record for the size change during
4202 the format conversion. */
4203 Lisp_Object tem
= XCAR (old_undo
);
4204 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4205 && INTEGERP (XCDR (tem
))
4206 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4207 XSETCDR (tem
, make_number (PT
+ inserted
));
4211 /* If undo_list was Qt before, keep it that way.
4212 Otherwise start with an empty undo_list. */
4213 BVAR (current_buffer
, undo_list
) = EQ (old_undo
, Qt
) ? Qt
: Qnil
;
4215 unbind_to (count1
, Qnil
);
4218 /* Call after-change hooks for the inserted text, aside from the case
4219 of normal visiting (not with REPLACE), which is done in a new buffer
4220 "before" the buffer is changed. */
4221 if (inserted
> 0 && total
> 0
4222 && (NILP (visit
) || !NILP (replace
)))
4224 signal_after_change (PT
, 0, inserted
);
4225 update_compositions (PT
, PT
, CHECK_BORDER
);
4229 && current_buffer
->modtime
== -1)
4231 /* If visiting nonexistent file, return nil. */
4232 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4236 Fsignal (Qquit
, Qnil
);
4238 /* ??? Retval needs to be dealt with in all cases consistently. */
4240 val
= Fcons (orig_filename
,
4241 Fcons (make_number (inserted
),
4244 RETURN_UNGCPRO (unbind_to (count
, val
));
4247 static Lisp_Object
build_annotations (Lisp_Object
, Lisp_Object
);
4250 build_annotations_unwind (Lisp_Object arg
)
4252 Vwrite_region_annotation_buffers
= arg
;
4256 /* Decide the coding-system to encode the data with. */
4259 choose_write_coding_system (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4260 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
,
4261 struct coding_system
*coding
)
4264 Lisp_Object eol_parent
= Qnil
;
4267 && NILP (Fstring_equal (BVAR (current_buffer
, filename
),
4268 BVAR (current_buffer
, auto_save_file_name
))))
4273 else if (!NILP (Vcoding_system_for_write
))
4275 val
= Vcoding_system_for_write
;
4276 if (coding_system_require_warning
4277 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4278 /* Confirm that VAL can surely encode the current region. */
4279 val
= call5 (Vselect_safe_coding_system_function
,
4280 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4285 /* If the variable `buffer-file-coding-system' is set locally,
4286 it means that the file was read with some kind of code
4287 conversion or the variable is explicitly set by users. We
4288 had better write it out with the same coding system even if
4289 `enable-multibyte-characters' is nil.
4291 If it is not set locally, we anyway have to convert EOL
4292 format if the default value of `buffer-file-coding-system'
4293 tells that it is not Unix-like (LF only) format. */
4294 int using_default_coding
= 0;
4295 int force_raw_text
= 0;
4297 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4299 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4302 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4308 /* Check file-coding-system-alist. */
4309 Lisp_Object args
[7], coding_systems
;
4311 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4312 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4314 coding_systems
= Ffind_operation_coding_system (7, args
);
4315 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4316 val
= XCDR (coding_systems
);
4321 /* If we still have not decided a coding system, use the
4322 default value of buffer-file-coding-system. */
4323 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4324 using_default_coding
= 1;
4327 if (! NILP (val
) && ! force_raw_text
)
4329 Lisp_Object spec
, attrs
;
4331 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4332 attrs
= AREF (spec
, 0);
4333 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4338 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4339 /* Confirm that VAL can surely encode the current region. */
4340 val
= call5 (Vselect_safe_coding_system_function
,
4341 start
, end
, val
, Qnil
, filename
);
4343 /* If the decided coding-system doesn't specify end-of-line
4344 format, we use that of
4345 `default-buffer-file-coding-system'. */
4346 if (! using_default_coding
4347 && ! NILP (BVAR (&buffer_defaults
, buffer_file_coding_system
)))
4348 val
= (coding_inherit_eol_type
4349 (val
, BVAR (&buffer_defaults
, buffer_file_coding_system
)));
4351 /* If we decide not to encode text, use `raw-text' or one of its
4354 val
= raw_text_coding_system (val
);
4357 val
= coding_inherit_eol_type (val
, eol_parent
);
4358 setup_coding_system (val
, coding
);
4360 if (!STRINGP (start
) && !NILP (BVAR (current_buffer
, selective_display
)))
4361 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4365 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4366 "r\nFWrite region to file: \ni\ni\ni\np",
4367 doc
: /* Write current region into specified file.
4368 When called from a program, requires three arguments:
4369 START, END and FILENAME. START and END are normally buffer positions
4370 specifying the part of the buffer to write.
4371 If START is nil, that means to use the entire buffer contents.
4372 If START is a string, then output that string to the file
4373 instead of any buffer contents; END is ignored.
4375 Optional fourth argument APPEND if non-nil means
4376 append to existing file contents (if any). If it is an integer,
4377 seek to that offset in the file before writing.
4378 Optional fifth argument VISIT, if t or a string, means
4379 set the last-save-file-modtime of buffer to this file's modtime
4380 and mark buffer not modified.
4381 If VISIT is a string, it is a second file name;
4382 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4383 VISIT is also the file name to lock and unlock for clash detection.
4384 If VISIT is neither t nor nil nor a string,
4385 that means do not display the \"Wrote file\" message.
4386 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4387 use for locking and unlocking, overriding FILENAME and VISIT.
4388 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4389 for an existing file with the same name. If MUSTBENEW is `excl',
4390 that means to get an error if the file already exists; never overwrite.
4391 If MUSTBENEW is neither nil nor `excl', that means ask for
4392 confirmation before overwriting, but do go ahead and overwrite the file
4393 if the user confirms.
4395 This does code conversion according to the value of
4396 `coding-system-for-write', `buffer-file-coding-system', or
4397 `file-coding-system-alist', and sets the variable
4398 `last-coding-system-used' to the coding system actually used.
4400 This calls `write-region-annotate-functions' at the start, and
4401 `write-region-post-annotation-function' at the end. */)
4402 (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
, Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
, Lisp_Object mustbenew
)
4409 int count
= SPECPDL_INDEX ();
4411 Lisp_Object handler
;
4412 Lisp_Object visit_file
;
4413 Lisp_Object annotations
;
4414 Lisp_Object encoded_filename
;
4415 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4416 int quietly
= !NILP (visit
);
4417 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4418 struct buffer
*given_buffer
;
4419 struct coding_system coding
;
4421 if (current_buffer
->base_buffer
&& visiting
)
4422 error ("Cannot do file visiting in an indirect buffer");
4424 if (!NILP (start
) && !STRINGP (start
))
4425 validate_region (&start
, &end
);
4428 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4430 filename
= Fexpand_file_name (filename
, Qnil
);
4432 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4433 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4435 if (STRINGP (visit
))
4436 visit_file
= Fexpand_file_name (visit
, Qnil
);
4438 visit_file
= filename
;
4440 if (NILP (lockname
))
4441 lockname
= visit_file
;
4445 /* If the file name has special constructs in it,
4446 call the corresponding file handler. */
4447 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4448 /* If FILENAME has no handler, see if VISIT has one. */
4449 if (NILP (handler
) && STRINGP (visit
))
4450 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4452 if (!NILP (handler
))
4455 val
= call6 (handler
, Qwrite_region
, start
, end
,
4456 filename
, append
, visit
);
4460 SAVE_MODIFF
= MODIFF
;
4461 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4462 BVAR (current_buffer
, filename
) = visit_file
;
4468 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4470 /* Special kludge to simplify auto-saving. */
4473 /* Do it later, so write-region-annotate-function can work differently
4474 if we save "the buffer" vs "a region".
4475 This is useful in tar-mode. --Stef
4476 XSETFASTINT (start, BEG);
4477 XSETFASTINT (end, Z); */
4481 record_unwind_protect (build_annotations_unwind
,
4482 Vwrite_region_annotation_buffers
);
4483 Vwrite_region_annotation_buffers
= Fcons (Fcurrent_buffer (), Qnil
);
4484 count1
= SPECPDL_INDEX ();
4486 given_buffer
= current_buffer
;
4488 if (!STRINGP (start
))
4490 annotations
= build_annotations (start
, end
);
4492 if (current_buffer
!= given_buffer
)
4494 XSETFASTINT (start
, BEGV
);
4495 XSETFASTINT (end
, ZV
);
4501 XSETFASTINT (start
, BEGV
);
4502 XSETFASTINT (end
, ZV
);
4507 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4509 /* Decide the coding-system to encode the data with.
4510 We used to make this choice before calling build_annotations, but that
4511 leads to problems when a write-annotate-function takes care of
4512 unsavable chars (as was the case with X-Symbol). */
4513 Vlast_coding_system_used
4514 = choose_write_coding_system (start
, end
, filename
,
4515 append
, visit
, lockname
, &coding
);
4517 #ifdef CLASH_DETECTION
4519 lock_file (lockname
);
4520 #endif /* CLASH_DETECTION */
4522 encoded_filename
= ENCODE_FILE (filename
);
4524 fn
= SSDATA (encoded_filename
);
4528 desc
= emacs_open (fn
, O_WRONLY
| O_BINARY
, 0);
4529 #else /* not DOS_NT */
4530 desc
= emacs_open (fn
, O_WRONLY
, 0);
4531 #endif /* not DOS_NT */
4533 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4535 desc
= emacs_open (fn
,
4536 O_WRONLY
| O_CREAT
| O_BINARY
4537 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4538 S_IREAD
| S_IWRITE
);
4539 #else /* not DOS_NT */
4540 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4541 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4542 auto_saving
? auto_save_mode_bits
: 0666);
4543 #endif /* not DOS_NT */
4547 #ifdef CLASH_DETECTION
4549 if (!auto_saving
) unlock_file (lockname
);
4551 #endif /* CLASH_DETECTION */
4553 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4556 record_unwind_protect (close_file_unwind
, make_number (desc
));
4558 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4562 if (NUMBERP (append
))
4563 ret
= emacs_lseek (desc
, XINT (append
), SEEK_CUR
);
4565 ret
= lseek (desc
, 0, SEEK_END
);
4568 #ifdef CLASH_DETECTION
4569 if (!auto_saving
) unlock_file (lockname
);
4570 #endif /* CLASH_DETECTION */
4572 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4581 if (STRINGP (start
))
4583 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
4584 &annotations
, &coding
);
4587 else if (XINT (start
) != XINT (end
))
4589 failure
= 0 > a_write (desc
, Qnil
,
4590 XINT (start
), XINT (end
) - XINT (start
),
4591 &annotations
, &coding
);
4596 /* If file was empty, still need to write the annotations */
4597 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4598 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4602 if (CODING_REQUIRE_FLUSHING (&coding
)
4603 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4606 /* We have to flush out a data. */
4607 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4608 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
4615 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4616 Disk full in NFS may be reported here. */
4617 /* mib says that closing the file will try to write as fast as NFS can do
4618 it, and that means the fsync here is not crucial for autosave files. */
4619 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
4621 /* If fsync fails with EINTR, don't treat that as serious. Also
4622 ignore EINVAL which happens when fsync is not supported on this
4624 if (errno
!= EINTR
&& errno
!= EINVAL
)
4625 failure
= 1, save_errno
= errno
;
4629 /* NFS can report a write failure now. */
4630 if (emacs_close (desc
) < 0)
4631 failure
= 1, save_errno
= errno
;
4635 /* Discard the unwind protect for close_file_unwind. */
4636 specpdl_ptr
= specpdl
+ count1
;
4638 /* Call write-region-post-annotation-function. */
4639 while (CONSP (Vwrite_region_annotation_buffers
))
4641 Lisp_Object buf
= XCAR (Vwrite_region_annotation_buffers
);
4642 if (!NILP (Fbuffer_live_p (buf
)))
4645 if (FUNCTIONP (Vwrite_region_post_annotation_function
))
4646 call0 (Vwrite_region_post_annotation_function
);
4648 Vwrite_region_annotation_buffers
4649 = XCDR (Vwrite_region_annotation_buffers
);
4652 unbind_to (count
, Qnil
);
4654 #ifdef CLASH_DETECTION
4656 unlock_file (lockname
);
4657 #endif /* CLASH_DETECTION */
4659 /* Do this before reporting IO error
4660 to avoid a "file has changed on disk" warning on
4661 next attempt to save. */
4664 current_buffer
->modtime
= st
.st_mtime
;
4665 current_buffer
->modtime_size
= st
.st_size
;
4669 error ("IO error writing %s: %s", SDATA (filename
),
4670 emacs_strerror (save_errno
));
4674 SAVE_MODIFF
= MODIFF
;
4675 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4676 BVAR (current_buffer
, filename
) = visit_file
;
4677 update_mode_lines
++;
4682 && ! NILP (Fstring_equal (BVAR (current_buffer
, filename
),
4683 BVAR (current_buffer
, auto_save_file_name
))))
4684 SAVE_MODIFF
= MODIFF
;
4690 message_with_string ((INTEGERP (append
)
4700 Lisp_Object
merge (Lisp_Object
, Lisp_Object
, Lisp_Object
);
4702 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4703 doc
: /* Return t if (car A) is numerically less than (car B). */)
4704 (Lisp_Object a
, Lisp_Object b
)
4706 return Flss (Fcar (a
), Fcar (b
));
4709 /* Build the complete list of annotations appropriate for writing out
4710 the text between START and END, by calling all the functions in
4711 write-region-annotate-functions and merging the lists they return.
4712 If one of these functions switches to a different buffer, we assume
4713 that buffer contains altered text. Therefore, the caller must
4714 make sure to restore the current buffer in all cases,
4715 as save-excursion would do. */
4718 build_annotations (Lisp_Object start
, Lisp_Object end
)
4720 Lisp_Object annotations
;
4722 struct gcpro gcpro1
, gcpro2
;
4723 Lisp_Object original_buffer
;
4724 int i
, used_global
= 0;
4726 XSETBUFFER (original_buffer
, current_buffer
);
4729 p
= Vwrite_region_annotate_functions
;
4730 GCPRO2 (annotations
, p
);
4733 struct buffer
*given_buffer
= current_buffer
;
4734 if (EQ (Qt
, XCAR (p
)) && !used_global
)
4735 { /* Use the global value of the hook. */
4738 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
4740 p
= Fappend (2, arg
);
4743 Vwrite_region_annotations_so_far
= annotations
;
4744 res
= call2 (XCAR (p
), start
, end
);
4745 /* If the function makes a different buffer current,
4746 assume that means this buffer contains altered text to be output.
4747 Reset START and END from the buffer bounds
4748 and discard all previous annotations because they should have
4749 been dealt with by this function. */
4750 if (current_buffer
!= given_buffer
)
4752 Vwrite_region_annotation_buffers
4753 = Fcons (Fcurrent_buffer (),
4754 Vwrite_region_annotation_buffers
);
4755 XSETFASTINT (start
, BEGV
);
4756 XSETFASTINT (end
, ZV
);
4759 Flength (res
); /* Check basic validity of return value */
4760 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4764 /* Now do the same for annotation functions implied by the file-format */
4765 if (auto_saving
&& (!EQ (BVAR (current_buffer
, auto_save_file_format
), Qt
)))
4766 p
= BVAR (current_buffer
, auto_save_file_format
);
4768 p
= BVAR (current_buffer
, file_format
);
4769 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
4771 struct buffer
*given_buffer
= current_buffer
;
4773 Vwrite_region_annotations_so_far
= annotations
;
4775 /* Value is either a list of annotations or nil if the function
4776 has written annotations to a temporary buffer, which is now
4778 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
4779 original_buffer
, make_number (i
));
4780 if (current_buffer
!= given_buffer
)
4782 XSETFASTINT (start
, BEGV
);
4783 XSETFASTINT (end
, ZV
);
4788 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4796 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
4797 If STRING is nil, POS is the character position in the current buffer.
4798 Intersperse with them the annotations from *ANNOT
4799 which fall within the range of POS to POS + NCHARS,
4800 each at its appropriate position.
4802 We modify *ANNOT by discarding elements as we use them up.
4804 The return value is negative in case of system call failure. */
4807 a_write (int desc
, Lisp_Object string
, EMACS_INT pos
,
4808 register EMACS_INT nchars
, Lisp_Object
*annot
,
4809 struct coding_system
*coding
)
4813 EMACS_INT lastpos
= pos
+ nchars
;
4815 while (NILP (*annot
) || CONSP (*annot
))
4817 tem
= Fcar_safe (Fcar (*annot
));
4820 nextpos
= XFASTINT (tem
);
4822 /* If there are no more annotations in this range,
4823 output the rest of the range all at once. */
4824 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
4825 return e_write (desc
, string
, pos
, lastpos
, coding
);
4827 /* Output buffer text up to the next annotation's position. */
4830 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
4834 /* Output the annotation. */
4835 tem
= Fcdr (Fcar (*annot
));
4838 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
4841 *annot
= Fcdr (*annot
);
4847 /* Write text in the range START and END into descriptor DESC,
4848 encoding them with coding system CODING. If STRING is nil, START
4849 and END are character positions of the current buffer, else they
4850 are indexes to the string STRING. */
4853 e_write (int desc
, Lisp_Object string
, EMACS_INT start
, EMACS_INT end
,
4854 struct coding_system
*coding
)
4856 if (STRINGP (string
))
4859 end
= SCHARS (string
);
4862 /* We used to have a code for handling selective display here. But,
4863 now it is handled within encode_coding. */
4867 if (STRINGP (string
))
4869 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
4870 if (CODING_REQUIRE_ENCODING (coding
))
4872 encode_coding_object (coding
, string
,
4873 start
, string_char_to_byte (string
, start
),
4874 end
, string_char_to_byte (string
, end
), Qt
);
4878 coding
->dst_object
= string
;
4879 coding
->consumed_char
= SCHARS (string
);
4880 coding
->produced
= SBYTES (string
);
4885 EMACS_INT start_byte
= CHAR_TO_BYTE (start
);
4886 EMACS_INT end_byte
= CHAR_TO_BYTE (end
);
4888 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
4889 if (CODING_REQUIRE_ENCODING (coding
))
4891 encode_coding_object (coding
, Fcurrent_buffer (),
4892 start
, start_byte
, end
, end_byte
, Qt
);
4896 coding
->dst_object
= Qnil
;
4897 coding
->dst_pos_byte
= start_byte
;
4898 if (start
>= GPT
|| end
<= GPT
)
4900 coding
->consumed_char
= end
- start
;
4901 coding
->produced
= end_byte
- start_byte
;
4905 coding
->consumed_char
= GPT
- start
;
4906 coding
->produced
= GPT_BYTE
- start_byte
;
4911 if (coding
->produced
> 0)
4915 STRINGP (coding
->dst_object
)
4916 ? SSDATA (coding
->dst_object
)
4917 : (char *) BYTE_POS_ADDR (coding
->dst_pos_byte
),
4920 if (coding
->produced
)
4923 start
+= coding
->consumed_char
;
4929 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4930 Sverify_visited_file_modtime
, 0, 1, 0,
4931 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
4932 This means that the file has not been changed since it was visited or saved.
4933 If BUF is omitted or nil, it defaults to the current buffer.
4934 See Info node `(elisp)Modification Time' for more details. */)
4939 Lisp_Object handler
;
4940 Lisp_Object filename
;
4950 if (!STRINGP (BVAR (b
, filename
))) return Qt
;
4951 if (b
->modtime
== 0) return Qt
;
4953 /* If the file name has special constructs in it,
4954 call the corresponding file handler. */
4955 handler
= Ffind_file_name_handler (BVAR (b
, filename
),
4956 Qverify_visited_file_modtime
);
4957 if (!NILP (handler
))
4958 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4960 filename
= ENCODE_FILE (BVAR (b
, filename
));
4962 if (stat (SSDATA (filename
), &st
) < 0)
4964 /* If the file doesn't exist now and didn't exist before,
4965 we say that it isn't modified, provided the error is a tame one. */
4966 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4971 if ((st
.st_mtime
== b
->modtime
4972 /* If both are positive, accept them if they are off by one second. */
4973 || (st
.st_mtime
> 0 && b
->modtime
> 0
4974 && (st
.st_mtime
- 1 == b
->modtime
4975 || st
.st_mtime
== b
->modtime
- 1)))
4976 && (st
.st_size
== b
->modtime_size
4977 || b
->modtime_size
< 0))
4982 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4983 Sclear_visited_file_modtime
, 0, 0, 0,
4984 doc
: /* Clear out records of last mod time of visited file.
4985 Next attempt to save will certainly not complain of a discrepancy. */)
4988 current_buffer
->modtime
= 0;
4989 current_buffer
->modtime_size
= -1;
4993 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4994 Svisited_file_modtime
, 0, 0, 0,
4995 doc
: /* Return the current buffer's recorded visited file modification time.
4996 The value is a list of the form (HIGH LOW), like the time values
4997 that `file-attributes' returns. If the current buffer has no recorded
4998 file modification time, this function returns 0.
4999 See Info node `(elisp)Modification Time' for more details. */)
5002 if (! current_buffer
->modtime
)
5003 return make_number (0);
5004 return make_time (current_buffer
->modtime
);
5007 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5008 Sset_visited_file_modtime
, 0, 1, 0,
5009 doc
: /* Update buffer's recorded modification time from the visited file's time.
5010 Useful if the buffer was not read from the file normally
5011 or if the file itself has been changed for some known benign reason.
5012 An argument specifies the modification time value to use
5013 \(instead of that of the visited file), in the form of a list
5014 \(HIGH . LOW) or (HIGH LOW). */)
5015 (Lisp_Object time_list
)
5017 if (!NILP (time_list
))
5019 CONS_TO_INTEGER (time_list
, time_t, current_buffer
->modtime
);
5020 current_buffer
->modtime_size
= -1;
5024 register Lisp_Object filename
;
5026 Lisp_Object handler
;
5028 filename
= Fexpand_file_name (BVAR (current_buffer
, filename
), Qnil
);
5030 /* If the file name has special constructs in it,
5031 call the corresponding file handler. */
5032 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5033 if (!NILP (handler
))
5034 /* The handler can find the file name the same way we did. */
5035 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5037 filename
= ENCODE_FILE (filename
);
5039 if (stat (SSDATA (filename
), &st
) >= 0)
5041 current_buffer
->modtime
= st
.st_mtime
;
5042 current_buffer
->modtime_size
= st
.st_size
;
5050 auto_save_error (Lisp_Object error_val
)
5052 Lisp_Object args
[3], msg
;
5054 struct gcpro gcpro1
;
5058 auto_save_error_occurred
= 1;
5060 ring_bell (XFRAME (selected_frame
));
5062 args
[0] = build_string ("Auto-saving %s: %s");
5063 args
[1] = BVAR (current_buffer
, name
);
5064 args
[2] = Ferror_message_string (error_val
);
5065 msg
= Fformat (3, args
);
5067 nbytes
= SBYTES (msg
);
5068 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5069 memcpy (msgbuf
, SDATA (msg
), nbytes
);
5071 for (i
= 0; i
< 3; ++i
)
5074 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5076 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5077 Fsleep_for (make_number (1), Qnil
);
5091 auto_save_mode_bits
= 0666;
5093 /* Get visited file's mode to become the auto save file's mode. */
5094 if (! NILP (BVAR (current_buffer
, filename
)))
5096 if (stat (SSDATA (BVAR (current_buffer
, filename
)), &st
) >= 0)
5097 /* But make sure we can overwrite it later! */
5098 auto_save_mode_bits
= st
.st_mode
| 0600;
5099 else if ((modes
= Ffile_modes (BVAR (current_buffer
, filename
)),
5101 /* Remote files don't cooperate with stat. */
5102 auto_save_mode_bits
= XINT (modes
) | 0600;
5106 Fwrite_region (Qnil
, Qnil
, BVAR (current_buffer
, auto_save_file_name
), Qnil
,
5107 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5112 do_auto_save_unwind (Lisp_Object arg
) /* used as unwind-protect function */
5115 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5127 do_auto_save_unwind_1 (Lisp_Object value
) /* used as unwind-protect function */
5130 minibuffer_auto_raise
= XINT (value
);
5135 do_auto_save_make_dir (Lisp_Object dir
)
5139 call2 (Qmake_directory
, dir
, Qt
);
5140 XSETFASTINT (mode
, 0700);
5141 return Fset_file_modes (dir
, mode
);
5145 do_auto_save_eh (Lisp_Object ignore
)
5150 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5151 doc
: /* Auto-save all buffers that need it.
5152 This is all buffers that have auto-saving enabled
5153 and are changed since last auto-saved.
5154 Auto-saving writes the buffer into a file
5155 so that your editing is not lost if the system crashes.
5156 This file is not the file you visited; that changes only when you save.
5157 Normally we run the normal hook `auto-save-hook' before saving.
5159 A non-nil NO-MESSAGE argument means do not print any message if successful.
5160 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5161 (Lisp_Object no_message
, Lisp_Object current_only
)
5163 struct buffer
*old
= current_buffer
, *b
;
5164 Lisp_Object tail
, buf
, hook
;
5166 int do_handled_files
;
5168 FILE *stream
= NULL
;
5169 int count
= SPECPDL_INDEX ();
5170 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5171 int old_message_p
= 0;
5172 struct gcpro gcpro1
, gcpro2
;
5174 if (max_specpdl_size
< specpdl_size
+ 40)
5175 max_specpdl_size
= specpdl_size
+ 40;
5180 if (NILP (no_message
))
5182 old_message_p
= push_message ();
5183 record_unwind_protect (pop_message_unwind
, Qnil
);
5186 /* Ordinarily don't quit within this function,
5187 but don't make it impossible to quit (in case we get hung in I/O). */
5191 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5192 point to non-strings reached from Vbuffer_alist. */
5194 hook
= intern ("auto-save-hook");
5195 Frun_hooks (1, &hook
);
5197 if (STRINGP (Vauto_save_list_file_name
))
5199 Lisp_Object listfile
;
5201 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5203 /* Don't try to create the directory when shutting down Emacs,
5204 because creating the directory might signal an error, and
5205 that would leave Emacs in a strange state. */
5206 if (!NILP (Vrun_hooks
))
5210 GCPRO2 (dir
, listfile
);
5211 dir
= Ffile_name_directory (listfile
);
5212 if (NILP (Ffile_directory_p (dir
)))
5213 internal_condition_case_1 (do_auto_save_make_dir
,
5214 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5219 stream
= fopen (SSDATA (listfile
), "w");
5222 record_unwind_protect (do_auto_save_unwind
,
5223 make_save_value (stream
, 0));
5224 record_unwind_protect (do_auto_save_unwind_1
,
5225 make_number (minibuffer_auto_raise
));
5226 minibuffer_auto_raise
= 0;
5228 auto_save_error_occurred
= 0;
5230 /* On first pass, save all files that don't have handlers.
5231 On second pass, save all files that do have handlers.
5233 If Emacs is crashing, the handlers may tweak what is causing
5234 Emacs to crash in the first place, and it would be a shame if
5235 Emacs failed to autosave perfectly ordinary files because it
5236 couldn't handle some ange-ftp'd file. */
5238 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5239 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5241 buf
= XCDR (XCAR (tail
));
5244 /* Record all the buffers that have auto save mode
5245 in the special file that lists them. For each of these buffers,
5246 Record visited name (if any) and auto save name. */
5247 if (STRINGP (BVAR (b
, auto_save_file_name
))
5248 && stream
!= NULL
&& do_handled_files
== 0)
5251 if (!NILP (BVAR (b
, filename
)))
5253 fwrite (SDATA (BVAR (b
, filename
)), 1,
5254 SBYTES (BVAR (b
, filename
)), stream
);
5256 putc ('\n', stream
);
5257 fwrite (SDATA (BVAR (b
, auto_save_file_name
)), 1,
5258 SBYTES (BVAR (b
, auto_save_file_name
)), stream
);
5259 putc ('\n', stream
);
5263 if (!NILP (current_only
)
5264 && b
!= current_buffer
)
5267 /* Don't auto-save indirect buffers.
5268 The base buffer takes care of it. */
5272 /* Check for auto save enabled
5273 and file changed since last auto save
5274 and file changed since last real save. */
5275 if (STRINGP (BVAR (b
, auto_save_file_name
))
5276 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5277 && BUF_AUTOSAVE_MODIFF (b
) < BUF_MODIFF (b
)
5278 /* -1 means we've turned off autosaving for a while--see below. */
5279 && XINT (BVAR (b
, save_length
)) >= 0
5280 && (do_handled_files
5281 || NILP (Ffind_file_name_handler (BVAR (b
, auto_save_file_name
),
5284 EMACS_TIME before_time
, after_time
;
5286 EMACS_GET_TIME (before_time
);
5288 /* If we had a failure, don't try again for 20 minutes. */
5289 if (b
->auto_save_failure_time
>= 0
5290 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5293 set_buffer_internal (b
);
5294 if (NILP (Vauto_save_include_big_deletions
)
5295 && (XFASTINT (BVAR (b
, save_length
)) * 10
5296 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5297 /* A short file is likely to change a large fraction;
5298 spare the user annoying messages. */
5299 && XFASTINT (BVAR (b
, save_length
)) > 5000
5300 /* These messages are frequent and annoying for `*mail*'. */
5301 && !EQ (BVAR (b
, filename
), Qnil
)
5302 && NILP (no_message
))
5304 /* It has shrunk too much; turn off auto-saving here. */
5305 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5306 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5308 minibuffer_auto_raise
= 0;
5309 /* Turn off auto-saving until there's a real save,
5310 and prevent any more warnings. */
5311 XSETINT (BVAR (b
, save_length
), -1);
5312 Fsleep_for (make_number (1), Qnil
);
5315 if (!auto_saved
&& NILP (no_message
))
5316 message1 ("Auto-saving...");
5317 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5319 BUF_AUTOSAVE_MODIFF (b
) = BUF_MODIFF (b
);
5320 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5321 set_buffer_internal (old
);
5323 EMACS_GET_TIME (after_time
);
5325 /* If auto-save took more than 60 seconds,
5326 assume it was an NFS failure that got a timeout. */
5327 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5328 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5332 /* Prevent another auto save till enough input events come in. */
5333 record_auto_save ();
5335 if (auto_saved
&& NILP (no_message
))
5339 /* If we are going to restore an old message,
5340 give time to read ours. */
5341 sit_for (make_number (1), 0, 0);
5344 else if (!auto_save_error_occurred
)
5345 /* Don't overwrite the error message if an error occurred.
5346 If we displayed a message and then restored a state
5347 with no message, leave a "done" message on the screen. */
5348 message1 ("Auto-saving...done");
5353 /* This restores the message-stack status. */
5354 unbind_to (count
, Qnil
);
5358 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5359 Sset_buffer_auto_saved
, 0, 0, 0,
5360 doc
: /* Mark current buffer as auto-saved with its current text.
5361 No auto-save file will be written until the buffer changes again. */)
5364 /* FIXME: This should not be called in indirect buffers, since
5365 they're not autosaved. */
5366 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
5367 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5368 current_buffer
->auto_save_failure_time
= -1;
5372 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5373 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5374 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5377 current_buffer
->auto_save_failure_time
= -1;
5381 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5383 doc
: /* Return t if current buffer has been auto-saved recently.
5384 More precisely, if it has been auto-saved since last read from or saved
5385 in the visited file. If the buffer has no visited file,
5386 then any auto-save counts as "recent". */)
5389 /* FIXME: maybe we should return nil for indirect buffers since
5390 they're never autosaved. */
5391 return (SAVE_MODIFF
< BUF_AUTOSAVE_MODIFF (current_buffer
) ? Qt
: Qnil
);
5394 /* Reading and completing file names */
5396 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5397 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5398 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5399 The return value is only relevant for a call to `read-file-name' that happens
5400 before any other event (mouse or keypress) is handled. */)
5403 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
5404 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5414 Fread_file_name (Lisp_Object prompt
, Lisp_Object dir
, Lisp_Object default_filename
, Lisp_Object mustmatch
, Lisp_Object initial
, Lisp_Object predicate
)
5416 struct gcpro gcpro1
;
5417 Lisp_Object args
[7];
5419 GCPRO1 (default_filename
);
5420 args
[0] = intern ("read-file-name");
5423 args
[3] = default_filename
;
5424 args
[4] = mustmatch
;
5426 args
[6] = predicate
;
5427 RETURN_UNGCPRO (Ffuncall (7, args
));
5432 syms_of_fileio (void)
5434 DEFSYM (Qoperations
, "operations");
5435 DEFSYM (Qexpand_file_name
, "expand-file-name");
5436 DEFSYM (Qsubstitute_in_file_name
, "substitute-in-file-name");
5437 DEFSYM (Qdirectory_file_name
, "directory-file-name");
5438 DEFSYM (Qfile_name_directory
, "file-name-directory");
5439 DEFSYM (Qfile_name_nondirectory
, "file-name-nondirectory");
5440 DEFSYM (Qunhandled_file_name_directory
, "unhandled-file-name-directory");
5441 DEFSYM (Qfile_name_as_directory
, "file-name-as-directory");
5442 DEFSYM (Qcopy_file
, "copy-file");
5443 DEFSYM (Qmake_directory_internal
, "make-directory-internal");
5444 DEFSYM (Qmake_directory
, "make-directory");
5445 DEFSYM (Qdelete_directory_internal
, "delete-directory-internal");
5446 DEFSYM (Qdelete_file
, "delete-file");
5447 DEFSYM (Qrename_file
, "rename-file");
5448 DEFSYM (Qadd_name_to_file
, "add-name-to-file");
5449 DEFSYM (Qmake_symbolic_link
, "make-symbolic-link");
5450 DEFSYM (Qfile_exists_p
, "file-exists-p");
5451 DEFSYM (Qfile_executable_p
, "file-executable-p");
5452 DEFSYM (Qfile_readable_p
, "file-readable-p");
5453 DEFSYM (Qfile_writable_p
, "file-writable-p");
5454 DEFSYM (Qfile_symlink_p
, "file-symlink-p");
5455 DEFSYM (Qaccess_file
, "access-file");
5456 DEFSYM (Qfile_directory_p
, "file-directory-p");
5457 DEFSYM (Qfile_regular_p
, "file-regular-p");
5458 DEFSYM (Qfile_accessible_directory_p
, "file-accessible-directory-p");
5459 DEFSYM (Qfile_modes
, "file-modes");
5460 DEFSYM (Qset_file_modes
, "set-file-modes");
5461 DEFSYM (Qset_file_times
, "set-file-times");
5462 DEFSYM (Qfile_selinux_context
, "file-selinux-context");
5463 DEFSYM (Qset_file_selinux_context
, "set-file-selinux-context");
5464 DEFSYM (Qfile_newer_than_file_p
, "file-newer-than-file-p");
5465 DEFSYM (Qinsert_file_contents
, "insert-file-contents");
5466 DEFSYM (Qwrite_region
, "write-region");
5467 DEFSYM (Qverify_visited_file_modtime
, "verify-visited-file-modtime");
5468 DEFSYM (Qset_visited_file_modtime
, "set-visited-file-modtime");
5469 DEFSYM (Qauto_save_coding
, "auto-save-coding");
5471 DEFSYM (Qfile_name_history
, "file-name-history");
5472 Fset (Qfile_name_history
, Qnil
);
5474 DEFSYM (Qfile_error
, "file-error");
5475 DEFSYM (Qfile_already_exists
, "file-already-exists");
5476 DEFSYM (Qfile_date_error
, "file-date-error");
5477 DEFSYM (Qexcl
, "excl");
5479 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system
,
5480 doc
: /* *Coding system for encoding file names.
5481 If it is nil, `default-file-name-coding-system' (which see) is used. */);
5482 Vfile_name_coding_system
= Qnil
;
5484 DEFVAR_LISP ("default-file-name-coding-system",
5485 Vdefault_file_name_coding_system
,
5486 doc
: /* Default coding system for encoding file names.
5487 This variable is used only when `file-name-coding-system' is nil.
5489 This variable is set/changed by the command `set-language-environment'.
5490 User should not set this variable manually,
5491 instead use `file-name-coding-system' to get a constant encoding
5492 of file names regardless of the current language environment. */);
5493 Vdefault_file_name_coding_system
= Qnil
;
5495 DEFSYM (Qformat_decode
, "format-decode");
5496 DEFSYM (Qformat_annotate_function
, "format-annotate-function");
5497 DEFSYM (Qafter_insert_file_set_coding
, "after-insert-file-set-coding");
5498 DEFSYM (Qcar_less_than_car
, "car-less-than-car");
5500 Fput (Qfile_error
, Qerror_conditions
,
5501 Fpurecopy (list2 (Qfile_error
, Qerror
)));
5502 Fput (Qfile_error
, Qerror_message
,
5503 make_pure_c_string ("File error"));
5505 Fput (Qfile_already_exists
, Qerror_conditions
,
5506 Fpurecopy (list3 (Qfile_already_exists
, Qfile_error
, Qerror
)));
5507 Fput (Qfile_already_exists
, Qerror_message
,
5508 make_pure_c_string ("File already exists"));
5510 Fput (Qfile_date_error
, Qerror_conditions
,
5511 Fpurecopy (list3 (Qfile_date_error
, Qfile_error
, Qerror
)));
5512 Fput (Qfile_date_error
, Qerror_message
,
5513 make_pure_c_string ("Cannot set file date"));
5515 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist
,
5516 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
5517 If a file name matches REGEXP, then all I/O on that file is done by calling
5520 The first argument given to HANDLER is the name of the I/O primitive
5521 to be handled; the remaining arguments are the arguments that were
5522 passed to that primitive. For example, if you do
5523 (file-exists-p FILENAME)
5524 and FILENAME is handled by HANDLER, then HANDLER is called like this:
5525 (funcall HANDLER 'file-exists-p FILENAME)
5526 The function `find-file-name-handler' checks this list for a handler
5527 for its argument. */);
5528 Vfile_name_handler_alist
= Qnil
;
5530 DEFVAR_LISP ("set-auto-coding-function",
5531 Vset_auto_coding_function
,
5532 doc
: /* If non-nil, a function to call to decide a coding system of file.
5533 Two arguments are passed to this function: the file name
5534 and the length of a file contents following the point.
5535 This function should return a coding system to decode the file contents.
5536 It should check the file name against `auto-coding-alist'.
5537 If no coding system is decided, it should check a coding system
5538 specified in the heading lines with the format:
5539 -*- ... coding: CODING-SYSTEM; ... -*-
5540 or local variable spec of the tailing lines with `coding:' tag. */);
5541 Vset_auto_coding_function
= Qnil
;
5543 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions
,
5544 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
5545 Each is passed one argument, the number of characters inserted,
5546 with point at the start of the inserted text. Each function
5547 should leave point the same, and return the new character count.
5548 If `insert-file-contents' is intercepted by a handler from
5549 `file-name-handler-alist', that handler is responsible for calling the
5550 functions in `after-insert-file-functions' if appropriate. */);
5551 Vafter_insert_file_functions
= Qnil
;
5553 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions
,
5554 doc
: /* A list of functions to be called at the start of `write-region'.
5555 Each is passed two arguments, START and END as for `write-region'.
5556 These are usually two numbers but not always; see the documentation
5557 for `write-region'. The function should return a list of pairs
5558 of the form (POSITION . STRING), consisting of strings to be effectively
5559 inserted at the specified positions of the file being written (1 means to
5560 insert before the first byte written). The POSITIONs must be sorted into
5563 If there are several annotation functions, the lists returned by these
5564 functions are merged destructively. As each annotation function runs,
5565 the variable `write-region-annotations-so-far' contains a list of all
5566 annotations returned by previous annotation functions.
5568 An annotation function can return with a different buffer current.
5569 Doing so removes the annotations returned by previous functions, and
5570 resets START and END to `point-min' and `point-max' of the new buffer.
5572 After `write-region' completes, Emacs calls the function stored in
5573 `write-region-post-annotation-function', once for each buffer that was
5574 current when building the annotations (i.e., at least once), with that
5575 buffer current. */);
5576 Vwrite_region_annotate_functions
= Qnil
;
5577 DEFSYM (Qwrite_region_annotate_functions
, "write-region-annotate-functions");
5579 DEFVAR_LISP ("write-region-post-annotation-function",
5580 Vwrite_region_post_annotation_function
,
5581 doc
: /* Function to call after `write-region' completes.
5582 The function is called with no arguments. If one or more of the
5583 annotation functions in `write-region-annotate-functions' changed the
5584 current buffer, the function stored in this variable is called for
5585 each of those additional buffers as well, in addition to the original
5586 buffer. The relevant buffer is current during each function call. */);
5587 Vwrite_region_post_annotation_function
= Qnil
;
5588 staticpro (&Vwrite_region_annotation_buffers
);
5590 DEFVAR_LISP ("write-region-annotations-so-far",
5591 Vwrite_region_annotations_so_far
,
5592 doc
: /* When an annotation function is called, this holds the previous annotations.
5593 These are the annotations made by other annotation functions
5594 that were already called. See also `write-region-annotate-functions'. */);
5595 Vwrite_region_annotations_so_far
= Qnil
;
5597 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers
,
5598 doc
: /* A list of file name handlers that temporarily should not be used.
5599 This applies only to the operation `inhibit-file-name-operation'. */);
5600 Vinhibit_file_name_handlers
= Qnil
;
5602 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation
,
5603 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5604 Vinhibit_file_name_operation
= Qnil
;
5606 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name
,
5607 doc
: /* File name in which we write a list of all auto save file names.
5608 This variable is initialized automatically from `auto-save-list-file-prefix'
5609 shortly after Emacs reads your `.emacs' file, if you have not yet given it
5610 a non-nil value. */);
5611 Vauto_save_list_file_name
= Qnil
;
5613 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name
,
5614 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
5615 Normally auto-save files are written under other names. */);
5616 Vauto_save_visited_file_name
= Qnil
;
5618 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions
,
5619 doc
: /* If non-nil, auto-save even if a large part of the text is deleted.
5620 If nil, deleting a substantial portion of the text disables auto-save
5621 in the buffer; this is the default behavior, because the auto-save
5622 file is usually more useful if it contains the deleted text. */);
5623 Vauto_save_include_big_deletions
= Qnil
;
5626 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync
,
5627 doc
: /* *Non-nil means don't call fsync in `write-region'.
5628 This variable affects calls to `write-region' as well as save commands.
5629 A non-nil value may result in data loss! */);
5630 write_region_inhibit_fsync
= 0;
5633 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash
,
5634 doc
: /* Specifies whether to use the system's trash can.
5635 When non-nil, certain file deletion commands use the function
5636 `move-file-to-trash' instead of deleting files outright.
5637 This includes interactive calls to `delete-file' and
5638 `delete-directory' and the Dired deletion commands. */);
5639 delete_by_moving_to_trash
= 0;
5640 Qdelete_by_moving_to_trash
= intern_c_string ("delete-by-moving-to-trash");
5642 DEFSYM (Qmove_file_to_trash
, "move-file-to-trash");
5643 DEFSYM (Qcopy_directory
, "copy-directory");
5644 DEFSYM (Qdelete_directory
, "delete-directory");
5646 defsubr (&Sfind_file_name_handler
);
5647 defsubr (&Sfile_name_directory
);
5648 defsubr (&Sfile_name_nondirectory
);
5649 defsubr (&Sunhandled_file_name_directory
);
5650 defsubr (&Sfile_name_as_directory
);
5651 defsubr (&Sdirectory_file_name
);
5652 defsubr (&Smake_temp_name
);
5653 defsubr (&Sexpand_file_name
);
5654 defsubr (&Ssubstitute_in_file_name
);
5655 defsubr (&Scopy_file
);
5656 defsubr (&Smake_directory_internal
);
5657 defsubr (&Sdelete_directory_internal
);
5658 defsubr (&Sdelete_file
);
5659 defsubr (&Srename_file
);
5660 defsubr (&Sadd_name_to_file
);
5661 defsubr (&Smake_symbolic_link
);
5662 defsubr (&Sfile_name_absolute_p
);
5663 defsubr (&Sfile_exists_p
);
5664 defsubr (&Sfile_executable_p
);
5665 defsubr (&Sfile_readable_p
);
5666 defsubr (&Sfile_writable_p
);
5667 defsubr (&Saccess_file
);
5668 defsubr (&Sfile_symlink_p
);
5669 defsubr (&Sfile_directory_p
);
5670 defsubr (&Sfile_accessible_directory_p
);
5671 defsubr (&Sfile_regular_p
);
5672 defsubr (&Sfile_modes
);
5673 defsubr (&Sset_file_modes
);
5674 defsubr (&Sset_file_times
);
5675 defsubr (&Sfile_selinux_context
);
5676 defsubr (&Sset_file_selinux_context
);
5677 defsubr (&Sset_default_file_modes
);
5678 defsubr (&Sdefault_file_modes
);
5679 defsubr (&Sfile_newer_than_file_p
);
5680 defsubr (&Sinsert_file_contents
);
5681 defsubr (&Swrite_region
);
5682 defsubr (&Scar_less_than_car
);
5683 defsubr (&Sverify_visited_file_modtime
);
5684 defsubr (&Sclear_visited_file_modtime
);
5685 defsubr (&Svisited_file_modtime
);
5686 defsubr (&Sset_visited_file_modtime
);
5687 defsubr (&Sdo_auto_save
);
5688 defsubr (&Sset_buffer_auto_saved
);
5689 defsubr (&Sclear_buffer_auto_save_failure
);
5690 defsubr (&Srecent_auto_save_p
);
5692 defsubr (&Snext_read_file_uses_dialog_p
);
5695 defsubr (&Sunix_sync
);