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. (The slash case caters to
264 error messages that begin with "I/O" or, in German, "E/A".) */
265 if (STRING_MULTIBYTE (errstring
)
266 && ! EQ (Faref (errstring
, make_number (1)), make_number ('/')))
270 str
= (char *) SDATA (errstring
);
271 c
= STRING_CHAR (str
, 0);
272 Faset (errstring
, make_number (0), make_number (DOWNCASE (c
)));
275 xsignal (Qfile_error
,
276 Fcons (build_string (string
), Fcons (errstring
, data
)));
281 close_file_unwind (fd
)
284 emacs_close (XFASTINT (fd
));
288 /* Restore point, having saved it as a marker. */
291 restore_point_unwind (location
)
292 Lisp_Object location
;
294 Fgoto_char (location
);
295 Fset_marker (location
, Qnil
, Qnil
);
300 Lisp_Object Qexpand_file_name
;
301 Lisp_Object Qsubstitute_in_file_name
;
302 Lisp_Object Qdirectory_file_name
;
303 Lisp_Object Qfile_name_directory
;
304 Lisp_Object Qfile_name_nondirectory
;
305 Lisp_Object Qunhandled_file_name_directory
;
306 Lisp_Object Qfile_name_as_directory
;
307 Lisp_Object Qcopy_file
;
308 Lisp_Object Qmake_directory_internal
;
309 Lisp_Object Qmake_directory
;
310 Lisp_Object Qdelete_directory
;
311 Lisp_Object Qdelete_file
;
312 Lisp_Object Qrename_file
;
313 Lisp_Object Qadd_name_to_file
;
314 Lisp_Object Qmake_symbolic_link
;
315 Lisp_Object Qfile_exists_p
;
316 Lisp_Object Qfile_executable_p
;
317 Lisp_Object Qfile_readable_p
;
318 Lisp_Object Qfile_writable_p
;
319 Lisp_Object Qfile_symlink_p
;
320 Lisp_Object Qaccess_file
;
321 Lisp_Object Qfile_directory_p
;
322 Lisp_Object Qfile_regular_p
;
323 Lisp_Object Qfile_accessible_directory_p
;
324 Lisp_Object Qfile_modes
;
325 Lisp_Object Qset_file_modes
;
326 Lisp_Object Qset_file_times
;
327 Lisp_Object Qfile_newer_than_file_p
;
328 Lisp_Object Qinsert_file_contents
;
329 Lisp_Object Qwrite_region
;
330 Lisp_Object Qverify_visited_file_modtime
;
331 Lisp_Object Qset_visited_file_modtime
;
333 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
334 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
335 Otherwise, return nil.
336 A file name is handled if one of the regular expressions in
337 `file-name-handler-alist' matches it.
339 If OPERATION equals `inhibit-file-name-operation', then we ignore
340 any handlers that are members of `inhibit-file-name-handlers',
341 but we still do run any other handlers. This lets handlers
342 use the standard functions without calling themselves recursively. */)
343 (filename
, operation
)
344 Lisp_Object filename
, operation
;
346 /* This function must not munge the match data. */
347 Lisp_Object chain
, inhibited_handlers
, result
;
351 CHECK_STRING (filename
);
353 if (EQ (operation
, Vinhibit_file_name_operation
))
354 inhibited_handlers
= Vinhibit_file_name_handlers
;
356 inhibited_handlers
= Qnil
;
358 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
359 chain
= XCDR (chain
))
365 Lisp_Object string
= XCAR (elt
);
367 Lisp_Object handler
= XCDR (elt
);
368 Lisp_Object operations
= Qnil
;
370 if (SYMBOLP (handler
))
371 operations
= Fget (handler
, Qoperations
);
374 && (match_pos
= fast_string_match (string
, filename
)) > pos
375 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
379 handler
= XCDR (elt
);
380 tem
= Fmemq (handler
, inhibited_handlers
);
394 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
396 doc
: /* Return the directory component in file name FILENAME.
397 Return nil if FILENAME does not include a directory.
398 Otherwise return a directory name.
399 Given a Unix syntax file name, returns a string ending in slash. */)
401 Lisp_Object filename
;
404 register const unsigned char *beg
;
406 register unsigned char *beg
;
408 register const unsigned char *p
;
411 CHECK_STRING (filename
);
413 /* If the file name has special constructs in it,
414 call the corresponding file handler. */
415 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
417 return call2 (handler
, Qfile_name_directory
, filename
);
419 filename
= FILE_SYSTEM_CASE (filename
);
420 beg
= SDATA (filename
);
422 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
424 p
= beg
+ SBYTES (filename
);
426 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
428 /* only recognise drive specifier at the beginning */
430 /* handle the "/:d:foo" and "/:foo" cases correctly */
431 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
432 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
439 /* Expansion of "c:" to drive and default directory. */
442 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
443 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
444 unsigned char *r
= res
;
446 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
448 strncpy (res
, beg
, 2);
453 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
455 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
458 p
= beg
+ strlen (beg
);
461 CORRECT_DIR_SEPS (beg
);
464 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
467 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
468 Sfile_name_nondirectory
, 1, 1, 0,
469 doc
: /* Return file name FILENAME sans its directory.
470 For example, in a Unix-syntax file name,
471 this is everything after the last slash,
472 or the entire name if it contains no slash. */)
474 Lisp_Object filename
;
476 register const unsigned char *beg
, *p
, *end
;
479 CHECK_STRING (filename
);
481 /* If the file name has special constructs in it,
482 call the corresponding file handler. */
483 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
485 return call2 (handler
, Qfile_name_nondirectory
, filename
);
487 beg
= SDATA (filename
);
488 end
= p
= beg
+ SBYTES (filename
);
490 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
492 /* only recognise drive specifier at beginning */
494 /* handle the "/:d:foo" case correctly */
495 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
500 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
503 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
504 Sunhandled_file_name_directory
, 1, 1, 0,
505 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
506 A `directly usable' directory name is one that may be used without the
507 intervention of any file handler.
508 If FILENAME is a directly usable file itself, return
509 \(file-name-directory FILENAME).
510 If FILENAME refers to a file which is not accessible from a local process,
511 then this should return nil.
512 The `call-process' and `start-process' functions use this function to
513 get a current directory to run processes in. */)
515 Lisp_Object filename
;
519 /* If the file name has special constructs in it,
520 call the corresponding file handler. */
521 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
523 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
525 return Ffile_name_directory (filename
);
530 file_name_as_directory (out
, in
)
533 int size
= strlen (in
) - 1;
545 /* For Unix syntax, Append a slash if necessary */
546 if (!IS_DIRECTORY_SEP (out
[size
]))
548 /* Cannot use DIRECTORY_SEP, which could have any value */
550 out
[size
+ 2] = '\0';
553 CORRECT_DIR_SEPS (out
);
558 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
559 Sfile_name_as_directory
, 1, 1, 0,
560 doc
: /* Return a string representing the file name FILE interpreted as a directory.
561 This operation exists because a directory is also a file, but its name as
562 a directory is different from its name as a file.
563 The result can be used as the value of `default-directory'
564 or passed as second argument to `expand-file-name'.
565 For a Unix-syntax file name, just appends a slash. */)
576 /* If the file name has special constructs in it,
577 call the corresponding file handler. */
578 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
580 return call2 (handler
, Qfile_name_as_directory
, file
);
582 buf
= (char *) alloca (SBYTES (file
) + 10);
583 file_name_as_directory (buf
, SDATA (file
));
584 return make_specified_string (buf
, -1, strlen (buf
),
585 STRING_MULTIBYTE (file
));
589 * Convert from directory name to filename.
590 * On UNIX, it's simple: just make sure there isn't a terminating /
592 * Value is nonzero if the string output is different from the input.
596 directory_file_name (src
, dst
)
603 /* Process as Unix format: just remove any final slash.
604 But leave "/" unchanged; do not change it to "". */
607 && IS_DIRECTORY_SEP (dst
[slen
- 1])
609 && !IS_ANY_SEP (dst
[slen
- 2])
614 CORRECT_DIR_SEPS (dst
);
619 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
621 doc
: /* Returns the file name of the directory named DIRECTORY.
622 This is the name of the file that holds the data for the directory DIRECTORY.
623 This operation exists because a directory is also a file, but its name as
624 a directory is different from its name as a file.
625 In Unix-syntax, this function just removes the final slash. */)
627 Lisp_Object directory
;
632 CHECK_STRING (directory
);
634 if (NILP (directory
))
637 /* If the file name has special constructs in it,
638 call the corresponding file handler. */
639 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
641 return call2 (handler
, Qdirectory_file_name
, directory
);
643 buf
= (char *) alloca (SBYTES (directory
) + 20);
644 directory_file_name (SDATA (directory
), buf
);
645 return make_specified_string (buf
, -1, strlen (buf
),
646 STRING_MULTIBYTE (directory
));
649 static char make_temp_name_tbl
[64] =
651 'A','B','C','D','E','F','G','H',
652 'I','J','K','L','M','N','O','P',
653 'Q','R','S','T','U','V','W','X',
654 'Y','Z','a','b','c','d','e','f',
655 'g','h','i','j','k','l','m','n',
656 'o','p','q','r','s','t','u','v',
657 'w','x','y','z','0','1','2','3',
658 '4','5','6','7','8','9','-','_'
661 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
663 /* Value is a temporary file name starting with PREFIX, a string.
665 The Emacs process number forms part of the result, so there is
666 no danger of generating a name being used by another process.
667 In addition, this function makes an attempt to choose a name
668 which has no existing file. To make this work, PREFIX should be
669 an absolute file name.
671 BASE64_P non-zero means add the pid as 3 characters in base64
672 encoding. In this case, 6 characters will be added to PREFIX to
673 form the file name. Otherwise, if Emacs is running on a system
674 with long file names, add the pid as a decimal number.
676 This function signals an error if no unique file name could be
680 make_temp_name (prefix
, base64_p
)
687 unsigned char *p
, *data
;
691 CHECK_STRING (prefix
);
693 /* VAL is created by adding 6 characters to PREFIX. The first
694 three are the PID of this process, in base 64, and the second
695 three are incremented if the file already exists. This ensures
696 262144 unique file names per PID per PREFIX. */
698 pid
= (int) getpid ();
702 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
703 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
704 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
709 #ifdef HAVE_LONG_FILE_NAMES
710 sprintf (pidbuf
, "%d", pid
);
711 pidlen
= strlen (pidbuf
);
713 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
714 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
715 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
720 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
721 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
722 if (!STRING_MULTIBYTE (prefix
))
723 STRING_SET_UNIBYTE (val
);
725 bcopy(SDATA (prefix
), data
, len
);
728 bcopy (pidbuf
, p
, pidlen
);
731 /* Here we try to minimize useless stat'ing when this function is
732 invoked many times successively with the same PREFIX. We achieve
733 this by initializing count to a random value, and incrementing it
736 We don't want make-temp-name to be called while dumping,
737 because then make_temp_name_count_initialized_p would get set
738 and then make_temp_name_count would not be set when Emacs starts. */
740 if (!make_temp_name_count_initialized_p
)
742 make_temp_name_count
= (unsigned) time (NULL
);
743 make_temp_name_count_initialized_p
= 1;
749 unsigned num
= make_temp_name_count
;
751 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
752 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
753 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
755 /* Poor man's congruential RN generator. Replace with
756 ++make_temp_name_count for debugging. */
757 make_temp_name_count
+= 25229;
758 make_temp_name_count
%= 225307;
760 if (stat (data
, &ignored
) < 0)
762 /* We want to return only if errno is ENOENT. */
766 /* The error here is dubious, but there is little else we
767 can do. The alternatives are to return nil, which is
768 as bad as (and in many cases worse than) throwing the
769 error, or to ignore the error, which will likely result
770 in looping through 225307 stat's, which is not only
771 dog-slow, but also useless since it will fallback to
772 the errow below, anyway. */
773 report_file_error ("Cannot create temporary name for prefix",
774 Fcons (prefix
, Qnil
));
779 error ("Cannot create temporary name for prefix `%s'",
785 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
786 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
787 The Emacs process number forms part of the result,
788 so there is no danger of generating a name being used by another process.
790 In addition, this function makes an attempt to choose a name
791 which has no existing file. To make this work,
792 PREFIX should be an absolute file name.
794 There is a race condition between calling `make-temp-name' and creating the
795 file which opens all kinds of security holes. For that reason, you should
796 probably use `make-temp-file' instead, except in three circumstances:
798 * If you are creating the file in the user's home directory.
799 * If you are creating a directory rather than an ordinary file.
800 * If you are taking special precautions as `make-temp-file' does. */)
804 return make_temp_name (prefix
, 0);
809 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
810 doc
: /* Convert filename NAME to absolute, and canonicalize it.
811 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
812 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
813 the current buffer's value of `default-directory' is used.
814 File name components that are `.' are removed, and
815 so are file name components followed by `..', along with the `..' itself;
816 note that these simplifications are done without checking the resulting
817 file names in the file system.
818 An initial `~/' expands to your home directory.
819 An initial `~USER/' expands to USER's home directory.
820 See also the function `substitute-in-file-name'. */)
821 (name
, default_directory
)
822 Lisp_Object name
, default_directory
;
824 /* These point to SDATA and need to be careful with string-relocation
825 during GC (via DECODE_FILE). */
826 unsigned char *nm
, *newdir
;
827 /* This should only point to alloca'd data. */
828 unsigned char *target
;
834 int collapse_newdir
= 1;
838 Lisp_Object handler
, result
;
844 /* If the file name has special constructs in it,
845 call the corresponding file handler. */
846 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
848 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
850 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
851 if (NILP (default_directory
))
852 default_directory
= current_buffer
->directory
;
853 if (! STRINGP (default_directory
))
856 /* "/" is not considered a root directory on DOS_NT, so using "/"
857 here causes an infinite recursion in, e.g., the following:
859 (let (default-directory)
860 (expand-file-name "a"))
862 To avoid this, we set default_directory to the root of the
864 extern char *emacs_root_dir (void);
866 default_directory
= build_string (emacs_root_dir ());
868 default_directory
= build_string ("/");
872 if (!NILP (default_directory
))
874 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
876 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
880 unsigned char *o
= SDATA (default_directory
);
882 /* Make sure DEFAULT_DIRECTORY is properly expanded.
883 It would be better to do this down below where we actually use
884 default_directory. Unfortunately, calling Fexpand_file_name recursively
885 could invoke GC, and the strings might be relocated. This would
886 be annoying because we have pointers into strings lying around
887 that would need adjusting, and people would add new pointers to
888 the code and forget to adjust them, resulting in intermittent bugs.
889 Putting this call here avoids all that crud.
891 The EQ test avoids infinite recursion. */
892 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
893 /* Save time in some common cases - as long as default_directory
894 is not relative, it can be canonicalized with name below (if it
895 is needed at all) without requiring it to be expanded now. */
897 /* Detect MSDOS file names with drive specifiers. */
898 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
899 && IS_DIRECTORY_SEP (o
[2]))
901 /* Detect Windows file names in UNC format. */
902 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
904 #else /* not DOS_NT */
905 /* Detect Unix absolute file names (/... alone is not absolute on
907 && ! (IS_DIRECTORY_SEP (o
[0]))
908 #endif /* not DOS_NT */
914 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
918 name
= FILE_SYSTEM_CASE (name
);
919 multibyte
= STRING_MULTIBYTE (name
);
920 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
923 default_directory
= string_to_multibyte (default_directory
);
926 name
= string_to_multibyte (name
);
933 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
934 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
937 /* Note if special escape prefix is present, but remove for now. */
938 if (nm
[0] == '/' && nm
[1] == ':')
944 /* Find and remove drive specifier if present; this makes nm absolute
945 even if the rest of the name appears to be relative. Only look for
946 drive specifier at the beginning. */
947 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
954 /* If we see "c://somedir", we want to strip the first slash after the
955 colon when stripping the drive letter. Otherwise, this expands to
957 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
960 /* Discard any previous drive specifier if nm is now in UNC format. */
961 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
965 #endif /* WINDOWSNT */
968 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
969 none are found, we can probably return right away. We will avoid
970 allocating a new string if name is already fully expanded. */
972 IS_DIRECTORY_SEP (nm
[0])
974 && drive
&& !is_escaped
977 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
981 /* If it turns out that the filename we want to return is just a
982 suffix of FILENAME, we don't need to go through and edit
983 things; we just need to construct a new string using data
984 starting at the middle of FILENAME. If we set lose to a
985 non-zero value, that means we've discovered that we can't do
988 unsigned char *p
= nm
;
992 /* Since we know the name is absolute, we can assume that each
993 element starts with a "/". */
995 /* "." and ".." are hairy. */
996 if (IS_DIRECTORY_SEP (p
[0])
998 && (IS_DIRECTORY_SEP (p
[2])
1000 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1003 /* We want to replace multiple `/' in a row with a single
1006 && IS_DIRECTORY_SEP (p
[0])
1007 && IS_DIRECTORY_SEP (p
[1]))
1014 /* Make sure directories are all separated with / or \ as
1015 desired, but avoid allocation of a new string when not
1017 CORRECT_DIR_SEPS (nm
);
1019 if (IS_DIRECTORY_SEP (nm
[1]))
1021 if (strcmp (nm
, SDATA (name
)) != 0)
1022 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1026 /* drive must be set, so this is okay */
1027 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1031 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1032 temp
[0] = DRIVE_LETTER (drive
);
1033 name
= concat2 (build_string (temp
), name
);
1036 #else /* not DOS_NT */
1037 if (strcmp (nm
, SDATA (name
)) == 0)
1039 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1040 #endif /* not DOS_NT */
1044 /* At this point, nm might or might not be an absolute file name. We
1045 need to expand ~ or ~user if present, otherwise prefix nm with
1046 default_directory if nm is not absolute, and finally collapse /./
1047 and /foo/../ sequences.
1049 We set newdir to be the appropriate prefix if one is needed:
1050 - the relevant user directory if nm starts with ~ or ~user
1051 - the specified drive's working dir (DOS/NT only) if nm does not
1053 - the value of default_directory.
1055 Note that these prefixes are not guaranteed to be absolute (except
1056 for the working dir of a drive). Therefore, to ensure we always
1057 return an absolute name, if the final prefix is not absolute we
1058 append it to the current working directory. */
1062 if (nm
[0] == '~') /* prefix ~ */
1064 if (IS_DIRECTORY_SEP (nm
[1])
1065 || nm
[1] == 0) /* ~ by itself */
1069 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1070 newdir
= (unsigned char *) "";
1072 /* egetenv may return a unibyte string, which will bite us since
1073 we expect the directory to be multibyte. */
1074 tem
= build_string (newdir
);
1075 if (!STRING_MULTIBYTE (tem
))
1077 hdir
= DECODE_FILE (tem
);
1078 newdir
= SDATA (hdir
);
1081 collapse_newdir
= 0;
1084 else /* ~user/filename */
1086 unsigned char *o
, *p
;
1087 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)); p
++);
1088 o
= alloca (p
- nm
+ 1);
1089 bcopy ((char *) nm
, o
, p
- nm
);
1093 pw
= (struct passwd
*) getpwnam (o
+ 1);
1097 newdir
= (unsigned char *) pw
-> pw_dir
;
1100 collapse_newdir
= 0;
1104 /* If we don't find a user of that name, leave the name
1105 unchanged; don't move nm forward to p. */
1110 /* On DOS and Windows, nm is absolute if a drive name was specified;
1111 use the drive's current directory as the prefix if needed. */
1112 if (!newdir
&& drive
)
1114 /* Get default directory if needed to make nm absolute. */
1115 if (!IS_DIRECTORY_SEP (nm
[0]))
1117 newdir
= alloca (MAXPATHLEN
+ 1);
1118 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1123 /* Either nm starts with /, or drive isn't mounted. */
1124 newdir
= alloca (4);
1125 newdir
[0] = DRIVE_LETTER (drive
);
1133 /* Finally, if no prefix has been specified and nm is not absolute,
1134 then it must be expanded relative to default_directory. */
1138 /* /... alone is not absolute on DOS and Windows. */
1139 && !IS_DIRECTORY_SEP (nm
[0])
1142 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1146 newdir
= SDATA (default_directory
);
1148 /* Note if special escape prefix is present, but remove for now. */
1149 if (newdir
[0] == '/' && newdir
[1] == ':')
1160 /* First ensure newdir is an absolute name. */
1162 /* Detect MSDOS file names with drive specifiers. */
1163 ! (IS_DRIVE (newdir
[0])
1164 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1166 /* Detect Windows file names in UNC format. */
1167 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1171 /* Effectively, let newdir be (expand-file-name newdir cwd).
1172 Because of the admonition against calling expand-file-name
1173 when we have pointers into lisp strings, we accomplish this
1174 indirectly by prepending newdir to nm if necessary, and using
1175 cwd (or the wd of newdir's drive) as the new newdir. */
1177 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1182 if (!IS_DIRECTORY_SEP (nm
[0]))
1184 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1185 file_name_as_directory (tmp
, newdir
);
1189 newdir
= alloca (MAXPATHLEN
+ 1);
1192 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1199 /* Strip off drive name from prefix, if present. */
1200 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1206 /* Keep only a prefix from newdir if nm starts with slash
1207 (//server/share for UNC, nothing otherwise). */
1208 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1211 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1214 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1216 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1218 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1230 /* Get rid of any slash at the end of newdir, unless newdir is
1231 just / or // (an incomplete UNC name). */
1232 length
= strlen (newdir
);
1233 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1235 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1239 unsigned char *temp
= (unsigned char *) alloca (length
);
1240 bcopy (newdir
, temp
, length
- 1);
1241 temp
[length
- 1] = 0;
1249 /* Now concatenate the directory and name to new space in the stack frame */
1250 tlen
+= strlen (nm
) + 1;
1252 /* Reserve space for drive specifier and escape prefix, since either
1253 or both may need to be inserted. (The Microsoft x86 compiler
1254 produces incorrect code if the following two lines are combined.) */
1255 target
= (unsigned char *) alloca (tlen
+ 4);
1257 #else /* not DOS_NT */
1258 target
= (unsigned char *) alloca (tlen
);
1259 #endif /* not DOS_NT */
1264 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1267 /* If newdir is effectively "C:/", then the drive letter will have
1268 been stripped and newdir will be "/". Concatenating with an
1269 absolute directory in nm produces "//", which will then be
1270 incorrectly treated as a network share. Ignore newdir in
1271 this case (keeping the drive letter). */
1272 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1273 && newdir
[1] == '\0'))
1275 strcpy (target
, newdir
);
1278 file_name_as_directory (target
, newdir
);
1281 strcat (target
, nm
);
1283 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1286 unsigned char *p
= target
;
1287 unsigned char *o
= target
;
1291 if (!IS_DIRECTORY_SEP (*p
))
1295 else if (p
[1] == '.'
1296 && (IS_DIRECTORY_SEP (p
[2])
1299 /* If "/." is the entire filename, keep the "/". Otherwise,
1300 just delete the whole "/.". */
1301 if (o
== target
&& p
[2] == '\0')
1305 else if (p
[1] == '.' && p
[2] == '.'
1306 /* `/../' is the "superroot" on certain file systems.
1307 Turned off on DOS_NT systems because they have no
1308 "superroot" and because this causes us to produce
1309 file names like "d:/../foo" which fail file-related
1310 functions of the underlying OS. (To reproduce, try a
1311 long series of "../../" in default_directory, longer
1312 than the number of levels from the root.) */
1316 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1318 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1320 /* Keep initial / only if this is the whole name. */
1321 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1325 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1326 /* Collapse multiple `/' in a row. */
1335 /* At last, set drive name. */
1337 /* Except for network file name. */
1338 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1339 #endif /* WINDOWSNT */
1341 if (!drive
) abort ();
1343 target
[0] = DRIVE_LETTER (drive
);
1346 /* Reinsert the escape prefix if required. */
1353 CORRECT_DIR_SEPS (target
);
1356 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1359 /* Again look to see if the file name has special constructs in it
1360 and perhaps call the corresponding file handler. This is needed
1361 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1362 the ".." component gives us "/user@host:/bar/../baz" which needs
1363 to be expanded again. */
1364 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1365 if (!NILP (handler
))
1366 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1372 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1373 This is the old version of expand-file-name, before it was thoroughly
1374 rewritten for Emacs 10.31. We leave this version here commented-out,
1375 because the code is very complex and likely to have subtle bugs. If
1376 bugs _are_ found, it might be of interest to look at the old code and
1377 see what did it do in the relevant situation.
1379 Don't remove this code: it's true that it will be accessible via CVS,
1380 but a few years from deletion, people will forget it is there. */
1382 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1383 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1384 "Convert FILENAME to absolute, and canonicalize it.\n\
1385 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1386 \(does not start with slash); if DEFAULT is nil or missing,\n\
1387 the current buffer's value of default-directory is used.\n\
1388 Filenames containing `.' or `..' as components are simplified;\n\
1389 initial `~/' expands to your home directory.\n\
1390 See also the function `substitute-in-file-name'.")
1392 Lisp_Object name
, defalt
;
1396 register unsigned char *newdir
, *p
, *o
;
1398 unsigned char *target
;
1402 CHECK_STRING (name
);
1405 /* If nm is absolute, flush ...// and detect /./ and /../.
1406 If no /./ or /../ we can return right away. */
1413 if (p
[0] == '/' && p
[1] == '/'
1416 if (p
[0] == '/' && p
[1] == '~')
1417 nm
= p
+ 1, lose
= 1;
1418 if (p
[0] == '/' && p
[1] == '.'
1419 && (p
[2] == '/' || p
[2] == 0
1420 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1426 if (nm
== SDATA (name
))
1428 return build_string (nm
);
1432 /* Now determine directory to start with and put it in NEWDIR */
1436 if (nm
[0] == '~') /* prefix ~ */
1437 if (nm
[1] == '/' || nm
[1] == 0)/* ~/filename */
1439 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1440 newdir
= (unsigned char *) "";
1443 else /* ~user/filename */
1445 /* Get past ~ to user */
1446 unsigned char *user
= nm
+ 1;
1447 /* Find end of name. */
1448 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1449 int len
= ptr
? ptr
- user
: strlen (user
);
1450 /* Copy the user name into temp storage. */
1451 o
= (unsigned char *) alloca (len
+ 1);
1452 bcopy ((char *) user
, o
, len
);
1455 /* Look up the user name. */
1457 pw
= (struct passwd
*) getpwnam (o
+ 1);
1460 error ("\"%s\" isn't a registered user", o
+ 1);
1462 newdir
= (unsigned char *) pw
->pw_dir
;
1464 /* Discard the user name from NM. */
1468 if (nm
[0] != '/' && !newdir
)
1471 defalt
= current_buffer
->directory
;
1472 CHECK_STRING (defalt
);
1473 newdir
= SDATA (defalt
);
1476 /* Now concatenate the directory and name to new space in the stack frame */
1478 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1479 target
= (unsigned char *) alloca (tlen
);
1484 if (nm
[0] == 0 || nm
[0] == '/')
1485 strcpy (target
, newdir
);
1487 file_name_as_directory (target
, newdir
);
1490 strcat (target
, nm
);
1492 /* Now canonicalize by removing /. and /foo/.. if they appear */
1503 else if (!strncmp (p
, "//", 2)
1509 else if (p
[0] == '/' && p
[1] == '.'
1510 && (p
[2] == '/' || p
[2] == 0))
1512 else if (!strncmp (p
, "/..", 3)
1513 /* `/../' is the "superroot" on certain file systems. */
1515 && (p
[3] == '/' || p
[3] == 0))
1517 while (o
!= target
&& *--o
!= '/')
1519 if (o
== target
&& *o
== '/')
1529 return make_string (target
, o
- target
);
1533 /* If /~ or // appears, discard everything through first slash. */
1535 file_name_absolute_p (filename
)
1536 const unsigned char *filename
;
1539 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
1541 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
1542 && IS_DIRECTORY_SEP (filename
[2]))
1547 static unsigned char *
1548 search_embedded_absfilename (nm
, endp
)
1549 unsigned char *nm
, *endp
;
1551 unsigned char *p
, *s
;
1553 for (p
= nm
+ 1; p
< endp
; p
++)
1556 || IS_DIRECTORY_SEP (p
[-1]))
1557 && file_name_absolute_p (p
)
1558 #if defined (WINDOWSNT) || defined(CYGWIN)
1559 /* // at start of file name is meaningful in Apollo,
1560 WindowsNT and Cygwin systems. */
1561 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
1562 #endif /* not (WINDOWSNT || CYGWIN) */
1565 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)); s
++);
1566 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
1568 unsigned char *o
= alloca (s
- p
+ 1);
1570 bcopy (p
, o
, s
- p
);
1573 /* If we have ~user and `user' exists, discard
1574 everything up to ~. But if `user' does not exist, leave
1575 ~user alone, it might be a literal file name. */
1577 pw
= getpwnam (o
+ 1);
1589 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1590 Ssubstitute_in_file_name
, 1, 1, 0,
1591 doc
: /* Substitute environment variables referred to in FILENAME.
1592 `$FOO' where FOO is an environment variable name means to substitute
1593 the value of that variable. The variable name should be terminated
1594 with a character not a letter, digit or underscore; otherwise, enclose
1595 the entire variable name in braces.
1596 If `/~' appears, all of FILENAME through that `/' is discarded. */)
1598 Lisp_Object filename
;
1602 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1603 unsigned char *target
= NULL
;
1605 int substituted
= 0;
1607 Lisp_Object handler
;
1609 CHECK_STRING (filename
);
1611 /* If the file name has special constructs in it,
1612 call the corresponding file handler. */
1613 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1614 if (!NILP (handler
))
1615 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1617 nm
= SDATA (filename
);
1619 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1620 CORRECT_DIR_SEPS (nm
);
1621 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
1623 endp
= nm
+ SBYTES (filename
);
1625 /* If /~ or // appears, discard everything through first slash. */
1626 p
= search_embedded_absfilename (nm
, endp
);
1628 /* Start over with the new string, so we check the file-name-handler
1629 again. Important with filenames like "/home/foo//:/hello///there"
1630 which whould substitute to "/:/hello///there" rather than "/there". */
1631 return Fsubstitute_in_file_name
1632 (make_specified_string (p
, -1, endp
- p
,
1633 STRING_MULTIBYTE (filename
)));
1636 /* See if any variables are substituted into the string
1637 and find the total length of their values in `total' */
1639 for (p
= nm
; p
!= endp
;)
1649 /* "$$" means a single "$" */
1658 while (p
!= endp
&& *p
!= '}') p
++;
1659 if (*p
!= '}') goto missingclose
;
1665 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1669 /* Copy out the variable name */
1670 target
= (unsigned char *) alloca (s
- o
+ 1);
1671 strncpy (target
, o
, s
- o
);
1674 strupr (target
); /* $home == $HOME etc. */
1677 /* Get variable value */
1678 o
= (unsigned char *) egetenv (target
);
1680 { /* Eight-bit chars occupy upto 2 bytes in multibyte. */
1681 total
+= strlen (o
) * (STRING_MULTIBYTE (filename
) ? 2 : 1);
1691 /* If substitution required, recopy the string and do it */
1692 /* Make space in stack frame for the new copy */
1693 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
1696 /* Copy the rest of the name through, replacing $ constructs with values */
1713 while (p
!= endp
&& *p
!= '}') p
++;
1714 if (*p
!= '}') goto missingclose
;
1720 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1724 /* Copy out the variable name */
1725 target
= (unsigned char *) alloca (s
- o
+ 1);
1726 strncpy (target
, o
, s
- o
);
1729 strupr (target
); /* $home == $HOME etc. */
1732 /* Get variable value */
1733 o
= (unsigned char *) egetenv (target
);
1737 strcpy (x
, target
); x
+= strlen (target
);
1739 else if (STRING_MULTIBYTE (filename
))
1741 /* If the original string is multibyte,
1742 convert what we substitute into multibyte. */
1746 c
= unibyte_char_to_multibyte (c
);
1747 x
+= CHAR_STRING (c
, x
);
1759 /* If /~ or // appears, discard everything through first slash. */
1760 while ((p
= search_embedded_absfilename (xnm
, x
)))
1761 /* This time we do not start over because we've already expanded envvars
1762 and replaced $$ with $. Maybe we should start over as well, but we'd
1763 need to quote some $ to $$ first. */
1766 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
1769 error ("Bad format environment-variable substitution");
1771 error ("Missing \"}\" in environment-variable substitution");
1773 error ("Substituting nonexistent environment variable \"%s\"", target
);
1779 /* A slightly faster and more convenient way to get
1780 (directory-file-name (expand-file-name FOO)). */
1783 expand_and_dir_to_file (filename
, defdir
)
1784 Lisp_Object filename
, defdir
;
1786 register Lisp_Object absname
;
1788 absname
= Fexpand_file_name (filename
, defdir
);
1790 /* Remove final slash, if any (unless this is the root dir).
1791 stat behaves differently depending! */
1792 if (SCHARS (absname
) > 1
1793 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
1794 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
1795 /* We cannot take shortcuts; they might be wrong for magic file names. */
1796 absname
= Fdirectory_file_name (absname
);
1800 /* Signal an error if the file ABSNAME already exists.
1801 If INTERACTIVE is nonzero, ask the user whether to proceed,
1802 and bypass the error if the user says to go ahead.
1803 QUERYSTRING is a name for the action that is being considered
1806 *STATPTR is used to store the stat information if the file exists.
1807 If the file does not exist, STATPTR->st_mode is set to 0.
1808 If STATPTR is null, we don't store into it.
1810 If QUICK is nonzero, we ask for y or n, not yes or no. */
1813 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
1814 Lisp_Object absname
;
1815 unsigned char *querystring
;
1817 struct stat
*statptr
;
1820 register Lisp_Object tem
, encoded_filename
;
1821 struct stat statbuf
;
1822 struct gcpro gcpro1
;
1824 encoded_filename
= ENCODE_FILE (absname
);
1826 /* stat is a good way to tell whether the file exists,
1827 regardless of what access permissions it has. */
1828 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
1831 xsignal2 (Qfile_already_exists
,
1832 build_string ("File already exists"), absname
);
1834 tem
= format2 ("File %s already exists; %s anyway? ",
1835 absname
, build_string (querystring
));
1837 tem
= Fy_or_n_p (tem
);
1839 tem
= do_yes_or_no_p (tem
);
1842 xsignal2 (Qfile_already_exists
,
1843 build_string ("File already exists"), absname
);
1850 statptr
->st_mode
= 0;
1855 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
1856 "fCopy file: \nGCopy %s to file: \np\nP",
1857 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
1858 If NEWNAME names a directory, copy FILE there.
1860 This function always sets the file modes of the output file to match
1863 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1864 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1865 signal a `file-already-exists' error without overwriting. If
1866 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1867 about overwriting; this is what happens in interactive use with M-x.
1868 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1871 Fourth arg KEEP-TIME non-nil means give the output file the same
1872 last-modified time as the old one. (This works on only some systems.)
1874 A prefix arg makes KEEP-TIME non-nil.
1876 If PRESERVE-UID-GID is non-nil, we try to transfer the
1877 uid and gid of FILE to NEWNAME. */)
1878 (file
, newname
, ok_if_already_exists
, keep_time
, preserve_uid_gid
)
1879 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
1880 Lisp_Object preserve_uid_gid
;
1883 char buf
[16 * 1024];
1884 struct stat st
, out_st
;
1885 Lisp_Object handler
;
1886 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1887 int count
= SPECPDL_INDEX ();
1888 int input_file_statable_p
;
1889 Lisp_Object encoded_file
, encoded_newname
;
1891 encoded_file
= encoded_newname
= Qnil
;
1892 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
1893 CHECK_STRING (file
);
1894 CHECK_STRING (newname
);
1896 if (!NILP (Ffile_directory_p (newname
)))
1897 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
1899 newname
= Fexpand_file_name (newname
, Qnil
);
1901 file
= Fexpand_file_name (file
, Qnil
);
1903 /* If the input file name has special constructs in it,
1904 call the corresponding file handler. */
1905 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1906 /* Likewise for output file name. */
1908 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1909 if (!NILP (handler
))
1910 RETURN_UNGCPRO (call6 (handler
, Qcopy_file
, file
, newname
,
1911 ok_if_already_exists
, keep_time
, preserve_uid_gid
));
1913 encoded_file
= ENCODE_FILE (file
);
1914 encoded_newname
= ENCODE_FILE (newname
);
1916 if (NILP (ok_if_already_exists
)
1917 || INTEGERP (ok_if_already_exists
))
1918 barf_or_query_if_file_exists (newname
, "copy to it",
1919 INTEGERP (ok_if_already_exists
), &out_st
, 0);
1920 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
1924 if (!CopyFile (SDATA (encoded_file
),
1925 SDATA (encoded_newname
),
1927 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
1928 /* CopyFile retains the timestamp by default. */
1929 else if (NILP (keep_time
))
1935 EMACS_GET_TIME (now
);
1936 filename
= SDATA (encoded_newname
);
1938 /* Ensure file is writable while its modified time is set. */
1939 attributes
= GetFileAttributes (filename
);
1940 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
1941 if (set_file_times (filename
, now
, now
))
1943 /* Restore original attributes. */
1944 SetFileAttributes (filename
, attributes
);
1945 xsignal2 (Qfile_date_error
,
1946 build_string ("Cannot set file date"), newname
);
1948 /* Restore original attributes. */
1949 SetFileAttributes (filename
, attributes
);
1951 #else /* not WINDOWSNT */
1953 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
1957 report_file_error ("Opening input file", Fcons (file
, Qnil
));
1959 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1961 /* We can only copy regular files and symbolic links. Other files are not
1963 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1965 #if !defined (MSDOS) || __DJGPP__ > 1
1966 if (out_st
.st_mode
!= 0
1967 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
1970 report_file_error ("Input and output files are the same",
1971 Fcons (file
, Fcons (newname
, Qnil
)));
1975 #if defined (S_ISREG) && defined (S_ISLNK)
1976 if (input_file_statable_p
)
1978 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1980 #if defined (EISDIR)
1981 /* Get a better looking error message. */
1984 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
1987 #endif /* S_ISREG && S_ISLNK */
1990 /* System's default file type was set to binary by _fmode in emacs.c. */
1991 ofd
= emacs_open (SDATA (encoded_newname
),
1992 O_WRONLY
| O_TRUNC
| O_CREAT
1993 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
1994 S_IREAD
| S_IWRITE
);
1995 #else /* not MSDOS */
1996 ofd
= emacs_open (SDATA (encoded_newname
),
1997 O_WRONLY
| O_TRUNC
| O_CREAT
1998 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2000 #endif /* not MSDOS */
2002 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2004 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2008 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2009 if (emacs_write (ofd
, buf
, n
) != n
)
2010 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2014 /* Preserve the original file modes, and if requested, also its
2016 if (input_file_statable_p
)
2018 if (! NILP (preserve_uid_gid
))
2019 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2020 fchmod (ofd
, st
.st_mode
& 07777);
2022 #endif /* not MSDOS */
2024 /* Closing the output clobbers the file times on some systems. */
2025 if (emacs_close (ofd
) < 0)
2026 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2028 if (input_file_statable_p
)
2030 if (!NILP (keep_time
))
2032 EMACS_TIME atime
, mtime
;
2033 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2034 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2035 if (set_file_times (SDATA (encoded_newname
),
2037 xsignal2 (Qfile_date_error
,
2038 build_string ("Cannot set file date"), newname
);
2044 #if defined (__DJGPP__) && __DJGPP__ > 1
2045 if (input_file_statable_p
)
2047 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2048 and if it can't, it tells so. Otherwise, under MSDOS we usually
2049 get only the READ bit, which will make the copied file read-only,
2050 so it's better not to chmod at all. */
2051 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2052 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2054 #endif /* DJGPP version 2 or newer */
2055 #endif /* not WINDOWSNT */
2057 /* Discard the unwind protects. */
2058 specpdl_ptr
= specpdl
+ count
;
2064 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2065 Smake_directory_internal
, 1, 1, 0,
2066 doc
: /* Create a new directory named DIRECTORY. */)
2068 Lisp_Object directory
;
2070 const unsigned char *dir
;
2071 Lisp_Object handler
;
2072 Lisp_Object encoded_dir
;
2074 CHECK_STRING (directory
);
2075 directory
= Fexpand_file_name (directory
, Qnil
);
2077 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2078 if (!NILP (handler
))
2079 return call2 (handler
, Qmake_directory_internal
, directory
);
2081 encoded_dir
= ENCODE_FILE (directory
);
2083 dir
= SDATA (encoded_dir
);
2086 if (mkdir (dir
) != 0)
2088 if (mkdir (dir
, 0777) != 0)
2090 report_file_error ("Creating directory", list1 (directory
));
2095 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2096 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2098 Lisp_Object directory
;
2100 const unsigned char *dir
;
2101 Lisp_Object handler
;
2102 Lisp_Object encoded_dir
;
2104 CHECK_STRING (directory
);
2105 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2107 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2108 if (!NILP (handler
))
2109 return call2 (handler
, Qdelete_directory
, directory
);
2111 if (delete_by_moving_to_trash
)
2112 return call1 (Qmove_file_to_trash
, directory
);
2114 encoded_dir
= ENCODE_FILE (directory
);
2116 dir
= SDATA (encoded_dir
);
2118 if (rmdir (dir
) != 0)
2119 report_file_error ("Removing directory", list1 (directory
));
2124 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2125 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2126 If file has multiple names, it continues to exist with the other names. */)
2128 Lisp_Object filename
;
2130 Lisp_Object handler
;
2131 Lisp_Object encoded_file
;
2132 struct gcpro gcpro1
;
2135 if (!NILP (Ffile_directory_p (filename
))
2136 && NILP (Ffile_symlink_p (filename
)))
2137 xsignal2 (Qfile_error
,
2138 build_string ("Removing old name: is a directory"),
2141 filename
= Fexpand_file_name (filename
, Qnil
);
2143 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2144 if (!NILP (handler
))
2145 return call2 (handler
, Qdelete_file
, filename
);
2147 if (delete_by_moving_to_trash
)
2148 return call1 (Qmove_file_to_trash
, filename
);
2150 encoded_file
= ENCODE_FILE (filename
);
2152 if (0 > unlink (SDATA (encoded_file
)))
2153 report_file_error ("Removing old name", list1 (filename
));
2158 internal_delete_file_1 (ignore
)
2164 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2167 internal_delete_file (filename
)
2168 Lisp_Object filename
;
2171 tem
= internal_condition_case_1 (Fdelete_file
, filename
,
2172 Qt
, internal_delete_file_1
);
2176 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2177 "fRename file: \nGRename %s to file: \np",
2178 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2179 If file has names other than FILE, it continues to have those names.
2180 Signals a `file-already-exists' error if a file NEWNAME already exists
2181 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2182 A number as third arg means request confirmation if NEWNAME already exists.
2183 This is what happens in interactive use with M-x. */)
2184 (file
, newname
, ok_if_already_exists
)
2185 Lisp_Object file
, newname
, ok_if_already_exists
;
2187 Lisp_Object handler
;
2188 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2189 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2191 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2192 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2193 CHECK_STRING (file
);
2194 CHECK_STRING (newname
);
2195 file
= Fexpand_file_name (file
, Qnil
);
2197 if ((!NILP (Ffile_directory_p (newname
)))
2199 /* If the file names are identical but for the case,
2200 don't attempt to move directory to itself. */
2201 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2204 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2206 newname
= Fexpand_file_name (newname
, Qnil
);
2208 /* If the file name has special constructs in it,
2209 call the corresponding file handler. */
2210 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2212 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2213 if (!NILP (handler
))
2214 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2215 file
, newname
, ok_if_already_exists
));
2217 encoded_file
= ENCODE_FILE (file
);
2218 encoded_newname
= ENCODE_FILE (newname
);
2221 /* If the file names are identical but for the case, don't ask for
2222 confirmation: they simply want to change the letter-case of the
2224 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2226 if (NILP (ok_if_already_exists
)
2227 || INTEGERP (ok_if_already_exists
))
2228 barf_or_query_if_file_exists (newname
, "rename to it",
2229 INTEGERP (ok_if_already_exists
), 0, 0);
2230 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2235 symlink_target
= Ffile_symlink_p (file
);
2236 if (! NILP (symlink_target
))
2237 Fmake_symbolic_link (symlink_target
, newname
,
2238 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2241 Fcopy_file (file
, newname
,
2242 /* We have already prompted if it was an integer,
2243 so don't have copy-file prompt again. */
2244 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2247 Fdelete_file (file
);
2250 report_file_error ("Renaming", list2 (file
, newname
));
2256 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2257 "fAdd name to file: \nGName to add to %s: \np",
2258 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2259 Signals a `file-already-exists' error if a file NEWNAME already exists
2260 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2261 A number as third arg means request confirmation if NEWNAME already exists.
2262 This is what happens in interactive use with M-x. */)
2263 (file
, newname
, ok_if_already_exists
)
2264 Lisp_Object file
, newname
, ok_if_already_exists
;
2266 Lisp_Object handler
;
2267 Lisp_Object encoded_file
, encoded_newname
;
2268 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2270 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2271 encoded_file
= encoded_newname
= Qnil
;
2272 CHECK_STRING (file
);
2273 CHECK_STRING (newname
);
2274 file
= Fexpand_file_name (file
, Qnil
);
2276 if (!NILP (Ffile_directory_p (newname
)))
2277 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2279 newname
= Fexpand_file_name (newname
, Qnil
);
2281 /* If the file name has special constructs in it,
2282 call the corresponding file handler. */
2283 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2284 if (!NILP (handler
))
2285 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2286 newname
, ok_if_already_exists
));
2288 /* If the new name has special constructs in it,
2289 call the corresponding file handler. */
2290 handler
= Ffind_file_name_handler (newname
, 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 encoded_file
= ENCODE_FILE (file
);
2296 encoded_newname
= ENCODE_FILE (newname
);
2298 if (NILP (ok_if_already_exists
)
2299 || INTEGERP (ok_if_already_exists
))
2300 barf_or_query_if_file_exists (newname
, "make it a new name",
2301 INTEGERP (ok_if_already_exists
), 0, 0);
2303 unlink (SDATA (newname
));
2304 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2305 report_file_error ("Adding new name", list2 (file
, newname
));
2311 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2312 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2313 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2314 Both args must be strings.
2315 Signals a `file-already-exists' error if a file LINKNAME already exists
2316 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2317 A number as third arg means request confirmation if LINKNAME already exists.
2318 This happens for interactive use with M-x. */)
2319 (filename
, linkname
, ok_if_already_exists
)
2320 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2322 Lisp_Object handler
;
2323 Lisp_Object encoded_filename
, encoded_linkname
;
2324 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2326 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2327 encoded_filename
= encoded_linkname
= Qnil
;
2328 CHECK_STRING (filename
);
2329 CHECK_STRING (linkname
);
2330 /* If the link target has a ~, we must expand it to get
2331 a truly valid file name. Otherwise, do not expand;
2332 we want to permit links to relative file names. */
2333 if (SREF (filename
, 0) == '~')
2334 filename
= Fexpand_file_name (filename
, Qnil
);
2336 if (!NILP (Ffile_directory_p (linkname
)))
2337 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2339 linkname
= Fexpand_file_name (linkname
, Qnil
);
2341 /* If the file name has special constructs in it,
2342 call the corresponding file handler. */
2343 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2344 if (!NILP (handler
))
2345 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2346 linkname
, ok_if_already_exists
));
2348 /* If the new link name has special constructs in it,
2349 call the corresponding file handler. */
2350 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2351 if (!NILP (handler
))
2352 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2353 linkname
, ok_if_already_exists
));
2356 encoded_filename
= ENCODE_FILE (filename
);
2357 encoded_linkname
= ENCODE_FILE (linkname
);
2359 if (NILP (ok_if_already_exists
)
2360 || INTEGERP (ok_if_already_exists
))
2361 barf_or_query_if_file_exists (linkname
, "make it a link",
2362 INTEGERP (ok_if_already_exists
), 0, 0);
2363 if (0 > symlink (SDATA (encoded_filename
),
2364 SDATA (encoded_linkname
)))
2366 /* If we didn't complain already, silently delete existing file. */
2367 if (errno
== EEXIST
)
2369 unlink (SDATA (encoded_linkname
));
2370 if (0 <= symlink (SDATA (encoded_filename
),
2371 SDATA (encoded_linkname
)))
2378 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2385 xsignal1 (Qfile_error
, build_string ("Symbolic links are not supported"));
2387 #endif /* S_IFLNK */
2391 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2393 doc
: /* Return t if file FILENAME specifies an absolute file name.
2394 On Unix, this is a name starting with a `/' or a `~'. */)
2396 Lisp_Object filename
;
2398 CHECK_STRING (filename
);
2399 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
2402 /* Return nonzero if file FILENAME exists and can be executed. */
2405 check_executable (filename
)
2409 int len
= strlen (filename
);
2412 if (stat (filename
, &st
) < 0)
2414 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2415 return ((st
.st_mode
& S_IEXEC
) != 0);
2417 return (S_ISREG (st
.st_mode
)
2419 && (xstrcasecmp ((suffix
= filename
+ len
-4), ".com") == 0
2420 || xstrcasecmp (suffix
, ".exe") == 0
2421 || xstrcasecmp (suffix
, ".bat") == 0)
2422 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2423 #endif /* not WINDOWSNT */
2424 #else /* not DOS_NT */
2425 #ifdef HAVE_EUIDACCESS
2426 return (euidaccess (filename
, 1) >= 0);
2428 /* Access isn't quite right because it uses the real uid
2429 and we really want to test with the effective uid.
2430 But Unix doesn't give us a right way to do it. */
2431 return (access (filename
, 1) >= 0);
2433 #endif /* not DOS_NT */
2436 /* Return nonzero if file FILENAME exists and can be written. */
2439 check_writable (filename
)
2444 if (stat (filename
, &st
) < 0)
2446 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2447 #else /* not MSDOS */
2448 #ifdef HAVE_EUIDACCESS
2449 return (euidaccess (filename
, 2) >= 0);
2451 /* Access isn't quite right because it uses the real uid
2452 and we really want to test with the effective uid.
2453 But Unix doesn't give us a right way to do it.
2454 Opening with O_WRONLY could work for an ordinary file,
2455 but would lose for directories. */
2456 return (access (filename
, 2) >= 0);
2458 #endif /* not MSDOS */
2461 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2462 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
2463 See also `file-readable-p' and `file-attributes'.
2464 This returns nil for a symlink to a nonexistent file.
2465 Use `file-symlink-p' to test for such links. */)
2467 Lisp_Object filename
;
2469 Lisp_Object absname
;
2470 Lisp_Object handler
;
2471 struct stat statbuf
;
2473 CHECK_STRING (filename
);
2474 absname
= Fexpand_file_name (filename
, Qnil
);
2476 /* If the file name has special constructs in it,
2477 call the corresponding file handler. */
2478 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2479 if (!NILP (handler
))
2480 return call2 (handler
, Qfile_exists_p
, absname
);
2482 absname
= ENCODE_FILE (absname
);
2484 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
2487 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2488 doc
: /* Return t if FILENAME can be executed by you.
2489 For a directory, this means you can access files in that directory. */)
2491 Lisp_Object filename
;
2493 Lisp_Object absname
;
2494 Lisp_Object handler
;
2496 CHECK_STRING (filename
);
2497 absname
= Fexpand_file_name (filename
, Qnil
);
2499 /* If the file name has special constructs in it,
2500 call the corresponding file handler. */
2501 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2502 if (!NILP (handler
))
2503 return call2 (handler
, Qfile_executable_p
, absname
);
2505 absname
= ENCODE_FILE (absname
);
2507 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
2510 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2511 doc
: /* Return t if file FILENAME exists and you can read it.
2512 See also `file-exists-p' and `file-attributes'. */)
2514 Lisp_Object filename
;
2516 Lisp_Object absname
;
2517 Lisp_Object handler
;
2520 struct stat statbuf
;
2522 CHECK_STRING (filename
);
2523 absname
= Fexpand_file_name (filename
, Qnil
);
2525 /* If the file name has special constructs in it,
2526 call the corresponding file handler. */
2527 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2528 if (!NILP (handler
))
2529 return call2 (handler
, Qfile_readable_p
, absname
);
2531 absname
= ENCODE_FILE (absname
);
2533 #if defined(DOS_NT) || defined(macintosh)
2534 /* Under MS-DOS, Windows, and Macintosh, open does not work for
2536 if (access (SDATA (absname
), 0) == 0)
2539 #else /* not DOS_NT and not macintosh */
2541 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2542 /* Opening a fifo without O_NONBLOCK can wait.
2543 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2544 except in the case of a fifo, on a system which handles it. */
2545 desc
= stat (SDATA (absname
), &statbuf
);
2548 if (S_ISFIFO (statbuf
.st_mode
))
2549 flags
|= O_NONBLOCK
;
2551 desc
= emacs_open (SDATA (absname
), flags
, 0);
2556 #endif /* not DOS_NT and not macintosh */
2559 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2561 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2562 doc
: /* Return t if file FILENAME can be written or created by you. */)
2564 Lisp_Object filename
;
2566 Lisp_Object absname
, dir
, encoded
;
2567 Lisp_Object handler
;
2568 struct stat statbuf
;
2570 CHECK_STRING (filename
);
2571 absname
= Fexpand_file_name (filename
, Qnil
);
2573 /* If the file name has special constructs in it,
2574 call the corresponding file handler. */
2575 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2576 if (!NILP (handler
))
2577 return call2 (handler
, Qfile_writable_p
, absname
);
2579 encoded
= ENCODE_FILE (absname
);
2580 if (stat (SDATA (encoded
), &statbuf
) >= 0)
2581 return (check_writable (SDATA (encoded
))
2584 dir
= Ffile_name_directory (absname
);
2587 dir
= Fdirectory_file_name (dir
);
2590 dir
= ENCODE_FILE (dir
);
2592 /* The read-only attribute of the parent directory doesn't affect
2593 whether a file or directory can be created within it. Some day we
2594 should check ACLs though, which do affect this. */
2595 if (stat (SDATA (dir
), &statbuf
) < 0)
2597 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2599 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
2604 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2605 doc
: /* Access file FILENAME, and get an error if that does not work.
2606 The second argument STRING is used in the error message.
2607 If there is no error, returns nil. */)
2609 Lisp_Object filename
, string
;
2611 Lisp_Object handler
, encoded_filename
, absname
;
2614 CHECK_STRING (filename
);
2615 absname
= Fexpand_file_name (filename
, Qnil
);
2617 CHECK_STRING (string
);
2619 /* If the file name has special constructs in it,
2620 call the corresponding file handler. */
2621 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
2622 if (!NILP (handler
))
2623 return call3 (handler
, Qaccess_file
, absname
, string
);
2625 encoded_filename
= ENCODE_FILE (absname
);
2627 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
2629 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
2635 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2636 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
2637 The value is the link target, as a string.
2638 Otherwise it returns nil.
2640 This function returns t when given the name of a symlink that
2641 points to a nonexistent file. */)
2643 Lisp_Object filename
;
2645 Lisp_Object handler
;
2647 CHECK_STRING (filename
);
2648 filename
= Fexpand_file_name (filename
, Qnil
);
2650 /* If the file name has special constructs in it,
2651 call the corresponding file handler. */
2652 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2653 if (!NILP (handler
))
2654 return call2 (handler
, Qfile_symlink_p
, filename
);
2663 filename
= ENCODE_FILE (filename
);
2670 buf
= (char *) xrealloc (buf
, bufsize
);
2671 bzero (buf
, bufsize
);
2674 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
2678 /* HP-UX reports ERANGE if buffer is too small. */
2679 if (errno
== ERANGE
)
2689 while (valsize
>= bufsize
);
2691 val
= make_string (buf
, valsize
);
2692 if (buf
[0] == '/' && index (buf
, ':'))
2693 val
= concat2 (build_string ("/:"), val
);
2695 val
= DECODE_FILE (val
);
2698 #else /* not S_IFLNK */
2700 #endif /* not S_IFLNK */
2703 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2704 doc
: /* Return t if FILENAME names an existing directory.
2705 Symbolic links to directories count as directories.
2706 See `file-symlink-p' to distinguish symlinks. */)
2708 Lisp_Object filename
;
2710 register Lisp_Object absname
;
2712 Lisp_Object handler
;
2714 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2716 /* If the file name has special constructs in it,
2717 call the corresponding file handler. */
2718 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2719 if (!NILP (handler
))
2720 return call2 (handler
, Qfile_directory_p
, absname
);
2722 absname
= ENCODE_FILE (absname
);
2724 if (stat (SDATA (absname
), &st
) < 0)
2726 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2729 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2730 doc
: /* Return t if file FILENAME names a directory you can open.
2731 For the value to be t, FILENAME must specify the name of a directory as a file,
2732 and the directory must allow you to open files in it. In order to use a
2733 directory as a buffer's current directory, this predicate must return true.
2734 A directory name spec may be given instead; then the value is t
2735 if the directory so specified exists and really is a readable and
2736 searchable directory. */)
2738 Lisp_Object filename
;
2740 Lisp_Object handler
;
2742 struct gcpro gcpro1
;
2744 /* If the file name has special constructs in it,
2745 call the corresponding file handler. */
2746 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2747 if (!NILP (handler
))
2748 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2751 tem
= (NILP (Ffile_directory_p (filename
))
2752 || NILP (Ffile_executable_p (filename
)));
2754 return tem
? Qnil
: Qt
;
2757 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2758 doc
: /* Return t if FILENAME names a regular file.
2759 This is the sort of file that holds an ordinary stream of data bytes.
2760 Symbolic links to regular files count as regular files.
2761 See `file-symlink-p' to distinguish symlinks. */)
2763 Lisp_Object filename
;
2765 register Lisp_Object absname
;
2767 Lisp_Object handler
;
2769 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2771 /* If the file name has special constructs in it,
2772 call the corresponding file handler. */
2773 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2774 if (!NILP (handler
))
2775 return call2 (handler
, Qfile_regular_p
, absname
);
2777 absname
= ENCODE_FILE (absname
);
2782 Lisp_Object tem
= Vw32_get_true_file_attributes
;
2784 /* Tell stat to use expensive method to get accurate info. */
2785 Vw32_get_true_file_attributes
= Qt
;
2786 result
= stat (SDATA (absname
), &st
);
2787 Vw32_get_true_file_attributes
= tem
;
2791 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2794 if (stat (SDATA (absname
), &st
) < 0)
2796 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2800 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2801 doc
: /* Return mode bits of file named FILENAME, as an integer.
2802 Return nil, if file does not exist or is not accessible. */)
2804 Lisp_Object filename
;
2806 Lisp_Object absname
;
2808 Lisp_Object handler
;
2810 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2812 /* If the file name has special constructs in it,
2813 call the corresponding file handler. */
2814 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2815 if (!NILP (handler
))
2816 return call2 (handler
, Qfile_modes
, absname
);
2818 absname
= ENCODE_FILE (absname
);
2820 if (stat (SDATA (absname
), &st
) < 0)
2822 #if defined (MSDOS) && __DJGPP__ < 2
2823 if (check_executable (SDATA (absname
)))
2824 st
.st_mode
|= S_IEXEC
;
2825 #endif /* MSDOS && __DJGPP__ < 2 */
2827 return make_number (st
.st_mode
& 07777);
2830 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
2831 "(let ((file (read-file-name \"File: \"))) \
2832 (list file (read-file-modes nil file)))",
2833 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
2834 Only the 12 low bits of MODE are used. */)
2836 Lisp_Object filename
, mode
;
2838 Lisp_Object absname
, encoded_absname
;
2839 Lisp_Object handler
;
2841 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2842 CHECK_NUMBER (mode
);
2844 /* If the file name has special constructs in it,
2845 call the corresponding file handler. */
2846 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2847 if (!NILP (handler
))
2848 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2850 encoded_absname
= ENCODE_FILE (absname
);
2852 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
2853 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2858 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2859 doc
: /* Set the file permission bits for newly created files.
2860 The argument MODE should be an integer; only the low 9 bits are used.
2861 This setting is inherited by subprocesses. */)
2865 CHECK_NUMBER (mode
);
2867 umask ((~ XINT (mode
)) & 0777);
2872 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2873 doc
: /* Return the default file protection for created files.
2874 The value is an integer. */)
2880 realmask
= umask (0);
2883 XSETINT (value
, (~ realmask
) & 0777);
2887 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
2889 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
2890 doc
: /* Set times of file FILENAME to TIME.
2891 Set both access and modification times.
2892 Return t on success, else nil.
2893 Use the current time if TIME is nil. TIME is in the format of
2896 Lisp_Object filename
, time
;
2898 Lisp_Object absname
, encoded_absname
;
2899 Lisp_Object handler
;
2903 if (! lisp_time_argument (time
, &sec
, &usec
))
2904 error ("Invalid time specification");
2906 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2908 /* If the file name has special constructs in it,
2909 call the corresponding file handler. */
2910 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
2911 if (!NILP (handler
))
2912 return call3 (handler
, Qset_file_times
, absname
, time
);
2914 encoded_absname
= ENCODE_FILE (absname
);
2919 EMACS_SET_SECS (t
, sec
);
2920 EMACS_SET_USECS (t
, usec
);
2922 if (set_file_times (SDATA (encoded_absname
), t
, t
))
2927 /* Setting times on a directory always fails. */
2928 if (stat (SDATA (encoded_absname
), &st
) == 0
2929 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
2932 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
2941 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2942 doc
: /* Tell Unix to finish all pending disk updates. */)
2949 #endif /* HAVE_SYNC */
2951 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2952 doc
: /* Return t if file FILE1 is newer than file FILE2.
2953 If FILE1 does not exist, the answer is nil;
2954 otherwise, if FILE2 does not exist, the answer is t. */)
2956 Lisp_Object file1
, file2
;
2958 Lisp_Object absname1
, absname2
;
2961 Lisp_Object handler
;
2962 struct gcpro gcpro1
, gcpro2
;
2964 CHECK_STRING (file1
);
2965 CHECK_STRING (file2
);
2968 GCPRO2 (absname1
, file2
);
2969 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2970 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2973 /* If the file name has special constructs in it,
2974 call the corresponding file handler. */
2975 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
2977 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
2978 if (!NILP (handler
))
2979 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
2981 GCPRO2 (absname1
, absname2
);
2982 absname1
= ENCODE_FILE (absname1
);
2983 absname2
= ENCODE_FILE (absname2
);
2986 if (stat (SDATA (absname1
), &st
) < 0)
2989 mtime1
= st
.st_mtime
;
2991 if (stat (SDATA (absname2
), &st
) < 0)
2994 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2998 Lisp_Object Qfind_buffer_file_type
;
3001 #ifndef READ_BUF_SIZE
3002 #define READ_BUF_SIZE (64 << 10)
3005 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3007 /* This function is called after Lisp functions to decide a coding
3008 system are called, or when they cause an error. Before they are
3009 called, the current buffer is set unibyte and it contains only a
3010 newly inserted text (thus the buffer was empty before the
3013 The functions may set markers, overlays, text properties, or even
3014 alter the buffer contents, change the current buffer.
3016 Here, we reset all those changes by:
3017 o set back the current buffer.
3018 o move all markers and overlays to BEG.
3019 o remove all text properties.
3020 o set back the buffer multibyteness. */
3023 decide_coding_unwind (unwind_data
)
3024 Lisp_Object unwind_data
;
3026 Lisp_Object multibyte
, undo_list
, buffer
;
3028 multibyte
= XCAR (unwind_data
);
3029 unwind_data
= XCDR (unwind_data
);
3030 undo_list
= XCAR (unwind_data
);
3031 buffer
= XCDR (unwind_data
);
3033 if (current_buffer
!= XBUFFER (buffer
))
3034 set_buffer_internal (XBUFFER (buffer
));
3035 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3036 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3037 BUF_INTERVALS (current_buffer
) = 0;
3038 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3040 /* Now we are safe to change the buffer's multibyteness directly. */
3041 current_buffer
->enable_multibyte_characters
= multibyte
;
3042 current_buffer
->undo_list
= undo_list
;
3048 /* Used to pass values from insert-file-contents to read_non_regular. */
3050 static int non_regular_fd
;
3051 static int non_regular_inserted
;
3052 static int non_regular_nbytes
;
3055 /* Read from a non-regular file.
3056 Read non_regular_trytry bytes max from non_regular_fd.
3057 Non_regular_inserted specifies where to put the read bytes.
3058 Value is the number of bytes read. */
3067 nbytes
= emacs_read (non_regular_fd
,
3068 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3069 non_regular_nbytes
);
3071 return make_number (nbytes
);
3075 /* Condition-case handler used when reading from non-regular files
3076 in insert-file-contents. */
3079 read_non_regular_quit ()
3085 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3087 doc
: /* Insert contents of file FILENAME after point.
3088 Returns list of absolute file name and number of characters inserted.
3089 If second argument VISIT is non-nil, the buffer's visited filename and
3090 last save file modtime are set, and it is marked unmodified. If
3091 visiting and the file does not exist, visiting is completed before the
3094 The optional third and fourth arguments BEG and END specify what portion
3095 of the file to insert. These arguments count bytes in the file, not
3096 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3098 If optional fifth argument REPLACE is non-nil, replace the current
3099 buffer contents (in the accessible portion) with the file contents.
3100 This is better than simply deleting and inserting the whole thing
3101 because (1) it preserves some marker positions and (2) it puts less data
3102 in the undo list. When REPLACE is non-nil, the second return value is
3103 the number of characters that replace previous buffer contents.
3105 This function does code conversion according to the value of
3106 `coding-system-for-read' or `file-coding-system-alist', and sets the
3107 variable `last-coding-system-used' to the coding system actually used. */)
3108 (filename
, visit
, beg
, end
, replace
)
3109 Lisp_Object filename
, visit
, beg
, end
, replace
;
3115 register int how_much
;
3116 register int unprocessed
;
3117 int count
= SPECPDL_INDEX ();
3118 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3119 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3122 int not_regular
= 0;
3123 unsigned char read_buf
[READ_BUF_SIZE
];
3124 struct coding_system coding
;
3125 unsigned char buffer
[1 << 14];
3126 int replace_handled
= 0;
3127 int set_coding_system
= 0;
3128 Lisp_Object coding_system
;
3130 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3131 int we_locked_file
= 0;
3133 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3134 error ("Cannot do file visiting in an indirect buffer");
3136 if (!NILP (current_buffer
->read_only
))
3137 Fbarf_if_buffer_read_only ();
3141 orig_filename
= Qnil
;
3144 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3146 CHECK_STRING (filename
);
3147 filename
= Fexpand_file_name (filename
, Qnil
);
3149 /* The value Qnil means that the coding system is not yet
3151 coding_system
= Qnil
;
3153 /* If the file name has special constructs in it,
3154 call the corresponding file handler. */
3155 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3156 if (!NILP (handler
))
3158 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3159 visit
, beg
, end
, replace
);
3160 if (CONSP (val
) && CONSP (XCDR (val
)))
3161 inserted
= XINT (XCAR (XCDR (val
)));
3165 orig_filename
= filename
;
3166 filename
= ENCODE_FILE (filename
);
3172 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3174 /* Tell stat to use expensive method to get accurate info. */
3175 Vw32_get_true_file_attributes
= Qt
;
3176 total
= stat (SDATA (filename
), &st
);
3177 Vw32_get_true_file_attributes
= tem
;
3181 if (stat (SDATA (filename
), &st
) < 0)
3182 #endif /* WINDOWSNT */
3184 if (fd
>= 0) emacs_close (fd
);
3187 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3190 if (!NILP (Vcoding_system_for_read
))
3191 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3196 /* This code will need to be changed in order to work on named
3197 pipes, and it's probably just not worth it. So we should at
3198 least signal an error. */
3199 if (!S_ISREG (st
.st_mode
))
3206 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3207 xsignal2 (Qfile_error
,
3208 build_string ("not a regular file"), orig_filename
);
3213 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3216 /* Replacement should preserve point as it preserves markers. */
3217 if (!NILP (replace
))
3218 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3220 record_unwind_protect (close_file_unwind
, make_number (fd
));
3222 /* Can happen on any platform that uses long as type of off_t, but allows
3223 file sizes to exceed 2Gb, so give a suitable message. */
3224 if (! not_regular
&& st
.st_size
< 0)
3225 error ("Maximum buffer size exceeded");
3227 /* Prevent redisplay optimizations. */
3228 current_buffer
->clip_changed
= 1;
3232 if (!NILP (beg
) || !NILP (end
))
3233 error ("Attempt to visit less than an entire file");
3234 if (BEG
< Z
&& NILP (replace
))
3235 error ("Cannot do file visiting in a non-empty buffer");
3241 XSETFASTINT (beg
, 0);
3249 XSETINT (end
, st
.st_size
);
3251 /* Arithmetic overflow can occur if an Emacs integer cannot
3252 represent the file size, or if the calculations below
3253 overflow. The calculations below double the file size
3254 twice, so check that it can be multiplied by 4 safely. */
3255 if (XINT (end
) != st
.st_size
3256 || st
.st_size
> INT_MAX
/ 4)
3257 error ("Maximum buffer size exceeded");
3259 /* The file size returned from stat may be zero, but data
3260 may be readable nonetheless, for example when this is a
3261 file in the /proc filesystem. */
3262 if (st
.st_size
== 0)
3263 XSETINT (end
, READ_BUF_SIZE
);
3267 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3269 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3270 setup_coding_system (coding_system
, &coding
);
3271 /* Ensure we set Vlast_coding_system_used. */
3272 set_coding_system
= 1;
3276 /* Decide the coding system to use for reading the file now
3277 because we can't use an optimized method for handling
3278 `coding:' tag if the current buffer is not empty. */
3279 if (!NILP (Vcoding_system_for_read
))
3280 coding_system
= Vcoding_system_for_read
;
3283 /* Don't try looking inside a file for a coding system
3284 specification if it is not seekable. */
3285 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3287 /* Find a coding system specified in the heading two
3288 lines or in the tailing several lines of the file.
3289 We assume that the 1K-byte and 3K-byte for heading
3290 and tailing respectively are sufficient for this
3294 if (st
.st_size
<= (1024 * 4))
3295 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3298 nread
= emacs_read (fd
, read_buf
, 1024);
3301 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3302 report_file_error ("Setting file position",
3303 Fcons (orig_filename
, Qnil
));
3304 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3309 error ("IO error reading %s: %s",
3310 SDATA (orig_filename
), emacs_strerror (errno
));
3313 struct buffer
*prev
= current_buffer
;
3317 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3319 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3320 buf
= XBUFFER (buffer
);
3322 delete_all_overlays (buf
);
3323 buf
->directory
= current_buffer
->directory
;
3324 buf
->read_only
= Qnil
;
3325 buf
->filename
= Qnil
;
3326 buf
->undo_list
= Qt
;
3327 eassert (buf
->overlays_before
== NULL
);
3328 eassert (buf
->overlays_after
== NULL
);
3330 set_buffer_internal (buf
);
3332 buf
->enable_multibyte_characters
= Qnil
;
3334 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3335 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3336 coding_system
= call2 (Vset_auto_coding_function
,
3337 filename
, make_number (nread
));
3338 set_buffer_internal (prev
);
3340 /* Discard the unwind protect for recovering the
3344 /* Rewind the file for the actual read done later. */
3345 if (lseek (fd
, 0, 0) < 0)
3346 report_file_error ("Setting file position",
3347 Fcons (orig_filename
, Qnil
));
3351 if (NILP (coding_system
))
3353 /* If we have not yet decided a coding system, check
3354 file-coding-system-alist. */
3355 Lisp_Object args
[6];
3357 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3358 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3359 coding_system
= Ffind_operation_coding_system (6, args
);
3360 if (CONSP (coding_system
))
3361 coding_system
= XCAR (coding_system
);
3365 if (NILP (coding_system
))
3366 coding_system
= Qundecided
;
3368 CHECK_CODING_SYSTEM (coding_system
);
3370 if (NILP (current_buffer
->enable_multibyte_characters
))
3371 /* We must suppress all character code conversion except for
3372 end-of-line conversion. */
3373 coding_system
= raw_text_coding_system (coding_system
);
3375 setup_coding_system (coding_system
, &coding
);
3376 /* Ensure we set Vlast_coding_system_used. */
3377 set_coding_system
= 1;
3380 /* If requested, replace the accessible part of the buffer
3381 with the file contents. Avoid replacing text at the
3382 beginning or end of the buffer that matches the file contents;
3383 that preserves markers pointing to the unchanged parts.
3385 Here we implement this feature in an optimized way
3386 for the case where code conversion is NOT needed.
3387 The following if-statement handles the case of conversion
3388 in a less optimal way.
3390 If the code conversion is "automatic" then we try using this
3391 method and hope for the best.
3392 But if we discover the need for conversion, we give up on this method
3393 and let the following if-statement handle the replace job. */
3396 && (NILP (coding_system
)
3397 || ! CODING_REQUIRE_DECODING (&coding
)))
3399 /* same_at_start and same_at_end count bytes,
3400 because file access counts bytes
3401 and BEG and END count bytes. */
3402 int same_at_start
= BEGV_BYTE
;
3403 int same_at_end
= ZV_BYTE
;
3405 /* There is still a possibility we will find the need to do code
3406 conversion. If that happens, we set this variable to 1 to
3407 give up on handling REPLACE in the optimized way. */
3408 int giveup_match_end
= 0;
3410 if (XINT (beg
) != 0)
3412 if (lseek (fd
, XINT (beg
), 0) < 0)
3413 report_file_error ("Setting file position",
3414 Fcons (orig_filename
, Qnil
));
3419 /* Count how many chars at the start of the file
3420 match the text at the beginning of the buffer. */
3425 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3427 error ("IO error reading %s: %s",
3428 SDATA (orig_filename
), emacs_strerror (errno
));
3429 else if (nread
== 0)
3432 if (CODING_REQUIRE_DETECTION (&coding
))
3434 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
3436 setup_coding_system (coding_system
, &coding
);
3439 if (CODING_REQUIRE_DECODING (&coding
))
3440 /* We found that the file should be decoded somehow.
3441 Let's give up here. */
3443 giveup_match_end
= 1;
3448 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3449 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3450 same_at_start
++, bufpos
++;
3451 /* If we found a discrepancy, stop the scan.
3452 Otherwise loop around and scan the next bufferful. */
3453 if (bufpos
!= nread
)
3457 /* If the file matches the buffer completely,
3458 there's no need to replace anything. */
3459 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3463 /* Truncate the buffer to the size of the file. */
3464 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3469 /* Count how many chars at the end of the file
3470 match the text at the end of the buffer. But, if we have
3471 already found that decoding is necessary, don't waste time. */
3472 while (!giveup_match_end
)
3474 int total_read
, nread
, bufpos
, curpos
, trial
;
3476 /* At what file position are we now scanning? */
3477 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3478 /* If the entire file matches the buffer tail, stop the scan. */
3481 /* How much can we scan in the next step? */
3482 trial
= min (curpos
, sizeof buffer
);
3483 if (lseek (fd
, curpos
- trial
, 0) < 0)
3484 report_file_error ("Setting file position",
3485 Fcons (orig_filename
, Qnil
));
3487 total_read
= nread
= 0;
3488 while (total_read
< trial
)
3490 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3492 error ("IO error reading %s: %s",
3493 SDATA (orig_filename
), emacs_strerror (errno
));
3494 else if (nread
== 0)
3496 total_read
+= nread
;
3499 /* Scan this bufferful from the end, comparing with
3500 the Emacs buffer. */
3501 bufpos
= total_read
;
3503 /* Compare with same_at_start to avoid counting some buffer text
3504 as matching both at the file's beginning and at the end. */
3505 while (bufpos
> 0 && same_at_end
> same_at_start
3506 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3507 same_at_end
--, bufpos
--;
3509 /* If we found a discrepancy, stop the scan.
3510 Otherwise loop around and scan the preceding bufferful. */
3513 /* If this discrepancy is because of code conversion,
3514 we cannot use this method; giveup and try the other. */
3515 if (same_at_end
> same_at_start
3516 && FETCH_BYTE (same_at_end
- 1) >= 0200
3517 && ! NILP (current_buffer
->enable_multibyte_characters
)
3518 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3519 giveup_match_end
= 1;
3528 if (! giveup_match_end
)
3532 /* We win! We can handle REPLACE the optimized way. */
3534 /* Extend the start of non-matching text area to multibyte
3535 character boundary. */
3536 if (! NILP (current_buffer
->enable_multibyte_characters
))
3537 while (same_at_start
> BEGV_BYTE
3538 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3541 /* Extend the end of non-matching text area to multibyte
3542 character boundary. */
3543 if (! NILP (current_buffer
->enable_multibyte_characters
))
3544 while (same_at_end
< ZV_BYTE
3545 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3548 /* Don't try to reuse the same piece of text twice. */
3549 overlap
= (same_at_start
- BEGV_BYTE
3550 - (same_at_end
+ st
.st_size
- ZV
));
3552 same_at_end
+= overlap
;
3554 /* Arrange to read only the nonmatching middle part of the file. */
3555 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3556 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3558 del_range_byte (same_at_start
, same_at_end
, 0);
3559 /* Insert from the file at the proper position. */
3560 temp
= BYTE_TO_CHAR (same_at_start
);
3561 SET_PT_BOTH (temp
, same_at_start
);
3563 /* If display currently starts at beginning of line,
3564 keep it that way. */
3565 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3566 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3568 replace_handled
= 1;
3572 /* If requested, replace the accessible part of the buffer
3573 with the file contents. Avoid replacing text at the
3574 beginning or end of the buffer that matches the file contents;
3575 that preserves markers pointing to the unchanged parts.
3577 Here we implement this feature for the case where code conversion
3578 is needed, in a simple way that needs a lot of memory.
3579 The preceding if-statement handles the case of no conversion
3580 in a more optimized way. */
3581 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3583 EMACS_INT same_at_start
= BEGV_BYTE
;
3584 EMACS_INT same_at_end
= ZV_BYTE
;
3585 EMACS_INT same_at_start_charpos
;
3586 EMACS_INT inserted_chars
;
3589 unsigned char *decoded
;
3591 int this_count
= SPECPDL_INDEX ();
3592 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3593 Lisp_Object conversion_buffer
;
3595 conversion_buffer
= code_conversion_save (1, multibyte
);
3597 /* First read the whole file, performing code conversion into
3598 CONVERSION_BUFFER. */
3600 if (lseek (fd
, XINT (beg
), 0) < 0)
3601 report_file_error ("Setting file position",
3602 Fcons (orig_filename
, Qnil
));
3604 total
= st
.st_size
; /* Total bytes in the file. */
3605 how_much
= 0; /* Bytes read from file so far. */
3606 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3607 unprocessed
= 0; /* Bytes not processed in previous loop. */
3609 GCPRO1 (conversion_buffer
);
3610 while (how_much
< total
)
3612 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
3613 quitting while reading a huge while. */
3614 /* try is reserved in some compilers (Microsoft C) */
3615 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3618 /* Allow quitting out of the actual I/O. */
3621 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
3633 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
3634 BUF_Z (XBUFFER (conversion_buffer
)));
3635 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
3637 unprocessed
= coding
.carryover_bytes
;
3638 if (coding
.carryover_bytes
> 0)
3639 bcopy (coding
.carryover
, read_buf
, unprocessed
);
3644 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
3645 if we couldn't read the file. */
3648 error ("IO error reading %s: %s",
3649 SDATA (orig_filename
), emacs_strerror (errno
));
3651 if (unprocessed
> 0)
3653 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3654 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
3656 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
3659 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
3660 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
3661 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3663 /* Compare the beginning of the converted string with the buffer
3667 while (bufpos
< inserted
&& same_at_start
< same_at_end
3668 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
3669 same_at_start
++, bufpos
++;
3671 /* If the file matches the head of buffer completely,
3672 there's no need to replace anything. */
3674 if (bufpos
== inserted
)
3676 /* Truncate the buffer to the size of the file. */
3677 if (same_at_start
== same_at_end
)
3680 del_range_byte (same_at_start
, same_at_end
, 0);
3683 unbind_to (this_count
, Qnil
);
3687 /* Extend the start of non-matching text area to the previous
3688 multibyte character boundary. */
3689 if (! NILP (current_buffer
->enable_multibyte_characters
))
3690 while (same_at_start
> BEGV_BYTE
3691 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3694 /* Scan this bufferful from the end, comparing with
3695 the Emacs buffer. */
3698 /* Compare with same_at_start to avoid counting some buffer text
3699 as matching both at the file's beginning and at the end. */
3700 while (bufpos
> 0 && same_at_end
> same_at_start
3701 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
3702 same_at_end
--, bufpos
--;
3704 /* Extend the end of non-matching text area to the next
3705 multibyte character boundary. */
3706 if (! NILP (current_buffer
->enable_multibyte_characters
))
3707 while (same_at_end
< ZV_BYTE
3708 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3711 /* Don't try to reuse the same piece of text twice. */
3712 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3714 same_at_end
+= overlap
;
3716 /* If display currently starts at beginning of line,
3717 keep it that way. */
3718 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3719 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3721 /* Replace the chars that we need to replace,
3722 and update INSERTED to equal the number of bytes
3723 we are taking from the decoded string. */
3724 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
3726 if (same_at_end
!= same_at_start
)
3728 del_range_byte (same_at_start
, same_at_end
, 0);
3730 same_at_start
= GPT_BYTE
;
3734 temp
= BYTE_TO_CHAR (same_at_start
);
3736 /* Insert from the file at the proper position. */
3737 SET_PT_BOTH (temp
, same_at_start
);
3738 same_at_start_charpos
3739 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3740 same_at_start
- BEGV_BYTE
3741 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3743 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3744 same_at_start
+ inserted
- BEGV_BYTE
3745 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
3746 - same_at_start_charpos
);
3747 /* This binding is to avoid ask-user-about-supersession-threat
3748 being called in insert_from_buffer (via in
3749 prepare_to_modify_buffer). */
3750 specbind (intern ("buffer-file-name"), Qnil
);
3751 insert_from_buffer (XBUFFER (conversion_buffer
),
3752 same_at_start_charpos
, inserted_chars
, 0);
3753 /* Set `inserted' to the number of inserted characters. */
3754 inserted
= PT
- temp
;
3755 /* Set point before the inserted characters. */
3756 SET_PT_BOTH (temp
, same_at_start
);
3758 unbind_to (this_count
, Qnil
);
3765 register Lisp_Object temp
;
3767 total
= XINT (end
) - XINT (beg
);
3769 /* Make sure point-max won't overflow after this insertion. */
3770 XSETINT (temp
, total
);
3771 if (total
!= XINT (temp
))
3772 error ("Maximum buffer size exceeded");
3775 /* For a special file, all we can do is guess. */
3776 total
= READ_BUF_SIZE
;
3778 if (NILP (visit
) && inserted
> 0)
3780 #ifdef CLASH_DETECTION
3781 if (!NILP (current_buffer
->file_truename
)
3782 /* Make binding buffer-file-name to nil effective. */
3783 && !NILP (current_buffer
->filename
)
3784 && SAVE_MODIFF
>= MODIFF
)
3786 #endif /* CLASH_DETECTION */
3787 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
3791 if (GAP_SIZE
< total
)
3792 make_gap (total
- GAP_SIZE
);
3794 if (XINT (beg
) != 0 || !NILP (replace
))
3796 if (lseek (fd
, XINT (beg
), 0) < 0)
3797 report_file_error ("Setting file position",
3798 Fcons (orig_filename
, Qnil
));
3801 /* In the following loop, HOW_MUCH contains the total bytes read so
3802 far for a regular file, and not changed for a special file. But,
3803 before exiting the loop, it is set to a negative value if I/O
3807 /* Total bytes inserted. */
3810 /* Here, we don't do code conversion in the loop. It is done by
3811 decode_coding_gap after all data are read into the buffer. */
3813 int gap_size
= GAP_SIZE
;
3815 while (how_much
< total
)
3817 /* try is reserved in some compilers (Microsoft C) */
3818 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3825 /* Maybe make more room. */
3826 if (gap_size
< trytry
)
3828 make_gap (total
- gap_size
);
3829 gap_size
= GAP_SIZE
;
3832 /* Read from the file, capturing `quit'. When an
3833 error occurs, end the loop, and arrange for a quit
3834 to be signaled after decoding the text we read. */
3835 non_regular_fd
= fd
;
3836 non_regular_inserted
= inserted
;
3837 non_regular_nbytes
= trytry
;
3838 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
3839 read_non_regular_quit
);
3850 /* Allow quitting out of the actual I/O. We don't make text
3851 part of the buffer until all the reading is done, so a C-g
3852 here doesn't do any harm. */
3855 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
3867 /* For a regular file, where TOTAL is the real size,
3868 count HOW_MUCH to compare with it.
3869 For a special file, where TOTAL is just a buffer size,
3870 so don't bother counting in HOW_MUCH.
3871 (INSERTED is where we count the number of characters inserted.) */
3878 /* Now we have read all the file data into the gap.
3879 If it was empty, undo marking the buffer modified. */
3883 #ifdef CLASH_DETECTION
3885 unlock_file (current_buffer
->file_truename
);
3887 Vdeactivate_mark
= old_Vdeactivate_mark
;
3890 Vdeactivate_mark
= Qt
;
3892 /* Make the text read part of the buffer. */
3893 GAP_SIZE
-= inserted
;
3895 GPT_BYTE
+= inserted
;
3897 ZV_BYTE
+= inserted
;
3902 /* Put an anchor to ensure multi-byte form ends at gap. */
3907 /* Discard the unwind protect for closing the file. */
3911 error ("IO error reading %s: %s",
3912 SDATA (orig_filename
), emacs_strerror (errno
));
3916 if (NILP (coding_system
))
3918 /* The coding system is not yet decided. Decide it by an
3919 optimized method for handling `coding:' tag.
3921 Note that we can get here only if the buffer was empty
3922 before the insertion. */
3924 if (!NILP (Vcoding_system_for_read
))
3925 coding_system
= Vcoding_system_for_read
;
3928 /* Since we are sure that the current buffer was empty
3929 before the insertion, we can toggle
3930 enable-multibyte-characters directly here without taking
3931 care of marker adjustment. By this way, we can run Lisp
3932 program safely before decoding the inserted text. */
3933 Lisp_Object unwind_data
;
3934 int count
= SPECPDL_INDEX ();
3936 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
3937 Fcons (current_buffer
->undo_list
,
3938 Fcurrent_buffer ()));
3939 current_buffer
->enable_multibyte_characters
= Qnil
;
3940 current_buffer
->undo_list
= Qt
;
3941 record_unwind_protect (decide_coding_unwind
, unwind_data
);
3943 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
3945 coding_system
= call2 (Vset_auto_coding_function
,
3946 filename
, make_number (inserted
));
3949 if (NILP (coding_system
))
3951 /* If the coding system is not yet decided, check
3952 file-coding-system-alist. */
3953 Lisp_Object args
[6];
3955 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3956 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
3957 coding_system
= Ffind_operation_coding_system (6, args
);
3958 if (CONSP (coding_system
))
3959 coding_system
= XCAR (coding_system
);
3961 unbind_to (count
, Qnil
);
3962 inserted
= Z_BYTE
- BEG_BYTE
;
3965 if (NILP (coding_system
))
3966 coding_system
= Qundecided
;
3968 CHECK_CODING_SYSTEM (coding_system
);
3970 if (NILP (current_buffer
->enable_multibyte_characters
))
3971 /* We must suppress all character code conversion except for
3972 end-of-line conversion. */
3973 coding_system
= raw_text_coding_system (coding_system
);
3974 setup_coding_system (coding_system
, &coding
);
3975 /* Ensure we set Vlast_coding_system_used. */
3976 set_coding_system
= 1;
3981 /* When we visit a file by raw-text, we change the buffer to
3983 if (CODING_FOR_UNIBYTE (&coding
)
3984 /* Can't do this if part of the buffer might be preserved. */
3986 /* Visiting a file with these coding system makes the buffer
3988 current_buffer
->enable_multibyte_characters
= Qnil
;
3991 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3992 if (CODING_MAY_REQUIRE_DECODING (&coding
)
3993 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
3995 move_gap_both (PT
, PT_BYTE
);
3996 GAP_SIZE
+= inserted
;
3997 ZV_BYTE
-= inserted
;
4001 decode_coding_gap (&coding
, inserted
, inserted
);
4002 inserted
= coding
.produced_char
;
4003 coding_system
= CODING_ID_NAME (coding
.id
);
4005 else if (inserted
> 0)
4006 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4009 /* Now INSERTED is measured in characters. */
4012 /* Use the conversion type to determine buffer-file-type
4013 (find-buffer-file-type is now used to help determine the
4015 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4016 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4017 && ! CODING_REQUIRE_DECODING (&coding
))
4018 current_buffer
->buffer_file_type
= Qt
;
4020 current_buffer
->buffer_file_type
= Qnil
;
4027 if (!EQ (current_buffer
->undo_list
, Qt
) && !nochange
)
4028 current_buffer
->undo_list
= Qnil
;
4032 current_buffer
->modtime
= st
.st_mtime
;
4033 current_buffer
->filename
= orig_filename
;
4036 SAVE_MODIFF
= MODIFF
;
4037 current_buffer
->auto_save_modified
= MODIFF
;
4038 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4039 #ifdef CLASH_DETECTION
4042 if (!NILP (current_buffer
->file_truename
))
4043 unlock_file (current_buffer
->file_truename
);
4044 unlock_file (filename
);
4046 #endif /* CLASH_DETECTION */
4048 xsignal2 (Qfile_error
,
4049 build_string ("not a regular file"), orig_filename
);
4052 if (set_coding_system
)
4053 Vlast_coding_system_used
= coding_system
;
4055 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4057 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4059 if (! NILP (insval
))
4061 CHECK_NUMBER (insval
);
4062 inserted
= XFASTINT (insval
);
4066 /* Decode file format. */
4069 /* Don't run point motion or modification hooks when decoding. */
4070 int count
= SPECPDL_INDEX ();
4071 int old_inserted
= inserted
;
4072 specbind (Qinhibit_point_motion_hooks
, Qt
);
4073 specbind (Qinhibit_modification_hooks
, Qt
);
4075 /* Save old undo list and don't record undo for decoding. */
4076 old_undo
= current_buffer
->undo_list
;
4077 current_buffer
->undo_list
= Qt
;
4081 insval
= call3 (Qformat_decode
,
4082 Qnil
, make_number (inserted
), visit
);
4083 CHECK_NUMBER (insval
);
4084 inserted
= XFASTINT (insval
);
4088 /* If REPLACE is non-nil and we succeeded in not replacing the
4089 beginning or end of the buffer text with the file's contents,
4090 call format-decode with `point' positioned at the beginning
4091 of the buffer and `inserted' equalling the number of
4092 characters in the buffer. Otherwise, format-decode might
4093 fail to correctly analyze the beginning or end of the buffer.
4094 Hence we temporarily save `point' and `inserted' here and
4095 restore `point' iff format-decode did not insert or delete
4096 any text. Otherwise we leave `point' at point-min. */
4098 int opoint_byte
= PT_BYTE
;
4099 int oinserted
= ZV
- BEGV
;
4100 int ochars_modiff
= CHARS_MODIFF
;
4102 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4103 insval
= call3 (Qformat_decode
,
4104 Qnil
, make_number (oinserted
), visit
);
4105 CHECK_NUMBER (insval
);
4106 if (ochars_modiff
== CHARS_MODIFF
)
4107 /* format_decode didn't modify buffer's characters => move
4108 point back to position before inserted text and leave
4109 value of inserted alone. */
4110 SET_PT_BOTH (opoint
, opoint_byte
);
4112 /* format_decode modified buffer's characters => consider
4113 entire buffer changed and leave point at point-min. */
4114 inserted
= XFASTINT (insval
);
4117 /* For consistency with format-decode call these now iff inserted > 0
4118 (martin 2007-06-28). */
4119 p
= Vafter_insert_file_functions
;
4124 insval
= call1 (XCAR (p
), make_number (inserted
));
4127 CHECK_NUMBER (insval
);
4128 inserted
= XFASTINT (insval
);
4133 /* For the rationale of this see the comment on
4134 format-decode above. */
4136 int opoint_byte
= PT_BYTE
;
4137 int oinserted
= ZV
- BEGV
;
4138 int ochars_modiff
= CHARS_MODIFF
;
4140 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4141 insval
= call1 (XCAR (p
), make_number (oinserted
));
4144 CHECK_NUMBER (insval
);
4145 if (ochars_modiff
== CHARS_MODIFF
)
4146 /* after_insert_file_functions didn't modify
4147 buffer's characters => move point back to
4148 position before inserted text and leave value of
4150 SET_PT_BOTH (opoint
, opoint_byte
);
4152 /* after_insert_file_functions did modify buffer's
4153 characters => consider entire buffer changed and
4154 leave point at point-min. */
4155 inserted
= XFASTINT (insval
);
4165 current_buffer
->undo_list
= old_undo
;
4166 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4168 /* Adjust the last undo record for the size change during
4169 the format conversion. */
4170 Lisp_Object tem
= XCAR (old_undo
);
4171 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4172 && INTEGERP (XCDR (tem
))
4173 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4174 XSETCDR (tem
, make_number (PT
+ inserted
));
4178 /* If undo_list was Qt before, keep it that way.
4179 Otherwise start with an empty undo_list. */
4180 current_buffer
->undo_list
= EQ (old_undo
, Qt
) ? Qt
: Qnil
;
4182 unbind_to (count
, Qnil
);
4185 /* Call after-change hooks for the inserted text, aside from the case
4186 of normal visiting (not with REPLACE), which is done in a new buffer
4187 "before" the buffer is changed. */
4188 if (inserted
> 0 && total
> 0
4189 && (NILP (visit
) || !NILP (replace
)))
4191 signal_after_change (PT
, 0, inserted
);
4192 update_compositions (PT
, PT
, CHECK_BORDER
);
4196 && current_buffer
->modtime
== -1)
4198 /* If visiting nonexistent file, return nil. */
4199 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4203 Fsignal (Qquit
, Qnil
);
4205 /* ??? Retval needs to be dealt with in all cases consistently. */
4207 val
= Fcons (orig_filename
,
4208 Fcons (make_number (inserted
),
4211 RETURN_UNGCPRO (unbind_to (count
, val
));
4214 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4216 /* If build_annotations switched buffers, switch back to BUF.
4217 Kill the temporary buffer that was selected in the meantime.
4219 Since this kill only the last temporary buffer, some buffers remain
4220 not killed if build_annotations switched buffers more than once.
4224 build_annotations_unwind (buf
)
4229 if (XBUFFER (buf
) == current_buffer
)
4231 tembuf
= Fcurrent_buffer ();
4233 Fkill_buffer (tembuf
);
4237 /* Decide the coding-system to encode the data with. */
4240 choose_write_coding_system (start
, end
, filename
,
4241 append
, visit
, lockname
, coding
)
4242 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4243 struct coding_system
*coding
;
4246 Lisp_Object eol_parent
= Qnil
;
4249 && NILP (Fstring_equal (current_buffer
->filename
,
4250 current_buffer
->auto_save_file_name
)))
4255 else if (!NILP (Vcoding_system_for_write
))
4257 val
= Vcoding_system_for_write
;
4258 if (coding_system_require_warning
4259 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4260 /* Confirm that VAL can surely encode the current region. */
4261 val
= call5 (Vselect_safe_coding_system_function
,
4262 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4267 /* If the variable `buffer-file-coding-system' is set locally,
4268 it means that the file was read with some kind of code
4269 conversion or the variable is explicitly set by users. We
4270 had better write it out with the same coding system even if
4271 `enable-multibyte-characters' is nil.
4273 If it is not set locally, we anyway have to convert EOL
4274 format if the default value of `buffer-file-coding-system'
4275 tells that it is not Unix-like (LF only) format. */
4276 int using_default_coding
= 0;
4277 int force_raw_text
= 0;
4279 val
= current_buffer
->buffer_file_coding_system
;
4281 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4284 if (NILP (current_buffer
->enable_multibyte_characters
))
4290 /* Check file-coding-system-alist. */
4291 Lisp_Object args
[7], coding_systems
;
4293 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4294 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4296 coding_systems
= Ffind_operation_coding_system (7, args
);
4297 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4298 val
= XCDR (coding_systems
);
4303 /* If we still have not decided a coding system, use the
4304 default value of buffer-file-coding-system. */
4305 val
= current_buffer
->buffer_file_coding_system
;
4306 using_default_coding
= 1;
4309 if (! NILP (val
) && ! force_raw_text
)
4311 Lisp_Object spec
, attrs
;
4313 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4314 attrs
= AREF (spec
, 0);
4315 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4320 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4321 /* Confirm that VAL can surely encode the current region. */
4322 val
= call5 (Vselect_safe_coding_system_function
,
4323 start
, end
, val
, Qnil
, filename
);
4325 /* If the decided coding-system doesn't specify end-of-line
4326 format, we use that of
4327 `default-buffer-file-coding-system'. */
4328 if (! using_default_coding
4329 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4330 val
= (coding_inherit_eol_type
4331 (val
, buffer_defaults
.buffer_file_coding_system
));
4333 /* If we decide not to encode text, use `raw-text' or one of its
4336 val
= raw_text_coding_system (val
);
4339 val
= coding_inherit_eol_type (val
, eol_parent
);
4340 setup_coding_system (val
, coding
);
4342 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4343 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4347 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4348 "r\nFWrite region to file: \ni\ni\ni\np",
4349 doc
: /* Write current region into specified file.
4350 When called from a program, requires three arguments:
4351 START, END and FILENAME. START and END are normally buffer positions
4352 specifying the part of the buffer to write.
4353 If START is nil, that means to use the entire buffer contents.
4354 If START is a string, then output that string to the file
4355 instead of any buffer contents; END is ignored.
4357 Optional fourth argument APPEND if non-nil means
4358 append to existing file contents (if any). If it is an integer,
4359 seek to that offset in the file before writing.
4360 Optional fifth argument VISIT, if t or a string, means
4361 set the last-save-file-modtime of buffer to this file's modtime
4362 and mark buffer not modified.
4363 If VISIT is a string, it is a second file name;
4364 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4365 VISIT is also the file name to lock and unlock for clash detection.
4366 If VISIT is neither t nor nil nor a string,
4367 that means do not display the \"Wrote file\" message.
4368 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4369 use for locking and unlocking, overriding FILENAME and VISIT.
4370 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4371 for an existing file with the same name. If MUSTBENEW is `excl',
4372 that means to get an error if the file already exists; never overwrite.
4373 If MUSTBENEW is neither nil nor `excl', that means ask for
4374 confirmation before overwriting, but do go ahead and overwrite the file
4375 if the user confirms.
4377 This does code conversion according to the value of
4378 `coding-system-for-write', `buffer-file-coding-system', or
4379 `file-coding-system-alist', and sets the variable
4380 `last-coding-system-used' to the coding system actually used. */)
4381 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4382 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4387 const unsigned char *fn
;
4389 int count
= SPECPDL_INDEX ();
4391 Lisp_Object handler
;
4392 Lisp_Object visit_file
;
4393 Lisp_Object annotations
;
4394 Lisp_Object encoded_filename
;
4395 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4396 int quietly
= !NILP (visit
);
4397 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4398 struct buffer
*given_buffer
;
4400 int buffer_file_type
= O_BINARY
;
4402 struct coding_system coding
;
4404 if (current_buffer
->base_buffer
&& visiting
)
4405 error ("Cannot do file visiting in an indirect buffer");
4407 if (!NILP (start
) && !STRINGP (start
))
4408 validate_region (&start
, &end
);
4411 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4413 filename
= Fexpand_file_name (filename
, Qnil
);
4415 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4416 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4418 if (STRINGP (visit
))
4419 visit_file
= Fexpand_file_name (visit
, Qnil
);
4421 visit_file
= filename
;
4423 if (NILP (lockname
))
4424 lockname
= visit_file
;
4428 /* If the file name has special constructs in it,
4429 call the corresponding file handler. */
4430 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4431 /* If FILENAME has no handler, see if VISIT has one. */
4432 if (NILP (handler
) && STRINGP (visit
))
4433 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4435 if (!NILP (handler
))
4438 val
= call6 (handler
, Qwrite_region
, start
, end
,
4439 filename
, append
, visit
);
4443 SAVE_MODIFF
= MODIFF
;
4444 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4445 current_buffer
->filename
= visit_file
;
4451 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4453 /* Special kludge to simplify auto-saving. */
4456 /* Do it later, so write-region-annotate-function can work differently
4457 if we save "the buffer" vs "a region".
4458 This is useful in tar-mode. --Stef
4459 XSETFASTINT (start, BEG);
4460 XSETFASTINT (end, Z); */
4464 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4465 count1
= SPECPDL_INDEX ();
4467 given_buffer
= current_buffer
;
4469 if (!STRINGP (start
))
4471 annotations
= build_annotations (start
, end
);
4473 if (current_buffer
!= given_buffer
)
4475 XSETFASTINT (start
, BEGV
);
4476 XSETFASTINT (end
, ZV
);
4482 XSETFASTINT (start
, BEGV
);
4483 XSETFASTINT (end
, ZV
);
4488 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4490 /* Decide the coding-system to encode the data with.
4491 We used to make this choice before calling build_annotations, but that
4492 leads to problems when a write-annotate-function takes care of
4493 unsavable chars (as was the case with X-Symbol). */
4494 Vlast_coding_system_used
4495 = choose_write_coding_system (start
, end
, filename
,
4496 append
, visit
, lockname
, &coding
);
4498 #ifdef CLASH_DETECTION
4501 #if 0 /* This causes trouble for GNUS. */
4502 /* If we've locked this file for some other buffer,
4503 query before proceeding. */
4504 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4505 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4508 lock_file (lockname
);
4510 #endif /* CLASH_DETECTION */
4512 encoded_filename
= ENCODE_FILE (filename
);
4514 fn
= SDATA (encoded_filename
);
4518 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4519 #else /* not DOS_NT */
4520 desc
= emacs_open (fn
, O_WRONLY
, 0);
4521 #endif /* not DOS_NT */
4523 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4525 desc
= emacs_open (fn
,
4526 O_WRONLY
| O_CREAT
| buffer_file_type
4527 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4528 S_IREAD
| S_IWRITE
);
4529 #else /* not DOS_NT */
4530 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4531 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4532 auto_saving
? auto_save_mode_bits
: 0666);
4533 #endif /* not DOS_NT */
4537 #ifdef CLASH_DETECTION
4539 if (!auto_saving
) unlock_file (lockname
);
4541 #endif /* CLASH_DETECTION */
4543 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4546 record_unwind_protect (close_file_unwind
, make_number (desc
));
4548 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4552 if (NUMBERP (append
))
4553 ret
= lseek (desc
, XINT (append
), 1);
4555 ret
= lseek (desc
, 0, 2);
4558 #ifdef CLASH_DETECTION
4559 if (!auto_saving
) unlock_file (lockname
);
4560 #endif /* CLASH_DETECTION */
4562 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4569 /* The new encoding routine doesn't require the following. */
4571 /* Whether VMS or not, we must move the gap to the next of newline
4572 when we must put designation sequences at beginning of line. */
4573 if (INTEGERP (start
)
4574 && coding
.type
== coding_type_iso2022
4575 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4576 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4578 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4579 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4580 move_gap_both (PT
, PT_BYTE
);
4581 SET_PT_BOTH (opoint
, opoint_byte
);
4588 if (STRINGP (start
))
4590 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
4591 &annotations
, &coding
);
4594 else if (XINT (start
) != XINT (end
))
4596 failure
= 0 > a_write (desc
, Qnil
,
4597 XINT (start
), XINT (end
) - XINT (start
),
4598 &annotations
, &coding
);
4603 /* If file was empty, still need to write the annotations */
4604 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4605 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4609 if (CODING_REQUIRE_FLUSHING (&coding
)
4610 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4613 /* We have to flush out a data. */
4614 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4615 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
4622 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4623 Disk full in NFS may be reported here. */
4624 /* mib says that closing the file will try to write as fast as NFS can do
4625 it, and that means the fsync here is not crucial for autosave files. */
4626 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
4628 /* If fsync fails with EINTR, don't treat that as serious. Also
4629 ignore EINVAL which happens when fsync is not supported on this
4631 if (errno
!= EINTR
&& errno
!= EINVAL
)
4632 failure
= 1, save_errno
= errno
;
4636 /* Spurious "file has changed on disk" warnings have been
4637 observed on Suns as well.
4638 It seems that `close' can change the modtime, under nfs.
4640 (This has supposedly been fixed in Sunos 4,
4641 but who knows about all the other machines with NFS?) */
4648 /* NFS can report a write failure now. */
4649 if (emacs_close (desc
) < 0)
4650 failure
= 1, save_errno
= errno
;
4655 /* Discard the unwind protect for close_file_unwind. */
4656 specpdl_ptr
= specpdl
+ count1
;
4657 /* Restore the original current buffer. */
4658 visit_file
= unbind_to (count
, visit_file
);
4660 #ifdef CLASH_DETECTION
4662 unlock_file (lockname
);
4663 #endif /* CLASH_DETECTION */
4665 /* Do this before reporting IO error
4666 to avoid a "file has changed on disk" warning on
4667 next attempt to save. */
4669 current_buffer
->modtime
= st
.st_mtime
;
4672 error ("IO error writing %s: %s", SDATA (filename
),
4673 emacs_strerror (save_errno
));
4677 SAVE_MODIFF
= MODIFF
;
4678 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4679 current_buffer
->filename
= visit_file
;
4680 update_mode_lines
++;
4685 && ! NILP (Fstring_equal (current_buffer
->filename
,
4686 current_buffer
->auto_save_file_name
)))
4687 SAVE_MODIFF
= MODIFF
;
4693 message_with_string ((INTEGERP (append
)
4703 Lisp_Object
merge ();
4705 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4706 doc
: /* Return t if (car A) is numerically less than (car B). */)
4710 return Flss (Fcar (a
), Fcar (b
));
4713 /* Build the complete list of annotations appropriate for writing out
4714 the text between START and END, by calling all the functions in
4715 write-region-annotate-functions and merging the lists they return.
4716 If one of these functions switches to a different buffer, we assume
4717 that buffer contains altered text. Therefore, the caller must
4718 make sure to restore the current buffer in all cases,
4719 as save-excursion would do. */
4722 build_annotations (start
, end
)
4723 Lisp_Object start
, end
;
4725 Lisp_Object annotations
;
4727 struct gcpro gcpro1
, gcpro2
;
4728 Lisp_Object original_buffer
;
4729 int i
, used_global
= 0;
4731 XSETBUFFER (original_buffer
, current_buffer
);
4734 p
= Vwrite_region_annotate_functions
;
4735 GCPRO2 (annotations
, p
);
4738 struct buffer
*given_buffer
= current_buffer
;
4739 if (EQ (Qt
, XCAR (p
)) && !used_global
)
4740 { /* Use the global value of the hook. */
4743 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
4745 p
= Fappend (2, arg
);
4748 Vwrite_region_annotations_so_far
= annotations
;
4749 res
= call2 (XCAR (p
), start
, end
);
4750 /* If the function makes a different buffer current,
4751 assume that means this buffer contains altered text to be output.
4752 Reset START and END from the buffer bounds
4753 and discard all previous annotations because they should have
4754 been dealt with by this function. */
4755 if (current_buffer
!= given_buffer
)
4757 XSETFASTINT (start
, BEGV
);
4758 XSETFASTINT (end
, ZV
);
4761 Flength (res
); /* Check basic validity of return value */
4762 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4766 /* Now do the same for annotation functions implied by the file-format */
4767 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
4768 p
= current_buffer
->auto_save_file_format
;
4770 p
= current_buffer
->file_format
;
4771 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
4773 struct buffer
*given_buffer
= current_buffer
;
4775 Vwrite_region_annotations_so_far
= annotations
;
4777 /* Value is either a list of annotations or nil if the function
4778 has written annotations to a temporary buffer, which is now
4780 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
4781 original_buffer
, make_number (i
));
4782 if (current_buffer
!= given_buffer
)
4784 XSETFASTINT (start
, BEGV
);
4785 XSETFASTINT (end
, ZV
);
4790 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4798 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
4799 If STRING is nil, POS is the character position in the current buffer.
4800 Intersperse with them the annotations from *ANNOT
4801 which fall within the range of POS to POS + NCHARS,
4802 each at its appropriate position.
4804 We modify *ANNOT by discarding elements as we use them up.
4806 The return value is negative in case of system call failure. */
4809 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
4812 register int nchars
;
4815 struct coding_system
*coding
;
4819 int lastpos
= pos
+ nchars
;
4821 while (NILP (*annot
) || CONSP (*annot
))
4823 tem
= Fcar_safe (Fcar (*annot
));
4826 nextpos
= XFASTINT (tem
);
4828 /* If there are no more annotations in this range,
4829 output the rest of the range all at once. */
4830 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
4831 return e_write (desc
, string
, pos
, lastpos
, coding
);
4833 /* Output buffer text up to the next annotation's position. */
4836 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
4840 /* Output the annotation. */
4841 tem
= Fcdr (Fcar (*annot
));
4844 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
4847 *annot
= Fcdr (*annot
);
4853 /* Write text in the range START and END into descriptor DESC,
4854 encoding them with coding system CODING. If STRING is nil, START
4855 and END are character positions of the current buffer, else they
4856 are indexes to the string STRING. */
4859 e_write (desc
, string
, start
, end
, coding
)
4863 struct coding_system
*coding
;
4865 if (STRINGP (string
))
4868 end
= SCHARS (string
);
4871 /* We used to have a code for handling selective display here. But,
4872 now it is handled within encode_coding. */
4876 if (STRINGP (string
))
4878 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
4879 if (CODING_REQUIRE_ENCODING (coding
))
4881 encode_coding_object (coding
, string
,
4882 start
, string_char_to_byte (string
, start
),
4883 end
, string_char_to_byte (string
, end
), Qt
);
4887 coding
->dst_object
= string
;
4888 coding
->consumed_char
= SCHARS (string
);
4889 coding
->produced
= SBYTES (string
);
4894 int start_byte
= CHAR_TO_BYTE (start
);
4895 int end_byte
= CHAR_TO_BYTE (end
);
4897 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
4898 if (CODING_REQUIRE_ENCODING (coding
))
4900 encode_coding_object (coding
, Fcurrent_buffer (),
4901 start
, start_byte
, end
, end_byte
, Qt
);
4905 coding
->dst_object
= Qnil
;
4906 coding
->dst_pos_byte
= start_byte
;
4907 if (start
>= GPT
|| end
<= GPT
)
4909 coding
->consumed_char
= end
- start
;
4910 coding
->produced
= end_byte
- start_byte
;
4914 coding
->consumed_char
= GPT
- start
;
4915 coding
->produced
= GPT_BYTE
- start_byte
;
4920 if (coding
->produced
> 0)
4924 STRINGP (coding
->dst_object
)
4925 ? SDATA (coding
->dst_object
)
4926 : BYTE_POS_ADDR (coding
->dst_pos_byte
),
4929 if (coding
->produced
)
4932 start
+= coding
->consumed_char
;
4938 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4939 Sverify_visited_file_modtime
, 1, 1, 0,
4940 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
4941 This means that the file has not been changed since it was visited or saved.
4942 See Info node `(elisp)Modification Time' for more details. */)
4948 Lisp_Object handler
;
4949 Lisp_Object filename
;
4954 if (!STRINGP (b
->filename
)) return Qt
;
4955 if (b
->modtime
== 0) return Qt
;
4957 /* If the file name has special constructs in it,
4958 call the corresponding file handler. */
4959 handler
= Ffind_file_name_handler (b
->filename
,
4960 Qverify_visited_file_modtime
);
4961 if (!NILP (handler
))
4962 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4964 filename
= ENCODE_FILE (b
->filename
);
4966 if (stat (SDATA (filename
), &st
) < 0)
4968 /* If the file doesn't exist now and didn't exist before,
4969 we say that it isn't modified, provided the error is a tame one. */
4970 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4975 if (st
.st_mtime
== b
->modtime
4976 /* If both are positive, accept them if they are off by one second. */
4977 || (st
.st_mtime
> 0 && b
->modtime
> 0
4978 && (st
.st_mtime
== b
->modtime
+ 1
4979 || st
.st_mtime
== b
->modtime
- 1)))
4984 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4985 Sclear_visited_file_modtime
, 0, 0, 0,
4986 doc
: /* Clear out records of last mod time of visited file.
4987 Next attempt to save will certainly not complain of a discrepancy. */)
4990 current_buffer
->modtime
= 0;
4994 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4995 Svisited_file_modtime
, 0, 0, 0,
4996 doc
: /* Return the current buffer's recorded visited file modification time.
4997 The value is a list of the form (HIGH LOW), like the time values
4998 that `file-attributes' returns. If the current buffer has no recorded
4999 file modification time, this function returns 0.
5000 See Info node `(elisp)Modification Time' for more details. */)
5003 if (! current_buffer
->modtime
)
5004 return make_number (0);
5005 return make_time ((time_t) current_buffer
->modtime
);
5008 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5009 Sset_visited_file_modtime
, 0, 1, 0,
5010 doc
: /* Update buffer's recorded modification time from the visited file's time.
5011 Useful if the buffer was not read from the file normally
5012 or if the file itself has been changed for some known benign reason.
5013 An argument specifies the modification time value to use
5014 \(instead of that of the visited file), in the form of a list
5015 \(HIGH . LOW) or (HIGH LOW). */)
5017 Lisp_Object time_list
;
5019 if (!NILP (time_list
))
5020 current_buffer
->modtime
= cons_to_long (time_list
);
5023 register Lisp_Object filename
;
5025 Lisp_Object handler
;
5027 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5029 /* If the file name has special constructs in it,
5030 call the corresponding file handler. */
5031 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5032 if (!NILP (handler
))
5033 /* The handler can find the file name the same way we did. */
5034 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5036 filename
= ENCODE_FILE (filename
);
5038 if (stat (SDATA (filename
), &st
) >= 0)
5039 current_buffer
->modtime
= st
.st_mtime
;
5046 auto_save_error (error
)
5049 Lisp_Object args
[3], msg
;
5051 struct gcpro gcpro1
;
5055 auto_save_error_occurred
= 1;
5057 ring_bell (XFRAME (selected_frame
));
5059 args
[0] = build_string ("Auto-saving %s: %s");
5060 args
[1] = current_buffer
->name
;
5061 args
[2] = Ferror_message_string (error
);
5062 msg
= Fformat (3, args
);
5064 nbytes
= SBYTES (msg
);
5065 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5066 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5068 for (i
= 0; i
< 3; ++i
)
5071 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5073 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5074 Fsleep_for (make_number (1), Qnil
);
5088 auto_save_mode_bits
= 0666;
5090 /* Get visited file's mode to become the auto save file's mode. */
5091 if (! NILP (current_buffer
->filename
))
5093 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5094 /* But make sure we can overwrite it later! */
5095 auto_save_mode_bits
= st
.st_mode
| 0600;
5096 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5098 /* Remote files don't cooperate with stat. */
5099 auto_save_mode_bits
= XINT (modes
) | 0600;
5103 Fwrite_region (Qnil
, Qnil
, current_buffer
->auto_save_file_name
, Qnil
,
5104 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5109 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5112 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5124 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5127 minibuffer_auto_raise
= XINT (value
);
5132 do_auto_save_make_dir (dir
)
5137 call2 (Qmake_directory
, dir
, Qt
);
5138 XSETFASTINT (mode
, 0700);
5139 return Fset_file_modes (dir
, mode
);
5143 do_auto_save_eh (ignore
)
5149 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5150 doc
: /* Auto-save all buffers that need it.
5151 This is all buffers that have auto-saving enabled
5152 and are changed since last auto-saved.
5153 Auto-saving writes the buffer into a file
5154 so that your editing is not lost if the system crashes.
5155 This file is not the file you visited; that changes only when you save.
5156 Normally we run the normal hook `auto-save-hook' before saving.
5158 A non-nil NO-MESSAGE argument means do not print any message if successful.
5159 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5160 (no_message
, current_only
)
5161 Lisp_Object no_message
, current_only
;
5163 struct buffer
*old
= current_buffer
, *b
;
5164 Lisp_Object tail
, buf
;
5166 int do_handled_files
;
5168 FILE *stream
= NULL
;
5169 int count
= SPECPDL_INDEX ();
5170 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5171 int old_message_p
= 0;
5172 struct gcpro gcpro1
, gcpro2
;
5174 if (max_specpdl_size
< specpdl_size
+ 40)
5175 max_specpdl_size
= specpdl_size
+ 40;
5180 if (NILP (no_message
))
5182 old_message_p
= push_message ();
5183 record_unwind_protect (pop_message_unwind
, Qnil
);
5186 /* Ordinarily don't quit within this function,
5187 but don't make it impossible to quit (in case we get hung in I/O). */
5191 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5192 point to non-strings reached from Vbuffer_alist. */
5194 if (!NILP (Vrun_hooks
))
5195 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5197 if (STRINGP (Vauto_save_list_file_name
))
5199 Lisp_Object listfile
;
5201 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5203 /* Don't try to create the directory when shutting down Emacs,
5204 because creating the directory might signal an error, and
5205 that would leave Emacs in a strange state. */
5206 if (!NILP (Vrun_hooks
))
5210 GCPRO2 (dir
, listfile
);
5211 dir
= Ffile_name_directory (listfile
);
5212 if (NILP (Ffile_directory_p (dir
)))
5213 internal_condition_case_1 (do_auto_save_make_dir
,
5214 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5219 stream
= fopen (SDATA (listfile
), "w");
5222 record_unwind_protect (do_auto_save_unwind
,
5223 make_save_value (stream
, 0));
5224 record_unwind_protect (do_auto_save_unwind_1
,
5225 make_number (minibuffer_auto_raise
));
5226 minibuffer_auto_raise
= 0;
5228 auto_save_error_occurred
= 0;
5230 /* On first pass, save all files that don't have handlers.
5231 On second pass, save all files that do have handlers.
5233 If Emacs is crashing, the handlers may tweak what is causing
5234 Emacs to crash in the first place, and it would be a shame if
5235 Emacs failed to autosave perfectly ordinary files because it
5236 couldn't handle some ange-ftp'd file. */
5238 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5239 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5241 buf
= XCDR (XCAR (tail
));
5244 /* Record all the buffers that have auto save mode
5245 in the special file that lists them. For each of these buffers,
5246 Record visited name (if any) and auto save name. */
5247 if (STRINGP (b
->auto_save_file_name
)
5248 && stream
!= NULL
&& do_handled_files
== 0)
5251 if (!NILP (b
->filename
))
5253 fwrite (SDATA (b
->filename
), 1,
5254 SBYTES (b
->filename
), stream
);
5256 putc ('\n', stream
);
5257 fwrite (SDATA (b
->auto_save_file_name
), 1,
5258 SBYTES (b
->auto_save_file_name
), stream
);
5259 putc ('\n', stream
);
5263 if (!NILP (current_only
)
5264 && b
!= current_buffer
)
5267 /* Don't auto-save indirect buffers.
5268 The base buffer takes care of it. */
5272 /* Check for auto save enabled
5273 and file changed since last auto save
5274 and file changed since last real save. */
5275 if (STRINGP (b
->auto_save_file_name
)
5276 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5277 && b
->auto_save_modified
< BUF_MODIFF (b
)
5278 /* -1 means we've turned off autosaving for a while--see below. */
5279 && XINT (b
->save_length
) >= 0
5280 && (do_handled_files
5281 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5284 EMACS_TIME before_time
, after_time
;
5286 EMACS_GET_TIME (before_time
);
5288 /* If we had a failure, don't try again for 20 minutes. */
5289 if (b
->auto_save_failure_time
>= 0
5290 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5293 if ((XFASTINT (b
->save_length
) * 10
5294 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5295 /* A short file is likely to change a large fraction;
5296 spare the user annoying messages. */
5297 && XFASTINT (b
->save_length
) > 5000
5298 /* These messages are frequent and annoying for `*mail*'. */
5299 && !EQ (b
->filename
, Qnil
)
5300 && NILP (no_message
))
5302 /* It has shrunk too much; turn off auto-saving here. */
5303 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5304 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5306 minibuffer_auto_raise
= 0;
5307 /* Turn off auto-saving until there's a real save,
5308 and prevent any more warnings. */
5309 XSETINT (b
->save_length
, -1);
5310 Fsleep_for (make_number (1), Qnil
);
5313 set_buffer_internal (b
);
5314 if (!auto_saved
&& NILP (no_message
))
5315 message1 ("Auto-saving...");
5316 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5318 b
->auto_save_modified
= BUF_MODIFF (b
);
5319 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5320 set_buffer_internal (old
);
5322 EMACS_GET_TIME (after_time
);
5324 /* If auto-save took more than 60 seconds,
5325 assume it was an NFS failure that got a timeout. */
5326 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5327 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5331 /* Prevent another auto save till enough input events come in. */
5332 record_auto_save ();
5334 if (auto_saved
&& NILP (no_message
))
5338 /* If we are going to restore an old message,
5339 give time to read ours. */
5340 sit_for (make_number (1), 0, 0);
5343 else if (!auto_save_error_occurred
)
5344 /* Don't overwrite the error message if an error occurred.
5345 If we displayed a message and then restored a state
5346 with no message, leave a "done" message on the screen. */
5347 message1 ("Auto-saving...done");
5352 /* This restores the message-stack status. */
5353 unbind_to (count
, Qnil
);
5357 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5358 Sset_buffer_auto_saved
, 0, 0, 0,
5359 doc
: /* Mark current buffer as auto-saved with its current text.
5360 No auto-save file will be written until the buffer changes again. */)
5363 current_buffer
->auto_save_modified
= MODIFF
;
5364 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5365 current_buffer
->auto_save_failure_time
= -1;
5369 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5370 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5371 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5374 current_buffer
->auto_save_failure_time
= -1;
5378 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5380 doc
: /* Return t if current buffer has been auto-saved recently.
5381 More precisely, if it has been auto-saved since last read from or saved
5382 in the visited file. If the buffer has no visited file,
5383 then any auto-save counts as "recent". */)
5386 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5389 /* Reading and completing file names */
5391 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5392 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5393 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5394 The return value is only relevant for a call to `read-file-name' that happens
5395 before any other event (mouse or keypress) is handeled. */)
5398 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
5399 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5409 Fread_file_name (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
5410 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
5412 struct gcpro gcpro1
, gcpro2
;
5413 Lisp_Object args
[7];
5415 GCPRO1 (default_filename
);
5416 args
[0] = intern ("read-file-name");
5419 args
[3] = default_filename
;
5420 args
[4] = mustmatch
;
5422 args
[6] = predicate
;
5423 RETURN_UNGCPRO (Ffuncall (7, args
));
5430 /* Must be set before any path manipulation is performed. */
5431 XSETFASTINT (Vdirectory_sep_char
, '/');
5438 Qoperations
= intern ("operations");
5439 Qexpand_file_name
= intern ("expand-file-name");
5440 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5441 Qdirectory_file_name
= intern ("directory-file-name");
5442 Qfile_name_directory
= intern ("file-name-directory");
5443 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5444 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5445 Qfile_name_as_directory
= intern ("file-name-as-directory");
5446 Qcopy_file
= intern ("copy-file");
5447 Qmake_directory_internal
= intern ("make-directory-internal");
5448 Qmake_directory
= intern ("make-directory");
5449 Qdelete_directory
= intern ("delete-directory");
5450 Qdelete_file
= intern ("delete-file");
5451 Qrename_file
= intern ("rename-file");
5452 Qadd_name_to_file
= intern ("add-name-to-file");
5453 Qmake_symbolic_link
= intern ("make-symbolic-link");
5454 Qfile_exists_p
= intern ("file-exists-p");
5455 Qfile_executable_p
= intern ("file-executable-p");
5456 Qfile_readable_p
= intern ("file-readable-p");
5457 Qfile_writable_p
= intern ("file-writable-p");
5458 Qfile_symlink_p
= intern ("file-symlink-p");
5459 Qaccess_file
= intern ("access-file");
5460 Qfile_directory_p
= intern ("file-directory-p");
5461 Qfile_regular_p
= intern ("file-regular-p");
5462 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5463 Qfile_modes
= intern ("file-modes");
5464 Qset_file_modes
= intern ("set-file-modes");
5465 Qset_file_times
= intern ("set-file-times");
5466 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5467 Qinsert_file_contents
= intern ("insert-file-contents");
5468 Qwrite_region
= intern ("write-region");
5469 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5470 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5471 Qauto_save_coding
= intern ("auto-save-coding");
5473 staticpro (&Qoperations
);
5474 staticpro (&Qexpand_file_name
);
5475 staticpro (&Qsubstitute_in_file_name
);
5476 staticpro (&Qdirectory_file_name
);
5477 staticpro (&Qfile_name_directory
);
5478 staticpro (&Qfile_name_nondirectory
);
5479 staticpro (&Qunhandled_file_name_directory
);
5480 staticpro (&Qfile_name_as_directory
);
5481 staticpro (&Qcopy_file
);
5482 staticpro (&Qmake_directory_internal
);
5483 staticpro (&Qmake_directory
);
5484 staticpro (&Qdelete_directory
);
5485 staticpro (&Qdelete_file
);
5486 staticpro (&Qrename_file
);
5487 staticpro (&Qadd_name_to_file
);
5488 staticpro (&Qmake_symbolic_link
);
5489 staticpro (&Qfile_exists_p
);
5490 staticpro (&Qfile_executable_p
);
5491 staticpro (&Qfile_readable_p
);
5492 staticpro (&Qfile_writable_p
);
5493 staticpro (&Qaccess_file
);
5494 staticpro (&Qfile_symlink_p
);
5495 staticpro (&Qfile_directory_p
);
5496 staticpro (&Qfile_regular_p
);
5497 staticpro (&Qfile_accessible_directory_p
);
5498 staticpro (&Qfile_modes
);
5499 staticpro (&Qset_file_modes
);
5500 staticpro (&Qset_file_times
);
5501 staticpro (&Qfile_newer_than_file_p
);
5502 staticpro (&Qinsert_file_contents
);
5503 staticpro (&Qwrite_region
);
5504 staticpro (&Qverify_visited_file_modtime
);
5505 staticpro (&Qset_visited_file_modtime
);
5506 staticpro (&Qauto_save_coding
);
5508 Qfile_name_history
= intern ("file-name-history");
5509 Fset (Qfile_name_history
, Qnil
);
5510 staticpro (&Qfile_name_history
);
5512 Qfile_error
= intern ("file-error");
5513 staticpro (&Qfile_error
);
5514 Qfile_already_exists
= intern ("file-already-exists");
5515 staticpro (&Qfile_already_exists
);
5516 Qfile_date_error
= intern ("file-date-error");
5517 staticpro (&Qfile_date_error
);
5518 Qexcl
= intern ("excl");
5522 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5523 staticpro (&Qfind_buffer_file_type
);
5526 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5527 doc
: /* *Coding system for encoding file names.
5528 If it is nil, `default-file-name-coding-system' (which see) is used. */);
5529 Vfile_name_coding_system
= Qnil
;
5531 DEFVAR_LISP ("default-file-name-coding-system",
5532 &Vdefault_file_name_coding_system
,
5533 doc
: /* Default coding system for encoding file names.
5534 This variable is used only when `file-name-coding-system' is nil.
5536 This variable is set/changed by the command `set-language-environment'.
5537 User should not set this variable manually,
5538 instead use `file-name-coding-system' to get a constant encoding
5539 of file names regardless of the current language environment. */);
5540 Vdefault_file_name_coding_system
= Qnil
;
5542 Qformat_decode
= intern ("format-decode");
5543 staticpro (&Qformat_decode
);
5544 Qformat_annotate_function
= intern ("format-annotate-function");
5545 staticpro (&Qformat_annotate_function
);
5546 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
5547 staticpro (&Qafter_insert_file_set_coding
);
5549 Qcar_less_than_car
= intern ("car-less-than-car");
5550 staticpro (&Qcar_less_than_car
);
5552 Fput (Qfile_error
, Qerror_conditions
,
5553 list2 (Qfile_error
, Qerror
));
5554 Fput (Qfile_error
, Qerror_message
,
5555 build_string ("File error"));
5557 Fput (Qfile_already_exists
, Qerror_conditions
,
5558 list3 (Qfile_already_exists
, Qfile_error
, Qerror
));
5559 Fput (Qfile_already_exists
, Qerror_message
,
5560 build_string ("File already exists"));
5562 Fput (Qfile_date_error
, Qerror_conditions
,
5563 list3 (Qfile_date_error
, Qfile_error
, Qerror
));
5564 Fput (Qfile_date_error
, Qerror_message
,
5565 build_string ("Cannot set file date"));
5567 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5568 doc
: /* Directory separator character for built-in functions that return file names.
5569 The value is always ?/. Don't use this variable, just use `/'. */);
5571 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5572 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
5573 If a file name matches REGEXP, then all I/O on that file is done by calling
5576 The first argument given to HANDLER is the name of the I/O primitive
5577 to be handled; the remaining arguments are the arguments that were
5578 passed to that primitive. For example, if you do
5579 (file-exists-p FILENAME)
5580 and FILENAME is handled by HANDLER, then HANDLER is called like this:
5581 (funcall HANDLER 'file-exists-p FILENAME)
5582 The function `find-file-name-handler' checks this list for a handler
5583 for its argument. */);
5584 Vfile_name_handler_alist
= Qnil
;
5586 DEFVAR_LISP ("set-auto-coding-function",
5587 &Vset_auto_coding_function
,
5588 doc
: /* If non-nil, a function to call to decide a coding system of file.
5589 Two arguments are passed to this function: the file name
5590 and the length of a file contents following the point.
5591 This function should return a coding system to decode the file contents.
5592 It should check the file name against `auto-coding-alist'.
5593 If no coding system is decided, it should check a coding system
5594 specified in the heading lines with the format:
5595 -*- ... coding: CODING-SYSTEM; ... -*-
5596 or local variable spec of the tailing lines with `coding:' tag. */);
5597 Vset_auto_coding_function
= Qnil
;
5599 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5600 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
5601 Each is passed one argument, the number of characters inserted,
5602 with point at the start of the inserted text. Each function
5603 should leave point the same, and return the new character count.
5604 If `insert-file-contents' is intercepted by a handler from
5605 `file-name-handler-alist', that handler is responsible for calling the
5606 functions in `after-insert-file-functions' if appropriate. */);
5607 Vafter_insert_file_functions
= Qnil
;
5609 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5610 doc
: /* A list of functions to be called at the start of `write-region'.
5611 Each is passed two arguments, START and END as for `write-region'.
5612 These are usually two numbers but not always; see the documentation
5613 for `write-region'. The function should return a list of pairs
5614 of the form (POSITION . STRING), consisting of strings to be effectively
5615 inserted at the specified positions of the file being written (1 means to
5616 insert before the first byte written). The POSITIONs must be sorted into
5617 increasing order. If there are several functions in the list, the several
5618 lists are merged destructively. Alternatively, the function can return
5619 with a different buffer current; in that case it should pay attention
5620 to the annotations returned by previous functions and listed in
5621 `write-region-annotations-so-far'.*/);
5622 Vwrite_region_annotate_functions
= Qnil
;
5623 staticpro (&Qwrite_region_annotate_functions
);
5624 Qwrite_region_annotate_functions
5625 = intern ("write-region-annotate-functions");
5627 DEFVAR_LISP ("write-region-annotations-so-far",
5628 &Vwrite_region_annotations_so_far
,
5629 doc
: /* When an annotation function is called, this holds the previous annotations.
5630 These are the annotations made by other annotation functions
5631 that were already called. See also `write-region-annotate-functions'. */);
5632 Vwrite_region_annotations_so_far
= Qnil
;
5634 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5635 doc
: /* A list of file name handlers that temporarily should not be used.
5636 This applies only to the operation `inhibit-file-name-operation'. */);
5637 Vinhibit_file_name_handlers
= Qnil
;
5639 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5640 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5641 Vinhibit_file_name_operation
= Qnil
;
5643 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5644 doc
: /* File name in which we write a list of all auto save file names.
5645 This variable is initialized automatically from `auto-save-list-file-prefix'
5646 shortly after Emacs reads your `.emacs' file, if you have not yet given it
5647 a non-nil value. */);
5648 Vauto_save_list_file_name
= Qnil
;
5650 DEFVAR_LISP ("auto-save-visited-file-name", &Vauto_save_visited_file_name
,
5651 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
5652 Normally auto-save files are written under other names. */);
5653 Vauto_save_visited_file_name
= Qnil
;
5656 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
5657 doc
: /* *Non-nil means don't call fsync in `write-region'.
5658 This variable affects calls to `write-region' as well as save commands.
5659 A non-nil value may result in data loss! */);
5660 write_region_inhibit_fsync
= 0;
5663 DEFVAR_BOOL ("delete-by-moving-to-trash", &delete_by_moving_to_trash
,
5664 doc
: /* Specifies whether to use the system's trash can.
5665 When non-nil, the function `move-file-to-trash' will be used by
5666 `delete-file' and `delete-directory'. */);
5667 delete_by_moving_to_trash
= 0;
5668 Qmove_file_to_trash
= intern ("move-file-to-trash");
5669 staticpro (&Qmove_file_to_trash
);
5671 defsubr (&Sfind_file_name_handler
);
5672 defsubr (&Sfile_name_directory
);
5673 defsubr (&Sfile_name_nondirectory
);
5674 defsubr (&Sunhandled_file_name_directory
);
5675 defsubr (&Sfile_name_as_directory
);
5676 defsubr (&Sdirectory_file_name
);
5677 defsubr (&Smake_temp_name
);
5678 defsubr (&Sexpand_file_name
);
5679 defsubr (&Ssubstitute_in_file_name
);
5680 defsubr (&Scopy_file
);
5681 defsubr (&Smake_directory_internal
);
5682 defsubr (&Sdelete_directory
);
5683 defsubr (&Sdelete_file
);
5684 defsubr (&Srename_file
);
5685 defsubr (&Sadd_name_to_file
);
5686 defsubr (&Smake_symbolic_link
);
5687 defsubr (&Sfile_name_absolute_p
);
5688 defsubr (&Sfile_exists_p
);
5689 defsubr (&Sfile_executable_p
);
5690 defsubr (&Sfile_readable_p
);
5691 defsubr (&Sfile_writable_p
);
5692 defsubr (&Saccess_file
);
5693 defsubr (&Sfile_symlink_p
);
5694 defsubr (&Sfile_directory_p
);
5695 defsubr (&Sfile_accessible_directory_p
);
5696 defsubr (&Sfile_regular_p
);
5697 defsubr (&Sfile_modes
);
5698 defsubr (&Sset_file_modes
);
5699 defsubr (&Sset_file_times
);
5700 defsubr (&Sset_default_file_modes
);
5701 defsubr (&Sdefault_file_modes
);
5702 defsubr (&Sfile_newer_than_file_p
);
5703 defsubr (&Sinsert_file_contents
);
5704 defsubr (&Swrite_region
);
5705 defsubr (&Scar_less_than_car
);
5706 defsubr (&Sverify_visited_file_modtime
);
5707 defsubr (&Sclear_visited_file_modtime
);
5708 defsubr (&Svisited_file_modtime
);
5709 defsubr (&Sset_visited_file_modtime
);
5710 defsubr (&Sdo_auto_save
);
5711 defsubr (&Sset_buffer_auto_saved
);
5712 defsubr (&Sclear_buffer_auto_save_failure
);
5713 defsubr (&Srecent_auto_save_p
);
5715 defsubr (&Snext_read_file_uses_dialog_p
);
5718 defsubr (&Sunix_sync
);
5722 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
5723 (do not change this comment) */