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