1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
29 #include <sys/types.h>
36 #if !defined (S_ISLNK) && defined (S_IFLNK)
37 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
40 #if !defined (S_ISFIFO) && defined (S_IFIFO)
41 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
44 #if !defined (S_ISREG) && defined (S_IFREG)
45 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
62 #include "intervals.h"
64 #include "character.h"
67 #include "blockinput.h"
69 #include "dispextern.h"
76 #endif /* not WINDOWSNT */
80 #include <sys/param.h>
88 #define CORRECT_DIR_SEPS(s) \
89 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
90 else unixtodos_filename (s); \
92 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
93 redirector allows the six letters between 'Z' and 'a' as well. */
95 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
98 #define IS_DRIVE(x) isalpha (x)
100 /* Need to lower-case the drive letter, or else expanded
101 filenames will sometimes compare inequal, because
102 `expand-file-name' doesn't always down-case the drive letter. */
103 #define DRIVE_LETTER(x) (tolower (x))
112 #include "commands.h"
113 extern int use_dialog_box
;
114 extern int use_file_dialog
;
128 #ifndef FILE_SYSTEM_CASE
129 #define FILE_SYSTEM_CASE(filename) (filename)
132 /* Nonzero during writing of auto-save files */
135 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
136 a new file with the same mode as the original */
137 int auto_save_mode_bits
;
139 /* Set by auto_save_1 if an error occurred during the last auto-save. */
140 int auto_save_error_occurred
;
142 /* The symbol bound to coding-system-for-read when
143 insert-file-contents is called for recovering a file. This is not
144 an actual coding system name, but just an indicator to tell
145 insert-file-contents to use `emacs-mule' with a special flag for
146 auto saving and recovering a file. */
147 Lisp_Object Qauto_save_coding
;
149 /* Coding system for file names, or nil if none. */
150 Lisp_Object Vfile_name_coding_system
;
152 /* Coding system for file names used only when
153 Vfile_name_coding_system is nil. */
154 Lisp_Object Vdefault_file_name_coding_system
;
156 /* Alist of elements (REGEXP . HANDLER) for file names
157 whose I/O is done with a special handler. */
158 Lisp_Object Vfile_name_handler_alist
;
160 /* Property name of a file name handler,
161 which gives a list of operations it handles.. */
162 Lisp_Object Qoperations
;
164 /* Lisp functions for translating file formats */
165 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
167 /* Function to be called to decide a coding system of a reading file. */
168 Lisp_Object Vset_auto_coding_function
;
170 /* Functions to be called to process text properties in inserted file. */
171 Lisp_Object Vafter_insert_file_functions
;
173 /* Lisp function for setting buffer-file-coding-system and the
174 multibyteness of the current buffer after inserting a file. */
175 Lisp_Object Qafter_insert_file_set_coding
;
177 /* Functions to be called to create text property annotations for file. */
178 Lisp_Object Vwrite_region_annotate_functions
;
179 Lisp_Object Qwrite_region_annotate_functions
;
181 /* During build_annotations, each time an annotation function is called,
182 this holds the annotations made by the previous functions. */
183 Lisp_Object Vwrite_region_annotations_so_far
;
185 /* File name in which we write a list of all our auto save files. */
186 Lisp_Object Vauto_save_list_file_name
;
188 /* Whether or not files are auto-saved into themselves. */
189 Lisp_Object Vauto_save_visited_file_name
;
191 /* On NT, specifies the directory separator character, used (eg.) when
192 expanding file names. This can be bound to / or \. */
193 Lisp_Object Vdirectory_sep_char
;
196 /* Nonzero means skip the call to fsync in Fwrite-region. */
197 int write_region_inhibit_fsync
;
200 /* Non-zero means call move-file-to-trash in Fdelete_file or
201 Fdelete_directory. */
202 int delete_by_moving_to_trash
;
204 /* Lisp function for moving files to trash. */
205 Lisp_Object Qmove_file_to_trash
;
207 extern Lisp_Object Vuser_login_name
;
210 extern Lisp_Object Vw32_get_true_file_attributes
;
213 extern int minibuf_level
;
215 extern int minibuffer_auto_raise
;
217 extern int history_delete_duplicates
;
219 /* These variables describe handlers that have "already" had a chance
220 to handle the current operation.
222 Vinhibit_file_name_handlers is a list of file name handlers.
223 Vinhibit_file_name_operation is the operation being handled.
224 If we try to handle that operation, we ignore those handlers. */
226 static Lisp_Object Vinhibit_file_name_handlers
;
227 static Lisp_Object Vinhibit_file_name_operation
;
229 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
231 Lisp_Object Qfile_name_history
;
233 Lisp_Object Qcar_less_than_car
;
235 static int a_write
P_ ((int, Lisp_Object
, int, int,
236 Lisp_Object
*, struct coding_system
*));
237 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
241 report_file_error (string
, data
)
245 Lisp_Object errstring
;
249 synchronize_system_messages_locale ();
250 str
= strerror (errorno
);
251 errstring
= code_convert_string_norecord (make_unibyte_string (str
,
253 Vlocale_coding_system
, 0);
259 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
262 /* System error messages are capitalized. Downcase the initial
263 unless it is followed by a slash. */
264 if (SREF (errstring
, 1) != '/')
265 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
267 xsignal (Qfile_error
,
268 Fcons (build_string (string
), Fcons (errstring
, data
)));
273 close_file_unwind (fd
)
276 emacs_close (XFASTINT (fd
));
280 /* Restore point, having saved it as a marker. */
283 restore_point_unwind (location
)
284 Lisp_Object location
;
286 Fgoto_char (location
);
287 Fset_marker (location
, Qnil
, Qnil
);
292 Lisp_Object Qexpand_file_name
;
293 Lisp_Object Qsubstitute_in_file_name
;
294 Lisp_Object Qdirectory_file_name
;
295 Lisp_Object Qfile_name_directory
;
296 Lisp_Object Qfile_name_nondirectory
;
297 Lisp_Object Qunhandled_file_name_directory
;
298 Lisp_Object Qfile_name_as_directory
;
299 Lisp_Object Qcopy_file
;
300 Lisp_Object Qmake_directory_internal
;
301 Lisp_Object Qmake_directory
;
302 Lisp_Object Qdelete_directory
;
303 Lisp_Object Qdelete_file
;
304 Lisp_Object Qrename_file
;
305 Lisp_Object Qadd_name_to_file
;
306 Lisp_Object Qmake_symbolic_link
;
307 Lisp_Object Qfile_exists_p
;
308 Lisp_Object Qfile_executable_p
;
309 Lisp_Object Qfile_readable_p
;
310 Lisp_Object Qfile_writable_p
;
311 Lisp_Object Qfile_symlink_p
;
312 Lisp_Object Qaccess_file
;
313 Lisp_Object Qfile_directory_p
;
314 Lisp_Object Qfile_regular_p
;
315 Lisp_Object Qfile_accessible_directory_p
;
316 Lisp_Object Qfile_modes
;
317 Lisp_Object Qset_file_modes
;
318 Lisp_Object Qset_file_times
;
319 Lisp_Object Qfile_newer_than_file_p
;
320 Lisp_Object Qinsert_file_contents
;
321 Lisp_Object Qwrite_region
;
322 Lisp_Object Qverify_visited_file_modtime
;
323 Lisp_Object Qset_visited_file_modtime
;
325 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
326 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
327 Otherwise, return nil.
328 A file name is handled if one of the regular expressions in
329 `file-name-handler-alist' matches it.
331 If OPERATION equals `inhibit-file-name-operation', then we ignore
332 any handlers that are members of `inhibit-file-name-handlers',
333 but we still do run any other handlers. This lets handlers
334 use the standard functions without calling themselves recursively. */)
335 (filename
, operation
)
336 Lisp_Object filename
, operation
;
338 /* This function must not munge the match data. */
339 Lisp_Object chain
, inhibited_handlers
, result
;
343 CHECK_STRING (filename
);
345 if (EQ (operation
, Vinhibit_file_name_operation
))
346 inhibited_handlers
= Vinhibit_file_name_handlers
;
348 inhibited_handlers
= Qnil
;
350 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
351 chain
= XCDR (chain
))
357 Lisp_Object string
= XCAR (elt
);
359 Lisp_Object handler
= XCDR (elt
);
360 Lisp_Object operations
= Qnil
;
362 if (SYMBOLP (handler
))
363 operations
= Fget (handler
, Qoperations
);
366 && (match_pos
= fast_string_match (string
, filename
)) > pos
367 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
371 handler
= XCDR (elt
);
372 tem
= Fmemq (handler
, inhibited_handlers
);
386 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
388 doc
: /* Return the directory component in file name FILENAME.
389 Return nil if FILENAME does not include a directory.
390 Otherwise return a directory name.
391 Given a Unix syntax file name, returns a string ending in slash. */)
393 Lisp_Object filename
;
396 register const unsigned char *beg
;
398 register unsigned char *beg
;
400 register const unsigned char *p
;
403 CHECK_STRING (filename
);
405 /* If the file name has special constructs in it,
406 call the corresponding file handler. */
407 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
409 return call2 (handler
, Qfile_name_directory
, filename
);
411 filename
= FILE_SYSTEM_CASE (filename
);
412 beg
= SDATA (filename
);
414 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
416 p
= beg
+ SBYTES (filename
);
418 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
420 /* only recognise drive specifier at the beginning */
422 /* handle the "/:d:foo" and "/:foo" cases correctly */
423 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
424 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
431 /* Expansion of "c:" to drive and default directory. */
434 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
435 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
436 unsigned char *r
= res
;
438 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
440 strncpy (res
, beg
, 2);
445 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
447 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
450 p
= beg
+ strlen (beg
);
453 CORRECT_DIR_SEPS (beg
);
456 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
459 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
460 Sfile_name_nondirectory
, 1, 1, 0,
461 doc
: /* Return file name FILENAME sans its directory.
462 For example, in a Unix-syntax file name,
463 this is everything after the last slash,
464 or the entire name if it contains no slash. */)
466 Lisp_Object filename
;
468 register const unsigned char *beg
, *p
, *end
;
471 CHECK_STRING (filename
);
473 /* If the file name has special constructs in it,
474 call the corresponding file handler. */
475 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
477 return call2 (handler
, Qfile_name_nondirectory
, filename
);
479 beg
= SDATA (filename
);
480 end
= p
= beg
+ SBYTES (filename
);
482 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
484 /* only recognise drive specifier at beginning */
486 /* handle the "/:d:foo" case correctly */
487 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
492 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
495 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
496 Sunhandled_file_name_directory
, 1, 1, 0,
497 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
498 A `directly usable' directory name is one that may be used without the
499 intervention of any file handler.
500 If FILENAME is a directly usable file itself, return
501 \(file-name-directory FILENAME).
502 If FILENAME refers to a file which is not accessible from a local process,
503 then this should return nil.
504 The `call-process' and `start-process' functions use this function to
505 get a current directory to run processes in. */)
507 Lisp_Object filename
;
511 /* If the file name has special constructs in it,
512 call the corresponding file handler. */
513 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
515 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
517 return Ffile_name_directory (filename
);
522 file_name_as_directory (out
, in
)
525 int size
= strlen (in
) - 1;
537 /* For Unix syntax, Append a slash if necessary */
538 if (!IS_DIRECTORY_SEP (out
[size
]))
540 /* Cannot use DIRECTORY_SEP, which could have any value */
542 out
[size
+ 2] = '\0';
545 CORRECT_DIR_SEPS (out
);
550 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
551 Sfile_name_as_directory
, 1, 1, 0,
552 doc
: /* Return a string representing the file name FILE interpreted as a directory.
553 This operation exists because a directory is also a file, but its name as
554 a directory is different from its name as a file.
555 The result can be used as the value of `default-directory'
556 or passed as second argument to `expand-file-name'.
557 For a Unix-syntax file name, just appends a slash. */)
568 /* If the file name has special constructs in it,
569 call the corresponding file handler. */
570 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
572 return call2 (handler
, Qfile_name_as_directory
, file
);
574 buf
= (char *) alloca (SBYTES (file
) + 10);
575 file_name_as_directory (buf
, SDATA (file
));
576 return make_specified_string (buf
, -1, strlen (buf
),
577 STRING_MULTIBYTE (file
));
581 * Convert from directory name to filename.
582 * On UNIX, it's simple: just make sure there isn't a terminating /
584 * Value is nonzero if the string output is different from the input.
588 directory_file_name (src
, dst
)
595 /* Process as Unix format: just remove any final slash.
596 But leave "/" unchanged; do not change it to "". */
599 && IS_DIRECTORY_SEP (dst
[slen
- 1])
601 && !IS_ANY_SEP (dst
[slen
- 2])
606 CORRECT_DIR_SEPS (dst
);
611 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
613 doc
: /* Returns the file name of the directory named DIRECTORY.
614 This is the name of the file that holds the data for the directory DIRECTORY.
615 This operation exists because a directory is also a file, but its name as
616 a directory is different from its name as a file.
617 In Unix-syntax, this function just removes the final slash. */)
619 Lisp_Object directory
;
624 CHECK_STRING (directory
);
626 if (NILP (directory
))
629 /* If the file name has special constructs in it,
630 call the corresponding file handler. */
631 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
633 return call2 (handler
, Qdirectory_file_name
, directory
);
635 buf
= (char *) alloca (SBYTES (directory
) + 20);
636 directory_file_name (SDATA (directory
), buf
);
637 return make_specified_string (buf
, -1, strlen (buf
),
638 STRING_MULTIBYTE (directory
));
641 static char make_temp_name_tbl
[64] =
643 'A','B','C','D','E','F','G','H',
644 'I','J','K','L','M','N','O','P',
645 'Q','R','S','T','U','V','W','X',
646 'Y','Z','a','b','c','d','e','f',
647 'g','h','i','j','k','l','m','n',
648 'o','p','q','r','s','t','u','v',
649 'w','x','y','z','0','1','2','3',
650 '4','5','6','7','8','9','-','_'
653 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
655 /* Value is a temporary file name starting with PREFIX, a string.
657 The Emacs process number forms part of the result, so there is
658 no danger of generating a name being used by another process.
659 In addition, this function makes an attempt to choose a name
660 which has no existing file. To make this work, PREFIX should be
661 an absolute file name.
663 BASE64_P non-zero means add the pid as 3 characters in base64
664 encoding. In this case, 6 characters will be added to PREFIX to
665 form the file name. Otherwise, if Emacs is running on a system
666 with long file names, add the pid as a decimal number.
668 This function signals an error if no unique file name could be
672 make_temp_name (prefix
, base64_p
)
679 unsigned char *p
, *data
;
683 CHECK_STRING (prefix
);
685 /* VAL is created by adding 6 characters to PREFIX. The first
686 three are the PID of this process, in base 64, and the second
687 three are incremented if the file already exists. This ensures
688 262144 unique file names per PID per PREFIX. */
690 pid
= (int) getpid ();
694 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
695 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
696 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
701 #ifdef HAVE_LONG_FILE_NAMES
702 sprintf (pidbuf
, "%d", pid
);
703 pidlen
= strlen (pidbuf
);
705 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
706 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
707 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
712 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
713 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
714 if (!STRING_MULTIBYTE (prefix
))
715 STRING_SET_UNIBYTE (val
);
717 bcopy(SDATA (prefix
), data
, len
);
720 bcopy (pidbuf
, p
, pidlen
);
723 /* Here we try to minimize useless stat'ing when this function is
724 invoked many times successively with the same PREFIX. We achieve
725 this by initializing count to a random value, and incrementing it
728 We don't want make-temp-name to be called while dumping,
729 because then make_temp_name_count_initialized_p would get set
730 and then make_temp_name_count would not be set when Emacs starts. */
732 if (!make_temp_name_count_initialized_p
)
734 make_temp_name_count
= (unsigned) time (NULL
);
735 make_temp_name_count_initialized_p
= 1;
741 unsigned num
= make_temp_name_count
;
743 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
744 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
745 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
747 /* Poor man's congruential RN generator. Replace with
748 ++make_temp_name_count for debugging. */
749 make_temp_name_count
+= 25229;
750 make_temp_name_count
%= 225307;
752 if (stat (data
, &ignored
) < 0)
754 /* We want to return only if errno is ENOENT. */
758 /* The error here is dubious, but there is little else we
759 can do. The alternatives are to return nil, which is
760 as bad as (and in many cases worse than) throwing the
761 error, or to ignore the error, which will likely result
762 in looping through 225307 stat's, which is not only
763 dog-slow, but also useless since it will fallback to
764 the errow below, anyway. */
765 report_file_error ("Cannot create temporary name for prefix",
766 Fcons (prefix
, Qnil
));
771 error ("Cannot create temporary name for prefix `%s'",
777 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
778 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
779 The Emacs process number forms part of the result,
780 so there is no danger of generating a name being used by another process.
782 In addition, this function makes an attempt to choose a name
783 which has no existing file. To make this work,
784 PREFIX should be an absolute file name.
786 There is a race condition between calling `make-temp-name' and creating the
787 file which opens all kinds of security holes. For that reason, you should
788 probably use `make-temp-file' instead, except in three circumstances:
790 * If you are creating the file in the user's home directory.
791 * If you are creating a directory rather than an ordinary file.
792 * If you are taking special precautions as `make-temp-file' does. */)
796 return make_temp_name (prefix
, 0);
801 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
802 doc
: /* Convert filename NAME to absolute, and canonicalize it.
803 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
804 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
805 the current buffer's value of `default-directory' is used.
806 File name components that are `.' are removed, and
807 so are file name components followed by `..', along with the `..' itself;
808 note that these simplifications are done without checking the resulting
809 file names in the file system.
810 An initial `~/' expands to your home directory.
811 An initial `~USER/' expands to USER's home directory.
812 See also the function `substitute-in-file-name'. */)
813 (name
, default_directory
)
814 Lisp_Object name
, default_directory
;
816 /* These point to SDATA and need to be careful with string-relocation
817 during GC (via DECODE_FILE). */
818 unsigned char *nm
, *newdir
;
820 /* This should only point to alloca'd data. */
821 unsigned char *target
;
827 int collapse_newdir
= 1;
831 Lisp_Object handler
, result
;
837 /* If the file name has special constructs in it,
838 call the corresponding file handler. */
839 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
841 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
843 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
844 if (NILP (default_directory
))
845 default_directory
= current_buffer
->directory
;
846 if (! STRINGP (default_directory
))
849 /* "/" is not considered a root directory on DOS_NT, so using "/"
850 here causes an infinite recursion in, e.g., the following:
852 (let (default-directory)
853 (expand-file-name "a"))
855 To avoid this, we set default_directory to the root of the
857 extern char *emacs_root_dir (void);
859 default_directory
= build_string (emacs_root_dir ());
861 default_directory
= build_string ("/");
865 if (!NILP (default_directory
))
867 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
869 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
873 unsigned char *o
= SDATA (default_directory
);
875 /* Make sure DEFAULT_DIRECTORY is properly expanded.
876 It would be better to do this down below where we actually use
877 default_directory. Unfortunately, calling Fexpand_file_name recursively
878 could invoke GC, and the strings might be relocated. This would
879 be annoying because we have pointers into strings lying around
880 that would need adjusting, and people would add new pointers to
881 the code and forget to adjust them, resulting in intermittent bugs.
882 Putting this call here avoids all that crud.
884 The EQ test avoids infinite recursion. */
885 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
886 /* Save time in some common cases - as long as default_directory
887 is not relative, it can be canonicalized with name below (if it
888 is needed at all) without requiring it to be expanded now. */
890 /* Detect MSDOS file names with drive specifiers. */
891 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
892 && IS_DIRECTORY_SEP (o
[2]))
894 /* Detect Windows file names in UNC format. */
895 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
897 #else /* not DOS_NT */
898 /* Detect Unix absolute file names (/... alone is not absolute on
900 && ! (IS_DIRECTORY_SEP (o
[0]))
901 #endif /* not DOS_NT */
907 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
911 name
= FILE_SYSTEM_CASE (name
);
912 multibyte
= STRING_MULTIBYTE (name
);
913 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
916 default_directory
= string_to_multibyte (default_directory
);
919 name
= string_to_multibyte (name
);
928 /* We will force directory separators to be either all \ or /, so make
929 a local copy to modify, even if there ends up being no change. */
930 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
933 /* Note if special escape prefix is present, but remove for now. */
934 if (nm
[0] == '/' && nm
[1] == ':')
940 /* Find and remove drive specifier if present; this makes nm absolute
941 even if the rest of the name appears to be relative. Only look for
942 drive specifier at the beginning. */
943 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
950 /* If we see "c://somedir", we want to strip the first slash after the
951 colon when stripping the drive letter. Otherwise, this expands to
953 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
956 /* Discard any previous drive specifier if nm is now in UNC format. */
957 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
961 #endif /* WINDOWSNT */
964 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
965 none are found, we can probably return right away. We will avoid
966 allocating a new string if name is already fully expanded. */
968 IS_DIRECTORY_SEP (nm
[0])
970 && drive
&& !is_escaped
973 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
977 /* If it turns out that the filename we want to return is just a
978 suffix of FILENAME, we don't need to go through and edit
979 things; we just need to construct a new string using data
980 starting at the middle of FILENAME. If we set lose to a
981 non-zero value, that means we've discovered that we can't do
984 unsigned char *p
= nm
;
988 /* Since we know the name is absolute, we can assume that each
989 element starts with a "/". */
991 /* "." and ".." are hairy. */
992 if (IS_DIRECTORY_SEP (p
[0])
994 && (IS_DIRECTORY_SEP (p
[2])
996 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
999 /* We want to replace multiple `/' in a row with a single
1002 && IS_DIRECTORY_SEP (p
[0])
1003 && IS_DIRECTORY_SEP (p
[1]))
1010 /* Make sure directories are all separated with / or \ as
1011 desired, but avoid allocation of a new string when not
1013 CORRECT_DIR_SEPS (nm
);
1015 if (IS_DIRECTORY_SEP (nm
[1]))
1017 if (strcmp (nm
, SDATA (name
)) != 0)
1018 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1022 /* drive must be set, so this is okay */
1023 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1027 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1028 temp
[0] = DRIVE_LETTER (drive
);
1029 name
= concat2 (build_string (temp
), name
);
1032 #else /* not DOS_NT */
1033 if (nm
== SDATA (name
))
1035 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1036 #endif /* not DOS_NT */
1040 /* At this point, nm might or might not be an absolute file name. We
1041 need to expand ~ or ~user if present, otherwise prefix nm with
1042 default_directory if nm is not absolute, and finally collapse /./
1043 and /foo/../ sequences.
1045 We set newdir to be the appropriate prefix if one is needed:
1046 - the relevant user directory if nm starts with ~ or ~user
1047 - the specified drive's working dir (DOS/NT only) if nm does not
1049 - the value of default_directory.
1051 Note that these prefixes are not guaranteed to be absolute (except
1052 for the working dir of a drive). Therefore, to ensure we always
1053 return an absolute name, if the final prefix is not absolute we
1054 append it to the current working directory. */
1058 if (nm
[0] == '~') /* prefix ~ */
1060 if (IS_DIRECTORY_SEP (nm
[1])
1061 || nm
[1] == 0) /* ~ by itself */
1065 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1066 newdir
= (unsigned char *) "";
1068 /* egetenv may return a unibyte string, which will bite us since
1069 we expect the directory to be multibyte. */
1070 tem
= build_string (newdir
);
1071 if (!STRING_MULTIBYTE (tem
))
1073 /* FIXME: DECODE_FILE may GC, which may move SDATA(name),
1074 after which `nm' won't point to the right place any more. */
1075 int offset
= nm
- SDATA (name
);
1076 hdir
= DECODE_FILE (tem
);
1077 newdir
= SDATA (hdir
);
1079 nm
= SDATA (name
) + offset
;
1082 collapse_newdir
= 0;
1085 else /* ~user/filename */
1087 unsigned char *o
, *p
;
1088 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)); p
++);
1089 o
= alloca (p
- nm
+ 1);
1090 bcopy ((char *) nm
, o
, p
- nm
);
1094 pw
= (struct passwd
*) getpwnam (o
+ 1);
1098 newdir
= (unsigned char *) pw
-> pw_dir
;
1101 collapse_newdir
= 0;
1105 /* If we don't find a user of that name, leave the name
1106 unchanged; don't move nm forward to p. */
1111 /* On DOS and Windows, nm is absolute if a drive name was specified;
1112 use the drive's current directory as the prefix if needed. */
1113 if (!newdir
&& drive
)
1115 /* Get default directory if needed to make nm absolute. */
1116 if (!IS_DIRECTORY_SEP (nm
[0]))
1118 newdir
= alloca (MAXPATHLEN
+ 1);
1119 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1124 /* Either nm starts with /, or drive isn't mounted. */
1125 newdir
= alloca (4);
1126 newdir
[0] = DRIVE_LETTER (drive
);
1134 /* Finally, if no prefix has been specified and nm is not absolute,
1135 then it must be expanded relative to default_directory. */
1139 /* /... alone is not absolute on DOS and Windows. */
1140 && !IS_DIRECTORY_SEP (nm
[0])
1143 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1147 newdir
= SDATA (default_directory
);
1149 /* Note if special escape prefix is present, but remove for now. */
1150 if (newdir
[0] == '/' && newdir
[1] == ':')
1161 /* First ensure newdir is an absolute name. */
1163 /* Detect MSDOS file names with drive specifiers. */
1164 ! (IS_DRIVE (newdir
[0])
1165 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1167 /* Detect Windows file names in UNC format. */
1168 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1172 /* Effectively, let newdir be (expand-file-name newdir cwd).
1173 Because of the admonition against calling expand-file-name
1174 when we have pointers into lisp strings, we accomplish this
1175 indirectly by prepending newdir to nm if necessary, and using
1176 cwd (or the wd of newdir's drive) as the new newdir. */
1178 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1183 if (!IS_DIRECTORY_SEP (nm
[0]))
1185 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1186 file_name_as_directory (tmp
, newdir
);
1190 newdir
= alloca (MAXPATHLEN
+ 1);
1193 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1200 /* Strip off drive name from prefix, if present. */
1201 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1207 /* Keep only a prefix from newdir if nm starts with slash
1208 (//server/share for UNC, nothing otherwise). */
1209 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1212 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1215 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1217 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1219 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1231 /* Get rid of any slash at the end of newdir, unless newdir is
1232 just / or // (an incomplete UNC name). */
1233 length
= strlen (newdir
);
1234 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1236 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1240 unsigned char *temp
= (unsigned char *) alloca (length
);
1241 bcopy (newdir
, temp
, length
- 1);
1242 temp
[length
- 1] = 0;
1250 /* Now concatenate the directory and name to new space in the stack frame */
1251 tlen
+= strlen (nm
) + 1;
1253 /* Reserve space for drive specifier and escape prefix, since either
1254 or both may need to be inserted. (The Microsoft x86 compiler
1255 produces incorrect code if the following two lines are combined.) */
1256 target
= (unsigned char *) alloca (tlen
+ 4);
1258 #else /* not DOS_NT */
1259 target
= (unsigned char *) alloca (tlen
);
1260 #endif /* not DOS_NT */
1265 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1268 /* If newdir is effectively "C:/", then the drive letter will have
1269 been stripped and newdir will be "/". Concatenating with an
1270 absolute directory in nm produces "//", which will then be
1271 incorrectly treated as a network share. Ignore newdir in
1272 this case (keeping the drive letter). */
1273 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1274 && newdir
[1] == '\0'))
1276 strcpy (target
, newdir
);
1279 file_name_as_directory (target
, newdir
);
1282 strcat (target
, nm
);
1284 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1287 unsigned char *p
= target
;
1288 unsigned char *o
= target
;
1292 if (!IS_DIRECTORY_SEP (*p
))
1296 else if (p
[1] == '.'
1297 && (IS_DIRECTORY_SEP (p
[2])
1300 /* If "/." is the entire filename, keep the "/". Otherwise,
1301 just delete the whole "/.". */
1302 if (o
== target
&& p
[2] == '\0')
1306 else if (p
[1] == '.' && p
[2] == '.'
1307 /* `/../' is the "superroot" on certain file systems.
1308 Turned off on DOS_NT systems because they have no
1309 "superroot" and because this causes us to produce
1310 file names like "d:/../foo" which fail file-related
1311 functions of the underlying OS. (To reproduce, try a
1312 long series of "../../" in default_directory, longer
1313 than the number of levels from the root.) */
1317 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1319 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1321 /* Keep initial / only if this is the whole name. */
1322 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1326 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1327 /* Collapse multiple `/' in a row. */
1336 /* At last, set drive name. */
1338 /* Except for network file name. */
1339 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1340 #endif /* WINDOWSNT */
1342 if (!drive
) abort ();
1344 target
[0] = DRIVE_LETTER (drive
);
1347 /* Reinsert the escape prefix if required. */
1354 CORRECT_DIR_SEPS (target
);
1357 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1360 /* Again look to see if the file name has special constructs in it
1361 and perhaps call the corresponding file handler. This is needed
1362 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1363 the ".." component gives us "/user@host:/bar/../baz" which needs
1364 to be expanded again. */
1365 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1366 if (!NILP (handler
))
1367 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1373 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1374 This is the old version of expand-file-name, before it was thoroughly
1375 rewritten for Emacs 10.31. We leave this version here commented-out,
1376 because the code is very complex and likely to have subtle bugs. If
1377 bugs _are_ found, it might be of interest to look at the old code and
1378 see what did it do in the relevant situation.
1380 Don't remove this code: it's true that it will be accessible via CVS,
1381 but a few years from deletion, people will forget it is there. */
1383 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1384 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1385 "Convert FILENAME to absolute, and canonicalize it.\n\
1386 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1387 \(does not start with slash); if DEFAULT is nil or missing,\n\
1388 the current buffer's value of default-directory is used.\n\
1389 Filenames containing `.' or `..' as components are simplified;\n\
1390 initial `~/' expands to your home directory.\n\
1391 See also the function `substitute-in-file-name'.")
1393 Lisp_Object name
, defalt
;
1397 register unsigned char *newdir
, *p
, *o
;
1399 unsigned char *target
;
1403 CHECK_STRING (name
);
1406 /* If nm is absolute, flush ...// and detect /./ and /../.
1407 If no /./ or /../ we can return right away. */
1414 if (p
[0] == '/' && p
[1] == '/'
1417 if (p
[0] == '/' && p
[1] == '~')
1418 nm
= p
+ 1, lose
= 1;
1419 if (p
[0] == '/' && p
[1] == '.'
1420 && (p
[2] == '/' || p
[2] == 0
1421 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1427 if (nm
== SDATA (name
))
1429 return build_string (nm
);
1433 /* Now determine directory to start with and put it in NEWDIR */
1437 if (nm
[0] == '~') /* prefix ~ */
1438 if (nm
[1] == '/' || nm
[1] == 0)/* ~/filename */
1440 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1441 newdir
= (unsigned char *) "";
1444 else /* ~user/filename */
1446 /* Get past ~ to user */
1447 unsigned char *user
= nm
+ 1;
1448 /* Find end of name. */
1449 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1450 int len
= ptr
? ptr
- user
: strlen (user
);
1451 /* Copy the user name into temp storage. */
1452 o
= (unsigned char *) alloca (len
+ 1);
1453 bcopy ((char *) user
, o
, len
);
1456 /* Look up the user name. */
1458 pw
= (struct passwd
*) getpwnam (o
+ 1);
1461 error ("\"%s\" isn't a registered user", o
+ 1);
1463 newdir
= (unsigned char *) pw
->pw_dir
;
1465 /* Discard the user name from NM. */
1469 if (nm
[0] != '/' && !newdir
)
1472 defalt
= current_buffer
->directory
;
1473 CHECK_STRING (defalt
);
1474 newdir
= SDATA (defalt
);
1477 /* Now concatenate the directory and name to new space in the stack frame */
1479 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1480 target
= (unsigned char *) alloca (tlen
);
1485 if (nm
[0] == 0 || nm
[0] == '/')
1486 strcpy (target
, newdir
);
1488 file_name_as_directory (target
, newdir
);
1491 strcat (target
, nm
);
1493 /* Now canonicalize by removing /. and /foo/.. if they appear */
1504 else if (!strncmp (p
, "//", 2)
1510 else if (p
[0] == '/' && p
[1] == '.'
1511 && (p
[2] == '/' || p
[2] == 0))
1513 else if (!strncmp (p
, "/..", 3)
1514 /* `/../' is the "superroot" on certain file systems. */
1516 && (p
[3] == '/' || p
[3] == 0))
1518 while (o
!= target
&& *--o
!= '/')
1520 if (o
== target
&& *o
== '/')
1530 return make_string (target
, o
- target
);
1534 /* If /~ or // appears, discard everything through first slash. */
1536 file_name_absolute_p (filename
)
1537 const unsigned char *filename
;
1540 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
1542 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
1543 && IS_DIRECTORY_SEP (filename
[2]))
1548 static unsigned char *
1549 search_embedded_absfilename (nm
, endp
)
1550 unsigned char *nm
, *endp
;
1552 unsigned char *p
, *s
;
1554 for (p
= nm
+ 1; p
< endp
; p
++)
1557 || IS_DIRECTORY_SEP (p
[-1]))
1558 && file_name_absolute_p (p
)
1559 #if defined (WINDOWSNT) || defined(CYGWIN)
1560 /* // at start of file name is meaningful in Apollo,
1561 WindowsNT and Cygwin systems. */
1562 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
1563 #endif /* not (WINDOWSNT || CYGWIN) */
1566 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)); s
++);
1567 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
1569 unsigned char *o
= alloca (s
- p
+ 1);
1571 bcopy (p
, o
, s
- p
);
1574 /* If we have ~user and `user' exists, discard
1575 everything up to ~. But if `user' does not exist, leave
1576 ~user alone, it might be a literal file name. */
1578 pw
= getpwnam (o
+ 1);
1590 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1591 Ssubstitute_in_file_name
, 1, 1, 0,
1592 doc
: /* Substitute environment variables referred to in FILENAME.
1593 `$FOO' where FOO is an environment variable name means to substitute
1594 the value of that variable. The variable name should be terminated
1595 with a character not a letter, digit or underscore; otherwise, enclose
1596 the entire variable name in braces.
1597 If `/~' appears, all of FILENAME through that `/' is discarded. */)
1599 Lisp_Object filename
;
1603 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1604 unsigned char *target
= NULL
;
1606 int substituted
= 0;
1608 Lisp_Object handler
;
1610 CHECK_STRING (filename
);
1612 /* If the file name has special constructs in it,
1613 call the corresponding file handler. */
1614 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1615 if (!NILP (handler
))
1616 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1618 nm
= SDATA (filename
);
1620 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1621 CORRECT_DIR_SEPS (nm
);
1622 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
1624 endp
= nm
+ SBYTES (filename
);
1626 /* If /~ or // appears, discard everything through first slash. */
1627 p
= search_embedded_absfilename (nm
, endp
);
1629 /* Start over with the new string, so we check the file-name-handler
1630 again. Important with filenames like "/home/foo//:/hello///there"
1631 which whould substitute to "/:/hello///there" rather than "/there". */
1632 return Fsubstitute_in_file_name
1633 (make_specified_string (p
, -1, endp
- p
,
1634 STRING_MULTIBYTE (filename
)));
1637 /* See if any variables are substituted into the string
1638 and find the total length of their values in `total' */
1640 for (p
= nm
; p
!= endp
;)
1650 /* "$$" means a single "$" */
1659 while (p
!= endp
&& *p
!= '}') p
++;
1660 if (*p
!= '}') goto missingclose
;
1666 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1670 /* Copy out the variable name */
1671 target
= (unsigned char *) alloca (s
- o
+ 1);
1672 strncpy (target
, o
, s
- o
);
1675 strupr (target
); /* $home == $HOME etc. */
1678 /* Get variable value */
1679 o
= (unsigned char *) egetenv (target
);
1681 { /* Eight-bit chars occupy upto 2 bytes in multibyte. */
1682 total
+= strlen (o
) * (STRING_MULTIBYTE (filename
) ? 2 : 1);
1692 /* If substitution required, recopy the string and do it */
1693 /* Make space in stack frame for the new copy */
1694 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
1697 /* Copy the rest of the name through, replacing $ constructs with values */
1714 while (p
!= endp
&& *p
!= '}') p
++;
1715 if (*p
!= '}') goto missingclose
;
1721 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1725 /* Copy out the variable name */
1726 target
= (unsigned char *) alloca (s
- o
+ 1);
1727 strncpy (target
, o
, s
- o
);
1730 strupr (target
); /* $home == $HOME etc. */
1733 /* Get variable value */
1734 o
= (unsigned char *) egetenv (target
);
1738 strcpy (x
, target
); x
+= strlen (target
);
1740 else if (STRING_MULTIBYTE (filename
))
1742 /* If the original string is multibyte,
1743 convert what we substitute into multibyte. */
1747 c
= unibyte_char_to_multibyte (c
);
1748 x
+= CHAR_STRING (c
, x
);
1760 /* If /~ or // appears, discard everything through first slash. */
1761 while ((p
= search_embedded_absfilename (xnm
, x
)))
1762 /* This time we do not start over because we've already expanded envvars
1763 and replaced $$ with $. Maybe we should start over as well, but we'd
1764 need to quote some $ to $$ first. */
1767 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
1770 error ("Bad format environment-variable substitution");
1772 error ("Missing \"}\" in environment-variable substitution");
1774 error ("Substituting nonexistent environment variable \"%s\"", target
);
1780 /* A slightly faster and more convenient way to get
1781 (directory-file-name (expand-file-name FOO)). */
1784 expand_and_dir_to_file (filename
, defdir
)
1785 Lisp_Object filename
, defdir
;
1787 register Lisp_Object absname
;
1789 absname
= Fexpand_file_name (filename
, defdir
);
1791 /* Remove final slash, if any (unless this is the root dir).
1792 stat behaves differently depending! */
1793 if (SCHARS (absname
) > 1
1794 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
1795 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
1796 /* We cannot take shortcuts; they might be wrong for magic file names. */
1797 absname
= Fdirectory_file_name (absname
);
1801 /* Signal an error if the file ABSNAME already exists.
1802 If INTERACTIVE is nonzero, ask the user whether to proceed,
1803 and bypass the error if the user says to go ahead.
1804 QUERYSTRING is a name for the action that is being considered
1807 *STATPTR is used to store the stat information if the file exists.
1808 If the file does not exist, STATPTR->st_mode is set to 0.
1809 If STATPTR is null, we don't store into it.
1811 If QUICK is nonzero, we ask for y or n, not yes or no. */
1814 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
1815 Lisp_Object absname
;
1816 unsigned char *querystring
;
1818 struct stat
*statptr
;
1821 register Lisp_Object tem
, encoded_filename
;
1822 struct stat statbuf
;
1823 struct gcpro gcpro1
;
1825 encoded_filename
= ENCODE_FILE (absname
);
1827 /* stat is a good way to tell whether the file exists,
1828 regardless of what access permissions it has. */
1829 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
1832 xsignal2 (Qfile_already_exists
,
1833 build_string ("File already exists"), absname
);
1835 tem
= format2 ("File %s already exists; %s anyway? ",
1836 absname
, build_string (querystring
));
1838 tem
= Fy_or_n_p (tem
);
1840 tem
= do_yes_or_no_p (tem
);
1843 xsignal2 (Qfile_already_exists
,
1844 build_string ("File already exists"), absname
);
1851 statptr
->st_mode
= 0;
1856 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
1857 "fCopy file: \nGCopy %s to file: \np\nP",
1858 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
1859 If NEWNAME names a directory, copy FILE there.
1861 This function always sets the file modes of the output file to match
1864 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1865 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1866 signal a `file-already-exists' error without overwriting. If
1867 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1868 about overwriting; this is what happens in interactive use with M-x.
1869 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1872 Fourth arg KEEP-TIME non-nil means give the output file the same
1873 last-modified time as the old one. (This works on only some systems.)
1875 A prefix arg makes KEEP-TIME non-nil.
1877 If PRESERVE-UID-GID is non-nil, we try to transfer the
1878 uid and gid of FILE to NEWNAME. */)
1879 (file
, newname
, ok_if_already_exists
, keep_time
, preserve_uid_gid
)
1880 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
1881 Lisp_Object preserve_uid_gid
;
1884 char buf
[16 * 1024];
1885 struct stat st
, out_st
;
1886 Lisp_Object handler
;
1887 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1888 int count
= SPECPDL_INDEX ();
1889 int input_file_statable_p
;
1890 Lisp_Object encoded_file
, encoded_newname
;
1892 encoded_file
= encoded_newname
= Qnil
;
1893 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
1894 CHECK_STRING (file
);
1895 CHECK_STRING (newname
);
1897 if (!NILP (Ffile_directory_p (newname
)))
1898 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
1900 newname
= Fexpand_file_name (newname
, Qnil
);
1902 file
= Fexpand_file_name (file
, Qnil
);
1904 /* If the input file name has special constructs in it,
1905 call the corresponding file handler. */
1906 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1907 /* Likewise for output file name. */
1909 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1910 if (!NILP (handler
))
1911 RETURN_UNGCPRO (call6 (handler
, Qcopy_file
, file
, newname
,
1912 ok_if_already_exists
, keep_time
, preserve_uid_gid
));
1914 encoded_file
= ENCODE_FILE (file
);
1915 encoded_newname
= ENCODE_FILE (newname
);
1917 if (NILP (ok_if_already_exists
)
1918 || INTEGERP (ok_if_already_exists
))
1919 barf_or_query_if_file_exists (newname
, "copy to it",
1920 INTEGERP (ok_if_already_exists
), &out_st
, 0);
1921 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
1925 if (!CopyFile (SDATA (encoded_file
),
1926 SDATA (encoded_newname
),
1928 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
1929 /* CopyFile retains the timestamp by default. */
1930 else if (NILP (keep_time
))
1936 EMACS_GET_TIME (now
);
1937 filename
= SDATA (encoded_newname
);
1939 /* Ensure file is writable while its modified time is set. */
1940 attributes
= GetFileAttributes (filename
);
1941 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
1942 if (set_file_times (filename
, now
, now
))
1944 /* Restore original attributes. */
1945 SetFileAttributes (filename
, attributes
);
1946 xsignal2 (Qfile_date_error
,
1947 build_string ("Cannot set file date"), newname
);
1949 /* Restore original attributes. */
1950 SetFileAttributes (filename
, attributes
);
1952 #else /* not WINDOWSNT */
1954 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
1958 report_file_error ("Opening input file", Fcons (file
, Qnil
));
1960 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1962 /* We can only copy regular files and symbolic links. Other files are not
1964 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1966 #if !defined (MSDOS) || __DJGPP__ > 1
1967 if (out_st
.st_mode
!= 0
1968 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
1971 report_file_error ("Input and output files are the same",
1972 Fcons (file
, Fcons (newname
, Qnil
)));
1976 #if defined (S_ISREG) && defined (S_ISLNK)
1977 if (input_file_statable_p
)
1979 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1981 #if defined (EISDIR)
1982 /* Get a better looking error message. */
1985 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
1988 #endif /* S_ISREG && S_ISLNK */
1991 /* System's default file type was set to binary by _fmode in emacs.c. */
1992 ofd
= emacs_open (SDATA (encoded_newname
),
1993 O_WRONLY
| O_TRUNC
| O_CREAT
1994 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
1995 S_IREAD
| S_IWRITE
);
1996 #else /* not MSDOS */
1997 ofd
= emacs_open (SDATA (encoded_newname
),
1998 O_WRONLY
| O_TRUNC
| O_CREAT
1999 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2001 #endif /* not MSDOS */
2003 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2005 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2009 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2010 if (emacs_write (ofd
, buf
, n
) != n
)
2011 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2015 /* Preserve the original file modes, and if requested, also its
2017 if (input_file_statable_p
)
2019 if (! NILP (preserve_uid_gid
))
2020 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2021 fchmod (ofd
, st
.st_mode
& 07777);
2023 #endif /* not MSDOS */
2025 /* Closing the output clobbers the file times on some systems. */
2026 if (emacs_close (ofd
) < 0)
2027 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2029 if (input_file_statable_p
)
2031 if (!NILP (keep_time
))
2033 EMACS_TIME atime
, mtime
;
2034 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2035 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2036 if (set_file_times (SDATA (encoded_newname
),
2038 xsignal2 (Qfile_date_error
,
2039 build_string ("Cannot set file date"), newname
);
2045 #if defined (__DJGPP__) && __DJGPP__ > 1
2046 if (input_file_statable_p
)
2048 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2049 and if it can't, it tells so. Otherwise, under MSDOS we usually
2050 get only the READ bit, which will make the copied file read-only,
2051 so it's better not to chmod at all. */
2052 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2053 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2055 #endif /* DJGPP version 2 or newer */
2056 #endif /* not WINDOWSNT */
2058 /* Discard the unwind protects. */
2059 specpdl_ptr
= specpdl
+ count
;
2065 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2066 Smake_directory_internal
, 1, 1, 0,
2067 doc
: /* Create a new directory named DIRECTORY. */)
2069 Lisp_Object directory
;
2071 const unsigned char *dir
;
2072 Lisp_Object handler
;
2073 Lisp_Object encoded_dir
;
2075 CHECK_STRING (directory
);
2076 directory
= Fexpand_file_name (directory
, Qnil
);
2078 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2079 if (!NILP (handler
))
2080 return call2 (handler
, Qmake_directory_internal
, directory
);
2082 encoded_dir
= ENCODE_FILE (directory
);
2084 dir
= SDATA (encoded_dir
);
2087 if (mkdir (dir
) != 0)
2089 if (mkdir (dir
, 0777) != 0)
2091 report_file_error ("Creating directory", list1 (directory
));
2096 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2097 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2099 Lisp_Object directory
;
2101 const unsigned char *dir
;
2102 Lisp_Object handler
;
2103 Lisp_Object encoded_dir
;
2105 CHECK_STRING (directory
);
2106 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2108 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2109 if (!NILP (handler
))
2110 return call2 (handler
, Qdelete_directory
, directory
);
2112 if (delete_by_moving_to_trash
)
2113 return call1 (Qmove_file_to_trash
, directory
);
2115 encoded_dir
= ENCODE_FILE (directory
);
2117 dir
= SDATA (encoded_dir
);
2119 if (rmdir (dir
) != 0)
2120 report_file_error ("Removing directory", list1 (directory
));
2125 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2126 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2127 If file has multiple names, it continues to exist with the other names. */)
2129 Lisp_Object filename
;
2131 Lisp_Object handler
;
2132 Lisp_Object encoded_file
;
2133 struct gcpro gcpro1
;
2136 if (!NILP (Ffile_directory_p (filename
))
2137 && NILP (Ffile_symlink_p (filename
)))
2138 xsignal2 (Qfile_error
,
2139 build_string ("Removing old name: is a directory"),
2142 filename
= Fexpand_file_name (filename
, Qnil
);
2144 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2145 if (!NILP (handler
))
2146 return call2 (handler
, Qdelete_file
, filename
);
2148 if (delete_by_moving_to_trash
)
2149 return call1 (Qmove_file_to_trash
, filename
);
2151 encoded_file
= ENCODE_FILE (filename
);
2153 if (0 > unlink (SDATA (encoded_file
)))
2154 report_file_error ("Removing old name", list1 (filename
));
2159 internal_delete_file_1 (ignore
)
2165 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2168 internal_delete_file (filename
)
2169 Lisp_Object filename
;
2172 tem
= internal_condition_case_1 (Fdelete_file
, filename
,
2173 Qt
, internal_delete_file_1
);
2177 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2178 "fRename file: \nGRename %s to file: \np",
2179 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2180 If file has names other than FILE, it continues to have those names.
2181 Signals a `file-already-exists' error if a file NEWNAME already exists
2182 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2183 A number as third arg means request confirmation if NEWNAME already exists.
2184 This is what happens in interactive use with M-x. */)
2185 (file
, newname
, ok_if_already_exists
)
2186 Lisp_Object file
, newname
, ok_if_already_exists
;
2188 Lisp_Object handler
;
2189 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2190 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2192 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2193 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2194 CHECK_STRING (file
);
2195 CHECK_STRING (newname
);
2196 file
= Fexpand_file_name (file
, Qnil
);
2198 if ((!NILP (Ffile_directory_p (newname
)))
2200 /* If the file names are identical but for the case,
2201 don't attempt to move directory to itself. */
2202 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2205 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2207 newname
= Fexpand_file_name (newname
, Qnil
);
2209 /* If the file name has special constructs in it,
2210 call the corresponding file handler. */
2211 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2213 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2214 if (!NILP (handler
))
2215 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2216 file
, newname
, ok_if_already_exists
));
2218 encoded_file
= ENCODE_FILE (file
);
2219 encoded_newname
= ENCODE_FILE (newname
);
2222 /* If the file names are identical but for the case, don't ask for
2223 confirmation: they simply want to change the letter-case of the
2225 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2227 if (NILP (ok_if_already_exists
)
2228 || INTEGERP (ok_if_already_exists
))
2229 barf_or_query_if_file_exists (newname
, "rename to it",
2230 INTEGERP (ok_if_already_exists
), 0, 0);
2231 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2236 symlink_target
= Ffile_symlink_p (file
);
2237 if (! NILP (symlink_target
))
2238 Fmake_symbolic_link (symlink_target
, newname
,
2239 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2242 Fcopy_file (file
, newname
,
2243 /* We have already prompted if it was an integer,
2244 so don't have copy-file prompt again. */
2245 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2248 Fdelete_file (file
);
2251 report_file_error ("Renaming", list2 (file
, newname
));
2257 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2258 "fAdd name to file: \nGName to add to %s: \np",
2259 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2260 Signals a `file-already-exists' error if a file NEWNAME already exists
2261 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2262 A number as third arg means request confirmation if NEWNAME already exists.
2263 This is what happens in interactive use with M-x. */)
2264 (file
, newname
, ok_if_already_exists
)
2265 Lisp_Object file
, newname
, ok_if_already_exists
;
2267 Lisp_Object handler
;
2268 Lisp_Object encoded_file
, encoded_newname
;
2269 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2271 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2272 encoded_file
= encoded_newname
= Qnil
;
2273 CHECK_STRING (file
);
2274 CHECK_STRING (newname
);
2275 file
= Fexpand_file_name (file
, Qnil
);
2277 if (!NILP (Ffile_directory_p (newname
)))
2278 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2280 newname
= Fexpand_file_name (newname
, Qnil
);
2282 /* If the file name has special constructs in it,
2283 call the corresponding file handler. */
2284 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2285 if (!NILP (handler
))
2286 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2287 newname
, ok_if_already_exists
));
2289 /* If the new name has special constructs in it,
2290 call the corresponding file handler. */
2291 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2292 if (!NILP (handler
))
2293 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2294 newname
, ok_if_already_exists
));
2296 encoded_file
= ENCODE_FILE (file
);
2297 encoded_newname
= ENCODE_FILE (newname
);
2299 if (NILP (ok_if_already_exists
)
2300 || INTEGERP (ok_if_already_exists
))
2301 barf_or_query_if_file_exists (newname
, "make it a new name",
2302 INTEGERP (ok_if_already_exists
), 0, 0);
2304 unlink (SDATA (newname
));
2305 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2306 report_file_error ("Adding new name", list2 (file
, newname
));
2312 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2313 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2314 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2315 Both args must be strings.
2316 Signals a `file-already-exists' error if a file LINKNAME already exists
2317 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2318 A number as third arg means request confirmation if LINKNAME already exists.
2319 This happens for interactive use with M-x. */)
2320 (filename
, linkname
, ok_if_already_exists
)
2321 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2323 Lisp_Object handler
;
2324 Lisp_Object encoded_filename
, encoded_linkname
;
2325 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2327 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2328 encoded_filename
= encoded_linkname
= Qnil
;
2329 CHECK_STRING (filename
);
2330 CHECK_STRING (linkname
);
2331 /* If the link target has a ~, we must expand it to get
2332 a truly valid file name. Otherwise, do not expand;
2333 we want to permit links to relative file names. */
2334 if (SREF (filename
, 0) == '~')
2335 filename
= Fexpand_file_name (filename
, Qnil
);
2337 if (!NILP (Ffile_directory_p (linkname
)))
2338 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2340 linkname
= Fexpand_file_name (linkname
, Qnil
);
2342 /* If the file name has special constructs in it,
2343 call the corresponding file handler. */
2344 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2345 if (!NILP (handler
))
2346 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2347 linkname
, ok_if_already_exists
));
2349 /* If the new link name has special constructs in it,
2350 call the corresponding file handler. */
2351 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2352 if (!NILP (handler
))
2353 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2354 linkname
, ok_if_already_exists
));
2357 encoded_filename
= ENCODE_FILE (filename
);
2358 encoded_linkname
= ENCODE_FILE (linkname
);
2360 if (NILP (ok_if_already_exists
)
2361 || INTEGERP (ok_if_already_exists
))
2362 barf_or_query_if_file_exists (linkname
, "make it a link",
2363 INTEGERP (ok_if_already_exists
), 0, 0);
2364 if (0 > symlink (SDATA (encoded_filename
),
2365 SDATA (encoded_linkname
)))
2367 /* If we didn't complain already, silently delete existing file. */
2368 if (errno
== EEXIST
)
2370 unlink (SDATA (encoded_linkname
));
2371 if (0 <= symlink (SDATA (encoded_filename
),
2372 SDATA (encoded_linkname
)))
2379 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2386 xsignal1 (Qfile_error
, build_string ("Symbolic links are not supported"));
2388 #endif /* S_IFLNK */
2392 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2394 doc
: /* Return t if file FILENAME specifies an absolute file name.
2395 On Unix, this is a name starting with a `/' or a `~'. */)
2397 Lisp_Object filename
;
2399 CHECK_STRING (filename
);
2400 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
2403 /* Return nonzero if file FILENAME exists and can be executed. */
2406 check_executable (filename
)
2410 int len
= strlen (filename
);
2413 if (stat (filename
, &st
) < 0)
2415 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2416 return ((st
.st_mode
& S_IEXEC
) != 0);
2418 return (S_ISREG (st
.st_mode
)
2420 && (xstrcasecmp ((suffix
= filename
+ len
-4), ".com") == 0
2421 || xstrcasecmp (suffix
, ".exe") == 0
2422 || xstrcasecmp (suffix
, ".bat") == 0)
2423 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2424 #endif /* not WINDOWSNT */
2425 #else /* not DOS_NT */
2426 #ifdef HAVE_EUIDACCESS
2427 return (euidaccess (filename
, 1) >= 0);
2429 /* Access isn't quite right because it uses the real uid
2430 and we really want to test with the effective uid.
2431 But Unix doesn't give us a right way to do it. */
2432 return (access (filename
, 1) >= 0);
2434 #endif /* not DOS_NT */
2437 /* Return nonzero if file FILENAME exists and can be written. */
2440 check_writable (filename
)
2445 if (stat (filename
, &st
) < 0)
2447 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2448 #else /* not MSDOS */
2449 #ifdef HAVE_EUIDACCESS
2450 return (euidaccess (filename
, 2) >= 0);
2452 /* Access isn't quite right because it uses the real uid
2453 and we really want to test with the effective uid.
2454 But Unix doesn't give us a right way to do it.
2455 Opening with O_WRONLY could work for an ordinary file,
2456 but would lose for directories. */
2457 return (access (filename
, 2) >= 0);
2459 #endif /* not MSDOS */
2462 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2463 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
2464 See also `file-readable-p' and `file-attributes'.
2465 This returns nil for a symlink to a nonexistent file.
2466 Use `file-symlink-p' to test for such links. */)
2468 Lisp_Object filename
;
2470 Lisp_Object absname
;
2471 Lisp_Object handler
;
2472 struct stat statbuf
;
2474 CHECK_STRING (filename
);
2475 absname
= Fexpand_file_name (filename
, Qnil
);
2477 /* If the file name has special constructs in it,
2478 call the corresponding file handler. */
2479 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2480 if (!NILP (handler
))
2481 return call2 (handler
, Qfile_exists_p
, absname
);
2483 absname
= ENCODE_FILE (absname
);
2485 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
2488 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2489 doc
: /* Return t if FILENAME can be executed by you.
2490 For a directory, this means you can access files in that directory. */)
2492 Lisp_Object filename
;
2494 Lisp_Object absname
;
2495 Lisp_Object handler
;
2497 CHECK_STRING (filename
);
2498 absname
= Fexpand_file_name (filename
, Qnil
);
2500 /* If the file name has special constructs in it,
2501 call the corresponding file handler. */
2502 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2503 if (!NILP (handler
))
2504 return call2 (handler
, Qfile_executable_p
, absname
);
2506 absname
= ENCODE_FILE (absname
);
2508 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
2511 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2512 doc
: /* Return t if file FILENAME exists and you can read it.
2513 See also `file-exists-p' and `file-attributes'. */)
2515 Lisp_Object filename
;
2517 Lisp_Object absname
;
2518 Lisp_Object handler
;
2521 struct stat statbuf
;
2523 CHECK_STRING (filename
);
2524 absname
= Fexpand_file_name (filename
, Qnil
);
2526 /* If the file name has special constructs in it,
2527 call the corresponding file handler. */
2528 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2529 if (!NILP (handler
))
2530 return call2 (handler
, Qfile_readable_p
, absname
);
2532 absname
= ENCODE_FILE (absname
);
2534 #if defined(DOS_NT) || defined(macintosh)
2535 /* Under MS-DOS, Windows, and Macintosh, open does not work for
2537 if (access (SDATA (absname
), 0) == 0)
2540 #else /* not DOS_NT and not macintosh */
2542 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2543 /* Opening a fifo without O_NONBLOCK can wait.
2544 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2545 except in the case of a fifo, on a system which handles it. */
2546 desc
= stat (SDATA (absname
), &statbuf
);
2549 if (S_ISFIFO (statbuf
.st_mode
))
2550 flags
|= O_NONBLOCK
;
2552 desc
= emacs_open (SDATA (absname
), flags
, 0);
2557 #endif /* not DOS_NT and not macintosh */
2560 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2562 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2563 doc
: /* Return t if file FILENAME can be written or created by you. */)
2565 Lisp_Object filename
;
2567 Lisp_Object absname
, dir
, encoded
;
2568 Lisp_Object handler
;
2569 struct stat statbuf
;
2571 CHECK_STRING (filename
);
2572 absname
= Fexpand_file_name (filename
, Qnil
);
2574 /* If the file name has special constructs in it,
2575 call the corresponding file handler. */
2576 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2577 if (!NILP (handler
))
2578 return call2 (handler
, Qfile_writable_p
, absname
);
2580 encoded
= ENCODE_FILE (absname
);
2581 if (stat (SDATA (encoded
), &statbuf
) >= 0)
2582 return (check_writable (SDATA (encoded
))
2585 dir
= Ffile_name_directory (absname
);
2588 dir
= Fdirectory_file_name (dir
);
2591 dir
= ENCODE_FILE (dir
);
2593 /* The read-only attribute of the parent directory doesn't affect
2594 whether a file or directory can be created within it. Some day we
2595 should check ACLs though, which do affect this. */
2596 if (stat (SDATA (dir
), &statbuf
) < 0)
2598 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2600 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
2605 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2606 doc
: /* Access file FILENAME, and get an error if that does not work.
2607 The second argument STRING is used in the error message.
2608 If there is no error, returns nil. */)
2610 Lisp_Object filename
, string
;
2612 Lisp_Object handler
, encoded_filename
, absname
;
2615 CHECK_STRING (filename
);
2616 absname
= Fexpand_file_name (filename
, Qnil
);
2618 CHECK_STRING (string
);
2620 /* If the file name has special constructs in it,
2621 call the corresponding file handler. */
2622 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
2623 if (!NILP (handler
))
2624 return call3 (handler
, Qaccess_file
, absname
, string
);
2626 encoded_filename
= ENCODE_FILE (absname
);
2628 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
2630 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
2636 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2637 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
2638 The value is the link target, as a string.
2639 Otherwise it returns nil.
2641 This function returns t when given the name of a symlink that
2642 points to a nonexistent file. */)
2644 Lisp_Object filename
;
2646 Lisp_Object handler
;
2648 CHECK_STRING (filename
);
2649 filename
= Fexpand_file_name (filename
, Qnil
);
2651 /* If the file name has special constructs in it,
2652 call the corresponding file handler. */
2653 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2654 if (!NILP (handler
))
2655 return call2 (handler
, Qfile_symlink_p
, filename
);
2664 filename
= ENCODE_FILE (filename
);
2671 buf
= (char *) xrealloc (buf
, bufsize
);
2672 bzero (buf
, bufsize
);
2675 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
2679 /* HP-UX reports ERANGE if buffer is too small. */
2680 if (errno
== ERANGE
)
2690 while (valsize
>= bufsize
);
2692 val
= make_string (buf
, valsize
);
2693 if (buf
[0] == '/' && index (buf
, ':'))
2694 val
= concat2 (build_string ("/:"), val
);
2696 val
= DECODE_FILE (val
);
2699 #else /* not S_IFLNK */
2701 #endif /* not S_IFLNK */
2704 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2705 doc
: /* Return t if FILENAME names an existing directory.
2706 Symbolic links to directories count as directories.
2707 See `file-symlink-p' to distinguish symlinks. */)
2709 Lisp_Object filename
;
2711 register Lisp_Object absname
;
2713 Lisp_Object handler
;
2715 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2717 /* If the file name has special constructs in it,
2718 call the corresponding file handler. */
2719 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2720 if (!NILP (handler
))
2721 return call2 (handler
, Qfile_directory_p
, absname
);
2723 absname
= ENCODE_FILE (absname
);
2725 if (stat (SDATA (absname
), &st
) < 0)
2727 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2730 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2731 doc
: /* Return t if file FILENAME names a directory you can open.
2732 For the value to be t, FILENAME must specify the name of a directory as a file,
2733 and the directory must allow you to open files in it. In order to use a
2734 directory as a buffer's current directory, this predicate must return true.
2735 A directory name spec may be given instead; then the value is t
2736 if the directory so specified exists and really is a readable and
2737 searchable directory. */)
2739 Lisp_Object filename
;
2741 Lisp_Object handler
;
2743 struct gcpro gcpro1
;
2745 /* If the file name has special constructs in it,
2746 call the corresponding file handler. */
2747 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2748 if (!NILP (handler
))
2749 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2752 tem
= (NILP (Ffile_directory_p (filename
))
2753 || NILP (Ffile_executable_p (filename
)));
2755 return tem
? Qnil
: Qt
;
2758 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2759 doc
: /* Return t if FILENAME names a regular file.
2760 This is the sort of file that holds an ordinary stream of data bytes.
2761 Symbolic links to regular files count as regular files.
2762 See `file-symlink-p' to distinguish symlinks. */)
2764 Lisp_Object filename
;
2766 register Lisp_Object absname
;
2768 Lisp_Object handler
;
2770 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2772 /* If the file name has special constructs in it,
2773 call the corresponding file handler. */
2774 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2775 if (!NILP (handler
))
2776 return call2 (handler
, Qfile_regular_p
, absname
);
2778 absname
= ENCODE_FILE (absname
);
2783 Lisp_Object tem
= Vw32_get_true_file_attributes
;
2785 /* Tell stat to use expensive method to get accurate info. */
2786 Vw32_get_true_file_attributes
= Qt
;
2787 result
= stat (SDATA (absname
), &st
);
2788 Vw32_get_true_file_attributes
= tem
;
2792 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2795 if (stat (SDATA (absname
), &st
) < 0)
2797 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2801 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2802 doc
: /* Return mode bits of file named FILENAME, as an integer.
2803 Return nil, if file does not exist or is not accessible. */)
2805 Lisp_Object filename
;
2807 Lisp_Object absname
;
2809 Lisp_Object handler
;
2811 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2813 /* If the file name has special constructs in it,
2814 call the corresponding file handler. */
2815 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2816 if (!NILP (handler
))
2817 return call2 (handler
, Qfile_modes
, absname
);
2819 absname
= ENCODE_FILE (absname
);
2821 if (stat (SDATA (absname
), &st
) < 0)
2823 #if defined (MSDOS) && __DJGPP__ < 2
2824 if (check_executable (SDATA (absname
)))
2825 st
.st_mode
|= S_IEXEC
;
2826 #endif /* MSDOS && __DJGPP__ < 2 */
2828 return make_number (st
.st_mode
& 07777);
2831 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
2832 "(let ((file (read-file-name \"File: \"))) \
2833 (list file (read-file-modes nil file)))",
2834 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
2835 Only the 12 low bits of MODE are used. */)
2837 Lisp_Object filename
, mode
;
2839 Lisp_Object absname
, encoded_absname
;
2840 Lisp_Object handler
;
2842 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2843 CHECK_NUMBER (mode
);
2845 /* If the file name has special constructs in it,
2846 call the corresponding file handler. */
2847 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2848 if (!NILP (handler
))
2849 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2851 encoded_absname
= ENCODE_FILE (absname
);
2853 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
2854 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2859 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2860 doc
: /* Set the file permission bits for newly created files.
2861 The argument MODE should be an integer; only the low 9 bits are used.
2862 This setting is inherited by subprocesses. */)
2866 CHECK_NUMBER (mode
);
2868 umask ((~ XINT (mode
)) & 0777);
2873 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2874 doc
: /* Return the default file protection for created files.
2875 The value is an integer. */)
2881 realmask
= umask (0);
2884 XSETINT (value
, (~ realmask
) & 0777);
2888 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
2890 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
2891 doc
: /* Set times of file FILENAME to TIME.
2892 Set both access and modification times.
2893 Return t on success, else nil.
2894 Use the current time if TIME is nil. TIME is in the format of
2897 Lisp_Object filename
, time
;
2899 Lisp_Object absname
, encoded_absname
;
2900 Lisp_Object handler
;
2904 if (! lisp_time_argument (time
, &sec
, &usec
))
2905 error ("Invalid time specification");
2907 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2909 /* If the file name has special constructs in it,
2910 call the corresponding file handler. */
2911 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
2912 if (!NILP (handler
))
2913 return call3 (handler
, Qset_file_times
, absname
, time
);
2915 encoded_absname
= ENCODE_FILE (absname
);
2920 EMACS_SET_SECS (t
, sec
);
2921 EMACS_SET_USECS (t
, usec
);
2923 if (set_file_times (SDATA (encoded_absname
), t
, t
))
2928 /* Setting times on a directory always fails. */
2929 if (stat (SDATA (encoded_absname
), &st
) == 0
2930 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
2933 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
2942 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2943 doc
: /* Tell Unix to finish all pending disk updates. */)
2950 #endif /* HAVE_SYNC */
2952 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2953 doc
: /* Return t if file FILE1 is newer than file FILE2.
2954 If FILE1 does not exist, the answer is nil;
2955 otherwise, if FILE2 does not exist, the answer is t. */)
2957 Lisp_Object file1
, file2
;
2959 Lisp_Object absname1
, absname2
;
2962 Lisp_Object handler
;
2963 struct gcpro gcpro1
, gcpro2
;
2965 CHECK_STRING (file1
);
2966 CHECK_STRING (file2
);
2969 GCPRO2 (absname1
, file2
);
2970 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2971 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2974 /* If the file name has special constructs in it,
2975 call the corresponding file handler. */
2976 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
2978 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
2979 if (!NILP (handler
))
2980 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
2982 GCPRO2 (absname1
, absname2
);
2983 absname1
= ENCODE_FILE (absname1
);
2984 absname2
= ENCODE_FILE (absname2
);
2987 if (stat (SDATA (absname1
), &st
) < 0)
2990 mtime1
= st
.st_mtime
;
2992 if (stat (SDATA (absname2
), &st
) < 0)
2995 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2999 Lisp_Object Qfind_buffer_file_type
;
3002 #ifndef READ_BUF_SIZE
3003 #define READ_BUF_SIZE (64 << 10)
3006 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3008 /* This function is called after Lisp functions to decide a coding
3009 system are called, or when they cause an error. Before they are
3010 called, the current buffer is set unibyte and it contains only a
3011 newly inserted text (thus the buffer was empty before the
3014 The functions may set markers, overlays, text properties, or even
3015 alter the buffer contents, change the current buffer.
3017 Here, we reset all those changes by:
3018 o set back the current buffer.
3019 o move all markers and overlays to BEG.
3020 o remove all text properties.
3021 o set back the buffer multibyteness. */
3024 decide_coding_unwind (unwind_data
)
3025 Lisp_Object unwind_data
;
3027 Lisp_Object multibyte
, undo_list
, buffer
;
3029 multibyte
= XCAR (unwind_data
);
3030 unwind_data
= XCDR (unwind_data
);
3031 undo_list
= XCAR (unwind_data
);
3032 buffer
= XCDR (unwind_data
);
3034 if (current_buffer
!= XBUFFER (buffer
))
3035 set_buffer_internal (XBUFFER (buffer
));
3036 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3037 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3038 BUF_INTERVALS (current_buffer
) = 0;
3039 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3041 /* Now we are safe to change the buffer's multibyteness directly. */
3042 current_buffer
->enable_multibyte_characters
= multibyte
;
3043 current_buffer
->undo_list
= undo_list
;
3049 /* Used to pass values from insert-file-contents to read_non_regular. */
3051 static int non_regular_fd
;
3052 static int non_regular_inserted
;
3053 static int non_regular_nbytes
;
3056 /* Read from a non-regular file.
3057 Read non_regular_trytry bytes max from non_regular_fd.
3058 Non_regular_inserted specifies where to put the read bytes.
3059 Value is the number of bytes read. */
3068 nbytes
= emacs_read (non_regular_fd
,
3069 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3070 non_regular_nbytes
);
3072 return make_number (nbytes
);
3076 /* Condition-case handler used when reading from non-regular files
3077 in insert-file-contents. */
3080 read_non_regular_quit ()
3086 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3088 doc
: /* Insert contents of file FILENAME after point.
3089 Returns list of absolute file name and number of characters inserted.
3090 If second argument VISIT is non-nil, the buffer's visited filename and
3091 last save file modtime are set, and it is marked unmodified. If
3092 visiting and the file does not exist, visiting is completed before the
3095 The optional third and fourth arguments BEG and END specify what portion
3096 of the file to insert. These arguments count bytes in the file, not
3097 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3099 If optional fifth argument REPLACE is non-nil, replace the current
3100 buffer contents (in the accessible portion) with the file contents.
3101 This is better than simply deleting and inserting the whole thing
3102 because (1) it preserves some marker positions and (2) it puts less data
3103 in the undo list. When REPLACE is non-nil, the second return value is
3104 the number of characters that replace previous buffer contents.
3106 This function does code conversion according to the value of
3107 `coding-system-for-read' or `file-coding-system-alist', and sets the
3108 variable `last-coding-system-used' to the coding system actually used. */)
3109 (filename
, visit
, beg
, end
, replace
)
3110 Lisp_Object filename
, visit
, beg
, end
, replace
;
3116 register int how_much
;
3117 register int unprocessed
;
3118 int count
= SPECPDL_INDEX ();
3119 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3120 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3123 int not_regular
= 0;
3124 unsigned char read_buf
[READ_BUF_SIZE
];
3125 struct coding_system coding
;
3126 unsigned char buffer
[1 << 14];
3127 int replace_handled
= 0;
3128 int set_coding_system
= 0;
3129 Lisp_Object coding_system
;
3131 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3132 int we_locked_file
= 0;
3134 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3135 error ("Cannot do file visiting in an indirect buffer");
3137 if (!NILP (current_buffer
->read_only
))
3138 Fbarf_if_buffer_read_only ();
3142 orig_filename
= Qnil
;
3145 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3147 CHECK_STRING (filename
);
3148 filename
= Fexpand_file_name (filename
, Qnil
);
3150 /* The value Qnil means that the coding system is not yet
3152 coding_system
= Qnil
;
3154 /* If the file name has special constructs in it,
3155 call the corresponding file handler. */
3156 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3157 if (!NILP (handler
))
3159 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3160 visit
, beg
, end
, replace
);
3161 if (CONSP (val
) && CONSP (XCDR (val
)))
3162 inserted
= XINT (XCAR (XCDR (val
)));
3166 orig_filename
= filename
;
3167 filename
= ENCODE_FILE (filename
);
3173 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3175 /* Tell stat to use expensive method to get accurate info. */
3176 Vw32_get_true_file_attributes
= Qt
;
3177 total
= stat (SDATA (filename
), &st
);
3178 Vw32_get_true_file_attributes
= tem
;
3182 if (stat (SDATA (filename
), &st
) < 0)
3183 #endif /* WINDOWSNT */
3185 if (fd
>= 0) emacs_close (fd
);
3188 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3191 if (!NILP (Vcoding_system_for_read
))
3192 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3197 /* This code will need to be changed in order to work on named
3198 pipes, and it's probably just not worth it. So we should at
3199 least signal an error. */
3200 if (!S_ISREG (st
.st_mode
))
3207 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3208 xsignal2 (Qfile_error
,
3209 build_string ("not a regular file"), orig_filename
);
3214 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3217 /* Replacement should preserve point as it preserves markers. */
3218 if (!NILP (replace
))
3219 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3221 record_unwind_protect (close_file_unwind
, make_number (fd
));
3223 /* Can happen on any platform that uses long as type of off_t, but allows
3224 file sizes to exceed 2Gb, so give a suitable message. */
3225 if (! not_regular
&& st
.st_size
< 0)
3226 error ("Maximum buffer size exceeded");
3228 /* Prevent redisplay optimizations. */
3229 current_buffer
->clip_changed
= 1;
3233 if (!NILP (beg
) || !NILP (end
))
3234 error ("Attempt to visit less than an entire file");
3235 if (BEG
< Z
&& NILP (replace
))
3236 error ("Cannot do file visiting in a non-empty buffer");
3242 XSETFASTINT (beg
, 0);
3250 XSETINT (end
, st
.st_size
);
3252 /* Arithmetic overflow can occur if an Emacs integer cannot
3253 represent the file size, or if the calculations below
3254 overflow. The calculations below double the file size
3255 twice, so check that it can be multiplied by 4 safely. */
3256 if (XINT (end
) != st
.st_size
3257 || st
.st_size
> INT_MAX
/ 4)
3258 error ("Maximum buffer size exceeded");
3260 /* The file size returned from stat may be zero, but data
3261 may be readable nonetheless, for example when this is a
3262 file in the /proc filesystem. */
3263 if (st
.st_size
== 0)
3264 XSETINT (end
, READ_BUF_SIZE
);
3268 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3270 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3271 setup_coding_system (coding_system
, &coding
);
3272 /* Ensure we set Vlast_coding_system_used. */
3273 set_coding_system
= 1;
3277 /* Decide the coding system to use for reading the file now
3278 because we can't use an optimized method for handling
3279 `coding:' tag if the current buffer is not empty. */
3280 if (!NILP (Vcoding_system_for_read
))
3281 coding_system
= Vcoding_system_for_read
;
3284 /* Don't try looking inside a file for a coding system
3285 specification if it is not seekable. */
3286 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3288 /* Find a coding system specified in the heading two
3289 lines or in the tailing several lines of the file.
3290 We assume that the 1K-byte and 3K-byte for heading
3291 and tailing respectively are sufficient for this
3295 if (st
.st_size
<= (1024 * 4))
3296 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3299 nread
= emacs_read (fd
, read_buf
, 1024);
3302 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3303 report_file_error ("Setting file position",
3304 Fcons (orig_filename
, Qnil
));
3305 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3310 error ("IO error reading %s: %s",
3311 SDATA (orig_filename
), emacs_strerror (errno
));
3314 struct buffer
*prev
= current_buffer
;
3318 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3320 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3321 buf
= XBUFFER (buffer
);
3323 delete_all_overlays (buf
);
3324 buf
->directory
= current_buffer
->directory
;
3325 buf
->read_only
= Qnil
;
3326 buf
->filename
= Qnil
;
3327 buf
->undo_list
= Qt
;
3328 eassert (buf
->overlays_before
== NULL
);
3329 eassert (buf
->overlays_after
== NULL
);
3331 set_buffer_internal (buf
);
3333 buf
->enable_multibyte_characters
= Qnil
;
3335 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3336 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3337 coding_system
= call2 (Vset_auto_coding_function
,
3338 filename
, make_number (nread
));
3339 set_buffer_internal (prev
);
3341 /* Discard the unwind protect for recovering the
3345 /* Rewind the file for the actual read done later. */
3346 if (lseek (fd
, 0, 0) < 0)
3347 report_file_error ("Setting file position",
3348 Fcons (orig_filename
, Qnil
));
3352 if (NILP (coding_system
))
3354 /* If we have not yet decided a coding system, check
3355 file-coding-system-alist. */
3356 Lisp_Object args
[6];
3358 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3359 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3360 coding_system
= Ffind_operation_coding_system (6, args
);
3361 if (CONSP (coding_system
))
3362 coding_system
= XCAR (coding_system
);
3366 if (NILP (coding_system
))
3367 coding_system
= Qundecided
;
3369 CHECK_CODING_SYSTEM (coding_system
);
3371 if (NILP (current_buffer
->enable_multibyte_characters
))
3372 /* We must suppress all character code conversion except for
3373 end-of-line conversion. */
3374 coding_system
= raw_text_coding_system (coding_system
);
3376 setup_coding_system (coding_system
, &coding
);
3377 /* Ensure we set Vlast_coding_system_used. */
3378 set_coding_system
= 1;
3381 /* If requested, replace the accessible part of the buffer
3382 with the file contents. Avoid replacing text at the
3383 beginning or end of the buffer that matches the file contents;
3384 that preserves markers pointing to the unchanged parts.
3386 Here we implement this feature in an optimized way
3387 for the case where code conversion is NOT needed.
3388 The following if-statement handles the case of conversion
3389 in a less optimal way.
3391 If the code conversion is "automatic" then we try using this
3392 method and hope for the best.
3393 But if we discover the need for conversion, we give up on this method
3394 and let the following if-statement handle the replace job. */
3397 && (NILP (coding_system
)
3398 || ! CODING_REQUIRE_DECODING (&coding
)))
3400 /* same_at_start and same_at_end count bytes,
3401 because file access counts bytes
3402 and BEG and END count bytes. */
3403 int same_at_start
= BEGV_BYTE
;
3404 int same_at_end
= ZV_BYTE
;
3406 /* There is still a possibility we will find the need to do code
3407 conversion. If that happens, we set this variable to 1 to
3408 give up on handling REPLACE in the optimized way. */
3409 int giveup_match_end
= 0;
3411 if (XINT (beg
) != 0)
3413 if (lseek (fd
, XINT (beg
), 0) < 0)
3414 report_file_error ("Setting file position",
3415 Fcons (orig_filename
, Qnil
));
3420 /* Count how many chars at the start of the file
3421 match the text at the beginning of the buffer. */
3426 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3428 error ("IO error reading %s: %s",
3429 SDATA (orig_filename
), emacs_strerror (errno
));
3430 else if (nread
== 0)
3433 if (CODING_REQUIRE_DETECTION (&coding
))
3435 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
3437 setup_coding_system (coding_system
, &coding
);
3440 if (CODING_REQUIRE_DECODING (&coding
))
3441 /* We found that the file should be decoded somehow.
3442 Let's give up here. */
3444 giveup_match_end
= 1;
3449 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3450 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3451 same_at_start
++, bufpos
++;
3452 /* If we found a discrepancy, stop the scan.
3453 Otherwise loop around and scan the next bufferful. */
3454 if (bufpos
!= nread
)
3458 /* If the file matches the buffer completely,
3459 there's no need to replace anything. */
3460 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3464 /* Truncate the buffer to the size of the file. */
3465 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3470 /* Count how many chars at the end of the file
3471 match the text at the end of the buffer. But, if we have
3472 already found that decoding is necessary, don't waste time. */
3473 while (!giveup_match_end
)
3475 int total_read
, nread
, bufpos
, curpos
, trial
;
3477 /* At what file position are we now scanning? */
3478 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3479 /* If the entire file matches the buffer tail, stop the scan. */
3482 /* How much can we scan in the next step? */
3483 trial
= min (curpos
, sizeof buffer
);
3484 if (lseek (fd
, curpos
- trial
, 0) < 0)
3485 report_file_error ("Setting file position",
3486 Fcons (orig_filename
, Qnil
));
3488 total_read
= nread
= 0;
3489 while (total_read
< trial
)
3491 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3493 error ("IO error reading %s: %s",
3494 SDATA (orig_filename
), emacs_strerror (errno
));
3495 else if (nread
== 0)
3497 total_read
+= nread
;
3500 /* Scan this bufferful from the end, comparing with
3501 the Emacs buffer. */
3502 bufpos
= total_read
;
3504 /* Compare with same_at_start to avoid counting some buffer text
3505 as matching both at the file's beginning and at the end. */
3506 while (bufpos
> 0 && same_at_end
> same_at_start
3507 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3508 same_at_end
--, bufpos
--;
3510 /* If we found a discrepancy, stop the scan.
3511 Otherwise loop around and scan the preceding bufferful. */
3514 /* If this discrepancy is because of code conversion,
3515 we cannot use this method; giveup and try the other. */
3516 if (same_at_end
> same_at_start
3517 && FETCH_BYTE (same_at_end
- 1) >= 0200
3518 && ! NILP (current_buffer
->enable_multibyte_characters
)
3519 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3520 giveup_match_end
= 1;
3529 if (! giveup_match_end
)
3533 /* We win! We can handle REPLACE the optimized way. */
3535 /* Extend the start of non-matching text area to multibyte
3536 character boundary. */
3537 if (! NILP (current_buffer
->enable_multibyte_characters
))
3538 while (same_at_start
> BEGV_BYTE
3539 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3542 /* Extend the end of non-matching text area to multibyte
3543 character boundary. */
3544 if (! NILP (current_buffer
->enable_multibyte_characters
))
3545 while (same_at_end
< ZV_BYTE
3546 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3549 /* Don't try to reuse the same piece of text twice. */
3550 overlap
= (same_at_start
- BEGV_BYTE
3551 - (same_at_end
+ st
.st_size
- ZV
));
3553 same_at_end
+= overlap
;
3555 /* Arrange to read only the nonmatching middle part of the file. */
3556 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3557 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3559 del_range_byte (same_at_start
, same_at_end
, 0);
3560 /* Insert from the file at the proper position. */
3561 temp
= BYTE_TO_CHAR (same_at_start
);
3562 SET_PT_BOTH (temp
, same_at_start
);
3564 /* If display currently starts at beginning of line,
3565 keep it that way. */
3566 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3567 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3569 replace_handled
= 1;
3573 /* If requested, replace the accessible part of the buffer
3574 with the file contents. Avoid replacing text at the
3575 beginning or end of the buffer that matches the file contents;
3576 that preserves markers pointing to the unchanged parts.
3578 Here we implement this feature for the case where code conversion
3579 is needed, in a simple way that needs a lot of memory.
3580 The preceding if-statement handles the case of no conversion
3581 in a more optimized way. */
3582 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3584 EMACS_INT same_at_start
= BEGV_BYTE
;
3585 EMACS_INT same_at_end
= ZV_BYTE
;
3586 EMACS_INT same_at_start_charpos
;
3587 EMACS_INT inserted_chars
;
3590 unsigned char *decoded
;
3592 int this_count
= SPECPDL_INDEX ();
3593 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3594 Lisp_Object conversion_buffer
;
3596 conversion_buffer
= code_conversion_save (1, multibyte
);
3598 /* First read the whole file, performing code conversion into
3599 CONVERSION_BUFFER. */
3601 if (lseek (fd
, XINT (beg
), 0) < 0)
3602 report_file_error ("Setting file position",
3603 Fcons (orig_filename
, Qnil
));
3605 total
= st
.st_size
; /* Total bytes in the file. */
3606 how_much
= 0; /* Bytes read from file so far. */
3607 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3608 unprocessed
= 0; /* Bytes not processed in previous loop. */
3610 GCPRO1 (conversion_buffer
);
3611 while (how_much
< total
)
3613 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
3614 quitting while reading a huge while. */
3615 /* try is reserved in some compilers (Microsoft C) */
3616 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3619 /* Allow quitting out of the actual I/O. */
3622 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
3634 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
3635 BUF_Z (XBUFFER (conversion_buffer
)));
3636 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
3638 unprocessed
= coding
.carryover_bytes
;
3639 if (coding
.carryover_bytes
> 0)
3640 bcopy (coding
.carryover
, read_buf
, unprocessed
);
3645 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
3646 if we couldn't read the file. */
3649 error ("IO error reading %s: %s",
3650 SDATA (orig_filename
), emacs_strerror (errno
));
3652 if (unprocessed
> 0)
3654 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3655 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
3657 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
3660 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
3661 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
3662 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3664 /* Compare the beginning of the converted string with the buffer
3668 while (bufpos
< inserted
&& same_at_start
< same_at_end
3669 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
3670 same_at_start
++, bufpos
++;
3672 /* If the file matches the head of buffer completely,
3673 there's no need to replace anything. */
3675 if (bufpos
== inserted
)
3678 /* Truncate the buffer to the size of the file. */
3679 if (same_at_start
== same_at_end
)
3682 del_range_byte (same_at_start
, same_at_end
, 0);
3685 unbind_to (this_count
, Qnil
);
3689 /* Extend the start of non-matching text area to the previous
3690 multibyte character boundary. */
3691 if (! NILP (current_buffer
->enable_multibyte_characters
))
3692 while (same_at_start
> BEGV_BYTE
3693 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3696 /* Scan this bufferful from the end, comparing with
3697 the Emacs buffer. */
3700 /* Compare with same_at_start to avoid counting some buffer text
3701 as matching both at the file's beginning and at the end. */
3702 while (bufpos
> 0 && same_at_end
> same_at_start
3703 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
3704 same_at_end
--, bufpos
--;
3706 /* Extend the end of non-matching text area to the next
3707 multibyte character boundary. */
3708 if (! NILP (current_buffer
->enable_multibyte_characters
))
3709 while (same_at_end
< ZV_BYTE
3710 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3713 /* Don't try to reuse the same piece of text twice. */
3714 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3716 same_at_end
+= overlap
;
3718 /* If display currently starts at beginning of line,
3719 keep it that way. */
3720 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3721 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3723 /* Replace the chars that we need to replace,
3724 and update INSERTED to equal the number of bytes
3725 we are taking from the decoded string. */
3726 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
3728 if (same_at_end
!= same_at_start
)
3730 del_range_byte (same_at_start
, same_at_end
, 0);
3732 same_at_start
= GPT_BYTE
;
3736 temp
= BYTE_TO_CHAR (same_at_start
);
3738 /* Insert from the file at the proper position. */
3739 SET_PT_BOTH (temp
, same_at_start
);
3740 same_at_start_charpos
3741 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3742 same_at_start
- BEGV_BYTE
3743 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3745 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3746 same_at_start
+ inserted
- BEGV_BYTE
3747 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
3748 - same_at_start_charpos
);
3749 /* This binding is to avoid ask-user-about-supersession-threat
3750 being called in insert_from_buffer (via in
3751 prepare_to_modify_buffer). */
3752 specbind (intern ("buffer-file-name"), Qnil
);
3753 insert_from_buffer (XBUFFER (conversion_buffer
),
3754 same_at_start_charpos
, inserted_chars
, 0);
3755 /* Set `inserted' to the number of inserted characters. */
3756 inserted
= PT
- temp
;
3757 /* Set point before the inserted characters. */
3758 SET_PT_BOTH (temp
, same_at_start
);
3760 unbind_to (this_count
, Qnil
);
3767 register Lisp_Object temp
;
3769 total
= XINT (end
) - XINT (beg
);
3771 /* Make sure point-max won't overflow after this insertion. */
3772 XSETINT (temp
, total
);
3773 if (total
!= XINT (temp
))
3774 error ("Maximum buffer size exceeded");
3777 /* For a special file, all we can do is guess. */
3778 total
= READ_BUF_SIZE
;
3780 if (NILP (visit
) && inserted
> 0)
3782 #ifdef CLASH_DETECTION
3783 if (!NILP (current_buffer
->file_truename
)
3784 /* Make binding buffer-file-name to nil effective. */
3785 && !NILP (current_buffer
->filename
)
3786 && SAVE_MODIFF
>= MODIFF
)
3788 #endif /* CLASH_DETECTION */
3789 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
3793 if (GAP_SIZE
< total
)
3794 make_gap (total
- GAP_SIZE
);
3796 if (XINT (beg
) != 0 || !NILP (replace
))
3798 if (lseek (fd
, XINT (beg
), 0) < 0)
3799 report_file_error ("Setting file position",
3800 Fcons (orig_filename
, Qnil
));
3803 /* In the following loop, HOW_MUCH contains the total bytes read so
3804 far for a regular file, and not changed for a special file. But,
3805 before exiting the loop, it is set to a negative value if I/O
3809 /* Total bytes inserted. */
3812 /* Here, we don't do code conversion in the loop. It is done by
3813 decode_coding_gap after all data are read into the buffer. */
3815 int gap_size
= GAP_SIZE
;
3817 while (how_much
< total
)
3819 /* try is reserved in some compilers (Microsoft C) */
3820 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3827 /* Maybe make more room. */
3828 if (gap_size
< trytry
)
3830 make_gap (total
- gap_size
);
3831 gap_size
= GAP_SIZE
;
3834 /* Read from the file, capturing `quit'. When an
3835 error occurs, end the loop, and arrange for a quit
3836 to be signaled after decoding the text we read. */
3837 non_regular_fd
= fd
;
3838 non_regular_inserted
= inserted
;
3839 non_regular_nbytes
= trytry
;
3840 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
3841 read_non_regular_quit
);
3852 /* Allow quitting out of the actual I/O. We don't make text
3853 part of the buffer until all the reading is done, so a C-g
3854 here doesn't do any harm. */
3857 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
3869 /* For a regular file, where TOTAL is the real size,
3870 count HOW_MUCH to compare with it.
3871 For a special file, where TOTAL is just a buffer size,
3872 so don't bother counting in HOW_MUCH.
3873 (INSERTED is where we count the number of characters inserted.) */
3880 /* Now we have read all the file data into the gap.
3881 If it was empty, undo marking the buffer modified. */
3885 #ifdef CLASH_DETECTION
3887 unlock_file (current_buffer
->file_truename
);
3889 Vdeactivate_mark
= old_Vdeactivate_mark
;
3892 Vdeactivate_mark
= Qt
;
3894 /* Make the text read part of the buffer. */
3895 GAP_SIZE
-= inserted
;
3897 GPT_BYTE
+= inserted
;
3899 ZV_BYTE
+= inserted
;
3904 /* Put an anchor to ensure multi-byte form ends at gap. */
3909 /* Discard the unwind protect for closing the file. */
3913 error ("IO error reading %s: %s",
3914 SDATA (orig_filename
), emacs_strerror (errno
));
3918 if (NILP (coding_system
))
3920 /* The coding system is not yet decided. Decide it by an
3921 optimized method for handling `coding:' tag.
3923 Note that we can get here only if the buffer was empty
3924 before the insertion. */
3926 if (!NILP (Vcoding_system_for_read
))
3927 coding_system
= Vcoding_system_for_read
;
3930 /* Since we are sure that the current buffer was empty
3931 before the insertion, we can toggle
3932 enable-multibyte-characters directly here without taking
3933 care of marker adjustment. By this way, we can run Lisp
3934 program safely before decoding the inserted text. */
3935 Lisp_Object unwind_data
;
3936 int count
= SPECPDL_INDEX ();
3938 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
3939 Fcons (current_buffer
->undo_list
,
3940 Fcurrent_buffer ()));
3941 current_buffer
->enable_multibyte_characters
= Qnil
;
3942 current_buffer
->undo_list
= Qt
;
3943 record_unwind_protect (decide_coding_unwind
, unwind_data
);
3945 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
3947 coding_system
= call2 (Vset_auto_coding_function
,
3948 filename
, make_number (inserted
));
3951 if (NILP (coding_system
))
3953 /* If the coding system is not yet decided, check
3954 file-coding-system-alist. */
3955 Lisp_Object args
[6];
3957 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3958 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
3959 coding_system
= Ffind_operation_coding_system (6, args
);
3960 if (CONSP (coding_system
))
3961 coding_system
= XCAR (coding_system
);
3963 unbind_to (count
, Qnil
);
3964 inserted
= Z_BYTE
- BEG_BYTE
;
3967 if (NILP (coding_system
))
3968 coding_system
= Qundecided
;
3970 CHECK_CODING_SYSTEM (coding_system
);
3972 if (NILP (current_buffer
->enable_multibyte_characters
))
3973 /* We must suppress all character code conversion except for
3974 end-of-line conversion. */
3975 coding_system
= raw_text_coding_system (coding_system
);
3976 setup_coding_system (coding_system
, &coding
);
3977 /* Ensure we set Vlast_coding_system_used. */
3978 set_coding_system
= 1;
3983 /* When we visit a file by raw-text, we change the buffer to
3985 if (CODING_FOR_UNIBYTE (&coding
)
3986 /* Can't do this if part of the buffer might be preserved. */
3988 /* Visiting a file with these coding system makes the buffer
3990 current_buffer
->enable_multibyte_characters
= Qnil
;
3993 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3994 if (CODING_MAY_REQUIRE_DECODING (&coding
)
3995 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
3997 move_gap_both (PT
, PT_BYTE
);
3998 GAP_SIZE
+= inserted
;
3999 ZV_BYTE
-= inserted
;
4003 decode_coding_gap (&coding
, inserted
, inserted
);
4004 inserted
= coding
.produced_char
;
4005 coding_system
= CODING_ID_NAME (coding
.id
);
4007 else if (inserted
> 0)
4008 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4011 /* Now INSERTED is measured in characters. */
4014 /* Use the conversion type to determine buffer-file-type
4015 (find-buffer-file-type is now used to help determine the
4017 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4018 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4019 && ! CODING_REQUIRE_DECODING (&coding
))
4020 current_buffer
->buffer_file_type
= Qt
;
4022 current_buffer
->buffer_file_type
= Qnil
;
4029 if (!EQ (current_buffer
->undo_list
, Qt
) && !nochange
)
4030 current_buffer
->undo_list
= Qnil
;
4034 current_buffer
->modtime
= st
.st_mtime
;
4035 current_buffer
->filename
= orig_filename
;
4038 SAVE_MODIFF
= MODIFF
;
4039 current_buffer
->auto_save_modified
= MODIFF
;
4040 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4041 #ifdef CLASH_DETECTION
4044 if (!NILP (current_buffer
->file_truename
))
4045 unlock_file (current_buffer
->file_truename
);
4046 unlock_file (filename
);
4048 #endif /* CLASH_DETECTION */
4050 xsignal2 (Qfile_error
,
4051 build_string ("not a regular file"), orig_filename
);
4054 if (set_coding_system
)
4055 Vlast_coding_system_used
= coding_system
;
4057 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4059 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4061 if (! NILP (insval
))
4063 CHECK_NUMBER (insval
);
4064 inserted
= XFASTINT (insval
);
4068 /* Decode file format. */
4071 /* Don't run point motion or modification hooks when decoding. */
4072 int count
= SPECPDL_INDEX ();
4073 int old_inserted
= inserted
;
4074 specbind (Qinhibit_point_motion_hooks
, Qt
);
4075 specbind (Qinhibit_modification_hooks
, Qt
);
4077 /* Save old undo list and don't record undo for decoding. */
4078 old_undo
= current_buffer
->undo_list
;
4079 current_buffer
->undo_list
= Qt
;
4083 insval
= call3 (Qformat_decode
,
4084 Qnil
, make_number (inserted
), visit
);
4085 CHECK_NUMBER (insval
);
4086 inserted
= XFASTINT (insval
);
4090 /* If REPLACE is non-nil and we succeeded in not replacing the
4091 beginning or end of the buffer text with the file's contents,
4092 call format-decode with `point' positioned at the beginning
4093 of the buffer and `inserted' equalling the number of
4094 characters in the buffer. Otherwise, format-decode might
4095 fail to correctly analyze the beginning or end of the buffer.
4096 Hence we temporarily save `point' and `inserted' here and
4097 restore `point' iff format-decode did not insert or delete
4098 any text. Otherwise we leave `point' at point-min. */
4100 int opoint_byte
= PT_BYTE
;
4101 int oinserted
= ZV
- BEGV
;
4102 int ochars_modiff
= CHARS_MODIFF
;
4104 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4105 insval
= call3 (Qformat_decode
,
4106 Qnil
, make_number (oinserted
), visit
);
4107 CHECK_NUMBER (insval
);
4108 if (ochars_modiff
== CHARS_MODIFF
)
4109 /* format_decode didn't modify buffer's characters => move
4110 point back to position before inserted text and leave
4111 value of inserted alone. */
4112 SET_PT_BOTH (opoint
, opoint_byte
);
4114 /* format_decode modified buffer's characters => consider
4115 entire buffer changed and leave point at point-min. */
4116 inserted
= XFASTINT (insval
);
4119 /* For consistency with format-decode call these now iff inserted > 0
4120 (martin 2007-06-28). */
4121 p
= Vafter_insert_file_functions
;
4126 insval
= call1 (XCAR (p
), make_number (inserted
));
4129 CHECK_NUMBER (insval
);
4130 inserted
= XFASTINT (insval
);
4135 /* For the rationale of this see the comment on
4136 format-decode above. */
4138 int opoint_byte
= PT_BYTE
;
4139 int oinserted
= ZV
- BEGV
;
4140 int ochars_modiff
= CHARS_MODIFF
;
4142 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4143 insval
= call1 (XCAR (p
), make_number (oinserted
));
4146 CHECK_NUMBER (insval
);
4147 if (ochars_modiff
== CHARS_MODIFF
)
4148 /* after_insert_file_functions didn't modify
4149 buffer's characters => move point back to
4150 position before inserted text and leave value of
4152 SET_PT_BOTH (opoint
, opoint_byte
);
4154 /* after_insert_file_functions did modify buffer's
4155 characters => consider entire buffer changed and
4156 leave point at point-min. */
4157 inserted
= XFASTINT (insval
);
4167 current_buffer
->undo_list
= old_undo
;
4168 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4170 /* Adjust the last undo record for the size change during
4171 the format conversion. */
4172 Lisp_Object tem
= XCAR (old_undo
);
4173 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4174 && INTEGERP (XCDR (tem
))
4175 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4176 XSETCDR (tem
, make_number (PT
+ inserted
));
4180 /* If undo_list was Qt before, keep it that way.
4181 Otherwise start with an empty undo_list. */
4182 current_buffer
->undo_list
= EQ (old_undo
, Qt
) ? Qt
: Qnil
;
4184 unbind_to (count
, Qnil
);
4187 /* Call after-change hooks for the inserted text, aside from the case
4188 of normal visiting (not with REPLACE), which is done in a new buffer
4189 "before" the buffer is changed. */
4190 if (inserted
> 0 && total
> 0
4191 && (NILP (visit
) || !NILP (replace
)))
4193 signal_after_change (PT
, 0, inserted
);
4194 update_compositions (PT
, PT
, CHECK_BORDER
);
4198 && current_buffer
->modtime
== -1)
4200 /* If visiting nonexistent file, return nil. */
4201 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4205 Fsignal (Qquit
, Qnil
);
4207 /* ??? Retval needs to be dealt with in all cases consistently. */
4209 val
= Fcons (orig_filename
,
4210 Fcons (make_number (inserted
),
4213 RETURN_UNGCPRO (unbind_to (count
, val
));
4216 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4218 /* If build_annotations switched buffers, switch back to BUF.
4219 Kill the temporary buffer that was selected in the meantime.
4221 Since this kill only the last temporary buffer, some buffers remain
4222 not killed if build_annotations switched buffers more than once.
4226 build_annotations_unwind (buf
)
4231 if (XBUFFER (buf
) == current_buffer
)
4233 tembuf
= Fcurrent_buffer ();
4235 Fkill_buffer (tembuf
);
4239 /* Decide the coding-system to encode the data with. */
4242 choose_write_coding_system (start
, end
, filename
,
4243 append
, visit
, lockname
, coding
)
4244 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4245 struct coding_system
*coding
;
4248 Lisp_Object eol_parent
= Qnil
;
4251 && NILP (Fstring_equal (current_buffer
->filename
,
4252 current_buffer
->auto_save_file_name
)))
4257 else if (!NILP (Vcoding_system_for_write
))
4259 val
= Vcoding_system_for_write
;
4260 if (coding_system_require_warning
4261 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4262 /* Confirm that VAL can surely encode the current region. */
4263 val
= call5 (Vselect_safe_coding_system_function
,
4264 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4269 /* If the variable `buffer-file-coding-system' is set locally,
4270 it means that the file was read with some kind of code
4271 conversion or the variable is explicitly set by users. We
4272 had better write it out with the same coding system even if
4273 `enable-multibyte-characters' is nil.
4275 If it is not set locally, we anyway have to convert EOL
4276 format if the default value of `buffer-file-coding-system'
4277 tells that it is not Unix-like (LF only) format. */
4278 int using_default_coding
= 0;
4279 int force_raw_text
= 0;
4281 val
= current_buffer
->buffer_file_coding_system
;
4283 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4286 if (NILP (current_buffer
->enable_multibyte_characters
))
4292 /* Check file-coding-system-alist. */
4293 Lisp_Object args
[7], coding_systems
;
4295 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4296 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4298 coding_systems
= Ffind_operation_coding_system (7, args
);
4299 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4300 val
= XCDR (coding_systems
);
4305 /* If we still have not decided a coding system, use the
4306 default value of buffer-file-coding-system. */
4307 val
= current_buffer
->buffer_file_coding_system
;
4308 using_default_coding
= 1;
4311 if (! NILP (val
) && ! force_raw_text
)
4313 Lisp_Object spec
, attrs
;
4315 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4316 attrs
= AREF (spec
, 0);
4317 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4322 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4323 /* Confirm that VAL can surely encode the current region. */
4324 val
= call5 (Vselect_safe_coding_system_function
,
4325 start
, end
, val
, Qnil
, filename
);
4327 /* If the decided coding-system doesn't specify end-of-line
4328 format, we use that of
4329 `default-buffer-file-coding-system'. */
4330 if (! using_default_coding
4331 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4332 val
= (coding_inherit_eol_type
4333 (val
, buffer_defaults
.buffer_file_coding_system
));
4335 /* If we decide not to encode text, use `raw-text' or one of its
4338 val
= raw_text_coding_system (val
);
4341 val
= coding_inherit_eol_type (val
, eol_parent
);
4342 setup_coding_system (val
, coding
);
4344 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4345 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4349 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4350 "r\nFWrite region to file: \ni\ni\ni\np",
4351 doc
: /* Write current region into specified file.
4352 When called from a program, requires three arguments:
4353 START, END and FILENAME. START and END are normally buffer positions
4354 specifying the part of the buffer to write.
4355 If START is nil, that means to use the entire buffer contents.
4356 If START is a string, then output that string to the file
4357 instead of any buffer contents; END is ignored.
4359 Optional fourth argument APPEND if non-nil means
4360 append to existing file contents (if any). If it is an integer,
4361 seek to that offset in the file before writing.
4362 Optional fifth argument VISIT, if t or a string, means
4363 set the last-save-file-modtime of buffer to this file's modtime
4364 and mark buffer not modified.
4365 If VISIT is a string, it is a second file name;
4366 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4367 VISIT is also the file name to lock and unlock for clash detection.
4368 If VISIT is neither t nor nil nor a string,
4369 that means do not display the \"Wrote file\" message.
4370 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4371 use for locking and unlocking, overriding FILENAME and VISIT.
4372 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4373 for an existing file with the same name. If MUSTBENEW is `excl',
4374 that means to get an error if the file already exists; never overwrite.
4375 If MUSTBENEW is neither nil nor `excl', that means ask for
4376 confirmation before overwriting, but do go ahead and overwrite the file
4377 if the user confirms.
4379 This does code conversion according to the value of
4380 `coding-system-for-write', `buffer-file-coding-system', or
4381 `file-coding-system-alist', and sets the variable
4382 `last-coding-system-used' to the coding system actually used. */)
4383 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4384 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4389 const unsigned char *fn
;
4391 int count
= SPECPDL_INDEX ();
4393 Lisp_Object handler
;
4394 Lisp_Object visit_file
;
4395 Lisp_Object annotations
;
4396 Lisp_Object encoded_filename
;
4397 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4398 int quietly
= !NILP (visit
);
4399 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4400 struct buffer
*given_buffer
;
4402 int buffer_file_type
= O_BINARY
;
4404 struct coding_system coding
;
4406 if (current_buffer
->base_buffer
&& visiting
)
4407 error ("Cannot do file visiting in an indirect buffer");
4409 if (!NILP (start
) && !STRINGP (start
))
4410 validate_region (&start
, &end
);
4413 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4415 filename
= Fexpand_file_name (filename
, Qnil
);
4417 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4418 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4420 if (STRINGP (visit
))
4421 visit_file
= Fexpand_file_name (visit
, Qnil
);
4423 visit_file
= filename
;
4425 if (NILP (lockname
))
4426 lockname
= visit_file
;
4430 /* If the file name has special constructs in it,
4431 call the corresponding file handler. */
4432 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4433 /* If FILENAME has no handler, see if VISIT has one. */
4434 if (NILP (handler
) && STRINGP (visit
))
4435 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4437 if (!NILP (handler
))
4440 val
= call6 (handler
, Qwrite_region
, start
, end
,
4441 filename
, append
, visit
);
4445 SAVE_MODIFF
= MODIFF
;
4446 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4447 current_buffer
->filename
= visit_file
;
4453 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4455 /* Special kludge to simplify auto-saving. */
4458 /* Do it later, so write-region-annotate-function can work differently
4459 if we save "the buffer" vs "a region".
4460 This is useful in tar-mode. --Stef
4461 XSETFASTINT (start, BEG);
4462 XSETFASTINT (end, Z); */
4466 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4467 count1
= SPECPDL_INDEX ();
4469 given_buffer
= current_buffer
;
4471 if (!STRINGP (start
))
4473 annotations
= build_annotations (start
, end
);
4475 if (current_buffer
!= given_buffer
)
4477 XSETFASTINT (start
, BEGV
);
4478 XSETFASTINT (end
, ZV
);
4484 XSETFASTINT (start
, BEGV
);
4485 XSETFASTINT (end
, ZV
);
4490 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4492 /* Decide the coding-system to encode the data with.
4493 We used to make this choice before calling build_annotations, but that
4494 leads to problems when a write-annotate-function takes care of
4495 unsavable chars (as was the case with X-Symbol). */
4496 Vlast_coding_system_used
4497 = choose_write_coding_system (start
, end
, filename
,
4498 append
, visit
, lockname
, &coding
);
4500 #ifdef CLASH_DETECTION
4503 #if 0 /* This causes trouble for GNUS. */
4504 /* If we've locked this file for some other buffer,
4505 query before proceeding. */
4506 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4507 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4510 lock_file (lockname
);
4512 #endif /* CLASH_DETECTION */
4514 encoded_filename
= ENCODE_FILE (filename
);
4516 fn
= SDATA (encoded_filename
);
4520 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4521 #else /* not DOS_NT */
4522 desc
= emacs_open (fn
, O_WRONLY
, 0);
4523 #endif /* not DOS_NT */
4525 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4527 desc
= emacs_open (fn
,
4528 O_WRONLY
| O_CREAT
| buffer_file_type
4529 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4530 S_IREAD
| S_IWRITE
);
4531 #else /* not DOS_NT */
4532 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4533 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4534 auto_saving
? auto_save_mode_bits
: 0666);
4535 #endif /* not DOS_NT */
4539 #ifdef CLASH_DETECTION
4541 if (!auto_saving
) unlock_file (lockname
);
4543 #endif /* CLASH_DETECTION */
4545 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4548 record_unwind_protect (close_file_unwind
, make_number (desc
));
4550 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4554 if (NUMBERP (append
))
4555 ret
= lseek (desc
, XINT (append
), 1);
4557 ret
= lseek (desc
, 0, 2);
4560 #ifdef CLASH_DETECTION
4561 if (!auto_saving
) unlock_file (lockname
);
4562 #endif /* CLASH_DETECTION */
4564 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4571 /* The new encoding routine doesn't require the following. */
4573 /* Whether VMS or not, we must move the gap to the next of newline
4574 when we must put designation sequences at beginning of line. */
4575 if (INTEGERP (start
)
4576 && coding
.type
== coding_type_iso2022
4577 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4578 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4580 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4581 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4582 move_gap_both (PT
, PT_BYTE
);
4583 SET_PT_BOTH (opoint
, opoint_byte
);
4590 if (STRINGP (start
))
4592 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
4593 &annotations
, &coding
);
4596 else if (XINT (start
) != XINT (end
))
4598 failure
= 0 > a_write (desc
, Qnil
,
4599 XINT (start
), XINT (end
) - XINT (start
),
4600 &annotations
, &coding
);
4605 /* If file was empty, still need to write the annotations */
4606 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4607 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4611 if (CODING_REQUIRE_FLUSHING (&coding
)
4612 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4615 /* We have to flush out a data. */
4616 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4617 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
4624 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4625 Disk full in NFS may be reported here. */
4626 /* mib says that closing the file will try to write as fast as NFS can do
4627 it, and that means the fsync here is not crucial for autosave files. */
4628 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
4630 /* If fsync fails with EINTR, don't treat that as serious. Also
4631 ignore EINVAL which happens when fsync is not supported on this
4633 if (errno
!= EINTR
&& errno
!= EINVAL
)
4634 failure
= 1, save_errno
= errno
;
4638 /* Spurious "file has changed on disk" warnings have been
4639 observed on Suns as well.
4640 It seems that `close' can change the modtime, under nfs.
4642 (This has supposedly been fixed in Sunos 4,
4643 but who knows about all the other machines with NFS?) */
4650 /* NFS can report a write failure now. */
4651 if (emacs_close (desc
) < 0)
4652 failure
= 1, save_errno
= errno
;
4657 /* Discard the unwind protect for close_file_unwind. */
4658 specpdl_ptr
= specpdl
+ count1
;
4659 /* Restore the original current buffer. */
4660 visit_file
= unbind_to (count
, visit_file
);
4662 #ifdef CLASH_DETECTION
4664 unlock_file (lockname
);
4665 #endif /* CLASH_DETECTION */
4667 /* Do this before reporting IO error
4668 to avoid a "file has changed on disk" warning on
4669 next attempt to save. */
4671 current_buffer
->modtime
= st
.st_mtime
;
4674 error ("IO error writing %s: %s", SDATA (filename
),
4675 emacs_strerror (save_errno
));
4679 SAVE_MODIFF
= MODIFF
;
4680 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4681 current_buffer
->filename
= visit_file
;
4682 update_mode_lines
++;
4687 && ! NILP (Fstring_equal (current_buffer
->filename
,
4688 current_buffer
->auto_save_file_name
)))
4689 SAVE_MODIFF
= MODIFF
;
4695 message_with_string ((INTEGERP (append
)
4705 Lisp_Object
merge ();
4707 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4708 doc
: /* Return t if (car A) is numerically less than (car B). */)
4712 return Flss (Fcar (a
), Fcar (b
));
4715 /* Build the complete list of annotations appropriate for writing out
4716 the text between START and END, by calling all the functions in
4717 write-region-annotate-functions and merging the lists they return.
4718 If one of these functions switches to a different buffer, we assume
4719 that buffer contains altered text. Therefore, the caller must
4720 make sure to restore the current buffer in all cases,
4721 as save-excursion would do. */
4724 build_annotations (start
, end
)
4725 Lisp_Object start
, end
;
4727 Lisp_Object annotations
;
4729 struct gcpro gcpro1
, gcpro2
;
4730 Lisp_Object original_buffer
;
4731 int i
, used_global
= 0;
4733 XSETBUFFER (original_buffer
, current_buffer
);
4736 p
= Vwrite_region_annotate_functions
;
4737 GCPRO2 (annotations
, p
);
4740 struct buffer
*given_buffer
= current_buffer
;
4741 if (EQ (Qt
, XCAR (p
)) && !used_global
)
4742 { /* Use the global value of the hook. */
4745 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
4747 p
= Fappend (2, arg
);
4750 Vwrite_region_annotations_so_far
= annotations
;
4751 res
= call2 (XCAR (p
), start
, end
);
4752 /* If the function makes a different buffer current,
4753 assume that means this buffer contains altered text to be output.
4754 Reset START and END from the buffer bounds
4755 and discard all previous annotations because they should have
4756 been dealt with by this function. */
4757 if (current_buffer
!= given_buffer
)
4759 XSETFASTINT (start
, BEGV
);
4760 XSETFASTINT (end
, ZV
);
4763 Flength (res
); /* Check basic validity of return value */
4764 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4768 /* Now do the same for annotation functions implied by the file-format */
4769 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
4770 p
= current_buffer
->auto_save_file_format
;
4772 p
= current_buffer
->file_format
;
4773 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
4775 struct buffer
*given_buffer
= current_buffer
;
4777 Vwrite_region_annotations_so_far
= annotations
;
4779 /* Value is either a list of annotations or nil if the function
4780 has written annotations to a temporary buffer, which is now
4782 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
4783 original_buffer
, make_number (i
));
4784 if (current_buffer
!= given_buffer
)
4786 XSETFASTINT (start
, BEGV
);
4787 XSETFASTINT (end
, ZV
);
4792 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4800 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
4801 If STRING is nil, POS is the character position in the current buffer.
4802 Intersperse with them the annotations from *ANNOT
4803 which fall within the range of POS to POS + NCHARS,
4804 each at its appropriate position.
4806 We modify *ANNOT by discarding elements as we use them up.
4808 The return value is negative in case of system call failure. */
4811 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
4814 register int nchars
;
4817 struct coding_system
*coding
;
4821 int lastpos
= pos
+ nchars
;
4823 while (NILP (*annot
) || CONSP (*annot
))
4825 tem
= Fcar_safe (Fcar (*annot
));
4828 nextpos
= XFASTINT (tem
);
4830 /* If there are no more annotations in this range,
4831 output the rest of the range all at once. */
4832 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
4833 return e_write (desc
, string
, pos
, lastpos
, coding
);
4835 /* Output buffer text up to the next annotation's position. */
4838 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
4842 /* Output the annotation. */
4843 tem
= Fcdr (Fcar (*annot
));
4846 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
4849 *annot
= Fcdr (*annot
);
4855 /* Write text in the range START and END into descriptor DESC,
4856 encoding them with coding system CODING. If STRING is nil, START
4857 and END are character positions of the current buffer, else they
4858 are indexes to the string STRING. */
4861 e_write (desc
, string
, start
, end
, coding
)
4865 struct coding_system
*coding
;
4867 if (STRINGP (string
))
4870 end
= SCHARS (string
);
4873 /* We used to have a code for handling selective display here. But,
4874 now it is handled within encode_coding. */
4878 if (STRINGP (string
))
4880 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
4881 if (CODING_REQUIRE_ENCODING (coding
))
4883 encode_coding_object (coding
, string
,
4884 start
, string_char_to_byte (string
, start
),
4885 end
, string_char_to_byte (string
, end
), Qt
);
4889 coding
->dst_object
= string
;
4890 coding
->consumed_char
= SCHARS (string
);
4891 coding
->produced
= SBYTES (string
);
4896 int start_byte
= CHAR_TO_BYTE (start
);
4897 int end_byte
= CHAR_TO_BYTE (end
);
4899 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
4900 if (CODING_REQUIRE_ENCODING (coding
))
4902 encode_coding_object (coding
, Fcurrent_buffer (),
4903 start
, start_byte
, end
, end_byte
, Qt
);
4907 coding
->dst_object
= Qnil
;
4908 coding
->dst_pos_byte
= start_byte
;
4909 if (start
>= GPT
|| end
<= GPT
)
4911 coding
->consumed_char
= end
- start
;
4912 coding
->produced
= end_byte
- start_byte
;
4916 coding
->consumed_char
= GPT
- start
;
4917 coding
->produced
= GPT_BYTE
- start_byte
;
4922 if (coding
->produced
> 0)
4926 STRINGP (coding
->dst_object
)
4927 ? SDATA (coding
->dst_object
)
4928 : BYTE_POS_ADDR (coding
->dst_pos_byte
),
4931 if (coding
->produced
)
4934 start
+= coding
->consumed_char
;
4940 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4941 Sverify_visited_file_modtime
, 1, 1, 0,
4942 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
4943 This means that the file has not been changed since it was visited or saved.
4944 See Info node `(elisp)Modification Time' for more details. */)
4950 Lisp_Object handler
;
4951 Lisp_Object filename
;
4956 if (!STRINGP (b
->filename
)) return Qt
;
4957 if (b
->modtime
== 0) return Qt
;
4959 /* If the file name has special constructs in it,
4960 call the corresponding file handler. */
4961 handler
= Ffind_file_name_handler (b
->filename
,
4962 Qverify_visited_file_modtime
);
4963 if (!NILP (handler
))
4964 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4966 filename
= ENCODE_FILE (b
->filename
);
4968 if (stat (SDATA (filename
), &st
) < 0)
4970 /* If the file doesn't exist now and didn't exist before,
4971 we say that it isn't modified, provided the error is a tame one. */
4972 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4977 if (st
.st_mtime
== b
->modtime
4978 /* If both are positive, accept them if they are off by one second. */
4979 || (st
.st_mtime
> 0 && b
->modtime
> 0
4980 && (st
.st_mtime
== b
->modtime
+ 1
4981 || st
.st_mtime
== b
->modtime
- 1)))
4986 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4987 Sclear_visited_file_modtime
, 0, 0, 0,
4988 doc
: /* Clear out records of last mod time of visited file.
4989 Next attempt to save will certainly not complain of a discrepancy. */)
4992 current_buffer
->modtime
= 0;
4996 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4997 Svisited_file_modtime
, 0, 0, 0,
4998 doc
: /* Return the current buffer's recorded visited file modification time.
4999 The value is a list of the form (HIGH LOW), like the time values
5000 that `file-attributes' returns. If the current buffer has no recorded
5001 file modification time, this function returns 0.
5002 See Info node `(elisp)Modification Time' for more details. */)
5005 if (! current_buffer
->modtime
)
5006 return make_number (0);
5007 return make_time ((time_t) current_buffer
->modtime
);
5010 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5011 Sset_visited_file_modtime
, 0, 1, 0,
5012 doc
: /* Update buffer's recorded modification time from the visited file's time.
5013 Useful if the buffer was not read from the file normally
5014 or if the file itself has been changed for some known benign reason.
5015 An argument specifies the modification time value to use
5016 \(instead of that of the visited file), in the form of a list
5017 \(HIGH . LOW) or (HIGH LOW). */)
5019 Lisp_Object time_list
;
5021 if (!NILP (time_list
))
5022 current_buffer
->modtime
= cons_to_long (time_list
);
5025 register Lisp_Object filename
;
5027 Lisp_Object handler
;
5029 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5031 /* If the file name has special constructs in it,
5032 call the corresponding file handler. */
5033 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5034 if (!NILP (handler
))
5035 /* The handler can find the file name the same way we did. */
5036 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5038 filename
= ENCODE_FILE (filename
);
5040 if (stat (SDATA (filename
), &st
) >= 0)
5041 current_buffer
->modtime
= st
.st_mtime
;
5048 auto_save_error (error
)
5051 Lisp_Object args
[3], msg
;
5053 struct gcpro gcpro1
;
5057 auto_save_error_occurred
= 1;
5059 ring_bell (XFRAME (selected_frame
));
5061 args
[0] = build_string ("Auto-saving %s: %s");
5062 args
[1] = current_buffer
->name
;
5063 args
[2] = Ferror_message_string (error
);
5064 msg
= Fformat (3, args
);
5066 nbytes
= SBYTES (msg
);
5067 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5068 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5070 for (i
= 0; i
< 3; ++i
)
5073 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5075 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5076 Fsleep_for (make_number (1), Qnil
);
5090 auto_save_mode_bits
= 0666;
5092 /* Get visited file's mode to become the auto save file's mode. */
5093 if (! NILP (current_buffer
->filename
))
5095 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5096 /* But make sure we can overwrite it later! */
5097 auto_save_mode_bits
= st
.st_mode
| 0600;
5098 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5100 /* Remote files don't cooperate with stat. */
5101 auto_save_mode_bits
= XINT (modes
) | 0600;
5105 Fwrite_region (Qnil
, Qnil
, current_buffer
->auto_save_file_name
, Qnil
,
5106 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5111 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5114 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5126 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5129 minibuffer_auto_raise
= XINT (value
);
5134 do_auto_save_make_dir (dir
)
5139 call2 (Qmake_directory
, dir
, Qt
);
5140 XSETFASTINT (mode
, 0700);
5141 return Fset_file_modes (dir
, mode
);
5145 do_auto_save_eh (ignore
)
5151 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5152 doc
: /* Auto-save all buffers that need it.
5153 This is all buffers that have auto-saving enabled
5154 and are changed since last auto-saved.
5155 Auto-saving writes the buffer into a file
5156 so that your editing is not lost if the system crashes.
5157 This file is not the file you visited; that changes only when you save.
5158 Normally we run the normal hook `auto-save-hook' before saving.
5160 A non-nil NO-MESSAGE argument means do not print any message if successful.
5161 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5162 (no_message
, current_only
)
5163 Lisp_Object no_message
, current_only
;
5165 struct buffer
*old
= current_buffer
, *b
;
5166 Lisp_Object tail
, buf
;
5168 int do_handled_files
;
5170 FILE *stream
= NULL
;
5171 int count
= SPECPDL_INDEX ();
5172 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5173 int old_message_p
= 0;
5174 struct gcpro gcpro1
, gcpro2
;
5176 if (max_specpdl_size
< specpdl_size
+ 40)
5177 max_specpdl_size
= specpdl_size
+ 40;
5182 if (NILP (no_message
))
5184 old_message_p
= push_message ();
5185 record_unwind_protect (pop_message_unwind
, Qnil
);
5188 /* Ordinarily don't quit within this function,
5189 but don't make it impossible to quit (in case we get hung in I/O). */
5193 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5194 point to non-strings reached from Vbuffer_alist. */
5196 if (!NILP (Vrun_hooks
))
5197 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5199 if (STRINGP (Vauto_save_list_file_name
))
5201 Lisp_Object listfile
;
5203 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5205 /* Don't try to create the directory when shutting down Emacs,
5206 because creating the directory might signal an error, and
5207 that would leave Emacs in a strange state. */
5208 if (!NILP (Vrun_hooks
))
5212 GCPRO2 (dir
, listfile
);
5213 dir
= Ffile_name_directory (listfile
);
5214 if (NILP (Ffile_directory_p (dir
)))
5215 internal_condition_case_1 (do_auto_save_make_dir
,
5216 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5221 stream
= fopen (SDATA (listfile
), "w");
5224 record_unwind_protect (do_auto_save_unwind
,
5225 make_save_value (stream
, 0));
5226 record_unwind_protect (do_auto_save_unwind_1
,
5227 make_number (minibuffer_auto_raise
));
5228 minibuffer_auto_raise
= 0;
5230 auto_save_error_occurred
= 0;
5232 /* On first pass, save all files that don't have handlers.
5233 On second pass, save all files that do have handlers.
5235 If Emacs is crashing, the handlers may tweak what is causing
5236 Emacs to crash in the first place, and it would be a shame if
5237 Emacs failed to autosave perfectly ordinary files because it
5238 couldn't handle some ange-ftp'd file. */
5240 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5241 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5243 buf
= XCDR (XCAR (tail
));
5246 /* Record all the buffers that have auto save mode
5247 in the special file that lists them. For each of these buffers,
5248 Record visited name (if any) and auto save name. */
5249 if (STRINGP (b
->auto_save_file_name
)
5250 && stream
!= NULL
&& do_handled_files
== 0)
5253 if (!NILP (b
->filename
))
5255 fwrite (SDATA (b
->filename
), 1,
5256 SBYTES (b
->filename
), stream
);
5258 putc ('\n', stream
);
5259 fwrite (SDATA (b
->auto_save_file_name
), 1,
5260 SBYTES (b
->auto_save_file_name
), stream
);
5261 putc ('\n', stream
);
5265 if (!NILP (current_only
)
5266 && b
!= current_buffer
)
5269 /* Don't auto-save indirect buffers.
5270 The base buffer takes care of it. */
5274 /* Check for auto save enabled
5275 and file changed since last auto save
5276 and file changed since last real save. */
5277 if (STRINGP (b
->auto_save_file_name
)
5278 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5279 && b
->auto_save_modified
< BUF_MODIFF (b
)
5280 /* -1 means we've turned off autosaving for a while--see below. */
5281 && XINT (b
->save_length
) >= 0
5282 && (do_handled_files
5283 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5286 EMACS_TIME before_time
, after_time
;
5288 EMACS_GET_TIME (before_time
);
5290 /* If we had a failure, don't try again for 20 minutes. */
5291 if (b
->auto_save_failure_time
>= 0
5292 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5295 if ((XFASTINT (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 (b
->save_length
) > 5000
5300 /* These messages are frequent and annoying for `*mail*'. */
5301 && !EQ (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 (b
->save_length
, -1);
5312 Fsleep_for (make_number (1), Qnil
);
5315 set_buffer_internal (b
);
5316 if (!auto_saved
&& NILP (no_message
))
5317 message1 ("Auto-saving...");
5318 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5320 b
->auto_save_modified
= BUF_MODIFF (b
);
5321 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5322 set_buffer_internal (old
);
5324 EMACS_GET_TIME (after_time
);
5326 /* If auto-save took more than 60 seconds,
5327 assume it was an NFS failure that got a timeout. */
5328 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5329 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5333 /* Prevent another auto save till enough input events come in. */
5334 record_auto_save ();
5336 if (auto_saved
&& NILP (no_message
))
5340 /* If we are going to restore an old message,
5341 give time to read ours. */
5342 sit_for (make_number (1), 0, 0);
5345 else if (!auto_save_error_occurred
)
5346 /* Don't overwrite the error message if an error occurred.
5347 If we displayed a message and then restored a state
5348 with no message, leave a "done" message on the screen. */
5349 message1 ("Auto-saving...done");
5354 /* This restores the message-stack status. */
5355 unbind_to (count
, Qnil
);
5359 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5360 Sset_buffer_auto_saved
, 0, 0, 0,
5361 doc
: /* Mark current buffer as auto-saved with its current text.
5362 No auto-save file will be written until the buffer changes again. */)
5365 current_buffer
->auto_save_modified
= MODIFF
;
5366 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5367 current_buffer
->auto_save_failure_time
= -1;
5371 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5372 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5373 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5376 current_buffer
->auto_save_failure_time
= -1;
5380 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5382 doc
: /* Return t if current buffer has been auto-saved recently.
5383 More precisely, if it has been auto-saved since last read from or saved
5384 in the visited file. If the buffer has no visited file,
5385 then any auto-save counts as "recent". */)
5388 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5391 /* Reading and completing file names */
5393 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5394 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5395 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5396 The return value is only relevant for a call to `read-file-name' that happens
5397 before any other event (mouse or keypress) is handeled. */)
5400 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
5401 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5411 Fread_file_name (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
5412 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
5414 struct gcpro gcpro1
, gcpro2
;
5415 Lisp_Object args
[7];
5417 GCPRO1 (default_filename
);
5418 args
[0] = intern ("read-file-name");
5421 args
[3] = default_filename
;
5422 args
[4] = mustmatch
;
5424 args
[6] = predicate
;
5425 RETURN_UNGCPRO (Ffuncall (7, args
));
5432 /* Must be set before any path manipulation is performed. */
5433 XSETFASTINT (Vdirectory_sep_char
, '/');
5440 Qoperations
= intern ("operations");
5441 Qexpand_file_name
= intern ("expand-file-name");
5442 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5443 Qdirectory_file_name
= intern ("directory-file-name");
5444 Qfile_name_directory
= intern ("file-name-directory");
5445 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5446 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5447 Qfile_name_as_directory
= intern ("file-name-as-directory");
5448 Qcopy_file
= intern ("copy-file");
5449 Qmake_directory_internal
= intern ("make-directory-internal");
5450 Qmake_directory
= intern ("make-directory");
5451 Qdelete_directory
= intern ("delete-directory");
5452 Qdelete_file
= intern ("delete-file");
5453 Qrename_file
= intern ("rename-file");
5454 Qadd_name_to_file
= intern ("add-name-to-file");
5455 Qmake_symbolic_link
= intern ("make-symbolic-link");
5456 Qfile_exists_p
= intern ("file-exists-p");
5457 Qfile_executable_p
= intern ("file-executable-p");
5458 Qfile_readable_p
= intern ("file-readable-p");
5459 Qfile_writable_p
= intern ("file-writable-p");
5460 Qfile_symlink_p
= intern ("file-symlink-p");
5461 Qaccess_file
= intern ("access-file");
5462 Qfile_directory_p
= intern ("file-directory-p");
5463 Qfile_regular_p
= intern ("file-regular-p");
5464 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5465 Qfile_modes
= intern ("file-modes");
5466 Qset_file_modes
= intern ("set-file-modes");
5467 Qset_file_times
= intern ("set-file-times");
5468 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5469 Qinsert_file_contents
= intern ("insert-file-contents");
5470 Qwrite_region
= intern ("write-region");
5471 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5472 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5473 Qauto_save_coding
= intern ("auto-save-coding");
5475 staticpro (&Qoperations
);
5476 staticpro (&Qexpand_file_name
);
5477 staticpro (&Qsubstitute_in_file_name
);
5478 staticpro (&Qdirectory_file_name
);
5479 staticpro (&Qfile_name_directory
);
5480 staticpro (&Qfile_name_nondirectory
);
5481 staticpro (&Qunhandled_file_name_directory
);
5482 staticpro (&Qfile_name_as_directory
);
5483 staticpro (&Qcopy_file
);
5484 staticpro (&Qmake_directory_internal
);
5485 staticpro (&Qmake_directory
);
5486 staticpro (&Qdelete_directory
);
5487 staticpro (&Qdelete_file
);
5488 staticpro (&Qrename_file
);
5489 staticpro (&Qadd_name_to_file
);
5490 staticpro (&Qmake_symbolic_link
);
5491 staticpro (&Qfile_exists_p
);
5492 staticpro (&Qfile_executable_p
);
5493 staticpro (&Qfile_readable_p
);
5494 staticpro (&Qfile_writable_p
);
5495 staticpro (&Qaccess_file
);
5496 staticpro (&Qfile_symlink_p
);
5497 staticpro (&Qfile_directory_p
);
5498 staticpro (&Qfile_regular_p
);
5499 staticpro (&Qfile_accessible_directory_p
);
5500 staticpro (&Qfile_modes
);
5501 staticpro (&Qset_file_modes
);
5502 staticpro (&Qset_file_times
);
5503 staticpro (&Qfile_newer_than_file_p
);
5504 staticpro (&Qinsert_file_contents
);
5505 staticpro (&Qwrite_region
);
5506 staticpro (&Qverify_visited_file_modtime
);
5507 staticpro (&Qset_visited_file_modtime
);
5508 staticpro (&Qauto_save_coding
);
5510 Qfile_name_history
= intern ("file-name-history");
5511 Fset (Qfile_name_history
, Qnil
);
5512 staticpro (&Qfile_name_history
);
5514 Qfile_error
= intern ("file-error");
5515 staticpro (&Qfile_error
);
5516 Qfile_already_exists
= intern ("file-already-exists");
5517 staticpro (&Qfile_already_exists
);
5518 Qfile_date_error
= intern ("file-date-error");
5519 staticpro (&Qfile_date_error
);
5520 Qexcl
= intern ("excl");
5524 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5525 staticpro (&Qfind_buffer_file_type
);
5528 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5529 doc
: /* *Coding system for encoding file names.
5530 If it is nil, `default-file-name-coding-system' (which see) is used. */);
5531 Vfile_name_coding_system
= Qnil
;
5533 DEFVAR_LISP ("default-file-name-coding-system",
5534 &Vdefault_file_name_coding_system
,
5535 doc
: /* Default coding system for encoding file names.
5536 This variable is used only when `file-name-coding-system' is nil.
5538 This variable is set/changed by the command `set-language-environment'.
5539 User should not set this variable manually,
5540 instead use `file-name-coding-system' to get a constant encoding
5541 of file names regardless of the current language environment. */);
5542 Vdefault_file_name_coding_system
= Qnil
;
5544 Qformat_decode
= intern ("format-decode");
5545 staticpro (&Qformat_decode
);
5546 Qformat_annotate_function
= intern ("format-annotate-function");
5547 staticpro (&Qformat_annotate_function
);
5548 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
5549 staticpro (&Qafter_insert_file_set_coding
);
5551 Qcar_less_than_car
= intern ("car-less-than-car");
5552 staticpro (&Qcar_less_than_car
);
5554 Fput (Qfile_error
, Qerror_conditions
,
5555 list2 (Qfile_error
, Qerror
));
5556 Fput (Qfile_error
, Qerror_message
,
5557 build_string ("File error"));
5559 Fput (Qfile_already_exists
, Qerror_conditions
,
5560 list3 (Qfile_already_exists
, Qfile_error
, Qerror
));
5561 Fput (Qfile_already_exists
, Qerror_message
,
5562 build_string ("File already exists"));
5564 Fput (Qfile_date_error
, Qerror_conditions
,
5565 list3 (Qfile_date_error
, Qfile_error
, Qerror
));
5566 Fput (Qfile_date_error
, Qerror_message
,
5567 build_string ("Cannot set file date"));
5569 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5570 doc
: /* Directory separator character for built-in functions that return file names.
5571 The value is always ?/. Don't use this variable, just use `/'. */);
5573 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5574 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
5575 If a file name matches REGEXP, then all I/O on that file is done by calling
5578 The first argument given to HANDLER is the name of the I/O primitive
5579 to be handled; the remaining arguments are the arguments that were
5580 passed to that primitive. For example, if you do
5581 (file-exists-p FILENAME)
5582 and FILENAME is handled by HANDLER, then HANDLER is called like this:
5583 (funcall HANDLER 'file-exists-p FILENAME)
5584 The function `find-file-name-handler' checks this list for a handler
5585 for its argument. */);
5586 Vfile_name_handler_alist
= Qnil
;
5588 DEFVAR_LISP ("set-auto-coding-function",
5589 &Vset_auto_coding_function
,
5590 doc
: /* If non-nil, a function to call to decide a coding system of file.
5591 Two arguments are passed to this function: the file name
5592 and the length of a file contents following the point.
5593 This function should return a coding system to decode the file contents.
5594 It should check the file name against `auto-coding-alist'.
5595 If no coding system is decided, it should check a coding system
5596 specified in the heading lines with the format:
5597 -*- ... coding: CODING-SYSTEM; ... -*-
5598 or local variable spec of the tailing lines with `coding:' tag. */);
5599 Vset_auto_coding_function
= Qnil
;
5601 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5602 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
5603 Each is passed one argument, the number of characters inserted,
5604 with point at the start of the inserted text. Each function
5605 should leave point the same, and return the new character count.
5606 If `insert-file-contents' is intercepted by a handler from
5607 `file-name-handler-alist', that handler is responsible for calling the
5608 functions in `after-insert-file-functions' if appropriate. */);
5609 Vafter_insert_file_functions
= Qnil
;
5611 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5612 doc
: /* A list of functions to be called at the start of `write-region'.
5613 Each is passed two arguments, START and END as for `write-region'.
5614 These are usually two numbers but not always; see the documentation
5615 for `write-region'. The function should return a list of pairs
5616 of the form (POSITION . STRING), consisting of strings to be effectively
5617 inserted at the specified positions of the file being written (1 means to
5618 insert before the first byte written). The POSITIONs must be sorted into
5619 increasing order. If there are several functions in the list, the several
5620 lists are merged destructively. Alternatively, the function can return
5621 with a different buffer current; in that case it should pay attention
5622 to the annotations returned by previous functions and listed in
5623 `write-region-annotations-so-far'.*/);
5624 Vwrite_region_annotate_functions
= Qnil
;
5625 staticpro (&Qwrite_region_annotate_functions
);
5626 Qwrite_region_annotate_functions
5627 = intern ("write-region-annotate-functions");
5629 DEFVAR_LISP ("write-region-annotations-so-far",
5630 &Vwrite_region_annotations_so_far
,
5631 doc
: /* When an annotation function is called, this holds the previous annotations.
5632 These are the annotations made by other annotation functions
5633 that were already called. See also `write-region-annotate-functions'. */);
5634 Vwrite_region_annotations_so_far
= Qnil
;
5636 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5637 doc
: /* A list of file name handlers that temporarily should not be used.
5638 This applies only to the operation `inhibit-file-name-operation'. */);
5639 Vinhibit_file_name_handlers
= Qnil
;
5641 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5642 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5643 Vinhibit_file_name_operation
= Qnil
;
5645 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5646 doc
: /* File name in which we write a list of all auto save file names.
5647 This variable is initialized automatically from `auto-save-list-file-prefix'
5648 shortly after Emacs reads your `.emacs' file, if you have not yet given it
5649 a non-nil value. */);
5650 Vauto_save_list_file_name
= Qnil
;
5652 DEFVAR_LISP ("auto-save-visited-file-name", &Vauto_save_visited_file_name
,
5653 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
5654 Normally auto-save files are written under other names. */);
5655 Vauto_save_visited_file_name
= Qnil
;
5658 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
5659 doc
: /* *Non-nil means don't call fsync in `write-region'.
5660 This variable affects calls to `write-region' as well as save commands.
5661 A non-nil value may result in data loss! */);
5662 write_region_inhibit_fsync
= 0;
5665 DEFVAR_BOOL ("delete-by-moving-to-trash", &delete_by_moving_to_trash
,
5666 doc
: /* Specifies whether to use the system's trash can.
5667 When non-nil, the function `move-file-to-trash' will be used by
5668 `delete-file' and `delete-directory'. */);
5669 delete_by_moving_to_trash
= 0;
5670 Qmove_file_to_trash
= intern ("move-file-to-trash");
5671 staticpro (&Qmove_file_to_trash
);
5673 defsubr (&Sfind_file_name_handler
);
5674 defsubr (&Sfile_name_directory
);
5675 defsubr (&Sfile_name_nondirectory
);
5676 defsubr (&Sunhandled_file_name_directory
);
5677 defsubr (&Sfile_name_as_directory
);
5678 defsubr (&Sdirectory_file_name
);
5679 defsubr (&Smake_temp_name
);
5680 defsubr (&Sexpand_file_name
);
5681 defsubr (&Ssubstitute_in_file_name
);
5682 defsubr (&Scopy_file
);
5683 defsubr (&Smake_directory_internal
);
5684 defsubr (&Sdelete_directory
);
5685 defsubr (&Sdelete_file
);
5686 defsubr (&Srename_file
);
5687 defsubr (&Sadd_name_to_file
);
5688 defsubr (&Smake_symbolic_link
);
5689 defsubr (&Sfile_name_absolute_p
);
5690 defsubr (&Sfile_exists_p
);
5691 defsubr (&Sfile_executable_p
);
5692 defsubr (&Sfile_readable_p
);
5693 defsubr (&Sfile_writable_p
);
5694 defsubr (&Saccess_file
);
5695 defsubr (&Sfile_symlink_p
);
5696 defsubr (&Sfile_directory_p
);
5697 defsubr (&Sfile_accessible_directory_p
);
5698 defsubr (&Sfile_regular_p
);
5699 defsubr (&Sfile_modes
);
5700 defsubr (&Sset_file_modes
);
5701 defsubr (&Sset_file_times
);
5702 defsubr (&Sset_default_file_modes
);
5703 defsubr (&Sdefault_file_modes
);
5704 defsubr (&Sfile_newer_than_file_p
);
5705 defsubr (&Sinsert_file_contents
);
5706 defsubr (&Swrite_region
);
5707 defsubr (&Scar_less_than_car
);
5708 defsubr (&Sverify_visited_file_modtime
);
5709 defsubr (&Sclear_visited_file_modtime
);
5710 defsubr (&Svisited_file_modtime
);
5711 defsubr (&Sset_visited_file_modtime
);
5712 defsubr (&Sdo_auto_save
);
5713 defsubr (&Sset_buffer_auto_saved
);
5714 defsubr (&Sclear_buffer_auto_save_failure
);
5715 defsubr (&Srecent_auto_save_p
);
5717 defsubr (&Snext_read_file_uses_dialog_p
);
5720 defsubr (&Sunix_sync
);
5724 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
5725 (do not change this comment) */