1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 #define _GNU_SOURCE /* for euidaccess */
26 #if defined (USG5) || defined (BSD_SYSTEM) || defined (GNU_LINUX)
31 #include <sys/types.h>
38 #if !defined (S_ISLNK) && defined (S_IFLNK)
39 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
42 #if !defined (S_ISFIFO) && defined (S_IFIFO)
43 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
46 #if !defined (S_ISREG) && defined (S_IFREG)
47 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
88 #include "intervals.h"
99 #endif /* not WINDOWSNT */
103 #include <sys/param.h>
111 #define CORRECT_DIR_SEPS(s) \
112 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
113 else unixtodos_filename (s); \
115 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
116 redirector allows the six letters between 'Z' and 'a' as well. */
118 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
121 #define IS_DRIVE(x) isalpha (x)
123 /* Need to lower-case the drive letter, or else expanded
124 filenames will sometimes compare inequal, because
125 `expand-file-name' doesn't always down-case the drive letter. */
126 #define DRIVE_LETTER(x) (tolower (x))
147 #include "commands.h"
148 extern int use_dialog_box
;
162 /* Nonzero during writing of auto-save files */
165 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
166 a new file with the same mode as the original */
167 int auto_save_mode_bits
;
169 /* Coding system for file names, or nil if none. */
170 Lisp_Object Vfile_name_coding_system
;
172 /* Coding system for file names used only when
173 Vfile_name_coding_system is nil. */
174 Lisp_Object Vdefault_file_name_coding_system
;
176 /* Alist of elements (REGEXP . HANDLER) for file names
177 whose I/O is done with a special handler. */
178 Lisp_Object Vfile_name_handler_alist
;
180 /* Format for auto-save files */
181 Lisp_Object Vauto_save_file_format
;
183 /* Lisp functions for translating file formats */
184 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
186 /* Function to be called to decide a coding system of a reading file. */
187 Lisp_Object Vset_auto_coding_function
;
189 /* Functions to be called to process text properties in inserted file. */
190 Lisp_Object Vafter_insert_file_functions
;
192 /* Functions to be called to create text property annotations for file. */
193 Lisp_Object Vwrite_region_annotate_functions
;
195 /* During build_annotations, each time an annotation function is called,
196 this holds the annotations made by the previous functions. */
197 Lisp_Object Vwrite_region_annotations_so_far
;
199 /* File name in which we write a list of all our auto save files. */
200 Lisp_Object Vauto_save_list_file_name
;
202 /* Function to call to read a file name. */
203 Lisp_Object Vread_file_name_function
;
205 /* Current predicate used by read_file_name_internal. */
206 Lisp_Object Vread_file_name_predicate
;
208 /* Nonzero means, when reading a filename in the minibuffer,
209 start out by inserting the default directory into the minibuffer. */
210 int insert_default_directory
;
212 /* On VMS, nonzero means write new files with record format stmlf.
213 Zero means use var format. */
216 /* On NT, specifies the directory separator character, used (eg.) when
217 expanding file names. This can be bound to / or \. */
218 Lisp_Object Vdirectory_sep_char
;
220 extern Lisp_Object Vuser_login_name
;
223 extern Lisp_Object Vw32_get_true_file_attributes
;
226 extern int minibuf_level
;
228 extern int minibuffer_auto_raise
;
230 /* These variables describe handlers that have "already" had a chance
231 to handle the current operation.
233 Vinhibit_file_name_handlers is a list of file name handlers.
234 Vinhibit_file_name_operation is the operation being handled.
235 If we try to handle that operation, we ignore those handlers. */
237 static Lisp_Object Vinhibit_file_name_handlers
;
238 static Lisp_Object Vinhibit_file_name_operation
;
240 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
242 Lisp_Object Qfile_name_history
;
244 Lisp_Object Qcar_less_than_car
;
246 static int a_write
P_ ((int, Lisp_Object
, int, int,
247 Lisp_Object
*, struct coding_system
*));
248 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
252 report_file_error (string
, data
)
256 Lisp_Object errstring
;
259 synchronize_system_messages_locale ();
260 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
261 Vlocale_coding_system
, 0);
267 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
270 /* System error messages are capitalized. Downcase the initial
271 unless it is followed by a slash. */
272 if (SREF (errstring
, 1) != '/')
273 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
275 Fsignal (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
);
299 Lisp_Object Qexpand_file_name
;
300 Lisp_Object Qsubstitute_in_file_name
;
301 Lisp_Object Qdirectory_file_name
;
302 Lisp_Object Qfile_name_directory
;
303 Lisp_Object Qfile_name_nondirectory
;
304 Lisp_Object Qunhandled_file_name_directory
;
305 Lisp_Object Qfile_name_as_directory
;
306 Lisp_Object Qcopy_file
;
307 Lisp_Object Qmake_directory_internal
;
308 Lisp_Object Qmake_directory
;
309 Lisp_Object Qdelete_directory
;
310 Lisp_Object Qdelete_file
;
311 Lisp_Object Qrename_file
;
312 Lisp_Object Qadd_name_to_file
;
313 Lisp_Object Qmake_symbolic_link
;
314 Lisp_Object Qfile_exists_p
;
315 Lisp_Object Qfile_executable_p
;
316 Lisp_Object Qfile_readable_p
;
317 Lisp_Object Qfile_writable_p
;
318 Lisp_Object Qfile_symlink_p
;
319 Lisp_Object Qaccess_file
;
320 Lisp_Object Qfile_directory_p
;
321 Lisp_Object Qfile_regular_p
;
322 Lisp_Object Qfile_accessible_directory_p
;
323 Lisp_Object Qfile_modes
;
324 Lisp_Object Qset_file_modes
;
325 Lisp_Object Qfile_newer_than_file_p
;
326 Lisp_Object Qinsert_file_contents
;
327 Lisp_Object Qwrite_region
;
328 Lisp_Object Qverify_visited_file_modtime
;
329 Lisp_Object Qset_visited_file_modtime
;
331 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
332 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
333 Otherwise, return nil.
334 A file name is handled if one of the regular expressions in
335 `file-name-handler-alist' matches it.
337 If OPERATION equals `inhibit-file-name-operation', then we ignore
338 any handlers that are members of `inhibit-file-name-handlers',
339 but we still do run any other handlers. This lets handlers
340 use the standard functions without calling themselves recursively. */)
341 (filename
, operation
)
342 Lisp_Object filename
, operation
;
344 /* This function must not munge the match data. */
345 Lisp_Object chain
, inhibited_handlers
, result
;
349 CHECK_STRING (filename
);
351 if (EQ (operation
, Vinhibit_file_name_operation
))
352 inhibited_handlers
= Vinhibit_file_name_handlers
;
354 inhibited_handlers
= Qnil
;
356 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
357 chain
= XCDR (chain
))
367 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
369 Lisp_Object handler
, tem
;
371 handler
= XCDR (elt
);
372 tem
= Fmemq (handler
, inhibited_handlers
);
386 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
388 doc
: /* Return the directory component in file name FILENAME.
389 Return nil if FILENAME does not include a directory.
390 Otherwise return a directory spec.
391 Given a Unix syntax file name, returns a string ending in slash;
392 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
394 Lisp_Object filename
;
396 register const unsigned char *beg
;
397 register const unsigned char *p
;
400 CHECK_STRING (filename
);
402 /* If the file name has special constructs in it,
403 call the corresponding file handler. */
404 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
406 return call2 (handler
, Qfile_name_directory
, filename
);
408 #ifdef FILE_SYSTEM_CASE
409 filename
= FILE_SYSTEM_CASE (filename
);
411 beg
= SDATA (filename
);
413 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
415 p
= beg
+ SBYTES (filename
);
417 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
419 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
422 /* only recognise drive specifier at the beginning */
424 /* handle the "/:d:foo" and "/:foo" cases correctly */
425 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
426 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
433 /* Expansion of "c:" to drive and default directory. */
436 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
437 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
438 unsigned char *r
= res
;
440 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
442 strncpy (res
, beg
, 2);
447 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
449 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
452 p
= beg
+ strlen (beg
);
455 CORRECT_DIR_SEPS (beg
);
458 if (STRING_MULTIBYTE (filename
))
459 return make_string (beg
, p
- beg
);
460 return make_unibyte_string (beg
, p
- beg
);
463 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
464 Sfile_name_nondirectory
, 1, 1, 0,
465 doc
: /* Return file name FILENAME sans its directory.
466 For example, in a Unix-syntax file name,
467 this is everything after the last slash,
468 or the entire name if it contains no slash. */)
470 Lisp_Object filename
;
472 register const unsigned char *beg
, *p
, *end
;
475 CHECK_STRING (filename
);
477 /* If the file name has special constructs in it,
478 call the corresponding file handler. */
479 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
481 return call2 (handler
, Qfile_name_nondirectory
, filename
);
483 beg
= SDATA (filename
);
484 end
= p
= beg
+ SBYTES (filename
);
486 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
488 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
491 /* only recognise drive specifier at beginning */
493 /* handle the "/:d:foo" case correctly */
494 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
499 if (STRING_MULTIBYTE (filename
))
500 return make_string (p
, end
- p
);
501 return make_unibyte_string (p
, end
- p
);
504 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
505 Sunhandled_file_name_directory
, 1, 1, 0,
506 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
507 A `directly usable' directory name is one that may be used without the
508 intervention of any file handler.
509 If FILENAME is a directly usable file itself, return
510 \(file-name-directory FILENAME).
511 The `call-process' and `start-process' functions use this function to
512 get a current directory to run processes in. */)
514 Lisp_Object filename
;
518 /* If the file name has special constructs in it,
519 call the corresponding file handler. */
520 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
522 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
524 return Ffile_name_directory (filename
);
529 file_name_as_directory (out
, in
)
532 int size
= strlen (in
) - 1;
545 /* Is it already a directory string? */
546 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
548 /* Is it a VMS directory file name? If so, hack VMS syntax. */
549 else if (! index (in
, '/')
550 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
551 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
552 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
553 || ! strncmp (&in
[size
- 5], ".dir", 4))
554 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
555 && in
[size
] == '1')))
557 register char *p
, *dot
;
561 dir:x.dir --> dir:[x]
562 dir:[x]y.dir --> dir:[x.y] */
564 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
567 strncpy (out
, in
, p
- in
);
586 dot
= index (p
, '.');
589 /* blindly remove any extension */
590 size
= strlen (out
) + (dot
- p
);
591 strncat (out
, p
, dot
- p
);
602 /* For Unix syntax, Append a slash if necessary */
603 if (!IS_DIRECTORY_SEP (out
[size
]))
605 /* Cannot use DIRECTORY_SEP, which could have any value */
607 out
[size
+ 2] = '\0';
610 CORRECT_DIR_SEPS (out
);
616 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
617 Sfile_name_as_directory
, 1, 1, 0,
618 doc
: /* Return a string representing the file name FILE interpreted as a directory.
619 This operation exists because a directory is also a file, but its name as
620 a directory is different from its name as a file.
621 The result can be used as the value of `default-directory'
622 or passed as second argument to `expand-file-name'.
623 For a Unix-syntax file name, just appends a slash.
624 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
635 /* If the file name has special constructs in it,
636 call the corresponding file handler. */
637 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
639 return call2 (handler
, Qfile_name_as_directory
, file
);
641 buf
= (char *) alloca (SBYTES (file
) + 10);
642 return build_string (file_name_as_directory (buf
, SDATA (file
)));
646 * Convert from directory name to filename.
648 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
649 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
650 * On UNIX, it's simple: just make sure there isn't a terminating /
652 * Value is nonzero if the string output is different from the input.
656 directory_file_name (src
, dst
)
664 struct FAB fab
= cc$rms_fab
;
665 struct NAM nam
= cc$rms_nam
;
666 char esa
[NAM$C_MAXRSS
];
671 if (! index (src
, '/')
672 && (src
[slen
- 1] == ']'
673 || src
[slen
- 1] == ':'
674 || src
[slen
- 1] == '>'))
676 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
678 fab
.fab$b_fns
= slen
;
679 fab
.fab$l_nam
= &nam
;
680 fab
.fab$l_fop
= FAB$M_NAM
;
683 nam
.nam$b_ess
= sizeof esa
;
684 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
686 /* We call SYS$PARSE to handle such things as [--] for us. */
687 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
689 slen
= nam
.nam$b_esl
;
690 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
695 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
697 /* what about when we have logical_name:???? */
698 if (src
[slen
- 1] == ':')
699 { /* Xlate logical name and see what we get */
700 ptr
= strcpy (dst
, src
); /* upper case for getenv */
703 if ('a' <= *ptr
&& *ptr
<= 'z')
707 dst
[slen
- 1] = 0; /* remove colon */
708 if (!(src
= egetenv (dst
)))
710 /* should we jump to the beginning of this procedure?
711 Good points: allows us to use logical names that xlate
713 Bad points: can be a problem if we just translated to a device
715 For now, I'll punt and always expect VMS names, and hope for
718 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
719 { /* no recursion here! */
725 { /* not a directory spec */
730 bracket
= src
[slen
- 1];
732 /* If bracket is ']' or '>', bracket - 2 is the corresponding
734 ptr
= index (src
, bracket
- 2);
736 { /* no opening bracket */
740 if (!(rptr
= rindex (src
, '.')))
743 strncpy (dst
, src
, slen
);
747 dst
[slen
++] = bracket
;
752 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
753 then translate the device and recurse. */
754 if (dst
[slen
- 1] == ':'
755 && dst
[slen
- 2] != ':' /* skip decnet nodes */
756 && strcmp (src
+ slen
, "[000000]") == 0)
758 dst
[slen
- 1] = '\0';
759 if ((ptr
= egetenv (dst
))
760 && (rlen
= strlen (ptr
) - 1) > 0
761 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
762 && ptr
[rlen
- 1] == '.')
764 char * buf
= (char *) alloca (strlen (ptr
) + 1);
768 return directory_file_name (buf
, dst
);
773 strcat (dst
, "[000000]");
777 rlen
= strlen (rptr
) - 1;
778 strncat (dst
, rptr
, rlen
);
779 dst
[slen
+ rlen
] = '\0';
780 strcat (dst
, ".DIR.1");
784 /* Process as Unix format: just remove any final slash.
785 But leave "/" unchanged; do not change it to "". */
788 /* Handle // as root for apollo's. */
789 if ((slen
> 2 && dst
[slen
- 1] == '/')
790 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
794 && IS_DIRECTORY_SEP (dst
[slen
- 1])
796 && !IS_ANY_SEP (dst
[slen
- 2])
802 CORRECT_DIR_SEPS (dst
);
807 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
809 doc
: /* Returns the file name of the directory named DIRECTORY.
810 This is the name of the file that holds the data for the directory DIRECTORY.
811 This operation exists because a directory is also a file, but its name as
812 a directory is different from its name as a file.
813 In Unix-syntax, this function just removes the final slash.
814 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
815 it returns a file name such as \"[X]Y.DIR.1\". */)
817 Lisp_Object directory
;
822 CHECK_STRING (directory
);
824 if (NILP (directory
))
827 /* If the file name has special constructs in it,
828 call the corresponding file handler. */
829 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
831 return call2 (handler
, Qdirectory_file_name
, directory
);
834 /* 20 extra chars is insufficient for VMS, since we might perform a
835 logical name translation. an equivalence string can be up to 255
836 chars long, so grab that much extra space... - sss */
837 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
839 buf
= (char *) alloca (SBYTES (directory
) + 20);
841 directory_file_name (SDATA (directory
), buf
);
842 return build_string (buf
);
845 static char make_temp_name_tbl
[64] =
847 'A','B','C','D','E','F','G','H',
848 'I','J','K','L','M','N','O','P',
849 'Q','R','S','T','U','V','W','X',
850 'Y','Z','a','b','c','d','e','f',
851 'g','h','i','j','k','l','m','n',
852 'o','p','q','r','s','t','u','v',
853 'w','x','y','z','0','1','2','3',
854 '4','5','6','7','8','9','-','_'
857 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
859 /* Value is a temporary file name starting with PREFIX, a string.
861 The Emacs process number forms part of the result, so there is
862 no danger of generating a name being used by another process.
863 In addition, this function makes an attempt to choose a name
864 which has no existing file. To make this work, PREFIX should be
865 an absolute file name.
867 BASE64_P non-zero means add the pid as 3 characters in base64
868 encoding. In this case, 6 characters will be added to PREFIX to
869 form the file name. Otherwise, if Emacs is running on a system
870 with long file names, add the pid as a decimal number.
872 This function signals an error if no unique file name could be
876 make_temp_name (prefix
, base64_p
)
883 unsigned char *p
, *data
;
887 CHECK_STRING (prefix
);
889 /* VAL is created by adding 6 characters to PREFIX. The first
890 three are the PID of this process, in base 64, and the second
891 three are incremented if the file already exists. This ensures
892 262144 unique file names per PID per PREFIX. */
894 pid
= (int) getpid ();
898 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
899 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
900 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
905 #ifdef HAVE_LONG_FILE_NAMES
906 sprintf (pidbuf
, "%d", pid
);
907 pidlen
= strlen (pidbuf
);
909 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
910 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
911 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
916 len
= SCHARS (prefix
);
917 val
= make_uninit_string (len
+ 3 + pidlen
);
919 bcopy(SDATA (prefix
), data
, len
);
922 bcopy (pidbuf
, p
, pidlen
);
925 /* Here we try to minimize useless stat'ing when this function is
926 invoked many times successively with the same PREFIX. We achieve
927 this by initializing count to a random value, and incrementing it
930 We don't want make-temp-name to be called while dumping,
931 because then make_temp_name_count_initialized_p would get set
932 and then make_temp_name_count would not be set when Emacs starts. */
934 if (!make_temp_name_count_initialized_p
)
936 make_temp_name_count
= (unsigned) time (NULL
);
937 make_temp_name_count_initialized_p
= 1;
943 unsigned num
= make_temp_name_count
;
945 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
946 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
947 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
949 /* Poor man's congruential RN generator. Replace with
950 ++make_temp_name_count for debugging. */
951 make_temp_name_count
+= 25229;
952 make_temp_name_count
%= 225307;
954 if (stat (data
, &ignored
) < 0)
956 /* We want to return only if errno is ENOENT. */
960 /* The error here is dubious, but there is little else we
961 can do. The alternatives are to return nil, which is
962 as bad as (and in many cases worse than) throwing the
963 error, or to ignore the error, which will likely result
964 in looping through 225307 stat's, which is not only
965 dog-slow, but also useless since it will fallback to
966 the errow below, anyway. */
967 report_file_error ("Cannot create temporary name for prefix",
968 Fcons (prefix
, Qnil
));
973 error ("Cannot create temporary name for prefix `%s'",
979 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
980 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
981 The Emacs process number forms part of the result,
982 so there is no danger of generating a name being used by another process.
984 In addition, this function makes an attempt to choose a name
985 which has no existing file. To make this work,
986 PREFIX should be an absolute file name.
988 There is a race condition between calling `make-temp-name' and creating the
989 file which opens all kinds of security holes. For that reason, you should
990 probably use `make-temp-file' instead, except in three circumstances:
992 * If you are creating the file in the user's home directory.
993 * If you are creating a directory rather than an ordinary file.
994 * If you are taking special precautions as `make-temp-file' does. */)
998 return make_temp_name (prefix
, 0);
1003 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1004 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1005 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1006 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1007 the current buffer's value of default-directory is used.
1008 File name components that are `.' are removed, and
1009 so are file name components followed by `..', along with the `..' itself;
1010 note that these simplifications are done without checking the resulting
1011 file names in the file system.
1012 An initial `~/' expands to your home directory.
1013 An initial `~USER/' expands to USER's home directory.
1014 See also the function `substitute-in-file-name'. */)
1015 (name
, default_directory
)
1016 Lisp_Object name
, default_directory
;
1020 register unsigned char *newdir
, *p
, *o
;
1022 unsigned char *target
;
1025 unsigned char * colon
= 0;
1026 unsigned char * close
= 0;
1027 unsigned char * slash
= 0;
1028 unsigned char * brack
= 0;
1029 int lbrack
= 0, rbrack
= 0;
1034 int collapse_newdir
= 1;
1038 Lisp_Object handler
;
1040 CHECK_STRING (name
);
1042 /* If the file name has special constructs in it,
1043 call the corresponding file handler. */
1044 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1045 if (!NILP (handler
))
1046 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1048 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1049 if (NILP (default_directory
))
1050 default_directory
= current_buffer
->directory
;
1051 if (! STRINGP (default_directory
))
1054 /* "/" is not considered a root directory on DOS_NT, so using "/"
1055 here causes an infinite recursion in, e.g., the following:
1057 (let (default-directory)
1058 (expand-file-name "a"))
1060 To avoid this, we set default_directory to the root of the
1062 extern char *emacs_root_dir (void);
1064 default_directory
= build_string (emacs_root_dir ());
1066 default_directory
= build_string ("/");
1070 if (!NILP (default_directory
))
1072 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1073 if (!NILP (handler
))
1074 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1077 o
= SDATA (default_directory
);
1079 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1080 It would be better to do this down below where we actually use
1081 default_directory. Unfortunately, calling Fexpand_file_name recursively
1082 could invoke GC, and the strings might be relocated. This would
1083 be annoying because we have pointers into strings lying around
1084 that would need adjusting, and people would add new pointers to
1085 the code and forget to adjust them, resulting in intermittent bugs.
1086 Putting this call here avoids all that crud.
1088 The EQ test avoids infinite recursion. */
1089 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1090 /* Save time in some common cases - as long as default_directory
1091 is not relative, it can be canonicalized with name below (if it
1092 is needed at all) without requiring it to be expanded now. */
1094 /* Detect MSDOS file names with drive specifiers. */
1095 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1097 /* Detect Windows file names in UNC format. */
1098 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1100 #else /* not DOS_NT */
1101 /* Detect Unix absolute file names (/... alone is not absolute on
1103 && ! (IS_DIRECTORY_SEP (o
[0]))
1104 #endif /* not DOS_NT */
1107 struct gcpro gcpro1
;
1110 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1115 /* Filenames on VMS are always upper case. */
1116 name
= Fupcase (name
);
1118 #ifdef FILE_SYSTEM_CASE
1119 name
= FILE_SYSTEM_CASE (name
);
1125 /* We will force directory separators to be either all \ or /, so make
1126 a local copy to modify, even if there ends up being no change. */
1127 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1129 /* Note if special escape prefix is present, but remove for now. */
1130 if (nm
[0] == '/' && nm
[1] == ':')
1136 /* Find and remove drive specifier if present; this makes nm absolute
1137 even if the rest of the name appears to be relative. Only look for
1138 drive specifier at the beginning. */
1139 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1146 /* If we see "c://somedir", we want to strip the first slash after the
1147 colon when stripping the drive letter. Otherwise, this expands to
1149 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1151 #endif /* WINDOWSNT */
1155 /* Discard any previous drive specifier if nm is now in UNC format. */
1156 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1162 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1163 none are found, we can probably return right away. We will avoid
1164 allocating a new string if name is already fully expanded. */
1166 IS_DIRECTORY_SEP (nm
[0])
1168 && drive
&& !is_escaped
1171 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1178 /* If it turns out that the filename we want to return is just a
1179 suffix of FILENAME, we don't need to go through and edit
1180 things; we just need to construct a new string using data
1181 starting at the middle of FILENAME. If we set lose to a
1182 non-zero value, that means we've discovered that we can't do
1189 /* Since we know the name is absolute, we can assume that each
1190 element starts with a "/". */
1192 /* "." and ".." are hairy. */
1193 if (IS_DIRECTORY_SEP (p
[0])
1195 && (IS_DIRECTORY_SEP (p
[2])
1197 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1200 /* We want to replace multiple `/' in a row with a single
1203 && IS_DIRECTORY_SEP (p
[0])
1204 && IS_DIRECTORY_SEP (p
[1]))
1211 /* if dev:[dir]/, move nm to / */
1212 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1213 nm
= (brack
? brack
+ 1 : colon
+ 1);
1214 lbrack
= rbrack
= 0;
1222 /* VMS pre V4.4,convert '-'s in filenames. */
1223 if (lbrack
== rbrack
)
1225 if (dots
< 2) /* this is to allow negative version numbers */
1230 if (lbrack
> rbrack
&&
1231 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1232 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1238 /* count open brackets, reset close bracket pointer */
1239 if (p
[0] == '[' || p
[0] == '<')
1240 lbrack
++, brack
= 0;
1241 /* count close brackets, set close bracket pointer */
1242 if (p
[0] == ']' || p
[0] == '>')
1243 rbrack
++, brack
= p
;
1244 /* detect ][ or >< */
1245 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1247 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1248 nm
= p
+ 1, lose
= 1;
1249 if (p
[0] == ':' && (colon
|| slash
))
1250 /* if dev1:[dir]dev2:, move nm to dev2: */
1256 /* if /name/dev:, move nm to dev: */
1259 /* if node::dev:, move colon following dev */
1260 else if (colon
&& colon
[-1] == ':')
1262 /* if dev1:dev2:, move nm to dev2: */
1263 else if (colon
&& colon
[-1] != ':')
1268 if (p
[0] == ':' && !colon
)
1274 if (lbrack
== rbrack
)
1277 else if (p
[0] == '.')
1285 if (index (nm
, '/'))
1286 return build_string (sys_translate_unix (nm
));
1289 /* Make sure directories are all separated with / or \ as
1290 desired, but avoid allocation of a new string when not
1292 CORRECT_DIR_SEPS (nm
);
1294 if (IS_DIRECTORY_SEP (nm
[1]))
1296 if (strcmp (nm
, SDATA (name
)) != 0)
1297 name
= build_string (nm
);
1301 /* drive must be set, so this is okay */
1302 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1304 name
= make_string (nm
- 2, p
- nm
+ 2);
1305 SSET (name
, 0, DRIVE_LETTER (drive
));
1306 SSET (name
, 1, ':');
1309 #else /* not DOS_NT */
1310 if (nm
== SDATA (name
))
1312 return build_string (nm
);
1313 #endif /* not DOS_NT */
1317 /* At this point, nm might or might not be an absolute file name. We
1318 need to expand ~ or ~user if present, otherwise prefix nm with
1319 default_directory if nm is not absolute, and finally collapse /./
1320 and /foo/../ sequences.
1322 We set newdir to be the appropriate prefix if one is needed:
1323 - the relevant user directory if nm starts with ~ or ~user
1324 - the specified drive's working dir (DOS/NT only) if nm does not
1326 - the value of default_directory.
1328 Note that these prefixes are not guaranteed to be absolute (except
1329 for the working dir of a drive). Therefore, to ensure we always
1330 return an absolute name, if the final prefix is not absolute we
1331 append it to the current working directory. */
1335 if (nm
[0] == '~') /* prefix ~ */
1337 if (IS_DIRECTORY_SEP (nm
[1])
1341 || nm
[1] == 0) /* ~ by itself */
1343 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1344 newdir
= (unsigned char *) "";
1347 collapse_newdir
= 0;
1350 nm
++; /* Don't leave the slash in nm. */
1353 else /* ~user/filename */
1355 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1360 o
= (unsigned char *) alloca (p
- nm
+ 1);
1361 bcopy ((char *) nm
, o
, p
- nm
);
1364 pw
= (struct passwd
*) getpwnam (o
+ 1);
1367 newdir
= (unsigned char *) pw
-> pw_dir
;
1369 nm
= p
+ 1; /* skip the terminator */
1373 collapse_newdir
= 0;
1378 /* If we don't find a user of that name, leave the name
1379 unchanged; don't move nm forward to p. */
1384 /* On DOS and Windows, nm is absolute if a drive name was specified;
1385 use the drive's current directory as the prefix if needed. */
1386 if (!newdir
&& drive
)
1388 /* Get default directory if needed to make nm absolute. */
1389 if (!IS_DIRECTORY_SEP (nm
[0]))
1391 newdir
= alloca (MAXPATHLEN
+ 1);
1392 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1397 /* Either nm starts with /, or drive isn't mounted. */
1398 newdir
= alloca (4);
1399 newdir
[0] = DRIVE_LETTER (drive
);
1407 /* Finally, if no prefix has been specified and nm is not absolute,
1408 then it must be expanded relative to default_directory. */
1412 /* /... alone is not absolute on DOS and Windows. */
1413 && !IS_DIRECTORY_SEP (nm
[0])
1416 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1423 newdir
= SDATA (default_directory
);
1425 /* Note if special escape prefix is present, but remove for now. */
1426 if (newdir
[0] == '/' && newdir
[1] == ':')
1437 /* First ensure newdir is an absolute name. */
1439 /* Detect MSDOS file names with drive specifiers. */
1440 ! (IS_DRIVE (newdir
[0])
1441 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1443 /* Detect Windows file names in UNC format. */
1444 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1448 /* Effectively, let newdir be (expand-file-name newdir cwd).
1449 Because of the admonition against calling expand-file-name
1450 when we have pointers into lisp strings, we accomplish this
1451 indirectly by prepending newdir to nm if necessary, and using
1452 cwd (or the wd of newdir's drive) as the new newdir. */
1454 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1459 if (!IS_DIRECTORY_SEP (nm
[0]))
1461 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1462 file_name_as_directory (tmp
, newdir
);
1466 newdir
= alloca (MAXPATHLEN
+ 1);
1469 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1476 /* Strip off drive name from prefix, if present. */
1477 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1483 /* Keep only a prefix from newdir if nm starts with slash
1484 (//server/share for UNC, nothing otherwise). */
1485 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1488 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1490 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1492 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1494 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1506 /* Get rid of any slash at the end of newdir, unless newdir is
1507 just / or // (an incomplete UNC name). */
1508 length
= strlen (newdir
);
1509 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1511 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1515 unsigned char *temp
= (unsigned char *) alloca (length
);
1516 bcopy (newdir
, temp
, length
- 1);
1517 temp
[length
- 1] = 0;
1525 /* Now concatenate the directory and name to new space in the stack frame */
1526 tlen
+= strlen (nm
) + 1;
1528 /* Reserve space for drive specifier and escape prefix, since either
1529 or both may need to be inserted. (The Microsoft x86 compiler
1530 produces incorrect code if the following two lines are combined.) */
1531 target
= (unsigned char *) alloca (tlen
+ 4);
1533 #else /* not DOS_NT */
1534 target
= (unsigned char *) alloca (tlen
);
1535 #endif /* not DOS_NT */
1541 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1544 /* If newdir is effectively "C:/", then the drive letter will have
1545 been stripped and newdir will be "/". Concatenating with an
1546 absolute directory in nm produces "//", which will then be
1547 incorrectly treated as a network share. Ignore newdir in
1548 this case (keeping the drive letter). */
1549 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1550 && newdir
[1] == '\0'))
1552 strcpy (target
, newdir
);
1556 file_name_as_directory (target
, newdir
);
1559 strcat (target
, nm
);
1561 if (index (target
, '/'))
1562 strcpy (target
, sys_translate_unix (target
));
1565 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1567 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1576 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1582 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1583 /* brackets are offset from each other by 2 */
1586 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1587 /* convert [foo][bar] to [bar] */
1588 while (o
[-1] != '[' && o
[-1] != '<')
1590 else if (*p
== '-' && *o
!= '.')
1593 else if (p
[0] == '-' && o
[-1] == '.' &&
1594 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1595 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1599 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1600 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1602 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1604 /* else [foo.-] ==> [-] */
1610 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1611 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1617 if (!IS_DIRECTORY_SEP (*p
))
1621 else if (IS_DIRECTORY_SEP (p
[0])
1623 && (IS_DIRECTORY_SEP (p
[2])
1626 /* If "/." is the entire filename, keep the "/". Otherwise,
1627 just delete the whole "/.". */
1628 if (o
== target
&& p
[2] == '\0')
1632 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1633 /* `/../' is the "superroot" on certain file systems. */
1635 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1637 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1639 /* Keep initial / only if this is the whole name. */
1640 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1645 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1647 /* Collapse multiple `/' in a row. */
1649 while (IS_DIRECTORY_SEP (*p
))
1656 #endif /* not VMS */
1660 /* At last, set drive name. */
1662 /* Except for network file name. */
1663 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1664 #endif /* WINDOWSNT */
1666 if (!drive
) abort ();
1668 target
[0] = DRIVE_LETTER (drive
);
1671 /* Reinsert the escape prefix if required. */
1678 CORRECT_DIR_SEPS (target
);
1681 return make_string (target
, o
- target
);
1685 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1686 This is the old version of expand-file-name, before it was thoroughly
1687 rewritten for Emacs 10.31. We leave this version here commented-out,
1688 because the code is very complex and likely to have subtle bugs. If
1689 bugs _are_ found, it might be of interest to look at the old code and
1690 see what did it do in the relevant situation.
1692 Don't remove this code: it's true that it will be accessible via CVS,
1693 but a few years from deletion, people will forget it is there. */
1695 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1696 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1697 "Convert FILENAME to absolute, and canonicalize it.\n\
1698 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1699 (does not start with slash); if DEFAULT is nil or missing,\n\
1700 the current buffer's value of default-directory is used.\n\
1701 Filenames containing `.' or `..' as components are simplified;\n\
1702 initial `~/' expands to your home directory.\n\
1703 See also the function `substitute-in-file-name'.")
1705 Lisp_Object name
, defalt
;
1709 register unsigned char *newdir
, *p
, *o
;
1711 unsigned char *target
;
1715 unsigned char * colon
= 0;
1716 unsigned char * close
= 0;
1717 unsigned char * slash
= 0;
1718 unsigned char * brack
= 0;
1719 int lbrack
= 0, rbrack
= 0;
1723 CHECK_STRING (name
);
1726 /* Filenames on VMS are always upper case. */
1727 name
= Fupcase (name
);
1732 /* If nm is absolute, flush ...// and detect /./ and /../.
1733 If no /./ or /../ we can return right away. */
1745 if (p
[0] == '/' && p
[1] == '/'
1747 /* // at start of filename is meaningful on Apollo system. */
1752 if (p
[0] == '/' && p
[1] == '~')
1753 nm
= p
+ 1, lose
= 1;
1754 if (p
[0] == '/' && p
[1] == '.'
1755 && (p
[2] == '/' || p
[2] == 0
1756 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1762 /* if dev:[dir]/, move nm to / */
1763 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1764 nm
= (brack
? brack
+ 1 : colon
+ 1);
1765 lbrack
= rbrack
= 0;
1773 /* VMS pre V4.4,convert '-'s in filenames. */
1774 if (lbrack
== rbrack
)
1776 if (dots
< 2) /* this is to allow negative version numbers */
1781 if (lbrack
> rbrack
&&
1782 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1783 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1789 /* count open brackets, reset close bracket pointer */
1790 if (p
[0] == '[' || p
[0] == '<')
1791 lbrack
++, brack
= 0;
1792 /* count close brackets, set close bracket pointer */
1793 if (p
[0] == ']' || p
[0] == '>')
1794 rbrack
++, brack
= p
;
1795 /* detect ][ or >< */
1796 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1798 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1799 nm
= p
+ 1, lose
= 1;
1800 if (p
[0] == ':' && (colon
|| slash
))
1801 /* if dev1:[dir]dev2:, move nm to dev2: */
1807 /* If /name/dev:, move nm to dev: */
1810 /* If node::dev:, move colon following dev */
1811 else if (colon
&& colon
[-1] == ':')
1813 /* If dev1:dev2:, move nm to dev2: */
1814 else if (colon
&& colon
[-1] != ':')
1819 if (p
[0] == ':' && !colon
)
1825 if (lbrack
== rbrack
)
1828 else if (p
[0] == '.')
1836 if (index (nm
, '/'))
1837 return build_string (sys_translate_unix (nm
));
1839 if (nm
== SDATA (name
))
1841 return build_string (nm
);
1845 /* Now determine directory to start with and put it in NEWDIR */
1849 if (nm
[0] == '~') /* prefix ~ */
1854 || nm
[1] == 0)/* ~/filename */
1856 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1857 newdir
= (unsigned char *) "";
1860 nm
++; /* Don't leave the slash in nm. */
1863 else /* ~user/filename */
1865 /* Get past ~ to user */
1866 unsigned char *user
= nm
+ 1;
1867 /* Find end of name. */
1868 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1869 int len
= ptr
? ptr
- user
: strlen (user
);
1871 unsigned char *ptr1
= index (user
, ':');
1872 if (ptr1
!= 0 && ptr1
- user
< len
)
1875 /* Copy the user name into temp storage. */
1876 o
= (unsigned char *) alloca (len
+ 1);
1877 bcopy ((char *) user
, o
, len
);
1880 /* Look up the user name. */
1881 pw
= (struct passwd
*) getpwnam (o
+ 1);
1883 error ("\"%s\" isn't a registered user", o
+ 1);
1885 newdir
= (unsigned char *) pw
->pw_dir
;
1887 /* Discard the user name from NM. */
1894 #endif /* not VMS */
1898 defalt
= current_buffer
->directory
;
1899 CHECK_STRING (defalt
);
1900 newdir
= SDATA (defalt
);
1903 /* Now concatenate the directory and name to new space in the stack frame */
1905 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1906 target
= (unsigned char *) alloca (tlen
);
1912 if (nm
[0] == 0 || nm
[0] == '/')
1913 strcpy (target
, newdir
);
1916 file_name_as_directory (target
, newdir
);
1919 strcat (target
, nm
);
1921 if (index (target
, '/'))
1922 strcpy (target
, sys_translate_unix (target
));
1925 /* Now canonicalize by removing /. and /foo/.. if they appear */
1933 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1939 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1940 /* brackets are offset from each other by 2 */
1943 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1944 /* convert [foo][bar] to [bar] */
1945 while (o
[-1] != '[' && o
[-1] != '<')
1947 else if (*p
== '-' && *o
!= '.')
1950 else if (p
[0] == '-' && o
[-1] == '.' &&
1951 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1952 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1956 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1957 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1959 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1961 /* else [foo.-] ==> [-] */
1967 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1968 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1978 else if (!strncmp (p
, "//", 2)
1980 /* // at start of filename is meaningful in Apollo system. */
1988 else if (p
[0] == '/' && p
[1] == '.' &&
1989 (p
[2] == '/' || p
[2] == 0))
1991 else if (!strncmp (p
, "/..", 3)
1992 /* `/../' is the "superroot" on certain file systems. */
1994 && (p
[3] == '/' || p
[3] == 0))
1996 while (o
!= target
&& *--o
!= '/')
1999 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2003 if (o
== target
&& *o
== '/')
2011 #endif /* not VMS */
2014 return make_string (target
, o
- target
);
2018 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2019 Ssubstitute_in_file_name
, 1, 1, 0,
2020 doc
: /* Substitute environment variables referred to in FILENAME.
2021 `$FOO' where FOO is an environment variable name means to substitute
2022 the value of that variable. The variable name should be terminated
2023 with a character not a letter, digit or underscore; otherwise, enclose
2024 the entire variable name in braces.
2025 If `/~' appears, all of FILENAME through that `/' is discarded.
2027 On VMS, `$' substitution is not done; this function does little and only
2028 duplicates what `expand-file-name' does. */)
2030 Lisp_Object filename
;
2034 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2035 unsigned char *target
= NULL
;
2037 int substituted
= 0;
2040 Lisp_Object handler
;
2042 CHECK_STRING (filename
);
2044 /* If the file name has special constructs in it,
2045 call the corresponding file handler. */
2046 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2047 if (!NILP (handler
))
2048 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2050 nm
= SDATA (filename
);
2052 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2053 CORRECT_DIR_SEPS (nm
);
2054 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2056 endp
= nm
+ SBYTES (filename
);
2058 /* If /~ or // appears, discard everything through first slash. */
2060 for (p
= nm
; p
!= endp
; p
++)
2063 #if defined (APOLLO) || defined (WINDOWSNT)
2064 /* // at start of file name is meaningful in Apollo and
2065 WindowsNT systems. */
2066 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2067 #else /* not (APOLLO || WINDOWSNT) */
2068 || IS_DIRECTORY_SEP (p
[0])
2069 #endif /* not (APOLLO || WINDOWSNT) */
2074 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2076 || IS_DIRECTORY_SEP (p
[-1])))
2078 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2083 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2085 o
= (unsigned char *) alloca (s
- p
+ 1);
2086 bcopy ((char *) p
, o
, s
- p
);
2089 pw
= (struct passwd
*) getpwnam (o
+ 1);
2091 /* If we have ~/ or ~user and `user' exists, discard
2092 everything up to ~. But if `user' does not exist, leave
2093 ~user alone, it might be a literal file name. */
2094 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2101 /* see comment in expand-file-name about drive specifiers */
2102 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2103 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2112 return build_string (nm
);
2115 /* See if any variables are substituted into the string
2116 and find the total length of their values in `total' */
2118 for (p
= nm
; p
!= endp
;)
2128 /* "$$" means a single "$" */
2137 while (p
!= endp
&& *p
!= '}') p
++;
2138 if (*p
!= '}') goto missingclose
;
2144 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2148 /* Copy out the variable name */
2149 target
= (unsigned char *) alloca (s
- o
+ 1);
2150 strncpy (target
, o
, s
- o
);
2153 strupr (target
); /* $home == $HOME etc. */
2156 /* Get variable value */
2157 o
= (unsigned char *) egetenv (target
);
2160 total
+= strlen (o
);
2170 /* If substitution required, recopy the string and do it */
2171 /* Make space in stack frame for the new copy */
2172 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2175 /* Copy the rest of the name through, replacing $ constructs with values */
2192 while (p
!= endp
&& *p
!= '}') p
++;
2193 if (*p
!= '}') goto missingclose
;
2199 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2203 /* Copy out the variable name */
2204 target
= (unsigned char *) alloca (s
- o
+ 1);
2205 strncpy (target
, o
, s
- o
);
2208 strupr (target
); /* $home == $HOME etc. */
2211 /* Get variable value */
2212 o
= (unsigned char *) egetenv (target
);
2216 strcpy (x
, target
); x
+= strlen (target
);
2218 else if (STRING_MULTIBYTE (filename
))
2220 /* If the original string is multibyte,
2221 convert what we substitute into multibyte. */
2224 int c
= unibyte_char_to_multibyte (*o
++);
2225 x
+= CHAR_STRING (c
, x
);
2237 /* If /~ or // appears, discard everything through first slash. */
2239 for (p
= xnm
; p
!= x
; p
++)
2241 #if defined (APOLLO) || defined (WINDOWSNT)
2242 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2243 #else /* not (APOLLO || WINDOWSNT) */
2244 || IS_DIRECTORY_SEP (p
[0])
2245 #endif /* not (APOLLO || WINDOWSNT) */
2247 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2250 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2251 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2255 if (STRING_MULTIBYTE (filename
))
2256 return make_string (xnm
, x
- xnm
);
2257 return make_unibyte_string (xnm
, x
- xnm
);
2260 error ("Bad format environment-variable substitution");
2262 error ("Missing \"}\" in environment-variable substitution");
2264 error ("Substituting nonexistent environment variable \"%s\"", target
);
2267 #endif /* not VMS */
2271 /* A slightly faster and more convenient way to get
2272 (directory-file-name (expand-file-name FOO)). */
2275 expand_and_dir_to_file (filename
, defdir
)
2276 Lisp_Object filename
, defdir
;
2278 register Lisp_Object absname
;
2280 absname
= Fexpand_file_name (filename
, defdir
);
2283 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2284 if (c
== ':' || c
== ']' || c
== '>')
2285 absname
= Fdirectory_file_name (absname
);
2288 /* Remove final slash, if any (unless this is the root dir).
2289 stat behaves differently depending! */
2290 if (SCHARS (absname
) > 1
2291 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2292 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2293 /* We cannot take shortcuts; they might be wrong for magic file names. */
2294 absname
= Fdirectory_file_name (absname
);
2299 /* Signal an error if the file ABSNAME already exists.
2300 If INTERACTIVE is nonzero, ask the user whether to proceed,
2301 and bypass the error if the user says to go ahead.
2302 QUERYSTRING is a name for the action that is being considered
2305 *STATPTR is used to store the stat information if the file exists.
2306 If the file does not exist, STATPTR->st_mode is set to 0.
2307 If STATPTR is null, we don't store into it.
2309 If QUICK is nonzero, we ask for y or n, not yes or no. */
2312 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2313 Lisp_Object absname
;
2314 unsigned char *querystring
;
2316 struct stat
*statptr
;
2319 register Lisp_Object tem
, encoded_filename
;
2320 struct stat statbuf
;
2321 struct gcpro gcpro1
;
2323 encoded_filename
= ENCODE_FILE (absname
);
2325 /* stat is a good way to tell whether the file exists,
2326 regardless of what access permissions it has. */
2327 if (stat (SDATA (encoded_filename
), &statbuf
) >= 0)
2330 Fsignal (Qfile_already_exists
,
2331 Fcons (build_string ("File already exists"),
2332 Fcons (absname
, Qnil
)));
2334 tem
= format1 ("File %s already exists; %s anyway? ",
2335 SDATA (absname
), querystring
);
2337 tem
= Fy_or_n_p (tem
);
2339 tem
= do_yes_or_no_p (tem
);
2342 Fsignal (Qfile_already_exists
,
2343 Fcons (build_string ("File already exists"),
2344 Fcons (absname
, Qnil
)));
2351 statptr
->st_mode
= 0;
2356 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2357 "fCopy file: \nFCopy %s to file: \np\nP",
2358 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2359 If NEWNAME names a directory, copy FILE there.
2360 Signals a `file-already-exists' error if file NEWNAME already exists,
2361 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2362 A number as third arg means request confirmation if NEWNAME already exists.
2363 This is what happens in interactive use with M-x.
2364 Fourth arg KEEP-TIME non-nil means give the new file the same
2365 last-modified time as the old one. (This works on only some systems.)
2366 A prefix arg makes KEEP-TIME non-nil. */)
2367 (file
, newname
, ok_if_already_exists
, keep_time
)
2368 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2371 char buf
[16 * 1024];
2372 struct stat st
, out_st
;
2373 Lisp_Object handler
;
2374 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2375 int count
= SPECPDL_INDEX ();
2376 int input_file_statable_p
;
2377 Lisp_Object encoded_file
, encoded_newname
;
2379 encoded_file
= encoded_newname
= Qnil
;
2380 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2381 CHECK_STRING (file
);
2382 CHECK_STRING (newname
);
2384 if (!NILP (Ffile_directory_p (newname
)))
2385 newname
= Fexpand_file_name (file
, newname
);
2387 newname
= Fexpand_file_name (newname
, Qnil
);
2389 file
= Fexpand_file_name (file
, Qnil
);
2391 /* If the input file name has special constructs in it,
2392 call the corresponding file handler. */
2393 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2394 /* Likewise for output file name. */
2396 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2397 if (!NILP (handler
))
2398 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2399 ok_if_already_exists
, keep_time
));
2401 encoded_file
= ENCODE_FILE (file
);
2402 encoded_newname
= ENCODE_FILE (newname
);
2404 if (NILP (ok_if_already_exists
)
2405 || INTEGERP (ok_if_already_exists
))
2406 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2407 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2408 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2412 if (!CopyFile (SDATA (encoded_file
),
2413 SDATA (encoded_newname
),
2415 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2416 else if (NILP (keep_time
))
2422 EMACS_GET_TIME (now
);
2423 filename
= SDATA (encoded_newname
);
2425 /* Ensure file is writable while its modified time is set. */
2426 attributes
= GetFileAttributes (filename
);
2427 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2428 if (set_file_times (filename
, now
, now
))
2430 /* Restore original attributes. */
2431 SetFileAttributes (filename
, attributes
);
2432 Fsignal (Qfile_date_error
,
2433 Fcons (build_string ("Cannot set file date"),
2434 Fcons (newname
, Qnil
)));
2436 /* Restore original attributes. */
2437 SetFileAttributes (filename
, attributes
);
2439 #else /* not WINDOWSNT */
2440 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2442 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2444 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2446 /* We can only copy regular files and symbolic links. Other files are not
2448 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2450 #if !defined (DOS_NT) || __DJGPP__ > 1
2451 if (out_st
.st_mode
!= 0
2452 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2455 report_file_error ("Input and output files are the same",
2456 Fcons (file
, Fcons (newname
, Qnil
)));
2460 #if defined (S_ISREG) && defined (S_ISLNK)
2461 if (input_file_statable_p
)
2463 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2465 #if defined (EISDIR)
2466 /* Get a better looking error message. */
2469 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2472 #endif /* S_ISREG && S_ISLNK */
2475 /* Create the copy file with the same record format as the input file */
2476 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2479 /* System's default file type was set to binary by _fmode in emacs.c. */
2480 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2481 #else /* not MSDOS */
2482 ofd
= creat (SDATA (encoded_newname
), 0666);
2483 #endif /* not MSDOS */
2486 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2488 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2492 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2493 if (emacs_write (ofd
, buf
, n
) != n
)
2494 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2497 /* Closing the output clobbers the file times on some systems. */
2498 if (emacs_close (ofd
) < 0)
2499 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2501 if (input_file_statable_p
)
2503 if (!NILP (keep_time
))
2505 EMACS_TIME atime
, mtime
;
2506 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2507 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2508 if (set_file_times (SDATA (encoded_newname
),
2510 Fsignal (Qfile_date_error
,
2511 Fcons (build_string ("Cannot set file date"),
2512 Fcons (newname
, Qnil
)));
2515 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2517 #if defined (__DJGPP__) && __DJGPP__ > 1
2518 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2519 and if it can't, it tells so. Otherwise, under MSDOS we usually
2520 get only the READ bit, which will make the copied file read-only,
2521 so it's better not to chmod at all. */
2522 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2523 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2524 #endif /* DJGPP version 2 or newer */
2529 #endif /* WINDOWSNT */
2531 /* Discard the unwind protects. */
2532 specpdl_ptr
= specpdl
+ count
;
2538 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2539 Smake_directory_internal
, 1, 1, 0,
2540 doc
: /* Create a new directory named DIRECTORY. */)
2542 Lisp_Object directory
;
2544 const unsigned char *dir
;
2545 Lisp_Object handler
;
2546 Lisp_Object encoded_dir
;
2548 CHECK_STRING (directory
);
2549 directory
= Fexpand_file_name (directory
, Qnil
);
2551 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2552 if (!NILP (handler
))
2553 return call2 (handler
, Qmake_directory_internal
, directory
);
2555 encoded_dir
= ENCODE_FILE (directory
);
2557 dir
= SDATA (encoded_dir
);
2560 if (mkdir (dir
) != 0)
2562 if (mkdir (dir
, 0777) != 0)
2564 report_file_error ("Creating directory", Flist (1, &directory
));
2569 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2570 doc
: /* Delete the directory named DIRECTORY. */)
2572 Lisp_Object directory
;
2574 const unsigned char *dir
;
2575 Lisp_Object handler
;
2576 Lisp_Object encoded_dir
;
2578 CHECK_STRING (directory
);
2579 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2581 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2582 if (!NILP (handler
))
2583 return call2 (handler
, Qdelete_directory
, directory
);
2585 encoded_dir
= ENCODE_FILE (directory
);
2587 dir
= SDATA (encoded_dir
);
2589 if (rmdir (dir
) != 0)
2590 report_file_error ("Removing directory", Flist (1, &directory
));
2595 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2596 doc
: /* Delete file named FILENAME.
2597 If file has multiple names, it continues to exist with the other names. */)
2599 Lisp_Object filename
;
2601 Lisp_Object handler
;
2602 Lisp_Object encoded_file
;
2604 CHECK_STRING (filename
);
2605 filename
= Fexpand_file_name (filename
, Qnil
);
2607 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2608 if (!NILP (handler
))
2609 return call2 (handler
, Qdelete_file
, filename
);
2611 encoded_file
= ENCODE_FILE (filename
);
2613 if (0 > unlink (SDATA (encoded_file
)))
2614 report_file_error ("Removing old name", Flist (1, &filename
));
2619 internal_delete_file_1 (ignore
)
2625 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2628 internal_delete_file (filename
)
2629 Lisp_Object filename
;
2631 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2632 Qt
, internal_delete_file_1
));
2635 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2636 "fRename file: \nFRename %s to file: \np",
2637 doc
: /* Rename FILE as NEWNAME. Both args strings.
2638 If file has names other than FILE, it continues to have those names.
2639 Signals a `file-already-exists' error if a file NEWNAME already exists
2640 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2641 A number as third arg means request confirmation if NEWNAME already exists.
2642 This is what happens in interactive use with M-x. */)
2643 (file
, newname
, ok_if_already_exists
)
2644 Lisp_Object file
, newname
, ok_if_already_exists
;
2647 Lisp_Object args
[2];
2649 Lisp_Object handler
;
2650 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2651 Lisp_Object encoded_file
, encoded_newname
;
2653 encoded_file
= encoded_newname
= Qnil
;
2654 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2655 CHECK_STRING (file
);
2656 CHECK_STRING (newname
);
2657 file
= Fexpand_file_name (file
, Qnil
);
2658 newname
= Fexpand_file_name (newname
, Qnil
);
2660 /* If the file name has special constructs in it,
2661 call the corresponding file handler. */
2662 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2664 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2665 if (!NILP (handler
))
2666 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2667 file
, newname
, ok_if_already_exists
));
2669 encoded_file
= ENCODE_FILE (file
);
2670 encoded_newname
= ENCODE_FILE (newname
);
2673 /* If the file names are identical but for the case, don't ask for
2674 confirmation: they simply want to change the letter-case of the
2676 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2678 if (NILP (ok_if_already_exists
)
2679 || INTEGERP (ok_if_already_exists
))
2680 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2681 INTEGERP (ok_if_already_exists
), 0, 0);
2683 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2685 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2686 || 0 > unlink (SDATA (encoded_file
)))
2691 Fcopy_file (file
, newname
,
2692 /* We have already prompted if it was an integer,
2693 so don't have copy-file prompt again. */
2694 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2695 Fdelete_file (file
);
2702 report_file_error ("Renaming", Flist (2, args
));
2705 report_file_error ("Renaming", Flist (2, &file
));
2712 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2713 "fAdd name to file: \nFName to add to %s: \np",
2714 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2715 Signals a `file-already-exists' error if a file NEWNAME already exists
2716 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2717 A number as third arg means request confirmation if NEWNAME already exists.
2718 This is what happens in interactive use with M-x. */)
2719 (file
, newname
, ok_if_already_exists
)
2720 Lisp_Object file
, newname
, ok_if_already_exists
;
2723 Lisp_Object args
[2];
2725 Lisp_Object handler
;
2726 Lisp_Object encoded_file
, encoded_newname
;
2727 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2729 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2730 encoded_file
= encoded_newname
= Qnil
;
2731 CHECK_STRING (file
);
2732 CHECK_STRING (newname
);
2733 file
= Fexpand_file_name (file
, Qnil
);
2734 newname
= Fexpand_file_name (newname
, Qnil
);
2736 /* If the file name has special constructs in it,
2737 call the corresponding file handler. */
2738 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2739 if (!NILP (handler
))
2740 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2741 newname
, ok_if_already_exists
));
2743 /* If the new name has special constructs in it,
2744 call the corresponding file handler. */
2745 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2746 if (!NILP (handler
))
2747 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2748 newname
, ok_if_already_exists
));
2750 encoded_file
= ENCODE_FILE (file
);
2751 encoded_newname
= ENCODE_FILE (newname
);
2753 if (NILP (ok_if_already_exists
)
2754 || INTEGERP (ok_if_already_exists
))
2755 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2756 INTEGERP (ok_if_already_exists
), 0, 0);
2758 unlink (SDATA (newname
));
2759 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2764 report_file_error ("Adding new name", Flist (2, args
));
2766 report_file_error ("Adding new name", Flist (2, &file
));
2775 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2776 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2777 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2778 Signals a `file-already-exists' error if a file LINKNAME already exists
2779 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2780 A number as third arg means request confirmation if LINKNAME already exists.
2781 This happens for interactive use with M-x. */)
2782 (filename
, linkname
, ok_if_already_exists
)
2783 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2786 Lisp_Object args
[2];
2788 Lisp_Object handler
;
2789 Lisp_Object encoded_filename
, encoded_linkname
;
2790 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2792 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2793 encoded_filename
= encoded_linkname
= Qnil
;
2794 CHECK_STRING (filename
);
2795 CHECK_STRING (linkname
);
2796 /* If the link target has a ~, we must expand it to get
2797 a truly valid file name. Otherwise, do not expand;
2798 we want to permit links to relative file names. */
2799 if (SREF (filename
, 0) == '~')
2800 filename
= Fexpand_file_name (filename
, Qnil
);
2801 linkname
= Fexpand_file_name (linkname
, Qnil
);
2803 /* If the file name has special constructs in it,
2804 call the corresponding file handler. */
2805 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2806 if (!NILP (handler
))
2807 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2808 linkname
, ok_if_already_exists
));
2810 /* If the new link name has special constructs in it,
2811 call the corresponding file handler. */
2812 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2813 if (!NILP (handler
))
2814 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2815 linkname
, ok_if_already_exists
));
2817 encoded_filename
= ENCODE_FILE (filename
);
2818 encoded_linkname
= ENCODE_FILE (linkname
);
2820 if (NILP (ok_if_already_exists
)
2821 || INTEGERP (ok_if_already_exists
))
2822 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2823 INTEGERP (ok_if_already_exists
), 0, 0);
2824 if (0 > symlink (SDATA (encoded_filename
),
2825 SDATA (encoded_linkname
)))
2827 /* If we didn't complain already, silently delete existing file. */
2828 if (errno
== EEXIST
)
2830 unlink (SDATA (encoded_linkname
));
2831 if (0 <= symlink (SDATA (encoded_filename
),
2832 SDATA (encoded_linkname
)))
2842 report_file_error ("Making symbolic link", Flist (2, args
));
2844 report_file_error ("Making symbolic link", Flist (2, &filename
));
2850 #endif /* S_IFLNK */
2854 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2855 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2856 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2857 If STRING is nil or a null string, the logical name NAME is deleted. */)
2862 CHECK_STRING (name
);
2864 delete_logical_name (SDATA (name
));
2867 CHECK_STRING (string
);
2869 if (SCHARS (string
) == 0)
2870 delete_logical_name (SDATA (name
));
2872 define_logical_name (SDATA (name
), SDATA (string
));
2881 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2882 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2884 Lisp_Object path
, login
;
2888 CHECK_STRING (path
);
2889 CHECK_STRING (login
);
2891 netresult
= netunam (SDATA (path
), SDATA (login
));
2893 if (netresult
== -1)
2898 #endif /* HPUX_NET */
2900 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2902 doc
: /* Return t if file FILENAME specifies an absolute file name.
2903 On Unix, this is a name starting with a `/' or a `~'. */)
2905 Lisp_Object filename
;
2907 const unsigned char *ptr
;
2909 CHECK_STRING (filename
);
2910 ptr
= SDATA (filename
);
2911 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2913 /* ??? This criterion is probably wrong for '<'. */
2914 || index (ptr
, ':') || index (ptr
, '<')
2915 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2919 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2927 /* Return nonzero if file FILENAME exists and can be executed. */
2930 check_executable (filename
)
2934 int len
= strlen (filename
);
2937 if (stat (filename
, &st
) < 0)
2939 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2940 return ((st
.st_mode
& S_IEXEC
) != 0);
2942 return (S_ISREG (st
.st_mode
)
2944 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2945 || stricmp (suffix
, ".exe") == 0
2946 || stricmp (suffix
, ".bat") == 0)
2947 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2948 #endif /* not WINDOWSNT */
2949 #else /* not DOS_NT */
2950 #ifdef HAVE_EUIDACCESS
2951 return (euidaccess (filename
, 1) >= 0);
2953 /* Access isn't quite right because it uses the real uid
2954 and we really want to test with the effective uid.
2955 But Unix doesn't give us a right way to do it. */
2956 return (access (filename
, 1) >= 0);
2958 #endif /* not DOS_NT */
2961 /* Return nonzero if file FILENAME exists and can be written. */
2964 check_writable (filename
)
2969 if (stat (filename
, &st
) < 0)
2971 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2972 #else /* not MSDOS */
2973 #ifdef HAVE_EUIDACCESS
2974 return (euidaccess (filename
, 2) >= 0);
2976 /* Access isn't quite right because it uses the real uid
2977 and we really want to test with the effective uid.
2978 But Unix doesn't give us a right way to do it.
2979 Opening with O_WRONLY could work for an ordinary file,
2980 but would lose for directories. */
2981 return (access (filename
, 2) >= 0);
2983 #endif /* not MSDOS */
2986 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2987 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
2988 See also `file-readable-p' and `file-attributes'. */)
2990 Lisp_Object filename
;
2992 Lisp_Object absname
;
2993 Lisp_Object handler
;
2994 struct stat statbuf
;
2996 CHECK_STRING (filename
);
2997 absname
= Fexpand_file_name (filename
, Qnil
);
2999 /* If the file name has special constructs in it,
3000 call the corresponding file handler. */
3001 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3002 if (!NILP (handler
))
3003 return call2 (handler
, Qfile_exists_p
, absname
);
3005 absname
= ENCODE_FILE (absname
);
3007 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3010 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3011 doc
: /* Return t if FILENAME can be executed by you.
3012 For a directory, this means you can access files in that directory. */)
3014 Lisp_Object filename
;
3016 Lisp_Object absname
;
3017 Lisp_Object handler
;
3019 CHECK_STRING (filename
);
3020 absname
= Fexpand_file_name (filename
, Qnil
);
3022 /* If the file name has special constructs in it,
3023 call the corresponding file handler. */
3024 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3025 if (!NILP (handler
))
3026 return call2 (handler
, Qfile_executable_p
, absname
);
3028 absname
= ENCODE_FILE (absname
);
3030 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3033 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3034 doc
: /* Return t if file FILENAME exists and you can read it.
3035 See also `file-exists-p' and `file-attributes'. */)
3037 Lisp_Object filename
;
3039 Lisp_Object absname
;
3040 Lisp_Object handler
;
3043 struct stat statbuf
;
3045 CHECK_STRING (filename
);
3046 absname
= Fexpand_file_name (filename
, Qnil
);
3048 /* If the file name has special constructs in it,
3049 call the corresponding file handler. */
3050 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3051 if (!NILP (handler
))
3052 return call2 (handler
, Qfile_readable_p
, absname
);
3054 absname
= ENCODE_FILE (absname
);
3056 #if defined(DOS_NT) || defined(macintosh)
3057 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3059 if (access (SDATA (absname
), 0) == 0)
3062 #else /* not DOS_NT and not macintosh */
3064 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3065 /* Opening a fifo without O_NONBLOCK can wait.
3066 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3067 except in the case of a fifo, on a system which handles it. */
3068 desc
= stat (SDATA (absname
), &statbuf
);
3071 if (S_ISFIFO (statbuf
.st_mode
))
3072 flags
|= O_NONBLOCK
;
3074 desc
= emacs_open (SDATA (absname
), flags
, 0);
3079 #endif /* not DOS_NT and not macintosh */
3082 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3084 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3085 doc
: /* Return t if file FILENAME can be written or created by you. */)
3087 Lisp_Object filename
;
3089 Lisp_Object absname
, dir
, encoded
;
3090 Lisp_Object handler
;
3091 struct stat statbuf
;
3093 CHECK_STRING (filename
);
3094 absname
= Fexpand_file_name (filename
, Qnil
);
3096 /* If the file name has special constructs in it,
3097 call the corresponding file handler. */
3098 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3099 if (!NILP (handler
))
3100 return call2 (handler
, Qfile_writable_p
, absname
);
3102 encoded
= ENCODE_FILE (absname
);
3103 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3104 return (check_writable (SDATA (encoded
))
3107 dir
= Ffile_name_directory (absname
);
3110 dir
= Fdirectory_file_name (dir
);
3114 dir
= Fdirectory_file_name (dir
);
3117 dir
= ENCODE_FILE (dir
);
3119 /* The read-only attribute of the parent directory doesn't affect
3120 whether a file or directory can be created within it. Some day we
3121 should check ACLs though, which do affect this. */
3122 if (stat (SDATA (dir
), &statbuf
) < 0)
3124 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3126 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3131 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3132 doc
: /* Access file FILENAME, and get an error if that does not work.
3133 The second argument STRING is used in the error message.
3134 If there is no error, we return nil. */)
3136 Lisp_Object filename
, string
;
3138 Lisp_Object handler
, encoded_filename
, absname
;
3141 CHECK_STRING (filename
);
3142 absname
= Fexpand_file_name (filename
, Qnil
);
3144 CHECK_STRING (string
);
3146 /* If the file name has special constructs in it,
3147 call the corresponding file handler. */
3148 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3149 if (!NILP (handler
))
3150 return call3 (handler
, Qaccess_file
, absname
, string
);
3152 encoded_filename
= ENCODE_FILE (absname
);
3154 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3156 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3162 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3163 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3164 The value is the name of the file to which it is linked.
3165 Otherwise returns nil. */)
3167 Lisp_Object filename
;
3174 Lisp_Object handler
;
3176 CHECK_STRING (filename
);
3177 filename
= Fexpand_file_name (filename
, Qnil
);
3179 /* If the file name has special constructs in it,
3180 call the corresponding file handler. */
3181 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3182 if (!NILP (handler
))
3183 return call2 (handler
, Qfile_symlink_p
, filename
);
3185 filename
= ENCODE_FILE (filename
);
3192 buf
= (char *) xrealloc (buf
, bufsize
);
3193 bzero (buf
, bufsize
);
3196 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3200 /* HP-UX reports ERANGE if buffer is too small. */
3201 if (errno
== ERANGE
)
3211 while (valsize
>= bufsize
);
3213 val
= make_string (buf
, valsize
);
3214 if (buf
[0] == '/' && index (buf
, ':'))
3215 val
= concat2 (build_string ("/:"), val
);
3217 val
= DECODE_FILE (val
);
3219 #else /* not S_IFLNK */
3221 #endif /* not S_IFLNK */
3224 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3225 doc
: /* Return t if FILENAME names an existing directory.
3226 Symbolic links to directories count as directories.
3227 See `file-symlink-p' to distinguish symlinks. */)
3229 Lisp_Object filename
;
3231 register Lisp_Object absname
;
3233 Lisp_Object handler
;
3235 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3237 /* If the file name has special constructs in it,
3238 call the corresponding file handler. */
3239 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3240 if (!NILP (handler
))
3241 return call2 (handler
, Qfile_directory_p
, absname
);
3243 absname
= ENCODE_FILE (absname
);
3245 if (stat (SDATA (absname
), &st
) < 0)
3247 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3250 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3251 doc
: /* Return t if file FILENAME names a directory you can open.
3252 For the value to be t, FILENAME must specify the name of a directory as a file,
3253 and the directory must allow you to open files in it. In order to use a
3254 directory as a buffer's current directory, this predicate must return true.
3255 A directory name spec may be given instead; then the value is t
3256 if the directory so specified exists and really is a readable and
3257 searchable directory. */)
3259 Lisp_Object filename
;
3261 Lisp_Object handler
;
3263 struct gcpro gcpro1
;
3265 /* If the file name has special constructs in it,
3266 call the corresponding file handler. */
3267 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3268 if (!NILP (handler
))
3269 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3271 /* It's an unlikely combination, but yes we really do need to gcpro:
3272 Suppose that file-accessible-directory-p has no handler, but
3273 file-directory-p does have a handler; this handler causes a GC which
3274 relocates the string in `filename'; and finally file-directory-p
3275 returns non-nil. Then we would end up passing a garbaged string
3276 to file-executable-p. */
3278 tem
= (NILP (Ffile_directory_p (filename
))
3279 || NILP (Ffile_executable_p (filename
)));
3281 return tem
? Qnil
: Qt
;
3284 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3285 doc
: /* Return t if file FILENAME is the name of a regular file.
3286 This is the sort of file that holds an ordinary stream of data bytes. */)
3288 Lisp_Object filename
;
3290 register Lisp_Object absname
;
3292 Lisp_Object handler
;
3294 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3296 /* If the file name has special constructs in it,
3297 call the corresponding file handler. */
3298 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3299 if (!NILP (handler
))
3300 return call2 (handler
, Qfile_regular_p
, absname
);
3302 absname
= ENCODE_FILE (absname
);
3307 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3309 /* Tell stat to use expensive method to get accurate info. */
3310 Vw32_get_true_file_attributes
= Qt
;
3311 result
= stat (SDATA (absname
), &st
);
3312 Vw32_get_true_file_attributes
= tem
;
3316 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3319 if (stat (SDATA (absname
), &st
) < 0)
3321 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3325 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3326 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
3328 Lisp_Object filename
;
3330 Lisp_Object absname
;
3332 Lisp_Object handler
;
3334 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3336 /* If the file name has special constructs in it,
3337 call the corresponding file handler. */
3338 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3339 if (!NILP (handler
))
3340 return call2 (handler
, Qfile_modes
, absname
);
3342 absname
= ENCODE_FILE (absname
);
3344 if (stat (SDATA (absname
), &st
) < 0)
3346 #if defined (MSDOS) && __DJGPP__ < 2
3347 if (check_executable (SDATA (absname
)))
3348 st
.st_mode
|= S_IEXEC
;
3349 #endif /* MSDOS && __DJGPP__ < 2 */
3351 return make_number (st
.st_mode
& 07777);
3354 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3355 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3356 Only the 12 low bits of MODE are used. */)
3358 Lisp_Object filename
, mode
;
3360 Lisp_Object absname
, encoded_absname
;
3361 Lisp_Object handler
;
3363 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3364 CHECK_NUMBER (mode
);
3366 /* If the file name has special constructs in it,
3367 call the corresponding file handler. */
3368 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3369 if (!NILP (handler
))
3370 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3372 encoded_absname
= ENCODE_FILE (absname
);
3374 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3375 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3380 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3381 doc
: /* Set the file permission bits for newly created files.
3382 The argument MODE should be an integer; only the low 9 bits are used.
3383 This setting is inherited by subprocesses. */)
3387 CHECK_NUMBER (mode
);
3389 umask ((~ XINT (mode
)) & 0777);
3394 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3395 doc
: /* Return the default file protection for created files.
3396 The value is an integer. */)
3402 realmask
= umask (0);
3405 XSETINT (value
, (~ realmask
) & 0777);
3415 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3416 doc
: /* Tell Unix to finish all pending disk updates. */)
3425 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3426 doc
: /* Return t if file FILE1 is newer than file FILE2.
3427 If FILE1 does not exist, the answer is nil;
3428 otherwise, if FILE2 does not exist, the answer is t. */)
3430 Lisp_Object file1
, file2
;
3432 Lisp_Object absname1
, absname2
;
3435 Lisp_Object handler
;
3436 struct gcpro gcpro1
, gcpro2
;
3438 CHECK_STRING (file1
);
3439 CHECK_STRING (file2
);
3442 GCPRO2 (absname1
, file2
);
3443 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3444 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3447 /* If the file name has special constructs in it,
3448 call the corresponding file handler. */
3449 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3451 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3452 if (!NILP (handler
))
3453 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3455 GCPRO2 (absname1
, absname2
);
3456 absname1
= ENCODE_FILE (absname1
);
3457 absname2
= ENCODE_FILE (absname2
);
3460 if (stat (SDATA (absname1
), &st
) < 0)
3463 mtime1
= st
.st_mtime
;
3465 if (stat (SDATA (absname2
), &st
) < 0)
3468 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3472 Lisp_Object Qfind_buffer_file_type
;
3475 #ifndef READ_BUF_SIZE
3476 #define READ_BUF_SIZE (64 << 10)
3479 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3481 /* This function is called after Lisp functions to decide a coding
3482 system are called, or when they cause an error. Before they are
3483 called, the current buffer is set unibyte and it contains only a
3484 newly inserted text (thus the buffer was empty before the
3487 The functions may set markers, overlays, text properties, or even
3488 alter the buffer contents, change the current buffer.
3490 Here, we reset all those changes by:
3491 o set back the current buffer.
3492 o move all markers and overlays to BEG.
3493 o remove all text properties.
3494 o set back the buffer multibyteness. */
3497 decide_coding_unwind (unwind_data
)
3498 Lisp_Object unwind_data
;
3500 Lisp_Object multibyte
, undo_list
, buffer
;
3502 multibyte
= XCAR (unwind_data
);
3503 unwind_data
= XCDR (unwind_data
);
3504 undo_list
= XCAR (unwind_data
);
3505 buffer
= XCDR (unwind_data
);
3507 if (current_buffer
!= XBUFFER (buffer
))
3508 set_buffer_internal (XBUFFER (buffer
));
3509 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3510 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3511 BUF_INTERVALS (current_buffer
) = 0;
3512 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3514 /* Now we are safe to change the buffer's multibyteness directly. */
3515 current_buffer
->enable_multibyte_characters
= multibyte
;
3516 current_buffer
->undo_list
= undo_list
;
3522 /* Used to pass values from insert-file-contents to read_non_regular. */
3524 static int non_regular_fd
;
3525 static int non_regular_inserted
;
3526 static int non_regular_nbytes
;
3529 /* Read from a non-regular file.
3530 Read non_regular_trytry bytes max from non_regular_fd.
3531 Non_regular_inserted specifies where to put the read bytes.
3532 Value is the number of bytes read. */
3541 nbytes
= emacs_read (non_regular_fd
,
3542 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3543 non_regular_nbytes
);
3545 return make_number (nbytes
);
3549 /* Condition-case handler used when reading from non-regular files
3550 in insert-file-contents. */
3553 read_non_regular_quit ()
3559 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3561 doc
: /* Insert contents of file FILENAME after point.
3562 Returns list of absolute file name and number of bytes inserted.
3563 If second argument VISIT is non-nil, the buffer's visited filename
3564 and last save file modtime are set, and it is marked unmodified.
3565 If visiting and the file does not exist, visiting is completed
3566 before the error is signaled.
3567 The optional third and fourth arguments BEG and END
3568 specify what portion of the file to insert.
3569 These arguments count bytes in the file, not characters in the buffer.
3570 If VISIT is non-nil, BEG and END must be nil.
3572 If optional fifth argument REPLACE is non-nil,
3573 it means replace the current buffer contents (in the accessible portion)
3574 with the file contents. This is better than simply deleting and inserting
3575 the whole thing because (1) it preserves some marker positions
3576 and (2) it puts less data in the undo list.
3577 When REPLACE is non-nil, the value is the number of characters actually read,
3578 which is often less than the number of characters to be read.
3580 This does code conversion according to the value of
3581 `coding-system-for-read' or `file-coding-system-alist',
3582 and sets the variable `last-coding-system-used' to the coding system
3584 (filename
, visit
, beg
, end
, replace
)
3585 Lisp_Object filename
, visit
, beg
, end
, replace
;
3590 register int how_much
;
3591 register int unprocessed
;
3592 int count
= SPECPDL_INDEX ();
3593 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3594 Lisp_Object handler
, val
, insval
, orig_filename
;
3597 int not_regular
= 0;
3598 unsigned char read_buf
[READ_BUF_SIZE
];
3599 struct coding_system coding
;
3600 unsigned char buffer
[1 << 14];
3601 int replace_handled
= 0;
3602 int set_coding_system
= 0;
3603 int coding_system_decided
= 0;
3606 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3607 error ("Cannot do file visiting in an indirect buffer");
3609 if (!NILP (current_buffer
->read_only
))
3610 Fbarf_if_buffer_read_only ();
3614 orig_filename
= Qnil
;
3616 GCPRO4 (filename
, val
, p
, orig_filename
);
3618 CHECK_STRING (filename
);
3619 filename
= Fexpand_file_name (filename
, Qnil
);
3621 /* If the file name has special constructs in it,
3622 call the corresponding file handler. */
3623 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3624 if (!NILP (handler
))
3626 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3627 visit
, beg
, end
, replace
);
3628 if (CONSP (val
) && CONSP (XCDR (val
)))
3629 inserted
= XINT (XCAR (XCDR (val
)));
3633 orig_filename
= filename
;
3634 filename
= ENCODE_FILE (filename
);
3640 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3642 /* Tell stat to use expensive method to get accurate info. */
3643 Vw32_get_true_file_attributes
= Qt
;
3644 total
= stat (SDATA (filename
), &st
);
3645 Vw32_get_true_file_attributes
= tem
;
3650 if (stat (SDATA (filename
), &st
) < 0)
3652 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3653 || fstat (fd
, &st
) < 0)
3654 #endif /* not APOLLO */
3655 #endif /* WINDOWSNT */
3657 if (fd
>= 0) emacs_close (fd
);
3660 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3663 if (!NILP (Vcoding_system_for_read
))
3664 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3669 /* This code will need to be changed in order to work on named
3670 pipes, and it's probably just not worth it. So we should at
3671 least signal an error. */
3672 if (!S_ISREG (st
.st_mode
))
3679 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3680 Fsignal (Qfile_error
,
3681 Fcons (build_string ("not a regular file"),
3682 Fcons (orig_filename
, Qnil
)));
3687 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3690 /* Replacement should preserve point as it preserves markers. */
3691 if (!NILP (replace
))
3692 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3694 record_unwind_protect (close_file_unwind
, make_number (fd
));
3696 /* Supposedly happens on VMS. */
3697 if (! not_regular
&& st
.st_size
< 0)
3698 error ("File size is negative");
3700 /* Prevent redisplay optimizations. */
3701 current_buffer
->clip_changed
= 1;
3705 if (!NILP (beg
) || !NILP (end
))
3706 error ("Attempt to visit less than an entire file");
3707 if (BEG
< Z
&& NILP (replace
))
3708 error ("Cannot do file visiting in a non-empty buffer");
3714 XSETFASTINT (beg
, 0);
3722 XSETINT (end
, st
.st_size
);
3724 /* Arithmetic overflow can occur if an Emacs integer cannot
3725 represent the file size, or if the calculations below
3726 overflow. The calculations below double the file size
3727 twice, so check that it can be multiplied by 4 safely. */
3728 if (XINT (end
) != st
.st_size
3729 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3730 error ("Maximum buffer size exceeded");
3732 /* The file size returned from stat may be zero, but data
3733 may be readable nonetheless, for example when this is a
3734 file in the /proc filesystem. */
3735 if (st
.st_size
== 0)
3736 XSETINT (end
, READ_BUF_SIZE
);
3742 /* Decide the coding system to use for reading the file now
3743 because we can't use an optimized method for handling
3744 `coding:' tag if the current buffer is not empty. */
3748 if (!NILP (Vcoding_system_for_read
))
3749 val
= Vcoding_system_for_read
;
3750 else if (! NILP (replace
))
3751 /* In REPLACE mode, we can use the same coding system
3752 that was used to visit the file. */
3753 val
= current_buffer
->buffer_file_coding_system
;
3756 /* Don't try looking inside a file for a coding system
3757 specification if it is not seekable. */
3758 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3760 /* Find a coding system specified in the heading two
3761 lines or in the tailing several lines of the file.
3762 We assume that the 1K-byte and 3K-byte for heading
3763 and tailing respectively are sufficient for this
3767 if (st
.st_size
<= (1024 * 4))
3768 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3771 nread
= emacs_read (fd
, read_buf
, 1024);
3774 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3775 report_file_error ("Setting file position",
3776 Fcons (orig_filename
, Qnil
));
3777 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3782 error ("IO error reading %s: %s",
3783 SDATA (orig_filename
), emacs_strerror (errno
));
3786 struct buffer
*prev
= current_buffer
;
3790 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3792 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3793 buf
= XBUFFER (buffer
);
3795 buf
->directory
= current_buffer
->directory
;
3796 buf
->read_only
= Qnil
;
3797 buf
->filename
= Qnil
;
3798 buf
->undo_list
= Qt
;
3799 buf
->overlays_before
= Qnil
;
3800 buf
->overlays_after
= Qnil
;
3802 set_buffer_internal (buf
);
3804 buf
->enable_multibyte_characters
= Qnil
;
3806 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3807 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3808 val
= call2 (Vset_auto_coding_function
,
3809 filename
, make_number (nread
));
3810 set_buffer_internal (prev
);
3812 /* Discard the unwind protect for recovering the
3816 /* Rewind the file for the actual read done later. */
3817 if (lseek (fd
, 0, 0) < 0)
3818 report_file_error ("Setting file position",
3819 Fcons (orig_filename
, Qnil
));
3825 /* If we have not yet decided a coding system, check
3826 file-coding-system-alist. */
3827 Lisp_Object args
[6], coding_systems
;
3829 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3830 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3831 coding_systems
= Ffind_operation_coding_system (6, args
);
3832 if (CONSP (coding_systems
))
3833 val
= XCAR (coding_systems
);
3837 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3838 /* Ensure we set Vlast_coding_system_used. */
3839 set_coding_system
= 1;
3841 if (NILP (current_buffer
->enable_multibyte_characters
)
3843 /* We must suppress all character code conversion except for
3844 end-of-line conversion. */
3845 setup_raw_text_coding_system (&coding
);
3847 coding
.src_multibyte
= 0;
3848 coding
.dst_multibyte
3849 = !NILP (current_buffer
->enable_multibyte_characters
);
3850 coding_system_decided
= 1;
3853 /* If requested, replace the accessible part of the buffer
3854 with the file contents. Avoid replacing text at the
3855 beginning or end of the buffer that matches the file contents;
3856 that preserves markers pointing to the unchanged parts.
3858 Here we implement this feature in an optimized way
3859 for the case where code conversion is NOT needed.
3860 The following if-statement handles the case of conversion
3861 in a less optimal way.
3863 If the code conversion is "automatic" then we try using this
3864 method and hope for the best.
3865 But if we discover the need for conversion, we give up on this method
3866 and let the following if-statement handle the replace job. */
3869 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3871 /* same_at_start and same_at_end count bytes,
3872 because file access counts bytes
3873 and BEG and END count bytes. */
3874 int same_at_start
= BEGV_BYTE
;
3875 int same_at_end
= ZV_BYTE
;
3877 /* There is still a possibility we will find the need to do code
3878 conversion. If that happens, we set this variable to 1 to
3879 give up on handling REPLACE in the optimized way. */
3880 int giveup_match_end
= 0;
3882 if (XINT (beg
) != 0)
3884 if (lseek (fd
, XINT (beg
), 0) < 0)
3885 report_file_error ("Setting file position",
3886 Fcons (orig_filename
, Qnil
));
3891 /* Count how many chars at the start of the file
3892 match the text at the beginning of the buffer. */
3897 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3899 error ("IO error reading %s: %s",
3900 SDATA (orig_filename
), emacs_strerror (errno
));
3901 else if (nread
== 0)
3904 if (coding
.type
== coding_type_undecided
)
3905 detect_coding (&coding
, buffer
, nread
);
3906 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
3907 /* We found that the file should be decoded somehow.
3908 Let's give up here. */
3910 giveup_match_end
= 1;
3914 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3915 detect_eol (&coding
, buffer
, nread
);
3916 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3917 && coding
.eol_type
!= CODING_EOL_LF
)
3918 /* We found that the format of eol should be decoded.
3919 Let's give up here. */
3921 giveup_match_end
= 1;
3926 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3927 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3928 same_at_start
++, bufpos
++;
3929 /* If we found a discrepancy, stop the scan.
3930 Otherwise loop around and scan the next bufferful. */
3931 if (bufpos
!= nread
)
3935 /* If the file matches the buffer completely,
3936 there's no need to replace anything. */
3937 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3941 /* Truncate the buffer to the size of the file. */
3942 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3947 /* Count how many chars at the end of the file
3948 match the text at the end of the buffer. But, if we have
3949 already found that decoding is necessary, don't waste time. */
3950 while (!giveup_match_end
)
3952 int total_read
, nread
, bufpos
, curpos
, trial
;
3954 /* At what file position are we now scanning? */
3955 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3956 /* If the entire file matches the buffer tail, stop the scan. */
3959 /* How much can we scan in the next step? */
3960 trial
= min (curpos
, sizeof buffer
);
3961 if (lseek (fd
, curpos
- trial
, 0) < 0)
3962 report_file_error ("Setting file position",
3963 Fcons (orig_filename
, Qnil
));
3965 total_read
= nread
= 0;
3966 while (total_read
< trial
)
3968 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3970 error ("IO error reading %s: %s",
3971 SDATA (orig_filename
), emacs_strerror (errno
));
3972 else if (nread
== 0)
3974 total_read
+= nread
;
3977 /* Scan this bufferful from the end, comparing with
3978 the Emacs buffer. */
3979 bufpos
= total_read
;
3981 /* Compare with same_at_start to avoid counting some buffer text
3982 as matching both at the file's beginning and at the end. */
3983 while (bufpos
> 0 && same_at_end
> same_at_start
3984 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3985 same_at_end
--, bufpos
--;
3987 /* If we found a discrepancy, stop the scan.
3988 Otherwise loop around and scan the preceding bufferful. */
3991 /* If this discrepancy is because of code conversion,
3992 we cannot use this method; giveup and try the other. */
3993 if (same_at_end
> same_at_start
3994 && FETCH_BYTE (same_at_end
- 1) >= 0200
3995 && ! NILP (current_buffer
->enable_multibyte_characters
)
3996 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3997 giveup_match_end
= 1;
4006 if (! giveup_match_end
)
4010 /* We win! We can handle REPLACE the optimized way. */
4012 /* Extend the start of non-matching text area to multibyte
4013 character boundary. */
4014 if (! NILP (current_buffer
->enable_multibyte_characters
))
4015 while (same_at_start
> BEGV_BYTE
4016 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4019 /* Extend the end of non-matching text area to multibyte
4020 character boundary. */
4021 if (! NILP (current_buffer
->enable_multibyte_characters
))
4022 while (same_at_end
< ZV_BYTE
4023 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4026 /* Don't try to reuse the same piece of text twice. */
4027 overlap
= (same_at_start
- BEGV_BYTE
4028 - (same_at_end
+ st
.st_size
- ZV
));
4030 same_at_end
+= overlap
;
4032 /* Arrange to read only the nonmatching middle part of the file. */
4033 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4034 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4036 del_range_byte (same_at_start
, same_at_end
, 0);
4037 /* Insert from the file at the proper position. */
4038 temp
= BYTE_TO_CHAR (same_at_start
);
4039 SET_PT_BOTH (temp
, same_at_start
);
4041 /* If display currently starts at beginning of line,
4042 keep it that way. */
4043 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4044 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4046 replace_handled
= 1;
4050 /* If requested, replace the accessible part of the buffer
4051 with the file contents. Avoid replacing text at the
4052 beginning or end of the buffer that matches the file contents;
4053 that preserves markers pointing to the unchanged parts.
4055 Here we implement this feature for the case where code conversion
4056 is needed, in a simple way that needs a lot of memory.
4057 The preceding if-statement handles the case of no conversion
4058 in a more optimized way. */
4059 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4061 int same_at_start
= BEGV_BYTE
;
4062 int same_at_end
= ZV_BYTE
;
4065 /* Make sure that the gap is large enough. */
4066 int bufsize
= 2 * st
.st_size
;
4067 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4070 /* First read the whole file, performing code conversion into
4071 CONVERSION_BUFFER. */
4073 if (lseek (fd
, XINT (beg
), 0) < 0)
4075 xfree (conversion_buffer
);
4076 report_file_error ("Setting file position",
4077 Fcons (orig_filename
, Qnil
));
4080 total
= st
.st_size
; /* Total bytes in the file. */
4081 how_much
= 0; /* Bytes read from file so far. */
4082 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4083 unprocessed
= 0; /* Bytes not processed in previous loop. */
4085 while (how_much
< total
)
4087 /* try is reserved in some compilers (Microsoft C) */
4088 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4089 unsigned char *destination
= read_buf
+ unprocessed
;
4092 /* Allow quitting out of the actual I/O. */
4095 this = emacs_read (fd
, destination
, trytry
);
4098 if (this < 0 || this + unprocessed
== 0)
4106 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4108 int require
, result
;
4110 this += unprocessed
;
4112 /* If we are using more space than estimated,
4113 make CONVERSION_BUFFER bigger. */
4114 require
= decoding_buffer_size (&coding
, this);
4115 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4117 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4118 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4121 /* Convert this batch with results in CONVERSION_BUFFER. */
4122 if (how_much
>= total
) /* This is the last block. */
4123 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4124 if (coding
.composing
!= COMPOSITION_DISABLED
)
4125 coding_allocate_composition_data (&coding
, BEGV
);
4126 result
= decode_coding (&coding
, read_buf
,
4127 conversion_buffer
+ inserted
,
4128 this, bufsize
- inserted
);
4130 /* Save for next iteration whatever we didn't convert. */
4131 unprocessed
= this - coding
.consumed
;
4132 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4133 if (!NILP (current_buffer
->enable_multibyte_characters
))
4134 this = coding
.produced
;
4136 this = str_as_unibyte (conversion_buffer
+ inserted
,
4143 /* At this point, INSERTED is how many characters (i.e. bytes)
4144 are present in CONVERSION_BUFFER.
4145 HOW_MUCH should equal TOTAL,
4146 or should be <= 0 if we couldn't read the file. */
4150 xfree (conversion_buffer
);
4153 error ("IO error reading %s: %s",
4154 SDATA (orig_filename
), emacs_strerror (errno
));
4155 else if (how_much
== -2)
4156 error ("maximum buffer size exceeded");
4159 /* Compare the beginning of the converted file
4160 with the buffer text. */
4163 while (bufpos
< inserted
&& same_at_start
< same_at_end
4164 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4165 same_at_start
++, bufpos
++;
4167 /* If the file matches the buffer completely,
4168 there's no need to replace anything. */
4170 if (bufpos
== inserted
)
4172 xfree (conversion_buffer
);
4175 /* Truncate the buffer to the size of the file. */
4176 del_range_byte (same_at_start
, same_at_end
, 0);
4181 /* Extend the start of non-matching text area to multibyte
4182 character boundary. */
4183 if (! NILP (current_buffer
->enable_multibyte_characters
))
4184 while (same_at_start
> BEGV_BYTE
4185 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4188 /* Scan this bufferful from the end, comparing with
4189 the Emacs buffer. */
4192 /* Compare with same_at_start to avoid counting some buffer text
4193 as matching both at the file's beginning and at the end. */
4194 while (bufpos
> 0 && same_at_end
> same_at_start
4195 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4196 same_at_end
--, bufpos
--;
4198 /* Extend the end of non-matching text area to multibyte
4199 character boundary. */
4200 if (! NILP (current_buffer
->enable_multibyte_characters
))
4201 while (same_at_end
< ZV_BYTE
4202 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4205 /* Don't try to reuse the same piece of text twice. */
4206 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4208 same_at_end
+= overlap
;
4210 /* If display currently starts at beginning of line,
4211 keep it that way. */
4212 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4213 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4215 /* Replace the chars that we need to replace,
4216 and update INSERTED to equal the number of bytes
4217 we are taking from the file. */
4218 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4220 if (same_at_end
!= same_at_start
)
4222 del_range_byte (same_at_start
, same_at_end
, 0);
4224 same_at_start
= GPT_BYTE
;
4228 temp
= BYTE_TO_CHAR (same_at_start
);
4230 /* Insert from the file at the proper position. */
4231 SET_PT_BOTH (temp
, same_at_start
);
4232 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
4234 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4235 coding_restore_composition (&coding
, Fcurrent_buffer ());
4236 coding_free_composition_data (&coding
);
4238 /* Set `inserted' to the number of inserted characters. */
4239 inserted
= PT
- temp
;
4241 xfree (conversion_buffer
);
4250 register Lisp_Object temp
;
4252 total
= XINT (end
) - XINT (beg
);
4254 /* Make sure point-max won't overflow after this insertion. */
4255 XSETINT (temp
, total
);
4256 if (total
!= XINT (temp
))
4257 error ("Maximum buffer size exceeded");
4260 /* For a special file, all we can do is guess. */
4261 total
= READ_BUF_SIZE
;
4263 if (NILP (visit
) && total
> 0)
4264 prepare_to_modify_buffer (PT
, PT
, NULL
);
4267 if (GAP_SIZE
< total
)
4268 make_gap (total
- GAP_SIZE
);
4270 if (XINT (beg
) != 0 || !NILP (replace
))
4272 if (lseek (fd
, XINT (beg
), 0) < 0)
4273 report_file_error ("Setting file position",
4274 Fcons (orig_filename
, Qnil
));
4277 /* In the following loop, HOW_MUCH contains the total bytes read so
4278 far for a regular file, and not changed for a special file. But,
4279 before exiting the loop, it is set to a negative value if I/O
4283 /* Total bytes inserted. */
4286 /* Here, we don't do code conversion in the loop. It is done by
4287 code_convert_region after all data are read into the buffer. */
4289 int gap_size
= GAP_SIZE
;
4291 while (how_much
< total
)
4293 /* try is reserved in some compilers (Microsoft C) */
4294 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4301 /* Maybe make more room. */
4302 if (gap_size
< trytry
)
4304 make_gap (total
- gap_size
);
4305 gap_size
= GAP_SIZE
;
4308 /* Read from the file, capturing `quit'. When an
4309 error occurs, end the loop, and arrange for a quit
4310 to be signaled after decoding the text we read. */
4311 non_regular_fd
= fd
;
4312 non_regular_inserted
= inserted
;
4313 non_regular_nbytes
= trytry
;
4314 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4315 read_non_regular_quit
);
4326 /* Allow quitting out of the actual I/O. We don't make text
4327 part of the buffer until all the reading is done, so a C-g
4328 here doesn't do any harm. */
4331 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4343 /* For a regular file, where TOTAL is the real size,
4344 count HOW_MUCH to compare with it.
4345 For a special file, where TOTAL is just a buffer size,
4346 so don't bother counting in HOW_MUCH.
4347 (INSERTED is where we count the number of characters inserted.) */
4354 /* Make the text read part of the buffer. */
4355 GAP_SIZE
-= inserted
;
4357 GPT_BYTE
+= inserted
;
4359 ZV_BYTE
+= inserted
;
4364 /* Put an anchor to ensure multi-byte form ends at gap. */
4369 /* Discard the unwind protect for closing the file. */
4373 error ("IO error reading %s: %s",
4374 SDATA (orig_filename
), emacs_strerror (errno
));
4378 if (! coding_system_decided
)
4380 /* The coding system is not yet decided. Decide it by an
4381 optimized method for handling `coding:' tag.
4383 Note that we can get here only if the buffer was empty
4384 before the insertion. */
4388 if (!NILP (Vcoding_system_for_read
))
4389 val
= Vcoding_system_for_read
;
4392 /* Since we are sure that the current buffer was empty
4393 before the insertion, we can toggle
4394 enable-multibyte-characters directly here without taking
4395 care of marker adjustment and byte combining problem. By
4396 this way, we can run Lisp program safely before decoding
4397 the inserted text. */
4398 Lisp_Object unwind_data
;
4399 int count
= SPECPDL_INDEX ();
4401 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4402 Fcons (current_buffer
->undo_list
,
4403 Fcurrent_buffer ()));
4404 current_buffer
->enable_multibyte_characters
= Qnil
;
4405 current_buffer
->undo_list
= Qt
;
4406 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4408 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4410 val
= call2 (Vset_auto_coding_function
,
4411 filename
, make_number (inserted
));
4416 /* If the coding system is not yet decided, check
4417 file-coding-system-alist. */
4418 Lisp_Object args
[6], coding_systems
;
4420 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4421 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4422 coding_systems
= Ffind_operation_coding_system (6, args
);
4423 if (CONSP (coding_systems
))
4424 val
= XCAR (coding_systems
);
4427 unbind_to (count
, Qnil
);
4428 inserted
= Z_BYTE
- BEG_BYTE
;
4431 /* The following kludgy code is to avoid some compiler bug.
4433 setup_coding_system (val, &coding);
4436 struct coding_system temp_coding
;
4437 setup_coding_system (val
, &temp_coding
);
4438 bcopy (&temp_coding
, &coding
, sizeof coding
);
4440 /* Ensure we set Vlast_coding_system_used. */
4441 set_coding_system
= 1;
4443 if (NILP (current_buffer
->enable_multibyte_characters
)
4445 /* We must suppress all character code conversion except for
4446 end-of-line conversion. */
4447 setup_raw_text_coding_system (&coding
);
4448 coding
.src_multibyte
= 0;
4449 coding
.dst_multibyte
4450 = !NILP (current_buffer
->enable_multibyte_characters
);
4454 /* Can't do this if part of the buffer might be preserved. */
4456 && (coding
.type
== coding_type_no_conversion
4457 || coding
.type
== coding_type_raw_text
))
4459 /* Visiting a file with these coding system makes the buffer
4461 current_buffer
->enable_multibyte_characters
= Qnil
;
4462 coding
.dst_multibyte
= 0;
4465 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4467 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4469 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4471 inserted
= coding
.produced_char
;
4474 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4479 /* Use the conversion type to determine buffer-file-type
4480 (find-buffer-file-type is now used to help determine the
4482 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4483 || coding
.eol_type
== CODING_EOL_LF
)
4484 && ! CODING_REQUIRE_DECODING (&coding
))
4485 current_buffer
->buffer_file_type
= Qt
;
4487 current_buffer
->buffer_file_type
= Qnil
;
4494 if (!EQ (current_buffer
->undo_list
, Qt
))
4495 current_buffer
->undo_list
= Qnil
;
4497 stat (SDATA (filename
), &st
);
4502 current_buffer
->modtime
= st
.st_mtime
;
4503 current_buffer
->filename
= orig_filename
;
4506 SAVE_MODIFF
= MODIFF
;
4507 current_buffer
->auto_save_modified
= MODIFF
;
4508 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4509 #ifdef CLASH_DETECTION
4512 if (!NILP (current_buffer
->file_truename
))
4513 unlock_file (current_buffer
->file_truename
);
4514 unlock_file (filename
);
4516 #endif /* CLASH_DETECTION */
4518 Fsignal (Qfile_error
,
4519 Fcons (build_string ("not a regular file"),
4520 Fcons (orig_filename
, Qnil
)));
4523 /* Decode file format */
4526 int empty_undo_list_p
= 0;
4528 /* If we're anyway going to discard undo information, don't
4529 record it in the first place. The buffer's undo list at this
4530 point is either nil or t when visiting a file. */
4533 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4534 current_buffer
->undo_list
= Qt
;
4537 insval
= call3 (Qformat_decode
,
4538 Qnil
, make_number (inserted
), visit
);
4539 CHECK_NUMBER (insval
);
4540 inserted
= XFASTINT (insval
);
4543 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4546 if (set_coding_system
)
4547 Vlast_coding_system_used
= coding
.symbol
;
4549 /* Call after-change hooks for the inserted text, aside from the case
4550 of normal visiting (not with REPLACE), which is done in a new buffer
4551 "before" the buffer is changed. */
4552 if (inserted
> 0 && total
> 0
4553 && (NILP (visit
) || !NILP (replace
)))
4555 signal_after_change (PT
, 0, inserted
);
4556 update_compositions (PT
, PT
, CHECK_BORDER
);
4559 p
= Vafter_insert_file_functions
;
4562 insval
= call1 (XCAR (p
), make_number (inserted
));
4565 CHECK_NUMBER (insval
);
4566 inserted
= XFASTINT (insval
);
4573 && current_buffer
->modtime
== -1)
4575 /* If visiting nonexistent file, return nil. */
4576 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4580 Fsignal (Qquit
, Qnil
);
4582 /* ??? Retval needs to be dealt with in all cases consistently. */
4584 val
= Fcons (orig_filename
,
4585 Fcons (make_number (inserted
),
4588 RETURN_UNGCPRO (unbind_to (count
, val
));
4591 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4592 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4593 Lisp_Object
, Lisp_Object
));
4595 /* If build_annotations switched buffers, switch back to BUF.
4596 Kill the temporary buffer that was selected in the meantime.
4598 Since this kill only the last temporary buffer, some buffers remain
4599 not killed if build_annotations switched buffers more than once.
4603 build_annotations_unwind (buf
)
4608 if (XBUFFER (buf
) == current_buffer
)
4610 tembuf
= Fcurrent_buffer ();
4612 Fkill_buffer (tembuf
);
4616 /* Decide the coding-system to encode the data with. */
4619 choose_write_coding_system (start
, end
, filename
,
4620 append
, visit
, lockname
, coding
)
4621 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4622 struct coding_system
*coding
;
4628 else if (!NILP (Vcoding_system_for_write
))
4629 val
= Vcoding_system_for_write
;
4632 /* If the variable `buffer-file-coding-system' is set locally,
4633 it means that the file was read with some kind of code
4634 conversion or the variable is explicitly set by users. We
4635 had better write it out with the same coding system even if
4636 `enable-multibyte-characters' is nil.
4638 If it is not set locally, we anyway have to convert EOL
4639 format if the default value of `buffer-file-coding-system'
4640 tells that it is not Unix-like (LF only) format. */
4641 int using_default_coding
= 0;
4642 int force_raw_text
= 0;
4644 val
= current_buffer
->buffer_file_coding_system
;
4646 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4649 if (NILP (current_buffer
->enable_multibyte_characters
))
4655 /* Check file-coding-system-alist. */
4656 Lisp_Object args
[7], coding_systems
;
4658 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4659 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4661 coding_systems
= Ffind_operation_coding_system (7, args
);
4662 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4663 val
= XCDR (coding_systems
);
4667 && !NILP (current_buffer
->buffer_file_coding_system
))
4669 /* If we still have not decided a coding system, use the
4670 default value of buffer-file-coding-system. */
4671 val
= current_buffer
->buffer_file_coding_system
;
4672 using_default_coding
= 1;
4676 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4677 /* Confirm that VAL can surely encode the current region. */
4678 val
= call5 (Vselect_safe_coding_system_function
,
4679 start
, end
, val
, Qnil
, filename
);
4681 setup_coding_system (Fcheck_coding_system (val
), coding
);
4682 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4683 && !using_default_coding
)
4685 if (! EQ (default_buffer_file_coding
.symbol
,
4686 buffer_defaults
.buffer_file_coding_system
))
4687 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4688 &default_buffer_file_coding
);
4689 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4691 Lisp_Object subsidiaries
;
4693 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4694 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4695 if (VECTORP (subsidiaries
)
4696 && XVECTOR (subsidiaries
)->size
== 3)
4698 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4703 setup_raw_text_coding_system (coding
);
4704 goto done_setup_coding
;
4707 setup_coding_system (Fcheck_coding_system (val
), coding
);
4710 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4711 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4714 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4715 "r\nFWrite region to file: \ni\ni\ni\np",
4716 doc
: /* Write current region into specified file.
4717 When called from a program, requires three arguments:
4718 START, END and FILENAME. START and END are normally buffer positions
4719 specifying the part of the buffer to write.
4720 If START is nil, that means to use the entire buffer contents.
4721 If START is a string, then output that string to the file
4722 instead of any buffer contents; END is ignored.
4724 Optional fourth argument APPEND if non-nil means
4725 append to existing file contents (if any). If it is an integer,
4726 seek to that offset in the file before writing.
4727 Optional fifth argument VISIT if t means
4728 set the last-save-file-modtime of buffer to this file's modtime
4729 and mark buffer not modified.
4730 If VISIT is a string, it is a second file name;
4731 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4732 VISIT is also the file name to lock and unlock for clash detection.
4733 If VISIT is neither t nor nil nor a string,
4734 that means do not display the \"Wrote file\" message.
4735 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4736 use for locking and unlocking, overriding FILENAME and VISIT.
4737 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4738 for an existing file with the same name. If MUSTBENEW is `excl',
4739 that means to get an error if the file already exists; never overwrite.
4740 If MUSTBENEW is neither nil nor `excl', that means ask for
4741 confirmation before overwriting, but do go ahead and overwrite the file
4742 if the user confirms.
4744 This does code conversion according to the value of
4745 `coding-system-for-write', `buffer-file-coding-system', or
4746 `file-coding-system-alist', and sets the variable
4747 `last-coding-system-used' to the coding system actually used. */)
4748 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4749 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4754 const unsigned char *fn
;
4757 int count
= SPECPDL_INDEX ();
4760 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4762 Lisp_Object handler
;
4763 Lisp_Object visit_file
;
4764 Lisp_Object annotations
;
4765 Lisp_Object encoded_filename
;
4766 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4767 int quietly
= !NILP (visit
);
4768 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4769 struct buffer
*given_buffer
;
4771 int buffer_file_type
= O_BINARY
;
4773 struct coding_system coding
;
4775 if (current_buffer
->base_buffer
&& visiting
)
4776 error ("Cannot do file visiting in an indirect buffer");
4778 if (!NILP (start
) && !STRINGP (start
))
4779 validate_region (&start
, &end
);
4781 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4783 filename
= Fexpand_file_name (filename
, Qnil
);
4785 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4786 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4788 if (STRINGP (visit
))
4789 visit_file
= Fexpand_file_name (visit
, Qnil
);
4791 visit_file
= filename
;
4793 if (NILP (lockname
))
4794 lockname
= visit_file
;
4798 /* If the file name has special constructs in it,
4799 call the corresponding file handler. */
4800 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4801 /* If FILENAME has no handler, see if VISIT has one. */
4802 if (NILP (handler
) && STRINGP (visit
))
4803 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4805 if (!NILP (handler
))
4808 val
= call6 (handler
, Qwrite_region
, start
, end
,
4809 filename
, append
, visit
);
4813 SAVE_MODIFF
= MODIFF
;
4814 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4815 current_buffer
->filename
= visit_file
;
4821 /* Special kludge to simplify auto-saving. */
4824 XSETFASTINT (start
, BEG
);
4825 XSETFASTINT (end
, Z
);
4828 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4829 count1
= SPECPDL_INDEX ();
4831 given_buffer
= current_buffer
;
4833 if (!STRINGP (start
))
4835 annotations
= build_annotations (start
, end
);
4837 if (current_buffer
!= given_buffer
)
4839 XSETFASTINT (start
, BEGV
);
4840 XSETFASTINT (end
, ZV
);
4846 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4848 /* Decide the coding-system to encode the data with.
4849 We used to make this choice before calling build_annotations, but that
4850 leads to problems when a write-annotate-function takes care of
4851 unsavable chars (as was the case with X-Symbol). */
4852 choose_write_coding_system (start
, end
, filename
,
4853 append
, visit
, lockname
, &coding
);
4854 Vlast_coding_system_used
= coding
.symbol
;
4856 given_buffer
= current_buffer
;
4857 if (! STRINGP (start
))
4859 annotations
= build_annotations_2 (start
, end
,
4860 coding
.pre_write_conversion
, annotations
);
4861 if (current_buffer
!= given_buffer
)
4863 XSETFASTINT (start
, BEGV
);
4864 XSETFASTINT (end
, ZV
);
4868 #ifdef CLASH_DETECTION
4871 #if 0 /* This causes trouble for GNUS. */
4872 /* If we've locked this file for some other buffer,
4873 query before proceeding. */
4874 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4875 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4878 lock_file (lockname
);
4880 #endif /* CLASH_DETECTION */
4882 encoded_filename
= ENCODE_FILE (filename
);
4884 fn
= SDATA (encoded_filename
);
4888 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4889 #else /* not DOS_NT */
4890 desc
= emacs_open (fn
, O_WRONLY
, 0);
4891 #endif /* not DOS_NT */
4893 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4895 if (auto_saving
) /* Overwrite any previous version of autosave file */
4897 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4898 desc
= emacs_open (fn
, O_RDWR
, 0);
4900 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4901 ? SDATA (current_buffer
->filename
) : 0,
4904 else /* Write to temporary name and rename if no errors */
4906 Lisp_Object temp_name
;
4907 temp_name
= Ffile_name_directory (filename
);
4909 if (!NILP (temp_name
))
4911 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4912 build_string ("$$SAVE$$")));
4913 fname
= SDATA (filename
);
4914 fn
= SDATA (temp_name
);
4915 desc
= creat_copy_attrs (fname
, fn
);
4918 /* If we can't open the temporary file, try creating a new
4919 version of the original file. VMS "creat" creates a
4920 new version rather than truncating an existing file. */
4923 desc
= creat (fn
, 0666);
4924 #if 0 /* This can clobber an existing file and fail to replace it,
4925 if the user runs out of space. */
4928 /* We can't make a new version;
4929 try to truncate and rewrite existing version if any. */
4931 desc
= emacs_open (fn
, O_RDWR
, 0);
4937 desc
= creat (fn
, 0666);
4941 desc
= emacs_open (fn
,
4942 O_WRONLY
| O_CREAT
| buffer_file_type
4943 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4944 S_IREAD
| S_IWRITE
);
4945 #else /* not DOS_NT */
4946 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4947 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4948 auto_saving
? auto_save_mode_bits
: 0666);
4949 #endif /* not DOS_NT */
4950 #endif /* not VMS */
4954 #ifdef CLASH_DETECTION
4956 if (!auto_saving
) unlock_file (lockname
);
4958 #endif /* CLASH_DETECTION */
4960 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4963 record_unwind_protect (close_file_unwind
, make_number (desc
));
4965 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4969 if (NUMBERP (append
))
4970 ret
= lseek (desc
, XINT (append
), 1);
4972 ret
= lseek (desc
, 0, 2);
4975 #ifdef CLASH_DETECTION
4976 if (!auto_saving
) unlock_file (lockname
);
4977 #endif /* CLASH_DETECTION */
4979 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4987 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4988 * if we do writes that don't end with a carriage return. Furthermore
4989 * it cannot handle writes of more then 16K. The modified
4990 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4991 * this EXCEPT for the last record (iff it doesn't end with a carriage
4992 * return). This implies that if your buffer doesn't end with a carriage
4993 * return, you get one free... tough. However it also means that if
4994 * we make two calls to sys_write (a la the following code) you can
4995 * get one at the gap as well. The easiest way to fix this (honest)
4996 * is to move the gap to the next newline (or the end of the buffer).
5001 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5002 move_gap (find_next_newline (GPT
, 1));
5004 /* Whether VMS or not, we must move the gap to the next of newline
5005 when we must put designation sequences at beginning of line. */
5006 if (INTEGERP (start
)
5007 && coding
.type
== coding_type_iso2022
5008 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5009 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5011 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5012 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5013 move_gap_both (PT
, PT_BYTE
);
5014 SET_PT_BOTH (opoint
, opoint_byte
);
5021 if (STRINGP (start
))
5023 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5024 &annotations
, &coding
);
5027 else if (XINT (start
) != XINT (end
))
5029 tem
= CHAR_TO_BYTE (XINT (start
));
5031 if (XINT (start
) < GPT
)
5033 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5034 min (GPT
, XINT (end
)) - XINT (start
),
5035 &annotations
, &coding
);
5039 if (XINT (end
) > GPT
&& !failure
)
5041 tem
= max (XINT (start
), GPT
);
5042 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5043 &annotations
, &coding
);
5049 /* If file was empty, still need to write the annotations */
5050 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5051 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5055 if (CODING_REQUIRE_FLUSHING (&coding
)
5056 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5059 /* We have to flush out a data. */
5060 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5061 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5068 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5069 Disk full in NFS may be reported here. */
5070 /* mib says that closing the file will try to write as fast as NFS can do
5071 it, and that means the fsync here is not crucial for autosave files. */
5072 if (!auto_saving
&& fsync (desc
) < 0)
5074 /* If fsync fails with EINTR, don't treat that as serious. */
5076 failure
= 1, save_errno
= errno
;
5080 /* Spurious "file has changed on disk" warnings have been
5081 observed on Suns as well.
5082 It seems that `close' can change the modtime, under nfs.
5084 (This has supposedly been fixed in Sunos 4,
5085 but who knows about all the other machines with NFS?) */
5088 /* On VMS and APOLLO, must do the stat after the close
5089 since closing changes the modtime. */
5092 /* Recall that #if defined does not work on VMS. */
5099 /* NFS can report a write failure now. */
5100 if (emacs_close (desc
) < 0)
5101 failure
= 1, save_errno
= errno
;
5104 /* If we wrote to a temporary name and had no errors, rename to real name. */
5108 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5116 /* Discard the unwind protect for close_file_unwind. */
5117 specpdl_ptr
= specpdl
+ count1
;
5118 /* Restore the original current buffer. */
5119 visit_file
= unbind_to (count
, visit_file
);
5121 #ifdef CLASH_DETECTION
5123 unlock_file (lockname
);
5124 #endif /* CLASH_DETECTION */
5126 /* Do this before reporting IO error
5127 to avoid a "file has changed on disk" warning on
5128 next attempt to save. */
5130 current_buffer
->modtime
= st
.st_mtime
;
5133 error ("IO error writing %s: %s", SDATA (filename
),
5134 emacs_strerror (save_errno
));
5138 SAVE_MODIFF
= MODIFF
;
5139 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5140 current_buffer
->filename
= visit_file
;
5141 update_mode_lines
++;
5147 message_with_string ("Wrote %s", visit_file
, 1);
5152 Lisp_Object
merge ();
5154 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5155 doc
: /* Return t if (car A) is numerically less than (car B). */)
5159 return Flss (Fcar (a
), Fcar (b
));
5162 /* Build the complete list of annotations appropriate for writing out
5163 the text between START and END, by calling all the functions in
5164 write-region-annotate-functions and merging the lists they return.
5165 If one of these functions switches to a different buffer, we assume
5166 that buffer contains altered text. Therefore, the caller must
5167 make sure to restore the current buffer in all cases,
5168 as save-excursion would do. */
5171 build_annotations (start
, end
)
5172 Lisp_Object start
, end
;
5174 Lisp_Object annotations
;
5176 struct gcpro gcpro1
, gcpro2
;
5177 Lisp_Object original_buffer
;
5180 XSETBUFFER (original_buffer
, current_buffer
);
5183 p
= Vwrite_region_annotate_functions
;
5184 GCPRO2 (annotations
, p
);
5187 struct buffer
*given_buffer
= current_buffer
;
5188 Vwrite_region_annotations_so_far
= annotations
;
5189 res
= call2 (XCAR (p
), start
, end
);
5190 /* If the function makes a different buffer current,
5191 assume that means this buffer contains altered text to be output.
5192 Reset START and END from the buffer bounds
5193 and discard all previous annotations because they should have
5194 been dealt with by this function. */
5195 if (current_buffer
!= given_buffer
)
5197 XSETFASTINT (start
, BEGV
);
5198 XSETFASTINT (end
, ZV
);
5201 Flength (res
); /* Check basic validity of return value */
5202 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5206 /* Now do the same for annotation functions implied by the file-format */
5207 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5208 p
= Vauto_save_file_format
;
5210 p
= current_buffer
->file_format
;
5211 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5213 struct buffer
*given_buffer
= current_buffer
;
5215 Vwrite_region_annotations_so_far
= annotations
;
5217 /* Value is either a list of annotations or nil if the function
5218 has written annotations to a temporary buffer, which is now
5220 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5221 original_buffer
, make_number (i
));
5222 if (current_buffer
!= given_buffer
)
5224 XSETFASTINT (start
, BEGV
);
5225 XSETFASTINT (end
, ZV
);
5230 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5238 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5239 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5241 struct gcpro gcpro1
;
5244 GCPRO1 (annotations
);
5245 /* At last, do the same for the function PRE_WRITE_CONVERSION
5246 implied by the current coding-system. */
5247 if (!NILP (pre_write_conversion
))
5249 struct buffer
*given_buffer
= current_buffer
;
5250 Vwrite_region_annotations_so_far
= annotations
;
5251 res
= call2 (pre_write_conversion
, start
, end
);
5253 annotations
= (current_buffer
!= given_buffer
5255 : merge (annotations
, res
, Qcar_less_than_car
));
5262 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5263 If STRING is nil, POS is the character position in the current buffer.
5264 Intersperse with them the annotations from *ANNOT
5265 which fall within the range of POS to POS + NCHARS,
5266 each at its appropriate position.
5268 We modify *ANNOT by discarding elements as we use them up.
5270 The return value is negative in case of system call failure. */
5273 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5276 register int nchars
;
5279 struct coding_system
*coding
;
5283 int lastpos
= pos
+ nchars
;
5285 while (NILP (*annot
) || CONSP (*annot
))
5287 tem
= Fcar_safe (Fcar (*annot
));
5290 nextpos
= XFASTINT (tem
);
5292 /* If there are no more annotations in this range,
5293 output the rest of the range all at once. */
5294 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5295 return e_write (desc
, string
, pos
, lastpos
, coding
);
5297 /* Output buffer text up to the next annotation's position. */
5300 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5304 /* Output the annotation. */
5305 tem
= Fcdr (Fcar (*annot
));
5308 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5311 *annot
= Fcdr (*annot
);
5316 #ifndef WRITE_BUF_SIZE
5317 #define WRITE_BUF_SIZE (16 * 1024)
5320 /* Write text in the range START and END into descriptor DESC,
5321 encoding them with coding system CODING. If STRING is nil, START
5322 and END are character positions of the current buffer, else they
5323 are indexes to the string STRING. */
5326 e_write (desc
, string
, start
, end
, coding
)
5330 struct coding_system
*coding
;
5332 register char *addr
;
5333 register int nbytes
;
5334 char buf
[WRITE_BUF_SIZE
];
5338 coding
->composing
= COMPOSITION_DISABLED
;
5339 if (coding
->composing
!= COMPOSITION_DISABLED
)
5340 coding_save_composition (coding
, start
, end
, string
);
5342 if (STRINGP (string
))
5344 addr
= SDATA (string
);
5345 nbytes
= SBYTES (string
);
5346 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5348 else if (start
< end
)
5350 /* It is assured that the gap is not in the range START and END-1. */
5351 addr
= CHAR_POS_ADDR (start
);
5352 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5353 coding
->src_multibyte
5354 = !NILP (current_buffer
->enable_multibyte_characters
);
5360 coding
->src_multibyte
= 1;
5363 /* We used to have a code for handling selective display here. But,
5364 now it is handled within encode_coding. */
5369 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5370 if (coding
->produced
> 0)
5372 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5373 if (coding
->produced
)
5379 nbytes
-= coding
->consumed
;
5380 addr
+= coding
->consumed
;
5381 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5384 /* The source text ends by an incomplete multibyte form.
5385 There's no way other than write it out as is. */
5386 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5395 start
+= coding
->consumed_char
;
5396 if (coding
->cmp_data
)
5397 coding_adjust_composition_offset (coding
, start
);
5400 if (coding
->cmp_data
)
5401 coding_free_composition_data (coding
);
5406 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5407 Sverify_visited_file_modtime
, 1, 1, 0,
5408 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5409 This means that the file has not been changed since it was visited or saved. */)
5415 Lisp_Object handler
;
5416 Lisp_Object filename
;
5421 if (!STRINGP (b
->filename
)) return Qt
;
5422 if (b
->modtime
== 0) return Qt
;
5424 /* If the file name has special constructs in it,
5425 call the corresponding file handler. */
5426 handler
= Ffind_file_name_handler (b
->filename
,
5427 Qverify_visited_file_modtime
);
5428 if (!NILP (handler
))
5429 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5431 filename
= ENCODE_FILE (b
->filename
);
5433 if (stat (SDATA (filename
), &st
) < 0)
5435 /* If the file doesn't exist now and didn't exist before,
5436 we say that it isn't modified, provided the error is a tame one. */
5437 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5442 if (st
.st_mtime
== b
->modtime
5443 /* If both are positive, accept them if they are off by one second. */
5444 || (st
.st_mtime
> 0 && b
->modtime
> 0
5445 && (st
.st_mtime
== b
->modtime
+ 1
5446 || st
.st_mtime
== b
->modtime
- 1)))
5451 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5452 Sclear_visited_file_modtime
, 0, 0, 0,
5453 doc
: /* Clear out records of last mod time of visited file.
5454 Next attempt to save will certainly not complain of a discrepancy. */)
5457 current_buffer
->modtime
= 0;
5461 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5462 Svisited_file_modtime
, 0, 0, 0,
5463 doc
: /* Return the current buffer's recorded visited file modification time.
5464 The value is a list of the form (HIGH . LOW), like the time values
5465 that `file-attributes' returns. */)
5468 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5471 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5472 Sset_visited_file_modtime
, 0, 1, 0,
5473 doc
: /* Update buffer's recorded modification time from the visited file's time.
5474 Useful if the buffer was not read from the file normally
5475 or if the file itself has been changed for some known benign reason.
5476 An argument specifies the modification time value to use
5477 \(instead of that of the visited file), in the form of a list
5478 \(HIGH . LOW) or (HIGH LOW). */)
5480 Lisp_Object time_list
;
5482 if (!NILP (time_list
))
5483 current_buffer
->modtime
= cons_to_long (time_list
);
5486 register Lisp_Object filename
;
5488 Lisp_Object handler
;
5490 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5492 /* If the file name has special constructs in it,
5493 call the corresponding file handler. */
5494 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5495 if (!NILP (handler
))
5496 /* The handler can find the file name the same way we did. */
5497 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5499 filename
= ENCODE_FILE (filename
);
5501 if (stat (SDATA (filename
), &st
) >= 0)
5502 current_buffer
->modtime
= st
.st_mtime
;
5509 auto_save_error (error
)
5512 Lisp_Object args
[3], msg
;
5514 struct gcpro gcpro1
;
5518 args
[0] = build_string ("Auto-saving %s: %s");
5519 args
[1] = current_buffer
->name
;
5520 args
[2] = Ferror_message_string (error
);
5521 msg
= Fformat (3, args
);
5523 nbytes
= SBYTES (msg
);
5525 for (i
= 0; i
< 3; ++i
)
5528 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5530 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5531 Fsleep_for (make_number (1), Qnil
);
5543 /* Get visited file's mode to become the auto save file's mode. */
5544 if (! NILP (current_buffer
->filename
)
5545 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5546 /* But make sure we can overwrite it later! */
5547 auto_save_mode_bits
= st
.st_mode
| 0600;
5549 auto_save_mode_bits
= 0666;
5552 Fwrite_region (Qnil
, Qnil
,
5553 current_buffer
->auto_save_file_name
,
5554 Qnil
, Qlambda
, Qnil
, Qnil
);
5558 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5563 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5564 | XFASTINT (XCDR (stream
))));
5570 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5573 minibuffer_auto_raise
= XINT (value
);
5577 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5578 doc
: /* Auto-save all buffers that need it.
5579 This is all buffers that have auto-saving enabled
5580 and are changed since last auto-saved.
5581 Auto-saving writes the buffer into a file
5582 so that your editing is not lost if the system crashes.
5583 This file is not the file you visited; that changes only when you save.
5584 Normally we run the normal hook `auto-save-hook' before saving.
5586 A non-nil NO-MESSAGE argument means do not print any message if successful.
5587 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5588 (no_message
, current_only
)
5589 Lisp_Object no_message
, current_only
;
5591 struct buffer
*old
= current_buffer
, *b
;
5592 Lisp_Object tail
, buf
;
5594 int do_handled_files
;
5597 Lisp_Object lispstream
;
5598 int count
= SPECPDL_INDEX ();
5599 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5602 if (max_specpdl_size
< specpdl_size
+ 40)
5603 max_specpdl_size
= specpdl_size
+ 40;
5608 if (NILP (no_message
));
5609 message_p
= push_message ();
5611 /* Ordinarily don't quit within this function,
5612 but don't make it impossible to quit (in case we get hung in I/O). */
5616 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5617 point to non-strings reached from Vbuffer_alist. */
5619 if (!NILP (Vrun_hooks
))
5620 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5622 if (STRINGP (Vauto_save_list_file_name
))
5624 Lisp_Object listfile
;
5626 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5628 /* Don't try to create the directory when shutting down Emacs,
5629 because creating the directory might signal an error, and
5630 that would leave Emacs in a strange state. */
5631 if (!NILP (Vrun_hooks
))
5634 dir
= Ffile_name_directory (listfile
);
5635 if (NILP (Ffile_directory_p (dir
)))
5636 call2 (Qmake_directory
, dir
, Qt
);
5639 stream
= fopen (SDATA (listfile
), "w");
5642 /* Arrange to close that file whether or not we get an error.
5643 Also reset auto_saving to 0. */
5644 lispstream
= Fcons (Qnil
, Qnil
);
5645 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5646 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5657 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5658 record_unwind_protect (do_auto_save_unwind_1
,
5659 make_number (minibuffer_auto_raise
));
5660 minibuffer_auto_raise
= 0;
5663 /* First, save all files which don't have handlers. If Emacs is
5664 crashing, the handlers may tweak what is causing Emacs to crash
5665 in the first place, and it would be a shame if Emacs failed to
5666 autosave perfectly ordinary files because it couldn't handle some
5668 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5669 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5671 buf
= XCDR (XCAR (tail
));
5674 /* Record all the buffers that have auto save mode
5675 in the special file that lists them. For each of these buffers,
5676 Record visited name (if any) and auto save name. */
5677 if (STRINGP (b
->auto_save_file_name
)
5678 && stream
!= NULL
&& do_handled_files
== 0)
5680 if (!NILP (b
->filename
))
5682 fwrite (SDATA (b
->filename
), 1,
5683 SBYTES (b
->filename
), stream
);
5685 putc ('\n', stream
);
5686 fwrite (SDATA (b
->auto_save_file_name
), 1,
5687 SBYTES (b
->auto_save_file_name
), stream
);
5688 putc ('\n', stream
);
5691 if (!NILP (current_only
)
5692 && b
!= current_buffer
)
5695 /* Don't auto-save indirect buffers.
5696 The base buffer takes care of it. */
5700 /* Check for auto save enabled
5701 and file changed since last auto save
5702 and file changed since last real save. */
5703 if (STRINGP (b
->auto_save_file_name
)
5704 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5705 && b
->auto_save_modified
< BUF_MODIFF (b
)
5706 /* -1 means we've turned off autosaving for a while--see below. */
5707 && XINT (b
->save_length
) >= 0
5708 && (do_handled_files
5709 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5712 EMACS_TIME before_time
, after_time
;
5714 EMACS_GET_TIME (before_time
);
5716 /* If we had a failure, don't try again for 20 minutes. */
5717 if (b
->auto_save_failure_time
>= 0
5718 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5721 if ((XFASTINT (b
->save_length
) * 10
5722 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5723 /* A short file is likely to change a large fraction;
5724 spare the user annoying messages. */
5725 && XFASTINT (b
->save_length
) > 5000
5726 /* These messages are frequent and annoying for `*mail*'. */
5727 && !EQ (b
->filename
, Qnil
)
5728 && NILP (no_message
))
5730 /* It has shrunk too much; turn off auto-saving here. */
5731 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5732 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5734 minibuffer_auto_raise
= 0;
5735 /* Turn off auto-saving until there's a real save,
5736 and prevent any more warnings. */
5737 XSETINT (b
->save_length
, -1);
5738 Fsleep_for (make_number (1), Qnil
);
5741 set_buffer_internal (b
);
5742 if (!auto_saved
&& NILP (no_message
))
5743 message1 ("Auto-saving...");
5744 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5746 b
->auto_save_modified
= BUF_MODIFF (b
);
5747 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5748 set_buffer_internal (old
);
5750 EMACS_GET_TIME (after_time
);
5752 /* If auto-save took more than 60 seconds,
5753 assume it was an NFS failure that got a timeout. */
5754 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5755 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5759 /* Prevent another auto save till enough input events come in. */
5760 record_auto_save ();
5762 if (auto_saved
&& NILP (no_message
))
5766 sit_for (1, 0, 0, 0, 0);
5770 message1 ("Auto-saving...done");
5775 unbind_to (count
, Qnil
);
5779 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5780 Sset_buffer_auto_saved
, 0, 0, 0,
5781 doc
: /* Mark current buffer as auto-saved with its current text.
5782 No auto-save file will be written until the buffer changes again. */)
5785 current_buffer
->auto_save_modified
= MODIFF
;
5786 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5787 current_buffer
->auto_save_failure_time
= -1;
5791 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5792 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5793 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5796 current_buffer
->auto_save_failure_time
= -1;
5800 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5802 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
5805 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5808 /* Reading and completing file names */
5809 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5811 /* In the string VAL, change each $ to $$ and return the result. */
5814 double_dollars (val
)
5817 register const unsigned char *old
;
5818 register unsigned char *new;
5822 osize
= SBYTES (val
);
5824 /* Count the number of $ characters. */
5825 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
5826 if (*old
++ == '$') count
++;
5830 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
5833 for (n
= osize
; n
> 0; n
--)
5847 read_file_name_cleanup (arg
)
5850 return (current_buffer
->directory
= arg
);
5853 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5855 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
5856 (string
, dir
, action
)
5857 Lisp_Object string
, dir
, action
;
5858 /* action is nil for complete, t for return list of completions,
5859 lambda for verify final value */
5861 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5863 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5865 CHECK_STRING (string
);
5872 /* No need to protect ACTION--we only compare it with t and nil. */
5873 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5875 if (SCHARS (string
) == 0)
5877 if (EQ (action
, Qlambda
))
5885 orig_string
= string
;
5886 string
= Fsubstitute_in_file_name (string
);
5887 changed
= NILP (Fstring_equal (string
, orig_string
));
5888 name
= Ffile_name_nondirectory (string
);
5889 val
= Ffile_name_directory (string
);
5891 realdir
= Fexpand_file_name (val
, realdir
);
5896 specdir
= Ffile_name_directory (string
);
5897 val
= Ffile_name_completion (name
, realdir
);
5902 return double_dollars (string
);
5906 if (!NILP (specdir
))
5907 val
= concat2 (specdir
, val
);
5909 return double_dollars (val
);
5912 #endif /* not VMS */
5916 if (EQ (action
, Qt
))
5918 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
5922 if (NILP (Vread_file_name_predicate
)
5923 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
5927 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
5929 /* Brute-force speed up for directory checking:
5930 Discard strings which don't end in a slash. */
5931 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
5933 Lisp_Object tem
= XCAR (all
);
5935 if (STRINGP (tem
) &&
5936 (len
= SCHARS (tem
), len
> 0) &&
5937 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
5938 comp
= Fcons (tem
, comp
);
5944 /* Must do it the hard (and slow) way. */
5945 GCPRO3 (all
, comp
, specdir
);
5946 count
= SPECPDL_INDEX ();
5947 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
5948 current_buffer
->directory
= realdir
;
5949 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
5950 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
5951 comp
= Fcons (XCAR (all
), comp
);
5952 unbind_to (count
, Qnil
);
5955 return Fnreverse (comp
);
5958 /* Only other case actually used is ACTION = lambda */
5960 /* Supposedly this helps commands such as `cd' that read directory names,
5961 but can someone explain how it helps them? -- RMS */
5962 if (SCHARS (name
) == 0)
5965 if (!NILP (Vread_file_name_predicate
))
5966 return call1 (Vread_file_name_predicate
, string
);
5967 return Ffile_exists_p (string
);
5970 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
5971 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
5972 Value is not expanded---you must call `expand-file-name' yourself.
5973 Default name to DEFAULT-FILENAME if user enters a null string.
5974 (If DEFAULT-FILENAME is omitted, the visited file name is used,
5975 except that if INITIAL is specified, that combined with DIR is used.)
5976 Fourth arg MUSTMATCH non-nil means require existing file's name.
5977 Non-nil and non-t means also require confirmation after completion.
5978 Fifth arg INITIAL specifies text to start with.
5979 If optional sixth arg PREDICATE is non-nil, possible completions and the
5980 resulting file name must satisfy (funcall PREDICATE NAME).
5981 DIR defaults to current buffer's directory default.
5983 If this command was invoked with the mouse, use a file dialog box if
5984 `use-dialog-box' is non-nil, and the window system or X toolkit in use
5985 provides a file dialog box. */)
5986 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
5987 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
5989 Lisp_Object val
, insdef
, tem
;
5990 struct gcpro gcpro1
, gcpro2
;
5991 register char *homedir
;
5992 int replace_in_history
= 0;
5993 int add_to_history
= 0;
5997 dir
= current_buffer
->directory
;
5998 if (NILP (default_filename
))
6000 if (! NILP (initial
))
6001 default_filename
= Fexpand_file_name (initial
, dir
);
6003 default_filename
= current_buffer
->filename
;
6006 /* If dir starts with user's homedir, change that to ~. */
6007 homedir
= (char *) egetenv ("HOME");
6009 /* homedir can be NULL in temacs, since Vprocess_environment is not
6010 yet set up. We shouldn't crash in that case. */
6013 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6014 CORRECT_DIR_SEPS (homedir
);
6019 && !strncmp (homedir
, SDATA (dir
), strlen (homedir
))
6020 && IS_DIRECTORY_SEP (SREF (dir
, strlen (homedir
))))
6022 dir
= make_string (SDATA (dir
) + strlen (homedir
) - 1,
6023 SBYTES (dir
) - strlen (homedir
) + 1);
6026 /* Likewise for default_filename. */
6028 && STRINGP (default_filename
)
6029 && !strncmp (homedir
, SDATA (default_filename
), strlen (homedir
))
6030 && IS_DIRECTORY_SEP (SREF (default_filename
, strlen (homedir
))))
6033 = make_string (SDATA (default_filename
) + strlen (homedir
) - 1,
6034 SBYTES (default_filename
) - strlen (homedir
) + 1);
6035 SSET (default_filename
, 0, '~');
6037 if (!NILP (default_filename
))
6039 CHECK_STRING (default_filename
);
6040 default_filename
= double_dollars (default_filename
);
6043 if (insert_default_directory
&& STRINGP (dir
))
6046 if (!NILP (initial
))
6048 Lisp_Object args
[2], pos
;
6052 insdef
= Fconcat (2, args
);
6053 pos
= make_number (SCHARS (double_dollars (dir
)));
6054 insdef
= Fcons (double_dollars (insdef
), pos
);
6057 insdef
= double_dollars (insdef
);
6059 else if (STRINGP (initial
))
6060 insdef
= Fcons (double_dollars (initial
), make_number (0));
6064 if (!NILP (Vread_file_name_function
))
6066 Lisp_Object args
[7];
6068 GCPRO2 (insdef
, default_filename
);
6069 args
[0] = Vread_file_name_function
;
6072 args
[3] = default_filename
;
6073 args
[4] = mustmatch
;
6075 args
[6] = predicate
;
6076 RETURN_UNGCPRO (Ffuncall (7, args
));
6079 count
= SPECPDL_INDEX ();
6081 specbind (intern ("completion-ignore-case"), Qt
);
6084 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6085 specbind (intern ("read-file-name-predicate"),
6086 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6088 GCPRO2 (insdef
, default_filename
);
6090 #if defined (USE_MOTIF) || defined (HAVE_NTGUI)
6091 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6095 /* If DIR contains a file name, split it. */
6097 file
= Ffile_name_nondirectory (dir
);
6098 if (SCHARS (file
) && NILP (default_filename
))
6100 default_filename
= file
;
6101 dir
= Ffile_name_directory (dir
);
6103 if (!NILP(default_filename
))
6104 default_filename
= Fexpand_file_name (default_filename
, dir
);
6105 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6110 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6111 dir
, mustmatch
, insdef
,
6112 Qfile_name_history
, default_filename
, Qnil
);
6114 tem
= Fsymbol_value (Qfile_name_history
);
6115 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6116 replace_in_history
= 1;
6118 /* If Fcompleting_read returned the inserted default string itself
6119 (rather than a new string with the same contents),
6120 it has to mean that the user typed RET with the minibuffer empty.
6121 In that case, we really want to return ""
6122 so that commands such as set-visited-file-name can distinguish. */
6123 if (EQ (val
, default_filename
))
6125 /* In this case, Fcompleting_read has not added an element
6126 to the history. Maybe we should. */
6127 if (! replace_in_history
)
6130 val
= build_string ("");
6133 unbind_to (count
, Qnil
);
6136 error ("No file name specified");
6138 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6140 if (!NILP (tem
) && !NILP (default_filename
))
6141 val
= default_filename
;
6142 else if (SCHARS (val
) == 0 && NILP (insdef
))
6144 if (!NILP (default_filename
))
6145 val
= default_filename
;
6147 error ("No default file name");
6149 val
= Fsubstitute_in_file_name (val
);
6151 if (replace_in_history
)
6152 /* Replace what Fcompleting_read added to the history
6153 with what we will actually return. */
6154 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6155 else if (add_to_history
)
6157 /* Add the value to the history--but not if it matches
6158 the last value already there. */
6159 Lisp_Object val1
= double_dollars (val
);
6160 tem
= Fsymbol_value (Qfile_name_history
);
6161 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6162 Fset (Qfile_name_history
,
6173 /* Must be set before any path manipulation is performed. */
6174 XSETFASTINT (Vdirectory_sep_char
, '/');
6181 Qexpand_file_name
= intern ("expand-file-name");
6182 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6183 Qdirectory_file_name
= intern ("directory-file-name");
6184 Qfile_name_directory
= intern ("file-name-directory");
6185 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6186 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6187 Qfile_name_as_directory
= intern ("file-name-as-directory");
6188 Qcopy_file
= intern ("copy-file");
6189 Qmake_directory_internal
= intern ("make-directory-internal");
6190 Qmake_directory
= intern ("make-directory");
6191 Qdelete_directory
= intern ("delete-directory");
6192 Qdelete_file
= intern ("delete-file");
6193 Qrename_file
= intern ("rename-file");
6194 Qadd_name_to_file
= intern ("add-name-to-file");
6195 Qmake_symbolic_link
= intern ("make-symbolic-link");
6196 Qfile_exists_p
= intern ("file-exists-p");
6197 Qfile_executable_p
= intern ("file-executable-p");
6198 Qfile_readable_p
= intern ("file-readable-p");
6199 Qfile_writable_p
= intern ("file-writable-p");
6200 Qfile_symlink_p
= intern ("file-symlink-p");
6201 Qaccess_file
= intern ("access-file");
6202 Qfile_directory_p
= intern ("file-directory-p");
6203 Qfile_regular_p
= intern ("file-regular-p");
6204 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6205 Qfile_modes
= intern ("file-modes");
6206 Qset_file_modes
= intern ("set-file-modes");
6207 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6208 Qinsert_file_contents
= intern ("insert-file-contents");
6209 Qwrite_region
= intern ("write-region");
6210 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6211 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6213 staticpro (&Qexpand_file_name
);
6214 staticpro (&Qsubstitute_in_file_name
);
6215 staticpro (&Qdirectory_file_name
);
6216 staticpro (&Qfile_name_directory
);
6217 staticpro (&Qfile_name_nondirectory
);
6218 staticpro (&Qunhandled_file_name_directory
);
6219 staticpro (&Qfile_name_as_directory
);
6220 staticpro (&Qcopy_file
);
6221 staticpro (&Qmake_directory_internal
);
6222 staticpro (&Qmake_directory
);
6223 staticpro (&Qdelete_directory
);
6224 staticpro (&Qdelete_file
);
6225 staticpro (&Qrename_file
);
6226 staticpro (&Qadd_name_to_file
);
6227 staticpro (&Qmake_symbolic_link
);
6228 staticpro (&Qfile_exists_p
);
6229 staticpro (&Qfile_executable_p
);
6230 staticpro (&Qfile_readable_p
);
6231 staticpro (&Qfile_writable_p
);
6232 staticpro (&Qaccess_file
);
6233 staticpro (&Qfile_symlink_p
);
6234 staticpro (&Qfile_directory_p
);
6235 staticpro (&Qfile_regular_p
);
6236 staticpro (&Qfile_accessible_directory_p
);
6237 staticpro (&Qfile_modes
);
6238 staticpro (&Qset_file_modes
);
6239 staticpro (&Qfile_newer_than_file_p
);
6240 staticpro (&Qinsert_file_contents
);
6241 staticpro (&Qwrite_region
);
6242 staticpro (&Qverify_visited_file_modtime
);
6243 staticpro (&Qset_visited_file_modtime
);
6245 Qfile_name_history
= intern ("file-name-history");
6246 Fset (Qfile_name_history
, Qnil
);
6247 staticpro (&Qfile_name_history
);
6249 Qfile_error
= intern ("file-error");
6250 staticpro (&Qfile_error
);
6251 Qfile_already_exists
= intern ("file-already-exists");
6252 staticpro (&Qfile_already_exists
);
6253 Qfile_date_error
= intern ("file-date-error");
6254 staticpro (&Qfile_date_error
);
6255 Qexcl
= intern ("excl");
6259 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6260 staticpro (&Qfind_buffer_file_type
);
6263 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6264 doc
: /* *Coding system for encoding file names.
6265 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6266 Vfile_name_coding_system
= Qnil
;
6268 DEFVAR_LISP ("default-file-name-coding-system",
6269 &Vdefault_file_name_coding_system
,
6270 doc
: /* Default coding system for encoding file names.
6271 This variable is used only when `file-name-coding-system' is nil.
6273 This variable is set/changed by the command `set-language-environment'.
6274 User should not set this variable manually,
6275 instead use `file-name-coding-system' to get a constant encoding
6276 of file names regardless of the current language environment. */);
6277 Vdefault_file_name_coding_system
= Qnil
;
6279 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6280 doc
: /* *Format in which to write auto-save files.
6281 Should be a list of symbols naming formats that are defined in `format-alist'.
6282 If it is t, which is the default, auto-save files are written in the
6283 same format as a regular save would use. */);
6284 Vauto_save_file_format
= Qt
;
6286 Qformat_decode
= intern ("format-decode");
6287 staticpro (&Qformat_decode
);
6288 Qformat_annotate_function
= intern ("format-annotate-function");
6289 staticpro (&Qformat_annotate_function
);
6291 Qcar_less_than_car
= intern ("car-less-than-car");
6292 staticpro (&Qcar_less_than_car
);
6294 Fput (Qfile_error
, Qerror_conditions
,
6295 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6296 Fput (Qfile_error
, Qerror_message
,
6297 build_string ("File error"));
6299 Fput (Qfile_already_exists
, Qerror_conditions
,
6300 Fcons (Qfile_already_exists
,
6301 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6302 Fput (Qfile_already_exists
, Qerror_message
,
6303 build_string ("File already exists"));
6305 Fput (Qfile_date_error
, Qerror_conditions
,
6306 Fcons (Qfile_date_error
,
6307 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6308 Fput (Qfile_date_error
, Qerror_message
,
6309 build_string ("Cannot set file date"));
6311 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6312 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6313 Vread_file_name_function
= Qnil
;
6315 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6316 doc
: /* Current predicate used by `read-file-name-internal'. */);
6317 Vread_file_name_predicate
= Qnil
;
6319 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6320 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer. */);
6321 insert_default_directory
= 1;
6323 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6324 doc
: /* *Non-nil means write new files with record format `stmlf'.
6325 nil means use format `var'. This variable is meaningful only on VMS. */);
6326 vms_stmlf_recfm
= 0;
6328 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6329 doc
: /* Directory separator character for built-in functions that return file names.
6330 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
6331 This variable affects the built-in functions only on Windows,
6332 on other platforms, it is initialized so that Lisp code can find out
6333 what the normal separator is. */);
6335 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6336 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6337 If a file name matches REGEXP, then all I/O on that file is done by calling
6340 The first argument given to HANDLER is the name of the I/O primitive
6341 to be handled; the remaining arguments are the arguments that were
6342 passed to that primitive. For example, if you do
6343 (file-exists-p FILENAME)
6344 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6345 (funcall HANDLER 'file-exists-p FILENAME)
6346 The function `find-file-name-handler' checks this list for a handler
6347 for its argument. */);
6348 Vfile_name_handler_alist
= Qnil
;
6350 DEFVAR_LISP ("set-auto-coding-function",
6351 &Vset_auto_coding_function
,
6352 doc
: /* If non-nil, a function to call to decide a coding system of file.
6353 Two arguments are passed to this function: the file name
6354 and the length of a file contents following the point.
6355 This function should return a coding system to decode the file contents.
6356 It should check the file name against `auto-coding-alist'.
6357 If no coding system is decided, it should check a coding system
6358 specified in the heading lines with the format:
6359 -*- ... coding: CODING-SYSTEM; ... -*-
6360 or local variable spec of the tailing lines with `coding:' tag. */);
6361 Vset_auto_coding_function
= Qnil
;
6363 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6364 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6365 Each is passed one argument, the number of bytes inserted. It should return
6366 the new byte count, and leave point the same. If `insert-file-contents' is
6367 intercepted by a handler from `file-name-handler-alist', that handler is
6368 responsible for calling the after-insert-file-functions if appropriate. */);
6369 Vafter_insert_file_functions
= Qnil
;
6371 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6372 doc
: /* A list of functions to be called at the start of `write-region'.
6373 Each is passed two arguments, START and END as for `write-region'.
6374 These are usually two numbers but not always; see the documentation
6375 for `write-region'. The function should return a list of pairs
6376 of the form (POSITION . STRING), consisting of strings to be effectively
6377 inserted at the specified positions of the file being written (1 means to
6378 insert before the first byte written). The POSITIONs must be sorted into
6379 increasing order. If there are several functions in the list, the several
6380 lists are merged destructively. Alternatively, the function can return
6381 with a different buffer current and value nil.*/);
6382 Vwrite_region_annotate_functions
= Qnil
;
6384 DEFVAR_LISP ("write-region-annotations-so-far",
6385 &Vwrite_region_annotations_so_far
,
6386 doc
: /* When an annotation function is called, this holds the previous annotations.
6387 These are the annotations made by other annotation functions
6388 that were already called. See also `write-region-annotate-functions'. */);
6389 Vwrite_region_annotations_so_far
= Qnil
;
6391 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6392 doc
: /* A list of file name handlers that temporarily should not be used.
6393 This applies only to the operation `inhibit-file-name-operation'. */);
6394 Vinhibit_file_name_handlers
= Qnil
;
6396 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6397 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6398 Vinhibit_file_name_operation
= Qnil
;
6400 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6401 doc
: /* File name in which we write a list of all auto save file names.
6402 This variable is initialized automatically from `auto-save-list-file-prefix'
6403 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6404 a non-nil value. */);
6405 Vauto_save_list_file_name
= Qnil
;
6407 defsubr (&Sfind_file_name_handler
);
6408 defsubr (&Sfile_name_directory
);
6409 defsubr (&Sfile_name_nondirectory
);
6410 defsubr (&Sunhandled_file_name_directory
);
6411 defsubr (&Sfile_name_as_directory
);
6412 defsubr (&Sdirectory_file_name
);
6413 defsubr (&Smake_temp_name
);
6414 defsubr (&Sexpand_file_name
);
6415 defsubr (&Ssubstitute_in_file_name
);
6416 defsubr (&Scopy_file
);
6417 defsubr (&Smake_directory_internal
);
6418 defsubr (&Sdelete_directory
);
6419 defsubr (&Sdelete_file
);
6420 defsubr (&Srename_file
);
6421 defsubr (&Sadd_name_to_file
);
6423 defsubr (&Smake_symbolic_link
);
6424 #endif /* S_IFLNK */
6426 defsubr (&Sdefine_logical_name
);
6429 defsubr (&Ssysnetunam
);
6430 #endif /* HPUX_NET */
6431 defsubr (&Sfile_name_absolute_p
);
6432 defsubr (&Sfile_exists_p
);
6433 defsubr (&Sfile_executable_p
);
6434 defsubr (&Sfile_readable_p
);
6435 defsubr (&Sfile_writable_p
);
6436 defsubr (&Saccess_file
);
6437 defsubr (&Sfile_symlink_p
);
6438 defsubr (&Sfile_directory_p
);
6439 defsubr (&Sfile_accessible_directory_p
);
6440 defsubr (&Sfile_regular_p
);
6441 defsubr (&Sfile_modes
);
6442 defsubr (&Sset_file_modes
);
6443 defsubr (&Sset_default_file_modes
);
6444 defsubr (&Sdefault_file_modes
);
6445 defsubr (&Sfile_newer_than_file_p
);
6446 defsubr (&Sinsert_file_contents
);
6447 defsubr (&Swrite_region
);
6448 defsubr (&Scar_less_than_car
);
6449 defsubr (&Sverify_visited_file_modtime
);
6450 defsubr (&Sclear_visited_file_modtime
);
6451 defsubr (&Svisited_file_modtime
);
6452 defsubr (&Sset_visited_file_modtime
);
6453 defsubr (&Sdo_auto_save
);
6454 defsubr (&Sset_buffer_auto_saved
);
6455 defsubr (&Sclear_buffer_auto_save_failure
);
6456 defsubr (&Srecent_auto_save_p
);
6458 defsubr (&Sread_file_name_internal
);
6459 defsubr (&Sread_file_name
);
6462 defsubr (&Sunix_sync
);