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, 2009, 2010 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>
37 #if !defined (S_ISLNK) && defined (S_IFLNK)
38 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
41 #if !defined (S_ISFIFO) && defined (S_IFIFO)
42 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
45 #if !defined (S_ISREG) && defined (S_IFREG)
46 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
56 #ifdef HAVE_LIBSELINUX
57 #include <selinux/selinux.h>
58 #include <selinux/context.h>
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>
86 #define CORRECT_DIR_SEPS(s) \
87 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
88 else unixtodos_filename (s); \
90 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
91 redirector allows the six letters between 'Z' and 'a' as well. */
93 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
96 #define IS_DRIVE(x) isalpha (x)
98 /* Need to lower-case the drive letter, or else expanded
99 filenames will sometimes compare inequal, because
100 `expand-file-name' doesn't always down-case the drive letter. */
101 #define DRIVE_LETTER(x) (tolower (x))
110 #include "commands.h"
111 extern int use_dialog_box
;
112 extern int use_file_dialog
;
126 #ifndef FILE_SYSTEM_CASE
127 #define FILE_SYSTEM_CASE(filename) (filename)
130 /* Nonzero during writing of auto-save files */
133 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
134 a new file with the same mode as the original */
135 int auto_save_mode_bits
;
137 /* Set by auto_save_1 if an error occurred during the last auto-save. */
138 int auto_save_error_occurred
;
140 /* The symbol bound to coding-system-for-read when
141 insert-file-contents is called for recovering a file. This is not
142 an actual coding system name, but just an indicator to tell
143 insert-file-contents to use `emacs-mule' with a special flag for
144 auto saving and recovering a file. */
145 Lisp_Object Qauto_save_coding
;
147 /* Coding system for file names, or nil if none. */
148 Lisp_Object Vfile_name_coding_system
;
150 /* Coding system for file names used only when
151 Vfile_name_coding_system is nil. */
152 Lisp_Object Vdefault_file_name_coding_system
;
154 /* Alist of elements (REGEXP . HANDLER) for file names
155 whose I/O is done with a special handler. */
156 Lisp_Object Vfile_name_handler_alist
;
158 /* Property name of a file name handler,
159 which gives a list of operations it handles.. */
160 Lisp_Object Qoperations
;
162 /* Lisp functions for translating file formats */
163 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
165 /* Function to be called to decide a coding system of a reading file. */
166 Lisp_Object Vset_auto_coding_function
;
168 /* Functions to be called to process text properties in inserted file. */
169 Lisp_Object Vafter_insert_file_functions
;
171 /* Lisp function for setting buffer-file-coding-system and the
172 multibyteness of the current buffer after inserting a file. */
173 Lisp_Object Qafter_insert_file_set_coding
;
175 /* Functions to be called to create text property annotations for file. */
176 Lisp_Object Vwrite_region_annotate_functions
;
177 Lisp_Object Qwrite_region_annotate_functions
;
178 Lisp_Object Vwrite_region_post_annotation_function
;
180 /* During build_annotations, each time an annotation function is called,
181 this holds the annotations made by the previous functions. */
182 Lisp_Object Vwrite_region_annotations_so_far
;
184 /* Each time an annotation function changes the buffer, the new buffer
186 Lisp_Object Vwrite_region_annotation_buffers
;
188 /* File name in which we write a list of all our auto save files. */
189 Lisp_Object Vauto_save_list_file_name
;
191 /* Whether or not files are auto-saved into themselves. */
192 Lisp_Object Vauto_save_visited_file_name
;
194 /* Whether or not to continue auto-saving after a large deletion. */
195 Lisp_Object Vauto_save_include_big_deletions
;
197 /* On NT, specifies the directory separator character, used (eg.) when
198 expanding file names. This can be bound to / or \. */
199 Lisp_Object Vdirectory_sep_char
;
202 /* Nonzero means skip the call to fsync in Fwrite-region. */
203 int write_region_inhibit_fsync
;
206 /* Non-zero means call move-file-to-trash in Fdelete_file or
207 Fdelete_directory_internal. */
208 int delete_by_moving_to_trash
;
210 Lisp_Object Qdelete_by_moving_to_trash
;
212 /* Lisp function for moving files to trash. */
213 Lisp_Object Qmove_file_to_trash
;
215 /* Lisp function for recursively copying directories. */
216 Lisp_Object Qcopy_directory
;
218 /* Lisp function for recursively deleting directories. */
219 Lisp_Object Qdelete_directory
;
221 extern Lisp_Object Vuser_login_name
;
224 extern Lisp_Object Vw32_get_true_file_attributes
;
227 extern int minibuf_level
;
229 extern int minibuffer_auto_raise
;
231 /* These variables describe handlers that have "already" had a chance
232 to handle the current operation.
234 Vinhibit_file_name_handlers is a list of file name handlers.
235 Vinhibit_file_name_operation is the operation being handled.
236 If we try to handle that operation, we ignore those handlers. */
238 static Lisp_Object Vinhibit_file_name_handlers
;
239 static Lisp_Object Vinhibit_file_name_operation
;
241 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
243 Lisp_Object Qfile_name_history
;
245 Lisp_Object Qcar_less_than_car
;
247 static int a_write
P_ ((int, Lisp_Object
, int, int,
248 Lisp_Object
*, struct coding_system
*));
249 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
253 report_file_error (string
, data
)
257 Lisp_Object errstring
;
261 synchronize_system_messages_locale ();
262 str
= strerror (errorno
);
263 errstring
= code_convert_string_norecord (make_unibyte_string (str
,
265 Vlocale_coding_system
, 0);
271 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
274 /* System error messages are capitalized. Downcase the initial
275 unless it is followed by a slash. (The slash case caters to
276 error messages that begin with "I/O" or, in German, "E/A".) */
277 if (STRING_MULTIBYTE (errstring
)
278 && ! EQ (Faref (errstring
, make_number (1)), make_number ('/')))
282 str
= (char *) SDATA (errstring
);
283 c
= STRING_CHAR (str
);
284 Faset (errstring
, make_number (0), make_number (DOWNCASE (c
)));
287 xsignal (Qfile_error
,
288 Fcons (build_string (string
), Fcons (errstring
, data
)));
293 close_file_unwind (fd
)
296 emacs_close (XFASTINT (fd
));
300 /* Restore point, having saved it as a marker. */
303 restore_point_unwind (location
)
304 Lisp_Object location
;
306 Fgoto_char (location
);
307 Fset_marker (location
, Qnil
, Qnil
);
312 Lisp_Object Qexpand_file_name
;
313 Lisp_Object Qsubstitute_in_file_name
;
314 Lisp_Object Qdirectory_file_name
;
315 Lisp_Object Qfile_name_directory
;
316 Lisp_Object Qfile_name_nondirectory
;
317 Lisp_Object Qunhandled_file_name_directory
;
318 Lisp_Object Qfile_name_as_directory
;
319 Lisp_Object Qcopy_file
;
320 Lisp_Object Qmake_directory_internal
;
321 Lisp_Object Qmake_directory
;
322 Lisp_Object Qdelete_directory_internal
;
323 Lisp_Object Qdelete_file
;
324 Lisp_Object Qrename_file
;
325 Lisp_Object Qadd_name_to_file
;
326 Lisp_Object Qmake_symbolic_link
;
327 Lisp_Object Qfile_exists_p
;
328 Lisp_Object Qfile_executable_p
;
329 Lisp_Object Qfile_readable_p
;
330 Lisp_Object Qfile_writable_p
;
331 Lisp_Object Qfile_symlink_p
;
332 Lisp_Object Qaccess_file
;
333 Lisp_Object Qfile_directory_p
;
334 Lisp_Object Qfile_regular_p
;
335 Lisp_Object Qfile_accessible_directory_p
;
336 Lisp_Object Qfile_modes
;
337 Lisp_Object Qset_file_modes
;
338 Lisp_Object Qset_file_times
;
339 Lisp_Object Qfile_selinux_context
;
340 Lisp_Object Qset_file_selinux_context
;
341 Lisp_Object Qfile_newer_than_file_p
;
342 Lisp_Object Qinsert_file_contents
;
343 Lisp_Object Qwrite_region
;
344 Lisp_Object Qverify_visited_file_modtime
;
345 Lisp_Object Qset_visited_file_modtime
;
347 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
348 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
349 Otherwise, return nil.
350 A file name is handled if one of the regular expressions in
351 `file-name-handler-alist' matches it.
353 If OPERATION equals `inhibit-file-name-operation', then we ignore
354 any handlers that are members of `inhibit-file-name-handlers',
355 but we still do run any other handlers. This lets handlers
356 use the standard functions without calling themselves recursively. */)
357 (filename
, operation
)
358 Lisp_Object filename
, operation
;
360 /* This function must not munge the match data. */
361 Lisp_Object chain
, inhibited_handlers
, result
;
365 CHECK_STRING (filename
);
367 if (EQ (operation
, Vinhibit_file_name_operation
))
368 inhibited_handlers
= Vinhibit_file_name_handlers
;
370 inhibited_handlers
= Qnil
;
372 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
373 chain
= XCDR (chain
))
379 Lisp_Object string
= XCAR (elt
);
381 Lisp_Object handler
= XCDR (elt
);
382 Lisp_Object operations
= Qnil
;
384 if (SYMBOLP (handler
))
385 operations
= Fget (handler
, Qoperations
);
388 && (match_pos
= fast_string_match (string
, filename
)) > pos
389 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
393 handler
= XCDR (elt
);
394 tem
= Fmemq (handler
, inhibited_handlers
);
408 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
410 doc
: /* Return the directory component in file name FILENAME.
411 Return nil if FILENAME does not include a directory.
412 Otherwise return a directory name.
413 Given a Unix syntax file name, returns a string ending in slash. */)
415 Lisp_Object filename
;
418 register const unsigned char *beg
;
420 register unsigned char *beg
;
422 register const unsigned char *p
;
425 CHECK_STRING (filename
);
427 /* If the file name has special constructs in it,
428 call the corresponding file handler. */
429 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
431 return call2 (handler
, Qfile_name_directory
, filename
);
433 filename
= FILE_SYSTEM_CASE (filename
);
435 beg
= (unsigned char *) alloca (SBYTES (filename
) + 1);
436 bcopy (SDATA (filename
), beg
, SBYTES (filename
) + 1);
438 beg
= SDATA (filename
);
440 p
= beg
+ SBYTES (filename
);
442 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
444 /* only recognise drive specifier at the beginning */
446 /* handle the "/:d:foo" and "/:foo" cases correctly */
447 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
448 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
455 /* Expansion of "c:" to drive and default directory. */
458 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
459 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
460 unsigned char *r
= res
;
462 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
464 strncpy (res
, beg
, 2);
469 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
471 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
474 p
= beg
+ strlen (beg
);
477 CORRECT_DIR_SEPS (beg
);
480 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
483 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
484 Sfile_name_nondirectory
, 1, 1, 0,
485 doc
: /* Return file name FILENAME sans its directory.
486 For example, in a Unix-syntax file name,
487 this is everything after the last slash,
488 or the entire name if it contains no slash. */)
490 Lisp_Object filename
;
492 register const unsigned char *beg
, *p
, *end
;
495 CHECK_STRING (filename
);
497 /* If the file name has special constructs in it,
498 call the corresponding file handler. */
499 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
501 return call2 (handler
, Qfile_name_nondirectory
, filename
);
503 beg
= SDATA (filename
);
504 end
= p
= beg
+ SBYTES (filename
);
506 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
508 /* only recognise drive specifier at beginning */
510 /* handle the "/:d:foo" case correctly */
511 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
516 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
519 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
520 Sunhandled_file_name_directory
, 1, 1, 0,
521 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
522 A `directly usable' directory name is one that may be used without the
523 intervention of any file handler.
524 If FILENAME is a directly usable file itself, return
525 \(file-name-directory FILENAME).
526 If FILENAME refers to a file which is not accessible from a local process,
527 then this should return nil.
528 The `call-process' and `start-process' functions use this function to
529 get a current directory to run processes in. */)
531 Lisp_Object filename
;
535 /* If the file name has special constructs in it,
536 call the corresponding file handler. */
537 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
539 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
541 return Ffile_name_directory (filename
);
546 file_name_as_directory (out
, in
)
549 int size
= strlen (in
) - 1;
561 /* For Unix syntax, Append a slash if necessary */
562 if (!IS_DIRECTORY_SEP (out
[size
]))
564 /* Cannot use DIRECTORY_SEP, which could have any value */
566 out
[size
+ 2] = '\0';
569 CORRECT_DIR_SEPS (out
);
574 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
575 Sfile_name_as_directory
, 1, 1, 0,
576 doc
: /* Return a string representing the file name FILE interpreted as a directory.
577 This operation exists because a directory is also a file, but its name as
578 a directory is different from its name as a file.
579 The result can be used as the value of `default-directory'
580 or passed as second argument to `expand-file-name'.
581 For a Unix-syntax file name, just appends a slash. */)
592 /* If the file name has special constructs in it,
593 call the corresponding file handler. */
594 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
596 return call2 (handler
, Qfile_name_as_directory
, file
);
598 buf
= (char *) alloca (SBYTES (file
) + 10);
599 file_name_as_directory (buf
, SDATA (file
));
600 return make_specified_string (buf
, -1, strlen (buf
),
601 STRING_MULTIBYTE (file
));
605 * Convert from directory name to filename.
606 * On UNIX, it's simple: just make sure there isn't a terminating /
608 * Value is nonzero if the string output is different from the input.
612 directory_file_name (src
, dst
)
619 /* Process as Unix format: just remove any final slash.
620 But leave "/" unchanged; do not change it to "". */
623 && IS_DIRECTORY_SEP (dst
[slen
- 1])
625 && !IS_ANY_SEP (dst
[slen
- 2])
630 CORRECT_DIR_SEPS (dst
);
635 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
637 doc
: /* Returns the file name of the directory named DIRECTORY.
638 This is the name of the file that holds the data for the directory DIRECTORY.
639 This operation exists because a directory is also a file, but its name as
640 a directory is different from its name as a file.
641 In Unix-syntax, this function just removes the final slash. */)
643 Lisp_Object directory
;
648 CHECK_STRING (directory
);
650 if (NILP (directory
))
653 /* If the file name has special constructs in it,
654 call the corresponding file handler. */
655 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
657 return call2 (handler
, Qdirectory_file_name
, directory
);
659 buf
= (char *) alloca (SBYTES (directory
) + 20);
660 directory_file_name (SDATA (directory
), buf
);
661 return make_specified_string (buf
, -1, strlen (buf
),
662 STRING_MULTIBYTE (directory
));
665 static const char make_temp_name_tbl
[64] =
667 'A','B','C','D','E','F','G','H',
668 'I','J','K','L','M','N','O','P',
669 'Q','R','S','T','U','V','W','X',
670 'Y','Z','a','b','c','d','e','f',
671 'g','h','i','j','k','l','m','n',
672 'o','p','q','r','s','t','u','v',
673 'w','x','y','z','0','1','2','3',
674 '4','5','6','7','8','9','-','_'
677 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
679 /* Value is a temporary file name starting with PREFIX, a string.
681 The Emacs process number forms part of the result, so there is
682 no danger of generating a name being used by another process.
683 In addition, this function makes an attempt to choose a name
684 which has no existing file. To make this work, PREFIX should be
685 an absolute file name.
687 BASE64_P non-zero means add the pid as 3 characters in base64
688 encoding. In this case, 6 characters will be added to PREFIX to
689 form the file name. Otherwise, if Emacs is running on a system
690 with long file names, add the pid as a decimal number.
692 This function signals an error if no unique file name could be
696 make_temp_name (prefix
, base64_p
)
703 unsigned char *p
, *data
;
707 CHECK_STRING (prefix
);
709 /* VAL is created by adding 6 characters to PREFIX. The first
710 three are the PID of this process, in base 64, and the second
711 three are incremented if the file already exists. This ensures
712 262144 unique file names per PID per PREFIX. */
714 pid
= (int) getpid ();
718 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
719 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
720 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
725 #ifdef HAVE_LONG_FILE_NAMES
726 sprintf (pidbuf
, "%d", pid
);
727 pidlen
= strlen (pidbuf
);
729 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
730 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
731 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
736 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
737 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
738 if (!STRING_MULTIBYTE (prefix
))
739 STRING_SET_UNIBYTE (val
);
741 bcopy(SDATA (prefix
), data
, len
);
744 bcopy (pidbuf
, p
, pidlen
);
747 /* Here we try to minimize useless stat'ing when this function is
748 invoked many times successively with the same PREFIX. We achieve
749 this by initializing count to a random value, and incrementing it
752 We don't want make-temp-name to be called while dumping,
753 because then make_temp_name_count_initialized_p would get set
754 and then make_temp_name_count would not be set when Emacs starts. */
756 if (!make_temp_name_count_initialized_p
)
758 make_temp_name_count
= (unsigned) time (NULL
);
759 make_temp_name_count_initialized_p
= 1;
765 unsigned num
= make_temp_name_count
;
767 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
768 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
769 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
771 /* Poor man's congruential RN generator. Replace with
772 ++make_temp_name_count for debugging. */
773 make_temp_name_count
+= 25229;
774 make_temp_name_count
%= 225307;
776 if (stat (data
, &ignored
) < 0)
778 /* We want to return only if errno is ENOENT. */
782 /* The error here is dubious, but there is little else we
783 can do. The alternatives are to return nil, which is
784 as bad as (and in many cases worse than) throwing the
785 error, or to ignore the error, which will likely result
786 in looping through 225307 stat's, which is not only
787 dog-slow, but also useless since it will fallback to
788 the errow below, anyway. */
789 report_file_error ("Cannot create temporary name for prefix",
790 Fcons (prefix
, Qnil
));
795 error ("Cannot create temporary name for prefix `%s'",
801 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
802 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
803 The Emacs process number forms part of the result,
804 so there is no danger of generating a name being used by another process.
806 In addition, this function makes an attempt to choose a name
807 which has no existing file. To make this work,
808 PREFIX should be an absolute file name.
810 There is a race condition between calling `make-temp-name' and creating the
811 file which opens all kinds of security holes. For that reason, you should
812 probably use `make-temp-file' instead, except in three circumstances:
814 * If you are creating the file in the user's home directory.
815 * If you are creating a directory rather than an ordinary file.
816 * If you are taking special precautions as `make-temp-file' does. */)
820 return make_temp_name (prefix
, 0);
825 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
826 doc
: /* Convert filename NAME to absolute, and canonicalize it.
827 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
828 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
829 the current buffer's value of `default-directory' is used.
830 File name components that are `.' are removed, and
831 so are file name components followed by `..', along with the `..' itself;
832 note that these simplifications are done without checking the resulting
833 file names in the file system.
834 An initial `~/' expands to your home directory.
835 An initial `~USER/' expands to USER's home directory.
836 See also the function `substitute-in-file-name'.
838 For technical reasons, this function can return correct but
839 non-intuitive results for the root directory; for instance,
840 \(expand-file-name ".." "/") returns "/..". For this reason, use
841 (directory-file-name (file-name-directory dirname)) to traverse a
842 filesystem tree, not (expand-file-name ".." dirname). */)
843 (name
, default_directory
)
844 Lisp_Object name
, default_directory
;
846 /* These point to SDATA and need to be careful with string-relocation
847 during GC (via DECODE_FILE). */
848 unsigned char *nm
, *newdir
;
849 /* This should only point to alloca'd data. */
850 unsigned char *target
;
856 int collapse_newdir
= 1;
860 Lisp_Object handler
, result
;
866 /* If the file name has special constructs in it,
867 call the corresponding file handler. */
868 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
870 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
872 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
873 if (NILP (default_directory
))
874 default_directory
= current_buffer
->directory
;
875 if (! STRINGP (default_directory
))
878 /* "/" is not considered a root directory on DOS_NT, so using "/"
879 here causes an infinite recursion in, e.g., the following:
881 (let (default-directory)
882 (expand-file-name "a"))
884 To avoid this, we set default_directory to the root of the
886 extern char *emacs_root_dir (void);
888 default_directory
= build_string (emacs_root_dir ());
890 default_directory
= build_string ("/");
894 if (!NILP (default_directory
))
896 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
898 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
902 unsigned char *o
= SDATA (default_directory
);
904 /* Make sure DEFAULT_DIRECTORY is properly expanded.
905 It would be better to do this down below where we actually use
906 default_directory. Unfortunately, calling Fexpand_file_name recursively
907 could invoke GC, and the strings might be relocated. This would
908 be annoying because we have pointers into strings lying around
909 that would need adjusting, and people would add new pointers to
910 the code and forget to adjust them, resulting in intermittent bugs.
911 Putting this call here avoids all that crud.
913 The EQ test avoids infinite recursion. */
914 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
915 /* Save time in some common cases - as long as default_directory
916 is not relative, it can be canonicalized with name below (if it
917 is needed at all) without requiring it to be expanded now. */
919 /* Detect MSDOS file names with drive specifiers. */
920 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
921 && IS_DIRECTORY_SEP (o
[2]))
923 /* Detect Windows file names in UNC format. */
924 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
926 #else /* not DOS_NT */
927 /* Detect Unix absolute file names (/... alone is not absolute on
929 && ! (IS_DIRECTORY_SEP (o
[0]))
930 #endif /* not DOS_NT */
936 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
940 name
= FILE_SYSTEM_CASE (name
);
941 multibyte
= STRING_MULTIBYTE (name
);
942 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
945 default_directory
= string_to_multibyte (default_directory
);
948 name
= string_to_multibyte (name
);
953 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
954 nm
= (unsigned char *) alloca (SBYTES (name
) + 1);
955 bcopy (SDATA (name
), nm
, SBYTES (name
) + 1);
958 /* Note if special escape prefix is present, but remove for now. */
959 if (nm
[0] == '/' && nm
[1] == ':')
965 /* Find and remove drive specifier if present; this makes nm absolute
966 even if the rest of the name appears to be relative. Only look for
967 drive specifier at the beginning. */
968 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
975 /* If we see "c://somedir", we want to strip the first slash after the
976 colon when stripping the drive letter. Otherwise, this expands to
978 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
981 /* Discard any previous drive specifier if nm is now in UNC format. */
982 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
986 #endif /* WINDOWSNT */
989 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
990 none are found, we can probably return right away. We will avoid
991 allocating a new string if name is already fully expanded. */
993 IS_DIRECTORY_SEP (nm
[0])
995 && drive
&& !is_escaped
998 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1002 /* If it turns out that the filename we want to return is just a
1003 suffix of FILENAME, we don't need to go through and edit
1004 things; we just need to construct a new string using data
1005 starting at the middle of FILENAME. If we set lose to a
1006 non-zero value, that means we've discovered that we can't do
1009 unsigned char *p
= nm
;
1013 /* Since we know the name is absolute, we can assume that each
1014 element starts with a "/". */
1016 /* "." and ".." are hairy. */
1017 if (IS_DIRECTORY_SEP (p
[0])
1019 && (IS_DIRECTORY_SEP (p
[2])
1021 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1024 /* We want to replace multiple `/' in a row with a single
1027 && IS_DIRECTORY_SEP (p
[0])
1028 && IS_DIRECTORY_SEP (p
[1]))
1035 /* Make sure directories are all separated with / or \ as
1036 desired, but avoid allocation of a new string when not
1038 CORRECT_DIR_SEPS (nm
);
1040 if (IS_DIRECTORY_SEP (nm
[1]))
1042 if (strcmp (nm
, SDATA (name
)) != 0)
1043 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1047 /* drive must be set, so this is okay */
1048 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1052 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1053 temp
[0] = DRIVE_LETTER (drive
);
1054 name
= concat2 (build_string (temp
), name
);
1057 #else /* not DOS_NT */
1058 if (strcmp (nm
, SDATA (name
)) == 0)
1060 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1061 #endif /* not DOS_NT */
1065 /* At this point, nm might or might not be an absolute file name. We
1066 need to expand ~ or ~user if present, otherwise prefix nm with
1067 default_directory if nm is not absolute, and finally collapse /./
1068 and /foo/../ sequences.
1070 We set newdir to be the appropriate prefix if one is needed:
1071 - the relevant user directory if nm starts with ~ or ~user
1072 - the specified drive's working dir (DOS/NT only) if nm does not
1074 - the value of default_directory.
1076 Note that these prefixes are not guaranteed to be absolute (except
1077 for the working dir of a drive). Therefore, to ensure we always
1078 return an absolute name, if the final prefix is not absolute we
1079 append it to the current working directory. */
1083 if (nm
[0] == '~') /* prefix ~ */
1085 if (IS_DIRECTORY_SEP (nm
[1])
1086 || nm
[1] == 0) /* ~ by itself */
1090 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1091 newdir
= (unsigned char *) "";
1093 /* egetenv may return a unibyte string, which will bite us since
1094 we expect the directory to be multibyte. */
1095 tem
= build_string (newdir
);
1096 if (!STRING_MULTIBYTE (tem
))
1098 hdir
= DECODE_FILE (tem
);
1099 newdir
= SDATA (hdir
);
1102 collapse_newdir
= 0;
1105 else /* ~user/filename */
1107 unsigned char *o
, *p
;
1108 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)); p
++);
1109 o
= alloca (p
- nm
+ 1);
1110 bcopy ((char *) nm
, o
, p
- nm
);
1114 pw
= (struct passwd
*) getpwnam (o
+ 1);
1118 newdir
= (unsigned char *) pw
-> pw_dir
;
1121 collapse_newdir
= 0;
1125 /* If we don't find a user of that name, leave the name
1126 unchanged; don't move nm forward to p. */
1131 /* On DOS and Windows, nm is absolute if a drive name was specified;
1132 use the drive's current directory as the prefix if needed. */
1133 if (!newdir
&& drive
)
1135 /* Get default directory if needed to make nm absolute. */
1136 if (!IS_DIRECTORY_SEP (nm
[0]))
1138 newdir
= alloca (MAXPATHLEN
+ 1);
1139 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1144 /* Either nm starts with /, or drive isn't mounted. */
1145 newdir
= alloca (4);
1146 newdir
[0] = DRIVE_LETTER (drive
);
1154 /* Finally, if no prefix has been specified and nm is not absolute,
1155 then it must be expanded relative to default_directory. */
1159 /* /... alone is not absolute on DOS and Windows. */
1160 && !IS_DIRECTORY_SEP (nm
[0])
1163 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1167 newdir
= SDATA (default_directory
);
1169 /* Note if special escape prefix is present, but remove for now. */
1170 if (newdir
[0] == '/' && newdir
[1] == ':')
1181 /* First ensure newdir is an absolute name. */
1183 /* Detect MSDOS file names with drive specifiers. */
1184 ! (IS_DRIVE (newdir
[0])
1185 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1187 /* Detect Windows file names in UNC format. */
1188 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1192 /* Effectively, let newdir be (expand-file-name newdir cwd).
1193 Because of the admonition against calling expand-file-name
1194 when we have pointers into lisp strings, we accomplish this
1195 indirectly by prepending newdir to nm if necessary, and using
1196 cwd (or the wd of newdir's drive) as the new newdir. */
1198 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1203 if (!IS_DIRECTORY_SEP (nm
[0]))
1205 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1206 file_name_as_directory (tmp
, newdir
);
1210 newdir
= alloca (MAXPATHLEN
+ 1);
1213 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1220 /* Strip off drive name from prefix, if present. */
1221 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1227 /* Keep only a prefix from newdir if nm starts with slash
1228 (//server/share for UNC, nothing otherwise). */
1229 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1232 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1235 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1237 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1239 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1251 /* Get rid of any slash at the end of newdir, unless newdir is
1252 just / or // (an incomplete UNC name). */
1253 length
= strlen (newdir
);
1254 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1256 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1260 unsigned char *temp
= (unsigned char *) alloca (length
);
1261 bcopy (newdir
, temp
, length
- 1);
1262 temp
[length
- 1] = 0;
1270 /* Now concatenate the directory and name to new space in the stack frame */
1271 tlen
+= strlen (nm
) + 1;
1273 /* Reserve space for drive specifier and escape prefix, since either
1274 or both may need to be inserted. (The Microsoft x86 compiler
1275 produces incorrect code if the following two lines are combined.) */
1276 target
= (unsigned char *) alloca (tlen
+ 4);
1278 #else /* not DOS_NT */
1279 target
= (unsigned char *) alloca (tlen
);
1280 #endif /* not DOS_NT */
1285 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1288 /* If newdir is effectively "C:/", then the drive letter will have
1289 been stripped and newdir will be "/". Concatenating with an
1290 absolute directory in nm produces "//", which will then be
1291 incorrectly treated as a network share. Ignore newdir in
1292 this case (keeping the drive letter). */
1293 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1294 && newdir
[1] == '\0'))
1296 strcpy (target
, newdir
);
1299 file_name_as_directory (target
, newdir
);
1302 strcat (target
, nm
);
1304 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1307 unsigned char *p
= target
;
1308 unsigned char *o
= target
;
1312 if (!IS_DIRECTORY_SEP (*p
))
1316 else if (p
[1] == '.'
1317 && (IS_DIRECTORY_SEP (p
[2])
1320 /* If "/." is the entire filename, keep the "/". Otherwise,
1321 just delete the whole "/.". */
1322 if (o
== target
&& p
[2] == '\0')
1326 else if (p
[1] == '.' && p
[2] == '.'
1327 /* `/../' is the "superroot" on certain file systems.
1328 Turned off on DOS_NT systems because they have no
1329 "superroot" and because this causes us to produce
1330 file names like "d:/../foo" which fail file-related
1331 functions of the underlying OS. (To reproduce, try a
1332 long series of "../../" in default_directory, longer
1333 than the number of levels from the root.) */
1337 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1340 unsigned char *prev_o
= o
;
1342 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1345 /* Don't go below server level in UNC filenames. */
1346 if (o
== target
+ 1 && IS_DIRECTORY_SEP (*o
)
1347 && IS_DIRECTORY_SEP (*target
))
1351 /* Keep initial / only if this is the whole name. */
1352 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1356 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1357 /* Collapse multiple `/' in a row. */
1366 /* At last, set drive name. */
1368 /* Except for network file name. */
1369 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1370 #endif /* WINDOWSNT */
1372 if (!drive
) abort ();
1374 target
[0] = DRIVE_LETTER (drive
);
1377 /* Reinsert the escape prefix if required. */
1384 CORRECT_DIR_SEPS (target
);
1387 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1390 /* Again look to see if the file name has special constructs in it
1391 and perhaps call the corresponding file handler. This is needed
1392 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1393 the ".." component gives us "/user@host:/bar/../baz" which needs
1394 to be expanded again. */
1395 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1396 if (!NILP (handler
))
1397 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1403 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1404 This is the old version of expand-file-name, before it was thoroughly
1405 rewritten for Emacs 10.31. We leave this version here commented-out,
1406 because the code is very complex and likely to have subtle bugs. If
1407 bugs _are_ found, it might be of interest to look at the old code and
1408 see what did it do in the relevant situation.
1410 Don't remove this code: it's true that it will be accessible
1411 from the repository, but a few years from deletion, people will
1412 forget it is there. */
1414 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1415 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1416 "Convert FILENAME to absolute, and canonicalize it.\n\
1417 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1418 \(does not start with slash); if DEFAULT is nil or missing,\n\
1419 the current buffer's value of default-directory is used.\n\
1420 Filenames containing `.' or `..' as components are simplified;\n\
1421 initial `~/' expands to your home directory.\n\
1422 See also the function `substitute-in-file-name'.")
1424 Lisp_Object name
, defalt
;
1428 register unsigned char *newdir
, *p
, *o
;
1430 unsigned char *target
;
1434 CHECK_STRING (name
);
1437 /* If nm is absolute, flush ...// and detect /./ and /../.
1438 If no /./ or /../ we can return right away. */
1445 if (p
[0] == '/' && p
[1] == '/'
1448 if (p
[0] == '/' && p
[1] == '~')
1449 nm
= p
+ 1, lose
= 1;
1450 if (p
[0] == '/' && p
[1] == '.'
1451 && (p
[2] == '/' || p
[2] == 0
1452 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1458 if (nm
== SDATA (name
))
1460 return build_string (nm
);
1464 /* Now determine directory to start with and put it in NEWDIR */
1468 if (nm
[0] == '~') /* prefix ~ */
1469 if (nm
[1] == '/' || nm
[1] == 0)/* ~/filename */
1471 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1472 newdir
= (unsigned char *) "";
1475 else /* ~user/filename */
1477 /* Get past ~ to user */
1478 unsigned char *user
= nm
+ 1;
1479 /* Find end of name. */
1480 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1481 int len
= ptr
? ptr
- user
: strlen (user
);
1482 /* Copy the user name into temp storage. */
1483 o
= (unsigned char *) alloca (len
+ 1);
1484 bcopy ((char *) user
, o
, len
);
1487 /* Look up the user name. */
1489 pw
= (struct passwd
*) getpwnam (o
+ 1);
1492 error ("\"%s\" isn't a registered user", o
+ 1);
1494 newdir
= (unsigned char *) pw
->pw_dir
;
1496 /* Discard the user name from NM. */
1500 if (nm
[0] != '/' && !newdir
)
1503 defalt
= current_buffer
->directory
;
1504 CHECK_STRING (defalt
);
1505 newdir
= SDATA (defalt
);
1508 /* Now concatenate the directory and name to new space in the stack frame */
1510 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1511 target
= (unsigned char *) alloca (tlen
);
1516 if (nm
[0] == 0 || nm
[0] == '/')
1517 strcpy (target
, newdir
);
1519 file_name_as_directory (target
, newdir
);
1522 strcat (target
, nm
);
1524 /* Now canonicalize by removing /. and /foo/.. if they appear */
1535 else if (!strncmp (p
, "//", 2)
1541 else if (p
[0] == '/' && p
[1] == '.'
1542 && (p
[2] == '/' || p
[2] == 0))
1544 else if (!strncmp (p
, "/..", 3)
1545 /* `/../' is the "superroot" on certain file systems. */
1547 && (p
[3] == '/' || p
[3] == 0))
1549 while (o
!= target
&& *--o
!= '/')
1551 if (o
== target
&& *o
== '/')
1561 return make_string (target
, o
- target
);
1565 /* If /~ or // appears, discard everything through first slash. */
1567 file_name_absolute_p (filename
)
1568 const unsigned char *filename
;
1571 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
1573 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
1574 && IS_DIRECTORY_SEP (filename
[2]))
1579 static unsigned char *
1580 search_embedded_absfilename (nm
, endp
)
1581 unsigned char *nm
, *endp
;
1583 unsigned char *p
, *s
;
1585 for (p
= nm
+ 1; p
< endp
; p
++)
1588 || IS_DIRECTORY_SEP (p
[-1]))
1589 && file_name_absolute_p (p
)
1590 #if defined (WINDOWSNT) || defined(CYGWIN)
1591 /* // at start of file name is meaningful in Apollo,
1592 WindowsNT and Cygwin systems. */
1593 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
1594 #endif /* not (WINDOWSNT || CYGWIN) */
1597 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)); s
++);
1598 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
1600 unsigned char *o
= alloca (s
- p
+ 1);
1602 bcopy (p
, o
, s
- p
);
1605 /* If we have ~user and `user' exists, discard
1606 everything up to ~. But if `user' does not exist, leave
1607 ~user alone, it might be a literal file name. */
1609 pw
= getpwnam (o
+ 1);
1621 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1622 Ssubstitute_in_file_name
, 1, 1, 0,
1623 doc
: /* Substitute environment variables referred to in FILENAME.
1624 `$FOO' where FOO is an environment variable name means to substitute
1625 the value of that variable. The variable name should be terminated
1626 with a character not a letter, digit or underscore; otherwise, enclose
1627 the entire variable name in braces.
1629 If `/~' appears, all of FILENAME through that `/' is discarded.
1630 If `//' appears, everything up to and including the first of
1631 those `/' is discarded. */)
1633 Lisp_Object filename
;
1637 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1638 unsigned char *target
= NULL
;
1640 int substituted
= 0;
1643 Lisp_Object handler
;
1645 CHECK_STRING (filename
);
1647 multibyte
= STRING_MULTIBYTE (filename
);
1649 /* If the file name has special constructs in it,
1650 call the corresponding file handler. */
1651 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1652 if (!NILP (handler
))
1653 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1655 /* Always work on a copy of the string, in case GC happens during
1656 decode of environment variables, causing the original Lisp_String
1657 data to be relocated. */
1658 nm
= (unsigned char *) alloca (SBYTES (filename
) + 1);
1659 bcopy (SDATA (filename
), nm
, SBYTES (filename
) + 1);
1662 CORRECT_DIR_SEPS (nm
);
1663 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
1665 endp
= nm
+ SBYTES (filename
);
1667 /* If /~ or // appears, discard everything through first slash. */
1668 p
= search_embedded_absfilename (nm
, endp
);
1670 /* Start over with the new string, so we check the file-name-handler
1671 again. Important with filenames like "/home/foo//:/hello///there"
1672 which whould substitute to "/:/hello///there" rather than "/there". */
1673 return Fsubstitute_in_file_name
1674 (make_specified_string (p
, -1, endp
- p
, multibyte
));
1676 /* See if any variables are substituted into the string
1677 and find the total length of their values in `total' */
1679 for (p
= nm
; p
!= endp
;)
1689 /* "$$" means a single "$" */
1698 while (p
!= endp
&& *p
!= '}') p
++;
1699 if (*p
!= '}') goto missingclose
;
1705 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1709 /* Copy out the variable name */
1710 target
= (unsigned char *) alloca (s
- o
+ 1);
1711 strncpy (target
, o
, s
- o
);
1714 strupr (target
); /* $home == $HOME etc. */
1717 /* Get variable value */
1718 o
= (unsigned char *) egetenv (target
);
1721 /* Don't try to guess a maximum length - UTF8 can use up to
1722 four bytes per character. This code is unlikely to run
1723 in a situation that requires performance, so decoding the
1724 env variables twice should be acceptable. Note that
1725 decoding may cause a garbage collect. */
1726 Lisp_Object orig
, decoded
;
1727 orig
= make_unibyte_string (o
, strlen (o
));
1728 decoded
= DECODE_FILE (orig
);
1729 total
+= SBYTES (decoded
);
1739 /* If substitution required, recopy the string and do it */
1740 /* Make space in stack frame for the new copy */
1741 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
1744 /* Copy the rest of the name through, replacing $ constructs with values */
1761 while (p
!= endp
&& *p
!= '}') p
++;
1762 if (*p
!= '}') goto missingclose
;
1768 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1772 /* Copy out the variable name */
1773 target
= (unsigned char *) alloca (s
- o
+ 1);
1774 strncpy (target
, o
, s
- o
);
1777 strupr (target
); /* $home == $HOME etc. */
1780 /* Get variable value */
1781 o
= (unsigned char *) egetenv (target
);
1785 strcpy (x
, target
); x
+= strlen (target
);
1789 Lisp_Object orig
, decoded
;
1790 int orig_length
, decoded_length
;
1791 orig_length
= strlen (o
);
1792 orig
= make_unibyte_string (o
, orig_length
);
1793 decoded
= DECODE_FILE (orig
);
1794 decoded_length
= SBYTES (decoded
);
1795 strncpy (x
, SDATA (decoded
), decoded_length
);
1796 x
+= decoded_length
;
1798 /* If environment variable needed decoding, return value
1799 needs to be multibyte. */
1800 if (decoded_length
!= orig_length
1801 || strncmp (SDATA (decoded
), o
, orig_length
))
1808 /* If /~ or // appears, discard everything through first slash. */
1809 while ((p
= search_embedded_absfilename (xnm
, x
)))
1810 /* This time we do not start over because we've already expanded envvars
1811 and replaced $$ with $. Maybe we should start over as well, but we'd
1812 need to quote some $ to $$ first. */
1815 return make_specified_string (xnm
, -1, x
- xnm
, multibyte
);
1818 error ("Bad format environment-variable substitution");
1820 error ("Missing \"}\" in environment-variable substitution");
1822 error ("Substituting nonexistent environment variable \"%s\"", target
);
1828 /* A slightly faster and more convenient way to get
1829 (directory-file-name (expand-file-name FOO)). */
1832 expand_and_dir_to_file (filename
, defdir
)
1833 Lisp_Object filename
, defdir
;
1835 register Lisp_Object absname
;
1837 absname
= Fexpand_file_name (filename
, defdir
);
1839 /* Remove final slash, if any (unless this is the root dir).
1840 stat behaves differently depending! */
1841 if (SCHARS (absname
) > 1
1842 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
1843 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
1844 /* We cannot take shortcuts; they might be wrong for magic file names. */
1845 absname
= Fdirectory_file_name (absname
);
1849 /* Signal an error if the file ABSNAME already exists.
1850 If INTERACTIVE is nonzero, ask the user whether to proceed,
1851 and bypass the error if the user says to go ahead.
1852 QUERYSTRING is a name for the action that is being considered
1855 *STATPTR is used to store the stat information if the file exists.
1856 If the file does not exist, STATPTR->st_mode is set to 0.
1857 If STATPTR is null, we don't store into it.
1859 If QUICK is nonzero, we ask for y or n, not yes or no. */
1862 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
1863 Lisp_Object absname
;
1864 unsigned char *querystring
;
1866 struct stat
*statptr
;
1869 register Lisp_Object tem
, encoded_filename
;
1870 struct stat statbuf
;
1871 struct gcpro gcpro1
;
1873 encoded_filename
= ENCODE_FILE (absname
);
1875 /* stat is a good way to tell whether the file exists,
1876 regardless of what access permissions it has. */
1877 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
1880 xsignal2 (Qfile_already_exists
,
1881 build_string ("File already exists"), absname
);
1883 tem
= format2 ("File %s already exists; %s anyway? ",
1884 absname
, build_string (querystring
));
1886 tem
= Fy_or_n_p (tem
);
1888 tem
= do_yes_or_no_p (tem
);
1891 xsignal2 (Qfile_already_exists
,
1892 build_string ("File already exists"), absname
);
1899 statptr
->st_mode
= 0;
1904 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
1905 "fCopy file: \nGCopy %s to file: \np\nP",
1906 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
1907 If NEWNAME names a directory, copy FILE there.
1909 This function always sets the file modes of the output file to match
1912 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1913 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1914 signal a `file-already-exists' error without overwriting. If
1915 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1916 about overwriting; this is what happens in interactive use with M-x.
1917 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1920 Fourth arg KEEP-TIME non-nil means give the output file the same
1921 last-modified time as the old one. (This works on only some systems.)
1923 A prefix arg makes KEEP-TIME non-nil.
1925 If PRESERVE-UID-GID is non-nil, we try to transfer the
1926 uid and gid of FILE to NEWNAME.
1928 If PRESERVE-SELINUX-CONTEXT is non-nil and SELinux is enabled
1929 on the system, we copy the SELinux context of FILE to NEWNAME. */)
1930 (file
, newname
, ok_if_already_exists
, keep_time
, preserve_uid_gid
, preserve_selinux_context
)
1931 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
1932 Lisp_Object preserve_uid_gid
, preserve_selinux_context
;
1935 char buf
[16 * 1024];
1936 struct stat st
, out_st
;
1937 Lisp_Object handler
;
1938 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1939 int count
= SPECPDL_INDEX ();
1940 int input_file_statable_p
;
1941 Lisp_Object encoded_file
, encoded_newname
;
1943 security_context_t con
;
1944 int fail
, conlength
= 0;
1947 encoded_file
= encoded_newname
= Qnil
;
1948 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
1949 CHECK_STRING (file
);
1950 CHECK_STRING (newname
);
1952 if (!NILP (Ffile_directory_p (newname
)))
1953 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
1955 newname
= Fexpand_file_name (newname
, Qnil
);
1957 file
= Fexpand_file_name (file
, Qnil
);
1959 /* If the input file name has special constructs in it,
1960 call the corresponding file handler. */
1961 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1962 /* Likewise for output file name. */
1964 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1965 if (!NILP (handler
))
1966 RETURN_UNGCPRO (call7 (handler
, Qcopy_file
, file
, newname
,
1967 ok_if_already_exists
, keep_time
, preserve_uid_gid
,
1968 preserve_selinux_context
));
1970 encoded_file
= ENCODE_FILE (file
);
1971 encoded_newname
= ENCODE_FILE (newname
);
1973 if (NILP (ok_if_already_exists
)
1974 || INTEGERP (ok_if_already_exists
))
1975 barf_or_query_if_file_exists (newname
, "copy to it",
1976 INTEGERP (ok_if_already_exists
), &out_st
, 0);
1977 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
1981 if (!CopyFile (SDATA (encoded_file
),
1982 SDATA (encoded_newname
),
1984 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
1985 /* CopyFile retains the timestamp by default. */
1986 else if (NILP (keep_time
))
1992 EMACS_GET_TIME (now
);
1993 filename
= SDATA (encoded_newname
);
1995 /* Ensure file is writable while its modified time is set. */
1996 attributes
= GetFileAttributes (filename
);
1997 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
1998 if (set_file_times (filename
, now
, now
))
2000 /* Restore original attributes. */
2001 SetFileAttributes (filename
, attributes
);
2002 xsignal2 (Qfile_date_error
,
2003 build_string ("Cannot set file date"), newname
);
2005 /* Restore original attributes. */
2006 SetFileAttributes (filename
, attributes
);
2008 #else /* not WINDOWSNT */
2010 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2014 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2016 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2018 /* We can only copy regular files and symbolic links. Other files are not
2020 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2023 if (!NILP (preserve_selinux_context
) && is_selinux_enabled ())
2025 conlength
= fgetfilecon (ifd
, &con
);
2026 if (conlength
== -1)
2027 report_file_error ("Doing fgetfilecon", Fcons (file
, Qnil
));
2031 if (out_st
.st_mode
!= 0
2032 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2035 report_file_error ("Input and output files are the same",
2036 Fcons (file
, Fcons (newname
, Qnil
)));
2039 #if defined (S_ISREG) && defined (S_ISLNK)
2040 if (input_file_statable_p
)
2042 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2044 #if defined (EISDIR)
2045 /* Get a better looking error message. */
2048 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2051 #endif /* S_ISREG && S_ISLNK */
2054 /* System's default file type was set to binary by _fmode in emacs.c. */
2055 ofd
= emacs_open (SDATA (encoded_newname
),
2056 O_WRONLY
| O_TRUNC
| O_CREAT
2057 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2058 S_IREAD
| S_IWRITE
);
2059 #else /* not MSDOS */
2060 ofd
= emacs_open (SDATA (encoded_newname
),
2061 O_WRONLY
| O_TRUNC
| O_CREAT
2062 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2064 #endif /* not MSDOS */
2066 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2068 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2072 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2073 if (emacs_write (ofd
, buf
, n
) != n
)
2074 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2078 /* Preserve the original file modes, and if requested, also its
2080 if (input_file_statable_p
)
2082 if (! NILP (preserve_uid_gid
))
2083 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2084 fchmod (ofd
, st
.st_mode
& 07777);
2086 #endif /* not MSDOS */
2091 /* Set the modified context back to the file. */
2092 fail
= fsetfilecon (ofd
, con
);
2094 report_file_error ("Doing fsetfilecon", Fcons (newname
, Qnil
));
2100 /* Closing the output clobbers the file times on some systems. */
2101 if (emacs_close (ofd
) < 0)
2102 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2104 if (input_file_statable_p
)
2106 if (!NILP (keep_time
))
2108 EMACS_TIME atime
, mtime
;
2109 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2110 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2111 if (set_file_times (SDATA (encoded_newname
),
2113 xsignal2 (Qfile_date_error
,
2114 build_string ("Cannot set file date"), newname
);
2121 if (input_file_statable_p
)
2123 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2124 and if it can't, it tells so. Otherwise, under MSDOS we usually
2125 get only the READ bit, which will make the copied file read-only,
2126 so it's better not to chmod at all. */
2127 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2128 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2131 #endif /* not WINDOWSNT */
2133 /* Discard the unwind protects. */
2134 specpdl_ptr
= specpdl
+ count
;
2140 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2141 Smake_directory_internal
, 1, 1, 0,
2142 doc
: /* Create a new directory named DIRECTORY. */)
2144 Lisp_Object directory
;
2146 const unsigned char *dir
;
2147 Lisp_Object handler
;
2148 Lisp_Object encoded_dir
;
2150 CHECK_STRING (directory
);
2151 directory
= Fexpand_file_name (directory
, Qnil
);
2153 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2154 if (!NILP (handler
))
2155 return call2 (handler
, Qmake_directory_internal
, directory
);
2157 encoded_dir
= ENCODE_FILE (directory
);
2159 dir
= SDATA (encoded_dir
);
2162 if (mkdir (dir
) != 0)
2164 if (mkdir (dir
, 0777) != 0)
2166 report_file_error ("Creating directory", list1 (directory
));
2171 DEFUN ("delete-directory-internal", Fdelete_directory_internal
,
2172 Sdelete_directory_internal
, 1, 1, 0,
2173 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2175 Lisp_Object directory
;
2177 const unsigned char *dir
;
2178 Lisp_Object handler
;
2179 Lisp_Object encoded_dir
;
2181 CHECK_STRING (directory
);
2182 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2184 if (delete_by_moving_to_trash
)
2185 return call1 (Qmove_file_to_trash
, directory
);
2187 encoded_dir
= ENCODE_FILE (directory
);
2189 dir
= SDATA (encoded_dir
);
2191 if (rmdir (dir
) != 0)
2192 report_file_error ("Removing directory", list1 (directory
));
2197 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 2,
2198 "(list (read-file-name \"Delete file: \" nil default-directory \
2199 (confirm-nonexistent-file-or-buffer)) \
2200 current-prefix-arg)",
2201 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2202 If file has multiple names, it continues to exist with the other names.
2204 If optional arg FORCE is non-nil, really delete the file regardless of
2205 `delete-by-moving-to-trash'. Otherwise, \"deleting\" actually moves
2206 it to the system's trash can if `delete-by-moving-to-trash' is non-nil.
2207 Interactively, FORCE is non-nil if called with a prefix arg. */)
2209 Lisp_Object filename
;
2212 Lisp_Object handler
;
2213 Lisp_Object encoded_file
;
2214 struct gcpro gcpro1
;
2217 if (!NILP (Ffile_directory_p (filename
))
2218 && NILP (Ffile_symlink_p (filename
)))
2219 xsignal2 (Qfile_error
,
2220 build_string ("Removing old name: is a directory"),
2223 filename
= Fexpand_file_name (filename
, Qnil
);
2225 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2226 if (!NILP (handler
))
2227 return call2 (handler
, Qdelete_file
, filename
);
2229 if (delete_by_moving_to_trash
&& NILP (force
))
2230 return call1 (Qmove_file_to_trash
, filename
);
2232 encoded_file
= ENCODE_FILE (filename
);
2234 if (0 > unlink (SDATA (encoded_file
)))
2235 report_file_error ("Removing old name", list1 (filename
));
2240 internal_delete_file_1 (ignore
)
2246 /* Delete file FILENAME, returning 1 if successful and 0 if failed.
2247 FORCE means to ignore `delete-by-moving-to-trash'. */
2250 internal_delete_file (Lisp_Object filename
, Lisp_Object force
)
2254 tem
= internal_condition_case_2 (Fdelete_file
, filename
, force
,
2255 Qt
, internal_delete_file_1
);
2259 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2260 "fRename file: \nGRename %s to file: \np",
2261 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2262 If file has names other than FILE, it continues to have those names.
2263 Signals a `file-already-exists' error if a file NEWNAME already exists
2264 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2265 A number as third arg means request confirmation if NEWNAME already exists.
2266 This is what happens in interactive use with M-x. */)
2267 (file
, newname
, ok_if_already_exists
)
2268 Lisp_Object file
, newname
, ok_if_already_exists
;
2270 Lisp_Object handler
;
2271 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2272 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2274 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2275 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2276 CHECK_STRING (file
);
2277 CHECK_STRING (newname
);
2278 file
= Fexpand_file_name (file
, Qnil
);
2280 if ((!NILP (Ffile_directory_p (newname
)))
2282 /* If the file names are identical but for the case,
2283 don't attempt to move directory to itself. */
2284 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2288 Lisp_Object fname
= NILP (Ffile_directory_p (file
))
2289 ? file
: Fdirectory_file_name (file
);
2290 newname
= Fexpand_file_name (Ffile_name_nondirectory (fname
), newname
);
2293 newname
= Fexpand_file_name (newname
, Qnil
);
2295 /* If the file name has special constructs in it,
2296 call the corresponding file handler. */
2297 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2299 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2300 if (!NILP (handler
))
2301 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2302 file
, newname
, ok_if_already_exists
));
2304 encoded_file
= ENCODE_FILE (file
);
2305 encoded_newname
= ENCODE_FILE (newname
);
2308 /* If the file names are identical but for the case, don't ask for
2309 confirmation: they simply want to change the letter-case of the
2311 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2313 if (NILP (ok_if_already_exists
)
2314 || INTEGERP (ok_if_already_exists
))
2315 barf_or_query_if_file_exists (newname
, "rename to it",
2316 INTEGERP (ok_if_already_exists
), 0, 0);
2317 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2323 symlink_target
= Ffile_symlink_p (file
);
2324 if (! NILP (symlink_target
))
2325 Fmake_symbolic_link (symlink_target
, newname
,
2326 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2329 if (!NILP (Ffile_directory_p (file
)))
2330 call4 (Qcopy_directory
, file
, newname
, Qt
, Qnil
);
2332 /* We have already prompted if it was an integer, so don't
2333 have copy-file prompt again. */
2334 Fcopy_file (file
, newname
,
2335 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2338 count
= SPECPDL_INDEX ();
2339 specbind (Qdelete_by_moving_to_trash
, Qnil
);
2341 if (!NILP (Ffile_directory_p (file
))
2343 && NILP (symlink_target
)
2346 call2 (Qdelete_directory
, file
, Qt
);
2348 Fdelete_file (file
, Qt
);
2349 unbind_to (count
, Qnil
);
2352 report_file_error ("Renaming", list2 (file
, newname
));
2358 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2359 "fAdd name to file: \nGName to add to %s: \np",
2360 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2361 Signals a `file-already-exists' error if a file NEWNAME already exists
2362 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2363 A number as third arg means request confirmation if NEWNAME already exists.
2364 This is what happens in interactive use with M-x. */)
2365 (file
, newname
, ok_if_already_exists
)
2366 Lisp_Object file
, newname
, ok_if_already_exists
;
2368 Lisp_Object handler
;
2369 Lisp_Object encoded_file
, encoded_newname
;
2370 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2372 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2373 encoded_file
= encoded_newname
= Qnil
;
2374 CHECK_STRING (file
);
2375 CHECK_STRING (newname
);
2376 file
= Fexpand_file_name (file
, Qnil
);
2378 if (!NILP (Ffile_directory_p (newname
)))
2379 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2381 newname
= Fexpand_file_name (newname
, Qnil
);
2383 /* If the file name has special constructs in it,
2384 call the corresponding file handler. */
2385 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2386 if (!NILP (handler
))
2387 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2388 newname
, ok_if_already_exists
));
2390 /* If the new name has special constructs in it,
2391 call the corresponding file handler. */
2392 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2393 if (!NILP (handler
))
2394 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2395 newname
, ok_if_already_exists
));
2397 encoded_file
= ENCODE_FILE (file
);
2398 encoded_newname
= ENCODE_FILE (newname
);
2400 if (NILP (ok_if_already_exists
)
2401 || INTEGERP (ok_if_already_exists
))
2402 barf_or_query_if_file_exists (newname
, "make it a new name",
2403 INTEGERP (ok_if_already_exists
), 0, 0);
2405 unlink (SDATA (newname
));
2406 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2407 report_file_error ("Adding new name", list2 (file
, newname
));
2413 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2414 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2415 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2416 Both args must be strings.
2417 Signals a `file-already-exists' error if a file LINKNAME already exists
2418 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2419 A number as third arg means request confirmation if LINKNAME already exists.
2420 This happens for interactive use with M-x. */)
2421 (filename
, linkname
, ok_if_already_exists
)
2422 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2424 Lisp_Object handler
;
2425 Lisp_Object encoded_filename
, encoded_linkname
;
2426 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2428 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2429 encoded_filename
= encoded_linkname
= Qnil
;
2430 CHECK_STRING (filename
);
2431 CHECK_STRING (linkname
);
2432 /* If the link target has a ~, we must expand it to get
2433 a truly valid file name. Otherwise, do not expand;
2434 we want to permit links to relative file names. */
2435 if (SREF (filename
, 0) == '~')
2436 filename
= Fexpand_file_name (filename
, Qnil
);
2438 if (!NILP (Ffile_directory_p (linkname
)))
2439 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2441 linkname
= Fexpand_file_name (linkname
, Qnil
);
2443 /* If the file name has special constructs in it,
2444 call the corresponding file handler. */
2445 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2446 if (!NILP (handler
))
2447 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2448 linkname
, ok_if_already_exists
));
2450 /* If the new link name has special constructs in it,
2451 call the corresponding file handler. */
2452 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2453 if (!NILP (handler
))
2454 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2455 linkname
, ok_if_already_exists
));
2458 encoded_filename
= ENCODE_FILE (filename
);
2459 encoded_linkname
= ENCODE_FILE (linkname
);
2461 if (NILP (ok_if_already_exists
)
2462 || INTEGERP (ok_if_already_exists
))
2463 barf_or_query_if_file_exists (linkname
, "make it a link",
2464 INTEGERP (ok_if_already_exists
), 0, 0);
2465 if (0 > symlink (SDATA (encoded_filename
),
2466 SDATA (encoded_linkname
)))
2468 /* If we didn't complain already, silently delete existing file. */
2469 if (errno
== EEXIST
)
2471 unlink (SDATA (encoded_linkname
));
2472 if (0 <= symlink (SDATA (encoded_filename
),
2473 SDATA (encoded_linkname
)))
2480 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2487 xsignal1 (Qfile_error
, build_string ("Symbolic links are not supported"));
2489 #endif /* S_IFLNK */
2493 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2495 doc
: /* Return t if file FILENAME specifies an absolute file name.
2496 On Unix, this is a name starting with a `/' or a `~'. */)
2498 Lisp_Object filename
;
2500 CHECK_STRING (filename
);
2501 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
2504 /* Return nonzero if file FILENAME exists and can be executed. */
2507 check_executable (filename
)
2511 int len
= strlen (filename
);
2514 if (stat (filename
, &st
) < 0)
2516 return ((st
.st_mode
& S_IEXEC
) != 0);
2517 #else /* not DOS_NT */
2518 #ifdef HAVE_EUIDACCESS
2519 return (euidaccess (filename
, 1) >= 0);
2521 /* Access isn't quite right because it uses the real uid
2522 and we really want to test with the effective uid.
2523 But Unix doesn't give us a right way to do it. */
2524 return (access (filename
, 1) >= 0);
2526 #endif /* not DOS_NT */
2529 /* Return nonzero if file FILENAME exists and can be written. */
2532 check_writable (filename
)
2537 if (stat (filename
, &st
) < 0)
2539 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2540 #else /* not MSDOS */
2541 #ifdef HAVE_EUIDACCESS
2542 return (euidaccess (filename
, 2) >= 0);
2544 /* Access isn't quite right because it uses the real uid
2545 and we really want to test with the effective uid.
2546 But Unix doesn't give us a right way to do it.
2547 Opening with O_WRONLY could work for an ordinary file,
2548 but would lose for directories. */
2549 return (access (filename
, 2) >= 0);
2551 #endif /* not MSDOS */
2554 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2555 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
2556 See also `file-readable-p' and `file-attributes'.
2557 This returns nil for a symlink to a nonexistent file.
2558 Use `file-symlink-p' to test for such links. */)
2560 Lisp_Object filename
;
2562 Lisp_Object absname
;
2563 Lisp_Object handler
;
2564 struct stat statbuf
;
2566 CHECK_STRING (filename
);
2567 absname
= Fexpand_file_name (filename
, Qnil
);
2569 /* If the file name has special constructs in it,
2570 call the corresponding file handler. */
2571 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2572 if (!NILP (handler
))
2573 return call2 (handler
, Qfile_exists_p
, absname
);
2575 absname
= ENCODE_FILE (absname
);
2577 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
2580 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2581 doc
: /* Return t if FILENAME can be executed by you.
2582 For a directory, this means you can access files in that directory. */)
2584 Lisp_Object filename
;
2586 Lisp_Object absname
;
2587 Lisp_Object handler
;
2589 CHECK_STRING (filename
);
2590 absname
= Fexpand_file_name (filename
, Qnil
);
2592 /* If the file name has special constructs in it,
2593 call the corresponding file handler. */
2594 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2595 if (!NILP (handler
))
2596 return call2 (handler
, Qfile_executable_p
, absname
);
2598 absname
= ENCODE_FILE (absname
);
2600 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
2603 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2604 doc
: /* Return t if file FILENAME exists and you can read it.
2605 See also `file-exists-p' and `file-attributes'. */)
2607 Lisp_Object filename
;
2609 Lisp_Object absname
;
2610 Lisp_Object handler
;
2613 struct stat statbuf
;
2615 CHECK_STRING (filename
);
2616 absname
= Fexpand_file_name (filename
, Qnil
);
2618 /* If the file name has special constructs in it,
2619 call the corresponding file handler. */
2620 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2621 if (!NILP (handler
))
2622 return call2 (handler
, Qfile_readable_p
, absname
);
2624 absname
= ENCODE_FILE (absname
);
2626 #if defined(DOS_NT) || defined(macintosh)
2627 /* Under MS-DOS, Windows, and Macintosh, open does not work for
2629 if (access (SDATA (absname
), 0) == 0)
2632 #else /* not DOS_NT and not macintosh */
2634 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2635 /* Opening a fifo without O_NONBLOCK can wait.
2636 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2637 except in the case of a fifo, on a system which handles it. */
2638 desc
= stat (SDATA (absname
), &statbuf
);
2641 if (S_ISFIFO (statbuf
.st_mode
))
2642 flags
|= O_NONBLOCK
;
2644 desc
= emacs_open (SDATA (absname
), flags
, 0);
2649 #endif /* not DOS_NT and not macintosh */
2652 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2654 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2655 doc
: /* Return t if file FILENAME can be written or created by you. */)
2657 Lisp_Object filename
;
2659 Lisp_Object absname
, dir
, encoded
;
2660 Lisp_Object handler
;
2661 struct stat statbuf
;
2663 CHECK_STRING (filename
);
2664 absname
= Fexpand_file_name (filename
, Qnil
);
2666 /* If the file name has special constructs in it,
2667 call the corresponding file handler. */
2668 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2669 if (!NILP (handler
))
2670 return call2 (handler
, Qfile_writable_p
, absname
);
2672 encoded
= ENCODE_FILE (absname
);
2673 if (stat (SDATA (encoded
), &statbuf
) >= 0)
2674 return (check_writable (SDATA (encoded
))
2677 dir
= Ffile_name_directory (absname
);
2680 dir
= Fdirectory_file_name (dir
);
2683 dir
= ENCODE_FILE (dir
);
2685 /* The read-only attribute of the parent directory doesn't affect
2686 whether a file or directory can be created within it. Some day we
2687 should check ACLs though, which do affect this. */
2688 if (stat (SDATA (dir
), &statbuf
) < 0)
2690 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2692 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
2697 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2698 doc
: /* Access file FILENAME, and get an error if that does not work.
2699 The second argument STRING is used in the error message.
2700 If there is no error, returns nil. */)
2702 Lisp_Object filename
, string
;
2704 Lisp_Object handler
, encoded_filename
, absname
;
2707 CHECK_STRING (filename
);
2708 absname
= Fexpand_file_name (filename
, Qnil
);
2710 CHECK_STRING (string
);
2712 /* If the file name has special constructs in it,
2713 call the corresponding file handler. */
2714 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
2715 if (!NILP (handler
))
2716 return call3 (handler
, Qaccess_file
, absname
, string
);
2718 encoded_filename
= ENCODE_FILE (absname
);
2720 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
2722 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
2728 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2729 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
2730 The value is the link target, as a string.
2731 Otherwise it returns nil.
2733 This function returns t when given the name of a symlink that
2734 points to a nonexistent file. */)
2736 Lisp_Object filename
;
2738 Lisp_Object handler
;
2740 CHECK_STRING (filename
);
2741 filename
= Fexpand_file_name (filename
, Qnil
);
2743 /* If the file name has special constructs in it,
2744 call the corresponding file handler. */
2745 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2746 if (!NILP (handler
))
2747 return call2 (handler
, Qfile_symlink_p
, filename
);
2756 filename
= ENCODE_FILE (filename
);
2763 buf
= (char *) xrealloc (buf
, bufsize
);
2764 bzero (buf
, bufsize
);
2767 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
2771 /* HP-UX reports ERANGE if buffer is too small. */
2772 if (errno
== ERANGE
)
2782 while (valsize
>= bufsize
);
2784 val
= make_string (buf
, valsize
);
2785 if (buf
[0] == '/' && index (buf
, ':'))
2786 val
= concat2 (build_string ("/:"), val
);
2788 val
= DECODE_FILE (val
);
2791 #else /* not S_IFLNK */
2793 #endif /* not S_IFLNK */
2796 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2797 doc
: /* Return t if FILENAME names an existing directory.
2798 Symbolic links to directories count as directories.
2799 See `file-symlink-p' to distinguish symlinks. */)
2801 Lisp_Object filename
;
2803 register Lisp_Object absname
;
2805 Lisp_Object handler
;
2807 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2809 /* If the file name has special constructs in it,
2810 call the corresponding file handler. */
2811 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2812 if (!NILP (handler
))
2813 return call2 (handler
, Qfile_directory_p
, absname
);
2815 absname
= ENCODE_FILE (absname
);
2817 if (stat (SDATA (absname
), &st
) < 0)
2819 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2822 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2823 doc
: /* Return t if file FILENAME names a directory you can open.
2824 For the value to be t, FILENAME must specify the name of a directory as a file,
2825 and the directory must allow you to open files in it. In order to use a
2826 directory as a buffer's current directory, this predicate must return true.
2827 A directory name spec may be given instead; then the value is t
2828 if the directory so specified exists and really is a readable and
2829 searchable directory. */)
2831 Lisp_Object filename
;
2833 Lisp_Object handler
;
2835 struct gcpro gcpro1
;
2837 /* If the file name has special constructs in it,
2838 call the corresponding file handler. */
2839 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2840 if (!NILP (handler
))
2841 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2844 tem
= (NILP (Ffile_directory_p (filename
))
2845 || NILP (Ffile_executable_p (filename
)));
2847 return tem
? Qnil
: Qt
;
2850 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2851 doc
: /* Return t if FILENAME names a regular file.
2852 This is the sort of file that holds an ordinary stream of data bytes.
2853 Symbolic links to regular files count as regular files.
2854 See `file-symlink-p' to distinguish symlinks. */)
2856 Lisp_Object filename
;
2858 register Lisp_Object absname
;
2860 Lisp_Object handler
;
2862 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2864 /* If the file name has special constructs in it,
2865 call the corresponding file handler. */
2866 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2867 if (!NILP (handler
))
2868 return call2 (handler
, Qfile_regular_p
, absname
);
2870 absname
= ENCODE_FILE (absname
);
2875 Lisp_Object tem
= Vw32_get_true_file_attributes
;
2877 /* Tell stat to use expensive method to get accurate info. */
2878 Vw32_get_true_file_attributes
= Qt
;
2879 result
= stat (SDATA (absname
), &st
);
2880 Vw32_get_true_file_attributes
= tem
;
2884 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2887 if (stat (SDATA (absname
), &st
) < 0)
2889 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2893 DEFUN ("file-selinux-context", Ffile_selinux_context
,
2894 Sfile_selinux_context
, 1, 1, 0,
2895 doc
: /* Return SELinux context of file named FILENAME,
2896 as a list ("user", "role", "type", "range"). Return (nil, nil, nil, nil)
2897 if file does not exist, is not accessible, or SELinux is disabled */)
2899 Lisp_Object filename
;
2901 Lisp_Object absname
;
2902 Lisp_Object values
[4];
2903 Lisp_Object handler
;
2905 security_context_t con
;
2910 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2912 /* If the file name has special constructs in it,
2913 call the corresponding file handler. */
2914 handler
= Ffind_file_name_handler (absname
, Qfile_selinux_context
);
2915 if (!NILP (handler
))
2916 return call2 (handler
, Qfile_selinux_context
, absname
);
2918 absname
= ENCODE_FILE (absname
);
2925 if (is_selinux_enabled ())
2927 conlength
= lgetfilecon (SDATA (absname
), &con
);
2930 context
= context_new (con
);
2931 if (context_user_get (context
))
2932 values
[0] = build_string (context_user_get (context
));
2933 if (context_role_get (context
))
2934 values
[1] = build_string (context_role_get (context
));
2935 if (context_type_get (context
))
2936 values
[2] = build_string (context_type_get (context
));
2937 if (context_range_get (context
))
2938 values
[3] = build_string (context_range_get (context
));
2939 context_free (context
);
2946 return Flist (sizeof(values
) / sizeof(values
[0]), values
);
2949 DEFUN ("set-file-selinux-context", Fset_file_selinux_context
,
2950 Sset_file_selinux_context
, 2, 2, 0,
2951 doc
: /* Set SELinux context of file named FILENAME to CONTEXT
2952 as a list ("user", "role", "type", "range"). Has no effect if SELinux
2955 Lisp_Object filename
, context
;
2957 Lisp_Object absname
, encoded_absname
;
2958 Lisp_Object handler
;
2959 Lisp_Object user
= CAR_SAFE (context
);
2960 Lisp_Object role
= CAR_SAFE (CDR_SAFE (context
));
2961 Lisp_Object type
= CAR_SAFE (CDR_SAFE (CDR_SAFE (context
)));
2962 Lisp_Object range
= CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context
))));
2964 security_context_t con
;
2965 int fail
, conlength
;
2966 context_t parsed_con
;
2969 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2971 /* If the file name has special constructs in it,
2972 call the corresponding file handler. */
2973 handler
= Ffind_file_name_handler (absname
, Qset_file_selinux_context
);
2974 if (!NILP (handler
))
2975 return call3 (handler
, Qset_file_selinux_context
, absname
, context
);
2977 encoded_absname
= ENCODE_FILE (absname
);
2980 if (is_selinux_enabled ())
2982 /* Get current file context. */
2983 conlength
= lgetfilecon (SDATA (encoded_absname
), &con
);
2986 parsed_con
= context_new (con
);
2987 /* Change the parts defined in the parameter.*/
2990 if (context_user_set (parsed_con
, SDATA (user
)))
2991 error ("Doing context_user_set");
2995 if (context_role_set (parsed_con
, SDATA (role
)))
2996 error ("Doing context_role_set");
3000 if (context_type_set (parsed_con
, SDATA (type
)))
3001 error ("Doing context_type_set");
3003 if (STRINGP (range
))
3005 if (context_range_set (parsed_con
, SDATA (range
)))
3006 error ("Doing context_range_set");
3009 /* Set the modified context back to the file. */
3010 fail
= lsetfilecon (SDATA (encoded_absname
), context_str (parsed_con
));
3012 report_file_error ("Doing lsetfilecon", Fcons (absname
, Qnil
));
3014 context_free (parsed_con
);
3017 report_file_error("Doing lgetfilecon", Fcons (absname
, Qnil
));
3027 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3028 doc
: /* Return mode bits of file named FILENAME, as an integer.
3029 Return nil, if file does not exist or is not accessible. */)
3031 Lisp_Object filename
;
3033 Lisp_Object absname
;
3035 Lisp_Object handler
;
3037 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3039 /* If the file name has special constructs in it,
3040 call the corresponding file handler. */
3041 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3042 if (!NILP (handler
))
3043 return call2 (handler
, Qfile_modes
, absname
);
3045 absname
= ENCODE_FILE (absname
);
3047 if (stat (SDATA (absname
), &st
) < 0)
3050 return make_number (st
.st_mode
& 07777);
3053 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
3054 "(let ((file (read-file-name \"File: \"))) \
3055 (list file (read-file-modes nil file)))",
3056 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3057 Only the 12 low bits of MODE are used.
3059 Interactively, mode bits are read by `read-file-modes', which accepts
3060 symbolic notation, like the `chmod' command from GNU Coreutils. */)
3062 Lisp_Object filename
, mode
;
3064 Lisp_Object absname
, encoded_absname
;
3065 Lisp_Object handler
;
3067 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3068 CHECK_NUMBER (mode
);
3070 /* If the file name has special constructs in it,
3071 call the corresponding file handler. */
3072 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3073 if (!NILP (handler
))
3074 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3076 encoded_absname
= ENCODE_FILE (absname
);
3078 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3079 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3084 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3085 doc
: /* Set the file permission bits for newly created files.
3086 The argument MODE should be an integer; only the low 9 bits are used.
3087 This setting is inherited by subprocesses. */)
3091 CHECK_NUMBER (mode
);
3093 umask ((~ XINT (mode
)) & 0777);
3098 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3099 doc
: /* Return the default file protection for created files.
3100 The value is an integer. */)
3106 realmask
= umask (0);
3109 XSETINT (value
, (~ realmask
) & 0777);
3113 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3115 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3116 doc
: /* Set times of file FILENAME to TIME.
3117 Set both access and modification times.
3118 Return t on success, else nil.
3119 Use the current time if TIME is nil. TIME is in the format of
3122 Lisp_Object filename
, time
;
3124 Lisp_Object absname
, encoded_absname
;
3125 Lisp_Object handler
;
3129 if (! lisp_time_argument (time
, &sec
, &usec
))
3130 error ("Invalid time specification");
3132 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3134 /* If the file name has special constructs in it,
3135 call the corresponding file handler. */
3136 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3137 if (!NILP (handler
))
3138 return call3 (handler
, Qset_file_times
, absname
, time
);
3140 encoded_absname
= ENCODE_FILE (absname
);
3145 EMACS_SET_SECS (t
, sec
);
3146 EMACS_SET_USECS (t
, usec
);
3148 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3153 /* Setting times on a directory always fails. */
3154 if (stat (SDATA (encoded_absname
), &st
) == 0
3155 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3158 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3167 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3168 doc
: /* Tell Unix to finish all pending disk updates. */)
3175 #endif /* HAVE_SYNC */
3177 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3178 doc
: /* Return t if file FILE1 is newer than file FILE2.
3179 If FILE1 does not exist, the answer is nil;
3180 otherwise, if FILE2 does not exist, the answer is t. */)
3182 Lisp_Object file1
, file2
;
3184 Lisp_Object absname1
, absname2
;
3187 Lisp_Object handler
;
3188 struct gcpro gcpro1
, gcpro2
;
3190 CHECK_STRING (file1
);
3191 CHECK_STRING (file2
);
3194 GCPRO2 (absname1
, file2
);
3195 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3196 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3199 /* If the file name has special constructs in it,
3200 call the corresponding file handler. */
3201 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3203 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3204 if (!NILP (handler
))
3205 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3207 GCPRO2 (absname1
, absname2
);
3208 absname1
= ENCODE_FILE (absname1
);
3209 absname2
= ENCODE_FILE (absname2
);
3212 if (stat (SDATA (absname1
), &st
) < 0)
3215 mtime1
= st
.st_mtime
;
3217 if (stat (SDATA (absname2
), &st
) < 0)
3220 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3224 Lisp_Object Qfind_buffer_file_type
;
3227 #ifndef READ_BUF_SIZE
3228 #define READ_BUF_SIZE (64 << 10)
3231 /* This function is called after Lisp functions to decide a coding
3232 system are called, or when they cause an error. Before they are
3233 called, the current buffer is set unibyte and it contains only a
3234 newly inserted text (thus the buffer was empty before the
3237 The functions may set markers, overlays, text properties, or even
3238 alter the buffer contents, change the current buffer.
3240 Here, we reset all those changes by:
3241 o set back the current buffer.
3242 o move all markers and overlays to BEG.
3243 o remove all text properties.
3244 o set back the buffer multibyteness. */
3247 decide_coding_unwind (unwind_data
)
3248 Lisp_Object unwind_data
;
3250 Lisp_Object multibyte
, undo_list
, buffer
;
3252 multibyte
= XCAR (unwind_data
);
3253 unwind_data
= XCDR (unwind_data
);
3254 undo_list
= XCAR (unwind_data
);
3255 buffer
= XCDR (unwind_data
);
3257 if (current_buffer
!= XBUFFER (buffer
))
3258 set_buffer_internal (XBUFFER (buffer
));
3259 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3260 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3261 BUF_INTERVALS (current_buffer
) = 0;
3262 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3264 /* Now we are safe to change the buffer's multibyteness directly. */
3265 current_buffer
->enable_multibyte_characters
= multibyte
;
3266 current_buffer
->undo_list
= undo_list
;
3272 /* Used to pass values from insert-file-contents to read_non_regular. */
3274 static int non_regular_fd
;
3275 static EMACS_INT non_regular_inserted
;
3276 static EMACS_INT non_regular_nbytes
;
3279 /* Read from a non-regular file.
3280 Read non_regular_trytry bytes max from non_regular_fd.
3281 Non_regular_inserted specifies where to put the read bytes.
3282 Value is the number of bytes read. */
3291 nbytes
= emacs_read (non_regular_fd
,
3292 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3293 non_regular_nbytes
);
3295 return make_number (nbytes
);
3299 /* Condition-case handler used when reading from non-regular files
3300 in insert-file-contents. */
3303 read_non_regular_quit ()
3309 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3311 doc
: /* Insert contents of file FILENAME after point.
3312 Returns list of absolute file name and number of characters inserted.
3313 If second argument VISIT is non-nil, the buffer's visited filename and
3314 last save file modtime are set, and it is marked unmodified. If
3315 visiting and the file does not exist, visiting is completed before the
3318 The optional third and fourth arguments BEG and END specify what portion
3319 of the file to insert. These arguments count bytes in the file, not
3320 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3322 If optional fifth argument REPLACE is non-nil, replace the current
3323 buffer contents (in the accessible portion) with the file contents.
3324 This is better than simply deleting and inserting the whole thing
3325 because (1) it preserves some marker positions and (2) it puts less data
3326 in the undo list. When REPLACE is non-nil, the second return value is
3327 the number of characters that replace previous buffer contents.
3329 This function does code conversion according to the value of
3330 `coding-system-for-read' or `file-coding-system-alist', and sets the
3331 variable `last-coding-system-used' to the coding system actually used. */)
3332 (filename
, visit
, beg
, end
, replace
)
3333 Lisp_Object filename
, visit
, beg
, end
, replace
;
3337 EMACS_INT inserted
= 0;
3339 register EMACS_INT how_much
;
3340 register EMACS_INT unprocessed
;
3341 int count
= SPECPDL_INDEX ();
3342 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3343 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3345 EMACS_INT total
= 0;
3346 int not_regular
= 0;
3347 unsigned char read_buf
[READ_BUF_SIZE
];
3348 struct coding_system coding
;
3349 unsigned char buffer
[1 << 14];
3350 int replace_handled
= 0;
3351 int set_coding_system
= 0;
3352 Lisp_Object coding_system
;
3354 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3355 int we_locked_file
= 0;
3356 int deferred_remove_unwind_protect
= 0;
3358 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3359 error ("Cannot do file visiting in an indirect buffer");
3361 if (!NILP (current_buffer
->read_only
))
3362 Fbarf_if_buffer_read_only ();
3366 orig_filename
= Qnil
;
3369 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3371 CHECK_STRING (filename
);
3372 filename
= Fexpand_file_name (filename
, Qnil
);
3374 /* The value Qnil means that the coding system is not yet
3376 coding_system
= Qnil
;
3378 /* If the file name has special constructs in it,
3379 call the corresponding file handler. */
3380 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3381 if (!NILP (handler
))
3383 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3384 visit
, beg
, end
, replace
);
3385 if (CONSP (val
) && CONSP (XCDR (val
)))
3386 inserted
= XINT (XCAR (XCDR (val
)));
3390 orig_filename
= filename
;
3391 filename
= ENCODE_FILE (filename
);
3397 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3399 /* Tell stat to use expensive method to get accurate info. */
3400 Vw32_get_true_file_attributes
= Qt
;
3401 total
= stat (SDATA (filename
), &st
);
3402 Vw32_get_true_file_attributes
= tem
;
3406 if (stat (SDATA (filename
), &st
) < 0)
3407 #endif /* WINDOWSNT */
3409 if (fd
>= 0) emacs_close (fd
);
3412 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3415 if (!NILP (Vcoding_system_for_read
))
3416 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3421 /* This code will need to be changed in order to work on named
3422 pipes, and it's probably just not worth it. So we should at
3423 least signal an error. */
3424 if (!S_ISREG (st
.st_mode
))
3431 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3432 xsignal2 (Qfile_error
,
3433 build_string ("not a regular file"), orig_filename
);
3438 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3441 /* Replacement should preserve point as it preserves markers. */
3442 if (!NILP (replace
))
3443 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3445 record_unwind_protect (close_file_unwind
, make_number (fd
));
3447 /* Can happen on any platform that uses long as type of off_t, but allows
3448 file sizes to exceed 2Gb, so give a suitable message. */
3449 if (! not_regular
&& st
.st_size
< 0)
3450 error ("Maximum buffer size exceeded");
3452 /* Prevent redisplay optimizations. */
3453 current_buffer
->clip_changed
= 1;
3457 if (!NILP (beg
) || !NILP (end
))
3458 error ("Attempt to visit less than an entire file");
3459 if (BEG
< Z
&& NILP (replace
))
3460 error ("Cannot do file visiting in a non-empty buffer");
3466 XSETFASTINT (beg
, 0);
3474 XSETINT (end
, st
.st_size
);
3476 /* Arithmetic overflow can occur if an Emacs integer cannot
3477 represent the file size, or if the calculations below
3478 overflow. The calculations below double the file size
3479 twice, so check that it can be multiplied by 4 safely. */
3480 if (XINT (end
) != st
.st_size
3481 /* Actually, it should test either INT_MAX or LONG_MAX
3482 depending on which one is used for EMACS_INT. But in
3483 any case, in practice, this test is redundant with the
3485 || st.st_size > INT_MAX / 4 */)
3486 error ("Maximum buffer size exceeded");
3488 /* The file size returned from stat may be zero, but data
3489 may be readable nonetheless, for example when this is a
3490 file in the /proc filesystem. */
3491 if (st
.st_size
== 0)
3492 XSETINT (end
, READ_BUF_SIZE
);
3496 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3498 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3499 setup_coding_system (coding_system
, &coding
);
3500 /* Ensure we set Vlast_coding_system_used. */
3501 set_coding_system
= 1;
3505 /* Decide the coding system to use for reading the file now
3506 because we can't use an optimized method for handling
3507 `coding:' tag if the current buffer is not empty. */
3508 if (!NILP (Vcoding_system_for_read
))
3509 coding_system
= Vcoding_system_for_read
;
3512 /* Don't try looking inside a file for a coding system
3513 specification if it is not seekable. */
3514 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3516 /* Find a coding system specified in the heading two
3517 lines or in the tailing several lines of the file.
3518 We assume that the 1K-byte and 3K-byte for heading
3519 and tailing respectively are sufficient for this
3523 if (st
.st_size
<= (1024 * 4))
3524 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3527 nread
= emacs_read (fd
, read_buf
, 1024);
3530 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3531 report_file_error ("Setting file position",
3532 Fcons (orig_filename
, Qnil
));
3533 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3538 error ("IO error reading %s: %s",
3539 SDATA (orig_filename
), emacs_strerror (errno
));
3542 struct buffer
*prev
= current_buffer
;
3546 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3548 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3549 buf
= XBUFFER (buffer
);
3551 delete_all_overlays (buf
);
3552 buf
->directory
= current_buffer
->directory
;
3553 buf
->read_only
= Qnil
;
3554 buf
->filename
= Qnil
;
3555 buf
->undo_list
= Qt
;
3556 eassert (buf
->overlays_before
== NULL
);
3557 eassert (buf
->overlays_after
== NULL
);
3559 set_buffer_internal (buf
);
3561 buf
->enable_multibyte_characters
= Qnil
;
3563 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3564 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3565 coding_system
= call2 (Vset_auto_coding_function
,
3566 filename
, make_number (nread
));
3567 set_buffer_internal (prev
);
3569 /* Discard the unwind protect for recovering the
3573 /* Rewind the file for the actual read done later. */
3574 if (lseek (fd
, 0, 0) < 0)
3575 report_file_error ("Setting file position",
3576 Fcons (orig_filename
, Qnil
));
3580 if (NILP (coding_system
))
3582 /* If we have not yet decided a coding system, check
3583 file-coding-system-alist. */
3584 Lisp_Object args
[6];
3586 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3587 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3588 coding_system
= Ffind_operation_coding_system (6, args
);
3589 if (CONSP (coding_system
))
3590 coding_system
= XCAR (coding_system
);
3594 if (NILP (coding_system
))
3595 coding_system
= Qundecided
;
3597 CHECK_CODING_SYSTEM (coding_system
);
3599 if (NILP (current_buffer
->enable_multibyte_characters
))
3600 /* We must suppress all character code conversion except for
3601 end-of-line conversion. */
3602 coding_system
= raw_text_coding_system (coding_system
);
3604 setup_coding_system (coding_system
, &coding
);
3605 /* Ensure we set Vlast_coding_system_used. */
3606 set_coding_system
= 1;
3609 /* If requested, replace the accessible part of the buffer
3610 with the file contents. Avoid replacing text at the
3611 beginning or end of the buffer that matches the file contents;
3612 that preserves markers pointing to the unchanged parts.
3614 Here we implement this feature in an optimized way
3615 for the case where code conversion is NOT needed.
3616 The following if-statement handles the case of conversion
3617 in a less optimal way.
3619 If the code conversion is "automatic" then we try using this
3620 method and hope for the best.
3621 But if we discover the need for conversion, we give up on this method
3622 and let the following if-statement handle the replace job. */
3625 && (NILP (coding_system
)
3626 || ! CODING_REQUIRE_DECODING (&coding
)))
3628 /* same_at_start and same_at_end count bytes,
3629 because file access counts bytes
3630 and BEG and END count bytes. */
3631 EMACS_INT same_at_start
= BEGV_BYTE
;
3632 EMACS_INT same_at_end
= ZV_BYTE
;
3634 /* There is still a possibility we will find the need to do code
3635 conversion. If that happens, we set this variable to 1 to
3636 give up on handling REPLACE in the optimized way. */
3637 int giveup_match_end
= 0;
3639 if (XINT (beg
) != 0)
3641 if (lseek (fd
, XINT (beg
), 0) < 0)
3642 report_file_error ("Setting file position",
3643 Fcons (orig_filename
, Qnil
));
3648 /* Count how many chars at the start of the file
3649 match the text at the beginning of the buffer. */
3652 EMACS_INT nread
, bufpos
;
3654 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3656 error ("IO error reading %s: %s",
3657 SDATA (orig_filename
), emacs_strerror (errno
));
3658 else if (nread
== 0)
3661 if (CODING_REQUIRE_DETECTION (&coding
))
3663 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
3665 setup_coding_system (coding_system
, &coding
);
3668 if (CODING_REQUIRE_DECODING (&coding
))
3669 /* We found that the file should be decoded somehow.
3670 Let's give up here. */
3672 giveup_match_end
= 1;
3677 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3678 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3679 same_at_start
++, bufpos
++;
3680 /* If we found a discrepancy, stop the scan.
3681 Otherwise loop around and scan the next bufferful. */
3682 if (bufpos
!= nread
)
3686 /* If the file matches the buffer completely,
3687 there's no need to replace anything. */
3688 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3692 /* Truncate the buffer to the size of the file. */
3693 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3698 /* Count how many chars at the end of the file
3699 match the text at the end of the buffer. But, if we have
3700 already found that decoding is necessary, don't waste time. */
3701 while (!giveup_match_end
)
3703 EMACS_INT total_read
, nread
, bufpos
, curpos
, trial
;
3705 /* At what file position are we now scanning? */
3706 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3707 /* If the entire file matches the buffer tail, stop the scan. */
3710 /* How much can we scan in the next step? */
3711 trial
= min (curpos
, sizeof buffer
);
3712 if (lseek (fd
, curpos
- trial
, 0) < 0)
3713 report_file_error ("Setting file position",
3714 Fcons (orig_filename
, Qnil
));
3716 total_read
= nread
= 0;
3717 while (total_read
< trial
)
3719 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3721 error ("IO error reading %s: %s",
3722 SDATA (orig_filename
), emacs_strerror (errno
));
3723 else if (nread
== 0)
3725 total_read
+= nread
;
3728 /* Scan this bufferful from the end, comparing with
3729 the Emacs buffer. */
3730 bufpos
= total_read
;
3732 /* Compare with same_at_start to avoid counting some buffer text
3733 as matching both at the file's beginning and at the end. */
3734 while (bufpos
> 0 && same_at_end
> same_at_start
3735 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3736 same_at_end
--, bufpos
--;
3738 /* If we found a discrepancy, stop the scan.
3739 Otherwise loop around and scan the preceding bufferful. */
3742 /* If this discrepancy is because of code conversion,
3743 we cannot use this method; giveup and try the other. */
3744 if (same_at_end
> same_at_start
3745 && FETCH_BYTE (same_at_end
- 1) >= 0200
3746 && ! NILP (current_buffer
->enable_multibyte_characters
)
3747 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3748 giveup_match_end
= 1;
3757 if (! giveup_match_end
)
3761 /* We win! We can handle REPLACE the optimized way. */
3763 /* Extend the start of non-matching text area to multibyte
3764 character boundary. */
3765 if (! NILP (current_buffer
->enable_multibyte_characters
))
3766 while (same_at_start
> BEGV_BYTE
3767 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3770 /* Extend the end of non-matching text area to multibyte
3771 character boundary. */
3772 if (! NILP (current_buffer
->enable_multibyte_characters
))
3773 while (same_at_end
< ZV_BYTE
3774 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3777 /* Don't try to reuse the same piece of text twice. */
3778 overlap
= (same_at_start
- BEGV_BYTE
3779 - (same_at_end
+ st
.st_size
- ZV
));
3781 same_at_end
+= overlap
;
3783 /* Arrange to read only the nonmatching middle part of the file. */
3784 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3785 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3787 del_range_byte (same_at_start
, same_at_end
, 0);
3788 /* Insert from the file at the proper position. */
3789 temp
= BYTE_TO_CHAR (same_at_start
);
3790 SET_PT_BOTH (temp
, same_at_start
);
3792 /* If display currently starts at beginning of line,
3793 keep it that way. */
3794 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3795 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3797 replace_handled
= 1;
3801 /* If requested, replace the accessible part of the buffer
3802 with the file contents. Avoid replacing text at the
3803 beginning or end of the buffer that matches the file contents;
3804 that preserves markers pointing to the unchanged parts.
3806 Here we implement this feature for the case where code conversion
3807 is needed, in a simple way that needs a lot of memory.
3808 The preceding if-statement handles the case of no conversion
3809 in a more optimized way. */
3810 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3812 EMACS_INT same_at_start
= BEGV_BYTE
;
3813 EMACS_INT same_at_end
= ZV_BYTE
;
3814 EMACS_INT same_at_start_charpos
;
3815 EMACS_INT inserted_chars
;
3818 unsigned char *decoded
;
3820 int this_count
= SPECPDL_INDEX ();
3821 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3822 Lisp_Object conversion_buffer
;
3824 conversion_buffer
= code_conversion_save (1, multibyte
);
3826 /* First read the whole file, performing code conversion into
3827 CONVERSION_BUFFER. */
3829 if (lseek (fd
, XINT (beg
), 0) < 0)
3830 report_file_error ("Setting file position",
3831 Fcons (orig_filename
, Qnil
));
3833 total
= st
.st_size
; /* Total bytes in the file. */
3834 how_much
= 0; /* Bytes read from file so far. */
3835 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3836 unprocessed
= 0; /* Bytes not processed in previous loop. */
3838 GCPRO1 (conversion_buffer
);
3839 while (how_much
< total
)
3841 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
3842 quitting while reading a huge while. */
3843 /* try is reserved in some compilers (Microsoft C) */
3844 EMACS_INT trytry
= min (total
- how_much
,
3845 READ_BUF_SIZE
- unprocessed
);
3848 /* Allow quitting out of the actual I/O. */
3851 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
3863 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
3864 BUF_Z (XBUFFER (conversion_buffer
)));
3865 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
3867 unprocessed
= coding
.carryover_bytes
;
3868 if (coding
.carryover_bytes
> 0)
3869 bcopy (coding
.carryover
, read_buf
, unprocessed
);
3874 /* We should remove the unwind_protect calling
3875 close_file_unwind, but other stuff has been added the stack,
3876 so defer the removal till we reach the `handled' label. */
3877 deferred_remove_unwind_protect
= 1;
3879 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
3880 if we couldn't read the file. */
3883 error ("IO error reading %s: %s",
3884 SDATA (orig_filename
), emacs_strerror (errno
));
3886 if (unprocessed
> 0)
3888 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3889 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
3891 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
3894 coding_system
= CODING_ID_NAME (coding
.id
);
3895 set_coding_system
= 1;
3896 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
3897 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
3898 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3900 /* Compare the beginning of the converted string with the buffer
3904 while (bufpos
< inserted
&& same_at_start
< same_at_end
3905 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
3906 same_at_start
++, bufpos
++;
3908 /* If the file matches the head of buffer completely,
3909 there's no need to replace anything. */
3911 if (bufpos
== inserted
)
3913 /* Truncate the buffer to the size of the file. */
3914 if (same_at_start
== same_at_end
)
3917 del_range_byte (same_at_start
, same_at_end
, 0);
3920 unbind_to (this_count
, Qnil
);
3924 /* Extend the start of non-matching text area to the previous
3925 multibyte character boundary. */
3926 if (! NILP (current_buffer
->enable_multibyte_characters
))
3927 while (same_at_start
> BEGV_BYTE
3928 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3931 /* Scan this bufferful from the end, comparing with
3932 the Emacs buffer. */
3935 /* Compare with same_at_start to avoid counting some buffer text
3936 as matching both at the file's beginning and at the end. */
3937 while (bufpos
> 0 && same_at_end
> same_at_start
3938 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
3939 same_at_end
--, bufpos
--;
3941 /* Extend the end of non-matching text area to the next
3942 multibyte character boundary. */
3943 if (! NILP (current_buffer
->enable_multibyte_characters
))
3944 while (same_at_end
< ZV_BYTE
3945 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3948 /* Don't try to reuse the same piece of text twice. */
3949 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3951 same_at_end
+= overlap
;
3953 /* If display currently starts at beginning of line,
3954 keep it that way. */
3955 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3956 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3958 /* Replace the chars that we need to replace,
3959 and update INSERTED to equal the number of bytes
3960 we are taking from the decoded string. */
3961 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
3963 if (same_at_end
!= same_at_start
)
3965 del_range_byte (same_at_start
, same_at_end
, 0);
3967 same_at_start
= GPT_BYTE
;
3971 temp
= BYTE_TO_CHAR (same_at_start
);
3973 /* Insert from the file at the proper position. */
3974 SET_PT_BOTH (temp
, same_at_start
);
3975 same_at_start_charpos
3976 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3977 same_at_start
- BEGV_BYTE
3978 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3980 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3981 same_at_start
+ inserted
- BEGV_BYTE
3982 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
3983 - same_at_start_charpos
);
3984 /* This binding is to avoid ask-user-about-supersession-threat
3985 being called in insert_from_buffer (via in
3986 prepare_to_modify_buffer). */
3987 specbind (intern ("buffer-file-name"), Qnil
);
3988 insert_from_buffer (XBUFFER (conversion_buffer
),
3989 same_at_start_charpos
, inserted_chars
, 0);
3990 /* Set `inserted' to the number of inserted characters. */
3991 inserted
= PT
- temp
;
3992 /* Set point before the inserted characters. */
3993 SET_PT_BOTH (temp
, same_at_start
);
3995 unbind_to (this_count
, Qnil
);
4002 register Lisp_Object temp
;
4004 total
= XINT (end
) - XINT (beg
);
4006 /* Make sure point-max won't overflow after this insertion. */
4007 XSETINT (temp
, total
);
4008 if (total
!= XINT (temp
))
4009 error ("Maximum buffer size exceeded");
4012 /* For a special file, all we can do is guess. */
4013 total
= READ_BUF_SIZE
;
4015 if (NILP (visit
) && inserted
> 0)
4017 #ifdef CLASH_DETECTION
4018 if (!NILP (current_buffer
->file_truename
)
4019 /* Make binding buffer-file-name to nil effective. */
4020 && !NILP (current_buffer
->filename
)
4021 && SAVE_MODIFF
>= MODIFF
)
4023 #endif /* CLASH_DETECTION */
4024 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4028 if (GAP_SIZE
< total
)
4029 make_gap (total
- GAP_SIZE
);
4031 if (XINT (beg
) != 0 || !NILP (replace
))
4033 if (lseek (fd
, XINT (beg
), 0) < 0)
4034 report_file_error ("Setting file position",
4035 Fcons (orig_filename
, Qnil
));
4038 /* In the following loop, HOW_MUCH contains the total bytes read so
4039 far for a regular file, and not changed for a special file. But,
4040 before exiting the loop, it is set to a negative value if I/O
4044 /* Total bytes inserted. */
4047 /* Here, we don't do code conversion in the loop. It is done by
4048 decode_coding_gap after all data are read into the buffer. */
4050 EMACS_INT gap_size
= GAP_SIZE
;
4052 while (how_much
< total
)
4054 /* try is reserved in some compilers (Microsoft C) */
4055 EMACS_INT trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4062 /* Maybe make more room. */
4063 if (gap_size
< trytry
)
4065 make_gap (total
- gap_size
);
4066 gap_size
= GAP_SIZE
;
4069 /* Read from the file, capturing `quit'. When an
4070 error occurs, end the loop, and arrange for a quit
4071 to be signaled after decoding the text we read. */
4072 non_regular_fd
= fd
;
4073 non_regular_inserted
= inserted
;
4074 non_regular_nbytes
= trytry
;
4075 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4076 read_non_regular_quit
);
4087 /* Allow quitting out of the actual I/O. We don't make text
4088 part of the buffer until all the reading is done, so a C-g
4089 here doesn't do any harm. */
4092 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4104 /* For a regular file, where TOTAL is the real size,
4105 count HOW_MUCH to compare with it.
4106 For a special file, where TOTAL is just a buffer size,
4107 so don't bother counting in HOW_MUCH.
4108 (INSERTED is where we count the number of characters inserted.) */
4115 /* Now we have read all the file data into the gap.
4116 If it was empty, undo marking the buffer modified. */
4120 #ifdef CLASH_DETECTION
4122 unlock_file (current_buffer
->file_truename
);
4124 Vdeactivate_mark
= old_Vdeactivate_mark
;
4127 Vdeactivate_mark
= Qt
;
4129 /* Make the text read part of the buffer. */
4130 GAP_SIZE
-= inserted
;
4132 GPT_BYTE
+= inserted
;
4134 ZV_BYTE
+= inserted
;
4139 /* Put an anchor to ensure multi-byte form ends at gap. */
4144 /* Discard the unwind protect for closing the file. */
4148 error ("IO error reading %s: %s",
4149 SDATA (orig_filename
), emacs_strerror (errno
));
4153 if (NILP (coding_system
))
4155 /* The coding system is not yet decided. Decide it by an
4156 optimized method for handling `coding:' tag.
4158 Note that we can get here only if the buffer was empty
4159 before the insertion. */
4161 if (!NILP (Vcoding_system_for_read
))
4162 coding_system
= Vcoding_system_for_read
;
4165 /* Since we are sure that the current buffer was empty
4166 before the insertion, we can toggle
4167 enable-multibyte-characters directly here without taking
4168 care of marker adjustment. By this way, we can run Lisp
4169 program safely before decoding the inserted text. */
4170 Lisp_Object unwind_data
;
4171 int count
= SPECPDL_INDEX ();
4173 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4174 Fcons (current_buffer
->undo_list
,
4175 Fcurrent_buffer ()));
4176 current_buffer
->enable_multibyte_characters
= Qnil
;
4177 current_buffer
->undo_list
= Qt
;
4178 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4180 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4182 coding_system
= call2 (Vset_auto_coding_function
,
4183 filename
, make_number (inserted
));
4186 if (NILP (coding_system
))
4188 /* If the coding system is not yet decided, check
4189 file-coding-system-alist. */
4190 Lisp_Object args
[6];
4192 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4193 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4194 coding_system
= Ffind_operation_coding_system (6, args
);
4195 if (CONSP (coding_system
))
4196 coding_system
= XCAR (coding_system
);
4198 unbind_to (count
, Qnil
);
4199 inserted
= Z_BYTE
- BEG_BYTE
;
4202 if (NILP (coding_system
))
4203 coding_system
= Qundecided
;
4205 CHECK_CODING_SYSTEM (coding_system
);
4207 if (NILP (current_buffer
->enable_multibyte_characters
))
4208 /* We must suppress all character code conversion except for
4209 end-of-line conversion. */
4210 coding_system
= raw_text_coding_system (coding_system
);
4211 setup_coding_system (coding_system
, &coding
);
4212 /* Ensure we set Vlast_coding_system_used. */
4213 set_coding_system
= 1;
4218 /* When we visit a file by raw-text, we change the buffer to
4220 if (CODING_FOR_UNIBYTE (&coding
)
4221 /* Can't do this if part of the buffer might be preserved. */
4223 /* Visiting a file with these coding system makes the buffer
4225 current_buffer
->enable_multibyte_characters
= Qnil
;
4228 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4229 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4230 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4232 move_gap_both (PT
, PT_BYTE
);
4233 GAP_SIZE
+= inserted
;
4234 ZV_BYTE
-= inserted
;
4238 decode_coding_gap (&coding
, inserted
, inserted
);
4239 inserted
= coding
.produced_char
;
4240 coding_system
= CODING_ID_NAME (coding
.id
);
4242 else if (inserted
> 0)
4243 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4246 /* Now INSERTED is measured in characters. */
4249 /* Use the conversion type to determine buffer-file-type
4250 (find-buffer-file-type is now used to help determine the
4252 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4253 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4254 && ! CODING_REQUIRE_DECODING (&coding
))
4255 current_buffer
->buffer_file_type
= Qt
;
4257 current_buffer
->buffer_file_type
= Qnil
;
4262 if (deferred_remove_unwind_protect
)
4263 /* If requested above, discard the unwind protect for closing the
4269 if (!EQ (current_buffer
->undo_list
, Qt
) && !nochange
)
4270 current_buffer
->undo_list
= Qnil
;
4274 current_buffer
->modtime
= st
.st_mtime
;
4275 current_buffer
->modtime_size
= st
.st_size
;
4276 current_buffer
->filename
= orig_filename
;
4279 SAVE_MODIFF
= MODIFF
;
4280 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
4281 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4282 #ifdef CLASH_DETECTION
4285 if (!NILP (current_buffer
->file_truename
))
4286 unlock_file (current_buffer
->file_truename
);
4287 unlock_file (filename
);
4289 #endif /* CLASH_DETECTION */
4291 xsignal2 (Qfile_error
,
4292 build_string ("not a regular file"), orig_filename
);
4295 if (set_coding_system
)
4296 Vlast_coding_system_used
= coding_system
;
4298 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4300 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4302 if (! NILP (insval
))
4304 CHECK_NUMBER (insval
);
4305 inserted
= XFASTINT (insval
);
4309 /* Decode file format. */
4312 /* Don't run point motion or modification hooks when decoding. */
4313 int count
= SPECPDL_INDEX ();
4314 EMACS_INT old_inserted
= inserted
;
4315 specbind (Qinhibit_point_motion_hooks
, Qt
);
4316 specbind (Qinhibit_modification_hooks
, Qt
);
4318 /* Save old undo list and don't record undo for decoding. */
4319 old_undo
= current_buffer
->undo_list
;
4320 current_buffer
->undo_list
= Qt
;
4324 insval
= call3 (Qformat_decode
,
4325 Qnil
, make_number (inserted
), visit
);
4326 CHECK_NUMBER (insval
);
4327 inserted
= XFASTINT (insval
);
4331 /* If REPLACE is non-nil and we succeeded in not replacing the
4332 beginning or end of the buffer text with the file's contents,
4333 call format-decode with `point' positioned at the beginning
4334 of the buffer and `inserted' equalling the number of
4335 characters in the buffer. Otherwise, format-decode might
4336 fail to correctly analyze the beginning or end of the buffer.
4337 Hence we temporarily save `point' and `inserted' here and
4338 restore `point' iff format-decode did not insert or delete
4339 any text. Otherwise we leave `point' at point-min. */
4340 EMACS_INT opoint
= PT
;
4341 EMACS_INT opoint_byte
= PT_BYTE
;
4342 EMACS_INT oinserted
= ZV
- BEGV
;
4343 int ochars_modiff
= CHARS_MODIFF
;
4345 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4346 insval
= call3 (Qformat_decode
,
4347 Qnil
, make_number (oinserted
), visit
);
4348 CHECK_NUMBER (insval
);
4349 if (ochars_modiff
== CHARS_MODIFF
)
4350 /* format_decode didn't modify buffer's characters => move
4351 point back to position before inserted text and leave
4352 value of inserted alone. */
4353 SET_PT_BOTH (opoint
, opoint_byte
);
4355 /* format_decode modified buffer's characters => consider
4356 entire buffer changed and leave point at point-min. */
4357 inserted
= XFASTINT (insval
);
4360 /* For consistency with format-decode call these now iff inserted > 0
4361 (martin 2007-06-28). */
4362 p
= Vafter_insert_file_functions
;
4367 insval
= call1 (XCAR (p
), make_number (inserted
));
4370 CHECK_NUMBER (insval
);
4371 inserted
= XFASTINT (insval
);
4376 /* For the rationale of this see the comment on
4377 format-decode above. */
4378 EMACS_INT opoint
= PT
;
4379 EMACS_INT opoint_byte
= PT_BYTE
;
4380 EMACS_INT oinserted
= ZV
- BEGV
;
4381 int ochars_modiff
= CHARS_MODIFF
;
4383 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4384 insval
= call1 (XCAR (p
), make_number (oinserted
));
4387 CHECK_NUMBER (insval
);
4388 if (ochars_modiff
== CHARS_MODIFF
)
4389 /* after_insert_file_functions didn't modify
4390 buffer's characters => move point back to
4391 position before inserted text and leave value of
4393 SET_PT_BOTH (opoint
, opoint_byte
);
4395 /* after_insert_file_functions did modify buffer's
4396 characters => consider entire buffer changed and
4397 leave point at point-min. */
4398 inserted
= XFASTINT (insval
);
4408 current_buffer
->undo_list
= old_undo
;
4409 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4411 /* Adjust the last undo record for the size change during
4412 the format conversion. */
4413 Lisp_Object tem
= XCAR (old_undo
);
4414 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4415 && INTEGERP (XCDR (tem
))
4416 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4417 XSETCDR (tem
, make_number (PT
+ inserted
));
4421 /* If undo_list was Qt before, keep it that way.
4422 Otherwise start with an empty undo_list. */
4423 current_buffer
->undo_list
= EQ (old_undo
, Qt
) ? Qt
: Qnil
;
4425 unbind_to (count
, Qnil
);
4428 /* Call after-change hooks for the inserted text, aside from the case
4429 of normal visiting (not with REPLACE), which is done in a new buffer
4430 "before" the buffer is changed. */
4431 if (inserted
> 0 && total
> 0
4432 && (NILP (visit
) || !NILP (replace
)))
4434 signal_after_change (PT
, 0, inserted
);
4435 update_compositions (PT
, PT
, CHECK_BORDER
);
4439 && current_buffer
->modtime
== -1)
4441 /* If visiting nonexistent file, return nil. */
4442 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4446 Fsignal (Qquit
, Qnil
);
4448 /* ??? Retval needs to be dealt with in all cases consistently. */
4450 val
= Fcons (orig_filename
,
4451 Fcons (make_number (inserted
),
4454 RETURN_UNGCPRO (unbind_to (count
, val
));
4457 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4460 build_annotations_unwind (arg
)
4463 Vwrite_region_annotation_buffers
= arg
;
4467 /* Decide the coding-system to encode the data with. */
4470 choose_write_coding_system (start
, end
, filename
,
4471 append
, visit
, lockname
, coding
)
4472 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4473 struct coding_system
*coding
;
4476 Lisp_Object eol_parent
= Qnil
;
4479 && NILP (Fstring_equal (current_buffer
->filename
,
4480 current_buffer
->auto_save_file_name
)))
4485 else if (!NILP (Vcoding_system_for_write
))
4487 val
= Vcoding_system_for_write
;
4488 if (coding_system_require_warning
4489 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4490 /* Confirm that VAL can surely encode the current region. */
4491 val
= call5 (Vselect_safe_coding_system_function
,
4492 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4497 /* If the variable `buffer-file-coding-system' is set locally,
4498 it means that the file was read with some kind of code
4499 conversion or the variable is explicitly set by users. We
4500 had better write it out with the same coding system even if
4501 `enable-multibyte-characters' is nil.
4503 If it is not set locally, we anyway have to convert EOL
4504 format if the default value of `buffer-file-coding-system'
4505 tells that it is not Unix-like (LF only) format. */
4506 int using_default_coding
= 0;
4507 int force_raw_text
= 0;
4509 val
= current_buffer
->buffer_file_coding_system
;
4511 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4514 if (NILP (current_buffer
->enable_multibyte_characters
))
4520 /* Check file-coding-system-alist. */
4521 Lisp_Object args
[7], coding_systems
;
4523 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4524 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4526 coding_systems
= Ffind_operation_coding_system (7, args
);
4527 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4528 val
= XCDR (coding_systems
);
4533 /* If we still have not decided a coding system, use the
4534 default value of buffer-file-coding-system. */
4535 val
= current_buffer
->buffer_file_coding_system
;
4536 using_default_coding
= 1;
4539 if (! NILP (val
) && ! force_raw_text
)
4541 Lisp_Object spec
, attrs
;
4543 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4544 attrs
= AREF (spec
, 0);
4545 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4550 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4551 /* Confirm that VAL can surely encode the current region. */
4552 val
= call5 (Vselect_safe_coding_system_function
,
4553 start
, end
, val
, Qnil
, filename
);
4555 /* If the decided coding-system doesn't specify end-of-line
4556 format, we use that of
4557 `default-buffer-file-coding-system'. */
4558 if (! using_default_coding
4559 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4560 val
= (coding_inherit_eol_type
4561 (val
, buffer_defaults
.buffer_file_coding_system
));
4563 /* If we decide not to encode text, use `raw-text' or one of its
4566 val
= raw_text_coding_system (val
);
4569 val
= coding_inherit_eol_type (val
, eol_parent
);
4570 setup_coding_system (val
, coding
);
4572 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4573 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4577 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4578 "r\nFWrite region to file: \ni\ni\ni\np",
4579 doc
: /* Write current region into specified file.
4580 When called from a program, requires three arguments:
4581 START, END and FILENAME. START and END are normally buffer positions
4582 specifying the part of the buffer to write.
4583 If START is nil, that means to use the entire buffer contents.
4584 If START is a string, then output that string to the file
4585 instead of any buffer contents; END is ignored.
4587 Optional fourth argument APPEND if non-nil means
4588 append to existing file contents (if any). If it is an integer,
4589 seek to that offset in the file before writing.
4590 Optional fifth argument VISIT, if t or a string, means
4591 set the last-save-file-modtime of buffer to this file's modtime
4592 and mark buffer not modified.
4593 If VISIT is a string, it is a second file name;
4594 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4595 VISIT is also the file name to lock and unlock for clash detection.
4596 If VISIT is neither t nor nil nor a string,
4597 that means do not display the \"Wrote file\" message.
4598 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4599 use for locking and unlocking, overriding FILENAME and VISIT.
4600 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4601 for an existing file with the same name. If MUSTBENEW is `excl',
4602 that means to get an error if the file already exists; never overwrite.
4603 If MUSTBENEW is neither nil nor `excl', that means ask for
4604 confirmation before overwriting, but do go ahead and overwrite the file
4605 if the user confirms.
4607 This does code conversion according to the value of
4608 `coding-system-for-write', `buffer-file-coding-system', or
4609 `file-coding-system-alist', and sets the variable
4610 `last-coding-system-used' to the coding system actually used.
4612 This calls `write-region-annotate-functions' at the start, and
4613 `write-region-post-annotation-function' at the end. */)
4614 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4615 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4620 const unsigned char *fn
;
4622 int count
= SPECPDL_INDEX ();
4624 Lisp_Object handler
;
4625 Lisp_Object visit_file
;
4626 Lisp_Object annotations
;
4627 Lisp_Object encoded_filename
;
4628 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4629 int quietly
= !NILP (visit
);
4630 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4631 struct buffer
*given_buffer
;
4633 int buffer_file_type
= O_BINARY
;
4635 struct coding_system coding
;
4637 if (current_buffer
->base_buffer
&& visiting
)
4638 error ("Cannot do file visiting in an indirect buffer");
4640 if (!NILP (start
) && !STRINGP (start
))
4641 validate_region (&start
, &end
);
4644 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4646 filename
= Fexpand_file_name (filename
, Qnil
);
4648 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4649 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4651 if (STRINGP (visit
))
4652 visit_file
= Fexpand_file_name (visit
, Qnil
);
4654 visit_file
= filename
;
4656 if (NILP (lockname
))
4657 lockname
= visit_file
;
4661 /* If the file name has special constructs in it,
4662 call the corresponding file handler. */
4663 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4664 /* If FILENAME has no handler, see if VISIT has one. */
4665 if (NILP (handler
) && STRINGP (visit
))
4666 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4668 if (!NILP (handler
))
4671 val
= call6 (handler
, Qwrite_region
, start
, end
,
4672 filename
, append
, visit
);
4676 SAVE_MODIFF
= MODIFF
;
4677 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4678 current_buffer
->filename
= visit_file
;
4684 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4686 /* Special kludge to simplify auto-saving. */
4689 /* Do it later, so write-region-annotate-function can work differently
4690 if we save "the buffer" vs "a region".
4691 This is useful in tar-mode. --Stef
4692 XSETFASTINT (start, BEG);
4693 XSETFASTINT (end, Z); */
4697 record_unwind_protect (build_annotations_unwind
,
4698 Vwrite_region_annotation_buffers
);
4699 Vwrite_region_annotation_buffers
= Fcons (Fcurrent_buffer (), Qnil
);
4700 count1
= SPECPDL_INDEX ();
4702 given_buffer
= current_buffer
;
4704 if (!STRINGP (start
))
4706 annotations
= build_annotations (start
, end
);
4708 if (current_buffer
!= given_buffer
)
4710 XSETFASTINT (start
, BEGV
);
4711 XSETFASTINT (end
, ZV
);
4717 XSETFASTINT (start
, BEGV
);
4718 XSETFASTINT (end
, ZV
);
4723 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4725 /* Decide the coding-system to encode the data with.
4726 We used to make this choice before calling build_annotations, but that
4727 leads to problems when a write-annotate-function takes care of
4728 unsavable chars (as was the case with X-Symbol). */
4729 Vlast_coding_system_used
4730 = choose_write_coding_system (start
, end
, filename
,
4731 append
, visit
, lockname
, &coding
);
4733 #ifdef CLASH_DETECTION
4735 lock_file (lockname
);
4736 #endif /* CLASH_DETECTION */
4738 encoded_filename
= ENCODE_FILE (filename
);
4740 fn
= SDATA (encoded_filename
);
4744 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4745 #else /* not DOS_NT */
4746 desc
= emacs_open (fn
, O_WRONLY
, 0);
4747 #endif /* not DOS_NT */
4749 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4751 desc
= emacs_open (fn
,
4752 O_WRONLY
| O_CREAT
| buffer_file_type
4753 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4754 S_IREAD
| S_IWRITE
);
4755 #else /* not DOS_NT */
4756 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4757 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4758 auto_saving
? auto_save_mode_bits
: 0666);
4759 #endif /* not DOS_NT */
4763 #ifdef CLASH_DETECTION
4765 if (!auto_saving
) unlock_file (lockname
);
4767 #endif /* CLASH_DETECTION */
4769 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4772 record_unwind_protect (close_file_unwind
, make_number (desc
));
4774 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4778 if (NUMBERP (append
))
4779 ret
= lseek (desc
, XINT (append
), 1);
4781 ret
= lseek (desc
, 0, 2);
4784 #ifdef CLASH_DETECTION
4785 if (!auto_saving
) unlock_file (lockname
);
4786 #endif /* CLASH_DETECTION */
4788 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4797 if (STRINGP (start
))
4799 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
4800 &annotations
, &coding
);
4803 else if (XINT (start
) != XINT (end
))
4805 failure
= 0 > a_write (desc
, Qnil
,
4806 XINT (start
), XINT (end
) - XINT (start
),
4807 &annotations
, &coding
);
4812 /* If file was empty, still need to write the annotations */
4813 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4814 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4818 if (CODING_REQUIRE_FLUSHING (&coding
)
4819 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4822 /* We have to flush out a data. */
4823 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4824 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
4831 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4832 Disk full in NFS may be reported here. */
4833 /* mib says that closing the file will try to write as fast as NFS can do
4834 it, and that means the fsync here is not crucial for autosave files. */
4835 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
4837 /* If fsync fails with EINTR, don't treat that as serious. Also
4838 ignore EINVAL which happens when fsync is not supported on this
4840 if (errno
!= EINTR
&& errno
!= EINVAL
)
4841 failure
= 1, save_errno
= errno
;
4845 /* NFS can report a write failure now. */
4846 if (emacs_close (desc
) < 0)
4847 failure
= 1, save_errno
= errno
;
4851 /* Discard the unwind protect for close_file_unwind. */
4852 specpdl_ptr
= specpdl
+ count1
;
4854 /* Call write-region-post-annotation-function. */
4855 while (CONSP (Vwrite_region_annotation_buffers
))
4857 Lisp_Object buf
= XCAR (Vwrite_region_annotation_buffers
);
4858 if (!NILP (Fbuffer_live_p (buf
)))
4861 if (FUNCTIONP (Vwrite_region_post_annotation_function
))
4862 call0 (Vwrite_region_post_annotation_function
);
4864 Vwrite_region_annotation_buffers
4865 = XCDR (Vwrite_region_annotation_buffers
);
4868 unbind_to (count
, Qnil
);
4870 #ifdef CLASH_DETECTION
4872 unlock_file (lockname
);
4873 #endif /* CLASH_DETECTION */
4875 /* Do this before reporting IO error
4876 to avoid a "file has changed on disk" warning on
4877 next attempt to save. */
4880 current_buffer
->modtime
= st
.st_mtime
;
4881 current_buffer
->modtime_size
= st
.st_size
;
4885 error ("IO error writing %s: %s", SDATA (filename
),
4886 emacs_strerror (save_errno
));
4890 SAVE_MODIFF
= MODIFF
;
4891 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4892 current_buffer
->filename
= visit_file
;
4893 update_mode_lines
++;
4898 && ! NILP (Fstring_equal (current_buffer
->filename
,
4899 current_buffer
->auto_save_file_name
)))
4900 SAVE_MODIFF
= MODIFF
;
4906 message_with_string ((INTEGERP (append
)
4916 Lisp_Object
merge ();
4918 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4919 doc
: /* Return t if (car A) is numerically less than (car B). */)
4923 return Flss (Fcar (a
), Fcar (b
));
4926 /* Build the complete list of annotations appropriate for writing out
4927 the text between START and END, by calling all the functions in
4928 write-region-annotate-functions and merging the lists they return.
4929 If one of these functions switches to a different buffer, we assume
4930 that buffer contains altered text. Therefore, the caller must
4931 make sure to restore the current buffer in all cases,
4932 as save-excursion would do. */
4935 build_annotations (start
, end
)
4936 Lisp_Object start
, end
;
4938 Lisp_Object annotations
;
4940 struct gcpro gcpro1
, gcpro2
;
4941 Lisp_Object original_buffer
;
4942 int i
, used_global
= 0;
4944 XSETBUFFER (original_buffer
, current_buffer
);
4947 p
= Vwrite_region_annotate_functions
;
4948 GCPRO2 (annotations
, p
);
4951 struct buffer
*given_buffer
= current_buffer
;
4952 if (EQ (Qt
, XCAR (p
)) && !used_global
)
4953 { /* Use the global value of the hook. */
4956 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
4958 p
= Fappend (2, arg
);
4961 Vwrite_region_annotations_so_far
= annotations
;
4962 res
= call2 (XCAR (p
), start
, end
);
4963 /* If the function makes a different buffer current,
4964 assume that means this buffer contains altered text to be output.
4965 Reset START and END from the buffer bounds
4966 and discard all previous annotations because they should have
4967 been dealt with by this function. */
4968 if (current_buffer
!= given_buffer
)
4970 Vwrite_region_annotation_buffers
4971 = Fcons (Fcurrent_buffer (),
4972 Vwrite_region_annotation_buffers
);
4973 XSETFASTINT (start
, BEGV
);
4974 XSETFASTINT (end
, ZV
);
4977 Flength (res
); /* Check basic validity of return value */
4978 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4982 /* Now do the same for annotation functions implied by the file-format */
4983 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
4984 p
= current_buffer
->auto_save_file_format
;
4986 p
= current_buffer
->file_format
;
4987 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
4989 struct buffer
*given_buffer
= current_buffer
;
4991 Vwrite_region_annotations_so_far
= annotations
;
4993 /* Value is either a list of annotations or nil if the function
4994 has written annotations to a temporary buffer, which is now
4996 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
4997 original_buffer
, make_number (i
));
4998 if (current_buffer
!= given_buffer
)
5000 XSETFASTINT (start
, BEGV
);
5001 XSETFASTINT (end
, ZV
);
5006 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5014 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5015 If STRING is nil, POS is the character position in the current buffer.
5016 Intersperse with them the annotations from *ANNOT
5017 which fall within the range of POS to POS + NCHARS,
5018 each at its appropriate position.
5020 We modify *ANNOT by discarding elements as we use them up.
5022 The return value is negative in case of system call failure. */
5025 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5028 register int nchars
;
5031 struct coding_system
*coding
;
5035 int lastpos
= pos
+ nchars
;
5037 while (NILP (*annot
) || CONSP (*annot
))
5039 tem
= Fcar_safe (Fcar (*annot
));
5042 nextpos
= XFASTINT (tem
);
5044 /* If there are no more annotations in this range,
5045 output the rest of the range all at once. */
5046 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5047 return e_write (desc
, string
, pos
, lastpos
, coding
);
5049 /* Output buffer text up to the next annotation's position. */
5052 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5056 /* Output the annotation. */
5057 tem
= Fcdr (Fcar (*annot
));
5060 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5063 *annot
= Fcdr (*annot
);
5069 /* Write text in the range START and END into descriptor DESC,
5070 encoding them with coding system CODING. If STRING is nil, START
5071 and END are character positions of the current buffer, else they
5072 are indexes to the string STRING. */
5075 e_write (desc
, string
, start
, end
, coding
)
5079 struct coding_system
*coding
;
5081 if (STRINGP (string
))
5084 end
= SCHARS (string
);
5087 /* We used to have a code for handling selective display here. But,
5088 now it is handled within encode_coding. */
5092 if (STRINGP (string
))
5094 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5095 if (CODING_REQUIRE_ENCODING (coding
))
5097 encode_coding_object (coding
, string
,
5098 start
, string_char_to_byte (string
, start
),
5099 end
, string_char_to_byte (string
, end
), Qt
);
5103 coding
->dst_object
= string
;
5104 coding
->consumed_char
= SCHARS (string
);
5105 coding
->produced
= SBYTES (string
);
5110 int start_byte
= CHAR_TO_BYTE (start
);
5111 int end_byte
= CHAR_TO_BYTE (end
);
5113 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5114 if (CODING_REQUIRE_ENCODING (coding
))
5116 encode_coding_object (coding
, Fcurrent_buffer (),
5117 start
, start_byte
, end
, end_byte
, Qt
);
5121 coding
->dst_object
= Qnil
;
5122 coding
->dst_pos_byte
= start_byte
;
5123 if (start
>= GPT
|| end
<= GPT
)
5125 coding
->consumed_char
= end
- start
;
5126 coding
->produced
= end_byte
- start_byte
;
5130 coding
->consumed_char
= GPT
- start
;
5131 coding
->produced
= GPT_BYTE
- start_byte
;
5136 if (coding
->produced
> 0)
5140 STRINGP (coding
->dst_object
)
5141 ? SDATA (coding
->dst_object
)
5142 : BYTE_POS_ADDR (coding
->dst_pos_byte
),
5145 if (coding
->produced
)
5148 start
+= coding
->consumed_char
;
5154 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5155 Sverify_visited_file_modtime
, 1, 1, 0,
5156 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5157 This means that the file has not been changed since it was visited or saved.
5158 See Info node `(elisp)Modification Time' for more details. */)
5164 Lisp_Object handler
;
5165 Lisp_Object filename
;
5170 if (!STRINGP (b
->filename
)) return Qt
;
5171 if (b
->modtime
== 0) return Qt
;
5173 /* If the file name has special constructs in it,
5174 call the corresponding file handler. */
5175 handler
= Ffind_file_name_handler (b
->filename
,
5176 Qverify_visited_file_modtime
);
5177 if (!NILP (handler
))
5178 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5180 filename
= ENCODE_FILE (b
->filename
);
5182 if (stat (SDATA (filename
), &st
) < 0)
5184 /* If the file doesn't exist now and didn't exist before,
5185 we say that it isn't modified, provided the error is a tame one. */
5186 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5191 if ((st
.st_mtime
== b
->modtime
5192 /* If both are positive, accept them if they are off by one second. */
5193 || (st
.st_mtime
> 0 && b
->modtime
> 0
5194 && (st
.st_mtime
== b
->modtime
+ 1
5195 || st
.st_mtime
== b
->modtime
- 1)))
5196 && (st
.st_size
== b
->modtime_size
5197 || b
->modtime_size
< 0))
5202 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5203 Sclear_visited_file_modtime
, 0, 0, 0,
5204 doc
: /* Clear out records of last mod time of visited file.
5205 Next attempt to save will certainly not complain of a discrepancy. */)
5208 current_buffer
->modtime
= 0;
5209 current_buffer
->modtime_size
= -1;
5213 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5214 Svisited_file_modtime
, 0, 0, 0,
5215 doc
: /* Return the current buffer's recorded visited file modification time.
5216 The value is a list of the form (HIGH LOW), like the time values
5217 that `file-attributes' returns. If the current buffer has no recorded
5218 file modification time, this function returns 0.
5219 See Info node `(elisp)Modification Time' for more details. */)
5222 if (! current_buffer
->modtime
)
5223 return make_number (0);
5224 return make_time ((time_t) current_buffer
->modtime
);
5227 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5228 Sset_visited_file_modtime
, 0, 1, 0,
5229 doc
: /* Update buffer's recorded modification time from the visited file's time.
5230 Useful if the buffer was not read from the file normally
5231 or if the file itself has been changed for some known benign reason.
5232 An argument specifies the modification time value to use
5233 \(instead of that of the visited file), in the form of a list
5234 \(HIGH . LOW) or (HIGH LOW). */)
5236 Lisp_Object time_list
;
5238 if (!NILP (time_list
))
5240 current_buffer
->modtime
= cons_to_long (time_list
);
5241 current_buffer
->modtime_size
= -1;
5245 register Lisp_Object filename
;
5247 Lisp_Object handler
;
5249 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5251 /* If the file name has special constructs in it,
5252 call the corresponding file handler. */
5253 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5254 if (!NILP (handler
))
5255 /* The handler can find the file name the same way we did. */
5256 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5258 filename
= ENCODE_FILE (filename
);
5260 if (stat (SDATA (filename
), &st
) >= 0)
5262 current_buffer
->modtime
= st
.st_mtime
;
5263 current_buffer
->modtime_size
= st
.st_size
;
5271 auto_save_error (error
)
5274 Lisp_Object args
[3], msg
;
5276 struct gcpro gcpro1
;
5280 auto_save_error_occurred
= 1;
5282 ring_bell (XFRAME (selected_frame
));
5284 args
[0] = build_string ("Auto-saving %s: %s");
5285 args
[1] = current_buffer
->name
;
5286 args
[2] = Ferror_message_string (error
);
5287 msg
= Fformat (3, args
);
5289 nbytes
= SBYTES (msg
);
5290 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5291 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5293 for (i
= 0; i
< 3; ++i
)
5296 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5298 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5299 Fsleep_for (make_number (1), Qnil
);
5313 auto_save_mode_bits
= 0666;
5315 /* Get visited file's mode to become the auto save file's mode. */
5316 if (! NILP (current_buffer
->filename
))
5318 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5319 /* But make sure we can overwrite it later! */
5320 auto_save_mode_bits
= st
.st_mode
| 0600;
5321 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5323 /* Remote files don't cooperate with stat. */
5324 auto_save_mode_bits
= XINT (modes
) | 0600;
5328 Fwrite_region (Qnil
, Qnil
, current_buffer
->auto_save_file_name
, Qnil
,
5329 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5334 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5337 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5349 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5352 minibuffer_auto_raise
= XINT (value
);
5357 do_auto_save_make_dir (dir
)
5362 call2 (Qmake_directory
, dir
, Qt
);
5363 XSETFASTINT (mode
, 0700);
5364 return Fset_file_modes (dir
, mode
);
5368 do_auto_save_eh (ignore
)
5374 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5375 doc
: /* Auto-save all buffers that need it.
5376 This is all buffers that have auto-saving enabled
5377 and are changed since last auto-saved.
5378 Auto-saving writes the buffer into a file
5379 so that your editing is not lost if the system crashes.
5380 This file is not the file you visited; that changes only when you save.
5381 Normally we run the normal hook `auto-save-hook' before saving.
5383 A non-nil NO-MESSAGE argument means do not print any message if successful.
5384 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5385 (no_message
, current_only
)
5386 Lisp_Object no_message
, current_only
;
5388 struct buffer
*old
= current_buffer
, *b
;
5389 Lisp_Object tail
, buf
;
5391 int do_handled_files
;
5393 FILE *stream
= NULL
;
5394 int count
= SPECPDL_INDEX ();
5395 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5396 int old_message_p
= 0;
5397 struct gcpro gcpro1
, gcpro2
;
5399 if (max_specpdl_size
< specpdl_size
+ 40)
5400 max_specpdl_size
= specpdl_size
+ 40;
5405 if (NILP (no_message
))
5407 old_message_p
= push_message ();
5408 record_unwind_protect (pop_message_unwind
, Qnil
);
5411 /* Ordinarily don't quit within this function,
5412 but don't make it impossible to quit (in case we get hung in I/O). */
5416 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5417 point to non-strings reached from Vbuffer_alist. */
5419 if (!NILP (Vrun_hooks
))
5420 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5422 if (STRINGP (Vauto_save_list_file_name
))
5424 Lisp_Object listfile
;
5426 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5428 /* Don't try to create the directory when shutting down Emacs,
5429 because creating the directory might signal an error, and
5430 that would leave Emacs in a strange state. */
5431 if (!NILP (Vrun_hooks
))
5435 GCPRO2 (dir
, listfile
);
5436 dir
= Ffile_name_directory (listfile
);
5437 if (NILP (Ffile_directory_p (dir
)))
5438 internal_condition_case_1 (do_auto_save_make_dir
,
5439 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5444 stream
= fopen (SDATA (listfile
), "w");
5447 record_unwind_protect (do_auto_save_unwind
,
5448 make_save_value (stream
, 0));
5449 record_unwind_protect (do_auto_save_unwind_1
,
5450 make_number (minibuffer_auto_raise
));
5451 minibuffer_auto_raise
= 0;
5453 auto_save_error_occurred
= 0;
5455 /* On first pass, save all files that don't have handlers.
5456 On second pass, save all files that do have handlers.
5458 If Emacs is crashing, the handlers may tweak what is causing
5459 Emacs to crash in the first place, and it would be a shame if
5460 Emacs failed to autosave perfectly ordinary files because it
5461 couldn't handle some ange-ftp'd file. */
5463 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5464 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5466 buf
= XCDR (XCAR (tail
));
5469 /* Record all the buffers that have auto save mode
5470 in the special file that lists them. For each of these buffers,
5471 Record visited name (if any) and auto save name. */
5472 if (STRINGP (b
->auto_save_file_name
)
5473 && stream
!= NULL
&& do_handled_files
== 0)
5476 if (!NILP (b
->filename
))
5478 fwrite (SDATA (b
->filename
), 1,
5479 SBYTES (b
->filename
), stream
);
5481 putc ('\n', stream
);
5482 fwrite (SDATA (b
->auto_save_file_name
), 1,
5483 SBYTES (b
->auto_save_file_name
), stream
);
5484 putc ('\n', stream
);
5488 if (!NILP (current_only
)
5489 && b
!= current_buffer
)
5492 /* Don't auto-save indirect buffers.
5493 The base buffer takes care of it. */
5497 /* Check for auto save enabled
5498 and file changed since last auto save
5499 and file changed since last real save. */
5500 if (STRINGP (b
->auto_save_file_name
)
5501 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5502 && BUF_AUTOSAVE_MODIFF (b
) < BUF_MODIFF (b
)
5503 /* -1 means we've turned off autosaving for a while--see below. */
5504 && XINT (b
->save_length
) >= 0
5505 && (do_handled_files
5506 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5509 EMACS_TIME before_time
, after_time
;
5511 EMACS_GET_TIME (before_time
);
5513 /* If we had a failure, don't try again for 20 minutes. */
5514 if (b
->auto_save_failure_time
>= 0
5515 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5518 set_buffer_internal (b
);
5519 if (NILP (Vauto_save_include_big_deletions
)
5520 && (XFASTINT (b
->save_length
) * 10
5521 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5522 /* A short file is likely to change a large fraction;
5523 spare the user annoying messages. */
5524 && XFASTINT (b
->save_length
) > 5000
5525 /* These messages are frequent and annoying for `*mail*'. */
5526 && !EQ (b
->filename
, Qnil
)
5527 && NILP (no_message
))
5529 /* It has shrunk too much; turn off auto-saving here. */
5530 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5531 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5533 minibuffer_auto_raise
= 0;
5534 /* Turn off auto-saving until there's a real save,
5535 and prevent any more warnings. */
5536 XSETINT (b
->save_length
, -1);
5537 Fsleep_for (make_number (1), Qnil
);
5540 if (!auto_saved
&& NILP (no_message
))
5541 message1 ("Auto-saving...");
5542 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5544 BUF_AUTOSAVE_MODIFF (b
) = BUF_MODIFF (b
);
5545 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5546 set_buffer_internal (old
);
5548 EMACS_GET_TIME (after_time
);
5550 /* If auto-save took more than 60 seconds,
5551 assume it was an NFS failure that got a timeout. */
5552 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5553 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5557 /* Prevent another auto save till enough input events come in. */
5558 record_auto_save ();
5560 if (auto_saved
&& NILP (no_message
))
5564 /* If we are going to restore an old message,
5565 give time to read ours. */
5566 sit_for (make_number (1), 0, 0);
5569 else if (!auto_save_error_occurred
)
5570 /* Don't overwrite the error message if an error occurred.
5571 If we displayed a message and then restored a state
5572 with no message, leave a "done" message on the screen. */
5573 message1 ("Auto-saving...done");
5578 /* This restores the message-stack status. */
5579 unbind_to (count
, Qnil
);
5583 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5584 Sset_buffer_auto_saved
, 0, 0, 0,
5585 doc
: /* Mark current buffer as auto-saved with its current text.
5586 No auto-save file will be written until the buffer changes again. */)
5589 /* FIXME: This should not be called in indirect buffers, since
5590 they're not autosaved. */
5591 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
5592 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5593 current_buffer
->auto_save_failure_time
= -1;
5597 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5598 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5599 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5602 current_buffer
->auto_save_failure_time
= -1;
5606 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5608 doc
: /* Return t if current buffer has been auto-saved recently.
5609 More precisely, if it has been auto-saved since last read from or saved
5610 in the visited file. If the buffer has no visited file,
5611 then any auto-save counts as "recent". */)
5614 /* FIXME: maybe we should return nil for indirect buffers since
5615 they're never autosaved. */
5616 return (SAVE_MODIFF
< BUF_AUTOSAVE_MODIFF (current_buffer
) ? Qt
: Qnil
);
5619 /* Reading and completing file names */
5621 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5622 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5623 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5624 The return value is only relevant for a call to `read-file-name' that happens
5625 before any other event (mouse or keypress) is handled. */)
5628 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
5629 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5639 Fread_file_name (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
5640 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
5642 struct gcpro gcpro1
, gcpro2
;
5643 Lisp_Object args
[7];
5645 GCPRO1 (default_filename
);
5646 args
[0] = intern ("read-file-name");
5649 args
[3] = default_filename
;
5650 args
[4] = mustmatch
;
5652 args
[6] = predicate
;
5653 RETURN_UNGCPRO (Ffuncall (7, args
));
5660 Qoperations
= intern_c_string ("operations");
5661 Qexpand_file_name
= intern_c_string ("expand-file-name");
5662 Qsubstitute_in_file_name
= intern_c_string ("substitute-in-file-name");
5663 Qdirectory_file_name
= intern_c_string ("directory-file-name");
5664 Qfile_name_directory
= intern_c_string ("file-name-directory");
5665 Qfile_name_nondirectory
= intern_c_string ("file-name-nondirectory");
5666 Qunhandled_file_name_directory
= intern_c_string ("unhandled-file-name-directory");
5667 Qfile_name_as_directory
= intern_c_string ("file-name-as-directory");
5668 Qcopy_file
= intern_c_string ("copy-file");
5669 Qmake_directory_internal
= intern_c_string ("make-directory-internal");
5670 Qmake_directory
= intern_c_string ("make-directory");
5671 Qdelete_directory_internal
= intern_c_string ("delete-directory-internal");
5672 Qdelete_file
= intern_c_string ("delete-file");
5673 Qrename_file
= intern_c_string ("rename-file");
5674 Qadd_name_to_file
= intern_c_string ("add-name-to-file");
5675 Qmake_symbolic_link
= intern_c_string ("make-symbolic-link");
5676 Qfile_exists_p
= intern_c_string ("file-exists-p");
5677 Qfile_executable_p
= intern_c_string ("file-executable-p");
5678 Qfile_readable_p
= intern_c_string ("file-readable-p");
5679 Qfile_writable_p
= intern_c_string ("file-writable-p");
5680 Qfile_symlink_p
= intern_c_string ("file-symlink-p");
5681 Qaccess_file
= intern_c_string ("access-file");
5682 Qfile_directory_p
= intern_c_string ("file-directory-p");
5683 Qfile_regular_p
= intern_c_string ("file-regular-p");
5684 Qfile_accessible_directory_p
= intern_c_string ("file-accessible-directory-p");
5685 Qfile_modes
= intern_c_string ("file-modes");
5686 Qset_file_modes
= intern_c_string ("set-file-modes");
5687 Qset_file_times
= intern_c_string ("set-file-times");
5688 Qfile_selinux_context
= intern_c_string("file-selinux-context");
5689 Qset_file_selinux_context
= intern_c_string("set-file-selinux-context");
5690 Qfile_newer_than_file_p
= intern_c_string ("file-newer-than-file-p");
5691 Qinsert_file_contents
= intern_c_string ("insert-file-contents");
5692 Qwrite_region
= intern_c_string ("write-region");
5693 Qverify_visited_file_modtime
= intern_c_string ("verify-visited-file-modtime");
5694 Qset_visited_file_modtime
= intern_c_string ("set-visited-file-modtime");
5695 Qauto_save_coding
= intern_c_string ("auto-save-coding");
5697 staticpro (&Qoperations
);
5698 staticpro (&Qexpand_file_name
);
5699 staticpro (&Qsubstitute_in_file_name
);
5700 staticpro (&Qdirectory_file_name
);
5701 staticpro (&Qfile_name_directory
);
5702 staticpro (&Qfile_name_nondirectory
);
5703 staticpro (&Qunhandled_file_name_directory
);
5704 staticpro (&Qfile_name_as_directory
);
5705 staticpro (&Qcopy_file
);
5706 staticpro (&Qmake_directory_internal
);
5707 staticpro (&Qmake_directory
);
5708 staticpro (&Qdelete_directory_internal
);
5709 staticpro (&Qdelete_file
);
5710 staticpro (&Qrename_file
);
5711 staticpro (&Qadd_name_to_file
);
5712 staticpro (&Qmake_symbolic_link
);
5713 staticpro (&Qfile_exists_p
);
5714 staticpro (&Qfile_executable_p
);
5715 staticpro (&Qfile_readable_p
);
5716 staticpro (&Qfile_writable_p
);
5717 staticpro (&Qaccess_file
);
5718 staticpro (&Qfile_symlink_p
);
5719 staticpro (&Qfile_directory_p
);
5720 staticpro (&Qfile_regular_p
);
5721 staticpro (&Qfile_accessible_directory_p
);
5722 staticpro (&Qfile_modes
);
5723 staticpro (&Qset_file_modes
);
5724 staticpro (&Qset_file_times
);
5725 staticpro (&Qfile_selinux_context
);
5726 staticpro (&Qset_file_selinux_context
);
5727 staticpro (&Qfile_newer_than_file_p
);
5728 staticpro (&Qinsert_file_contents
);
5729 staticpro (&Qwrite_region
);
5730 staticpro (&Qverify_visited_file_modtime
);
5731 staticpro (&Qset_visited_file_modtime
);
5732 staticpro (&Qauto_save_coding
);
5734 Qfile_name_history
= intern_c_string ("file-name-history");
5735 Fset (Qfile_name_history
, Qnil
);
5736 staticpro (&Qfile_name_history
);
5738 Qfile_error
= intern_c_string ("file-error");
5739 staticpro (&Qfile_error
);
5740 Qfile_already_exists
= intern_c_string ("file-already-exists");
5741 staticpro (&Qfile_already_exists
);
5742 Qfile_date_error
= intern_c_string ("file-date-error");
5743 staticpro (&Qfile_date_error
);
5744 Qexcl
= intern_c_string ("excl");
5748 Qfind_buffer_file_type
= intern_c_string ("find-buffer-file-type");
5749 staticpro (&Qfind_buffer_file_type
);
5752 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5753 doc
: /* *Coding system for encoding file names.
5754 If it is nil, `default-file-name-coding-system' (which see) is used. */);
5755 Vfile_name_coding_system
= Qnil
;
5757 DEFVAR_LISP ("default-file-name-coding-system",
5758 &Vdefault_file_name_coding_system
,
5759 doc
: /* Default coding system for encoding file names.
5760 This variable is used only when `file-name-coding-system' is nil.
5762 This variable is set/changed by the command `set-language-environment'.
5763 User should not set this variable manually,
5764 instead use `file-name-coding-system' to get a constant encoding
5765 of file names regardless of the current language environment. */);
5766 Vdefault_file_name_coding_system
= Qnil
;
5768 Qformat_decode
= intern_c_string ("format-decode");
5769 staticpro (&Qformat_decode
);
5770 Qformat_annotate_function
= intern_c_string ("format-annotate-function");
5771 staticpro (&Qformat_annotate_function
);
5772 Qafter_insert_file_set_coding
= intern_c_string ("after-insert-file-set-coding");
5773 staticpro (&Qafter_insert_file_set_coding
);
5775 Qcar_less_than_car
= intern_c_string ("car-less-than-car");
5776 staticpro (&Qcar_less_than_car
);
5778 Fput (Qfile_error
, Qerror_conditions
,
5779 Fpurecopy (list2 (Qfile_error
, Qerror
)));
5780 Fput (Qfile_error
, Qerror_message
,
5781 make_pure_c_string ("File error"));
5783 Fput (Qfile_already_exists
, Qerror_conditions
,
5784 Fpurecopy (list3 (Qfile_already_exists
, Qfile_error
, Qerror
)));
5785 Fput (Qfile_already_exists
, Qerror_message
,
5786 make_pure_c_string ("File already exists"));
5788 Fput (Qfile_date_error
, Qerror_conditions
,
5789 Fpurecopy (list3 (Qfile_date_error
, Qfile_error
, Qerror
)));
5790 Fput (Qfile_date_error
, Qerror_message
,
5791 make_pure_c_string ("Cannot set file date"));
5793 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5794 doc
: /* Directory separator character for built-in functions that return file names.
5795 The value is always ?/. Don't use this variable, just use `/'. */);
5796 XSETFASTINT (Vdirectory_sep_char
, '/');
5798 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5799 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
5800 If a file name matches REGEXP, then all I/O on that file is done by calling
5803 The first argument given to HANDLER is the name of the I/O primitive
5804 to be handled; the remaining arguments are the arguments that were
5805 passed to that primitive. For example, if you do
5806 (file-exists-p FILENAME)
5807 and FILENAME is handled by HANDLER, then HANDLER is called like this:
5808 (funcall HANDLER 'file-exists-p FILENAME)
5809 The function `find-file-name-handler' checks this list for a handler
5810 for its argument. */);
5811 Vfile_name_handler_alist
= Qnil
;
5813 DEFVAR_LISP ("set-auto-coding-function",
5814 &Vset_auto_coding_function
,
5815 doc
: /* If non-nil, a function to call to decide a coding system of file.
5816 Two arguments are passed to this function: the file name
5817 and the length of a file contents following the point.
5818 This function should return a coding system to decode the file contents.
5819 It should check the file name against `auto-coding-alist'.
5820 If no coding system is decided, it should check a coding system
5821 specified in the heading lines with the format:
5822 -*- ... coding: CODING-SYSTEM; ... -*-
5823 or local variable spec of the tailing lines with `coding:' tag. */);
5824 Vset_auto_coding_function
= Qnil
;
5826 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5827 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
5828 Each is passed one argument, the number of characters inserted,
5829 with point at the start of the inserted text. Each function
5830 should leave point the same, and return the new character count.
5831 If `insert-file-contents' is intercepted by a handler from
5832 `file-name-handler-alist', that handler is responsible for calling the
5833 functions in `after-insert-file-functions' if appropriate. */);
5834 Vafter_insert_file_functions
= Qnil
;
5836 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5837 doc
: /* A list of functions to be called at the start of `write-region'.
5838 Each is passed two arguments, START and END as for `write-region'.
5839 These are usually two numbers but not always; see the documentation
5840 for `write-region'. The function should return a list of pairs
5841 of the form (POSITION . STRING), consisting of strings to be effectively
5842 inserted at the specified positions of the file being written (1 means to
5843 insert before the first byte written). The POSITIONs must be sorted into
5846 If there are several annotation functions, the lists returned by these
5847 functions are merged destructively. As each annotation function runs,
5848 the variable `write-region-annotations-so-far' contains a list of all
5849 annotations returned by previous annotation functions.
5851 An annotation function can return with a different buffer current.
5852 Doing so removes the annotations returned by previous functions, and
5853 resets START and END to `point-min' and `point-max' of the new buffer.
5855 After `write-region' completes, Emacs calls the function stored in
5856 `write-region-post-annotation-function', once for each buffer that was
5857 current when building the annotations (i.e., at least once), with that
5858 buffer current. */);
5859 Vwrite_region_annotate_functions
= Qnil
;
5860 staticpro (&Qwrite_region_annotate_functions
);
5861 Qwrite_region_annotate_functions
5862 = intern_c_string ("write-region-annotate-functions");
5864 DEFVAR_LISP ("write-region-post-annotation-function",
5865 &Vwrite_region_post_annotation_function
,
5866 doc
: /* Function to call after `write-region' completes.
5867 The function is called with no arguments. If one or more of the
5868 annotation functions in `write-region-annotate-functions' changed the
5869 current buffer, the function stored in this variable is called for
5870 each of those additional buffers as well, in addition to the original
5871 buffer. The relevant buffer is current during each function call. */);
5872 Vwrite_region_post_annotation_function
= Qnil
;
5873 staticpro (&Vwrite_region_annotation_buffers
);
5875 DEFVAR_LISP ("write-region-annotations-so-far",
5876 &Vwrite_region_annotations_so_far
,
5877 doc
: /* When an annotation function is called, this holds the previous annotations.
5878 These are the annotations made by other annotation functions
5879 that were already called. See also `write-region-annotate-functions'. */);
5880 Vwrite_region_annotations_so_far
= Qnil
;
5882 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5883 doc
: /* A list of file name handlers that temporarily should not be used.
5884 This applies only to the operation `inhibit-file-name-operation'. */);
5885 Vinhibit_file_name_handlers
= Qnil
;
5887 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5888 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5889 Vinhibit_file_name_operation
= Qnil
;
5891 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5892 doc
: /* File name in which we write a list of all auto save file names.
5893 This variable is initialized automatically from `auto-save-list-file-prefix'
5894 shortly after Emacs reads your `.emacs' file, if you have not yet given it
5895 a non-nil value. */);
5896 Vauto_save_list_file_name
= Qnil
;
5898 DEFVAR_LISP ("auto-save-visited-file-name", &Vauto_save_visited_file_name
,
5899 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
5900 Normally auto-save files are written under other names. */);
5901 Vauto_save_visited_file_name
= Qnil
;
5903 DEFVAR_LISP ("auto-save-include-big-deletions", &Vauto_save_include_big_deletions
,
5904 doc
: /* If non-nil, auto-save even if a large part of the text is deleted.
5905 If nil, deleting a substantial portion of the text disables auto-save
5906 in the buffer; this is the default behavior, because the auto-save
5907 file is usually more useful if it contains the deleted text. */);
5908 Vauto_save_include_big_deletions
= Qnil
;
5911 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
5912 doc
: /* *Non-nil means don't call fsync in `write-region'.
5913 This variable affects calls to `write-region' as well as save commands.
5914 A non-nil value may result in data loss! */);
5915 write_region_inhibit_fsync
= 0;
5918 DEFVAR_BOOL ("delete-by-moving-to-trash", &delete_by_moving_to_trash
,
5919 doc
: /* Specifies whether to use the system's trash can.
5920 When non-nil, the function `move-file-to-trash' will be used by
5921 `delete-file' and `delete-directory'. */);
5922 delete_by_moving_to_trash
= 0;
5923 Qdelete_by_moving_to_trash
= intern_c_string ("delete-by-moving-to-trash");
5924 Qmove_file_to_trash
= intern_c_string ("move-file-to-trash");
5925 staticpro (&Qmove_file_to_trash
);
5926 Qcopy_directory
= intern_c_string ("copy-directory");
5927 staticpro (&Qcopy_directory
);
5928 Qdelete_directory
= intern_c_string ("delete-directory");
5929 staticpro (&Qdelete_directory
);
5931 defsubr (&Sfind_file_name_handler
);
5932 defsubr (&Sfile_name_directory
);
5933 defsubr (&Sfile_name_nondirectory
);
5934 defsubr (&Sunhandled_file_name_directory
);
5935 defsubr (&Sfile_name_as_directory
);
5936 defsubr (&Sdirectory_file_name
);
5937 defsubr (&Smake_temp_name
);
5938 defsubr (&Sexpand_file_name
);
5939 defsubr (&Ssubstitute_in_file_name
);
5940 defsubr (&Scopy_file
);
5941 defsubr (&Smake_directory_internal
);
5942 defsubr (&Sdelete_directory_internal
);
5943 defsubr (&Sdelete_file
);
5944 defsubr (&Srename_file
);
5945 defsubr (&Sadd_name_to_file
);
5946 defsubr (&Smake_symbolic_link
);
5947 defsubr (&Sfile_name_absolute_p
);
5948 defsubr (&Sfile_exists_p
);
5949 defsubr (&Sfile_executable_p
);
5950 defsubr (&Sfile_readable_p
);
5951 defsubr (&Sfile_writable_p
);
5952 defsubr (&Saccess_file
);
5953 defsubr (&Sfile_symlink_p
);
5954 defsubr (&Sfile_directory_p
);
5955 defsubr (&Sfile_accessible_directory_p
);
5956 defsubr (&Sfile_regular_p
);
5957 defsubr (&Sfile_modes
);
5958 defsubr (&Sset_file_modes
);
5959 defsubr (&Sset_file_times
);
5960 defsubr (&Sfile_selinux_context
);
5961 defsubr (&Sset_file_selinux_context
);
5962 defsubr (&Sset_default_file_modes
);
5963 defsubr (&Sdefault_file_modes
);
5964 defsubr (&Sfile_newer_than_file_p
);
5965 defsubr (&Sinsert_file_contents
);
5966 defsubr (&Swrite_region
);
5967 defsubr (&Scar_less_than_car
);
5968 defsubr (&Sverify_visited_file_modtime
);
5969 defsubr (&Sclear_visited_file_modtime
);
5970 defsubr (&Svisited_file_modtime
);
5971 defsubr (&Sset_visited_file_modtime
);
5972 defsubr (&Sdo_auto_save
);
5973 defsubr (&Sset_buffer_auto_saved
);
5974 defsubr (&Sclear_buffer_auto_save_failure
);
5975 defsubr (&Srecent_auto_save_p
);
5977 defsubr (&Snext_read_file_uses_dialog_p
);
5980 defsubr (&Sunix_sync
);
5984 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
5985 (do not change this comment) */