1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
29 #include <sys/types.h>
36 #if !defined (S_ISLNK) && defined (S_IFLNK)
37 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
40 #if !defined (S_ISFIFO) && defined (S_IFIFO)
41 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
44 #if !defined (S_ISREG) && defined (S_IFREG)
45 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
62 #include "intervals.h"
64 #include "character.h"
67 #include "blockinput.h"
69 #include "dispextern.h"
76 #endif /* not WINDOWSNT */
80 #include <sys/param.h>
88 #define CORRECT_DIR_SEPS(s) \
89 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
90 else unixtodos_filename (s); \
92 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
93 redirector allows the six letters between 'Z' and 'a' as well. */
95 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
98 #define IS_DRIVE(x) isalpha (x)
100 /* Need to lower-case the drive letter, or else expanded
101 filenames will sometimes compare inequal, because
102 `expand-file-name' doesn't always down-case the drive letter. */
103 #define DRIVE_LETTER(x) (tolower (x))
112 #include "commands.h"
113 extern int use_dialog_box
;
114 extern int use_file_dialog
;
128 #ifndef FILE_SYSTEM_CASE
129 #define FILE_SYSTEM_CASE(filename) (filename)
132 /* Nonzero during writing of auto-save files */
135 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
136 a new file with the same mode as the original */
137 int auto_save_mode_bits
;
139 /* Set by auto_save_1 if an error occurred during the last auto-save. */
140 int auto_save_error_occurred
;
142 /* The symbol bound to coding-system-for-read when
143 insert-file-contents is called for recovering a file. This is not
144 an actual coding system name, but just an indicator to tell
145 insert-file-contents to use `emacs-mule' with a special flag for
146 auto saving and recovering a file. */
147 Lisp_Object Qauto_save_coding
;
149 /* Coding system for file names, or nil if none. */
150 Lisp_Object Vfile_name_coding_system
;
152 /* Coding system for file names used only when
153 Vfile_name_coding_system is nil. */
154 Lisp_Object Vdefault_file_name_coding_system
;
156 /* Alist of elements (REGEXP . HANDLER) for file names
157 whose I/O is done with a special handler. */
158 Lisp_Object Vfile_name_handler_alist
;
160 /* Property name of a file name handler,
161 which gives a list of operations it handles.. */
162 Lisp_Object Qoperations
;
164 /* Lisp functions for translating file formats */
165 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
167 /* Function to be called to decide a coding system of a reading file. */
168 Lisp_Object Vset_auto_coding_function
;
170 /* Functions to be called to process text properties in inserted file. */
171 Lisp_Object Vafter_insert_file_functions
;
173 /* Lisp function for setting buffer-file-coding-system and the
174 multibyteness of the current buffer after inserting a file. */
175 Lisp_Object Qafter_insert_file_set_coding
;
177 /* Functions to be called to create text property annotations for file. */
178 Lisp_Object Vwrite_region_annotate_functions
;
179 Lisp_Object Qwrite_region_annotate_functions
;
181 /* During build_annotations, each time an annotation function is called,
182 this holds the annotations made by the previous functions. */
183 Lisp_Object Vwrite_region_annotations_so_far
;
185 /* File name in which we write a list of all our auto save files. */
186 Lisp_Object Vauto_save_list_file_name
;
188 /* Whether or not files are auto-saved into themselves. */
189 Lisp_Object Vauto_save_visited_file_name
;
191 /* On NT, specifies the directory separator character, used (eg.) when
192 expanding file names. This can be bound to / or \. */
193 Lisp_Object Vdirectory_sep_char
;
196 /* Nonzero means skip the call to fsync in Fwrite-region. */
197 int write_region_inhibit_fsync
;
200 /* Non-zero means call move-file-to-trash in Fdelete_file or
201 Fdelete_directory. */
202 int delete_by_moving_to_trash
;
204 /* Lisp function for moving files to trash. */
205 Lisp_Object Qmove_file_to_trash
;
207 extern Lisp_Object Vuser_login_name
;
210 extern Lisp_Object Vw32_get_true_file_attributes
;
213 extern int minibuf_level
;
215 extern int minibuffer_auto_raise
;
217 extern int history_delete_duplicates
;
219 /* These variables describe handlers that have "already" had a chance
220 to handle the current operation.
222 Vinhibit_file_name_handlers is a list of file name handlers.
223 Vinhibit_file_name_operation is the operation being handled.
224 If we try to handle that operation, we ignore those handlers. */
226 static Lisp_Object Vinhibit_file_name_handlers
;
227 static Lisp_Object Vinhibit_file_name_operation
;
229 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
231 Lisp_Object Qfile_name_history
;
233 Lisp_Object Qcar_less_than_car
;
235 static int a_write
P_ ((int, Lisp_Object
, int, int,
236 Lisp_Object
*, struct coding_system
*));
237 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
241 report_file_error (string
, data
)
245 Lisp_Object errstring
;
249 synchronize_system_messages_locale ();
250 str
= strerror (errorno
);
251 errstring
= code_convert_string_norecord (make_unibyte_string (str
,
253 Vlocale_coding_system
, 0);
259 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
262 /* System error messages are capitalized. Downcase the initial
263 unless it is followed by a slash. (The slash case caters to
264 error messages that begin with "I/O" or, in German, "E/A".) */
265 if (STRING_MULTIBYTE (errstring
)
266 && ! EQ (Faref (errstring
, make_number (1)), make_number ('/')))
270 str
= (char *) SDATA (errstring
);
271 c
= STRING_CHAR (str
, 0);
272 Faset (errstring
, make_number (0), make_number (DOWNCASE (c
)));
275 xsignal (Qfile_error
,
276 Fcons (build_string (string
), Fcons (errstring
, data
)));
281 close_file_unwind (fd
)
284 emacs_close (XFASTINT (fd
));
288 /* Restore point, having saved it as a marker. */
291 restore_point_unwind (location
)
292 Lisp_Object location
;
294 Fgoto_char (location
);
295 Fset_marker (location
, Qnil
, Qnil
);
300 Lisp_Object Qexpand_file_name
;
301 Lisp_Object Qsubstitute_in_file_name
;
302 Lisp_Object Qdirectory_file_name
;
303 Lisp_Object Qfile_name_directory
;
304 Lisp_Object Qfile_name_nondirectory
;
305 Lisp_Object Qunhandled_file_name_directory
;
306 Lisp_Object Qfile_name_as_directory
;
307 Lisp_Object Qcopy_file
;
308 Lisp_Object Qmake_directory_internal
;
309 Lisp_Object Qmake_directory
;
310 Lisp_Object Qdelete_directory
;
311 Lisp_Object Qdelete_file
;
312 Lisp_Object Qrename_file
;
313 Lisp_Object Qadd_name_to_file
;
314 Lisp_Object Qmake_symbolic_link
;
315 Lisp_Object Qfile_exists_p
;
316 Lisp_Object Qfile_executable_p
;
317 Lisp_Object Qfile_readable_p
;
318 Lisp_Object Qfile_writable_p
;
319 Lisp_Object Qfile_symlink_p
;
320 Lisp_Object Qaccess_file
;
321 Lisp_Object Qfile_directory_p
;
322 Lisp_Object Qfile_regular_p
;
323 Lisp_Object Qfile_accessible_directory_p
;
324 Lisp_Object Qfile_modes
;
325 Lisp_Object Qset_file_modes
;
326 Lisp_Object Qset_file_times
;
327 Lisp_Object Qfile_newer_than_file_p
;
328 Lisp_Object Qinsert_file_contents
;
329 Lisp_Object Qwrite_region
;
330 Lisp_Object Qverify_visited_file_modtime
;
331 Lisp_Object Qset_visited_file_modtime
;
333 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
334 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
335 Otherwise, return nil.
336 A file name is handled if one of the regular expressions in
337 `file-name-handler-alist' matches it.
339 If OPERATION equals `inhibit-file-name-operation', then we ignore
340 any handlers that are members of `inhibit-file-name-handlers',
341 but we still do run any other handlers. This lets handlers
342 use the standard functions without calling themselves recursively. */)
343 (filename
, operation
)
344 Lisp_Object filename
, operation
;
346 /* This function must not munge the match data. */
347 Lisp_Object chain
, inhibited_handlers
, result
;
351 CHECK_STRING (filename
);
353 if (EQ (operation
, Vinhibit_file_name_operation
))
354 inhibited_handlers
= Vinhibit_file_name_handlers
;
356 inhibited_handlers
= Qnil
;
358 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
359 chain
= XCDR (chain
))
365 Lisp_Object string
= XCAR (elt
);
367 Lisp_Object handler
= XCDR (elt
);
368 Lisp_Object operations
= Qnil
;
370 if (SYMBOLP (handler
))
371 operations
= Fget (handler
, Qoperations
);
374 && (match_pos
= fast_string_match (string
, filename
)) > pos
375 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
379 handler
= XCDR (elt
);
380 tem
= Fmemq (handler
, inhibited_handlers
);
394 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
396 doc
: /* Return the directory component in file name FILENAME.
397 Return nil if FILENAME does not include a directory.
398 Otherwise return a directory name.
399 Given a Unix syntax file name, returns a string ending in slash. */)
401 Lisp_Object filename
;
404 register const unsigned char *beg
;
406 register unsigned char *beg
;
408 register const unsigned char *p
;
411 CHECK_STRING (filename
);
413 /* If the file name has special constructs in it,
414 call the corresponding file handler. */
415 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
417 return call2 (handler
, Qfile_name_directory
, filename
);
419 filename
= FILE_SYSTEM_CASE (filename
);
420 beg
= SDATA (filename
);
422 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
424 p
= beg
+ SBYTES (filename
);
426 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
428 /* only recognise drive specifier at the beginning */
430 /* handle the "/:d:foo" and "/:foo" cases correctly */
431 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
432 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
439 /* Expansion of "c:" to drive and default directory. */
442 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
443 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
444 unsigned char *r
= res
;
446 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
448 strncpy (res
, beg
, 2);
453 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
455 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
458 p
= beg
+ strlen (beg
);
461 CORRECT_DIR_SEPS (beg
);
464 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
467 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
468 Sfile_name_nondirectory
, 1, 1, 0,
469 doc
: /* Return file name FILENAME sans its directory.
470 For example, in a Unix-syntax file name,
471 this is everything after the last slash,
472 or the entire name if it contains no slash. */)
474 Lisp_Object filename
;
476 register const unsigned char *beg
, *p
, *end
;
479 CHECK_STRING (filename
);
481 /* If the file name has special constructs in it,
482 call the corresponding file handler. */
483 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
485 return call2 (handler
, Qfile_name_nondirectory
, filename
);
487 beg
= SDATA (filename
);
488 end
= p
= beg
+ SBYTES (filename
);
490 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
492 /* only recognise drive specifier at beginning */
494 /* handle the "/:d:foo" case correctly */
495 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
500 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
503 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
504 Sunhandled_file_name_directory
, 1, 1, 0,
505 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
506 A `directly usable' directory name is one that may be used without the
507 intervention of any file handler.
508 If FILENAME is a directly usable file itself, return
509 \(file-name-directory FILENAME).
510 If FILENAME refers to a file which is not accessible from a local process,
511 then this should return nil.
512 The `call-process' and `start-process' functions use this function to
513 get a current directory to run processes in. */)
515 Lisp_Object filename
;
519 /* If the file name has special constructs in it,
520 call the corresponding file handler. */
521 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
523 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
525 return Ffile_name_directory (filename
);
530 file_name_as_directory (out
, in
)
533 int size
= strlen (in
) - 1;
545 /* For Unix syntax, Append a slash if necessary */
546 if (!IS_DIRECTORY_SEP (out
[size
]))
548 /* Cannot use DIRECTORY_SEP, which could have any value */
550 out
[size
+ 2] = '\0';
553 CORRECT_DIR_SEPS (out
);
558 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
559 Sfile_name_as_directory
, 1, 1, 0,
560 doc
: /* Return a string representing the file name FILE interpreted as a directory.
561 This operation exists because a directory is also a file, but its name as
562 a directory is different from its name as a file.
563 The result can be used as the value of `default-directory'
564 or passed as second argument to `expand-file-name'.
565 For a Unix-syntax file name, just appends a slash. */)
576 /* If the file name has special constructs in it,
577 call the corresponding file handler. */
578 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
580 return call2 (handler
, Qfile_name_as_directory
, file
);
582 buf
= (char *) alloca (SBYTES (file
) + 10);
583 file_name_as_directory (buf
, SDATA (file
));
584 return make_specified_string (buf
, -1, strlen (buf
),
585 STRING_MULTIBYTE (file
));
589 * Convert from directory name to filename.
590 * On UNIX, it's simple: just make sure there isn't a terminating /
592 * Value is nonzero if the string output is different from the input.
596 directory_file_name (src
, dst
)
603 /* Process as Unix format: just remove any final slash.
604 But leave "/" unchanged; do not change it to "". */
607 && IS_DIRECTORY_SEP (dst
[slen
- 1])
609 && !IS_ANY_SEP (dst
[slen
- 2])
614 CORRECT_DIR_SEPS (dst
);
619 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
621 doc
: /* Returns the file name of the directory named DIRECTORY.
622 This is the name of the file that holds the data for the directory DIRECTORY.
623 This operation exists because a directory is also a file, but its name as
624 a directory is different from its name as a file.
625 In Unix-syntax, this function just removes the final slash. */)
627 Lisp_Object directory
;
632 CHECK_STRING (directory
);
634 if (NILP (directory
))
637 /* If the file name has special constructs in it,
638 call the corresponding file handler. */
639 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
641 return call2 (handler
, Qdirectory_file_name
, directory
);
643 buf
= (char *) alloca (SBYTES (directory
) + 20);
644 directory_file_name (SDATA (directory
), buf
);
645 return make_specified_string (buf
, -1, strlen (buf
),
646 STRING_MULTIBYTE (directory
));
649 static char make_temp_name_tbl
[64] =
651 'A','B','C','D','E','F','G','H',
652 'I','J','K','L','M','N','O','P',
653 'Q','R','S','T','U','V','W','X',
654 'Y','Z','a','b','c','d','e','f',
655 'g','h','i','j','k','l','m','n',
656 'o','p','q','r','s','t','u','v',
657 'w','x','y','z','0','1','2','3',
658 '4','5','6','7','8','9','-','_'
661 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
663 /* Value is a temporary file name starting with PREFIX, a string.
665 The Emacs process number forms part of the result, so there is
666 no danger of generating a name being used by another process.
667 In addition, this function makes an attempt to choose a name
668 which has no existing file. To make this work, PREFIX should be
669 an absolute file name.
671 BASE64_P non-zero means add the pid as 3 characters in base64
672 encoding. In this case, 6 characters will be added to PREFIX to
673 form the file name. Otherwise, if Emacs is running on a system
674 with long file names, add the pid as a decimal number.
676 This function signals an error if no unique file name could be
680 make_temp_name (prefix
, base64_p
)
687 unsigned char *p
, *data
;
691 CHECK_STRING (prefix
);
693 /* VAL is created by adding 6 characters to PREFIX. The first
694 three are the PID of this process, in base 64, and the second
695 three are incremented if the file already exists. This ensures
696 262144 unique file names per PID per PREFIX. */
698 pid
= (int) getpid ();
702 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
703 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
704 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
709 #ifdef HAVE_LONG_FILE_NAMES
710 sprintf (pidbuf
, "%d", pid
);
711 pidlen
= strlen (pidbuf
);
713 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
714 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
715 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
720 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
721 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
722 if (!STRING_MULTIBYTE (prefix
))
723 STRING_SET_UNIBYTE (val
);
725 bcopy(SDATA (prefix
), data
, len
);
728 bcopy (pidbuf
, p
, pidlen
);
731 /* Here we try to minimize useless stat'ing when this function is
732 invoked many times successively with the same PREFIX. We achieve
733 this by initializing count to a random value, and incrementing it
736 We don't want make-temp-name to be called while dumping,
737 because then make_temp_name_count_initialized_p would get set
738 and then make_temp_name_count would not be set when Emacs starts. */
740 if (!make_temp_name_count_initialized_p
)
742 make_temp_name_count
= (unsigned) time (NULL
);
743 make_temp_name_count_initialized_p
= 1;
749 unsigned num
= make_temp_name_count
;
751 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
752 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
753 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
755 /* Poor man's congruential RN generator. Replace with
756 ++make_temp_name_count for debugging. */
757 make_temp_name_count
+= 25229;
758 make_temp_name_count
%= 225307;
760 if (stat (data
, &ignored
) < 0)
762 /* We want to return only if errno is ENOENT. */
766 /* The error here is dubious, but there is little else we
767 can do. The alternatives are to return nil, which is
768 as bad as (and in many cases worse than) throwing the
769 error, or to ignore the error, which will likely result
770 in looping through 225307 stat's, which is not only
771 dog-slow, but also useless since it will fallback to
772 the errow below, anyway. */
773 report_file_error ("Cannot create temporary name for prefix",
774 Fcons (prefix
, Qnil
));
779 error ("Cannot create temporary name for prefix `%s'",
785 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
786 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
787 The Emacs process number forms part of the result,
788 so there is no danger of generating a name being used by another process.
790 In addition, this function makes an attempt to choose a name
791 which has no existing file. To make this work,
792 PREFIX should be an absolute file name.
794 There is a race condition between calling `make-temp-name' and creating the
795 file which opens all kinds of security holes. For that reason, you should
796 probably use `make-temp-file' instead, except in three circumstances:
798 * If you are creating the file in the user's home directory.
799 * If you are creating a directory rather than an ordinary file.
800 * If you are taking special precautions as `make-temp-file' does. */)
804 return make_temp_name (prefix
, 0);
809 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
810 doc
: /* Convert filename NAME to absolute, and canonicalize it.
811 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
812 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
813 the current buffer's value of `default-directory' is used.
814 File name components that are `.' are removed, and
815 so are file name components followed by `..', along with the `..' itself;
816 note that these simplifications are done without checking the resulting
817 file names in the file system.
818 An initial `~/' expands to your home directory.
819 An initial `~USER/' expands to USER's home directory.
820 See also the function `substitute-in-file-name'. */)
821 (name
, default_directory
)
822 Lisp_Object name
, default_directory
;
824 /* These point to SDATA and need to be careful with string-relocation
825 during GC (via DECODE_FILE). */
826 unsigned char *nm
, *newdir
;
828 /* This should only point to alloca'd data. */
829 unsigned char *target
;
835 int collapse_newdir
= 1;
839 Lisp_Object handler
, result
;
845 /* If the file name has special constructs in it,
846 call the corresponding file handler. */
847 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
849 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
851 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
852 if (NILP (default_directory
))
853 default_directory
= current_buffer
->directory
;
854 if (! STRINGP (default_directory
))
857 /* "/" is not considered a root directory on DOS_NT, so using "/"
858 here causes an infinite recursion in, e.g., the following:
860 (let (default-directory)
861 (expand-file-name "a"))
863 To avoid this, we set default_directory to the root of the
865 extern char *emacs_root_dir (void);
867 default_directory
= build_string (emacs_root_dir ());
869 default_directory
= build_string ("/");
873 if (!NILP (default_directory
))
875 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
877 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
881 unsigned char *o
= SDATA (default_directory
);
883 /* Make sure DEFAULT_DIRECTORY is properly expanded.
884 It would be better to do this down below where we actually use
885 default_directory. Unfortunately, calling Fexpand_file_name recursively
886 could invoke GC, and the strings might be relocated. This would
887 be annoying because we have pointers into strings lying around
888 that would need adjusting, and people would add new pointers to
889 the code and forget to adjust them, resulting in intermittent bugs.
890 Putting this call here avoids all that crud.
892 The EQ test avoids infinite recursion. */
893 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
894 /* Save time in some common cases - as long as default_directory
895 is not relative, it can be canonicalized with name below (if it
896 is needed at all) without requiring it to be expanded now. */
898 /* Detect MSDOS file names with drive specifiers. */
899 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
900 && IS_DIRECTORY_SEP (o
[2]))
902 /* Detect Windows file names in UNC format. */
903 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
905 #else /* not DOS_NT */
906 /* Detect Unix absolute file names (/... alone is not absolute on
908 && ! (IS_DIRECTORY_SEP (o
[0]))
909 #endif /* not DOS_NT */
915 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
919 name
= FILE_SYSTEM_CASE (name
);
920 multibyte
= STRING_MULTIBYTE (name
);
921 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
924 default_directory
= string_to_multibyte (default_directory
);
927 name
= string_to_multibyte (name
);
935 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
936 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
940 /* Note if special escape prefix is present, but remove for now. */
941 if (nm
[0] == '/' && nm
[1] == ':')
947 /* Find and remove drive specifier if present; this makes nm absolute
948 even if the rest of the name appears to be relative. Only look for
949 drive specifier at the beginning. */
950 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
957 /* If we see "c://somedir", we want to strip the first slash after the
958 colon when stripping the drive letter. Otherwise, this expands to
960 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
963 /* Discard any previous drive specifier if nm is now in UNC format. */
964 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
968 #endif /* WINDOWSNT */
971 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
972 none are found, we can probably return right away. We will avoid
973 allocating a new string if name is already fully expanded. */
975 IS_DIRECTORY_SEP (nm
[0])
977 && drive
&& !is_escaped
980 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
984 /* If it turns out that the filename we want to return is just a
985 suffix of FILENAME, we don't need to go through and edit
986 things; we just need to construct a new string using data
987 starting at the middle of FILENAME. If we set lose to a
988 non-zero value, that means we've discovered that we can't do
991 unsigned char *p
= nm
;
995 /* Since we know the name is absolute, we can assume that each
996 element starts with a "/". */
998 /* "." and ".." are hairy. */
999 if (IS_DIRECTORY_SEP (p
[0])
1001 && (IS_DIRECTORY_SEP (p
[2])
1003 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1006 /* We want to replace multiple `/' in a row with a single
1009 && IS_DIRECTORY_SEP (p
[0])
1010 && IS_DIRECTORY_SEP (p
[1]))
1017 /* Make sure directories are all separated with / or \ as
1018 desired, but avoid allocation of a new string when not
1020 CORRECT_DIR_SEPS (nm
);
1022 if (IS_DIRECTORY_SEP (nm
[1]))
1024 if (strcmp (nm
, SDATA (name
)) != 0)
1025 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1029 /* drive must be set, so this is okay */
1030 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1034 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1035 temp
[0] = DRIVE_LETTER (drive
);
1036 name
= concat2 (build_string (temp
), name
);
1039 #else /* not DOS_NT */
1040 if (strcmp (nm
, SDATA (name
)) == 0)
1042 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1043 #endif /* not DOS_NT */
1047 /* At this point, nm might or might not be an absolute file name. We
1048 need to expand ~ or ~user if present, otherwise prefix nm with
1049 default_directory if nm is not absolute, and finally collapse /./
1050 and /foo/../ sequences.
1052 We set newdir to be the appropriate prefix if one is needed:
1053 - the relevant user directory if nm starts with ~ or ~user
1054 - the specified drive's working dir (DOS/NT only) if nm does not
1056 - the value of default_directory.
1058 Note that these prefixes are not guaranteed to be absolute (except
1059 for the working dir of a drive). Therefore, to ensure we always
1060 return an absolute name, if the final prefix is not absolute we
1061 append it to the current working directory. */
1065 if (nm
[0] == '~') /* prefix ~ */
1067 if (IS_DIRECTORY_SEP (nm
[1])
1068 || nm
[1] == 0) /* ~ by itself */
1072 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1073 newdir
= (unsigned char *) "";
1075 /* egetenv may return a unibyte string, which will bite us since
1076 we expect the directory to be multibyte. */
1077 tem
= build_string (newdir
);
1078 if (!STRING_MULTIBYTE (tem
))
1080 /* FIXME: DECODE_FILE may GC, which may move SDATA(name),
1081 after which `nm' won't point to the right place any more. */
1082 int offset
= nm
- SDATA (name
);
1083 hdir
= DECODE_FILE (tem
);
1084 newdir
= SDATA (hdir
);
1086 nm
= SDATA (name
) + offset
;
1089 collapse_newdir
= 0;
1092 else /* ~user/filename */
1094 unsigned char *o
, *p
;
1095 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)); p
++);
1096 o
= alloca (p
- nm
+ 1);
1097 bcopy ((char *) nm
, o
, p
- nm
);
1101 pw
= (struct passwd
*) getpwnam (o
+ 1);
1105 newdir
= (unsigned char *) pw
-> pw_dir
;
1108 collapse_newdir
= 0;
1112 /* If we don't find a user of that name, leave the name
1113 unchanged; don't move nm forward to p. */
1118 /* On DOS and Windows, nm is absolute if a drive name was specified;
1119 use the drive's current directory as the prefix if needed. */
1120 if (!newdir
&& drive
)
1122 /* Get default directory if needed to make nm absolute. */
1123 if (!IS_DIRECTORY_SEP (nm
[0]))
1125 newdir
= alloca (MAXPATHLEN
+ 1);
1126 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1131 /* Either nm starts with /, or drive isn't mounted. */
1132 newdir
= alloca (4);
1133 newdir
[0] = DRIVE_LETTER (drive
);
1141 /* Finally, if no prefix has been specified and nm is not absolute,
1142 then it must be expanded relative to default_directory. */
1146 /* /... alone is not absolute on DOS and Windows. */
1147 && !IS_DIRECTORY_SEP (nm
[0])
1150 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1154 newdir
= SDATA (default_directory
);
1156 /* Note if special escape prefix is present, but remove for now. */
1157 if (newdir
[0] == '/' && newdir
[1] == ':')
1168 /* First ensure newdir is an absolute name. */
1170 /* Detect MSDOS file names with drive specifiers. */
1171 ! (IS_DRIVE (newdir
[0])
1172 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1174 /* Detect Windows file names in UNC format. */
1175 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1179 /* Effectively, let newdir be (expand-file-name newdir cwd).
1180 Because of the admonition against calling expand-file-name
1181 when we have pointers into lisp strings, we accomplish this
1182 indirectly by prepending newdir to nm if necessary, and using
1183 cwd (or the wd of newdir's drive) as the new newdir. */
1185 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1190 if (!IS_DIRECTORY_SEP (nm
[0]))
1192 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1193 file_name_as_directory (tmp
, newdir
);
1197 newdir
= alloca (MAXPATHLEN
+ 1);
1200 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1207 /* Strip off drive name from prefix, if present. */
1208 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1214 /* Keep only a prefix from newdir if nm starts with slash
1215 (//server/share for UNC, nothing otherwise). */
1216 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1219 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1222 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1224 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1226 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1238 /* Get rid of any slash at the end of newdir, unless newdir is
1239 just / or // (an incomplete UNC name). */
1240 length
= strlen (newdir
);
1241 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1243 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1247 unsigned char *temp
= (unsigned char *) alloca (length
);
1248 bcopy (newdir
, temp
, length
- 1);
1249 temp
[length
- 1] = 0;
1257 /* Now concatenate the directory and name to new space in the stack frame */
1258 tlen
+= strlen (nm
) + 1;
1260 /* Reserve space for drive specifier and escape prefix, since either
1261 or both may need to be inserted. (The Microsoft x86 compiler
1262 produces incorrect code if the following two lines are combined.) */
1263 target
= (unsigned char *) alloca (tlen
+ 4);
1265 #else /* not DOS_NT */
1266 target
= (unsigned char *) alloca (tlen
);
1267 #endif /* not DOS_NT */
1272 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1275 /* If newdir is effectively "C:/", then the drive letter will have
1276 been stripped and newdir will be "/". Concatenating with an
1277 absolute directory in nm produces "//", which will then be
1278 incorrectly treated as a network share. Ignore newdir in
1279 this case (keeping the drive letter). */
1280 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1281 && newdir
[1] == '\0'))
1283 strcpy (target
, newdir
);
1286 file_name_as_directory (target
, newdir
);
1289 strcat (target
, nm
);
1291 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1294 unsigned char *p
= target
;
1295 unsigned char *o
= target
;
1299 if (!IS_DIRECTORY_SEP (*p
))
1303 else if (p
[1] == '.'
1304 && (IS_DIRECTORY_SEP (p
[2])
1307 /* If "/." is the entire filename, keep the "/". Otherwise,
1308 just delete the whole "/.". */
1309 if (o
== target
&& p
[2] == '\0')
1313 else if (p
[1] == '.' && p
[2] == '.'
1314 /* `/../' is the "superroot" on certain file systems.
1315 Turned off on DOS_NT systems because they have no
1316 "superroot" and because this causes us to produce
1317 file names like "d:/../foo" which fail file-related
1318 functions of the underlying OS. (To reproduce, try a
1319 long series of "../../" in default_directory, longer
1320 than the number of levels from the root.) */
1324 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1326 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1328 /* Keep initial / only if this is the whole name. */
1329 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1333 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1334 /* Collapse multiple `/' in a row. */
1343 /* At last, set drive name. */
1345 /* Except for network file name. */
1346 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1347 #endif /* WINDOWSNT */
1349 if (!drive
) abort ();
1351 target
[0] = DRIVE_LETTER (drive
);
1354 /* Reinsert the escape prefix if required. */
1361 CORRECT_DIR_SEPS (target
);
1364 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1367 /* Again look to see if the file name has special constructs in it
1368 and perhaps call the corresponding file handler. This is needed
1369 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1370 the ".." component gives us "/user@host:/bar/../baz" which needs
1371 to be expanded again. */
1372 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1373 if (!NILP (handler
))
1374 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1380 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1381 This is the old version of expand-file-name, before it was thoroughly
1382 rewritten for Emacs 10.31. We leave this version here commented-out,
1383 because the code is very complex and likely to have subtle bugs. If
1384 bugs _are_ found, it might be of interest to look at the old code and
1385 see what did it do in the relevant situation.
1387 Don't remove this code: it's true that it will be accessible via CVS,
1388 but a few years from deletion, people will forget it is there. */
1390 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1391 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1392 "Convert FILENAME to absolute, and canonicalize it.\n\
1393 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1394 \(does not start with slash); if DEFAULT is nil or missing,\n\
1395 the current buffer's value of default-directory is used.\n\
1396 Filenames containing `.' or `..' as components are simplified;\n\
1397 initial `~/' expands to your home directory.\n\
1398 See also the function `substitute-in-file-name'.")
1400 Lisp_Object name
, defalt
;
1404 register unsigned char *newdir
, *p
, *o
;
1406 unsigned char *target
;
1410 CHECK_STRING (name
);
1413 /* If nm is absolute, flush ...// and detect /./ and /../.
1414 If no /./ or /../ we can return right away. */
1421 if (p
[0] == '/' && p
[1] == '/'
1424 if (p
[0] == '/' && p
[1] == '~')
1425 nm
= p
+ 1, lose
= 1;
1426 if (p
[0] == '/' && p
[1] == '.'
1427 && (p
[2] == '/' || p
[2] == 0
1428 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1434 if (nm
== SDATA (name
))
1436 return build_string (nm
);
1440 /* Now determine directory to start with and put it in NEWDIR */
1444 if (nm
[0] == '~') /* prefix ~ */
1445 if (nm
[1] == '/' || nm
[1] == 0)/* ~/filename */
1447 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1448 newdir
= (unsigned char *) "";
1451 else /* ~user/filename */
1453 /* Get past ~ to user */
1454 unsigned char *user
= nm
+ 1;
1455 /* Find end of name. */
1456 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1457 int len
= ptr
? ptr
- user
: strlen (user
);
1458 /* Copy the user name into temp storage. */
1459 o
= (unsigned char *) alloca (len
+ 1);
1460 bcopy ((char *) user
, o
, len
);
1463 /* Look up the user name. */
1465 pw
= (struct passwd
*) getpwnam (o
+ 1);
1468 error ("\"%s\" isn't a registered user", o
+ 1);
1470 newdir
= (unsigned char *) pw
->pw_dir
;
1472 /* Discard the user name from NM. */
1476 if (nm
[0] != '/' && !newdir
)
1479 defalt
= current_buffer
->directory
;
1480 CHECK_STRING (defalt
);
1481 newdir
= SDATA (defalt
);
1484 /* Now concatenate the directory and name to new space in the stack frame */
1486 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1487 target
= (unsigned char *) alloca (tlen
);
1492 if (nm
[0] == 0 || nm
[0] == '/')
1493 strcpy (target
, newdir
);
1495 file_name_as_directory (target
, newdir
);
1498 strcat (target
, nm
);
1500 /* Now canonicalize by removing /. and /foo/.. if they appear */
1511 else if (!strncmp (p
, "//", 2)
1517 else if (p
[0] == '/' && p
[1] == '.'
1518 && (p
[2] == '/' || p
[2] == 0))
1520 else if (!strncmp (p
, "/..", 3)
1521 /* `/../' is the "superroot" on certain file systems. */
1523 && (p
[3] == '/' || p
[3] == 0))
1525 while (o
!= target
&& *--o
!= '/')
1527 if (o
== target
&& *o
== '/')
1537 return make_string (target
, o
- target
);
1541 /* If /~ or // appears, discard everything through first slash. */
1543 file_name_absolute_p (filename
)
1544 const unsigned char *filename
;
1547 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
1549 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
1550 && IS_DIRECTORY_SEP (filename
[2]))
1555 static unsigned char *
1556 search_embedded_absfilename (nm
, endp
)
1557 unsigned char *nm
, *endp
;
1559 unsigned char *p
, *s
;
1561 for (p
= nm
+ 1; p
< endp
; p
++)
1564 || IS_DIRECTORY_SEP (p
[-1]))
1565 && file_name_absolute_p (p
)
1566 #if defined (WINDOWSNT) || defined(CYGWIN)
1567 /* // at start of file name is meaningful in Apollo,
1568 WindowsNT and Cygwin systems. */
1569 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
1570 #endif /* not (WINDOWSNT || CYGWIN) */
1573 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)); s
++);
1574 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
1576 unsigned char *o
= alloca (s
- p
+ 1);
1578 bcopy (p
, o
, s
- p
);
1581 /* If we have ~user and `user' exists, discard
1582 everything up to ~. But if `user' does not exist, leave
1583 ~user alone, it might be a literal file name. */
1585 pw
= getpwnam (o
+ 1);
1597 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1598 Ssubstitute_in_file_name
, 1, 1, 0,
1599 doc
: /* Substitute environment variables referred to in FILENAME.
1600 `$FOO' where FOO is an environment variable name means to substitute
1601 the value of that variable. The variable name should be terminated
1602 with a character not a letter, digit or underscore; otherwise, enclose
1603 the entire variable name in braces.
1604 If `/~' appears, all of FILENAME through that `/' is discarded. */)
1606 Lisp_Object filename
;
1610 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1611 unsigned char *target
= NULL
;
1613 int substituted
= 0;
1615 Lisp_Object handler
;
1617 CHECK_STRING (filename
);
1619 /* If the file name has special constructs in it,
1620 call the corresponding file handler. */
1621 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1622 if (!NILP (handler
))
1623 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1625 nm
= SDATA (filename
);
1627 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1628 CORRECT_DIR_SEPS (nm
);
1629 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
1631 endp
= nm
+ SBYTES (filename
);
1633 /* If /~ or // appears, discard everything through first slash. */
1634 p
= search_embedded_absfilename (nm
, endp
);
1636 /* Start over with the new string, so we check the file-name-handler
1637 again. Important with filenames like "/home/foo//:/hello///there"
1638 which whould substitute to "/:/hello///there" rather than "/there". */
1639 return Fsubstitute_in_file_name
1640 (make_specified_string (p
, -1, endp
- p
,
1641 STRING_MULTIBYTE (filename
)));
1644 /* See if any variables are substituted into the string
1645 and find the total length of their values in `total' */
1647 for (p
= nm
; p
!= endp
;)
1657 /* "$$" means a single "$" */
1666 while (p
!= endp
&& *p
!= '}') p
++;
1667 if (*p
!= '}') goto missingclose
;
1673 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1677 /* Copy out the variable name */
1678 target
= (unsigned char *) alloca (s
- o
+ 1);
1679 strncpy (target
, o
, s
- o
);
1682 strupr (target
); /* $home == $HOME etc. */
1685 /* Get variable value */
1686 o
= (unsigned char *) egetenv (target
);
1688 { /* Eight-bit chars occupy upto 2 bytes in multibyte. */
1689 total
+= strlen (o
) * (STRING_MULTIBYTE (filename
) ? 2 : 1);
1699 /* If substitution required, recopy the string and do it */
1700 /* Make space in stack frame for the new copy */
1701 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
1704 /* Copy the rest of the name through, replacing $ constructs with values */
1721 while (p
!= endp
&& *p
!= '}') p
++;
1722 if (*p
!= '}') goto missingclose
;
1728 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1732 /* Copy out the variable name */
1733 target
= (unsigned char *) alloca (s
- o
+ 1);
1734 strncpy (target
, o
, s
- o
);
1737 strupr (target
); /* $home == $HOME etc. */
1740 /* Get variable value */
1741 o
= (unsigned char *) egetenv (target
);
1745 strcpy (x
, target
); x
+= strlen (target
);
1747 else if (STRING_MULTIBYTE (filename
))
1749 /* If the original string is multibyte,
1750 convert what we substitute into multibyte. */
1754 c
= unibyte_char_to_multibyte (c
);
1755 x
+= CHAR_STRING (c
, x
);
1767 /* If /~ or // appears, discard everything through first slash. */
1768 while ((p
= search_embedded_absfilename (xnm
, x
)))
1769 /* This time we do not start over because we've already expanded envvars
1770 and replaced $$ with $. Maybe we should start over as well, but we'd
1771 need to quote some $ to $$ first. */
1774 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
1777 error ("Bad format environment-variable substitution");
1779 error ("Missing \"}\" in environment-variable substitution");
1781 error ("Substituting nonexistent environment variable \"%s\"", target
);
1787 /* A slightly faster and more convenient way to get
1788 (directory-file-name (expand-file-name FOO)). */
1791 expand_and_dir_to_file (filename
, defdir
)
1792 Lisp_Object filename
, defdir
;
1794 register Lisp_Object absname
;
1796 absname
= Fexpand_file_name (filename
, defdir
);
1798 /* Remove final slash, if any (unless this is the root dir).
1799 stat behaves differently depending! */
1800 if (SCHARS (absname
) > 1
1801 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
1802 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
1803 /* We cannot take shortcuts; they might be wrong for magic file names. */
1804 absname
= Fdirectory_file_name (absname
);
1808 /* Signal an error if the file ABSNAME already exists.
1809 If INTERACTIVE is nonzero, ask the user whether to proceed,
1810 and bypass the error if the user says to go ahead.
1811 QUERYSTRING is a name for the action that is being considered
1814 *STATPTR is used to store the stat information if the file exists.
1815 If the file does not exist, STATPTR->st_mode is set to 0.
1816 If STATPTR is null, we don't store into it.
1818 If QUICK is nonzero, we ask for y or n, not yes or no. */
1821 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
1822 Lisp_Object absname
;
1823 unsigned char *querystring
;
1825 struct stat
*statptr
;
1828 register Lisp_Object tem
, encoded_filename
;
1829 struct stat statbuf
;
1830 struct gcpro gcpro1
;
1832 encoded_filename
= ENCODE_FILE (absname
);
1834 /* stat is a good way to tell whether the file exists,
1835 regardless of what access permissions it has. */
1836 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
1839 xsignal2 (Qfile_already_exists
,
1840 build_string ("File already exists"), absname
);
1842 tem
= format2 ("File %s already exists; %s anyway? ",
1843 absname
, build_string (querystring
));
1845 tem
= Fy_or_n_p (tem
);
1847 tem
= do_yes_or_no_p (tem
);
1850 xsignal2 (Qfile_already_exists
,
1851 build_string ("File already exists"), absname
);
1858 statptr
->st_mode
= 0;
1863 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
1864 "fCopy file: \nGCopy %s to file: \np\nP",
1865 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
1866 If NEWNAME names a directory, copy FILE there.
1868 This function always sets the file modes of the output file to match
1871 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1872 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1873 signal a `file-already-exists' error without overwriting. If
1874 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1875 about overwriting; this is what happens in interactive use with M-x.
1876 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1879 Fourth arg KEEP-TIME non-nil means give the output file the same
1880 last-modified time as the old one. (This works on only some systems.)
1882 A prefix arg makes KEEP-TIME non-nil.
1884 If PRESERVE-UID-GID is non-nil, we try to transfer the
1885 uid and gid of FILE to NEWNAME. */)
1886 (file
, newname
, ok_if_already_exists
, keep_time
, preserve_uid_gid
)
1887 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
1888 Lisp_Object preserve_uid_gid
;
1891 char buf
[16 * 1024];
1892 struct stat st
, out_st
;
1893 Lisp_Object handler
;
1894 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1895 int count
= SPECPDL_INDEX ();
1896 int input_file_statable_p
;
1897 Lisp_Object encoded_file
, encoded_newname
;
1899 encoded_file
= encoded_newname
= Qnil
;
1900 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
1901 CHECK_STRING (file
);
1902 CHECK_STRING (newname
);
1904 if (!NILP (Ffile_directory_p (newname
)))
1905 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
1907 newname
= Fexpand_file_name (newname
, Qnil
);
1909 file
= Fexpand_file_name (file
, Qnil
);
1911 /* If the input file name has special constructs in it,
1912 call the corresponding file handler. */
1913 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1914 /* Likewise for output file name. */
1916 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1917 if (!NILP (handler
))
1918 RETURN_UNGCPRO (call6 (handler
, Qcopy_file
, file
, newname
,
1919 ok_if_already_exists
, keep_time
, preserve_uid_gid
));
1921 encoded_file
= ENCODE_FILE (file
);
1922 encoded_newname
= ENCODE_FILE (newname
);
1924 if (NILP (ok_if_already_exists
)
1925 || INTEGERP (ok_if_already_exists
))
1926 barf_or_query_if_file_exists (newname
, "copy to it",
1927 INTEGERP (ok_if_already_exists
), &out_st
, 0);
1928 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
1932 if (!CopyFile (SDATA (encoded_file
),
1933 SDATA (encoded_newname
),
1935 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
1936 /* CopyFile retains the timestamp by default. */
1937 else if (NILP (keep_time
))
1943 EMACS_GET_TIME (now
);
1944 filename
= SDATA (encoded_newname
);
1946 /* Ensure file is writable while its modified time is set. */
1947 attributes
= GetFileAttributes (filename
);
1948 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
1949 if (set_file_times (filename
, now
, now
))
1951 /* Restore original attributes. */
1952 SetFileAttributes (filename
, attributes
);
1953 xsignal2 (Qfile_date_error
,
1954 build_string ("Cannot set file date"), newname
);
1956 /* Restore original attributes. */
1957 SetFileAttributes (filename
, attributes
);
1959 #else /* not WINDOWSNT */
1961 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
1965 report_file_error ("Opening input file", Fcons (file
, Qnil
));
1967 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1969 /* We can only copy regular files and symbolic links. Other files are not
1971 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1973 #if !defined (MSDOS) || __DJGPP__ > 1
1974 if (out_st
.st_mode
!= 0
1975 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
1978 report_file_error ("Input and output files are the same",
1979 Fcons (file
, Fcons (newname
, Qnil
)));
1983 #if defined (S_ISREG) && defined (S_ISLNK)
1984 if (input_file_statable_p
)
1986 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1988 #if defined (EISDIR)
1989 /* Get a better looking error message. */
1992 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
1995 #endif /* S_ISREG && S_ISLNK */
1998 /* System's default file type was set to binary by _fmode in emacs.c. */
1999 ofd
= emacs_open (SDATA (encoded_newname
),
2000 O_WRONLY
| O_TRUNC
| O_CREAT
2001 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2002 S_IREAD
| S_IWRITE
);
2003 #else /* not MSDOS */
2004 ofd
= emacs_open (SDATA (encoded_newname
),
2005 O_WRONLY
| O_TRUNC
| O_CREAT
2006 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2008 #endif /* not MSDOS */
2010 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2012 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2016 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2017 if (emacs_write (ofd
, buf
, n
) != n
)
2018 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2022 /* Preserve the original file modes, and if requested, also its
2024 if (input_file_statable_p
)
2026 if (! NILP (preserve_uid_gid
))
2027 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2028 fchmod (ofd
, st
.st_mode
& 07777);
2030 #endif /* not MSDOS */
2032 /* Closing the output clobbers the file times on some systems. */
2033 if (emacs_close (ofd
) < 0)
2034 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2036 if (input_file_statable_p
)
2038 if (!NILP (keep_time
))
2040 EMACS_TIME atime
, mtime
;
2041 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2042 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2043 if (set_file_times (SDATA (encoded_newname
),
2045 xsignal2 (Qfile_date_error
,
2046 build_string ("Cannot set file date"), newname
);
2052 #if defined (__DJGPP__) && __DJGPP__ > 1
2053 if (input_file_statable_p
)
2055 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2056 and if it can't, it tells so. Otherwise, under MSDOS we usually
2057 get only the READ bit, which will make the copied file read-only,
2058 so it's better not to chmod at all. */
2059 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2060 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2062 #endif /* DJGPP version 2 or newer */
2063 #endif /* not WINDOWSNT */
2065 /* Discard the unwind protects. */
2066 specpdl_ptr
= specpdl
+ count
;
2072 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2073 Smake_directory_internal
, 1, 1, 0,
2074 doc
: /* Create a new directory named DIRECTORY. */)
2076 Lisp_Object directory
;
2078 const unsigned char *dir
;
2079 Lisp_Object handler
;
2080 Lisp_Object encoded_dir
;
2082 CHECK_STRING (directory
);
2083 directory
= Fexpand_file_name (directory
, Qnil
);
2085 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2086 if (!NILP (handler
))
2087 return call2 (handler
, Qmake_directory_internal
, directory
);
2089 encoded_dir
= ENCODE_FILE (directory
);
2091 dir
= SDATA (encoded_dir
);
2094 if (mkdir (dir
) != 0)
2096 if (mkdir (dir
, 0777) != 0)
2098 report_file_error ("Creating directory", list1 (directory
));
2103 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2104 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2106 Lisp_Object directory
;
2108 const unsigned char *dir
;
2109 Lisp_Object handler
;
2110 Lisp_Object encoded_dir
;
2112 CHECK_STRING (directory
);
2113 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2115 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2116 if (!NILP (handler
))
2117 return call2 (handler
, Qdelete_directory
, directory
);
2119 if (delete_by_moving_to_trash
)
2120 return call1 (Qmove_file_to_trash
, directory
);
2122 encoded_dir
= ENCODE_FILE (directory
);
2124 dir
= SDATA (encoded_dir
);
2126 if (rmdir (dir
) != 0)
2127 report_file_error ("Removing directory", list1 (directory
));
2132 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2133 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2134 If file has multiple names, it continues to exist with the other names. */)
2136 Lisp_Object filename
;
2138 Lisp_Object handler
;
2139 Lisp_Object encoded_file
;
2140 struct gcpro gcpro1
;
2143 if (!NILP (Ffile_directory_p (filename
))
2144 && NILP (Ffile_symlink_p (filename
)))
2145 xsignal2 (Qfile_error
,
2146 build_string ("Removing old name: is a directory"),
2149 filename
= Fexpand_file_name (filename
, Qnil
);
2151 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2152 if (!NILP (handler
))
2153 return call2 (handler
, Qdelete_file
, filename
);
2155 if (delete_by_moving_to_trash
)
2156 return call1 (Qmove_file_to_trash
, filename
);
2158 encoded_file
= ENCODE_FILE (filename
);
2160 if (0 > unlink (SDATA (encoded_file
)))
2161 report_file_error ("Removing old name", list1 (filename
));
2166 internal_delete_file_1 (ignore
)
2172 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2175 internal_delete_file (filename
)
2176 Lisp_Object filename
;
2179 tem
= internal_condition_case_1 (Fdelete_file
, filename
,
2180 Qt
, internal_delete_file_1
);
2184 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2185 "fRename file: \nGRename %s to file: \np",
2186 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2187 If file has names other than FILE, it continues to have those names.
2188 Signals a `file-already-exists' error if a file NEWNAME already exists
2189 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2190 A number as third arg means request confirmation if NEWNAME already exists.
2191 This is what happens in interactive use with M-x. */)
2192 (file
, newname
, ok_if_already_exists
)
2193 Lisp_Object file
, newname
, ok_if_already_exists
;
2195 Lisp_Object handler
;
2196 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2197 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2199 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2200 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2201 CHECK_STRING (file
);
2202 CHECK_STRING (newname
);
2203 file
= Fexpand_file_name (file
, Qnil
);
2205 if ((!NILP (Ffile_directory_p (newname
)))
2207 /* If the file names are identical but for the case,
2208 don't attempt to move directory to itself. */
2209 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2212 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2214 newname
= Fexpand_file_name (newname
, Qnil
);
2216 /* If the file name has special constructs in it,
2217 call the corresponding file handler. */
2218 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2220 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2221 if (!NILP (handler
))
2222 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2223 file
, newname
, ok_if_already_exists
));
2225 encoded_file
= ENCODE_FILE (file
);
2226 encoded_newname
= ENCODE_FILE (newname
);
2229 /* If the file names are identical but for the case, don't ask for
2230 confirmation: they simply want to change the letter-case of the
2232 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2234 if (NILP (ok_if_already_exists
)
2235 || INTEGERP (ok_if_already_exists
))
2236 barf_or_query_if_file_exists (newname
, "rename to it",
2237 INTEGERP (ok_if_already_exists
), 0, 0);
2238 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2243 symlink_target
= Ffile_symlink_p (file
);
2244 if (! NILP (symlink_target
))
2245 Fmake_symbolic_link (symlink_target
, newname
,
2246 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2249 Fcopy_file (file
, newname
,
2250 /* We have already prompted if it was an integer,
2251 so don't have copy-file prompt again. */
2252 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2255 Fdelete_file (file
);
2258 report_file_error ("Renaming", list2 (file
, newname
));
2264 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2265 "fAdd name to file: \nGName to add to %s: \np",
2266 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2267 Signals a `file-already-exists' error if a file NEWNAME already exists
2268 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2269 A number as third arg means request confirmation if NEWNAME already exists.
2270 This is what happens in interactive use with M-x. */)
2271 (file
, newname
, ok_if_already_exists
)
2272 Lisp_Object file
, newname
, ok_if_already_exists
;
2274 Lisp_Object handler
;
2275 Lisp_Object encoded_file
, encoded_newname
;
2276 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2278 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2279 encoded_file
= encoded_newname
= Qnil
;
2280 CHECK_STRING (file
);
2281 CHECK_STRING (newname
);
2282 file
= Fexpand_file_name (file
, Qnil
);
2284 if (!NILP (Ffile_directory_p (newname
)))
2285 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2287 newname
= Fexpand_file_name (newname
, Qnil
);
2289 /* If the file name has special constructs in it,
2290 call the corresponding file handler. */
2291 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2292 if (!NILP (handler
))
2293 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2294 newname
, ok_if_already_exists
));
2296 /* If the new name has special constructs in it,
2297 call the corresponding file handler. */
2298 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2299 if (!NILP (handler
))
2300 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2301 newname
, ok_if_already_exists
));
2303 encoded_file
= ENCODE_FILE (file
);
2304 encoded_newname
= ENCODE_FILE (newname
);
2306 if (NILP (ok_if_already_exists
)
2307 || INTEGERP (ok_if_already_exists
))
2308 barf_or_query_if_file_exists (newname
, "make it a new name",
2309 INTEGERP (ok_if_already_exists
), 0, 0);
2311 unlink (SDATA (newname
));
2312 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2313 report_file_error ("Adding new name", list2 (file
, newname
));
2319 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2320 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2321 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2322 Both args must be strings.
2323 Signals a `file-already-exists' error if a file LINKNAME already exists
2324 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2325 A number as third arg means request confirmation if LINKNAME already exists.
2326 This happens for interactive use with M-x. */)
2327 (filename
, linkname
, ok_if_already_exists
)
2328 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2330 Lisp_Object handler
;
2331 Lisp_Object encoded_filename
, encoded_linkname
;
2332 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2334 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2335 encoded_filename
= encoded_linkname
= Qnil
;
2336 CHECK_STRING (filename
);
2337 CHECK_STRING (linkname
);
2338 /* If the link target has a ~, we must expand it to get
2339 a truly valid file name. Otherwise, do not expand;
2340 we want to permit links to relative file names. */
2341 if (SREF (filename
, 0) == '~')
2342 filename
= Fexpand_file_name (filename
, Qnil
);
2344 if (!NILP (Ffile_directory_p (linkname
)))
2345 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2347 linkname
= Fexpand_file_name (linkname
, Qnil
);
2349 /* If the file name has special constructs in it,
2350 call the corresponding file handler. */
2351 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2352 if (!NILP (handler
))
2353 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2354 linkname
, ok_if_already_exists
));
2356 /* If the new link name has special constructs in it,
2357 call the corresponding file handler. */
2358 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2359 if (!NILP (handler
))
2360 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2361 linkname
, ok_if_already_exists
));
2364 encoded_filename
= ENCODE_FILE (filename
);
2365 encoded_linkname
= ENCODE_FILE (linkname
);
2367 if (NILP (ok_if_already_exists
)
2368 || INTEGERP (ok_if_already_exists
))
2369 barf_or_query_if_file_exists (linkname
, "make it a link",
2370 INTEGERP (ok_if_already_exists
), 0, 0);
2371 if (0 > symlink (SDATA (encoded_filename
),
2372 SDATA (encoded_linkname
)))
2374 /* If we didn't complain already, silently delete existing file. */
2375 if (errno
== EEXIST
)
2377 unlink (SDATA (encoded_linkname
));
2378 if (0 <= symlink (SDATA (encoded_filename
),
2379 SDATA (encoded_linkname
)))
2386 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2393 xsignal1 (Qfile_error
, build_string ("Symbolic links are not supported"));
2395 #endif /* S_IFLNK */
2399 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2401 doc
: /* Return t if file FILENAME specifies an absolute file name.
2402 On Unix, this is a name starting with a `/' or a `~'. */)
2404 Lisp_Object filename
;
2406 CHECK_STRING (filename
);
2407 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
2410 /* Return nonzero if file FILENAME exists and can be executed. */
2413 check_executable (filename
)
2417 int len
= strlen (filename
);
2420 if (stat (filename
, &st
) < 0)
2422 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2423 return ((st
.st_mode
& S_IEXEC
) != 0);
2425 return (S_ISREG (st
.st_mode
)
2427 && (xstrcasecmp ((suffix
= filename
+ len
-4), ".com") == 0
2428 || xstrcasecmp (suffix
, ".exe") == 0
2429 || xstrcasecmp (suffix
, ".bat") == 0)
2430 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2431 #endif /* not WINDOWSNT */
2432 #else /* not DOS_NT */
2433 #ifdef HAVE_EUIDACCESS
2434 return (euidaccess (filename
, 1) >= 0);
2436 /* Access isn't quite right because it uses the real uid
2437 and we really want to test with the effective uid.
2438 But Unix doesn't give us a right way to do it. */
2439 return (access (filename
, 1) >= 0);
2441 #endif /* not DOS_NT */
2444 /* Return nonzero if file FILENAME exists and can be written. */
2447 check_writable (filename
)
2452 if (stat (filename
, &st
) < 0)
2454 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2455 #else /* not MSDOS */
2456 #ifdef HAVE_EUIDACCESS
2457 return (euidaccess (filename
, 2) >= 0);
2459 /* Access isn't quite right because it uses the real uid
2460 and we really want to test with the effective uid.
2461 But Unix doesn't give us a right way to do it.
2462 Opening with O_WRONLY could work for an ordinary file,
2463 but would lose for directories. */
2464 return (access (filename
, 2) >= 0);
2466 #endif /* not MSDOS */
2469 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2470 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
2471 See also `file-readable-p' and `file-attributes'.
2472 This returns nil for a symlink to a nonexistent file.
2473 Use `file-symlink-p' to test for such links. */)
2475 Lisp_Object filename
;
2477 Lisp_Object absname
;
2478 Lisp_Object handler
;
2479 struct stat statbuf
;
2481 CHECK_STRING (filename
);
2482 absname
= Fexpand_file_name (filename
, Qnil
);
2484 /* If the file name has special constructs in it,
2485 call the corresponding file handler. */
2486 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2487 if (!NILP (handler
))
2488 return call2 (handler
, Qfile_exists_p
, absname
);
2490 absname
= ENCODE_FILE (absname
);
2492 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
2495 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2496 doc
: /* Return t if FILENAME can be executed by you.
2497 For a directory, this means you can access files in that directory. */)
2499 Lisp_Object filename
;
2501 Lisp_Object absname
;
2502 Lisp_Object handler
;
2504 CHECK_STRING (filename
);
2505 absname
= Fexpand_file_name (filename
, Qnil
);
2507 /* If the file name has special constructs in it,
2508 call the corresponding file handler. */
2509 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2510 if (!NILP (handler
))
2511 return call2 (handler
, Qfile_executable_p
, absname
);
2513 absname
= ENCODE_FILE (absname
);
2515 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
2518 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2519 doc
: /* Return t if file FILENAME exists and you can read it.
2520 See also `file-exists-p' and `file-attributes'. */)
2522 Lisp_Object filename
;
2524 Lisp_Object absname
;
2525 Lisp_Object handler
;
2528 struct stat statbuf
;
2530 CHECK_STRING (filename
);
2531 absname
= Fexpand_file_name (filename
, Qnil
);
2533 /* If the file name has special constructs in it,
2534 call the corresponding file handler. */
2535 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2536 if (!NILP (handler
))
2537 return call2 (handler
, Qfile_readable_p
, absname
);
2539 absname
= ENCODE_FILE (absname
);
2541 #if defined(DOS_NT) || defined(macintosh)
2542 /* Under MS-DOS, Windows, and Macintosh, open does not work for
2544 if (access (SDATA (absname
), 0) == 0)
2547 #else /* not DOS_NT and not macintosh */
2549 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2550 /* Opening a fifo without O_NONBLOCK can wait.
2551 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2552 except in the case of a fifo, on a system which handles it. */
2553 desc
= stat (SDATA (absname
), &statbuf
);
2556 if (S_ISFIFO (statbuf
.st_mode
))
2557 flags
|= O_NONBLOCK
;
2559 desc
= emacs_open (SDATA (absname
), flags
, 0);
2564 #endif /* not DOS_NT and not macintosh */
2567 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2569 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2570 doc
: /* Return t if file FILENAME can be written or created by you. */)
2572 Lisp_Object filename
;
2574 Lisp_Object absname
, dir
, encoded
;
2575 Lisp_Object handler
;
2576 struct stat statbuf
;
2578 CHECK_STRING (filename
);
2579 absname
= Fexpand_file_name (filename
, Qnil
);
2581 /* If the file name has special constructs in it,
2582 call the corresponding file handler. */
2583 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2584 if (!NILP (handler
))
2585 return call2 (handler
, Qfile_writable_p
, absname
);
2587 encoded
= ENCODE_FILE (absname
);
2588 if (stat (SDATA (encoded
), &statbuf
) >= 0)
2589 return (check_writable (SDATA (encoded
))
2592 dir
= Ffile_name_directory (absname
);
2595 dir
= Fdirectory_file_name (dir
);
2598 dir
= ENCODE_FILE (dir
);
2600 /* The read-only attribute of the parent directory doesn't affect
2601 whether a file or directory can be created within it. Some day we
2602 should check ACLs though, which do affect this. */
2603 if (stat (SDATA (dir
), &statbuf
) < 0)
2605 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2607 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
2612 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2613 doc
: /* Access file FILENAME, and get an error if that does not work.
2614 The second argument STRING is used in the error message.
2615 If there is no error, returns nil. */)
2617 Lisp_Object filename
, string
;
2619 Lisp_Object handler
, encoded_filename
, absname
;
2622 CHECK_STRING (filename
);
2623 absname
= Fexpand_file_name (filename
, Qnil
);
2625 CHECK_STRING (string
);
2627 /* If the file name has special constructs in it,
2628 call the corresponding file handler. */
2629 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
2630 if (!NILP (handler
))
2631 return call3 (handler
, Qaccess_file
, absname
, string
);
2633 encoded_filename
= ENCODE_FILE (absname
);
2635 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
2637 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
2643 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2644 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
2645 The value is the link target, as a string.
2646 Otherwise it returns nil.
2648 This function returns t when given the name of a symlink that
2649 points to a nonexistent file. */)
2651 Lisp_Object filename
;
2653 Lisp_Object handler
;
2655 CHECK_STRING (filename
);
2656 filename
= Fexpand_file_name (filename
, Qnil
);
2658 /* If the file name has special constructs in it,
2659 call the corresponding file handler. */
2660 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2661 if (!NILP (handler
))
2662 return call2 (handler
, Qfile_symlink_p
, filename
);
2671 filename
= ENCODE_FILE (filename
);
2678 buf
= (char *) xrealloc (buf
, bufsize
);
2679 bzero (buf
, bufsize
);
2682 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
2686 /* HP-UX reports ERANGE if buffer is too small. */
2687 if (errno
== ERANGE
)
2697 while (valsize
>= bufsize
);
2699 val
= make_string (buf
, valsize
);
2700 if (buf
[0] == '/' && index (buf
, ':'))
2701 val
= concat2 (build_string ("/:"), val
);
2703 val
= DECODE_FILE (val
);
2706 #else /* not S_IFLNK */
2708 #endif /* not S_IFLNK */
2711 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2712 doc
: /* Return t if FILENAME names an existing directory.
2713 Symbolic links to directories count as directories.
2714 See `file-symlink-p' to distinguish symlinks. */)
2716 Lisp_Object filename
;
2718 register Lisp_Object absname
;
2720 Lisp_Object handler
;
2722 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2724 /* If the file name has special constructs in it,
2725 call the corresponding file handler. */
2726 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2727 if (!NILP (handler
))
2728 return call2 (handler
, Qfile_directory_p
, absname
);
2730 absname
= ENCODE_FILE (absname
);
2732 if (stat (SDATA (absname
), &st
) < 0)
2734 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2737 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2738 doc
: /* Return t if file FILENAME names a directory you can open.
2739 For the value to be t, FILENAME must specify the name of a directory as a file,
2740 and the directory must allow you to open files in it. In order to use a
2741 directory as a buffer's current directory, this predicate must return true.
2742 A directory name spec may be given instead; then the value is t
2743 if the directory so specified exists and really is a readable and
2744 searchable directory. */)
2746 Lisp_Object filename
;
2748 Lisp_Object handler
;
2750 struct gcpro gcpro1
;
2752 /* If the file name has special constructs in it,
2753 call the corresponding file handler. */
2754 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2755 if (!NILP (handler
))
2756 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2759 tem
= (NILP (Ffile_directory_p (filename
))
2760 || NILP (Ffile_executable_p (filename
)));
2762 return tem
? Qnil
: Qt
;
2765 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2766 doc
: /* Return t if FILENAME names a regular file.
2767 This is the sort of file that holds an ordinary stream of data bytes.
2768 Symbolic links to regular files count as regular files.
2769 See `file-symlink-p' to distinguish symlinks. */)
2771 Lisp_Object filename
;
2773 register Lisp_Object absname
;
2775 Lisp_Object handler
;
2777 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2779 /* If the file name has special constructs in it,
2780 call the corresponding file handler. */
2781 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2782 if (!NILP (handler
))
2783 return call2 (handler
, Qfile_regular_p
, absname
);
2785 absname
= ENCODE_FILE (absname
);
2790 Lisp_Object tem
= Vw32_get_true_file_attributes
;
2792 /* Tell stat to use expensive method to get accurate info. */
2793 Vw32_get_true_file_attributes
= Qt
;
2794 result
= stat (SDATA (absname
), &st
);
2795 Vw32_get_true_file_attributes
= tem
;
2799 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2802 if (stat (SDATA (absname
), &st
) < 0)
2804 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2808 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2809 doc
: /* Return mode bits of file named FILENAME, as an integer.
2810 Return nil, if file does not exist or is not accessible. */)
2812 Lisp_Object filename
;
2814 Lisp_Object absname
;
2816 Lisp_Object handler
;
2818 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2820 /* If the file name has special constructs in it,
2821 call the corresponding file handler. */
2822 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2823 if (!NILP (handler
))
2824 return call2 (handler
, Qfile_modes
, absname
);
2826 absname
= ENCODE_FILE (absname
);
2828 if (stat (SDATA (absname
), &st
) < 0)
2830 #if defined (MSDOS) && __DJGPP__ < 2
2831 if (check_executable (SDATA (absname
)))
2832 st
.st_mode
|= S_IEXEC
;
2833 #endif /* MSDOS && __DJGPP__ < 2 */
2835 return make_number (st
.st_mode
& 07777);
2838 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
2839 "(let ((file (read-file-name \"File: \"))) \
2840 (list file (read-file-modes nil file)))",
2841 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
2842 Only the 12 low bits of MODE are used. */)
2844 Lisp_Object filename
, mode
;
2846 Lisp_Object absname
, encoded_absname
;
2847 Lisp_Object handler
;
2849 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2850 CHECK_NUMBER (mode
);
2852 /* If the file name has special constructs in it,
2853 call the corresponding file handler. */
2854 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2855 if (!NILP (handler
))
2856 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2858 encoded_absname
= ENCODE_FILE (absname
);
2860 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
2861 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2866 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2867 doc
: /* Set the file permission bits for newly created files.
2868 The argument MODE should be an integer; only the low 9 bits are used.
2869 This setting is inherited by subprocesses. */)
2873 CHECK_NUMBER (mode
);
2875 umask ((~ XINT (mode
)) & 0777);
2880 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2881 doc
: /* Return the default file protection for created files.
2882 The value is an integer. */)
2888 realmask
= umask (0);
2891 XSETINT (value
, (~ realmask
) & 0777);
2895 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
2897 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
2898 doc
: /* Set times of file FILENAME to TIME.
2899 Set both access and modification times.
2900 Return t on success, else nil.
2901 Use the current time if TIME is nil. TIME is in the format of
2904 Lisp_Object filename
, time
;
2906 Lisp_Object absname
, encoded_absname
;
2907 Lisp_Object handler
;
2911 if (! lisp_time_argument (time
, &sec
, &usec
))
2912 error ("Invalid time specification");
2914 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2916 /* If the file name has special constructs in it,
2917 call the corresponding file handler. */
2918 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
2919 if (!NILP (handler
))
2920 return call3 (handler
, Qset_file_times
, absname
, time
);
2922 encoded_absname
= ENCODE_FILE (absname
);
2927 EMACS_SET_SECS (t
, sec
);
2928 EMACS_SET_USECS (t
, usec
);
2930 if (set_file_times (SDATA (encoded_absname
), t
, t
))
2935 /* Setting times on a directory always fails. */
2936 if (stat (SDATA (encoded_absname
), &st
) == 0
2937 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
2940 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
2949 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2950 doc
: /* Tell Unix to finish all pending disk updates. */)
2957 #endif /* HAVE_SYNC */
2959 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2960 doc
: /* Return t if file FILE1 is newer than file FILE2.
2961 If FILE1 does not exist, the answer is nil;
2962 otherwise, if FILE2 does not exist, the answer is t. */)
2964 Lisp_Object file1
, file2
;
2966 Lisp_Object absname1
, absname2
;
2969 Lisp_Object handler
;
2970 struct gcpro gcpro1
, gcpro2
;
2972 CHECK_STRING (file1
);
2973 CHECK_STRING (file2
);
2976 GCPRO2 (absname1
, file2
);
2977 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2978 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2981 /* If the file name has special constructs in it,
2982 call the corresponding file handler. */
2983 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
2985 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
2986 if (!NILP (handler
))
2987 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
2989 GCPRO2 (absname1
, absname2
);
2990 absname1
= ENCODE_FILE (absname1
);
2991 absname2
= ENCODE_FILE (absname2
);
2994 if (stat (SDATA (absname1
), &st
) < 0)
2997 mtime1
= st
.st_mtime
;
2999 if (stat (SDATA (absname2
), &st
) < 0)
3002 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3006 Lisp_Object Qfind_buffer_file_type
;
3009 #ifndef READ_BUF_SIZE
3010 #define READ_BUF_SIZE (64 << 10)
3013 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3015 /* This function is called after Lisp functions to decide a coding
3016 system are called, or when they cause an error. Before they are
3017 called, the current buffer is set unibyte and it contains only a
3018 newly inserted text (thus the buffer was empty before the
3021 The functions may set markers, overlays, text properties, or even
3022 alter the buffer contents, change the current buffer.
3024 Here, we reset all those changes by:
3025 o set back the current buffer.
3026 o move all markers and overlays to BEG.
3027 o remove all text properties.
3028 o set back the buffer multibyteness. */
3031 decide_coding_unwind (unwind_data
)
3032 Lisp_Object unwind_data
;
3034 Lisp_Object multibyte
, undo_list
, buffer
;
3036 multibyte
= XCAR (unwind_data
);
3037 unwind_data
= XCDR (unwind_data
);
3038 undo_list
= XCAR (unwind_data
);
3039 buffer
= XCDR (unwind_data
);
3041 if (current_buffer
!= XBUFFER (buffer
))
3042 set_buffer_internal (XBUFFER (buffer
));
3043 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3044 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3045 BUF_INTERVALS (current_buffer
) = 0;
3046 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3048 /* Now we are safe to change the buffer's multibyteness directly. */
3049 current_buffer
->enable_multibyte_characters
= multibyte
;
3050 current_buffer
->undo_list
= undo_list
;
3056 /* Used to pass values from insert-file-contents to read_non_regular. */
3058 static int non_regular_fd
;
3059 static int non_regular_inserted
;
3060 static int non_regular_nbytes
;
3063 /* Read from a non-regular file.
3064 Read non_regular_trytry bytes max from non_regular_fd.
3065 Non_regular_inserted specifies where to put the read bytes.
3066 Value is the number of bytes read. */
3075 nbytes
= emacs_read (non_regular_fd
,
3076 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3077 non_regular_nbytes
);
3079 return make_number (nbytes
);
3083 /* Condition-case handler used when reading from non-regular files
3084 in insert-file-contents. */
3087 read_non_regular_quit ()
3093 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3095 doc
: /* Insert contents of file FILENAME after point.
3096 Returns list of absolute file name and number of characters inserted.
3097 If second argument VISIT is non-nil, the buffer's visited filename and
3098 last save file modtime are set, and it is marked unmodified. If
3099 visiting and the file does not exist, visiting is completed before the
3102 The optional third and fourth arguments BEG and END specify what portion
3103 of the file to insert. These arguments count bytes in the file, not
3104 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3106 If optional fifth argument REPLACE is non-nil, replace the current
3107 buffer contents (in the accessible portion) with the file contents.
3108 This is better than simply deleting and inserting the whole thing
3109 because (1) it preserves some marker positions and (2) it puts less data
3110 in the undo list. When REPLACE is non-nil, the second return value is
3111 the number of characters that replace previous buffer contents.
3113 This function does code conversion according to the value of
3114 `coding-system-for-read' or `file-coding-system-alist', and sets the
3115 variable `last-coding-system-used' to the coding system actually used. */)
3116 (filename
, visit
, beg
, end
, replace
)
3117 Lisp_Object filename
, visit
, beg
, end
, replace
;
3123 register int how_much
;
3124 register int unprocessed
;
3125 int count
= SPECPDL_INDEX ();
3126 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3127 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3130 int not_regular
= 0;
3131 unsigned char read_buf
[READ_BUF_SIZE
];
3132 struct coding_system coding
;
3133 unsigned char buffer
[1 << 14];
3134 int replace_handled
= 0;
3135 int set_coding_system
= 0;
3136 Lisp_Object coding_system
;
3138 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3139 int we_locked_file
= 0;
3141 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3142 error ("Cannot do file visiting in an indirect buffer");
3144 if (!NILP (current_buffer
->read_only
))
3145 Fbarf_if_buffer_read_only ();
3149 orig_filename
= Qnil
;
3152 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3154 CHECK_STRING (filename
);
3155 filename
= Fexpand_file_name (filename
, Qnil
);
3157 /* The value Qnil means that the coding system is not yet
3159 coding_system
= Qnil
;
3161 /* If the file name has special constructs in it,
3162 call the corresponding file handler. */
3163 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3164 if (!NILP (handler
))
3166 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3167 visit
, beg
, end
, replace
);
3168 if (CONSP (val
) && CONSP (XCDR (val
)))
3169 inserted
= XINT (XCAR (XCDR (val
)));
3173 orig_filename
= filename
;
3174 filename
= ENCODE_FILE (filename
);
3180 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3182 /* Tell stat to use expensive method to get accurate info. */
3183 Vw32_get_true_file_attributes
= Qt
;
3184 total
= stat (SDATA (filename
), &st
);
3185 Vw32_get_true_file_attributes
= tem
;
3189 if (stat (SDATA (filename
), &st
) < 0)
3190 #endif /* WINDOWSNT */
3192 if (fd
>= 0) emacs_close (fd
);
3195 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3198 if (!NILP (Vcoding_system_for_read
))
3199 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3204 /* This code will need to be changed in order to work on named
3205 pipes, and it's probably just not worth it. So we should at
3206 least signal an error. */
3207 if (!S_ISREG (st
.st_mode
))
3214 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3215 xsignal2 (Qfile_error
,
3216 build_string ("not a regular file"), orig_filename
);
3221 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3224 /* Replacement should preserve point as it preserves markers. */
3225 if (!NILP (replace
))
3226 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3228 record_unwind_protect (close_file_unwind
, make_number (fd
));
3230 /* Can happen on any platform that uses long as type of off_t, but allows
3231 file sizes to exceed 2Gb, so give a suitable message. */
3232 if (! not_regular
&& st
.st_size
< 0)
3233 error ("Maximum buffer size exceeded");
3235 /* Prevent redisplay optimizations. */
3236 current_buffer
->clip_changed
= 1;
3240 if (!NILP (beg
) || !NILP (end
))
3241 error ("Attempt to visit less than an entire file");
3242 if (BEG
< Z
&& NILP (replace
))
3243 error ("Cannot do file visiting in a non-empty buffer");
3249 XSETFASTINT (beg
, 0);
3257 XSETINT (end
, st
.st_size
);
3259 /* Arithmetic overflow can occur if an Emacs integer cannot
3260 represent the file size, or if the calculations below
3261 overflow. The calculations below double the file size
3262 twice, so check that it can be multiplied by 4 safely. */
3263 if (XINT (end
) != st
.st_size
3264 || st
.st_size
> INT_MAX
/ 4)
3265 error ("Maximum buffer size exceeded");
3267 /* The file size returned from stat may be zero, but data
3268 may be readable nonetheless, for example when this is a
3269 file in the /proc filesystem. */
3270 if (st
.st_size
== 0)
3271 XSETINT (end
, READ_BUF_SIZE
);
3275 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3277 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3278 setup_coding_system (coding_system
, &coding
);
3279 /* Ensure we set Vlast_coding_system_used. */
3280 set_coding_system
= 1;
3284 /* Decide the coding system to use for reading the file now
3285 because we can't use an optimized method for handling
3286 `coding:' tag if the current buffer is not empty. */
3287 if (!NILP (Vcoding_system_for_read
))
3288 coding_system
= Vcoding_system_for_read
;
3291 /* Don't try looking inside a file for a coding system
3292 specification if it is not seekable. */
3293 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3295 /* Find a coding system specified in the heading two
3296 lines or in the tailing several lines of the file.
3297 We assume that the 1K-byte and 3K-byte for heading
3298 and tailing respectively are sufficient for this
3302 if (st
.st_size
<= (1024 * 4))
3303 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3306 nread
= emacs_read (fd
, read_buf
, 1024);
3309 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3310 report_file_error ("Setting file position",
3311 Fcons (orig_filename
, Qnil
));
3312 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3317 error ("IO error reading %s: %s",
3318 SDATA (orig_filename
), emacs_strerror (errno
));
3321 struct buffer
*prev
= current_buffer
;
3325 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3327 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3328 buf
= XBUFFER (buffer
);
3330 delete_all_overlays (buf
);
3331 buf
->directory
= current_buffer
->directory
;
3332 buf
->read_only
= Qnil
;
3333 buf
->filename
= Qnil
;
3334 buf
->undo_list
= Qt
;
3335 eassert (buf
->overlays_before
== NULL
);
3336 eassert (buf
->overlays_after
== NULL
);
3338 set_buffer_internal (buf
);
3340 buf
->enable_multibyte_characters
= Qnil
;
3342 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3343 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3344 coding_system
= call2 (Vset_auto_coding_function
,
3345 filename
, make_number (nread
));
3346 set_buffer_internal (prev
);
3348 /* Discard the unwind protect for recovering the
3352 /* Rewind the file for the actual read done later. */
3353 if (lseek (fd
, 0, 0) < 0)
3354 report_file_error ("Setting file position",
3355 Fcons (orig_filename
, Qnil
));
3359 if (NILP (coding_system
))
3361 /* If we have not yet decided a coding system, check
3362 file-coding-system-alist. */
3363 Lisp_Object args
[6];
3365 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3366 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3367 coding_system
= Ffind_operation_coding_system (6, args
);
3368 if (CONSP (coding_system
))
3369 coding_system
= XCAR (coding_system
);
3373 if (NILP (coding_system
))
3374 coding_system
= Qundecided
;
3376 CHECK_CODING_SYSTEM (coding_system
);
3378 if (NILP (current_buffer
->enable_multibyte_characters
))
3379 /* We must suppress all character code conversion except for
3380 end-of-line conversion. */
3381 coding_system
= raw_text_coding_system (coding_system
);
3383 setup_coding_system (coding_system
, &coding
);
3384 /* Ensure we set Vlast_coding_system_used. */
3385 set_coding_system
= 1;
3388 /* If requested, replace the accessible part of the buffer
3389 with the file contents. Avoid replacing text at the
3390 beginning or end of the buffer that matches the file contents;
3391 that preserves markers pointing to the unchanged parts.
3393 Here we implement this feature in an optimized way
3394 for the case where code conversion is NOT needed.
3395 The following if-statement handles the case of conversion
3396 in a less optimal way.
3398 If the code conversion is "automatic" then we try using this
3399 method and hope for the best.
3400 But if we discover the need for conversion, we give up on this method
3401 and let the following if-statement handle the replace job. */
3404 && (NILP (coding_system
)
3405 || ! CODING_REQUIRE_DECODING (&coding
)))
3407 /* same_at_start and same_at_end count bytes,
3408 because file access counts bytes
3409 and BEG and END count bytes. */
3410 int same_at_start
= BEGV_BYTE
;
3411 int same_at_end
= ZV_BYTE
;
3413 /* There is still a possibility we will find the need to do code
3414 conversion. If that happens, we set this variable to 1 to
3415 give up on handling REPLACE in the optimized way. */
3416 int giveup_match_end
= 0;
3418 if (XINT (beg
) != 0)
3420 if (lseek (fd
, XINT (beg
), 0) < 0)
3421 report_file_error ("Setting file position",
3422 Fcons (orig_filename
, Qnil
));
3427 /* Count how many chars at the start of the file
3428 match the text at the beginning of the buffer. */
3433 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3435 error ("IO error reading %s: %s",
3436 SDATA (orig_filename
), emacs_strerror (errno
));
3437 else if (nread
== 0)
3440 if (CODING_REQUIRE_DETECTION (&coding
))
3442 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
3444 setup_coding_system (coding_system
, &coding
);
3447 if (CODING_REQUIRE_DECODING (&coding
))
3448 /* We found that the file should be decoded somehow.
3449 Let's give up here. */
3451 giveup_match_end
= 1;
3456 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3457 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3458 same_at_start
++, bufpos
++;
3459 /* If we found a discrepancy, stop the scan.
3460 Otherwise loop around and scan the next bufferful. */
3461 if (bufpos
!= nread
)
3465 /* If the file matches the buffer completely,
3466 there's no need to replace anything. */
3467 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3471 /* Truncate the buffer to the size of the file. */
3472 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3477 /* Count how many chars at the end of the file
3478 match the text at the end of the buffer. But, if we have
3479 already found that decoding is necessary, don't waste time. */
3480 while (!giveup_match_end
)
3482 int total_read
, nread
, bufpos
, curpos
, trial
;
3484 /* At what file position are we now scanning? */
3485 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3486 /* If the entire file matches the buffer tail, stop the scan. */
3489 /* How much can we scan in the next step? */
3490 trial
= min (curpos
, sizeof buffer
);
3491 if (lseek (fd
, curpos
- trial
, 0) < 0)
3492 report_file_error ("Setting file position",
3493 Fcons (orig_filename
, Qnil
));
3495 total_read
= nread
= 0;
3496 while (total_read
< trial
)
3498 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3500 error ("IO error reading %s: %s",
3501 SDATA (orig_filename
), emacs_strerror (errno
));
3502 else if (nread
== 0)
3504 total_read
+= nread
;
3507 /* Scan this bufferful from the end, comparing with
3508 the Emacs buffer. */
3509 bufpos
= total_read
;
3511 /* Compare with same_at_start to avoid counting some buffer text
3512 as matching both at the file's beginning and at the end. */
3513 while (bufpos
> 0 && same_at_end
> same_at_start
3514 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3515 same_at_end
--, bufpos
--;
3517 /* If we found a discrepancy, stop the scan.
3518 Otherwise loop around and scan the preceding bufferful. */
3521 /* If this discrepancy is because of code conversion,
3522 we cannot use this method; giveup and try the other. */
3523 if (same_at_end
> same_at_start
3524 && FETCH_BYTE (same_at_end
- 1) >= 0200
3525 && ! NILP (current_buffer
->enable_multibyte_characters
)
3526 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3527 giveup_match_end
= 1;
3536 if (! giveup_match_end
)
3540 /* We win! We can handle REPLACE the optimized way. */
3542 /* Extend the start of non-matching text area to multibyte
3543 character boundary. */
3544 if (! NILP (current_buffer
->enable_multibyte_characters
))
3545 while (same_at_start
> BEGV_BYTE
3546 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3549 /* Extend the end of non-matching text area to multibyte
3550 character boundary. */
3551 if (! NILP (current_buffer
->enable_multibyte_characters
))
3552 while (same_at_end
< ZV_BYTE
3553 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3556 /* Don't try to reuse the same piece of text twice. */
3557 overlap
= (same_at_start
- BEGV_BYTE
3558 - (same_at_end
+ st
.st_size
- ZV
));
3560 same_at_end
+= overlap
;
3562 /* Arrange to read only the nonmatching middle part of the file. */
3563 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3564 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3566 del_range_byte (same_at_start
, same_at_end
, 0);
3567 /* Insert from the file at the proper position. */
3568 temp
= BYTE_TO_CHAR (same_at_start
);
3569 SET_PT_BOTH (temp
, same_at_start
);
3571 /* If display currently starts at beginning of line,
3572 keep it that way. */
3573 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3574 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3576 replace_handled
= 1;
3580 /* If requested, replace the accessible part of the buffer
3581 with the file contents. Avoid replacing text at the
3582 beginning or end of the buffer that matches the file contents;
3583 that preserves markers pointing to the unchanged parts.
3585 Here we implement this feature for the case where code conversion
3586 is needed, in a simple way that needs a lot of memory.
3587 The preceding if-statement handles the case of no conversion
3588 in a more optimized way. */
3589 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3591 EMACS_INT same_at_start
= BEGV_BYTE
;
3592 EMACS_INT same_at_end
= ZV_BYTE
;
3593 EMACS_INT same_at_start_charpos
;
3594 EMACS_INT inserted_chars
;
3597 unsigned char *decoded
;
3599 int this_count
= SPECPDL_INDEX ();
3600 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3601 Lisp_Object conversion_buffer
;
3603 conversion_buffer
= code_conversion_save (1, multibyte
);
3605 /* First read the whole file, performing code conversion into
3606 CONVERSION_BUFFER. */
3608 if (lseek (fd
, XINT (beg
), 0) < 0)
3609 report_file_error ("Setting file position",
3610 Fcons (orig_filename
, Qnil
));
3612 total
= st
.st_size
; /* Total bytes in the file. */
3613 how_much
= 0; /* Bytes read from file so far. */
3614 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3615 unprocessed
= 0; /* Bytes not processed in previous loop. */
3617 GCPRO1 (conversion_buffer
);
3618 while (how_much
< total
)
3620 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
3621 quitting while reading a huge while. */
3622 /* try is reserved in some compilers (Microsoft C) */
3623 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3626 /* Allow quitting out of the actual I/O. */
3629 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
3641 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
3642 BUF_Z (XBUFFER (conversion_buffer
)));
3643 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
3645 unprocessed
= coding
.carryover_bytes
;
3646 if (coding
.carryover_bytes
> 0)
3647 bcopy (coding
.carryover
, read_buf
, unprocessed
);
3652 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
3653 if we couldn't read the file. */
3656 error ("IO error reading %s: %s",
3657 SDATA (orig_filename
), emacs_strerror (errno
));
3659 if (unprocessed
> 0)
3661 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3662 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
3664 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
3667 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
3668 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
3669 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3671 /* Compare the beginning of the converted string with the buffer
3675 while (bufpos
< inserted
&& same_at_start
< same_at_end
3676 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
3677 same_at_start
++, bufpos
++;
3679 /* If the file matches the head of buffer completely,
3680 there's no need to replace anything. */
3682 if (bufpos
== inserted
)
3685 /* Truncate the buffer to the size of the file. */
3686 if (same_at_start
== same_at_end
)
3689 del_range_byte (same_at_start
, same_at_end
, 0);
3692 unbind_to (this_count
, Qnil
);
3696 /* Extend the start of non-matching text area to the previous
3697 multibyte character boundary. */
3698 if (! NILP (current_buffer
->enable_multibyte_characters
))
3699 while (same_at_start
> BEGV_BYTE
3700 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3703 /* Scan this bufferful from the end, comparing with
3704 the Emacs buffer. */
3707 /* Compare with same_at_start to avoid counting some buffer text
3708 as matching both at the file's beginning and at the end. */
3709 while (bufpos
> 0 && same_at_end
> same_at_start
3710 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
3711 same_at_end
--, bufpos
--;
3713 /* Extend the end of non-matching text area to the next
3714 multibyte character boundary. */
3715 if (! NILP (current_buffer
->enable_multibyte_characters
))
3716 while (same_at_end
< ZV_BYTE
3717 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3720 /* Don't try to reuse the same piece of text twice. */
3721 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3723 same_at_end
+= overlap
;
3725 /* If display currently starts at beginning of line,
3726 keep it that way. */
3727 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3728 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3730 /* Replace the chars that we need to replace,
3731 and update INSERTED to equal the number of bytes
3732 we are taking from the decoded string. */
3733 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
3735 if (same_at_end
!= same_at_start
)
3737 del_range_byte (same_at_start
, same_at_end
, 0);
3739 same_at_start
= GPT_BYTE
;
3743 temp
= BYTE_TO_CHAR (same_at_start
);
3745 /* Insert from the file at the proper position. */
3746 SET_PT_BOTH (temp
, same_at_start
);
3747 same_at_start_charpos
3748 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3749 same_at_start
- BEGV_BYTE
3750 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3752 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
3753 same_at_start
+ inserted
- BEGV_BYTE
3754 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
3755 - same_at_start_charpos
);
3756 /* This binding is to avoid ask-user-about-supersession-threat
3757 being called in insert_from_buffer (via in
3758 prepare_to_modify_buffer). */
3759 specbind (intern ("buffer-file-name"), Qnil
);
3760 insert_from_buffer (XBUFFER (conversion_buffer
),
3761 same_at_start_charpos
, inserted_chars
, 0);
3762 /* Set `inserted' to the number of inserted characters. */
3763 inserted
= PT
- temp
;
3764 /* Set point before the inserted characters. */
3765 SET_PT_BOTH (temp
, same_at_start
);
3767 unbind_to (this_count
, Qnil
);
3774 register Lisp_Object temp
;
3776 total
= XINT (end
) - XINT (beg
);
3778 /* Make sure point-max won't overflow after this insertion. */
3779 XSETINT (temp
, total
);
3780 if (total
!= XINT (temp
))
3781 error ("Maximum buffer size exceeded");
3784 /* For a special file, all we can do is guess. */
3785 total
= READ_BUF_SIZE
;
3787 if (NILP (visit
) && inserted
> 0)
3789 #ifdef CLASH_DETECTION
3790 if (!NILP (current_buffer
->file_truename
)
3791 /* Make binding buffer-file-name to nil effective. */
3792 && !NILP (current_buffer
->filename
)
3793 && SAVE_MODIFF
>= MODIFF
)
3795 #endif /* CLASH_DETECTION */
3796 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
3800 if (GAP_SIZE
< total
)
3801 make_gap (total
- GAP_SIZE
);
3803 if (XINT (beg
) != 0 || !NILP (replace
))
3805 if (lseek (fd
, XINT (beg
), 0) < 0)
3806 report_file_error ("Setting file position",
3807 Fcons (orig_filename
, Qnil
));
3810 /* In the following loop, HOW_MUCH contains the total bytes read so
3811 far for a regular file, and not changed for a special file. But,
3812 before exiting the loop, it is set to a negative value if I/O
3816 /* Total bytes inserted. */
3819 /* Here, we don't do code conversion in the loop. It is done by
3820 decode_coding_gap after all data are read into the buffer. */
3822 int gap_size
= GAP_SIZE
;
3824 while (how_much
< total
)
3826 /* try is reserved in some compilers (Microsoft C) */
3827 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3834 /* Maybe make more room. */
3835 if (gap_size
< trytry
)
3837 make_gap (total
- gap_size
);
3838 gap_size
= GAP_SIZE
;
3841 /* Read from the file, capturing `quit'. When an
3842 error occurs, end the loop, and arrange for a quit
3843 to be signaled after decoding the text we read. */
3844 non_regular_fd
= fd
;
3845 non_regular_inserted
= inserted
;
3846 non_regular_nbytes
= trytry
;
3847 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
3848 read_non_regular_quit
);
3859 /* Allow quitting out of the actual I/O. We don't make text
3860 part of the buffer until all the reading is done, so a C-g
3861 here doesn't do any harm. */
3864 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
3876 /* For a regular file, where TOTAL is the real size,
3877 count HOW_MUCH to compare with it.
3878 For a special file, where TOTAL is just a buffer size,
3879 so don't bother counting in HOW_MUCH.
3880 (INSERTED is where we count the number of characters inserted.) */
3887 /* Now we have read all the file data into the gap.
3888 If it was empty, undo marking the buffer modified. */
3892 #ifdef CLASH_DETECTION
3894 unlock_file (current_buffer
->file_truename
);
3896 Vdeactivate_mark
= old_Vdeactivate_mark
;
3899 Vdeactivate_mark
= Qt
;
3901 /* Make the text read part of the buffer. */
3902 GAP_SIZE
-= inserted
;
3904 GPT_BYTE
+= inserted
;
3906 ZV_BYTE
+= inserted
;
3911 /* Put an anchor to ensure multi-byte form ends at gap. */
3916 /* Discard the unwind protect for closing the file. */
3920 error ("IO error reading %s: %s",
3921 SDATA (orig_filename
), emacs_strerror (errno
));
3925 if (NILP (coding_system
))
3927 /* The coding system is not yet decided. Decide it by an
3928 optimized method for handling `coding:' tag.
3930 Note that we can get here only if the buffer was empty
3931 before the insertion. */
3933 if (!NILP (Vcoding_system_for_read
))
3934 coding_system
= Vcoding_system_for_read
;
3937 /* Since we are sure that the current buffer was empty
3938 before the insertion, we can toggle
3939 enable-multibyte-characters directly here without taking
3940 care of marker adjustment. By this way, we can run Lisp
3941 program safely before decoding the inserted text. */
3942 Lisp_Object unwind_data
;
3943 int count
= SPECPDL_INDEX ();
3945 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
3946 Fcons (current_buffer
->undo_list
,
3947 Fcurrent_buffer ()));
3948 current_buffer
->enable_multibyte_characters
= Qnil
;
3949 current_buffer
->undo_list
= Qt
;
3950 record_unwind_protect (decide_coding_unwind
, unwind_data
);
3952 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
3954 coding_system
= call2 (Vset_auto_coding_function
,
3955 filename
, make_number (inserted
));
3958 if (NILP (coding_system
))
3960 /* If the coding system is not yet decided, check
3961 file-coding-system-alist. */
3962 Lisp_Object args
[6];
3964 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3965 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
3966 coding_system
= Ffind_operation_coding_system (6, args
);
3967 if (CONSP (coding_system
))
3968 coding_system
= XCAR (coding_system
);
3970 unbind_to (count
, Qnil
);
3971 inserted
= Z_BYTE
- BEG_BYTE
;
3974 if (NILP (coding_system
))
3975 coding_system
= Qundecided
;
3977 CHECK_CODING_SYSTEM (coding_system
);
3979 if (NILP (current_buffer
->enable_multibyte_characters
))
3980 /* We must suppress all character code conversion except for
3981 end-of-line conversion. */
3982 coding_system
= raw_text_coding_system (coding_system
);
3983 setup_coding_system (coding_system
, &coding
);
3984 /* Ensure we set Vlast_coding_system_used. */
3985 set_coding_system
= 1;
3990 /* When we visit a file by raw-text, we change the buffer to
3992 if (CODING_FOR_UNIBYTE (&coding
)
3993 /* Can't do this if part of the buffer might be preserved. */
3995 /* Visiting a file with these coding system makes the buffer
3997 current_buffer
->enable_multibyte_characters
= Qnil
;
4000 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4001 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4002 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4004 move_gap_both (PT
, PT_BYTE
);
4005 GAP_SIZE
+= inserted
;
4006 ZV_BYTE
-= inserted
;
4010 decode_coding_gap (&coding
, inserted
, inserted
);
4011 inserted
= coding
.produced_char
;
4012 coding_system
= CODING_ID_NAME (coding
.id
);
4014 else if (inserted
> 0)
4015 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4018 /* Now INSERTED is measured in characters. */
4021 /* Use the conversion type to determine buffer-file-type
4022 (find-buffer-file-type is now used to help determine the
4024 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4025 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4026 && ! CODING_REQUIRE_DECODING (&coding
))
4027 current_buffer
->buffer_file_type
= Qt
;
4029 current_buffer
->buffer_file_type
= Qnil
;
4036 if (!EQ (current_buffer
->undo_list
, Qt
) && !nochange
)
4037 current_buffer
->undo_list
= Qnil
;
4041 current_buffer
->modtime
= st
.st_mtime
;
4042 current_buffer
->filename
= orig_filename
;
4045 SAVE_MODIFF
= MODIFF
;
4046 current_buffer
->auto_save_modified
= MODIFF
;
4047 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4048 #ifdef CLASH_DETECTION
4051 if (!NILP (current_buffer
->file_truename
))
4052 unlock_file (current_buffer
->file_truename
);
4053 unlock_file (filename
);
4055 #endif /* CLASH_DETECTION */
4057 xsignal2 (Qfile_error
,
4058 build_string ("not a regular file"), orig_filename
);
4061 if (set_coding_system
)
4062 Vlast_coding_system_used
= coding_system
;
4064 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4066 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4068 if (! NILP (insval
))
4070 CHECK_NUMBER (insval
);
4071 inserted
= XFASTINT (insval
);
4075 /* Decode file format. */
4078 /* Don't run point motion or modification hooks when decoding. */
4079 int count
= SPECPDL_INDEX ();
4080 int old_inserted
= inserted
;
4081 specbind (Qinhibit_point_motion_hooks
, Qt
);
4082 specbind (Qinhibit_modification_hooks
, Qt
);
4084 /* Save old undo list and don't record undo for decoding. */
4085 old_undo
= current_buffer
->undo_list
;
4086 current_buffer
->undo_list
= Qt
;
4090 insval
= call3 (Qformat_decode
,
4091 Qnil
, make_number (inserted
), visit
);
4092 CHECK_NUMBER (insval
);
4093 inserted
= XFASTINT (insval
);
4097 /* If REPLACE is non-nil and we succeeded in not replacing the
4098 beginning or end of the buffer text with the file's contents,
4099 call format-decode with `point' positioned at the beginning
4100 of the buffer and `inserted' equalling the number of
4101 characters in the buffer. Otherwise, format-decode might
4102 fail to correctly analyze the beginning or end of the buffer.
4103 Hence we temporarily save `point' and `inserted' here and
4104 restore `point' iff format-decode did not insert or delete
4105 any text. Otherwise we leave `point' at point-min. */
4107 int opoint_byte
= PT_BYTE
;
4108 int oinserted
= ZV
- BEGV
;
4109 int ochars_modiff
= CHARS_MODIFF
;
4111 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4112 insval
= call3 (Qformat_decode
,
4113 Qnil
, make_number (oinserted
), visit
);
4114 CHECK_NUMBER (insval
);
4115 if (ochars_modiff
== CHARS_MODIFF
)
4116 /* format_decode didn't modify buffer's characters => move
4117 point back to position before inserted text and leave
4118 value of inserted alone. */
4119 SET_PT_BOTH (opoint
, opoint_byte
);
4121 /* format_decode modified buffer's characters => consider
4122 entire buffer changed and leave point at point-min. */
4123 inserted
= XFASTINT (insval
);
4126 /* For consistency with format-decode call these now iff inserted > 0
4127 (martin 2007-06-28). */
4128 p
= Vafter_insert_file_functions
;
4133 insval
= call1 (XCAR (p
), make_number (inserted
));
4136 CHECK_NUMBER (insval
);
4137 inserted
= XFASTINT (insval
);
4142 /* For the rationale of this see the comment on
4143 format-decode above. */
4145 int opoint_byte
= PT_BYTE
;
4146 int oinserted
= ZV
- BEGV
;
4147 int ochars_modiff
= CHARS_MODIFF
;
4149 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4150 insval
= call1 (XCAR (p
), make_number (oinserted
));
4153 CHECK_NUMBER (insval
);
4154 if (ochars_modiff
== CHARS_MODIFF
)
4155 /* after_insert_file_functions didn't modify
4156 buffer's characters => move point back to
4157 position before inserted text and leave value of
4159 SET_PT_BOTH (opoint
, opoint_byte
);
4161 /* after_insert_file_functions did modify buffer's
4162 characters => consider entire buffer changed and
4163 leave point at point-min. */
4164 inserted
= XFASTINT (insval
);
4174 current_buffer
->undo_list
= old_undo
;
4175 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4177 /* Adjust the last undo record for the size change during
4178 the format conversion. */
4179 Lisp_Object tem
= XCAR (old_undo
);
4180 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4181 && INTEGERP (XCDR (tem
))
4182 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4183 XSETCDR (tem
, make_number (PT
+ inserted
));
4187 /* If undo_list was Qt before, keep it that way.
4188 Otherwise start with an empty undo_list. */
4189 current_buffer
->undo_list
= EQ (old_undo
, Qt
) ? Qt
: Qnil
;
4191 unbind_to (count
, Qnil
);
4194 /* Call after-change hooks for the inserted text, aside from the case
4195 of normal visiting (not with REPLACE), which is done in a new buffer
4196 "before" the buffer is changed. */
4197 if (inserted
> 0 && total
> 0
4198 && (NILP (visit
) || !NILP (replace
)))
4200 signal_after_change (PT
, 0, inserted
);
4201 update_compositions (PT
, PT
, CHECK_BORDER
);
4205 && current_buffer
->modtime
== -1)
4207 /* If visiting nonexistent file, return nil. */
4208 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4212 Fsignal (Qquit
, Qnil
);
4214 /* ??? Retval needs to be dealt with in all cases consistently. */
4216 val
= Fcons (orig_filename
,
4217 Fcons (make_number (inserted
),
4220 RETURN_UNGCPRO (unbind_to (count
, val
));
4223 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4225 /* If build_annotations switched buffers, switch back to BUF.
4226 Kill the temporary buffer that was selected in the meantime.
4228 Since this kill only the last temporary buffer, some buffers remain
4229 not killed if build_annotations switched buffers more than once.
4233 build_annotations_unwind (buf
)
4238 if (XBUFFER (buf
) == current_buffer
)
4240 tembuf
= Fcurrent_buffer ();
4242 Fkill_buffer (tembuf
);
4246 /* Decide the coding-system to encode the data with. */
4249 choose_write_coding_system (start
, end
, filename
,
4250 append
, visit
, lockname
, coding
)
4251 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4252 struct coding_system
*coding
;
4255 Lisp_Object eol_parent
= Qnil
;
4258 && NILP (Fstring_equal (current_buffer
->filename
,
4259 current_buffer
->auto_save_file_name
)))
4264 else if (!NILP (Vcoding_system_for_write
))
4266 val
= Vcoding_system_for_write
;
4267 if (coding_system_require_warning
4268 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4269 /* Confirm that VAL can surely encode the current region. */
4270 val
= call5 (Vselect_safe_coding_system_function
,
4271 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4276 /* If the variable `buffer-file-coding-system' is set locally,
4277 it means that the file was read with some kind of code
4278 conversion or the variable is explicitly set by users. We
4279 had better write it out with the same coding system even if
4280 `enable-multibyte-characters' is nil.
4282 If it is not set locally, we anyway have to convert EOL
4283 format if the default value of `buffer-file-coding-system'
4284 tells that it is not Unix-like (LF only) format. */
4285 int using_default_coding
= 0;
4286 int force_raw_text
= 0;
4288 val
= current_buffer
->buffer_file_coding_system
;
4290 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4293 if (NILP (current_buffer
->enable_multibyte_characters
))
4299 /* Check file-coding-system-alist. */
4300 Lisp_Object args
[7], coding_systems
;
4302 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4303 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4305 coding_systems
= Ffind_operation_coding_system (7, args
);
4306 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4307 val
= XCDR (coding_systems
);
4312 /* If we still have not decided a coding system, use the
4313 default value of buffer-file-coding-system. */
4314 val
= current_buffer
->buffer_file_coding_system
;
4315 using_default_coding
= 1;
4318 if (! NILP (val
) && ! force_raw_text
)
4320 Lisp_Object spec
, attrs
;
4322 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4323 attrs
= AREF (spec
, 0);
4324 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4329 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4330 /* Confirm that VAL can surely encode the current region. */
4331 val
= call5 (Vselect_safe_coding_system_function
,
4332 start
, end
, val
, Qnil
, filename
);
4334 /* If the decided coding-system doesn't specify end-of-line
4335 format, we use that of
4336 `default-buffer-file-coding-system'. */
4337 if (! using_default_coding
4338 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4339 val
= (coding_inherit_eol_type
4340 (val
, buffer_defaults
.buffer_file_coding_system
));
4342 /* If we decide not to encode text, use `raw-text' or one of its
4345 val
= raw_text_coding_system (val
);
4348 val
= coding_inherit_eol_type (val
, eol_parent
);
4349 setup_coding_system (val
, coding
);
4351 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4352 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4356 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4357 "r\nFWrite region to file: \ni\ni\ni\np",
4358 doc
: /* Write current region into specified file.
4359 When called from a program, requires three arguments:
4360 START, END and FILENAME. START and END are normally buffer positions
4361 specifying the part of the buffer to write.
4362 If START is nil, that means to use the entire buffer contents.
4363 If START is a string, then output that string to the file
4364 instead of any buffer contents; END is ignored.
4366 Optional fourth argument APPEND if non-nil means
4367 append to existing file contents (if any). If it is an integer,
4368 seek to that offset in the file before writing.
4369 Optional fifth argument VISIT, if t or a string, means
4370 set the last-save-file-modtime of buffer to this file's modtime
4371 and mark buffer not modified.
4372 If VISIT is a string, it is a second file name;
4373 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4374 VISIT is also the file name to lock and unlock for clash detection.
4375 If VISIT is neither t nor nil nor a string,
4376 that means do not display the \"Wrote file\" message.
4377 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4378 use for locking and unlocking, overriding FILENAME and VISIT.
4379 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4380 for an existing file with the same name. If MUSTBENEW is `excl',
4381 that means to get an error if the file already exists; never overwrite.
4382 If MUSTBENEW is neither nil nor `excl', that means ask for
4383 confirmation before overwriting, but do go ahead and overwrite the file
4384 if the user confirms.
4386 This does code conversion according to the value of
4387 `coding-system-for-write', `buffer-file-coding-system', or
4388 `file-coding-system-alist', and sets the variable
4389 `last-coding-system-used' to the coding system actually used. */)
4390 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4391 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4396 const unsigned char *fn
;
4398 int count
= SPECPDL_INDEX ();
4400 Lisp_Object handler
;
4401 Lisp_Object visit_file
;
4402 Lisp_Object annotations
;
4403 Lisp_Object encoded_filename
;
4404 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4405 int quietly
= !NILP (visit
);
4406 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4407 struct buffer
*given_buffer
;
4409 int buffer_file_type
= O_BINARY
;
4411 struct coding_system coding
;
4413 if (current_buffer
->base_buffer
&& visiting
)
4414 error ("Cannot do file visiting in an indirect buffer");
4416 if (!NILP (start
) && !STRINGP (start
))
4417 validate_region (&start
, &end
);
4420 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4422 filename
= Fexpand_file_name (filename
, Qnil
);
4424 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4425 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4427 if (STRINGP (visit
))
4428 visit_file
= Fexpand_file_name (visit
, Qnil
);
4430 visit_file
= filename
;
4432 if (NILP (lockname
))
4433 lockname
= visit_file
;
4437 /* If the file name has special constructs in it,
4438 call the corresponding file handler. */
4439 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4440 /* If FILENAME has no handler, see if VISIT has one. */
4441 if (NILP (handler
) && STRINGP (visit
))
4442 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4444 if (!NILP (handler
))
4447 val
= call6 (handler
, Qwrite_region
, start
, end
,
4448 filename
, append
, visit
);
4452 SAVE_MODIFF
= MODIFF
;
4453 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4454 current_buffer
->filename
= visit_file
;
4460 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4462 /* Special kludge to simplify auto-saving. */
4465 /* Do it later, so write-region-annotate-function can work differently
4466 if we save "the buffer" vs "a region".
4467 This is useful in tar-mode. --Stef
4468 XSETFASTINT (start, BEG);
4469 XSETFASTINT (end, Z); */
4473 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4474 count1
= SPECPDL_INDEX ();
4476 given_buffer
= current_buffer
;
4478 if (!STRINGP (start
))
4480 annotations
= build_annotations (start
, end
);
4482 if (current_buffer
!= given_buffer
)
4484 XSETFASTINT (start
, BEGV
);
4485 XSETFASTINT (end
, ZV
);
4491 XSETFASTINT (start
, BEGV
);
4492 XSETFASTINT (end
, ZV
);
4497 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4499 /* Decide the coding-system to encode the data with.
4500 We used to make this choice before calling build_annotations, but that
4501 leads to problems when a write-annotate-function takes care of
4502 unsavable chars (as was the case with X-Symbol). */
4503 Vlast_coding_system_used
4504 = choose_write_coding_system (start
, end
, filename
,
4505 append
, visit
, lockname
, &coding
);
4507 #ifdef CLASH_DETECTION
4510 #if 0 /* This causes trouble for GNUS. */
4511 /* If we've locked this file for some other buffer,
4512 query before proceeding. */
4513 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4514 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4517 lock_file (lockname
);
4519 #endif /* CLASH_DETECTION */
4521 encoded_filename
= ENCODE_FILE (filename
);
4523 fn
= SDATA (encoded_filename
);
4527 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4528 #else /* not DOS_NT */
4529 desc
= emacs_open (fn
, O_WRONLY
, 0);
4530 #endif /* not DOS_NT */
4532 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4534 desc
= emacs_open (fn
,
4535 O_WRONLY
| O_CREAT
| buffer_file_type
4536 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4537 S_IREAD
| S_IWRITE
);
4538 #else /* not DOS_NT */
4539 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4540 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4541 auto_saving
? auto_save_mode_bits
: 0666);
4542 #endif /* not DOS_NT */
4546 #ifdef CLASH_DETECTION
4548 if (!auto_saving
) unlock_file (lockname
);
4550 #endif /* CLASH_DETECTION */
4552 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4555 record_unwind_protect (close_file_unwind
, make_number (desc
));
4557 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4561 if (NUMBERP (append
))
4562 ret
= lseek (desc
, XINT (append
), 1);
4564 ret
= lseek (desc
, 0, 2);
4567 #ifdef CLASH_DETECTION
4568 if (!auto_saving
) unlock_file (lockname
);
4569 #endif /* CLASH_DETECTION */
4571 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4578 /* The new encoding routine doesn't require the following. */
4580 /* Whether VMS or not, we must move the gap to the next of newline
4581 when we must put designation sequences at beginning of line. */
4582 if (INTEGERP (start
)
4583 && coding
.type
== coding_type_iso2022
4584 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4585 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4587 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4588 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4589 move_gap_both (PT
, PT_BYTE
);
4590 SET_PT_BOTH (opoint
, opoint_byte
);
4597 if (STRINGP (start
))
4599 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
4600 &annotations
, &coding
);
4603 else if (XINT (start
) != XINT (end
))
4605 failure
= 0 > a_write (desc
, Qnil
,
4606 XINT (start
), XINT (end
) - XINT (start
),
4607 &annotations
, &coding
);
4612 /* If file was empty, still need to write the annotations */
4613 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4614 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4618 if (CODING_REQUIRE_FLUSHING (&coding
)
4619 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4622 /* We have to flush out a data. */
4623 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4624 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
4631 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4632 Disk full in NFS may be reported here. */
4633 /* mib says that closing the file will try to write as fast as NFS can do
4634 it, and that means the fsync here is not crucial for autosave files. */
4635 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
4637 /* If fsync fails with EINTR, don't treat that as serious. Also
4638 ignore EINVAL which happens when fsync is not supported on this
4640 if (errno
!= EINTR
&& errno
!= EINVAL
)
4641 failure
= 1, save_errno
= errno
;
4645 /* Spurious "file has changed on disk" warnings have been
4646 observed on Suns as well.
4647 It seems that `close' can change the modtime, under nfs.
4649 (This has supposedly been fixed in Sunos 4,
4650 but who knows about all the other machines with NFS?) */
4657 /* NFS can report a write failure now. */
4658 if (emacs_close (desc
) < 0)
4659 failure
= 1, save_errno
= errno
;
4664 /* Discard the unwind protect for close_file_unwind. */
4665 specpdl_ptr
= specpdl
+ count1
;
4666 /* Restore the original current buffer. */
4667 visit_file
= unbind_to (count
, visit_file
);
4669 #ifdef CLASH_DETECTION
4671 unlock_file (lockname
);
4672 #endif /* CLASH_DETECTION */
4674 /* Do this before reporting IO error
4675 to avoid a "file has changed on disk" warning on
4676 next attempt to save. */
4678 current_buffer
->modtime
= st
.st_mtime
;
4681 error ("IO error writing %s: %s", SDATA (filename
),
4682 emacs_strerror (save_errno
));
4686 SAVE_MODIFF
= MODIFF
;
4687 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4688 current_buffer
->filename
= visit_file
;
4689 update_mode_lines
++;
4694 && ! NILP (Fstring_equal (current_buffer
->filename
,
4695 current_buffer
->auto_save_file_name
)))
4696 SAVE_MODIFF
= MODIFF
;
4702 message_with_string ((INTEGERP (append
)
4712 Lisp_Object
merge ();
4714 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4715 doc
: /* Return t if (car A) is numerically less than (car B). */)
4719 return Flss (Fcar (a
), Fcar (b
));
4722 /* Build the complete list of annotations appropriate for writing out
4723 the text between START and END, by calling all the functions in
4724 write-region-annotate-functions and merging the lists they return.
4725 If one of these functions switches to a different buffer, we assume
4726 that buffer contains altered text. Therefore, the caller must
4727 make sure to restore the current buffer in all cases,
4728 as save-excursion would do. */
4731 build_annotations (start
, end
)
4732 Lisp_Object start
, end
;
4734 Lisp_Object annotations
;
4736 struct gcpro gcpro1
, gcpro2
;
4737 Lisp_Object original_buffer
;
4738 int i
, used_global
= 0;
4740 XSETBUFFER (original_buffer
, current_buffer
);
4743 p
= Vwrite_region_annotate_functions
;
4744 GCPRO2 (annotations
, p
);
4747 struct buffer
*given_buffer
= current_buffer
;
4748 if (EQ (Qt
, XCAR (p
)) && !used_global
)
4749 { /* Use the global value of the hook. */
4752 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
4754 p
= Fappend (2, arg
);
4757 Vwrite_region_annotations_so_far
= annotations
;
4758 res
= call2 (XCAR (p
), start
, end
);
4759 /* If the function makes a different buffer current,
4760 assume that means this buffer contains altered text to be output.
4761 Reset START and END from the buffer bounds
4762 and discard all previous annotations because they should have
4763 been dealt with by this function. */
4764 if (current_buffer
!= given_buffer
)
4766 XSETFASTINT (start
, BEGV
);
4767 XSETFASTINT (end
, ZV
);
4770 Flength (res
); /* Check basic validity of return value */
4771 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4775 /* Now do the same for annotation functions implied by the file-format */
4776 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
4777 p
= current_buffer
->auto_save_file_format
;
4779 p
= current_buffer
->file_format
;
4780 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
4782 struct buffer
*given_buffer
= current_buffer
;
4784 Vwrite_region_annotations_so_far
= annotations
;
4786 /* Value is either a list of annotations or nil if the function
4787 has written annotations to a temporary buffer, which is now
4789 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
4790 original_buffer
, make_number (i
));
4791 if (current_buffer
!= given_buffer
)
4793 XSETFASTINT (start
, BEGV
);
4794 XSETFASTINT (end
, ZV
);
4799 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4807 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
4808 If STRING is nil, POS is the character position in the current buffer.
4809 Intersperse with them the annotations from *ANNOT
4810 which fall within the range of POS to POS + NCHARS,
4811 each at its appropriate position.
4813 We modify *ANNOT by discarding elements as we use them up.
4815 The return value is negative in case of system call failure. */
4818 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
4821 register int nchars
;
4824 struct coding_system
*coding
;
4828 int lastpos
= pos
+ nchars
;
4830 while (NILP (*annot
) || CONSP (*annot
))
4832 tem
= Fcar_safe (Fcar (*annot
));
4835 nextpos
= XFASTINT (tem
);
4837 /* If there are no more annotations in this range,
4838 output the rest of the range all at once. */
4839 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
4840 return e_write (desc
, string
, pos
, lastpos
, coding
);
4842 /* Output buffer text up to the next annotation's position. */
4845 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
4849 /* Output the annotation. */
4850 tem
= Fcdr (Fcar (*annot
));
4853 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
4856 *annot
= Fcdr (*annot
);
4862 /* Write text in the range START and END into descriptor DESC,
4863 encoding them with coding system CODING. If STRING is nil, START
4864 and END are character positions of the current buffer, else they
4865 are indexes to the string STRING. */
4868 e_write (desc
, string
, start
, end
, coding
)
4872 struct coding_system
*coding
;
4874 if (STRINGP (string
))
4877 end
= SCHARS (string
);
4880 /* We used to have a code for handling selective display here. But,
4881 now it is handled within encode_coding. */
4885 if (STRINGP (string
))
4887 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
4888 if (CODING_REQUIRE_ENCODING (coding
))
4890 encode_coding_object (coding
, string
,
4891 start
, string_char_to_byte (string
, start
),
4892 end
, string_char_to_byte (string
, end
), Qt
);
4896 coding
->dst_object
= string
;
4897 coding
->consumed_char
= SCHARS (string
);
4898 coding
->produced
= SBYTES (string
);
4903 int start_byte
= CHAR_TO_BYTE (start
);
4904 int end_byte
= CHAR_TO_BYTE (end
);
4906 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
4907 if (CODING_REQUIRE_ENCODING (coding
))
4909 encode_coding_object (coding
, Fcurrent_buffer (),
4910 start
, start_byte
, end
, end_byte
, Qt
);
4914 coding
->dst_object
= Qnil
;
4915 coding
->dst_pos_byte
= start_byte
;
4916 if (start
>= GPT
|| end
<= GPT
)
4918 coding
->consumed_char
= end
- start
;
4919 coding
->produced
= end_byte
- start_byte
;
4923 coding
->consumed_char
= GPT
- start
;
4924 coding
->produced
= GPT_BYTE
- start_byte
;
4929 if (coding
->produced
> 0)
4933 STRINGP (coding
->dst_object
)
4934 ? SDATA (coding
->dst_object
)
4935 : BYTE_POS_ADDR (coding
->dst_pos_byte
),
4938 if (coding
->produced
)
4941 start
+= coding
->consumed_char
;
4947 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4948 Sverify_visited_file_modtime
, 1, 1, 0,
4949 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
4950 This means that the file has not been changed since it was visited or saved.
4951 See Info node `(elisp)Modification Time' for more details. */)
4957 Lisp_Object handler
;
4958 Lisp_Object filename
;
4963 if (!STRINGP (b
->filename
)) return Qt
;
4964 if (b
->modtime
== 0) return Qt
;
4966 /* If the file name has special constructs in it,
4967 call the corresponding file handler. */
4968 handler
= Ffind_file_name_handler (b
->filename
,
4969 Qverify_visited_file_modtime
);
4970 if (!NILP (handler
))
4971 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4973 filename
= ENCODE_FILE (b
->filename
);
4975 if (stat (SDATA (filename
), &st
) < 0)
4977 /* If the file doesn't exist now and didn't exist before,
4978 we say that it isn't modified, provided the error is a tame one. */
4979 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4984 if (st
.st_mtime
== b
->modtime
4985 /* If both are positive, accept them if they are off by one second. */
4986 || (st
.st_mtime
> 0 && b
->modtime
> 0
4987 && (st
.st_mtime
== b
->modtime
+ 1
4988 || st
.st_mtime
== b
->modtime
- 1)))
4993 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4994 Sclear_visited_file_modtime
, 0, 0, 0,
4995 doc
: /* Clear out records of last mod time of visited file.
4996 Next attempt to save will certainly not complain of a discrepancy. */)
4999 current_buffer
->modtime
= 0;
5003 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5004 Svisited_file_modtime
, 0, 0, 0,
5005 doc
: /* Return the current buffer's recorded visited file modification time.
5006 The value is a list of the form (HIGH LOW), like the time values
5007 that `file-attributes' returns. If the current buffer has no recorded
5008 file modification time, this function returns 0.
5009 See Info node `(elisp)Modification Time' for more details. */)
5012 if (! current_buffer
->modtime
)
5013 return make_number (0);
5014 return make_time ((time_t) current_buffer
->modtime
);
5017 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5018 Sset_visited_file_modtime
, 0, 1, 0,
5019 doc
: /* Update buffer's recorded modification time from the visited file's time.
5020 Useful if the buffer was not read from the file normally
5021 or if the file itself has been changed for some known benign reason.
5022 An argument specifies the modification time value to use
5023 \(instead of that of the visited file), in the form of a list
5024 \(HIGH . LOW) or (HIGH LOW). */)
5026 Lisp_Object time_list
;
5028 if (!NILP (time_list
))
5029 current_buffer
->modtime
= cons_to_long (time_list
);
5032 register Lisp_Object filename
;
5034 Lisp_Object handler
;
5036 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5038 /* If the file name has special constructs in it,
5039 call the corresponding file handler. */
5040 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5041 if (!NILP (handler
))
5042 /* The handler can find the file name the same way we did. */
5043 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5045 filename
= ENCODE_FILE (filename
);
5047 if (stat (SDATA (filename
), &st
) >= 0)
5048 current_buffer
->modtime
= st
.st_mtime
;
5055 auto_save_error (error
)
5058 Lisp_Object args
[3], msg
;
5060 struct gcpro gcpro1
;
5064 auto_save_error_occurred
= 1;
5066 ring_bell (XFRAME (selected_frame
));
5068 args
[0] = build_string ("Auto-saving %s: %s");
5069 args
[1] = current_buffer
->name
;
5070 args
[2] = Ferror_message_string (error
);
5071 msg
= Fformat (3, args
);
5073 nbytes
= SBYTES (msg
);
5074 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5075 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5077 for (i
= 0; i
< 3; ++i
)
5080 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5082 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5083 Fsleep_for (make_number (1), Qnil
);
5097 auto_save_mode_bits
= 0666;
5099 /* Get visited file's mode to become the auto save file's mode. */
5100 if (! NILP (current_buffer
->filename
))
5102 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5103 /* But make sure we can overwrite it later! */
5104 auto_save_mode_bits
= st
.st_mode
| 0600;
5105 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5107 /* Remote files don't cooperate with stat. */
5108 auto_save_mode_bits
= XINT (modes
) | 0600;
5112 Fwrite_region (Qnil
, Qnil
, current_buffer
->auto_save_file_name
, Qnil
,
5113 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5118 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5121 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5133 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5136 minibuffer_auto_raise
= XINT (value
);
5141 do_auto_save_make_dir (dir
)
5146 call2 (Qmake_directory
, dir
, Qt
);
5147 XSETFASTINT (mode
, 0700);
5148 return Fset_file_modes (dir
, mode
);
5152 do_auto_save_eh (ignore
)
5158 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5159 doc
: /* Auto-save all buffers that need it.
5160 This is all buffers that have auto-saving enabled
5161 and are changed since last auto-saved.
5162 Auto-saving writes the buffer into a file
5163 so that your editing is not lost if the system crashes.
5164 This file is not the file you visited; that changes only when you save.
5165 Normally we run the normal hook `auto-save-hook' before saving.
5167 A non-nil NO-MESSAGE argument means do not print any message if successful.
5168 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5169 (no_message
, current_only
)
5170 Lisp_Object no_message
, current_only
;
5172 struct buffer
*old
= current_buffer
, *b
;
5173 Lisp_Object tail
, buf
;
5175 int do_handled_files
;
5177 FILE *stream
= NULL
;
5178 int count
= SPECPDL_INDEX ();
5179 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5180 int old_message_p
= 0;
5181 struct gcpro gcpro1
, gcpro2
;
5183 if (max_specpdl_size
< specpdl_size
+ 40)
5184 max_specpdl_size
= specpdl_size
+ 40;
5189 if (NILP (no_message
))
5191 old_message_p
= push_message ();
5192 record_unwind_protect (pop_message_unwind
, Qnil
);
5195 /* Ordinarily don't quit within this function,
5196 but don't make it impossible to quit (in case we get hung in I/O). */
5200 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5201 point to non-strings reached from Vbuffer_alist. */
5203 if (!NILP (Vrun_hooks
))
5204 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5206 if (STRINGP (Vauto_save_list_file_name
))
5208 Lisp_Object listfile
;
5210 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5212 /* Don't try to create the directory when shutting down Emacs,
5213 because creating the directory might signal an error, and
5214 that would leave Emacs in a strange state. */
5215 if (!NILP (Vrun_hooks
))
5219 GCPRO2 (dir
, listfile
);
5220 dir
= Ffile_name_directory (listfile
);
5221 if (NILP (Ffile_directory_p (dir
)))
5222 internal_condition_case_1 (do_auto_save_make_dir
,
5223 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5228 stream
= fopen (SDATA (listfile
), "w");
5231 record_unwind_protect (do_auto_save_unwind
,
5232 make_save_value (stream
, 0));
5233 record_unwind_protect (do_auto_save_unwind_1
,
5234 make_number (minibuffer_auto_raise
));
5235 minibuffer_auto_raise
= 0;
5237 auto_save_error_occurred
= 0;
5239 /* On first pass, save all files that don't have handlers.
5240 On second pass, save all files that do have handlers.
5242 If Emacs is crashing, the handlers may tweak what is causing
5243 Emacs to crash in the first place, and it would be a shame if
5244 Emacs failed to autosave perfectly ordinary files because it
5245 couldn't handle some ange-ftp'd file. */
5247 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5248 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5250 buf
= XCDR (XCAR (tail
));
5253 /* Record all the buffers that have auto save mode
5254 in the special file that lists them. For each of these buffers,
5255 Record visited name (if any) and auto save name. */
5256 if (STRINGP (b
->auto_save_file_name
)
5257 && stream
!= NULL
&& do_handled_files
== 0)
5260 if (!NILP (b
->filename
))
5262 fwrite (SDATA (b
->filename
), 1,
5263 SBYTES (b
->filename
), stream
);
5265 putc ('\n', stream
);
5266 fwrite (SDATA (b
->auto_save_file_name
), 1,
5267 SBYTES (b
->auto_save_file_name
), stream
);
5268 putc ('\n', stream
);
5272 if (!NILP (current_only
)
5273 && b
!= current_buffer
)
5276 /* Don't auto-save indirect buffers.
5277 The base buffer takes care of it. */
5281 /* Check for auto save enabled
5282 and file changed since last auto save
5283 and file changed since last real save. */
5284 if (STRINGP (b
->auto_save_file_name
)
5285 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5286 && b
->auto_save_modified
< BUF_MODIFF (b
)
5287 /* -1 means we've turned off autosaving for a while--see below. */
5288 && XINT (b
->save_length
) >= 0
5289 && (do_handled_files
5290 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5293 EMACS_TIME before_time
, after_time
;
5295 EMACS_GET_TIME (before_time
);
5297 /* If we had a failure, don't try again for 20 minutes. */
5298 if (b
->auto_save_failure_time
>= 0
5299 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5302 if ((XFASTINT (b
->save_length
) * 10
5303 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5304 /* A short file is likely to change a large fraction;
5305 spare the user annoying messages. */
5306 && XFASTINT (b
->save_length
) > 5000
5307 /* These messages are frequent and annoying for `*mail*'. */
5308 && !EQ (b
->filename
, Qnil
)
5309 && NILP (no_message
))
5311 /* It has shrunk too much; turn off auto-saving here. */
5312 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5313 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5315 minibuffer_auto_raise
= 0;
5316 /* Turn off auto-saving until there's a real save,
5317 and prevent any more warnings. */
5318 XSETINT (b
->save_length
, -1);
5319 Fsleep_for (make_number (1), Qnil
);
5322 set_buffer_internal (b
);
5323 if (!auto_saved
&& NILP (no_message
))
5324 message1 ("Auto-saving...");
5325 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5327 b
->auto_save_modified
= BUF_MODIFF (b
);
5328 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5329 set_buffer_internal (old
);
5331 EMACS_GET_TIME (after_time
);
5333 /* If auto-save took more than 60 seconds,
5334 assume it was an NFS failure that got a timeout. */
5335 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5336 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5340 /* Prevent another auto save till enough input events come in. */
5341 record_auto_save ();
5343 if (auto_saved
&& NILP (no_message
))
5347 /* If we are going to restore an old message,
5348 give time to read ours. */
5349 sit_for (make_number (1), 0, 0);
5352 else if (!auto_save_error_occurred
)
5353 /* Don't overwrite the error message if an error occurred.
5354 If we displayed a message and then restored a state
5355 with no message, leave a "done" message on the screen. */
5356 message1 ("Auto-saving...done");
5361 /* This restores the message-stack status. */
5362 unbind_to (count
, Qnil
);
5366 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5367 Sset_buffer_auto_saved
, 0, 0, 0,
5368 doc
: /* Mark current buffer as auto-saved with its current text.
5369 No auto-save file will be written until the buffer changes again. */)
5372 current_buffer
->auto_save_modified
= MODIFF
;
5373 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5374 current_buffer
->auto_save_failure_time
= -1;
5378 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5379 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5380 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5383 current_buffer
->auto_save_failure_time
= -1;
5387 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5389 doc
: /* Return t if current buffer has been auto-saved recently.
5390 More precisely, if it has been auto-saved since last read from or saved
5391 in the visited file. If the buffer has no visited file,
5392 then any auto-save counts as "recent". */)
5395 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5398 /* Reading and completing file names */
5400 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5401 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5402 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5403 The return value is only relevant for a call to `read-file-name' that happens
5404 before any other event (mouse or keypress) is handeled. */)
5407 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
5408 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5418 Fread_file_name (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
5419 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
5421 struct gcpro gcpro1
, gcpro2
;
5422 Lisp_Object args
[7];
5424 GCPRO1 (default_filename
);
5425 args
[0] = intern ("read-file-name");
5428 args
[3] = default_filename
;
5429 args
[4] = mustmatch
;
5431 args
[6] = predicate
;
5432 RETURN_UNGCPRO (Ffuncall (7, args
));
5439 /* Must be set before any path manipulation is performed. */
5440 XSETFASTINT (Vdirectory_sep_char
, '/');
5447 Qoperations
= intern ("operations");
5448 Qexpand_file_name
= intern ("expand-file-name");
5449 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5450 Qdirectory_file_name
= intern ("directory-file-name");
5451 Qfile_name_directory
= intern ("file-name-directory");
5452 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5453 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5454 Qfile_name_as_directory
= intern ("file-name-as-directory");
5455 Qcopy_file
= intern ("copy-file");
5456 Qmake_directory_internal
= intern ("make-directory-internal");
5457 Qmake_directory
= intern ("make-directory");
5458 Qdelete_directory
= intern ("delete-directory");
5459 Qdelete_file
= intern ("delete-file");
5460 Qrename_file
= intern ("rename-file");
5461 Qadd_name_to_file
= intern ("add-name-to-file");
5462 Qmake_symbolic_link
= intern ("make-symbolic-link");
5463 Qfile_exists_p
= intern ("file-exists-p");
5464 Qfile_executable_p
= intern ("file-executable-p");
5465 Qfile_readable_p
= intern ("file-readable-p");
5466 Qfile_writable_p
= intern ("file-writable-p");
5467 Qfile_symlink_p
= intern ("file-symlink-p");
5468 Qaccess_file
= intern ("access-file");
5469 Qfile_directory_p
= intern ("file-directory-p");
5470 Qfile_regular_p
= intern ("file-regular-p");
5471 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5472 Qfile_modes
= intern ("file-modes");
5473 Qset_file_modes
= intern ("set-file-modes");
5474 Qset_file_times
= intern ("set-file-times");
5475 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5476 Qinsert_file_contents
= intern ("insert-file-contents");
5477 Qwrite_region
= intern ("write-region");
5478 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5479 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5480 Qauto_save_coding
= intern ("auto-save-coding");
5482 staticpro (&Qoperations
);
5483 staticpro (&Qexpand_file_name
);
5484 staticpro (&Qsubstitute_in_file_name
);
5485 staticpro (&Qdirectory_file_name
);
5486 staticpro (&Qfile_name_directory
);
5487 staticpro (&Qfile_name_nondirectory
);
5488 staticpro (&Qunhandled_file_name_directory
);
5489 staticpro (&Qfile_name_as_directory
);
5490 staticpro (&Qcopy_file
);
5491 staticpro (&Qmake_directory_internal
);
5492 staticpro (&Qmake_directory
);
5493 staticpro (&Qdelete_directory
);
5494 staticpro (&Qdelete_file
);
5495 staticpro (&Qrename_file
);
5496 staticpro (&Qadd_name_to_file
);
5497 staticpro (&Qmake_symbolic_link
);
5498 staticpro (&Qfile_exists_p
);
5499 staticpro (&Qfile_executable_p
);
5500 staticpro (&Qfile_readable_p
);
5501 staticpro (&Qfile_writable_p
);
5502 staticpro (&Qaccess_file
);
5503 staticpro (&Qfile_symlink_p
);
5504 staticpro (&Qfile_directory_p
);
5505 staticpro (&Qfile_regular_p
);
5506 staticpro (&Qfile_accessible_directory_p
);
5507 staticpro (&Qfile_modes
);
5508 staticpro (&Qset_file_modes
);
5509 staticpro (&Qset_file_times
);
5510 staticpro (&Qfile_newer_than_file_p
);
5511 staticpro (&Qinsert_file_contents
);
5512 staticpro (&Qwrite_region
);
5513 staticpro (&Qverify_visited_file_modtime
);
5514 staticpro (&Qset_visited_file_modtime
);
5515 staticpro (&Qauto_save_coding
);
5517 Qfile_name_history
= intern ("file-name-history");
5518 Fset (Qfile_name_history
, Qnil
);
5519 staticpro (&Qfile_name_history
);
5521 Qfile_error
= intern ("file-error");
5522 staticpro (&Qfile_error
);
5523 Qfile_already_exists
= intern ("file-already-exists");
5524 staticpro (&Qfile_already_exists
);
5525 Qfile_date_error
= intern ("file-date-error");
5526 staticpro (&Qfile_date_error
);
5527 Qexcl
= intern ("excl");
5531 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5532 staticpro (&Qfind_buffer_file_type
);
5535 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5536 doc
: /* *Coding system for encoding file names.
5537 If it is nil, `default-file-name-coding-system' (which see) is used. */);
5538 Vfile_name_coding_system
= Qnil
;
5540 DEFVAR_LISP ("default-file-name-coding-system",
5541 &Vdefault_file_name_coding_system
,
5542 doc
: /* Default coding system for encoding file names.
5543 This variable is used only when `file-name-coding-system' is nil.
5545 This variable is set/changed by the command `set-language-environment'.
5546 User should not set this variable manually,
5547 instead use `file-name-coding-system' to get a constant encoding
5548 of file names regardless of the current language environment. */);
5549 Vdefault_file_name_coding_system
= Qnil
;
5551 Qformat_decode
= intern ("format-decode");
5552 staticpro (&Qformat_decode
);
5553 Qformat_annotate_function
= intern ("format-annotate-function");
5554 staticpro (&Qformat_annotate_function
);
5555 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
5556 staticpro (&Qafter_insert_file_set_coding
);
5558 Qcar_less_than_car
= intern ("car-less-than-car");
5559 staticpro (&Qcar_less_than_car
);
5561 Fput (Qfile_error
, Qerror_conditions
,
5562 list2 (Qfile_error
, Qerror
));
5563 Fput (Qfile_error
, Qerror_message
,
5564 build_string ("File error"));
5566 Fput (Qfile_already_exists
, Qerror_conditions
,
5567 list3 (Qfile_already_exists
, Qfile_error
, Qerror
));
5568 Fput (Qfile_already_exists
, Qerror_message
,
5569 build_string ("File already exists"));
5571 Fput (Qfile_date_error
, Qerror_conditions
,
5572 list3 (Qfile_date_error
, Qfile_error
, Qerror
));
5573 Fput (Qfile_date_error
, Qerror_message
,
5574 build_string ("Cannot set file date"));
5576 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5577 doc
: /* Directory separator character for built-in functions that return file names.
5578 The value is always ?/. Don't use this variable, just use `/'. */);
5580 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5581 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
5582 If a file name matches REGEXP, then all I/O on that file is done by calling
5585 The first argument given to HANDLER is the name of the I/O primitive
5586 to be handled; the remaining arguments are the arguments that were
5587 passed to that primitive. For example, if you do
5588 (file-exists-p FILENAME)
5589 and FILENAME is handled by HANDLER, then HANDLER is called like this:
5590 (funcall HANDLER 'file-exists-p FILENAME)
5591 The function `find-file-name-handler' checks this list for a handler
5592 for its argument. */);
5593 Vfile_name_handler_alist
= Qnil
;
5595 DEFVAR_LISP ("set-auto-coding-function",
5596 &Vset_auto_coding_function
,
5597 doc
: /* If non-nil, a function to call to decide a coding system of file.
5598 Two arguments are passed to this function: the file name
5599 and the length of a file contents following the point.
5600 This function should return a coding system to decode the file contents.
5601 It should check the file name against `auto-coding-alist'.
5602 If no coding system is decided, it should check a coding system
5603 specified in the heading lines with the format:
5604 -*- ... coding: CODING-SYSTEM; ... -*-
5605 or local variable spec of the tailing lines with `coding:' tag. */);
5606 Vset_auto_coding_function
= Qnil
;
5608 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5609 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
5610 Each is passed one argument, the number of characters inserted,
5611 with point at the start of the inserted text. Each function
5612 should leave point the same, and return the new character count.
5613 If `insert-file-contents' is intercepted by a handler from
5614 `file-name-handler-alist', that handler is responsible for calling the
5615 functions in `after-insert-file-functions' if appropriate. */);
5616 Vafter_insert_file_functions
= Qnil
;
5618 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5619 doc
: /* A list of functions to be called at the start of `write-region'.
5620 Each is passed two arguments, START and END as for `write-region'.
5621 These are usually two numbers but not always; see the documentation
5622 for `write-region'. The function should return a list of pairs
5623 of the form (POSITION . STRING), consisting of strings to be effectively
5624 inserted at the specified positions of the file being written (1 means to
5625 insert before the first byte written). The POSITIONs must be sorted into
5626 increasing order. If there are several functions in the list, the several
5627 lists are merged destructively. Alternatively, the function can return
5628 with a different buffer current; in that case it should pay attention
5629 to the annotations returned by previous functions and listed in
5630 `write-region-annotations-so-far'.*/);
5631 Vwrite_region_annotate_functions
= Qnil
;
5632 staticpro (&Qwrite_region_annotate_functions
);
5633 Qwrite_region_annotate_functions
5634 = intern ("write-region-annotate-functions");
5636 DEFVAR_LISP ("write-region-annotations-so-far",
5637 &Vwrite_region_annotations_so_far
,
5638 doc
: /* When an annotation function is called, this holds the previous annotations.
5639 These are the annotations made by other annotation functions
5640 that were already called. See also `write-region-annotate-functions'. */);
5641 Vwrite_region_annotations_so_far
= Qnil
;
5643 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5644 doc
: /* A list of file name handlers that temporarily should not be used.
5645 This applies only to the operation `inhibit-file-name-operation'. */);
5646 Vinhibit_file_name_handlers
= Qnil
;
5648 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5649 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5650 Vinhibit_file_name_operation
= Qnil
;
5652 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5653 doc
: /* File name in which we write a list of all auto save file names.
5654 This variable is initialized automatically from `auto-save-list-file-prefix'
5655 shortly after Emacs reads your `.emacs' file, if you have not yet given it
5656 a non-nil value. */);
5657 Vauto_save_list_file_name
= Qnil
;
5659 DEFVAR_LISP ("auto-save-visited-file-name", &Vauto_save_visited_file_name
,
5660 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
5661 Normally auto-save files are written under other names. */);
5662 Vauto_save_visited_file_name
= Qnil
;
5665 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
5666 doc
: /* *Non-nil means don't call fsync in `write-region'.
5667 This variable affects calls to `write-region' as well as save commands.
5668 A non-nil value may result in data loss! */);
5669 write_region_inhibit_fsync
= 0;
5672 DEFVAR_BOOL ("delete-by-moving-to-trash", &delete_by_moving_to_trash
,
5673 doc
: /* Specifies whether to use the system's trash can.
5674 When non-nil, the function `move-file-to-trash' will be used by
5675 `delete-file' and `delete-directory'. */);
5676 delete_by_moving_to_trash
= 0;
5677 Qmove_file_to_trash
= intern ("move-file-to-trash");
5678 staticpro (&Qmove_file_to_trash
);
5680 defsubr (&Sfind_file_name_handler
);
5681 defsubr (&Sfile_name_directory
);
5682 defsubr (&Sfile_name_nondirectory
);
5683 defsubr (&Sunhandled_file_name_directory
);
5684 defsubr (&Sfile_name_as_directory
);
5685 defsubr (&Sdirectory_file_name
);
5686 defsubr (&Smake_temp_name
);
5687 defsubr (&Sexpand_file_name
);
5688 defsubr (&Ssubstitute_in_file_name
);
5689 defsubr (&Scopy_file
);
5690 defsubr (&Smake_directory_internal
);
5691 defsubr (&Sdelete_directory
);
5692 defsubr (&Sdelete_file
);
5693 defsubr (&Srename_file
);
5694 defsubr (&Sadd_name_to_file
);
5695 defsubr (&Smake_symbolic_link
);
5696 defsubr (&Sfile_name_absolute_p
);
5697 defsubr (&Sfile_exists_p
);
5698 defsubr (&Sfile_executable_p
);
5699 defsubr (&Sfile_readable_p
);
5700 defsubr (&Sfile_writable_p
);
5701 defsubr (&Saccess_file
);
5702 defsubr (&Sfile_symlink_p
);
5703 defsubr (&Sfile_directory_p
);
5704 defsubr (&Sfile_accessible_directory_p
);
5705 defsubr (&Sfile_regular_p
);
5706 defsubr (&Sfile_modes
);
5707 defsubr (&Sset_file_modes
);
5708 defsubr (&Sset_file_times
);
5709 defsubr (&Sset_default_file_modes
);
5710 defsubr (&Sdefault_file_modes
);
5711 defsubr (&Sfile_newer_than_file_p
);
5712 defsubr (&Sinsert_file_contents
);
5713 defsubr (&Swrite_region
);
5714 defsubr (&Scar_less_than_car
);
5715 defsubr (&Sverify_visited_file_modtime
);
5716 defsubr (&Sclear_visited_file_modtime
);
5717 defsubr (&Svisited_file_modtime
);
5718 defsubr (&Sset_visited_file_modtime
);
5719 defsubr (&Sdo_auto_save
);
5720 defsubr (&Sset_buffer_auto_saved
);
5721 defsubr (&Sclear_buffer_auto_save_failure
);
5722 defsubr (&Srecent_auto_save_p
);
5724 defsubr (&Snext_read_file_uses_dialog_p
);
5727 defsubr (&Sunix_sync
);
5731 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
5732 (do not change this comment) */