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 (! EQ (Faref (errstring
, make_number (1)), make_number ('/')))
268 str
= (char *) SDATA (errstring
);
269 c
= STRING_CHAR (str
, 0);
270 Faset (errstring
, 0, make_number (DOWNCASE (c
)));
273 xsignal (Qfile_error
,
274 Fcons (build_string (string
), Fcons (errstring
, data
)));
279 close_file_unwind (fd
)
282 emacs_close (XFASTINT (fd
));
286 /* Restore point, having saved it as a marker. */
289 restore_point_unwind (location
)
290 Lisp_Object location
;
292 Fgoto_char (location
);
293 Fset_marker (location
, Qnil
, Qnil
);
298 Lisp_Object Qexpand_file_name
;
299 Lisp_Object Qsubstitute_in_file_name
;
300 Lisp_Object Qdirectory_file_name
;
301 Lisp_Object Qfile_name_directory
;
302 Lisp_Object Qfile_name_nondirectory
;
303 Lisp_Object Qunhandled_file_name_directory
;
304 Lisp_Object Qfile_name_as_directory
;
305 Lisp_Object Qcopy_file
;
306 Lisp_Object Qmake_directory_internal
;
307 Lisp_Object Qmake_directory
;
308 Lisp_Object Qdelete_directory
;
309 Lisp_Object Qdelete_file
;
310 Lisp_Object Qrename_file
;
311 Lisp_Object Qadd_name_to_file
;
312 Lisp_Object Qmake_symbolic_link
;
313 Lisp_Object Qfile_exists_p
;
314 Lisp_Object Qfile_executable_p
;
315 Lisp_Object Qfile_readable_p
;
316 Lisp_Object Qfile_writable_p
;
317 Lisp_Object Qfile_symlink_p
;
318 Lisp_Object Qaccess_file
;
319 Lisp_Object Qfile_directory_p
;
320 Lisp_Object Qfile_regular_p
;
321 Lisp_Object Qfile_accessible_directory_p
;
322 Lisp_Object Qfile_modes
;
323 Lisp_Object Qset_file_modes
;
324 Lisp_Object Qset_file_times
;
325 Lisp_Object Qfile_newer_than_file_p
;
326 Lisp_Object Qinsert_file_contents
;
327 Lisp_Object Qwrite_region
;
328 Lisp_Object Qverify_visited_file_modtime
;
329 Lisp_Object Qset_visited_file_modtime
;
331 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
332 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
333 Otherwise, return nil.
334 A file name is handled if one of the regular expressions in
335 `file-name-handler-alist' matches it.
337 If OPERATION equals `inhibit-file-name-operation', then we ignore
338 any handlers that are members of `inhibit-file-name-handlers',
339 but we still do run any other handlers. This lets handlers
340 use the standard functions without calling themselves recursively. */)
341 (filename
, operation
)
342 Lisp_Object filename
, operation
;
344 /* This function must not munge the match data. */
345 Lisp_Object chain
, inhibited_handlers
, result
;
349 CHECK_STRING (filename
);
351 if (EQ (operation
, Vinhibit_file_name_operation
))
352 inhibited_handlers
= Vinhibit_file_name_handlers
;
354 inhibited_handlers
= Qnil
;
356 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
357 chain
= XCDR (chain
))
363 Lisp_Object string
= XCAR (elt
);
365 Lisp_Object handler
= XCDR (elt
);
366 Lisp_Object operations
= Qnil
;
368 if (SYMBOLP (handler
))
369 operations
= Fget (handler
, Qoperations
);
372 && (match_pos
= fast_string_match (string
, filename
)) > pos
373 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
377 handler
= XCDR (elt
);
378 tem
= Fmemq (handler
, inhibited_handlers
);
392 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
394 doc
: /* Return the directory component in file name FILENAME.
395 Return nil if FILENAME does not include a directory.
396 Otherwise return a directory name.
397 Given a Unix syntax file name, returns a string ending in slash. */)
399 Lisp_Object filename
;
402 register const unsigned char *beg
;
404 register unsigned char *beg
;
406 register const unsigned char *p
;
409 CHECK_STRING (filename
);
411 /* If the file name has special constructs in it,
412 call the corresponding file handler. */
413 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
415 return call2 (handler
, Qfile_name_directory
, filename
);
417 filename
= FILE_SYSTEM_CASE (filename
);
418 beg
= SDATA (filename
);
420 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
422 p
= beg
+ SBYTES (filename
);
424 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
426 /* only recognise drive specifier at the beginning */
428 /* handle the "/:d:foo" and "/:foo" cases correctly */
429 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
430 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
437 /* Expansion of "c:" to drive and default directory. */
440 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
441 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
442 unsigned char *r
= res
;
444 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
446 strncpy (res
, beg
, 2);
451 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
453 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
456 p
= beg
+ strlen (beg
);
459 CORRECT_DIR_SEPS (beg
);
462 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
465 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
466 Sfile_name_nondirectory
, 1, 1, 0,
467 doc
: /* Return file name FILENAME sans its directory.
468 For example, in a Unix-syntax file name,
469 this is everything after the last slash,
470 or the entire name if it contains no slash. */)
472 Lisp_Object filename
;
474 register const unsigned char *beg
, *p
, *end
;
477 CHECK_STRING (filename
);
479 /* If the file name has special constructs in it,
480 call the corresponding file handler. */
481 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
483 return call2 (handler
, Qfile_name_nondirectory
, filename
);
485 beg
= SDATA (filename
);
486 end
= p
= beg
+ SBYTES (filename
);
488 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
490 /* only recognise drive specifier at beginning */
492 /* handle the "/:d:foo" case correctly */
493 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
498 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
501 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
502 Sunhandled_file_name_directory
, 1, 1, 0,
503 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
504 A `directly usable' directory name is one that may be used without the
505 intervention of any file handler.
506 If FILENAME is a directly usable file itself, return
507 \(file-name-directory FILENAME).
508 If FILENAME refers to a file which is not accessible from a local process,
509 then this should return nil.
510 The `call-process' and `start-process' functions use this function to
511 get a current directory to run processes in. */)
513 Lisp_Object filename
;
517 /* If the file name has special constructs in it,
518 call the corresponding file handler. */
519 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
521 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
523 return Ffile_name_directory (filename
);
528 file_name_as_directory (out
, in
)
531 int size
= strlen (in
) - 1;
543 /* For Unix syntax, Append a slash if necessary */
544 if (!IS_DIRECTORY_SEP (out
[size
]))
546 /* Cannot use DIRECTORY_SEP, which could have any value */
548 out
[size
+ 2] = '\0';
551 CORRECT_DIR_SEPS (out
);
556 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
557 Sfile_name_as_directory
, 1, 1, 0,
558 doc
: /* Return a string representing the file name FILE interpreted as a directory.
559 This operation exists because a directory is also a file, but its name as
560 a directory is different from its name as a file.
561 The result can be used as the value of `default-directory'
562 or passed as second argument to `expand-file-name'.
563 For a Unix-syntax file name, just appends a slash. */)
574 /* If the file name has special constructs in it,
575 call the corresponding file handler. */
576 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
578 return call2 (handler
, Qfile_name_as_directory
, file
);
580 buf
= (char *) alloca (SBYTES (file
) + 10);
581 file_name_as_directory (buf
, SDATA (file
));
582 return make_specified_string (buf
, -1, strlen (buf
),
583 STRING_MULTIBYTE (file
));
587 * Convert from directory name to filename.
588 * On UNIX, it's simple: just make sure there isn't a terminating /
590 * Value is nonzero if the string output is different from the input.
594 directory_file_name (src
, dst
)
601 /* Process as Unix format: just remove any final slash.
602 But leave "/" unchanged; do not change it to "". */
605 && IS_DIRECTORY_SEP (dst
[slen
- 1])
607 && !IS_ANY_SEP (dst
[slen
- 2])
612 CORRECT_DIR_SEPS (dst
);
617 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
619 doc
: /* Returns the file name of the directory named DIRECTORY.
620 This is the name of the file that holds the data for the directory DIRECTORY.
621 This operation exists because a directory is also a file, but its name as
622 a directory is different from its name as a file.
623 In Unix-syntax, this function just removes the final slash. */)
625 Lisp_Object directory
;
630 CHECK_STRING (directory
);
632 if (NILP (directory
))
635 /* If the file name has special constructs in it,
636 call the corresponding file handler. */
637 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
639 return call2 (handler
, Qdirectory_file_name
, directory
);
641 buf
= (char *) alloca (SBYTES (directory
) + 20);
642 directory_file_name (SDATA (directory
), buf
);
643 return make_specified_string (buf
, -1, strlen (buf
),
644 STRING_MULTIBYTE (directory
));
647 static char make_temp_name_tbl
[64] =
649 'A','B','C','D','E','F','G','H',
650 'I','J','K','L','M','N','O','P',
651 'Q','R','S','T','U','V','W','X',
652 'Y','Z','a','b','c','d','e','f',
653 'g','h','i','j','k','l','m','n',
654 'o','p','q','r','s','t','u','v',
655 'w','x','y','z','0','1','2','3',
656 '4','5','6','7','8','9','-','_'
659 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
661 /* Value is a temporary file name starting with PREFIX, a string.
663 The Emacs process number forms part of the result, so there is
664 no danger of generating a name being used by another process.
665 In addition, this function makes an attempt to choose a name
666 which has no existing file. To make this work, PREFIX should be
667 an absolute file name.
669 BASE64_P non-zero means add the pid as 3 characters in base64
670 encoding. In this case, 6 characters will be added to PREFIX to
671 form the file name. Otherwise, if Emacs is running on a system
672 with long file names, add the pid as a decimal number.
674 This function signals an error if no unique file name could be
678 make_temp_name (prefix
, base64_p
)
685 unsigned char *p
, *data
;
689 CHECK_STRING (prefix
);
691 /* VAL is created by adding 6 characters to PREFIX. The first
692 three are the PID of this process, in base 64, and the second
693 three are incremented if the file already exists. This ensures
694 262144 unique file names per PID per PREFIX. */
696 pid
= (int) getpid ();
700 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
701 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
702 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
707 #ifdef HAVE_LONG_FILE_NAMES
708 sprintf (pidbuf
, "%d", pid
);
709 pidlen
= strlen (pidbuf
);
711 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
712 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
713 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
718 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
719 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
720 if (!STRING_MULTIBYTE (prefix
))
721 STRING_SET_UNIBYTE (val
);
723 bcopy(SDATA (prefix
), data
, len
);
726 bcopy (pidbuf
, p
, pidlen
);
729 /* Here we try to minimize useless stat'ing when this function is
730 invoked many times successively with the same PREFIX. We achieve
731 this by initializing count to a random value, and incrementing it
734 We don't want make-temp-name to be called while dumping,
735 because then make_temp_name_count_initialized_p would get set
736 and then make_temp_name_count would not be set when Emacs starts. */
738 if (!make_temp_name_count_initialized_p
)
740 make_temp_name_count
= (unsigned) time (NULL
);
741 make_temp_name_count_initialized_p
= 1;
747 unsigned num
= make_temp_name_count
;
749 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
750 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
751 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
753 /* Poor man's congruential RN generator. Replace with
754 ++make_temp_name_count for debugging. */
755 make_temp_name_count
+= 25229;
756 make_temp_name_count
%= 225307;
758 if (stat (data
, &ignored
) < 0)
760 /* We want to return only if errno is ENOENT. */
764 /* The error here is dubious, but there is little else we
765 can do. The alternatives are to return nil, which is
766 as bad as (and in many cases worse than) throwing the
767 error, or to ignore the error, which will likely result
768 in looping through 225307 stat's, which is not only
769 dog-slow, but also useless since it will fallback to
770 the errow below, anyway. */
771 report_file_error ("Cannot create temporary name for prefix",
772 Fcons (prefix
, Qnil
));
777 error ("Cannot create temporary name for prefix `%s'",
783 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
784 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
785 The Emacs process number forms part of the result,
786 so there is no danger of generating a name being used by another process.
788 In addition, this function makes an attempt to choose a name
789 which has no existing file. To make this work,
790 PREFIX should be an absolute file name.
792 There is a race condition between calling `make-temp-name' and creating the
793 file which opens all kinds of security holes. For that reason, you should
794 probably use `make-temp-file' instead, except in three circumstances:
796 * If you are creating the file in the user's home directory.
797 * If you are creating a directory rather than an ordinary file.
798 * If you are taking special precautions as `make-temp-file' does. */)
802 return make_temp_name (prefix
, 0);
807 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
808 doc
: /* Convert filename NAME to absolute, and canonicalize it.
809 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
810 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
811 the current buffer's value of `default-directory' is used.
812 File name components that are `.' are removed, and
813 so are file name components followed by `..', along with the `..' itself;
814 note that these simplifications are done without checking the resulting
815 file names in the file system.
816 An initial `~/' expands to your home directory.
817 An initial `~USER/' expands to USER's home directory.
818 See also the function `substitute-in-file-name'. */)
819 (name
, default_directory
)
820 Lisp_Object name
, default_directory
;
822 /* These point to SDATA and need to be careful with string-relocation
823 during GC (via DECODE_FILE). */
824 unsigned char *nm
, *newdir
;
826 /* This should only point to alloca'd data. */
827 unsigned char *target
;
833 int collapse_newdir
= 1;
837 Lisp_Object handler
, result
;
843 /* If the file name has special constructs in it,
844 call the corresponding file handler. */
845 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
847 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
849 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
850 if (NILP (default_directory
))
851 default_directory
= current_buffer
->directory
;
852 if (! STRINGP (default_directory
))
855 /* "/" is not considered a root directory on DOS_NT, so using "/"
856 here causes an infinite recursion in, e.g., the following:
858 (let (default-directory)
859 (expand-file-name "a"))
861 To avoid this, we set default_directory to the root of the
863 extern char *emacs_root_dir (void);
865 default_directory
= build_string (emacs_root_dir ());
867 default_directory
= build_string ("/");
871 if (!NILP (default_directory
))
873 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
875 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
879 unsigned char *o
= SDATA (default_directory
);
881 /* Make sure DEFAULT_DIRECTORY is properly expanded.
882 It would be better to do this down below where we actually use
883 default_directory. Unfortunately, calling Fexpand_file_name recursively
884 could invoke GC, and the strings might be relocated. This would
885 be annoying because we have pointers into strings lying around
886 that would need adjusting, and people would add new pointers to
887 the code and forget to adjust them, resulting in intermittent bugs.
888 Putting this call here avoids all that crud.
890 The EQ test avoids infinite recursion. */
891 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
892 /* Save time in some common cases - as long as default_directory
893 is not relative, it can be canonicalized with name below (if it
894 is needed at all) without requiring it to be expanded now. */
896 /* Detect MSDOS file names with drive specifiers. */
897 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
898 && IS_DIRECTORY_SEP (o
[2]))
900 /* Detect Windows file names in UNC format. */
901 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
903 #else /* not DOS_NT */
904 /* Detect Unix absolute file names (/... alone is not absolute on
906 && ! (IS_DIRECTORY_SEP (o
[0]))
907 #endif /* not DOS_NT */
913 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
917 name
= FILE_SYSTEM_CASE (name
);
918 multibyte
= STRING_MULTIBYTE (name
);
919 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
922 default_directory
= string_to_multibyte (default_directory
);
925 name
= string_to_multibyte (name
);
934 /* We will force directory separators to be either all \ or /, so make
935 a local copy to modify, even if there ends up being no change. */
936 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
939 /* Note if special escape prefix is present, but remove for now. */
940 if (nm
[0] == '/' && nm
[1] == ':')
946 /* Find and remove drive specifier if present; this makes nm absolute
947 even if the rest of the name appears to be relative. Only look for
948 drive specifier at the beginning. */
949 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
956 /* If we see "c://somedir", we want to strip the first slash after the
957 colon when stripping the drive letter. Otherwise, this expands to
959 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
962 /* Discard any previous drive specifier if nm is now in UNC format. */
963 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
967 #endif /* WINDOWSNT */
970 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
971 none are found, we can probably return right away. We will avoid
972 allocating a new string if name is already fully expanded. */
974 IS_DIRECTORY_SEP (nm
[0])
976 && drive
&& !is_escaped
979 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
983 /* If it turns out that the filename we want to return is just a
984 suffix of FILENAME, we don't need to go through and edit
985 things; we just need to construct a new string using data
986 starting at the middle of FILENAME. If we set lose to a
987 non-zero value, that means we've discovered that we can't do
990 unsigned char *p
= nm
;
994 /* Since we know the name is absolute, we can assume that each
995 element starts with a "/". */
997 /* "." and ".." are hairy. */
998 if (IS_DIRECTORY_SEP (p
[0])
1000 && (IS_DIRECTORY_SEP (p
[2])
1002 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1005 /* We want to replace multiple `/' in a row with a single
1008 && IS_DIRECTORY_SEP (p
[0])
1009 && IS_DIRECTORY_SEP (p
[1]))
1016 /* Make sure directories are all separated with / or \ as
1017 desired, but avoid allocation of a new string when not
1019 CORRECT_DIR_SEPS (nm
);
1021 if (IS_DIRECTORY_SEP (nm
[1]))
1023 if (strcmp (nm
, SDATA (name
)) != 0)
1024 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1028 /* drive must be set, so this is okay */
1029 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1033 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1034 temp
[0] = DRIVE_LETTER (drive
);
1035 name
= concat2 (build_string (temp
), name
);
1038 #else /* not DOS_NT */
1039 if (nm
== SDATA (name
))
1041 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1042 #endif /* not DOS_NT */
1046 /* At this point, nm might or might not be an absolute file name. We
1047 need to expand ~ or ~user if present, otherwise prefix nm with
1048 default_directory if nm is not absolute, and finally collapse /./
1049 and /foo/../ sequences.
1051 We set newdir to be the appropriate prefix if one is needed:
1052 - the relevant user directory if nm starts with ~ or ~user
1053 - the specified drive's working dir (DOS/NT only) if nm does not
1055 - the value of default_directory.
1057 Note that these prefixes are not guaranteed to be absolute (except
1058 for the working dir of a drive). Therefore, to ensure we always
1059 return an absolute name, if the final prefix is not absolute we
1060 append it to the current working directory. */
1064 if (nm
[0] == '~') /* prefix ~ */
1066 if (IS_DIRECTORY_SEP (nm
[1])
1067 || nm
[1] == 0) /* ~ by itself */
1071 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1072 newdir
= (unsigned char *) "";
1074 /* egetenv may return a unibyte string, which will bite us since
1075 we expect the directory to be multibyte. */
1076 tem
= build_string (newdir
);
1077 if (!STRING_MULTIBYTE (tem
))
1079 /* FIXME: DECODE_FILE may GC, which may move SDATA(name),
1080 after which `nm' won't point to the right place any more. */
1081 int offset
= nm
- SDATA (name
);
1082 hdir
= DECODE_FILE (tem
);
1083 newdir
= SDATA (hdir
);
1085 nm
= SDATA (name
) + offset
;
1088 collapse_newdir
= 0;
1091 else /* ~user/filename */
1093 unsigned char *o
, *p
;
1094 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)); p
++);
1095 o
= alloca (p
- nm
+ 1);
1096 bcopy ((char *) nm
, o
, p
- nm
);
1100 pw
= (struct passwd
*) getpwnam (o
+ 1);
1104 newdir
= (unsigned char *) pw
-> pw_dir
;
1107 collapse_newdir
= 0;
1111 /* If we don't find a user of that name, leave the name
1112 unchanged; don't move nm forward to p. */
1117 /* On DOS and Windows, nm is absolute if a drive name was specified;
1118 use the drive's current directory as the prefix if needed. */
1119 if (!newdir
&& drive
)
1121 /* Get default directory if needed to make nm absolute. */
1122 if (!IS_DIRECTORY_SEP (nm
[0]))
1124 newdir
= alloca (MAXPATHLEN
+ 1);
1125 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1130 /* Either nm starts with /, or drive isn't mounted. */
1131 newdir
= alloca (4);
1132 newdir
[0] = DRIVE_LETTER (drive
);
1140 /* Finally, if no prefix has been specified and nm is not absolute,
1141 then it must be expanded relative to default_directory. */
1145 /* /... alone is not absolute on DOS and Windows. */
1146 && !IS_DIRECTORY_SEP (nm
[0])
1149 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1153 newdir
= SDATA (default_directory
);
1155 /* Note if special escape prefix is present, but remove for now. */
1156 if (newdir
[0] == '/' && newdir
[1] == ':')
1167 /* First ensure newdir is an absolute name. */
1169 /* Detect MSDOS file names with drive specifiers. */
1170 ! (IS_DRIVE (newdir
[0])
1171 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1173 /* Detect Windows file names in UNC format. */
1174 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1178 /* Effectively, let newdir be (expand-file-name newdir cwd).
1179 Because of the admonition against calling expand-file-name
1180 when we have pointers into lisp strings, we accomplish this
1181 indirectly by prepending newdir to nm if necessary, and using
1182 cwd (or the wd of newdir's drive) as the new newdir. */
1184 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1189 if (!IS_DIRECTORY_SEP (nm
[0]))
1191 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1192 file_name_as_directory (tmp
, newdir
);
1196 newdir
= alloca (MAXPATHLEN
+ 1);
1199 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1206 /* Strip off drive name from prefix, if present. */
1207 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1213 /* Keep only a prefix from newdir if nm starts with slash
1214 (//server/share for UNC, nothing otherwise). */
1215 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1218 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1221 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1223 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1225 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1237 /* Get rid of any slash at the end of newdir, unless newdir is
1238 just / or // (an incomplete UNC name). */
1239 length
= strlen (newdir
);
1240 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1242 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1246 unsigned char *temp
= (unsigned char *) alloca (length
);
1247 bcopy (newdir
, temp
, length
- 1);
1248 temp
[length
- 1] = 0;
1256 /* Now concatenate the directory and name to new space in the stack frame */
1257 tlen
+= strlen (nm
) + 1;
1259 /* Reserve space for drive specifier and escape prefix, since either
1260 or both may need to be inserted. (The Microsoft x86 compiler
1261 produces incorrect code if the following two lines are combined.) */
1262 target
= (unsigned char *) alloca (tlen
+ 4);
1264 #else /* not DOS_NT */
1265 target
= (unsigned char *) alloca (tlen
);
1266 #endif /* not DOS_NT */
1271 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1274 /* If newdir is effectively "C:/", then the drive letter will have
1275 been stripped and newdir will be "/". Concatenating with an
1276 absolute directory in nm produces "//", which will then be
1277 incorrectly treated as a network share. Ignore newdir in
1278 this case (keeping the drive letter). */
1279 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1280 && newdir
[1] == '\0'))
1282 strcpy (target
, newdir
);
1285 file_name_as_directory (target
, newdir
);
1288 strcat (target
, nm
);
1290 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1293 unsigned char *p
= target
;
1294 unsigned char *o
= target
;
1298 if (!IS_DIRECTORY_SEP (*p
))
1302 else if (p
[1] == '.'
1303 && (IS_DIRECTORY_SEP (p
[2])
1306 /* If "/." is the entire filename, keep the "/". Otherwise,
1307 just delete the whole "/.". */
1308 if (o
== target
&& p
[2] == '\0')
1312 else if (p
[1] == '.' && p
[2] == '.'
1313 /* `/../' is the "superroot" on certain file systems.
1314 Turned off on DOS_NT systems because they have no
1315 "superroot" and because this causes us to produce
1316 file names like "d:/../foo" which fail file-related
1317 functions of the underlying OS. (To reproduce, try a
1318 long series of "../../" in default_directory, longer
1319 than the number of levels from the root.) */
1323 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1325 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1327 /* Keep initial / only if this is the whole name. */
1328 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1332 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1333 /* Collapse multiple `/' in a row. */
1342 /* At last, set drive name. */
1344 /* Except for network file name. */
1345 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1346 #endif /* WINDOWSNT */
1348 if (!drive
) abort ();
1350 target
[0] = DRIVE_LETTER (drive
);
1353 /* Reinsert the escape prefix if required. */
1360 CORRECT_DIR_SEPS (target
);
1363 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1366 /* Again look to see if the file name has special constructs in it
1367 and perhaps call the corresponding file handler. This is needed
1368 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1369 the ".." component gives us "/user@host:/bar/../baz" which needs
1370 to be expanded again. */
1371 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1372 if (!NILP (handler
))
1373 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1379 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1380 This is the old version of expand-file-name, before it was thoroughly
1381 rewritten for Emacs 10.31. We leave this version here commented-out,
1382 because the code is very complex and likely to have subtle bugs. If
1383 bugs _are_ found, it might be of interest to look at the old code and
1384 see what did it do in the relevant situation.
1386 Don't remove this code: it's true that it will be accessible via CVS,
1387 but a few years from deletion, people will forget it is there. */
1389 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1390 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1391 "Convert FILENAME to absolute, and canonicalize it.\n\
1392 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1393 \(does not start with slash); if DEFAULT is nil or missing,\n\
1394 the current buffer's value of default-directory is used.\n\
1395 Filenames containing `.' or `..' as components are simplified;\n\
1396 initial `~/' expands to your home directory.\n\
1397 See also the function `substitute-in-file-name'.")
1399 Lisp_Object name
, defalt
;
1403 register unsigned char *newdir
, *p
, *o
;
1405 unsigned char *target
;
1409 CHECK_STRING (name
);
1412 /* If nm is absolute, flush ...// and detect /./ and /../.
1413 If no /./ or /../ we can return right away. */
1420 if (p
[0] == '/' && p
[1] == '/'
1423 if (p
[0] == '/' && p
[1] == '~')
1424 nm
= p
+ 1, lose
= 1;
1425 if (p
[0] == '/' && p
[1] == '.'
1426 && (p
[2] == '/' || p
[2] == 0
1427 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1433 if (nm
== SDATA (name
))
1435 return build_string (nm
);
1439 /* Now determine directory to start with and put it in NEWDIR */
1443 if (nm
[0] == '~') /* prefix ~ */
1444 if (nm
[1] == '/' || nm
[1] == 0)/* ~/filename */
1446 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1447 newdir
= (unsigned char *) "";
1450 else /* ~user/filename */
1452 /* Get past ~ to user */
1453 unsigned char *user
= nm
+ 1;
1454 /* Find end of name. */
1455 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1456 int len
= ptr
? ptr
- user
: strlen (user
);
1457 /* Copy the user name into temp storage. */
1458 o
= (unsigned char *) alloca (len
+ 1);
1459 bcopy ((char *) user
, o
, len
);
1462 /* Look up the user name. */
1464 pw
= (struct passwd
*) getpwnam (o
+ 1);
1467 error ("\"%s\" isn't a registered user", o
+ 1);
1469 newdir
= (unsigned char *) pw
->pw_dir
;
1471 /* Discard the user name from NM. */
1475 if (nm
[0] != '/' && !newdir
)
1478 defalt
= current_buffer
->directory
;
1479 CHECK_STRING (defalt
);
1480 newdir
= SDATA (defalt
);
1483 /* Now concatenate the directory and name to new space in the stack frame */
1485 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1486 target
= (unsigned char *) alloca (tlen
);
1491 if (nm
[0] == 0 || nm
[0] == '/')
1492 strcpy (target
, newdir
);
1494 file_name_as_directory (target
, newdir
);
1497 strcat (target
, nm
);
1499 /* Now canonicalize by removing /. and /foo/.. if they appear */
1510 else if (!strncmp (p
, "//", 2)
1516 else if (p
[0] == '/' && p
[1] == '.'
1517 && (p
[2] == '/' || p
[2] == 0))
1519 else if (!strncmp (p
, "/..", 3)
1520 /* `/../' is the "superroot" on certain file systems. */
1522 && (p
[3] == '/' || p
[3] == 0))
1524 while (o
!= target
&& *--o
!= '/')
1526 if (o
== target
&& *o
== '/')
1536 return make_string (target
, o
- target
);
1540 /* If /~ or // appears, discard everything through first slash. */
1542 file_name_absolute_p (filename
)
1543 const unsigned char *filename
;
1546 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
1548 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
1549 && IS_DIRECTORY_SEP (filename
[2]))
1554 static unsigned char *
1555 search_embedded_absfilename (nm
, endp
)
1556 unsigned char *nm
, *endp
;
1558 unsigned char *p
, *s
;
1560 for (p
= nm
+ 1; p
< endp
; p
++)
1563 || IS_DIRECTORY_SEP (p
[-1]))
1564 && file_name_absolute_p (p
)
1565 #if defined (WINDOWSNT) || defined(CYGWIN)
1566 /* // at start of file name is meaningful in Apollo,
1567 WindowsNT and Cygwin systems. */
1568 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
1569 #endif /* not (WINDOWSNT || CYGWIN) */
1572 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)); s
++);
1573 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
1575 unsigned char *o
= alloca (s
- p
+ 1);
1577 bcopy (p
, o
, s
- p
);
1580 /* If we have ~user and `user' exists, discard
1581 everything up to ~. But if `user' does not exist, leave
1582 ~user alone, it might be a literal file name. */
1584 pw
= getpwnam (o
+ 1);
1596 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1597 Ssubstitute_in_file_name
, 1, 1, 0,
1598 doc
: /* Substitute environment variables referred to in FILENAME.
1599 `$FOO' where FOO is an environment variable name means to substitute
1600 the value of that variable. The variable name should be terminated
1601 with a character not a letter, digit or underscore; otherwise, enclose
1602 the entire variable name in braces.
1603 If `/~' appears, all of FILENAME through that `/' is discarded. */)
1605 Lisp_Object filename
;
1609 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1610 unsigned char *target
= NULL
;
1612 int substituted
= 0;
1614 Lisp_Object handler
;
1616 CHECK_STRING (filename
);
1618 /* If the file name has special constructs in it,
1619 call the corresponding file handler. */
1620 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1621 if (!NILP (handler
))
1622 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1624 nm
= SDATA (filename
);
1626 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1627 CORRECT_DIR_SEPS (nm
);
1628 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
1630 endp
= nm
+ SBYTES (filename
);
1632 /* If /~ or // appears, discard everything through first slash. */
1633 p
= search_embedded_absfilename (nm
, endp
);
1635 /* Start over with the new string, so we check the file-name-handler
1636 again. Important with filenames like "/home/foo//:/hello///there"
1637 which whould substitute to "/:/hello///there" rather than "/there". */
1638 return Fsubstitute_in_file_name
1639 (make_specified_string (p
, -1, endp
- p
,
1640 STRING_MULTIBYTE (filename
)));
1643 /* See if any variables are substituted into the string
1644 and find the total length of their values in `total' */
1646 for (p
= nm
; p
!= endp
;)
1656 /* "$$" means a single "$" */
1665 while (p
!= endp
&& *p
!= '}') p
++;
1666 if (*p
!= '}') goto missingclose
;
1672 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1676 /* Copy out the variable name */
1677 target
= (unsigned char *) alloca (s
- o
+ 1);
1678 strncpy (target
, o
, s
- o
);
1681 strupr (target
); /* $home == $HOME etc. */
1684 /* Get variable value */
1685 o
= (unsigned char *) egetenv (target
);
1687 { /* Eight-bit chars occupy upto 2 bytes in multibyte. */
1688 total
+= strlen (o
) * (STRING_MULTIBYTE (filename
) ? 2 : 1);
1698 /* If substitution required, recopy the string and do it */
1699 /* Make space in stack frame for the new copy */
1700 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
1703 /* Copy the rest of the name through, replacing $ constructs with values */
1720 while (p
!= endp
&& *p
!= '}') p
++;
1721 if (*p
!= '}') goto missingclose
;
1727 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1731 /* Copy out the variable name */
1732 target
= (unsigned char *) alloca (s
- o
+ 1);
1733 strncpy (target
, o
, s
- o
);
1736 strupr (target
); /* $home == $HOME etc. */
1739 /* Get variable value */
1740 o
= (unsigned char *) egetenv (target
);
1744 strcpy (x
, target
); x
+= strlen (target
);
1746 else if (STRING_MULTIBYTE (filename
))
1748 /* If the original string is multibyte,
1749 convert what we substitute into multibyte. */
1753 c
= unibyte_char_to_multibyte (c
);
1754 x
+= CHAR_STRING (c
, x
);
1766 /* If /~ or // appears, discard everything through first slash. */
1767 while ((p
= search_embedded_absfilename (xnm
, x
)))
1768 /* This time we do not start over because we've already expanded envvars
1769 and replaced $$ with $. Maybe we should start over as well, but we'd
1770 need to quote some $ to $$ first. */
1773 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
1776 error ("Bad format environment-variable substitution");
1778 error ("Missing \"}\" in environment-variable substitution");
1780 error ("Substituting nonexistent environment variable \"%s\"", target
);
1786 /* A slightly faster and more convenient way to get
1787 (directory-file-name (expand-file-name FOO)). */
1790 expand_and_dir_to_file (filename
, defdir
)
1791 Lisp_Object filename
, defdir
;
1793 register Lisp_Object absname
;
1795 absname
= Fexpand_file_name (filename
, defdir
);
1797 /* Remove final slash, if any (unless this is the root dir).
1798 stat behaves differently depending! */
1799 if (SCHARS (absname
) > 1
1800 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
1801 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
1802 /* We cannot take shortcuts; they might be wrong for magic file names. */
1803 absname
= Fdirectory_file_name (absname
);
1807 /* Signal an error if the file ABSNAME already exists.
1808 If INTERACTIVE is nonzero, ask the user whether to proceed,
1809 and bypass the error if the user says to go ahead.
1810 QUERYSTRING is a name for the action that is being considered
1813 *STATPTR is used to store the stat information if the file exists.
1814 If the file does not exist, STATPTR->st_mode is set to 0.
1815 If STATPTR is null, we don't store into it.
1817 If QUICK is nonzero, we ask for y or n, not yes or no. */
1820 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
1821 Lisp_Object absname
;
1822 unsigned char *querystring
;
1824 struct stat
*statptr
;
1827 register Lisp_Object tem
, encoded_filename
;
1828 struct stat statbuf
;
1829 struct gcpro gcpro1
;
1831 encoded_filename
= ENCODE_FILE (absname
);
1833 /* stat is a good way to tell whether the file exists,
1834 regardless of what access permissions it has. */
1835 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
1838 xsignal2 (Qfile_already_exists
,
1839 build_string ("File already exists"), absname
);
1841 tem
= format2 ("File %s already exists; %s anyway? ",
1842 absname
, build_string (querystring
));
1844 tem
= Fy_or_n_p (tem
);
1846 tem
= do_yes_or_no_p (tem
);
1849 xsignal2 (Qfile_already_exists
,
1850 build_string ("File already exists"), absname
);
1857 statptr
->st_mode
= 0;
1862 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
1863 "fCopy file: \nGCopy %s to file: \np\nP",
1864 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
1865 If NEWNAME names a directory, copy FILE there.
1867 This function always sets the file modes of the output file to match
1870 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1871 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1872 signal a `file-already-exists' error without overwriting. If
1873 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1874 about overwriting; this is what happens in interactive use with M-x.
1875 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1878 Fourth arg KEEP-TIME non-nil means give the output file the same
1879 last-modified time as the old one. (This works on only some systems.)
1881 A prefix arg makes KEEP-TIME non-nil.
1883 If PRESERVE-UID-GID is non-nil, we try to transfer the
1884 uid and gid of FILE to NEWNAME. */)
1885 (file
, newname
, ok_if_already_exists
, keep_time
, preserve_uid_gid
)
1886 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
1887 Lisp_Object preserve_uid_gid
;
1890 char buf
[16 * 1024];
1891 struct stat st
, out_st
;
1892 Lisp_Object handler
;
1893 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1894 int count
= SPECPDL_INDEX ();
1895 int input_file_statable_p
;
1896 Lisp_Object encoded_file
, encoded_newname
;
1898 encoded_file
= encoded_newname
= Qnil
;
1899 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
1900 CHECK_STRING (file
);
1901 CHECK_STRING (newname
);
1903 if (!NILP (Ffile_directory_p (newname
)))
1904 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
1906 newname
= Fexpand_file_name (newname
, Qnil
);
1908 file
= Fexpand_file_name (file
, Qnil
);
1910 /* If the input file name has special constructs in it,
1911 call the corresponding file handler. */
1912 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1913 /* Likewise for output file name. */
1915 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1916 if (!NILP (handler
))
1917 RETURN_UNGCPRO (call6 (handler
, Qcopy_file
, file
, newname
,
1918 ok_if_already_exists
, keep_time
, preserve_uid_gid
));
1920 encoded_file
= ENCODE_FILE (file
);
1921 encoded_newname
= ENCODE_FILE (newname
);
1923 if (NILP (ok_if_already_exists
)
1924 || INTEGERP (ok_if_already_exists
))
1925 barf_or_query_if_file_exists (newname
, "copy to it",
1926 INTEGERP (ok_if_already_exists
), &out_st
, 0);
1927 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
1931 if (!CopyFile (SDATA (encoded_file
),
1932 SDATA (encoded_newname
),
1934 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
1935 /* CopyFile retains the timestamp by default. */
1936 else if (NILP (keep_time
))
1942 EMACS_GET_TIME (now
);
1943 filename
= SDATA (encoded_newname
);
1945 /* Ensure file is writable while its modified time is set. */
1946 attributes
= GetFileAttributes (filename
);
1947 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
1948 if (set_file_times (filename
, now
, now
))
1950 /* Restore original attributes. */
1951 SetFileAttributes (filename
, attributes
);
1952 xsignal2 (Qfile_date_error
,
1953 build_string ("Cannot set file date"), newname
);
1955 /* Restore original attributes. */
1956 SetFileAttributes (filename
, attributes
);
1958 #else /* not WINDOWSNT */
1960 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
1964 report_file_error ("Opening input file", Fcons (file
, Qnil
));
1966 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1968 /* We can only copy regular files and symbolic links. Other files are not
1970 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1972 #if !defined (MSDOS) || __DJGPP__ > 1
1973 if (out_st
.st_mode
!= 0
1974 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
1977 report_file_error ("Input and output files are the same",
1978 Fcons (file
, Fcons (newname
, Qnil
)));
1982 #if defined (S_ISREG) && defined (S_ISLNK)
1983 if (input_file_statable_p
)
1985 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1987 #if defined (EISDIR)
1988 /* Get a better looking error message. */
1991 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
1994 #endif /* S_ISREG && S_ISLNK */
1997 /* System's default file type was set to binary by _fmode in emacs.c. */
1998 ofd
= emacs_open (SDATA (encoded_newname
),
1999 O_WRONLY
| O_TRUNC
| O_CREAT
2000 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2001 S_IREAD
| S_IWRITE
);
2002 #else /* not MSDOS */
2003 ofd
= emacs_open (SDATA (encoded_newname
),
2004 O_WRONLY
| O_TRUNC
| O_CREAT
2005 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2007 #endif /* not MSDOS */
2009 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2011 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2015 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2016 if (emacs_write (ofd
, buf
, n
) != n
)
2017 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2021 /* Preserve the original file modes, and if requested, also its
2023 if (input_file_statable_p
)
2025 if (! NILP (preserve_uid_gid
))
2026 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2027 fchmod (ofd
, st
.st_mode
& 07777);
2029 #endif /* not MSDOS */
2031 /* Closing the output clobbers the file times on some systems. */
2032 if (emacs_close (ofd
) < 0)
2033 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2035 if (input_file_statable_p
)
2037 if (!NILP (keep_time
))
2039 EMACS_TIME atime
, mtime
;
2040 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2041 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2042 if (set_file_times (SDATA (encoded_newname
),
2044 xsignal2 (Qfile_date_error
,
2045 build_string ("Cannot set file date"), newname
);
2051 #if defined (__DJGPP__) && __DJGPP__ > 1
2052 if (input_file_statable_p
)
2054 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2055 and if it can't, it tells so. Otherwise, under MSDOS we usually
2056 get only the READ bit, which will make the copied file read-only,
2057 so it's better not to chmod at all. */
2058 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2059 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2061 #endif /* DJGPP version 2 or newer */
2062 #endif /* not WINDOWSNT */
2064 /* Discard the unwind protects. */
2065 specpdl_ptr
= specpdl
+ count
;
2071 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2072 Smake_directory_internal
, 1, 1, 0,
2073 doc
: /* Create a new directory named DIRECTORY. */)
2075 Lisp_Object directory
;
2077 const unsigned char *dir
;
2078 Lisp_Object handler
;
2079 Lisp_Object encoded_dir
;
2081 CHECK_STRING (directory
);
2082 directory
= Fexpand_file_name (directory
, Qnil
);
2084 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2085 if (!NILP (handler
))
2086 return call2 (handler
, Qmake_directory_internal
, directory
);
2088 encoded_dir
= ENCODE_FILE (directory
);
2090 dir
= SDATA (encoded_dir
);
2093 if (mkdir (dir
) != 0)
2095 if (mkdir (dir
, 0777) != 0)
2097 report_file_error ("Creating directory", list1 (directory
));
2102 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2103 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2105 Lisp_Object directory
;
2107 const unsigned char *dir
;
2108 Lisp_Object handler
;
2109 Lisp_Object encoded_dir
;
2111 CHECK_STRING (directory
);
2112 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2114 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2115 if (!NILP (handler
))
2116 return call2 (handler
, Qdelete_directory
, directory
);
2118 if (delete_by_moving_to_trash
)
2119 return call1 (Qmove_file_to_trash
, directory
);
2121 encoded_dir
= ENCODE_FILE (directory
);
2123 dir
= SDATA (encoded_dir
);
2125 if (rmdir (dir
) != 0)
2126 report_file_error ("Removing directory", list1 (directory
));
2131 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2132 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2133 If file has multiple names, it continues to exist with the other names. */)
2135 Lisp_Object filename
;
2137 Lisp_Object handler
;
2138 Lisp_Object encoded_file
;
2139 struct gcpro gcpro1
;
2142 if (!NILP (Ffile_directory_p (filename
))
2143 && NILP (Ffile_symlink_p (filename
)))
2144 xsignal2 (Qfile_error
,
2145 build_string ("Removing old name: is a directory"),
2148 filename
= Fexpand_file_name (filename
, Qnil
);
2150 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2151 if (!NILP (handler
))
2152 return call2 (handler
, Qdelete_file
, filename
);
2154 if (delete_by_moving_to_trash
)
2155 return call1 (Qmove_file_to_trash
, filename
);
2157 encoded_file
= ENCODE_FILE (filename
);
2159 if (0 > unlink (SDATA (encoded_file
)))
2160 report_file_error ("Removing old name", list1 (filename
));
2165 internal_delete_file_1 (ignore
)
2171 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2174 internal_delete_file (filename
)
2175 Lisp_Object filename
;
2178 tem
= internal_condition_case_1 (Fdelete_file
, filename
,
2179 Qt
, internal_delete_file_1
);
2183 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2184 "fRename file: \nGRename %s to file: \np",
2185 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2186 If file has names other than FILE, it continues to have those names.
2187 Signals a `file-already-exists' error if a file NEWNAME already exists
2188 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2189 A number as third arg means request confirmation if NEWNAME already exists.
2190 This is what happens in interactive use with M-x. */)
2191 (file
, newname
, ok_if_already_exists
)
2192 Lisp_Object file
, newname
, ok_if_already_exists
;
2194 Lisp_Object handler
;
2195 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2196 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2198 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2199 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2200 CHECK_STRING (file
);
2201 CHECK_STRING (newname
);
2202 file
= Fexpand_file_name (file
, Qnil
);
2204 if ((!NILP (Ffile_directory_p (newname
)))
2206 /* If the file names are identical but for the case,
2207 don't attempt to move directory to itself. */
2208 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2211 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2213 newname
= Fexpand_file_name (newname
, Qnil
);
2215 /* If the file name has special constructs in it,
2216 call the corresponding file handler. */
2217 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2219 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2220 if (!NILP (handler
))
2221 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2222 file
, newname
, ok_if_already_exists
));
2224 encoded_file
= ENCODE_FILE (file
);
2225 encoded_newname
= ENCODE_FILE (newname
);
2228 /* If the file names are identical but for the case, don't ask for
2229 confirmation: they simply want to change the letter-case of the
2231 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2233 if (NILP (ok_if_already_exists
)
2234 || INTEGERP (ok_if_already_exists
))
2235 barf_or_query_if_file_exists (newname
, "rename to it",
2236 INTEGERP (ok_if_already_exists
), 0, 0);
2237 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2242 symlink_target
= Ffile_symlink_p (file
);
2243 if (! NILP (symlink_target
))
2244 Fmake_symbolic_link (symlink_target
, newname
,
2245 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2248 Fcopy_file (file
, newname
,
2249 /* We have already prompted if it was an integer,
2250 so don't have copy-file prompt again. */
2251 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2254 Fdelete_file (file
);
2257 report_file_error ("Renaming", list2 (file
, newname
));
2263 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2264 "fAdd name to file: \nGName to add to %s: \np",
2265 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2266 Signals a `file-already-exists' error if a file NEWNAME already exists
2267 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2268 A number as third arg means request confirmation if NEWNAME already exists.
2269 This is what happens in interactive use with M-x. */)
2270 (file
, newname
, ok_if_already_exists
)
2271 Lisp_Object file
, newname
, ok_if_already_exists
;
2273 Lisp_Object handler
;
2274 Lisp_Object encoded_file
, encoded_newname
;
2275 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2277 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2278 encoded_file
= encoded_newname
= Qnil
;
2279 CHECK_STRING (file
);
2280 CHECK_STRING (newname
);
2281 file
= Fexpand_file_name (file
, Qnil
);
2283 if (!NILP (Ffile_directory_p (newname
)))
2284 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2286 newname
= Fexpand_file_name (newname
, Qnil
);
2288 /* If the file name has special constructs in it,
2289 call the corresponding file handler. */
2290 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2291 if (!NILP (handler
))
2292 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2293 newname
, ok_if_already_exists
));
2295 /* If the new name has special constructs in it,
2296 call the corresponding file handler. */
2297 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2298 if (!NILP (handler
))
2299 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2300 newname
, ok_if_already_exists
));
2302 encoded_file
= ENCODE_FILE (file
);
2303 encoded_newname
= ENCODE_FILE (newname
);
2305 if (NILP (ok_if_already_exists
)
2306 || INTEGERP (ok_if_already_exists
))
2307 barf_or_query_if_file_exists (newname
, "make it a new name",
2308 INTEGERP (ok_if_already_exists
), 0, 0);
2310 unlink (SDATA (newname
));
2311 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2312 report_file_error ("Adding new name", list2 (file
, newname
));
2318 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2319 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2320 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2321 Both args must be strings.
2322 Signals a `file-already-exists' error if a file LINKNAME already exists
2323 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2324 A number as third arg means request confirmation if LINKNAME already exists.
2325 This happens for interactive use with M-x. */)
2326 (filename
, linkname
, ok_if_already_exists
)
2327 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2329 Lisp_Object handler
;
2330 Lisp_Object encoded_filename
, encoded_linkname
;
2331 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2333 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2334 encoded_filename
= encoded_linkname
= Qnil
;
2335 CHECK_STRING (filename
);
2336 CHECK_STRING (linkname
);
2337 /* If the link target has a ~, we must expand it to get
2338 a truly valid file name. Otherwise, do not expand;
2339 we want to permit links to relative file names. */
2340 if (SREF (filename
, 0) == '~')
2341 filename
= Fexpand_file_name (filename
, Qnil
);
2343 if (!NILP (Ffile_directory_p (linkname
)))
2344 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2346 linkname
= Fexpand_file_name (linkname
, Qnil
);
2348 /* If the file name has special constructs in it,
2349 call the corresponding file handler. */
2350 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2351 if (!NILP (handler
))
2352 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2353 linkname
, ok_if_already_exists
));
2355 /* If the new link name has special constructs in it,
2356 call the corresponding file handler. */
2357 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2358 if (!NILP (handler
))
2359 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2360 linkname
, ok_if_already_exists
));
2363 encoded_filename
= ENCODE_FILE (filename
);
2364 encoded_linkname
= ENCODE_FILE (linkname
);
2366 if (NILP (ok_if_already_exists
)
2367 || INTEGERP (ok_if_already_exists
))
2368 barf_or_query_if_file_exists (linkname
, "make it a link",
2369 INTEGERP (ok_if_already_exists
), 0, 0);
2370 if (0 > symlink (SDATA (encoded_filename
),
2371 SDATA (encoded_linkname
)))
2373 /* If we didn't complain already, silently delete existing file. */
2374 if (errno
== EEXIST
)
2376 unlink (SDATA (encoded_linkname
));
2377 if (0 <= symlink (SDATA (encoded_filename
),
2378 SDATA (encoded_linkname
)))
2385 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2392 xsignal1 (Qfile_error
, build_string ("Symbolic links are not supported"));
2394 #endif /* S_IFLNK */
2398 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2400 doc
: /* Return t if file FILENAME specifies an absolute file name.
2401 On Unix, this is a name starting with a `/' or a `~'. */)
2403 Lisp_Object filename
;
2405 CHECK_STRING (filename
);
2406 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
2409 /* Return nonzero if file FILENAME exists and can be executed. */
2412 check_executable (filename
)
2416 int len
= strlen (filename
);
2419 if (stat (filename
, &st
) < 0)
2421 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2422 return ((st
.st_mode
& S_IEXEC
) != 0);
2424 return (S_ISREG (st
.st_mode
)
2426 && (xstrcasecmp ((suffix
= filename
+ len
-4), ".com") == 0
2427 || xstrcasecmp (suffix
, ".exe") == 0
2428 || xstrcasecmp (suffix
, ".bat") == 0)
2429 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2430 #endif /* not WINDOWSNT */
2431 #else /* not DOS_NT */
2432 #ifdef HAVE_EUIDACCESS
2433 return (euidaccess (filename
, 1) >= 0);
2435 /* Access isn't quite right because it uses the real uid
2436 and we really want to test with the effective uid.
2437 But Unix doesn't give us a right way to do it. */
2438 return (access (filename
, 1) >= 0);
2440 #endif /* not DOS_NT */
2443 /* Return nonzero if file FILENAME exists and can be written. */
2446 check_writable (filename
)
2451 if (stat (filename
, &st
) < 0)
2453 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2454 #else /* not MSDOS */
2455 #ifdef HAVE_EUIDACCESS
2456 return (euidaccess (filename
, 2) >= 0);
2458 /* Access isn't quite right because it uses the real uid
2459 and we really want to test with the effective uid.
2460 But Unix doesn't give us a right way to do it.
2461 Opening with O_WRONLY could work for an ordinary file,
2462 but would lose for directories. */
2463 return (access (filename
, 2) >= 0);
2465 #endif /* not MSDOS */
2468 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2469 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
2470 See also `file-readable-p' and `file-attributes'.
2471 This returns nil for a symlink to a nonexistent file.
2472 Use `file-symlink-p' to test for such links. */)
2474 Lisp_Object filename
;
2476 Lisp_Object absname
;
2477 Lisp_Object handler
;
2478 struct stat statbuf
;
2480 CHECK_STRING (filename
);
2481 absname
= Fexpand_file_name (filename
, Qnil
);
2483 /* If the file name has special constructs in it,
2484 call the corresponding file handler. */
2485 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2486 if (!NILP (handler
))
2487 return call2 (handler
, Qfile_exists_p
, absname
);
2489 absname
= ENCODE_FILE (absname
);
2491 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
2494 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2495 doc
: /* Return t if FILENAME can be executed by you.
2496 For a directory, this means you can access files in that directory. */)
2498 Lisp_Object filename
;
2500 Lisp_Object absname
;
2501 Lisp_Object handler
;
2503 CHECK_STRING (filename
);
2504 absname
= Fexpand_file_name (filename
, Qnil
);
2506 /* If the file name has special constructs in it,
2507 call the corresponding file handler. */
2508 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2509 if (!NILP (handler
))
2510 return call2 (handler
, Qfile_executable_p
, absname
);
2512 absname
= ENCODE_FILE (absname
);
2514 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
2517 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2518 doc
: /* Return t if file FILENAME exists and you can read it.
2519 See also `file-exists-p' and `file-attributes'. */)
2521 Lisp_Object filename
;
2523 Lisp_Object absname
;
2524 Lisp_Object handler
;
2527 struct stat statbuf
;
2529 CHECK_STRING (filename
);
2530 absname
= Fexpand_file_name (filename
, Qnil
);
2532 /* If the file name has special constructs in it,
2533 call the corresponding file handler. */
2534 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2535 if (!NILP (handler
))
2536 return call2 (handler
, Qfile_readable_p
, absname
);
2538 absname
= ENCODE_FILE (absname
);
2540 #if defined(DOS_NT) || defined(macintosh)
2541 /* Under MS-DOS, Windows, and Macintosh, open does not work for
2543 if (access (SDATA (absname
), 0) == 0)
2546 #else /* not DOS_NT and not macintosh */
2548 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2549 /* Opening a fifo without O_NONBLOCK can wait.
2550 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2551 except in the case of a fifo, on a system which handles it. */
2552 desc
= stat (SDATA (absname
), &statbuf
);
2555 if (S_ISFIFO (statbuf
.st_mode
))
2556 flags
|= O_NONBLOCK
;
2558 desc
= emacs_open (SDATA (absname
), flags
, 0);
2563 #endif /* not DOS_NT and not macintosh */
2566 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2568 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2569 doc
: /* Return t if file FILENAME can be written or created by you. */)
2571 Lisp_Object filename
;
2573 Lisp_Object absname
, dir
, encoded
;
2574 Lisp_Object handler
;
2575 struct stat statbuf
;
2577 CHECK_STRING (filename
);
2578 absname
= Fexpand_file_name (filename
, Qnil
);
2580 /* If the file name has special constructs in it,
2581 call the corresponding file handler. */
2582 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2583 if (!NILP (handler
))
2584 return call2 (handler
, Qfile_writable_p
, absname
);
2586 encoded
= ENCODE_FILE (absname
);
2587 if (stat (SDATA (encoded
), &statbuf
) >= 0)
2588 return (check_writable (SDATA (encoded
))
2591 dir
= Ffile_name_directory (absname
);
2594 dir
= Fdirectory_file_name (dir
);
2597 dir
= ENCODE_FILE (dir
);
2599 /* The read-only attribute of the parent directory doesn't affect
2600 whether a file or directory can be created within it. Some day we
2601 should check ACLs though, which do affect this. */
2602 if (stat (SDATA (dir
), &statbuf
) < 0)
2604 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2606 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
2611 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2612 doc
: /* Access file FILENAME, and get an error if that does not work.
2613 The second argument STRING is used in the error message.
2614 If there is no error, returns nil. */)
2616 Lisp_Object filename
, string
;
2618 Lisp_Object handler
, encoded_filename
, absname
;
2621 CHECK_STRING (filename
);
2622 absname
= Fexpand_file_name (filename
, Qnil
);
2624 CHECK_STRING (string
);
2626 /* If the file name has special constructs in it,
2627 call the corresponding file handler. */
2628 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
2629 if (!NILP (handler
))
2630 return call3 (handler
, Qaccess_file
, absname
, string
);
2632 encoded_filename
= ENCODE_FILE (absname
);
2634 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
2636 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
2642 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2643 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
2644 The value is the link target, as a string.
2645 Otherwise it returns nil.
2647 This function returns t when given the name of a symlink that
2648 points to a nonexistent file. */)
2650 Lisp_Object filename
;
2652 Lisp_Object handler
;
2654 CHECK_STRING (filename
);
2655 filename
= Fexpand_file_name (filename
, Qnil
);
2657 /* If the file name has special constructs in it,
2658 call the corresponding file handler. */
2659 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2660 if (!NILP (handler
))
2661 return call2 (handler
, Qfile_symlink_p
, filename
);
2670 filename
= ENCODE_FILE (filename
);
2677 buf
= (char *) xrealloc (buf
, bufsize
);
2678 bzero (buf
, bufsize
);
2681 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
2685 /* HP-UX reports ERANGE if buffer is too small. */
2686 if (errno
== ERANGE
)
2696 while (valsize
>= bufsize
);
2698 val
= make_string (buf
, valsize
);
2699 if (buf
[0] == '/' && index (buf
, ':'))
2700 val
= concat2 (build_string ("/:"), val
);
2702 val
= DECODE_FILE (val
);
2705 #else /* not S_IFLNK */
2707 #endif /* not S_IFLNK */
2710 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2711 doc
: /* Return t if FILENAME names an existing directory.
2712 Symbolic links to directories count as directories.
2713 See `file-symlink-p' to distinguish symlinks. */)
2715 Lisp_Object filename
;
2717 register Lisp_Object absname
;
2719 Lisp_Object handler
;
2721 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2723 /* If the file name has special constructs in it,
2724 call the corresponding file handler. */
2725 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2726 if (!NILP (handler
))
2727 return call2 (handler
, Qfile_directory_p
, absname
);
2729 absname
= ENCODE_FILE (absname
);
2731 if (stat (SDATA (absname
), &st
) < 0)
2733 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2736 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2737 doc
: /* Return t if file FILENAME names a directory you can open.
2738 For the value to be t, FILENAME must specify the name of a directory as a file,
2739 and the directory must allow you to open files in it. In order to use a
2740 directory as a buffer's current directory, this predicate must return true.
2741 A directory name spec may be given instead; then the value is t
2742 if the directory so specified exists and really is a readable and
2743 searchable directory. */)
2745 Lisp_Object filename
;
2747 Lisp_Object handler
;
2749 struct gcpro gcpro1
;
2751 /* If the file name has special constructs in it,
2752 call the corresponding file handler. */
2753 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2754 if (!NILP (handler
))
2755 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2758 tem
= (NILP (Ffile_directory_p (filename
))
2759 || NILP (Ffile_executable_p (filename
)));
2761 return tem
? Qnil
: Qt
;
2764 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2765 doc
: /* Return t if FILENAME names a regular file.
2766 This is the sort of file that holds an ordinary stream of data bytes.
2767 Symbolic links to regular files count as regular files.
2768 See `file-symlink-p' to distinguish symlinks. */)
2770 Lisp_Object filename
;
2772 register Lisp_Object absname
;
2774 Lisp_Object handler
;
2776 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2778 /* If the file name has special constructs in it,
2779 call the corresponding file handler. */
2780 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2781 if (!NILP (handler
))
2782 return call2 (handler
, Qfile_regular_p
, absname
);
2784 absname
= ENCODE_FILE (absname
);
2789 Lisp_Object tem
= Vw32_get_true_file_attributes
;
2791 /* Tell stat to use expensive method to get accurate info. */
2792 Vw32_get_true_file_attributes
= Qt
;
2793 result
= stat (SDATA (absname
), &st
);
2794 Vw32_get_true_file_attributes
= tem
;
2798 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2801 if (stat (SDATA (absname
), &st
) < 0)
2803 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2807 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2808 doc
: /* Return mode bits of file named FILENAME, as an integer.
2809 Return nil, if file does not exist or is not accessible. */)
2811 Lisp_Object filename
;
2813 Lisp_Object absname
;
2815 Lisp_Object handler
;
2817 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2819 /* If the file name has special constructs in it,
2820 call the corresponding file handler. */
2821 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2822 if (!NILP (handler
))
2823 return call2 (handler
, Qfile_modes
, absname
);
2825 absname
= ENCODE_FILE (absname
);
2827 if (stat (SDATA (absname
), &st
) < 0)
2829 #if defined (MSDOS) && __DJGPP__ < 2
2830 if (check_executable (SDATA (absname
)))
2831 st
.st_mode
|= S_IEXEC
;
2832 #endif /* MSDOS && __DJGPP__ < 2 */
2834 return make_number (st
.st_mode
& 07777);
2837 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
2838 "(let ((file (read-file-name \"File: \"))) \
2839 (list file (read-file-modes nil file)))",
2840 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
2841 Only the 12 low bits of MODE are used. */)
2843 Lisp_Object filename
, mode
;
2845 Lisp_Object absname
, encoded_absname
;
2846 Lisp_Object handler
;
2848 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2849 CHECK_NUMBER (mode
);
2851 /* If the file name has special constructs in it,
2852 call the corresponding file handler. */
2853 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2854 if (!NILP (handler
))
2855 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2857 encoded_absname
= ENCODE_FILE (absname
);
2859 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
2860 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2865 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2866 doc
: /* Set the file permission bits for newly created files.
2867 The argument MODE should be an integer; only the low 9 bits are used.
2868 This setting is inherited by subprocesses. */)
2872 CHECK_NUMBER (mode
);
2874 umask ((~ XINT (mode
)) & 0777);
2879 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2880 doc
: /* Return the default file protection for created files.
2881 The value is an integer. */)
2887 realmask
= umask (0);
2890 XSETINT (value
, (~ realmask
) & 0777);
2894 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
2896 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
2897 doc
: /* Set times of file FILENAME to TIME.
2898 Set both access and modification times.
2899 Return t on success, else nil.
2900 Use the current time if TIME is nil. TIME is in the format of
2903 Lisp_Object filename
, time
;
2905 Lisp_Object absname
, encoded_absname
;
2906 Lisp_Object handler
;
2910 if (! lisp_time_argument (time
, &sec
, &usec
))
2911 error ("Invalid time specification");
2913 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2915 /* If the file name has special constructs in it,
2916 call the corresponding file handler. */
2917 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
2918 if (!NILP (handler
))
2919 return call3 (handler
, Qset_file_times
, absname
, time
);
2921 encoded_absname
= ENCODE_FILE (absname
);
2926 EMACS_SET_SECS (t
, sec
);
2927 EMACS_SET_USECS (t
, usec
);
2929 if (set_file_times (SDATA (encoded_absname
), t
, t
))
2934 /* Setting times on a directory always fails. */
2935 if (stat (SDATA (encoded_absname
), &st
) == 0
2936 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
2939 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
2948 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2949 doc
: /* Tell Unix to finish all pending disk updates. */)
2956 #endif /* HAVE_SYNC */
2958 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2959 doc
: /* Return t if file FILE1 is newer than file FILE2.
2960 If FILE1 does not exist, the answer is nil;
2961 otherwise, if FILE2 does not exist, the answer is t. */)
2963 Lisp_Object file1
, file2
;
2965 Lisp_Object absname1
, absname2
;
2968 Lisp_Object handler
;
2969 struct gcpro gcpro1
, gcpro2
;
2971 CHECK_STRING (file1
);
2972 CHECK_STRING (file2
);
2975 GCPRO2 (absname1
, file2
);
2976 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2977 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2980 /* If the file name has special constructs in it,
2981 call the corresponding file handler. */
2982 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
2984 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
2985 if (!NILP (handler
))
2986 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
2988 GCPRO2 (absname1
, absname2
);
2989 absname1
= ENCODE_FILE (absname1
);
2990 absname2
= ENCODE_FILE (absname2
);
2993 if (stat (SDATA (absname1
), &st
) < 0)
2996 mtime1
= st
.st_mtime
;
2998 if (stat (SDATA (absname2
), &st
) < 0)
3001 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3005 Lisp_Object Qfind_buffer_file_type
;
3008 #ifndef READ_BUF_SIZE
3009 #define READ_BUF_SIZE (64 << 10)
3012 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3014 /* This function is called after Lisp functions to decide a coding
3015 system are called, or when they cause an error. Before they are
3016 called, the current buffer is set unibyte and it contains only a
3017 newly inserted text (thus the buffer was empty before the
3020 The functions may set markers, overlays, text properties, or even
3021 alter the buffer contents, change the current buffer.
3023 Here, we reset all those changes by:
3024 o set back the current buffer.
3025 o move all markers and overlays to BEG.
3026 o remove all text properties.
3027 o set back the buffer multibyteness. */
3030 decide_coding_unwind (unwind_data
)
3031 Lisp_Object unwind_data
;
3033 Lisp_Object multibyte
, undo_list
, buffer
;
3035 multibyte
= XCAR (unwind_data
);
3036 unwind_data
= XCDR (unwind_data
);
3037 undo_list
= XCAR (unwind_data
);
3038 buffer
= XCDR (unwind_data
);
3040 if (current_buffer
!= XBUFFER (buffer
))
3041 set_buffer_internal (XBUFFER (buffer
));
3042 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3043 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3044 BUF_INTERVALS (current_buffer
) = 0;
3045 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3047 /* Now we are safe to change the buffer's multibyteness directly. */
3048 current_buffer
->enable_multibyte_characters
= multibyte
;
3049 current_buffer
->undo_list
= undo_list
;
3055 /* Used to pass values from insert-file-contents to read_non_regular. */
3057 static int non_regular_fd
;
3058 static int non_regular_inserted
;
3059 static int non_regular_nbytes
;
3062 /* Read from a non-regular file.
3063 Read non_regular_trytry bytes max from non_regular_fd.
3064 Non_regular_inserted specifies where to put the read bytes.
3065 Value is the number of bytes read. */
3074 nbytes
= emacs_read (non_regular_fd
,
3075 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3076 non_regular_nbytes
);
3078 return make_number (nbytes
);
3082 /* Condition-case handler used when reading from non-regular files
3083 in insert-file-contents. */
3086 read_non_regular_quit ()
3092 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3094 doc
: /* Insert contents of file FILENAME after point.
3095 Returns list of absolute file name and number of characters inserted.
3096 If second argument VISIT is non-nil, the buffer's visited filename and
3097 last save file modtime are set, and it is marked unmodified. If
3098 visiting and the file does not exist, visiting is completed before the
3101 The optional third and fourth arguments BEG and END specify what portion
3102 of the file to insert. These arguments count bytes in the file, not
3103 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3105 If optional fifth argument REPLACE is non-nil, replace the current
3106 buffer contents (in the accessible portion) with the file contents.
3107 This is better than simply deleting and inserting the whole thing
3108 because (1) it preserves some marker positions and (2) it puts less data
3109 in the undo list. When REPLACE is non-nil, the second return value is
3110 the number of characters that replace previous buffer contents.
3112 This function does code conversion according to the value of
3113 `coding-system-for-read' or `file-coding-system-alist', and sets the
3114 variable `last-coding-system-used' to the coding system actually used. */)
3115 (filename
, visit
, beg
, end
, replace
)
3116 Lisp_Object filename
, visit
, beg
, end
, replace
;
3122 register int how_much
;
3123 register int unprocessed
;
3124 int count
= SPECPDL_INDEX ();
3125 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3126 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3129 int not_regular
= 0;
3130 unsigned char read_buf
[READ_BUF_SIZE
];
3131 struct coding_system coding
;
3132 unsigned char buffer
[1 << 14];
3133 int replace_handled
= 0;
3134 int set_coding_system
= 0;
3135 Lisp_Object coding_system
;
3137 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3138 int we_locked_file
= 0;
3140 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3141 error ("Cannot do file visiting in an indirect buffer");
3143 if (!NILP (current_buffer
->read_only
))
3144 Fbarf_if_buffer_read_only ();
3148 orig_filename
= Qnil
;
3151 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3153 CHECK_STRING (filename
);
3154 filename
= Fexpand_file_name (filename
, Qnil
);
3156 /* The value Qnil means that the coding system is not yet
3158 coding_system
= Qnil
;
3160 /* If the file name has special constructs in it,
3161 call the corresponding file handler. */
3162 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3163 if (!NILP (handler
))
3165 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3166 visit
, beg
, end
, replace
);
3167 if (CONSP (val
) && CONSP (XCDR (val
)))
3168 inserted
= XINT (XCAR (XCDR (val
)));
3172 orig_filename
= filename
;
3173 filename
= ENCODE_FILE (filename
);
3179 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3181 /* Tell stat to use expensive method to get accurate info. */
3182 Vw32_get_true_file_attributes
= Qt
;
3183 total
= stat (SDATA (filename
), &st
);
3184 Vw32_get_true_file_attributes
= tem
;
3188 if (stat (SDATA (filename
), &st
) < 0)
3189 #endif /* WINDOWSNT */
3191 if (fd
>= 0) emacs_close (fd
);
3194 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3197 if (!NILP (Vcoding_system_for_read
))
3198 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3203 /* This code will need to be changed in order to work on named
3204 pipes, and it's probably just not worth it. So we should at
3205 least signal an error. */
3206 if (!S_ISREG (st
.st_mode
))
3213 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3214 xsignal2 (Qfile_error
,
3215 build_string ("not a regular file"), orig_filename
);
3220 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3223 /* Replacement should preserve point as it preserves markers. */
3224 if (!NILP (replace
))
3225 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3227 record_unwind_protect (close_file_unwind
, make_number (fd
));
3229 /* Can happen on any platform that uses long as type of off_t, but allows
3230 file sizes to exceed 2Gb, so give a suitable message. */
3231 if (! not_regular
&& st
.st_size
< 0)
3232 error ("Maximum buffer size exceeded");
3234 /* Prevent redisplay optimizations. */
3235 current_buffer
->clip_changed
= 1;
3239 if (!NILP (beg
) || !NILP (end
))
3240 error ("Attempt to visit less than an entire file");
3241 if (BEG
< Z
&& NILP (replace
))
3242 error ("Cannot do file visiting in a non-empty buffer");
3248 XSETFASTINT (beg
, 0);
3256 XSETINT (end
, st
.st_size
);
3258 /* Arithmetic overflow can occur if an Emacs integer cannot
3259 represent the file size, or if the calculations below
3260 overflow. The calculations below double the file size
3261 twice, so check that it can be multiplied by 4 safely. */
3262 if (XINT (end
) != st
.st_size
3263 || st
.st_size
> INT_MAX
/ 4)
3264 error ("Maximum buffer size exceeded");
3266 /* The file size returned from stat may be zero, but data
3267 may be readable nonetheless, for example when this is a
3268 file in the /proc filesystem. */
3269 if (st
.st_size
== 0)
3270 XSETINT (end
, READ_BUF_SIZE
);
3274 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3276 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3277 setup_coding_system (coding_system
, &coding
);
3278 /* Ensure we set Vlast_coding_system_used. */
3279 set_coding_system
= 1;
3283 /* Decide the coding system to use for reading the file now
3284 because we can't use an optimized method for handling
3285 `coding:' tag if the current buffer is not empty. */
3286 if (!NILP (Vcoding_system_for_read
))
3287 coding_system
= Vcoding_system_for_read
;
3290 /* Don't try looking inside a file for a coding system
3291 specification if it is not seekable. */
3292 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3294 /* Find a coding system specified in the heading two
3295 lines or in the tailing several lines of the file.
3296 We assume that the 1K-byte and 3K-byte for heading
3297 and tailing respectively are sufficient for this
3301 if (st
.st_size
<= (1024 * 4))
3302 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3305 nread
= emacs_read (fd
, read_buf
, 1024);
3308 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3309 report_file_error ("Setting file position",
3310 Fcons (orig_filename
, Qnil
));
3311 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3316 error ("IO error reading %s: %s",
3317 SDATA (orig_filename
), emacs_strerror (errno
));
3320 struct buffer
*prev
= current_buffer
;
3324 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3326 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3327 buf
= XBUFFER (buffer
);
3329 delete_all_overlays (buf
);
3330 buf
->directory
= current_buffer
->directory
;
3331 buf
->read_only
= Qnil
;
3332 buf
->filename
= Qnil
;
3333 buf
->undo_list
= Qt
;
3334 eassert (buf
->overlays_before
== NULL
);
3335 eassert (buf
->overlays_after
== NULL
);
3337 set_buffer_internal (buf
);
3339 buf
->enable_multibyte_characters
= Qnil
;
3341 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3342 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3343 coding_system
= call2 (Vset_auto_coding_function
,
3344 filename
, make_number (nread
));
3345 set_buffer_internal (prev
);
3347 /* Discard the unwind protect for recovering the
3351 /* Rewind the file for the actual read done later. */
3352 if (lseek (fd
, 0, 0) < 0)
3353 report_file_error ("Setting file position",
3354 Fcons (orig_filename
, Qnil
));
3358 if (NILP (coding_system
))
3360 /* If we have not yet decided a coding system, check
3361 file-coding-system-alist. */
3362 Lisp_Object args
[6];
3364 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3365 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3366 coding_system
= Ffind_operation_coding_system (6, args
);
3367 if (CONSP (coding_system
))
3368 coding_system
= XCAR (coding_system
);
3372 if (NILP (coding_system
))
3373 coding_system
= Qundecided
;
3375 CHECK_CODING_SYSTEM (coding_system
);
3377 if (NILP (current_buffer
->enable_multibyte_characters
))
3378 /* We must suppress all character code conversion except for
3379 end-of-line conversion. */
3380 coding_system
= raw_text_coding_system (coding_system
);
3382 setup_coding_system (coding_system
, &coding
);
3383 /* Ensure we set Vlast_coding_system_used. */
3384 set_coding_system
= 1;
3387 /* If requested, replace the accessible part of the buffer
3388 with the file contents. Avoid replacing text at the
3389 beginning or end of the buffer that matches the file contents;
3390 that preserves markers pointing to the unchanged parts.
3392 Here we implement this feature in an optimized way
3393 for the case where code conversion is NOT needed.
3394 The following if-statement handles the case of conversion
3395 in a less optimal way.
3397 If the code conversion is "automatic" then we try using this
3398 method and hope for the best.
3399 But if we discover the need for conversion, we give up on this method
3400 and let the following if-statement handle the replace job. */
3403 && (NILP (coding_system
)
3404 || ! CODING_REQUIRE_DECODING (&coding
)))
3406 /* same_at_start and same_at_end count bytes,
3407 because file access counts bytes
3408 and BEG and END count bytes. */
3409 int same_at_start
= BEGV_BYTE
;
3410 int same_at_end
= ZV_BYTE
;
3412 /* There is still a possibility we will find the need to do code
3413 conversion. If that happens, we set this variable to 1 to
3414 give up on handling REPLACE in the optimized way. */
3415 int giveup_match_end
= 0;
3417 if (XINT (beg
) != 0)
3419 if (lseek (fd
, XINT (beg
), 0) < 0)
3420 report_file_error ("Setting file position",
3421 Fcons (orig_filename
, Qnil
));
3426 /* Count how many chars at the start of the file
3427 match the text at the beginning of the buffer. */
3432 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3434 error ("IO error reading %s: %s",
3435 SDATA (orig_filename
), emacs_strerror (errno
));
3436 else if (nread
== 0)
3439 if (CODING_REQUIRE_DETECTION (&coding
))
3441 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
3443 setup_coding_system (coding_system
, &coding
);
3446 if (CODING_REQUIRE_DECODING (&coding
))
3447 /* We found that the file should be decoded somehow.
3448 Let's give up here. */
3450 giveup_match_end
= 1;
3455 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3456 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3457 same_at_start
++, bufpos
++;
3458 /* If we found a discrepancy, stop the scan.
3459 Otherwise loop around and scan the next bufferful. */
3460 if (bufpos
!= nread
)
3464 /* If the file matches the buffer completely,
3465 there's no need to replace anything. */
3466 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3470 /* Truncate the buffer to the size of the file. */
3471 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3476 /* Count how many chars at the end of the file
3477 match the text at the end of the buffer. But, if we have
3478 already found that decoding is necessary, don't waste time. */
3479 while (!giveup_match_end
)
3481 int total_read
, nread
, bufpos
, curpos
, trial
;
3483 /* At what file position are we now scanning? */
3484 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3485 /* If the entire file matches the buffer tail, stop the scan. */
3488 /* How much can we scan in the next step? */
3489 trial
= min (curpos
, sizeof buffer
);
3490 if (lseek (fd
, curpos
- trial
, 0) < 0)
3491 report_file_error ("Setting file position",
3492 Fcons (orig_filename
, Qnil
));
3494 total_read
= nread
= 0;
3495 while (total_read
< trial
)
3497 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3499 error ("IO error reading %s: %s",
3500 SDATA (orig_filename
), emacs_strerror (errno
));
3501 else if (nread
== 0)
3503 total_read
+= nread
;
3506 /* Scan this bufferful from the end, comparing with
3507 the Emacs buffer. */
3508 bufpos
= total_read
;
3510 /* Compare with same_at_start to avoid counting some buffer text
3511 as matching both at the file's beginning and at the end. */
3512 while (bufpos
> 0 && same_at_end
> same_at_start
3513 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3514 same_at_end
--, bufpos
--;
3516 /* If we found a discrepancy, stop the scan.
3517 Otherwise loop around and scan the preceding bufferful. */
3520 /* If this discrepancy is because of code conversion,
3521 we cannot use this method; giveup and try the other. */
3522 if (same_at_end
> same_at_start
3523 && FETCH_BYTE (same_at_end
- 1) >= 0200
3524 && ! NILP (current_buffer
->enable_multibyte_characters
)
3525 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3526 giveup_match_end
= 1;
3535 if (! giveup_match_end
)
3539 /* We win! We can handle REPLACE the optimized way. */
3541 /* Extend the start of non-matching text area to multibyte
3542 character boundary. */
3543 if (! NILP (current_buffer
->enable_multibyte_characters
))
3544 while (same_at_start
> BEGV_BYTE
3545 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3548 /* Extend the end of non-matching text area to multibyte
3549 character boundary. */
3550 if (! NILP (current_buffer
->enable_multibyte_characters
))
3551 while (same_at_end
< ZV_BYTE
3552 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3555 /* Don't try to reuse the same piece of text twice. */
3556 overlap
= (same_at_start
- BEGV_BYTE
3557 - (same_at_end
+ st
.st_size
- ZV
));
3559 same_at_end
+= overlap
;
3561 /* Arrange to read only the nonmatching middle part of the file. */
3562 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3563 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3565 del_range_byte (same_at_start
, same_at_end
, 0);
3566 /* Insert from the file at the proper position. */
3567 temp
= BYTE_TO_CHAR (same_at_start
);
3568 SET_PT_BOTH (temp
, same_at_start
);
3570 /* If display currently starts at beginning of line,
3571 keep it that way. */
3572 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3573 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3575 replace_handled
= 1;
3579 /* If requested, replace the accessible part of the buffer
3580 with the file contents. Avoid replacing text at the
3581 beginning or end of the buffer that matches the file contents;
3582 that preserves markers pointing to the unchanged parts.
3584 Here we implement this feature for the case where code conversion
3585 is needed, in a simple way that needs a lot of memory.
3586 The preceding if-statement handles the case of no conversion
3587 in a more optimized way. */
3588 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3590 EMACS_INT same_at_start
= BEGV_BYTE
;
3591 EMACS_INT same_at_end
= ZV_BYTE
;
3592 EMACS_INT same_at_start_charpos
;
3593 EMACS_INT inserted_chars
;
3596 unsigned char *decoded
;
3598 int this_count
= SPECPDL_INDEX ();
3599 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3600 Lisp_Object conversion_buffer
;
3602 conversion_buffer
= code_conversion_save (1, multibyte
);
3604 /* First read the whole file, performing code conversion into
3605 CONVERSION_BUFFER. */
3607 if (lseek (fd
, XINT (beg
), 0) < 0)
3608 report_file_error ("Setting file position",
3609 Fcons (orig_filename
, Qnil
));
3611 total
= st
.st_size
; /* Total bytes in the file. */
3612 how_much
= 0; /* Bytes read from file so far. */
3613 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3614 unprocessed
= 0; /* Bytes not processed in previous loop. */
3616 GCPRO1 (conversion_buffer
);
3617 while (how_much
< total
)
3619 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
3620 quitting while reading a huge while. */
3621 /* try is reserved in some compilers (Microsoft C) */
3622 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3625 /* Allow quitting out of the actual I/O. */
3628 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
3640 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
3641 BUF_Z (XBUFFER (conversion_buffer
)));
3642 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
3644 unprocessed
= coding
.carryover_bytes
;
3645 if (coding
.carryover_bytes
> 0)
3646 bcopy (coding
.carryover
, read_buf
, unprocessed
);
3651 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
3652 if we couldn't read the file. */
3655 error ("IO error reading %s: %s",
3656 SDATA (orig_filename
), emacs_strerror (errno
));
3658 if (unprocessed
> 0)
3660 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3661 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
3663 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
3666 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
3667 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
3668 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3670 /* Compare the beginning of the converted string with the buffer
3674 while (bufpos
< inserted
&& same_at_start
< same_at_end
3675 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
3676 same_at_start
++, bufpos
++;
3678 /* If the file matches the head of buffer completely,
3679 there's no need to replace anything. */
3681 if (bufpos
== inserted
)
3684 /* Truncate the buffer to the size of the file. */
3685 if (same_at_start
== same_at_end
)
3688 del_range_byte (same_at_start
, same_at_end
, 0);
3691 unbind_to (this_count
, Qnil
);
3695 /* Extend the start of non-matching text area to the previous
3696 multibyte character boundary. */
3697 if (! NILP (current_buffer
->enable_multibyte_characters
))
3698 while (same_at_start
> BEGV_BYTE
3699 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3702 /* Scan this bufferful from the end, comparing with
3703 the Emacs buffer. */
3706 /* Compare with same_at_start to avoid counting some buffer text
3707 as matching both at the file's beginning and at the end. */
3708 while (bufpos
> 0 && same_at_end
> same_at_start
3709 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
3710 same_at_end
--, bufpos
--;
3712 /* Extend the end of non-matching text area to the next
3713 multibyte character boundary. */
3714 if (! NILP (current_buffer
->enable_multibyte_characters
))
3715 while (same_at_end
< ZV_BYTE
3716 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3719 /* Don't try to reuse the same piece of text twice. */
3720 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3722 same_at_end
+= overlap
;
3724 /* If display currently starts at beginning of line,
3725 keep it that way. */
3726 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3727 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3729 /* Replace the chars that we need to replace,
3730 and update INSERTED to equal the number of bytes
3731 we are taking from the decoded string. */
3732 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
3734 if (same_at_end
!= same_at_start
)
3736 del_range_byte (same_at_start
, same_at_end
, 0);
3738 same_at_start
= GPT_BYTE
;
3742 temp
= BYTE_TO_CHAR (same_at_start
);
3744 /* Insert from the file at the proper position. */
3745 SET_PT_BOTH (temp
, same_at_start
);
3746 same_at_start_charpos
3747 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3748 same_at_start
- BEGV_BYTE
3749 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3751 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3752 same_at_start
+ inserted
- BEGV_BYTE
3753 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
3754 - same_at_start_charpos
);
3755 /* This binding is to avoid ask-user-about-supersession-threat
3756 being called in insert_from_buffer (via in
3757 prepare_to_modify_buffer). */
3758 specbind (intern ("buffer-file-name"), Qnil
);
3759 insert_from_buffer (XBUFFER (conversion_buffer
),
3760 same_at_start_charpos
, inserted_chars
, 0);
3761 /* Set `inserted' to the number of inserted characters. */
3762 inserted
= PT
- temp
;
3763 /* Set point before the inserted characters. */
3764 SET_PT_BOTH (temp
, same_at_start
);
3766 unbind_to (this_count
, Qnil
);
3773 register Lisp_Object temp
;
3775 total
= XINT (end
) - XINT (beg
);
3777 /* Make sure point-max won't overflow after this insertion. */
3778 XSETINT (temp
, total
);
3779 if (total
!= XINT (temp
))
3780 error ("Maximum buffer size exceeded");
3783 /* For a special file, all we can do is guess. */
3784 total
= READ_BUF_SIZE
;
3786 if (NILP (visit
) && inserted
> 0)
3788 #ifdef CLASH_DETECTION
3789 if (!NILP (current_buffer
->file_truename
)
3790 /* Make binding buffer-file-name to nil effective. */
3791 && !NILP (current_buffer
->filename
)
3792 && SAVE_MODIFF
>= MODIFF
)
3794 #endif /* CLASH_DETECTION */
3795 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
3799 if (GAP_SIZE
< total
)
3800 make_gap (total
- GAP_SIZE
);
3802 if (XINT (beg
) != 0 || !NILP (replace
))
3804 if (lseek (fd
, XINT (beg
), 0) < 0)
3805 report_file_error ("Setting file position",
3806 Fcons (orig_filename
, Qnil
));
3809 /* In the following loop, HOW_MUCH contains the total bytes read so
3810 far for a regular file, and not changed for a special file. But,
3811 before exiting the loop, it is set to a negative value if I/O
3815 /* Total bytes inserted. */
3818 /* Here, we don't do code conversion in the loop. It is done by
3819 decode_coding_gap after all data are read into the buffer. */
3821 int gap_size
= GAP_SIZE
;
3823 while (how_much
< total
)
3825 /* try is reserved in some compilers (Microsoft C) */
3826 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3833 /* Maybe make more room. */
3834 if (gap_size
< trytry
)
3836 make_gap (total
- gap_size
);
3837 gap_size
= GAP_SIZE
;
3840 /* Read from the file, capturing `quit'. When an
3841 error occurs, end the loop, and arrange for a quit
3842 to be signaled after decoding the text we read. */
3843 non_regular_fd
= fd
;
3844 non_regular_inserted
= inserted
;
3845 non_regular_nbytes
= trytry
;
3846 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
3847 read_non_regular_quit
);
3858 /* Allow quitting out of the actual I/O. We don't make text
3859 part of the buffer until all the reading is done, so a C-g
3860 here doesn't do any harm. */
3863 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
3875 /* For a regular file, where TOTAL is the real size,
3876 count HOW_MUCH to compare with it.
3877 For a special file, where TOTAL is just a buffer size,
3878 so don't bother counting in HOW_MUCH.
3879 (INSERTED is where we count the number of characters inserted.) */
3886 /* Now we have read all the file data into the gap.
3887 If it was empty, undo marking the buffer modified. */
3891 #ifdef CLASH_DETECTION
3893 unlock_file (current_buffer
->file_truename
);
3895 Vdeactivate_mark
= old_Vdeactivate_mark
;
3898 Vdeactivate_mark
= Qt
;
3900 /* Make the text read part of the buffer. */
3901 GAP_SIZE
-= inserted
;
3903 GPT_BYTE
+= inserted
;
3905 ZV_BYTE
+= inserted
;
3910 /* Put an anchor to ensure multi-byte form ends at gap. */
3915 /* Discard the unwind protect for closing the file. */
3919 error ("IO error reading %s: %s",
3920 SDATA (orig_filename
), emacs_strerror (errno
));
3924 if (NILP (coding_system
))
3926 /* The coding system is not yet decided. Decide it by an
3927 optimized method for handling `coding:' tag.
3929 Note that we can get here only if the buffer was empty
3930 before the insertion. */
3932 if (!NILP (Vcoding_system_for_read
))
3933 coding_system
= Vcoding_system_for_read
;
3936 /* Since we are sure that the current buffer was empty
3937 before the insertion, we can toggle
3938 enable-multibyte-characters directly here without taking
3939 care of marker adjustment. By this way, we can run Lisp
3940 program safely before decoding the inserted text. */
3941 Lisp_Object unwind_data
;
3942 int count
= SPECPDL_INDEX ();
3944 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
3945 Fcons (current_buffer
->undo_list
,
3946 Fcurrent_buffer ()));
3947 current_buffer
->enable_multibyte_characters
= Qnil
;
3948 current_buffer
->undo_list
= Qt
;
3949 record_unwind_protect (decide_coding_unwind
, unwind_data
);
3951 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
3953 coding_system
= call2 (Vset_auto_coding_function
,
3954 filename
, make_number (inserted
));
3957 if (NILP (coding_system
))
3959 /* If the coding system is not yet decided, check
3960 file-coding-system-alist. */
3961 Lisp_Object args
[6];
3963 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3964 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
3965 coding_system
= Ffind_operation_coding_system (6, args
);
3966 if (CONSP (coding_system
))
3967 coding_system
= XCAR (coding_system
);
3969 unbind_to (count
, Qnil
);
3970 inserted
= Z_BYTE
- BEG_BYTE
;
3973 if (NILP (coding_system
))
3974 coding_system
= Qundecided
;
3976 CHECK_CODING_SYSTEM (coding_system
);
3978 if (NILP (current_buffer
->enable_multibyte_characters
))
3979 /* We must suppress all character code conversion except for
3980 end-of-line conversion. */
3981 coding_system
= raw_text_coding_system (coding_system
);
3982 setup_coding_system (coding_system
, &coding
);
3983 /* Ensure we set Vlast_coding_system_used. */
3984 set_coding_system
= 1;
3989 /* When we visit a file by raw-text, we change the buffer to
3991 if (CODING_FOR_UNIBYTE (&coding
)
3992 /* Can't do this if part of the buffer might be preserved. */
3994 /* Visiting a file with these coding system makes the buffer
3996 current_buffer
->enable_multibyte_characters
= Qnil
;
3999 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4000 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4001 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4003 move_gap_both (PT
, PT_BYTE
);
4004 GAP_SIZE
+= inserted
;
4005 ZV_BYTE
-= inserted
;
4009 decode_coding_gap (&coding
, inserted
, inserted
);
4010 inserted
= coding
.produced_char
;
4011 coding_system
= CODING_ID_NAME (coding
.id
);
4013 else if (inserted
> 0)
4014 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4017 /* Now INSERTED is measured in characters. */
4020 /* Use the conversion type to determine buffer-file-type
4021 (find-buffer-file-type is now used to help determine the
4023 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4024 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4025 && ! CODING_REQUIRE_DECODING (&coding
))
4026 current_buffer
->buffer_file_type
= Qt
;
4028 current_buffer
->buffer_file_type
= Qnil
;
4035 if (!EQ (current_buffer
->undo_list
, Qt
) && !nochange
)
4036 current_buffer
->undo_list
= Qnil
;
4040 current_buffer
->modtime
= st
.st_mtime
;
4041 current_buffer
->filename
= orig_filename
;
4044 SAVE_MODIFF
= MODIFF
;
4045 current_buffer
->auto_save_modified
= MODIFF
;
4046 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4047 #ifdef CLASH_DETECTION
4050 if (!NILP (current_buffer
->file_truename
))
4051 unlock_file (current_buffer
->file_truename
);
4052 unlock_file (filename
);
4054 #endif /* CLASH_DETECTION */
4056 xsignal2 (Qfile_error
,
4057 build_string ("not a regular file"), orig_filename
);
4060 if (set_coding_system
)
4061 Vlast_coding_system_used
= coding_system
;
4063 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4065 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4067 if (! NILP (insval
))
4069 CHECK_NUMBER (insval
);
4070 inserted
= XFASTINT (insval
);
4074 /* Decode file format. */
4077 /* Don't run point motion or modification hooks when decoding. */
4078 int count
= SPECPDL_INDEX ();
4079 int old_inserted
= inserted
;
4080 specbind (Qinhibit_point_motion_hooks
, Qt
);
4081 specbind (Qinhibit_modification_hooks
, Qt
);
4083 /* Save old undo list and don't record undo for decoding. */
4084 old_undo
= current_buffer
->undo_list
;
4085 current_buffer
->undo_list
= Qt
;
4089 insval
= call3 (Qformat_decode
,
4090 Qnil
, make_number (inserted
), visit
);
4091 CHECK_NUMBER (insval
);
4092 inserted
= XFASTINT (insval
);
4096 /* If REPLACE is non-nil and we succeeded in not replacing the
4097 beginning or end of the buffer text with the file's contents,
4098 call format-decode with `point' positioned at the beginning
4099 of the buffer and `inserted' equalling the number of
4100 characters in the buffer. Otherwise, format-decode might
4101 fail to correctly analyze the beginning or end of the buffer.
4102 Hence we temporarily save `point' and `inserted' here and
4103 restore `point' iff format-decode did not insert or delete
4104 any text. Otherwise we leave `point' at point-min. */
4106 int opoint_byte
= PT_BYTE
;
4107 int oinserted
= ZV
- BEGV
;
4108 int ochars_modiff
= CHARS_MODIFF
;
4110 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4111 insval
= call3 (Qformat_decode
,
4112 Qnil
, make_number (oinserted
), visit
);
4113 CHECK_NUMBER (insval
);
4114 if (ochars_modiff
== CHARS_MODIFF
)
4115 /* format_decode didn't modify buffer's characters => move
4116 point back to position before inserted text and leave
4117 value of inserted alone. */
4118 SET_PT_BOTH (opoint
, opoint_byte
);
4120 /* format_decode modified buffer's characters => consider
4121 entire buffer changed and leave point at point-min. */
4122 inserted
= XFASTINT (insval
);
4125 /* For consistency with format-decode call these now iff inserted > 0
4126 (martin 2007-06-28). */
4127 p
= Vafter_insert_file_functions
;
4132 insval
= call1 (XCAR (p
), make_number (inserted
));
4135 CHECK_NUMBER (insval
);
4136 inserted
= XFASTINT (insval
);
4141 /* For the rationale of this see the comment on
4142 format-decode above. */
4144 int opoint_byte
= PT_BYTE
;
4145 int oinserted
= ZV
- BEGV
;
4146 int ochars_modiff
= CHARS_MODIFF
;
4148 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4149 insval
= call1 (XCAR (p
), make_number (oinserted
));
4152 CHECK_NUMBER (insval
);
4153 if (ochars_modiff
== CHARS_MODIFF
)
4154 /* after_insert_file_functions didn't modify
4155 buffer's characters => move point back to
4156 position before inserted text and leave value of
4158 SET_PT_BOTH (opoint
, opoint_byte
);
4160 /* after_insert_file_functions did modify buffer's
4161 characters => consider entire buffer changed and
4162 leave point at point-min. */
4163 inserted
= XFASTINT (insval
);
4173 current_buffer
->undo_list
= old_undo
;
4174 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4176 /* Adjust the last undo record for the size change during
4177 the format conversion. */
4178 Lisp_Object tem
= XCAR (old_undo
);
4179 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4180 && INTEGERP (XCDR (tem
))
4181 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4182 XSETCDR (tem
, make_number (PT
+ inserted
));
4186 /* If undo_list was Qt before, keep it that way.
4187 Otherwise start with an empty undo_list. */
4188 current_buffer
->undo_list
= EQ (old_undo
, Qt
) ? Qt
: Qnil
;
4190 unbind_to (count
, Qnil
);
4193 /* Call after-change hooks for the inserted text, aside from the case
4194 of normal visiting (not with REPLACE), which is done in a new buffer
4195 "before" the buffer is changed. */
4196 if (inserted
> 0 && total
> 0
4197 && (NILP (visit
) || !NILP (replace
)))
4199 signal_after_change (PT
, 0, inserted
);
4200 update_compositions (PT
, PT
, CHECK_BORDER
);
4204 && current_buffer
->modtime
== -1)
4206 /* If visiting nonexistent file, return nil. */
4207 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4211 Fsignal (Qquit
, Qnil
);
4213 /* ??? Retval needs to be dealt with in all cases consistently. */
4215 val
= Fcons (orig_filename
,
4216 Fcons (make_number (inserted
),
4219 RETURN_UNGCPRO (unbind_to (count
, val
));
4222 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4224 /* If build_annotations switched buffers, switch back to BUF.
4225 Kill the temporary buffer that was selected in the meantime.
4227 Since this kill only the last temporary buffer, some buffers remain
4228 not killed if build_annotations switched buffers more than once.
4232 build_annotations_unwind (buf
)
4237 if (XBUFFER (buf
) == current_buffer
)
4239 tembuf
= Fcurrent_buffer ();
4241 Fkill_buffer (tembuf
);
4245 /* Decide the coding-system to encode the data with. */
4248 choose_write_coding_system (start
, end
, filename
,
4249 append
, visit
, lockname
, coding
)
4250 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4251 struct coding_system
*coding
;
4254 Lisp_Object eol_parent
= Qnil
;
4257 && NILP (Fstring_equal (current_buffer
->filename
,
4258 current_buffer
->auto_save_file_name
)))
4263 else if (!NILP (Vcoding_system_for_write
))
4265 val
= Vcoding_system_for_write
;
4266 if (coding_system_require_warning
4267 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4268 /* Confirm that VAL can surely encode the current region. */
4269 val
= call5 (Vselect_safe_coding_system_function
,
4270 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4275 /* If the variable `buffer-file-coding-system' is set locally,
4276 it means that the file was read with some kind of code
4277 conversion or the variable is explicitly set by users. We
4278 had better write it out with the same coding system even if
4279 `enable-multibyte-characters' is nil.
4281 If it is not set locally, we anyway have to convert EOL
4282 format if the default value of `buffer-file-coding-system'
4283 tells that it is not Unix-like (LF only) format. */
4284 int using_default_coding
= 0;
4285 int force_raw_text
= 0;
4287 val
= current_buffer
->buffer_file_coding_system
;
4289 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4292 if (NILP (current_buffer
->enable_multibyte_characters
))
4298 /* Check file-coding-system-alist. */
4299 Lisp_Object args
[7], coding_systems
;
4301 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4302 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4304 coding_systems
= Ffind_operation_coding_system (7, args
);
4305 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4306 val
= XCDR (coding_systems
);
4311 /* If we still have not decided a coding system, use the
4312 default value of buffer-file-coding-system. */
4313 val
= current_buffer
->buffer_file_coding_system
;
4314 using_default_coding
= 1;
4317 if (! NILP (val
) && ! force_raw_text
)
4319 Lisp_Object spec
, attrs
;
4321 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4322 attrs
= AREF (spec
, 0);
4323 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4328 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4329 /* Confirm that VAL can surely encode the current region. */
4330 val
= call5 (Vselect_safe_coding_system_function
,
4331 start
, end
, val
, Qnil
, filename
);
4333 /* If the decided coding-system doesn't specify end-of-line
4334 format, we use that of
4335 `default-buffer-file-coding-system'. */
4336 if (! using_default_coding
4337 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4338 val
= (coding_inherit_eol_type
4339 (val
, buffer_defaults
.buffer_file_coding_system
));
4341 /* If we decide not to encode text, use `raw-text' or one of its
4344 val
= raw_text_coding_system (val
);
4347 val
= coding_inherit_eol_type (val
, eol_parent
);
4348 setup_coding_system (val
, coding
);
4350 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4351 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4355 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4356 "r\nFWrite region to file: \ni\ni\ni\np",
4357 doc
: /* Write current region into specified file.
4358 When called from a program, requires three arguments:
4359 START, END and FILENAME. START and END are normally buffer positions
4360 specifying the part of the buffer to write.
4361 If START is nil, that means to use the entire buffer contents.
4362 If START is a string, then output that string to the file
4363 instead of any buffer contents; END is ignored.
4365 Optional fourth argument APPEND if non-nil means
4366 append to existing file contents (if any). If it is an integer,
4367 seek to that offset in the file before writing.
4368 Optional fifth argument VISIT, if t or a string, means
4369 set the last-save-file-modtime of buffer to this file's modtime
4370 and mark buffer not modified.
4371 If VISIT is a string, it is a second file name;
4372 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4373 VISIT is also the file name to lock and unlock for clash detection.
4374 If VISIT is neither t nor nil nor a string,
4375 that means do not display the \"Wrote file\" message.
4376 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4377 use for locking and unlocking, overriding FILENAME and VISIT.
4378 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4379 for an existing file with the same name. If MUSTBENEW is `excl',
4380 that means to get an error if the file already exists; never overwrite.
4381 If MUSTBENEW is neither nil nor `excl', that means ask for
4382 confirmation before overwriting, but do go ahead and overwrite the file
4383 if the user confirms.
4385 This does code conversion according to the value of
4386 `coding-system-for-write', `buffer-file-coding-system', or
4387 `file-coding-system-alist', and sets the variable
4388 `last-coding-system-used' to the coding system actually used. */)
4389 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4390 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4395 const unsigned char *fn
;
4397 int count
= SPECPDL_INDEX ();
4399 Lisp_Object handler
;
4400 Lisp_Object visit_file
;
4401 Lisp_Object annotations
;
4402 Lisp_Object encoded_filename
;
4403 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4404 int quietly
= !NILP (visit
);
4405 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4406 struct buffer
*given_buffer
;
4408 int buffer_file_type
= O_BINARY
;
4410 struct coding_system coding
;
4412 if (current_buffer
->base_buffer
&& visiting
)
4413 error ("Cannot do file visiting in an indirect buffer");
4415 if (!NILP (start
) && !STRINGP (start
))
4416 validate_region (&start
, &end
);
4419 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4421 filename
= Fexpand_file_name (filename
, Qnil
);
4423 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4424 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4426 if (STRINGP (visit
))
4427 visit_file
= Fexpand_file_name (visit
, Qnil
);
4429 visit_file
= filename
;
4431 if (NILP (lockname
))
4432 lockname
= visit_file
;
4436 /* If the file name has special constructs in it,
4437 call the corresponding file handler. */
4438 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4439 /* If FILENAME has no handler, see if VISIT has one. */
4440 if (NILP (handler
) && STRINGP (visit
))
4441 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4443 if (!NILP (handler
))
4446 val
= call6 (handler
, Qwrite_region
, start
, end
,
4447 filename
, append
, visit
);
4451 SAVE_MODIFF
= MODIFF
;
4452 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4453 current_buffer
->filename
= visit_file
;
4459 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4461 /* Special kludge to simplify auto-saving. */
4464 /* Do it later, so write-region-annotate-function can work differently
4465 if we save "the buffer" vs "a region".
4466 This is useful in tar-mode. --Stef
4467 XSETFASTINT (start, BEG);
4468 XSETFASTINT (end, Z); */
4472 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4473 count1
= SPECPDL_INDEX ();
4475 given_buffer
= current_buffer
;
4477 if (!STRINGP (start
))
4479 annotations
= build_annotations (start
, end
);
4481 if (current_buffer
!= given_buffer
)
4483 XSETFASTINT (start
, BEGV
);
4484 XSETFASTINT (end
, ZV
);
4490 XSETFASTINT (start
, BEGV
);
4491 XSETFASTINT (end
, ZV
);
4496 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4498 /* Decide the coding-system to encode the data with.
4499 We used to make this choice before calling build_annotations, but that
4500 leads to problems when a write-annotate-function takes care of
4501 unsavable chars (as was the case with X-Symbol). */
4502 Vlast_coding_system_used
4503 = choose_write_coding_system (start
, end
, filename
,
4504 append
, visit
, lockname
, &coding
);
4506 #ifdef CLASH_DETECTION
4509 #if 0 /* This causes trouble for GNUS. */
4510 /* If we've locked this file for some other buffer,
4511 query before proceeding. */
4512 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4513 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4516 lock_file (lockname
);
4518 #endif /* CLASH_DETECTION */
4520 encoded_filename
= ENCODE_FILE (filename
);
4522 fn
= SDATA (encoded_filename
);
4526 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4527 #else /* not DOS_NT */
4528 desc
= emacs_open (fn
, O_WRONLY
, 0);
4529 #endif /* not DOS_NT */
4531 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4533 desc
= emacs_open (fn
,
4534 O_WRONLY
| O_CREAT
| buffer_file_type
4535 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4536 S_IREAD
| S_IWRITE
);
4537 #else /* not DOS_NT */
4538 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4539 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4540 auto_saving
? auto_save_mode_bits
: 0666);
4541 #endif /* not DOS_NT */
4545 #ifdef CLASH_DETECTION
4547 if (!auto_saving
) unlock_file (lockname
);
4549 #endif /* CLASH_DETECTION */
4551 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4554 record_unwind_protect (close_file_unwind
, make_number (desc
));
4556 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4560 if (NUMBERP (append
))
4561 ret
= lseek (desc
, XINT (append
), 1);
4563 ret
= lseek (desc
, 0, 2);
4566 #ifdef CLASH_DETECTION
4567 if (!auto_saving
) unlock_file (lockname
);
4568 #endif /* CLASH_DETECTION */
4570 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4577 /* The new encoding routine doesn't require the following. */
4579 /* Whether VMS or not, we must move the gap to the next of newline
4580 when we must put designation sequences at beginning of line. */
4581 if (INTEGERP (start
)
4582 && coding
.type
== coding_type_iso2022
4583 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4584 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4586 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4587 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4588 move_gap_both (PT
, PT_BYTE
);
4589 SET_PT_BOTH (opoint
, opoint_byte
);
4596 if (STRINGP (start
))
4598 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
4599 &annotations
, &coding
);
4602 else if (XINT (start
) != XINT (end
))
4604 failure
= 0 > a_write (desc
, Qnil
,
4605 XINT (start
), XINT (end
) - XINT (start
),
4606 &annotations
, &coding
);
4611 /* If file was empty, still need to write the annotations */
4612 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4613 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4617 if (CODING_REQUIRE_FLUSHING (&coding
)
4618 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4621 /* We have to flush out a data. */
4622 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4623 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
4630 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4631 Disk full in NFS may be reported here. */
4632 /* mib says that closing the file will try to write as fast as NFS can do
4633 it, and that means the fsync here is not crucial for autosave files. */
4634 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
4636 /* If fsync fails with EINTR, don't treat that as serious. Also
4637 ignore EINVAL which happens when fsync is not supported on this
4639 if (errno
!= EINTR
&& errno
!= EINVAL
)
4640 failure
= 1, save_errno
= errno
;
4644 /* Spurious "file has changed on disk" warnings have been
4645 observed on Suns as well.
4646 It seems that `close' can change the modtime, under nfs.
4648 (This has supposedly been fixed in Sunos 4,
4649 but who knows about all the other machines with NFS?) */
4656 /* NFS can report a write failure now. */
4657 if (emacs_close (desc
) < 0)
4658 failure
= 1, save_errno
= errno
;
4663 /* Discard the unwind protect for close_file_unwind. */
4664 specpdl_ptr
= specpdl
+ count1
;
4665 /* Restore the original current buffer. */
4666 visit_file
= unbind_to (count
, visit_file
);
4668 #ifdef CLASH_DETECTION
4670 unlock_file (lockname
);
4671 #endif /* CLASH_DETECTION */
4673 /* Do this before reporting IO error
4674 to avoid a "file has changed on disk" warning on
4675 next attempt to save. */
4677 current_buffer
->modtime
= st
.st_mtime
;
4680 error ("IO error writing %s: %s", SDATA (filename
),
4681 emacs_strerror (save_errno
));
4685 SAVE_MODIFF
= MODIFF
;
4686 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4687 current_buffer
->filename
= visit_file
;
4688 update_mode_lines
++;
4693 && ! NILP (Fstring_equal (current_buffer
->filename
,
4694 current_buffer
->auto_save_file_name
)))
4695 SAVE_MODIFF
= MODIFF
;
4701 message_with_string ((INTEGERP (append
)
4711 Lisp_Object
merge ();
4713 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4714 doc
: /* Return t if (car A) is numerically less than (car B). */)
4718 return Flss (Fcar (a
), Fcar (b
));
4721 /* Build the complete list of annotations appropriate for writing out
4722 the text between START and END, by calling all the functions in
4723 write-region-annotate-functions and merging the lists they return.
4724 If one of these functions switches to a different buffer, we assume
4725 that buffer contains altered text. Therefore, the caller must
4726 make sure to restore the current buffer in all cases,
4727 as save-excursion would do. */
4730 build_annotations (start
, end
)
4731 Lisp_Object start
, end
;
4733 Lisp_Object annotations
;
4735 struct gcpro gcpro1
, gcpro2
;
4736 Lisp_Object original_buffer
;
4737 int i
, used_global
= 0;
4739 XSETBUFFER (original_buffer
, current_buffer
);
4742 p
= Vwrite_region_annotate_functions
;
4743 GCPRO2 (annotations
, p
);
4746 struct buffer
*given_buffer
= current_buffer
;
4747 if (EQ (Qt
, XCAR (p
)) && !used_global
)
4748 { /* Use the global value of the hook. */
4751 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
4753 p
= Fappend (2, arg
);
4756 Vwrite_region_annotations_so_far
= annotations
;
4757 res
= call2 (XCAR (p
), start
, end
);
4758 /* If the function makes a different buffer current,
4759 assume that means this buffer contains altered text to be output.
4760 Reset START and END from the buffer bounds
4761 and discard all previous annotations because they should have
4762 been dealt with by this function. */
4763 if (current_buffer
!= given_buffer
)
4765 XSETFASTINT (start
, BEGV
);
4766 XSETFASTINT (end
, ZV
);
4769 Flength (res
); /* Check basic validity of return value */
4770 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4774 /* Now do the same for annotation functions implied by the file-format */
4775 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
4776 p
= current_buffer
->auto_save_file_format
;
4778 p
= current_buffer
->file_format
;
4779 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
4781 struct buffer
*given_buffer
= current_buffer
;
4783 Vwrite_region_annotations_so_far
= annotations
;
4785 /* Value is either a list of annotations or nil if the function
4786 has written annotations to a temporary buffer, which is now
4788 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
4789 original_buffer
, make_number (i
));
4790 if (current_buffer
!= given_buffer
)
4792 XSETFASTINT (start
, BEGV
);
4793 XSETFASTINT (end
, ZV
);
4798 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4806 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
4807 If STRING is nil, POS is the character position in the current buffer.
4808 Intersperse with them the annotations from *ANNOT
4809 which fall within the range of POS to POS + NCHARS,
4810 each at its appropriate position.
4812 We modify *ANNOT by discarding elements as we use them up.
4814 The return value is negative in case of system call failure. */
4817 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
4820 register int nchars
;
4823 struct coding_system
*coding
;
4827 int lastpos
= pos
+ nchars
;
4829 while (NILP (*annot
) || CONSP (*annot
))
4831 tem
= Fcar_safe (Fcar (*annot
));
4834 nextpos
= XFASTINT (tem
);
4836 /* If there are no more annotations in this range,
4837 output the rest of the range all at once. */
4838 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
4839 return e_write (desc
, string
, pos
, lastpos
, coding
);
4841 /* Output buffer text up to the next annotation's position. */
4844 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
4848 /* Output the annotation. */
4849 tem
= Fcdr (Fcar (*annot
));
4852 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
4855 *annot
= Fcdr (*annot
);
4861 /* Write text in the range START and END into descriptor DESC,
4862 encoding them with coding system CODING. If STRING is nil, START
4863 and END are character positions of the current buffer, else they
4864 are indexes to the string STRING. */
4867 e_write (desc
, string
, start
, end
, coding
)
4871 struct coding_system
*coding
;
4873 if (STRINGP (string
))
4876 end
= SCHARS (string
);
4879 /* We used to have a code for handling selective display here. But,
4880 now it is handled within encode_coding. */
4884 if (STRINGP (string
))
4886 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
4887 if (CODING_REQUIRE_ENCODING (coding
))
4889 encode_coding_object (coding
, string
,
4890 start
, string_char_to_byte (string
, start
),
4891 end
, string_char_to_byte (string
, end
), Qt
);
4895 coding
->dst_object
= string
;
4896 coding
->consumed_char
= SCHARS (string
);
4897 coding
->produced
= SBYTES (string
);
4902 int start_byte
= CHAR_TO_BYTE (start
);
4903 int end_byte
= CHAR_TO_BYTE (end
);
4905 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
4906 if (CODING_REQUIRE_ENCODING (coding
))
4908 encode_coding_object (coding
, Fcurrent_buffer (),
4909 start
, start_byte
, end
, end_byte
, Qt
);
4913 coding
->dst_object
= Qnil
;
4914 coding
->dst_pos_byte
= start_byte
;
4915 if (start
>= GPT
|| end
<= GPT
)
4917 coding
->consumed_char
= end
- start
;
4918 coding
->produced
= end_byte
- start_byte
;
4922 coding
->consumed_char
= GPT
- start
;
4923 coding
->produced
= GPT_BYTE
- start_byte
;
4928 if (coding
->produced
> 0)
4932 STRINGP (coding
->dst_object
)
4933 ? SDATA (coding
->dst_object
)
4934 : BYTE_POS_ADDR (coding
->dst_pos_byte
),
4937 if (coding
->produced
)
4940 start
+= coding
->consumed_char
;
4946 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4947 Sverify_visited_file_modtime
, 1, 1, 0,
4948 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
4949 This means that the file has not been changed since it was visited or saved.
4950 See Info node `(elisp)Modification Time' for more details. */)
4956 Lisp_Object handler
;
4957 Lisp_Object filename
;
4962 if (!STRINGP (b
->filename
)) return Qt
;
4963 if (b
->modtime
== 0) return Qt
;
4965 /* If the file name has special constructs in it,
4966 call the corresponding file handler. */
4967 handler
= Ffind_file_name_handler (b
->filename
,
4968 Qverify_visited_file_modtime
);
4969 if (!NILP (handler
))
4970 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4972 filename
= ENCODE_FILE (b
->filename
);
4974 if (stat (SDATA (filename
), &st
) < 0)
4976 /* If the file doesn't exist now and didn't exist before,
4977 we say that it isn't modified, provided the error is a tame one. */
4978 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4983 if (st
.st_mtime
== b
->modtime
4984 /* If both are positive, accept them if they are off by one second. */
4985 || (st
.st_mtime
> 0 && b
->modtime
> 0
4986 && (st
.st_mtime
== b
->modtime
+ 1
4987 || st
.st_mtime
== b
->modtime
- 1)))
4992 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4993 Sclear_visited_file_modtime
, 0, 0, 0,
4994 doc
: /* Clear out records of last mod time of visited file.
4995 Next attempt to save will certainly not complain of a discrepancy. */)
4998 current_buffer
->modtime
= 0;
5002 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5003 Svisited_file_modtime
, 0, 0, 0,
5004 doc
: /* Return the current buffer's recorded visited file modification time.
5005 The value is a list of the form (HIGH LOW), like the time values
5006 that `file-attributes' returns. If the current buffer has no recorded
5007 file modification time, this function returns 0.
5008 See Info node `(elisp)Modification Time' for more details. */)
5011 if (! current_buffer
->modtime
)
5012 return make_number (0);
5013 return make_time ((time_t) current_buffer
->modtime
);
5016 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5017 Sset_visited_file_modtime
, 0, 1, 0,
5018 doc
: /* Update buffer's recorded modification time from the visited file's time.
5019 Useful if the buffer was not read from the file normally
5020 or if the file itself has been changed for some known benign reason.
5021 An argument specifies the modification time value to use
5022 \(instead of that of the visited file), in the form of a list
5023 \(HIGH . LOW) or (HIGH LOW). */)
5025 Lisp_Object time_list
;
5027 if (!NILP (time_list
))
5028 current_buffer
->modtime
= cons_to_long (time_list
);
5031 register Lisp_Object filename
;
5033 Lisp_Object handler
;
5035 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5037 /* If the file name has special constructs in it,
5038 call the corresponding file handler. */
5039 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5040 if (!NILP (handler
))
5041 /* The handler can find the file name the same way we did. */
5042 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5044 filename
= ENCODE_FILE (filename
);
5046 if (stat (SDATA (filename
), &st
) >= 0)
5047 current_buffer
->modtime
= st
.st_mtime
;
5054 auto_save_error (error
)
5057 Lisp_Object args
[3], msg
;
5059 struct gcpro gcpro1
;
5063 auto_save_error_occurred
= 1;
5065 ring_bell (XFRAME (selected_frame
));
5067 args
[0] = build_string ("Auto-saving %s: %s");
5068 args
[1] = current_buffer
->name
;
5069 args
[2] = Ferror_message_string (error
);
5070 msg
= Fformat (3, args
);
5072 nbytes
= SBYTES (msg
);
5073 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5074 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5076 for (i
= 0; i
< 3; ++i
)
5079 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5081 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5082 Fsleep_for (make_number (1), Qnil
);
5096 auto_save_mode_bits
= 0666;
5098 /* Get visited file's mode to become the auto save file's mode. */
5099 if (! NILP (current_buffer
->filename
))
5101 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5102 /* But make sure we can overwrite it later! */
5103 auto_save_mode_bits
= st
.st_mode
| 0600;
5104 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5106 /* Remote files don't cooperate with stat. */
5107 auto_save_mode_bits
= XINT (modes
) | 0600;
5111 Fwrite_region (Qnil
, Qnil
, current_buffer
->auto_save_file_name
, Qnil
,
5112 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5117 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5120 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5132 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5135 minibuffer_auto_raise
= XINT (value
);
5140 do_auto_save_make_dir (dir
)
5145 call2 (Qmake_directory
, dir
, Qt
);
5146 XSETFASTINT (mode
, 0700);
5147 return Fset_file_modes (dir
, mode
);
5151 do_auto_save_eh (ignore
)
5157 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5158 doc
: /* Auto-save all buffers that need it.
5159 This is all buffers that have auto-saving enabled
5160 and are changed since last auto-saved.
5161 Auto-saving writes the buffer into a file
5162 so that your editing is not lost if the system crashes.
5163 This file is not the file you visited; that changes only when you save.
5164 Normally we run the normal hook `auto-save-hook' before saving.
5166 A non-nil NO-MESSAGE argument means do not print any message if successful.
5167 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5168 (no_message
, current_only
)
5169 Lisp_Object no_message
, current_only
;
5171 struct buffer
*old
= current_buffer
, *b
;
5172 Lisp_Object tail
, buf
;
5174 int do_handled_files
;
5176 FILE *stream
= NULL
;
5177 int count
= SPECPDL_INDEX ();
5178 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5179 int old_message_p
= 0;
5180 struct gcpro gcpro1
, gcpro2
;
5182 if (max_specpdl_size
< specpdl_size
+ 40)
5183 max_specpdl_size
= specpdl_size
+ 40;
5188 if (NILP (no_message
))
5190 old_message_p
= push_message ();
5191 record_unwind_protect (pop_message_unwind
, Qnil
);
5194 /* Ordinarily don't quit within this function,
5195 but don't make it impossible to quit (in case we get hung in I/O). */
5199 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5200 point to non-strings reached from Vbuffer_alist. */
5202 if (!NILP (Vrun_hooks
))
5203 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5205 if (STRINGP (Vauto_save_list_file_name
))
5207 Lisp_Object listfile
;
5209 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5211 /* Don't try to create the directory when shutting down Emacs,
5212 because creating the directory might signal an error, and
5213 that would leave Emacs in a strange state. */
5214 if (!NILP (Vrun_hooks
))
5218 GCPRO2 (dir
, listfile
);
5219 dir
= Ffile_name_directory (listfile
);
5220 if (NILP (Ffile_directory_p (dir
)))
5221 internal_condition_case_1 (do_auto_save_make_dir
,
5222 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5227 stream
= fopen (SDATA (listfile
), "w");
5230 record_unwind_protect (do_auto_save_unwind
,
5231 make_save_value (stream
, 0));
5232 record_unwind_protect (do_auto_save_unwind_1
,
5233 make_number (minibuffer_auto_raise
));
5234 minibuffer_auto_raise
= 0;
5236 auto_save_error_occurred
= 0;
5238 /* On first pass, save all files that don't have handlers.
5239 On second pass, save all files that do have handlers.
5241 If Emacs is crashing, the handlers may tweak what is causing
5242 Emacs to crash in the first place, and it would be a shame if
5243 Emacs failed to autosave perfectly ordinary files because it
5244 couldn't handle some ange-ftp'd file. */
5246 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5247 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5249 buf
= XCDR (XCAR (tail
));
5252 /* Record all the buffers that have auto save mode
5253 in the special file that lists them. For each of these buffers,
5254 Record visited name (if any) and auto save name. */
5255 if (STRINGP (b
->auto_save_file_name
)
5256 && stream
!= NULL
&& do_handled_files
== 0)
5259 if (!NILP (b
->filename
))
5261 fwrite (SDATA (b
->filename
), 1,
5262 SBYTES (b
->filename
), stream
);
5264 putc ('\n', stream
);
5265 fwrite (SDATA (b
->auto_save_file_name
), 1,
5266 SBYTES (b
->auto_save_file_name
), stream
);
5267 putc ('\n', stream
);
5271 if (!NILP (current_only
)
5272 && b
!= current_buffer
)
5275 /* Don't auto-save indirect buffers.
5276 The base buffer takes care of it. */
5280 /* Check for auto save enabled
5281 and file changed since last auto save
5282 and file changed since last real save. */
5283 if (STRINGP (b
->auto_save_file_name
)
5284 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5285 && b
->auto_save_modified
< BUF_MODIFF (b
)
5286 /* -1 means we've turned off autosaving for a while--see below. */
5287 && XINT (b
->save_length
) >= 0
5288 && (do_handled_files
5289 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5292 EMACS_TIME before_time
, after_time
;
5294 EMACS_GET_TIME (before_time
);
5296 /* If we had a failure, don't try again for 20 minutes. */
5297 if (b
->auto_save_failure_time
>= 0
5298 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5301 if ((XFASTINT (b
->save_length
) * 10
5302 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5303 /* A short file is likely to change a large fraction;
5304 spare the user annoying messages. */
5305 && XFASTINT (b
->save_length
) > 5000
5306 /* These messages are frequent and annoying for `*mail*'. */
5307 && !EQ (b
->filename
, Qnil
)
5308 && NILP (no_message
))
5310 /* It has shrunk too much; turn off auto-saving here. */
5311 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5312 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5314 minibuffer_auto_raise
= 0;
5315 /* Turn off auto-saving until there's a real save,
5316 and prevent any more warnings. */
5317 XSETINT (b
->save_length
, -1);
5318 Fsleep_for (make_number (1), Qnil
);
5321 set_buffer_internal (b
);
5322 if (!auto_saved
&& NILP (no_message
))
5323 message1 ("Auto-saving...");
5324 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5326 b
->auto_save_modified
= BUF_MODIFF (b
);
5327 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5328 set_buffer_internal (old
);
5330 EMACS_GET_TIME (after_time
);
5332 /* If auto-save took more than 60 seconds,
5333 assume it was an NFS failure that got a timeout. */
5334 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5335 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5339 /* Prevent another auto save till enough input events come in. */
5340 record_auto_save ();
5342 if (auto_saved
&& NILP (no_message
))
5346 /* If we are going to restore an old message,
5347 give time to read ours. */
5348 sit_for (make_number (1), 0, 0);
5351 else if (!auto_save_error_occurred
)
5352 /* Don't overwrite the error message if an error occurred.
5353 If we displayed a message and then restored a state
5354 with no message, leave a "done" message on the screen. */
5355 message1 ("Auto-saving...done");
5360 /* This restores the message-stack status. */
5361 unbind_to (count
, Qnil
);
5365 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5366 Sset_buffer_auto_saved
, 0, 0, 0,
5367 doc
: /* Mark current buffer as auto-saved with its current text.
5368 No auto-save file will be written until the buffer changes again. */)
5371 current_buffer
->auto_save_modified
= MODIFF
;
5372 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5373 current_buffer
->auto_save_failure_time
= -1;
5377 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5378 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5379 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5382 current_buffer
->auto_save_failure_time
= -1;
5386 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5388 doc
: /* Return t if current buffer has been auto-saved recently.
5389 More precisely, if it has been auto-saved since last read from or saved
5390 in the visited file. If the buffer has no visited file,
5391 then any auto-save counts as "recent". */)
5394 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5397 /* Reading and completing file names */
5399 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5400 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5401 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5402 The return value is only relevant for a call to `read-file-name' that happens
5403 before any other event (mouse or keypress) is handeled. */)
5406 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
5407 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5417 Fread_file_name (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
5418 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
5420 struct gcpro gcpro1
, gcpro2
;
5421 Lisp_Object args
[7];
5423 GCPRO1 (default_filename
);
5424 args
[0] = intern ("read-file-name");
5427 args
[3] = default_filename
;
5428 args
[4] = mustmatch
;
5430 args
[6] = predicate
;
5431 RETURN_UNGCPRO (Ffuncall (7, args
));
5438 /* Must be set before any path manipulation is performed. */
5439 XSETFASTINT (Vdirectory_sep_char
, '/');
5446 Qoperations
= intern ("operations");
5447 Qexpand_file_name
= intern ("expand-file-name");
5448 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5449 Qdirectory_file_name
= intern ("directory-file-name");
5450 Qfile_name_directory
= intern ("file-name-directory");
5451 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5452 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5453 Qfile_name_as_directory
= intern ("file-name-as-directory");
5454 Qcopy_file
= intern ("copy-file");
5455 Qmake_directory_internal
= intern ("make-directory-internal");
5456 Qmake_directory
= intern ("make-directory");
5457 Qdelete_directory
= intern ("delete-directory");
5458 Qdelete_file
= intern ("delete-file");
5459 Qrename_file
= intern ("rename-file");
5460 Qadd_name_to_file
= intern ("add-name-to-file");
5461 Qmake_symbolic_link
= intern ("make-symbolic-link");
5462 Qfile_exists_p
= intern ("file-exists-p");
5463 Qfile_executable_p
= intern ("file-executable-p");
5464 Qfile_readable_p
= intern ("file-readable-p");
5465 Qfile_writable_p
= intern ("file-writable-p");
5466 Qfile_symlink_p
= intern ("file-symlink-p");
5467 Qaccess_file
= intern ("access-file");
5468 Qfile_directory_p
= intern ("file-directory-p");
5469 Qfile_regular_p
= intern ("file-regular-p");
5470 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5471 Qfile_modes
= intern ("file-modes");
5472 Qset_file_modes
= intern ("set-file-modes");
5473 Qset_file_times
= intern ("set-file-times");
5474 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5475 Qinsert_file_contents
= intern ("insert-file-contents");
5476 Qwrite_region
= intern ("write-region");
5477 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5478 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5479 Qauto_save_coding
= intern ("auto-save-coding");
5481 staticpro (&Qoperations
);
5482 staticpro (&Qexpand_file_name
);
5483 staticpro (&Qsubstitute_in_file_name
);
5484 staticpro (&Qdirectory_file_name
);
5485 staticpro (&Qfile_name_directory
);
5486 staticpro (&Qfile_name_nondirectory
);
5487 staticpro (&Qunhandled_file_name_directory
);
5488 staticpro (&Qfile_name_as_directory
);
5489 staticpro (&Qcopy_file
);
5490 staticpro (&Qmake_directory_internal
);
5491 staticpro (&Qmake_directory
);
5492 staticpro (&Qdelete_directory
);
5493 staticpro (&Qdelete_file
);
5494 staticpro (&Qrename_file
);
5495 staticpro (&Qadd_name_to_file
);
5496 staticpro (&Qmake_symbolic_link
);
5497 staticpro (&Qfile_exists_p
);
5498 staticpro (&Qfile_executable_p
);
5499 staticpro (&Qfile_readable_p
);
5500 staticpro (&Qfile_writable_p
);
5501 staticpro (&Qaccess_file
);
5502 staticpro (&Qfile_symlink_p
);
5503 staticpro (&Qfile_directory_p
);
5504 staticpro (&Qfile_regular_p
);
5505 staticpro (&Qfile_accessible_directory_p
);
5506 staticpro (&Qfile_modes
);
5507 staticpro (&Qset_file_modes
);
5508 staticpro (&Qset_file_times
);
5509 staticpro (&Qfile_newer_than_file_p
);
5510 staticpro (&Qinsert_file_contents
);
5511 staticpro (&Qwrite_region
);
5512 staticpro (&Qverify_visited_file_modtime
);
5513 staticpro (&Qset_visited_file_modtime
);
5514 staticpro (&Qauto_save_coding
);
5516 Qfile_name_history
= intern ("file-name-history");
5517 Fset (Qfile_name_history
, Qnil
);
5518 staticpro (&Qfile_name_history
);
5520 Qfile_error
= intern ("file-error");
5521 staticpro (&Qfile_error
);
5522 Qfile_already_exists
= intern ("file-already-exists");
5523 staticpro (&Qfile_already_exists
);
5524 Qfile_date_error
= intern ("file-date-error");
5525 staticpro (&Qfile_date_error
);
5526 Qexcl
= intern ("excl");
5530 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5531 staticpro (&Qfind_buffer_file_type
);
5534 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5535 doc
: /* *Coding system for encoding file names.
5536 If it is nil, `default-file-name-coding-system' (which see) is used. */);
5537 Vfile_name_coding_system
= Qnil
;
5539 DEFVAR_LISP ("default-file-name-coding-system",
5540 &Vdefault_file_name_coding_system
,
5541 doc
: /* Default coding system for encoding file names.
5542 This variable is used only when `file-name-coding-system' is nil.
5544 This variable is set/changed by the command `set-language-environment'.
5545 User should not set this variable manually,
5546 instead use `file-name-coding-system' to get a constant encoding
5547 of file names regardless of the current language environment. */);
5548 Vdefault_file_name_coding_system
= Qnil
;
5550 Qformat_decode
= intern ("format-decode");
5551 staticpro (&Qformat_decode
);
5552 Qformat_annotate_function
= intern ("format-annotate-function");
5553 staticpro (&Qformat_annotate_function
);
5554 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
5555 staticpro (&Qafter_insert_file_set_coding
);
5557 Qcar_less_than_car
= intern ("car-less-than-car");
5558 staticpro (&Qcar_less_than_car
);
5560 Fput (Qfile_error
, Qerror_conditions
,
5561 list2 (Qfile_error
, Qerror
));
5562 Fput (Qfile_error
, Qerror_message
,
5563 build_string ("File error"));
5565 Fput (Qfile_already_exists
, Qerror_conditions
,
5566 list3 (Qfile_already_exists
, Qfile_error
, Qerror
));
5567 Fput (Qfile_already_exists
, Qerror_message
,
5568 build_string ("File already exists"));
5570 Fput (Qfile_date_error
, Qerror_conditions
,
5571 list3 (Qfile_date_error
, Qfile_error
, Qerror
));
5572 Fput (Qfile_date_error
, Qerror_message
,
5573 build_string ("Cannot set file date"));
5575 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5576 doc
: /* Directory separator character for built-in functions that return file names.
5577 The value is always ?/. Don't use this variable, just use `/'. */);
5579 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5580 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
5581 If a file name matches REGEXP, then all I/O on that file is done by calling
5584 The first argument given to HANDLER is the name of the I/O primitive
5585 to be handled; the remaining arguments are the arguments that were
5586 passed to that primitive. For example, if you do
5587 (file-exists-p FILENAME)
5588 and FILENAME is handled by HANDLER, then HANDLER is called like this:
5589 (funcall HANDLER 'file-exists-p FILENAME)
5590 The function `find-file-name-handler' checks this list for a handler
5591 for its argument. */);
5592 Vfile_name_handler_alist
= Qnil
;
5594 DEFVAR_LISP ("set-auto-coding-function",
5595 &Vset_auto_coding_function
,
5596 doc
: /* If non-nil, a function to call to decide a coding system of file.
5597 Two arguments are passed to this function: the file name
5598 and the length of a file contents following the point.
5599 This function should return a coding system to decode the file contents.
5600 It should check the file name against `auto-coding-alist'.
5601 If no coding system is decided, it should check a coding system
5602 specified in the heading lines with the format:
5603 -*- ... coding: CODING-SYSTEM; ... -*-
5604 or local variable spec of the tailing lines with `coding:' tag. */);
5605 Vset_auto_coding_function
= Qnil
;
5607 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5608 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
5609 Each is passed one argument, the number of characters inserted,
5610 with point at the start of the inserted text. Each function
5611 should leave point the same, and return the new character count.
5612 If `insert-file-contents' is intercepted by a handler from
5613 `file-name-handler-alist', that handler is responsible for calling the
5614 functions in `after-insert-file-functions' if appropriate. */);
5615 Vafter_insert_file_functions
= Qnil
;
5617 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5618 doc
: /* A list of functions to be called at the start of `write-region'.
5619 Each is passed two arguments, START and END as for `write-region'.
5620 These are usually two numbers but not always; see the documentation
5621 for `write-region'. The function should return a list of pairs
5622 of the form (POSITION . STRING), consisting of strings to be effectively
5623 inserted at the specified positions of the file being written (1 means to
5624 insert before the first byte written). The POSITIONs must be sorted into
5625 increasing order. If there are several functions in the list, the several
5626 lists are merged destructively. Alternatively, the function can return
5627 with a different buffer current; in that case it should pay attention
5628 to the annotations returned by previous functions and listed in
5629 `write-region-annotations-so-far'.*/);
5630 Vwrite_region_annotate_functions
= Qnil
;
5631 staticpro (&Qwrite_region_annotate_functions
);
5632 Qwrite_region_annotate_functions
5633 = intern ("write-region-annotate-functions");
5635 DEFVAR_LISP ("write-region-annotations-so-far",
5636 &Vwrite_region_annotations_so_far
,
5637 doc
: /* When an annotation function is called, this holds the previous annotations.
5638 These are the annotations made by other annotation functions
5639 that were already called. See also `write-region-annotate-functions'. */);
5640 Vwrite_region_annotations_so_far
= Qnil
;
5642 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5643 doc
: /* A list of file name handlers that temporarily should not be used.
5644 This applies only to the operation `inhibit-file-name-operation'. */);
5645 Vinhibit_file_name_handlers
= Qnil
;
5647 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5648 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5649 Vinhibit_file_name_operation
= Qnil
;
5651 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5652 doc
: /* File name in which we write a list of all auto save file names.
5653 This variable is initialized automatically from `auto-save-list-file-prefix'
5654 shortly after Emacs reads your `.emacs' file, if you have not yet given it
5655 a non-nil value. */);
5656 Vauto_save_list_file_name
= Qnil
;
5658 DEFVAR_LISP ("auto-save-visited-file-name", &Vauto_save_visited_file_name
,
5659 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
5660 Normally auto-save files are written under other names. */);
5661 Vauto_save_visited_file_name
= Qnil
;
5664 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
5665 doc
: /* *Non-nil means don't call fsync in `write-region'.
5666 This variable affects calls to `write-region' as well as save commands.
5667 A non-nil value may result in data loss! */);
5668 write_region_inhibit_fsync
= 0;
5671 DEFVAR_BOOL ("delete-by-moving-to-trash", &delete_by_moving_to_trash
,
5672 doc
: /* Specifies whether to use the system's trash can.
5673 When non-nil, the function `move-file-to-trash' will be used by
5674 `delete-file' and `delete-directory'. */);
5675 delete_by_moving_to_trash
= 0;
5676 Qmove_file_to_trash
= intern ("move-file-to-trash");
5677 staticpro (&Qmove_file_to_trash
);
5679 defsubr (&Sfind_file_name_handler
);
5680 defsubr (&Sfile_name_directory
);
5681 defsubr (&Sfile_name_nondirectory
);
5682 defsubr (&Sunhandled_file_name_directory
);
5683 defsubr (&Sfile_name_as_directory
);
5684 defsubr (&Sdirectory_file_name
);
5685 defsubr (&Smake_temp_name
);
5686 defsubr (&Sexpand_file_name
);
5687 defsubr (&Ssubstitute_in_file_name
);
5688 defsubr (&Scopy_file
);
5689 defsubr (&Smake_directory_internal
);
5690 defsubr (&Sdelete_directory
);
5691 defsubr (&Sdelete_file
);
5692 defsubr (&Srename_file
);
5693 defsubr (&Sadd_name_to_file
);
5694 defsubr (&Smake_symbolic_link
);
5695 defsubr (&Sfile_name_absolute_p
);
5696 defsubr (&Sfile_exists_p
);
5697 defsubr (&Sfile_executable_p
);
5698 defsubr (&Sfile_readable_p
);
5699 defsubr (&Sfile_writable_p
);
5700 defsubr (&Saccess_file
);
5701 defsubr (&Sfile_symlink_p
);
5702 defsubr (&Sfile_directory_p
);
5703 defsubr (&Sfile_accessible_directory_p
);
5704 defsubr (&Sfile_regular_p
);
5705 defsubr (&Sfile_modes
);
5706 defsubr (&Sset_file_modes
);
5707 defsubr (&Sset_file_times
);
5708 defsubr (&Sset_default_file_modes
);
5709 defsubr (&Sdefault_file_modes
);
5710 defsubr (&Sfile_newer_than_file_p
);
5711 defsubr (&Sinsert_file_contents
);
5712 defsubr (&Swrite_region
);
5713 defsubr (&Scar_less_than_car
);
5714 defsubr (&Sverify_visited_file_modtime
);
5715 defsubr (&Sclear_visited_file_modtime
);
5716 defsubr (&Svisited_file_modtime
);
5717 defsubr (&Sset_visited_file_modtime
);
5718 defsubr (&Sdo_auto_save
);
5719 defsubr (&Sset_buffer_auto_saved
);
5720 defsubr (&Sclear_buffer_auto_save_failure
);
5721 defsubr (&Srecent_auto_save_p
);
5723 defsubr (&Snext_read_file_uses_dialog_p
);
5726 defsubr (&Sunix_sync
);
5730 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
5731 (do not change this comment) */