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. */
29 #include <sys/types.h>
36 #if !defined (S_ISLNK) && defined (S_IFLNK)
37 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
40 #if !defined (S_ISFIFO) && defined (S_IFIFO)
41 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
44 #if !defined (S_ISREG) && defined (S_IFREG)
45 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
76 #include "intervals.h"
87 #endif /* not WINDOWSNT */
91 #include <sys/param.h>
99 #define CORRECT_DIR_SEPS(s) \
100 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
101 else unixtodos_filename (s); \
103 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
104 redirector allows the six letters between 'Z' and 'a' as well. */
106 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
109 #define IS_DRIVE(x) isalpha (x)
111 /* Need to lower-case the drive letter, or else expanded
112 filenames will sometimes compare inequal, because
113 `expand-file-name' doesn't always down-case the drive letter. */
114 #define DRIVE_LETTER(x) (tolower (x))
135 #include "commands.h"
136 extern int use_dialog_box
;
150 /* Nonzero during writing of auto-save files */
153 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
154 a new file with the same mode as the original */
155 int auto_save_mode_bits
;
157 /* Coding system for file names, or nil if none. */
158 Lisp_Object Vfile_name_coding_system
;
160 /* Coding system for file names used only when
161 Vfile_name_coding_system is nil. */
162 Lisp_Object Vdefault_file_name_coding_system
;
164 /* Alist of elements (REGEXP . HANDLER) for file names
165 whose I/O is done with a special handler. */
166 Lisp_Object Vfile_name_handler_alist
;
168 /* Format for auto-save files */
169 Lisp_Object Vauto_save_file_format
;
171 /* Lisp functions for translating file formats */
172 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
174 /* Function to be called to decide a coding system of a reading file. */
175 Lisp_Object Vset_auto_coding_function
;
177 /* Functions to be called to process text properties in inserted file. */
178 Lisp_Object Vafter_insert_file_functions
;
180 /* Functions to be called to create text property annotations for file. */
181 Lisp_Object Vwrite_region_annotate_functions
;
183 /* During build_annotations, each time an annotation function is called,
184 this holds the annotations made by the previous functions. */
185 Lisp_Object Vwrite_region_annotations_so_far
;
187 /* File name in which we write a list of all our auto save files. */
188 Lisp_Object Vauto_save_list_file_name
;
190 /* Function to call to read a file name. */
191 Lisp_Object Vread_file_name_function
;
193 /* Current predicate used by read_file_name_internal. */
194 Lisp_Object Vread_file_name_predicate
;
196 /* Nonzero means, when reading a filename in the minibuffer,
197 start out by inserting the default directory into the minibuffer. */
198 int insert_default_directory
;
200 /* On VMS, nonzero means write new files with record format stmlf.
201 Zero means use var format. */
204 /* On NT, specifies the directory separator character, used (eg.) when
205 expanding file names. This can be bound to / or \. */
206 Lisp_Object Vdirectory_sep_char
;
208 extern Lisp_Object Vuser_login_name
;
211 extern Lisp_Object Vw32_get_true_file_attributes
;
214 extern int minibuf_level
;
216 extern int minibuffer_auto_raise
;
218 /* These variables describe handlers that have "already" had a chance
219 to handle the current operation.
221 Vinhibit_file_name_handlers is a list of file name handlers.
222 Vinhibit_file_name_operation is the operation being handled.
223 If we try to handle that operation, we ignore those handlers. */
225 static Lisp_Object Vinhibit_file_name_handlers
;
226 static Lisp_Object Vinhibit_file_name_operation
;
228 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
230 Lisp_Object Qfile_name_history
;
232 Lisp_Object Qcar_less_than_car
;
234 static int a_write
P_ ((int, Lisp_Object
, int, int,
235 Lisp_Object
*, struct coding_system
*));
236 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
240 report_file_error (string
, data
)
244 Lisp_Object errstring
;
247 synchronize_system_messages_locale ();
248 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
249 Vlocale_coding_system
, 0);
255 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
258 /* System error messages are capitalized. Downcase the initial
259 unless it is followed by a slash. */
260 if (SREF (errstring
, 1) != '/')
261 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
263 Fsignal (Qfile_error
,
264 Fcons (build_string (string
), Fcons (errstring
, data
)));
269 close_file_unwind (fd
)
272 emacs_close (XFASTINT (fd
));
276 /* Restore point, having saved it as a marker. */
279 restore_point_unwind (location
)
280 Lisp_Object location
;
282 Fgoto_char (location
);
283 Fset_marker (location
, Qnil
, Qnil
);
287 Lisp_Object Qexpand_file_name
;
288 Lisp_Object Qsubstitute_in_file_name
;
289 Lisp_Object Qdirectory_file_name
;
290 Lisp_Object Qfile_name_directory
;
291 Lisp_Object Qfile_name_nondirectory
;
292 Lisp_Object Qunhandled_file_name_directory
;
293 Lisp_Object Qfile_name_as_directory
;
294 Lisp_Object Qcopy_file
;
295 Lisp_Object Qmake_directory_internal
;
296 Lisp_Object Qmake_directory
;
297 Lisp_Object Qdelete_directory
;
298 Lisp_Object Qdelete_file
;
299 Lisp_Object Qrename_file
;
300 Lisp_Object Qadd_name_to_file
;
301 Lisp_Object Qmake_symbolic_link
;
302 Lisp_Object Qfile_exists_p
;
303 Lisp_Object Qfile_executable_p
;
304 Lisp_Object Qfile_readable_p
;
305 Lisp_Object Qfile_writable_p
;
306 Lisp_Object Qfile_symlink_p
;
307 Lisp_Object Qaccess_file
;
308 Lisp_Object Qfile_directory_p
;
309 Lisp_Object Qfile_regular_p
;
310 Lisp_Object Qfile_accessible_directory_p
;
311 Lisp_Object Qfile_modes
;
312 Lisp_Object Qset_file_modes
;
313 Lisp_Object Qfile_newer_than_file_p
;
314 Lisp_Object Qinsert_file_contents
;
315 Lisp_Object Qwrite_region
;
316 Lisp_Object Qverify_visited_file_modtime
;
317 Lisp_Object Qset_visited_file_modtime
;
319 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
320 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
321 Otherwise, return nil.
322 A file name is handled if one of the regular expressions in
323 `file-name-handler-alist' matches it.
325 If OPERATION equals `inhibit-file-name-operation', then we ignore
326 any handlers that are members of `inhibit-file-name-handlers',
327 but we still do run any other handlers. This lets handlers
328 use the standard functions without calling themselves recursively. */)
329 (filename
, operation
)
330 Lisp_Object filename
, operation
;
332 /* This function must not munge the match data. */
333 Lisp_Object chain
, inhibited_handlers
, result
;
337 CHECK_STRING (filename
);
339 if (EQ (operation
, Vinhibit_file_name_operation
))
340 inhibited_handlers
= Vinhibit_file_name_handlers
;
342 inhibited_handlers
= Qnil
;
344 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
345 chain
= XCDR (chain
))
355 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
357 Lisp_Object handler
, tem
;
359 handler
= XCDR (elt
);
360 tem
= Fmemq (handler
, inhibited_handlers
);
374 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
376 doc
: /* Return the directory component in file name FILENAME.
377 Return nil if FILENAME does not include a directory.
378 Otherwise return a directory spec.
379 Given a Unix syntax file name, returns a string ending in slash;
380 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
382 Lisp_Object filename
;
385 register const unsigned char *beg
;
387 register unsigned char *beg
;
389 register const unsigned char *p
;
392 CHECK_STRING (filename
);
394 /* If the file name has special constructs in it,
395 call the corresponding file handler. */
396 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
398 return call2 (handler
, Qfile_name_directory
, filename
);
400 #ifdef FILE_SYSTEM_CASE
401 filename
= FILE_SYSTEM_CASE (filename
);
403 beg
= SDATA (filename
);
405 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
407 p
= beg
+ SBYTES (filename
);
409 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
411 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
414 /* only recognise drive specifier at the beginning */
416 /* handle the "/:d:foo" and "/:foo" cases correctly */
417 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
418 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
425 /* Expansion of "c:" to drive and default directory. */
428 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
429 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
430 unsigned char *r
= res
;
432 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
434 strncpy (res
, beg
, 2);
439 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
441 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
444 p
= beg
+ strlen (beg
);
447 CORRECT_DIR_SEPS (beg
);
450 if (STRING_MULTIBYTE (filename
))
451 return make_string (beg
, p
- beg
);
452 return make_unibyte_string (beg
, p
- beg
);
455 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
456 Sfile_name_nondirectory
, 1, 1, 0,
457 doc
: /* Return file name FILENAME sans its directory.
458 For example, in a Unix-syntax file name,
459 this is everything after the last slash,
460 or the entire name if it contains no slash. */)
462 Lisp_Object filename
;
464 register const unsigned char *beg
, *p
, *end
;
467 CHECK_STRING (filename
);
469 /* If the file name has special constructs in it,
470 call the corresponding file handler. */
471 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
473 return call2 (handler
, Qfile_name_nondirectory
, filename
);
475 beg
= SDATA (filename
);
476 end
= p
= beg
+ SBYTES (filename
);
478 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
480 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
483 /* only recognise drive specifier at beginning */
485 /* handle the "/:d:foo" case correctly */
486 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
491 if (STRING_MULTIBYTE (filename
))
492 return make_string (p
, end
- p
);
493 return make_unibyte_string (p
, end
- p
);
496 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
497 Sunhandled_file_name_directory
, 1, 1, 0,
498 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
499 A `directly usable' directory name is one that may be used without the
500 intervention of any file handler.
501 If FILENAME is a directly usable file itself, return
502 \(file-name-directory FILENAME).
503 The `call-process' and `start-process' functions use this function to
504 get a current directory to run processes in. */)
506 Lisp_Object filename
;
510 /* If the file name has special constructs in it,
511 call the corresponding file handler. */
512 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
514 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
516 return Ffile_name_directory (filename
);
521 file_name_as_directory (out
, in
)
524 int size
= strlen (in
) - 1;
537 /* Is it already a directory string? */
538 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
540 /* Is it a VMS directory file name? If so, hack VMS syntax. */
541 else if (! index (in
, '/')
542 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
543 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
544 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
545 || ! strncmp (&in
[size
- 5], ".dir", 4))
546 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
547 && in
[size
] == '1')))
549 register char *p
, *dot
;
553 dir:x.dir --> dir:[x]
554 dir:[x]y.dir --> dir:[x.y] */
556 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
559 strncpy (out
, in
, p
- in
);
578 dot
= index (p
, '.');
581 /* blindly remove any extension */
582 size
= strlen (out
) + (dot
- p
);
583 strncat (out
, p
, dot
- p
);
594 /* For Unix syntax, Append a slash if necessary */
595 if (!IS_DIRECTORY_SEP (out
[size
]))
597 /* Cannot use DIRECTORY_SEP, which could have any value */
599 out
[size
+ 2] = '\0';
602 CORRECT_DIR_SEPS (out
);
608 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
609 Sfile_name_as_directory
, 1, 1, 0,
610 doc
: /* Return a string representing the file name FILE interpreted as a directory.
611 This operation exists because a directory is also a file, but its name as
612 a directory is different from its name as a file.
613 The result can be used as the value of `default-directory'
614 or passed as second argument to `expand-file-name'.
615 For a Unix-syntax file name, just appends a slash.
616 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
627 /* If the file name has special constructs in it,
628 call the corresponding file handler. */
629 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
631 return call2 (handler
, Qfile_name_as_directory
, file
);
633 buf
= (char *) alloca (SBYTES (file
) + 10);
634 return build_string (file_name_as_directory (buf
, SDATA (file
)));
638 * Convert from directory name to filename.
640 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
641 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
642 * On UNIX, it's simple: just make sure there isn't a terminating /
644 * Value is nonzero if the string output is different from the input.
648 directory_file_name (src
, dst
)
656 struct FAB fab
= cc$rms_fab
;
657 struct NAM nam
= cc$rms_nam
;
658 char esa
[NAM$C_MAXRSS
];
663 if (! index (src
, '/')
664 && (src
[slen
- 1] == ']'
665 || src
[slen
- 1] == ':'
666 || src
[slen
- 1] == '>'))
668 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
670 fab
.fab$b_fns
= slen
;
671 fab
.fab$l_nam
= &nam
;
672 fab
.fab$l_fop
= FAB$M_NAM
;
675 nam
.nam$b_ess
= sizeof esa
;
676 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
678 /* We call SYS$PARSE to handle such things as [--] for us. */
679 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
681 slen
= nam
.nam$b_esl
;
682 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
687 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
689 /* what about when we have logical_name:???? */
690 if (src
[slen
- 1] == ':')
691 { /* Xlate logical name and see what we get */
692 ptr
= strcpy (dst
, src
); /* upper case for getenv */
695 if ('a' <= *ptr
&& *ptr
<= 'z')
699 dst
[slen
- 1] = 0; /* remove colon */
700 if (!(src
= egetenv (dst
)))
702 /* should we jump to the beginning of this procedure?
703 Good points: allows us to use logical names that xlate
705 Bad points: can be a problem if we just translated to a device
707 For now, I'll punt and always expect VMS names, and hope for
710 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
711 { /* no recursion here! */
717 { /* not a directory spec */
722 bracket
= src
[slen
- 1];
724 /* If bracket is ']' or '>', bracket - 2 is the corresponding
726 ptr
= index (src
, bracket
- 2);
728 { /* no opening bracket */
732 if (!(rptr
= rindex (src
, '.')))
735 strncpy (dst
, src
, slen
);
739 dst
[slen
++] = bracket
;
744 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
745 then translate the device and recurse. */
746 if (dst
[slen
- 1] == ':'
747 && dst
[slen
- 2] != ':' /* skip decnet nodes */
748 && strcmp (src
+ slen
, "[000000]") == 0)
750 dst
[slen
- 1] = '\0';
751 if ((ptr
= egetenv (dst
))
752 && (rlen
= strlen (ptr
) - 1) > 0
753 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
754 && ptr
[rlen
- 1] == '.')
756 char * buf
= (char *) alloca (strlen (ptr
) + 1);
760 return directory_file_name (buf
, dst
);
765 strcat (dst
, "[000000]");
769 rlen
= strlen (rptr
) - 1;
770 strncat (dst
, rptr
, rlen
);
771 dst
[slen
+ rlen
] = '\0';
772 strcat (dst
, ".DIR.1");
776 /* Process as Unix format: just remove any final slash.
777 But leave "/" unchanged; do not change it to "". */
780 /* Handle // as root for apollo's. */
781 if ((slen
> 2 && dst
[slen
- 1] == '/')
782 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
786 && IS_DIRECTORY_SEP (dst
[slen
- 1])
788 && !IS_ANY_SEP (dst
[slen
- 2])
794 CORRECT_DIR_SEPS (dst
);
799 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
801 doc
: /* Returns the file name of the directory named DIRECTORY.
802 This is the name of the file that holds the data for the directory DIRECTORY.
803 This operation exists because a directory is also a file, but its name as
804 a directory is different from its name as a file.
805 In Unix-syntax, this function just removes the final slash.
806 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
807 it returns a file name such as \"[X]Y.DIR.1\". */)
809 Lisp_Object directory
;
814 CHECK_STRING (directory
);
816 if (NILP (directory
))
819 /* If the file name has special constructs in it,
820 call the corresponding file handler. */
821 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
823 return call2 (handler
, Qdirectory_file_name
, directory
);
826 /* 20 extra chars is insufficient for VMS, since we might perform a
827 logical name translation. an equivalence string can be up to 255
828 chars long, so grab that much extra space... - sss */
829 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
831 buf
= (char *) alloca (SBYTES (directory
) + 20);
833 directory_file_name (SDATA (directory
), buf
);
834 return build_string (buf
);
837 static char make_temp_name_tbl
[64] =
839 'A','B','C','D','E','F','G','H',
840 'I','J','K','L','M','N','O','P',
841 'Q','R','S','T','U','V','W','X',
842 'Y','Z','a','b','c','d','e','f',
843 'g','h','i','j','k','l','m','n',
844 'o','p','q','r','s','t','u','v',
845 'w','x','y','z','0','1','2','3',
846 '4','5','6','7','8','9','-','_'
849 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
851 /* Value is a temporary file name starting with PREFIX, a string.
853 The Emacs process number forms part of the result, so there is
854 no danger of generating a name being used by another process.
855 In addition, this function makes an attempt to choose a name
856 which has no existing file. To make this work, PREFIX should be
857 an absolute file name.
859 BASE64_P non-zero means add the pid as 3 characters in base64
860 encoding. In this case, 6 characters will be added to PREFIX to
861 form the file name. Otherwise, if Emacs is running on a system
862 with long file names, add the pid as a decimal number.
864 This function signals an error if no unique file name could be
868 make_temp_name (prefix
, base64_p
)
875 unsigned char *p
, *data
;
879 CHECK_STRING (prefix
);
881 /* VAL is created by adding 6 characters to PREFIX. The first
882 three are the PID of this process, in base 64, and the second
883 three are incremented if the file already exists. This ensures
884 262144 unique file names per PID per PREFIX. */
886 pid
= (int) getpid ();
890 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
891 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
892 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
897 #ifdef HAVE_LONG_FILE_NAMES
898 sprintf (pidbuf
, "%d", pid
);
899 pidlen
= strlen (pidbuf
);
901 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
902 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
903 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
908 len
= SCHARS (prefix
);
909 val
= make_uninit_string (len
+ 3 + pidlen
);
911 bcopy(SDATA (prefix
), data
, len
);
914 bcopy (pidbuf
, p
, pidlen
);
917 /* Here we try to minimize useless stat'ing when this function is
918 invoked many times successively with the same PREFIX. We achieve
919 this by initializing count to a random value, and incrementing it
922 We don't want make-temp-name to be called while dumping,
923 because then make_temp_name_count_initialized_p would get set
924 and then make_temp_name_count would not be set when Emacs starts. */
926 if (!make_temp_name_count_initialized_p
)
928 make_temp_name_count
= (unsigned) time (NULL
);
929 make_temp_name_count_initialized_p
= 1;
935 unsigned num
= make_temp_name_count
;
937 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
938 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
939 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
941 /* Poor man's congruential RN generator. Replace with
942 ++make_temp_name_count for debugging. */
943 make_temp_name_count
+= 25229;
944 make_temp_name_count
%= 225307;
946 if (stat (data
, &ignored
) < 0)
948 /* We want to return only if errno is ENOENT. */
952 /* The error here is dubious, but there is little else we
953 can do. The alternatives are to return nil, which is
954 as bad as (and in many cases worse than) throwing the
955 error, or to ignore the error, which will likely result
956 in looping through 225307 stat's, which is not only
957 dog-slow, but also useless since it will fallback to
958 the errow below, anyway. */
959 report_file_error ("Cannot create temporary name for prefix",
960 Fcons (prefix
, Qnil
));
965 error ("Cannot create temporary name for prefix `%s'",
971 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
972 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
973 The Emacs process number forms part of the result,
974 so there is no danger of generating a name being used by another process.
976 In addition, this function makes an attempt to choose a name
977 which has no existing file. To make this work,
978 PREFIX should be an absolute file name.
980 There is a race condition between calling `make-temp-name' and creating the
981 file which opens all kinds of security holes. For that reason, you should
982 probably use `make-temp-file' instead, except in three circumstances:
984 * If you are creating the file in the user's home directory.
985 * If you are creating a directory rather than an ordinary file.
986 * If you are taking special precautions as `make-temp-file' does. */)
990 return make_temp_name (prefix
, 0);
995 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
996 doc
: /* Convert filename NAME to absolute, and canonicalize it.
997 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
998 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
999 the current buffer's value of default-directory is used.
1000 File name components that are `.' are removed, and
1001 so are file name components followed by `..', along with the `..' itself;
1002 note that these simplifications are done without checking the resulting
1003 file names in the file system.
1004 An initial `~/' expands to your home directory.
1005 An initial `~USER/' expands to USER's home directory.
1006 See also the function `substitute-in-file-name'. */)
1007 (name
, default_directory
)
1008 Lisp_Object name
, default_directory
;
1012 register unsigned char *newdir
, *p
, *o
;
1014 unsigned char *target
;
1017 unsigned char * colon
= 0;
1018 unsigned char * close
= 0;
1019 unsigned char * slash
= 0;
1020 unsigned char * brack
= 0;
1021 int lbrack
= 0, rbrack
= 0;
1026 int collapse_newdir
= 1;
1030 Lisp_Object handler
;
1032 CHECK_STRING (name
);
1034 /* If the file name has special constructs in it,
1035 call the corresponding file handler. */
1036 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1037 if (!NILP (handler
))
1038 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1040 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1041 if (NILP (default_directory
))
1042 default_directory
= current_buffer
->directory
;
1043 if (! STRINGP (default_directory
))
1046 /* "/" is not considered a root directory on DOS_NT, so using "/"
1047 here causes an infinite recursion in, e.g., the following:
1049 (let (default-directory)
1050 (expand-file-name "a"))
1052 To avoid this, we set default_directory to the root of the
1054 extern char *emacs_root_dir (void);
1056 default_directory
= build_string (emacs_root_dir ());
1058 default_directory
= build_string ("/");
1062 if (!NILP (default_directory
))
1064 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1065 if (!NILP (handler
))
1066 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1069 o
= SDATA (default_directory
);
1071 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1072 It would be better to do this down below where we actually use
1073 default_directory. Unfortunately, calling Fexpand_file_name recursively
1074 could invoke GC, and the strings might be relocated. This would
1075 be annoying because we have pointers into strings lying around
1076 that would need adjusting, and people would add new pointers to
1077 the code and forget to adjust them, resulting in intermittent bugs.
1078 Putting this call here avoids all that crud.
1080 The EQ test avoids infinite recursion. */
1081 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1082 /* Save time in some common cases - as long as default_directory
1083 is not relative, it can be canonicalized with name below (if it
1084 is needed at all) without requiring it to be expanded now. */
1086 /* Detect MSDOS file names with drive specifiers. */
1087 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1089 /* Detect Windows file names in UNC format. */
1090 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1092 #else /* not DOS_NT */
1093 /* Detect Unix absolute file names (/... alone is not absolute on
1095 && ! (IS_DIRECTORY_SEP (o
[0]))
1096 #endif /* not DOS_NT */
1099 struct gcpro gcpro1
;
1102 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1107 /* Filenames on VMS are always upper case. */
1108 name
= Fupcase (name
);
1110 #ifdef FILE_SYSTEM_CASE
1111 name
= FILE_SYSTEM_CASE (name
);
1117 /* We will force directory separators to be either all \ or /, so make
1118 a local copy to modify, even if there ends up being no change. */
1119 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1121 /* Note if special escape prefix is present, but remove for now. */
1122 if (nm
[0] == '/' && nm
[1] == ':')
1128 /* Find and remove drive specifier if present; this makes nm absolute
1129 even if the rest of the name appears to be relative. Only look for
1130 drive specifier at the beginning. */
1131 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1138 /* If we see "c://somedir", we want to strip the first slash after the
1139 colon when stripping the drive letter. Otherwise, this expands to
1141 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1143 #endif /* WINDOWSNT */
1147 /* Discard any previous drive specifier if nm is now in UNC format. */
1148 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1154 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1155 none are found, we can probably return right away. We will avoid
1156 allocating a new string if name is already fully expanded. */
1158 IS_DIRECTORY_SEP (nm
[0])
1160 && drive
&& !is_escaped
1163 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1170 /* If it turns out that the filename we want to return is just a
1171 suffix of FILENAME, we don't need to go through and edit
1172 things; we just need to construct a new string using data
1173 starting at the middle of FILENAME. If we set lose to a
1174 non-zero value, that means we've discovered that we can't do
1181 /* Since we know the name is absolute, we can assume that each
1182 element starts with a "/". */
1184 /* "." and ".." are hairy. */
1185 if (IS_DIRECTORY_SEP (p
[0])
1187 && (IS_DIRECTORY_SEP (p
[2])
1189 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1192 /* We want to replace multiple `/' in a row with a single
1195 && IS_DIRECTORY_SEP (p
[0])
1196 && IS_DIRECTORY_SEP (p
[1]))
1203 /* if dev:[dir]/, move nm to / */
1204 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1205 nm
= (brack
? brack
+ 1 : colon
+ 1);
1206 lbrack
= rbrack
= 0;
1214 /* VMS pre V4.4,convert '-'s in filenames. */
1215 if (lbrack
== rbrack
)
1217 if (dots
< 2) /* this is to allow negative version numbers */
1222 if (lbrack
> rbrack
&&
1223 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1224 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1230 /* count open brackets, reset close bracket pointer */
1231 if (p
[0] == '[' || p
[0] == '<')
1232 lbrack
++, brack
= 0;
1233 /* count close brackets, set close bracket pointer */
1234 if (p
[0] == ']' || p
[0] == '>')
1235 rbrack
++, brack
= p
;
1236 /* detect ][ or >< */
1237 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1239 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1240 nm
= p
+ 1, lose
= 1;
1241 if (p
[0] == ':' && (colon
|| slash
))
1242 /* if dev1:[dir]dev2:, move nm to dev2: */
1248 /* if /name/dev:, move nm to dev: */
1251 /* if node::dev:, move colon following dev */
1252 else if (colon
&& colon
[-1] == ':')
1254 /* if dev1:dev2:, move nm to dev2: */
1255 else if (colon
&& colon
[-1] != ':')
1260 if (p
[0] == ':' && !colon
)
1266 if (lbrack
== rbrack
)
1269 else if (p
[0] == '.')
1277 if (index (nm
, '/'))
1278 return build_string (sys_translate_unix (nm
));
1281 /* Make sure directories are all separated with / or \ as
1282 desired, but avoid allocation of a new string when not
1284 CORRECT_DIR_SEPS (nm
);
1286 if (IS_DIRECTORY_SEP (nm
[1]))
1288 if (strcmp (nm
, SDATA (name
)) != 0)
1289 name
= build_string (nm
);
1293 /* drive must be set, so this is okay */
1294 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1296 name
= make_string (nm
- 2, p
- nm
+ 2);
1297 SSET (name
, 0, DRIVE_LETTER (drive
));
1298 SSET (name
, 1, ':');
1301 #else /* not DOS_NT */
1302 if (nm
== SDATA (name
))
1304 return build_string (nm
);
1305 #endif /* not DOS_NT */
1309 /* At this point, nm might or might not be an absolute file name. We
1310 need to expand ~ or ~user if present, otherwise prefix nm with
1311 default_directory if nm is not absolute, and finally collapse /./
1312 and /foo/../ sequences.
1314 We set newdir to be the appropriate prefix if one is needed:
1315 - the relevant user directory if nm starts with ~ or ~user
1316 - the specified drive's working dir (DOS/NT only) if nm does not
1318 - the value of default_directory.
1320 Note that these prefixes are not guaranteed to be absolute (except
1321 for the working dir of a drive). Therefore, to ensure we always
1322 return an absolute name, if the final prefix is not absolute we
1323 append it to the current working directory. */
1327 if (nm
[0] == '~') /* prefix ~ */
1329 if (IS_DIRECTORY_SEP (nm
[1])
1333 || nm
[1] == 0) /* ~ by itself */
1335 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1336 newdir
= (unsigned char *) "";
1339 collapse_newdir
= 0;
1342 nm
++; /* Don't leave the slash in nm. */
1345 else /* ~user/filename */
1347 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1352 o
= (unsigned char *) alloca (p
- nm
+ 1);
1353 bcopy ((char *) nm
, o
, p
- nm
);
1356 pw
= (struct passwd
*) getpwnam (o
+ 1);
1359 newdir
= (unsigned char *) pw
-> pw_dir
;
1361 nm
= p
+ 1; /* skip the terminator */
1365 collapse_newdir
= 0;
1370 /* If we don't find a user of that name, leave the name
1371 unchanged; don't move nm forward to p. */
1376 /* On DOS and Windows, nm is absolute if a drive name was specified;
1377 use the drive's current directory as the prefix if needed. */
1378 if (!newdir
&& drive
)
1380 /* Get default directory if needed to make nm absolute. */
1381 if (!IS_DIRECTORY_SEP (nm
[0]))
1383 newdir
= alloca (MAXPATHLEN
+ 1);
1384 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1389 /* Either nm starts with /, or drive isn't mounted. */
1390 newdir
= alloca (4);
1391 newdir
[0] = DRIVE_LETTER (drive
);
1399 /* Finally, if no prefix has been specified and nm is not absolute,
1400 then it must be expanded relative to default_directory. */
1404 /* /... alone is not absolute on DOS and Windows. */
1405 && !IS_DIRECTORY_SEP (nm
[0])
1408 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1415 newdir
= SDATA (default_directory
);
1417 /* Note if special escape prefix is present, but remove for now. */
1418 if (newdir
[0] == '/' && newdir
[1] == ':')
1429 /* First ensure newdir is an absolute name. */
1431 /* Detect MSDOS file names with drive specifiers. */
1432 ! (IS_DRIVE (newdir
[0])
1433 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1435 /* Detect Windows file names in UNC format. */
1436 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1440 /* Effectively, let newdir be (expand-file-name newdir cwd).
1441 Because of the admonition against calling expand-file-name
1442 when we have pointers into lisp strings, we accomplish this
1443 indirectly by prepending newdir to nm if necessary, and using
1444 cwd (or the wd of newdir's drive) as the new newdir. */
1446 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1451 if (!IS_DIRECTORY_SEP (nm
[0]))
1453 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1454 file_name_as_directory (tmp
, newdir
);
1458 newdir
= alloca (MAXPATHLEN
+ 1);
1461 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1468 /* Strip off drive name from prefix, if present. */
1469 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1475 /* Keep only a prefix from newdir if nm starts with slash
1476 (//server/share for UNC, nothing otherwise). */
1477 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1480 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1482 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1484 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1486 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1498 /* Get rid of any slash at the end of newdir, unless newdir is
1499 just / or // (an incomplete UNC name). */
1500 length
= strlen (newdir
);
1501 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1503 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1507 unsigned char *temp
= (unsigned char *) alloca (length
);
1508 bcopy (newdir
, temp
, length
- 1);
1509 temp
[length
- 1] = 0;
1517 /* Now concatenate the directory and name to new space in the stack frame */
1518 tlen
+= strlen (nm
) + 1;
1520 /* Reserve space for drive specifier and escape prefix, since either
1521 or both may need to be inserted. (The Microsoft x86 compiler
1522 produces incorrect code if the following two lines are combined.) */
1523 target
= (unsigned char *) alloca (tlen
+ 4);
1525 #else /* not DOS_NT */
1526 target
= (unsigned char *) alloca (tlen
);
1527 #endif /* not DOS_NT */
1533 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1536 /* If newdir is effectively "C:/", then the drive letter will have
1537 been stripped and newdir will be "/". Concatenating with an
1538 absolute directory in nm produces "//", which will then be
1539 incorrectly treated as a network share. Ignore newdir in
1540 this case (keeping the drive letter). */
1541 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1542 && newdir
[1] == '\0'))
1544 strcpy (target
, newdir
);
1548 file_name_as_directory (target
, newdir
);
1551 strcat (target
, nm
);
1553 if (index (target
, '/'))
1554 strcpy (target
, sys_translate_unix (target
));
1557 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1559 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1568 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1574 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1575 /* brackets are offset from each other by 2 */
1578 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1579 /* convert [foo][bar] to [bar] */
1580 while (o
[-1] != '[' && o
[-1] != '<')
1582 else if (*p
== '-' && *o
!= '.')
1585 else if (p
[0] == '-' && o
[-1] == '.' &&
1586 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1587 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1591 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1592 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1594 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1596 /* else [foo.-] ==> [-] */
1602 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1603 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1609 if (!IS_DIRECTORY_SEP (*p
))
1613 else if (IS_DIRECTORY_SEP (p
[0])
1615 && (IS_DIRECTORY_SEP (p
[2])
1618 /* If "/." is the entire filename, keep the "/". Otherwise,
1619 just delete the whole "/.". */
1620 if (o
== target
&& p
[2] == '\0')
1624 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1625 /* `/../' is the "superroot" on certain file systems. */
1627 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1629 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1631 /* Keep initial / only if this is the whole name. */
1632 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1637 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1639 /* Collapse multiple `/' in a row. */
1641 while (IS_DIRECTORY_SEP (*p
))
1648 #endif /* not VMS */
1652 /* At last, set drive name. */
1654 /* Except for network file name. */
1655 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1656 #endif /* WINDOWSNT */
1658 if (!drive
) abort ();
1660 target
[0] = DRIVE_LETTER (drive
);
1663 /* Reinsert the escape prefix if required. */
1670 CORRECT_DIR_SEPS (target
);
1673 return make_string (target
, o
- target
);
1677 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1678 This is the old version of expand-file-name, before it was thoroughly
1679 rewritten for Emacs 10.31. We leave this version here commented-out,
1680 because the code is very complex and likely to have subtle bugs. If
1681 bugs _are_ found, it might be of interest to look at the old code and
1682 see what did it do in the relevant situation.
1684 Don't remove this code: it's true that it will be accessible via CVS,
1685 but a few years from deletion, people will forget it is there. */
1687 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1688 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1689 "Convert FILENAME to absolute, and canonicalize it.\n\
1690 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1691 (does not start with slash); if DEFAULT is nil or missing,\n\
1692 the current buffer's value of default-directory is used.\n\
1693 Filenames containing `.' or `..' as components are simplified;\n\
1694 initial `~/' expands to your home directory.\n\
1695 See also the function `substitute-in-file-name'.")
1697 Lisp_Object name
, defalt
;
1701 register unsigned char *newdir
, *p
, *o
;
1703 unsigned char *target
;
1707 unsigned char * colon
= 0;
1708 unsigned char * close
= 0;
1709 unsigned char * slash
= 0;
1710 unsigned char * brack
= 0;
1711 int lbrack
= 0, rbrack
= 0;
1715 CHECK_STRING (name
);
1718 /* Filenames on VMS are always upper case. */
1719 name
= Fupcase (name
);
1724 /* If nm is absolute, flush ...// and detect /./ and /../.
1725 If no /./ or /../ we can return right away. */
1737 if (p
[0] == '/' && p
[1] == '/'
1739 /* // at start of filename is meaningful on Apollo system. */
1744 if (p
[0] == '/' && p
[1] == '~')
1745 nm
= p
+ 1, lose
= 1;
1746 if (p
[0] == '/' && p
[1] == '.'
1747 && (p
[2] == '/' || p
[2] == 0
1748 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1754 /* if dev:[dir]/, move nm to / */
1755 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1756 nm
= (brack
? brack
+ 1 : colon
+ 1);
1757 lbrack
= rbrack
= 0;
1765 /* VMS pre V4.4,convert '-'s in filenames. */
1766 if (lbrack
== rbrack
)
1768 if (dots
< 2) /* this is to allow negative version numbers */
1773 if (lbrack
> rbrack
&&
1774 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1775 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1781 /* count open brackets, reset close bracket pointer */
1782 if (p
[0] == '[' || p
[0] == '<')
1783 lbrack
++, brack
= 0;
1784 /* count close brackets, set close bracket pointer */
1785 if (p
[0] == ']' || p
[0] == '>')
1786 rbrack
++, brack
= p
;
1787 /* detect ][ or >< */
1788 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1790 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1791 nm
= p
+ 1, lose
= 1;
1792 if (p
[0] == ':' && (colon
|| slash
))
1793 /* if dev1:[dir]dev2:, move nm to dev2: */
1799 /* If /name/dev:, move nm to dev: */
1802 /* If node::dev:, move colon following dev */
1803 else if (colon
&& colon
[-1] == ':')
1805 /* If dev1:dev2:, move nm to dev2: */
1806 else if (colon
&& colon
[-1] != ':')
1811 if (p
[0] == ':' && !colon
)
1817 if (lbrack
== rbrack
)
1820 else if (p
[0] == '.')
1828 if (index (nm
, '/'))
1829 return build_string (sys_translate_unix (nm
));
1831 if (nm
== SDATA (name
))
1833 return build_string (nm
);
1837 /* Now determine directory to start with and put it in NEWDIR */
1841 if (nm
[0] == '~') /* prefix ~ */
1846 || nm
[1] == 0)/* ~/filename */
1848 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1849 newdir
= (unsigned char *) "";
1852 nm
++; /* Don't leave the slash in nm. */
1855 else /* ~user/filename */
1857 /* Get past ~ to user */
1858 unsigned char *user
= nm
+ 1;
1859 /* Find end of name. */
1860 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1861 int len
= ptr
? ptr
- user
: strlen (user
);
1863 unsigned char *ptr1
= index (user
, ':');
1864 if (ptr1
!= 0 && ptr1
- user
< len
)
1867 /* Copy the user name into temp storage. */
1868 o
= (unsigned char *) alloca (len
+ 1);
1869 bcopy ((char *) user
, o
, len
);
1872 /* Look up the user name. */
1873 pw
= (struct passwd
*) getpwnam (o
+ 1);
1875 error ("\"%s\" isn't a registered user", o
+ 1);
1877 newdir
= (unsigned char *) pw
->pw_dir
;
1879 /* Discard the user name from NM. */
1886 #endif /* not VMS */
1890 defalt
= current_buffer
->directory
;
1891 CHECK_STRING (defalt
);
1892 newdir
= SDATA (defalt
);
1895 /* Now concatenate the directory and name to new space in the stack frame */
1897 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1898 target
= (unsigned char *) alloca (tlen
);
1904 if (nm
[0] == 0 || nm
[0] == '/')
1905 strcpy (target
, newdir
);
1908 file_name_as_directory (target
, newdir
);
1911 strcat (target
, nm
);
1913 if (index (target
, '/'))
1914 strcpy (target
, sys_translate_unix (target
));
1917 /* Now canonicalize by removing /. and /foo/.. if they appear */
1925 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1931 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1932 /* brackets are offset from each other by 2 */
1935 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1936 /* convert [foo][bar] to [bar] */
1937 while (o
[-1] != '[' && o
[-1] != '<')
1939 else if (*p
== '-' && *o
!= '.')
1942 else if (p
[0] == '-' && o
[-1] == '.' &&
1943 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1944 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1948 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1949 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1951 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1953 /* else [foo.-] ==> [-] */
1959 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1960 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1970 else if (!strncmp (p
, "//", 2)
1972 /* // at start of filename is meaningful in Apollo system. */
1980 else if (p
[0] == '/' && p
[1] == '.' &&
1981 (p
[2] == '/' || p
[2] == 0))
1983 else if (!strncmp (p
, "/..", 3)
1984 /* `/../' is the "superroot" on certain file systems. */
1986 && (p
[3] == '/' || p
[3] == 0))
1988 while (o
!= target
&& *--o
!= '/')
1991 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1995 if (o
== target
&& *o
== '/')
2003 #endif /* not VMS */
2006 return make_string (target
, o
- target
);
2010 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2011 Ssubstitute_in_file_name
, 1, 1, 0,
2012 doc
: /* Substitute environment variables referred to in FILENAME.
2013 `$FOO' where FOO is an environment variable name means to substitute
2014 the value of that variable. The variable name should be terminated
2015 with a character not a letter, digit or underscore; otherwise, enclose
2016 the entire variable name in braces.
2017 If `/~' appears, all of FILENAME through that `/' is discarded.
2019 On VMS, `$' substitution is not done; this function does little and only
2020 duplicates what `expand-file-name' does. */)
2022 Lisp_Object filename
;
2026 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2027 unsigned char *target
= NULL
;
2029 int substituted
= 0;
2032 Lisp_Object handler
;
2034 CHECK_STRING (filename
);
2036 /* If the file name has special constructs in it,
2037 call the corresponding file handler. */
2038 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2039 if (!NILP (handler
))
2040 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2042 nm
= SDATA (filename
);
2044 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2045 CORRECT_DIR_SEPS (nm
);
2046 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2048 endp
= nm
+ SBYTES (filename
);
2050 /* If /~ or // appears, discard everything through first slash. */
2052 for (p
= nm
; p
!= endp
; p
++)
2055 #if defined (APOLLO) || defined (WINDOWSNT)
2056 /* // at start of file name is meaningful in Apollo and
2057 WindowsNT systems. */
2058 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2059 #else /* not (APOLLO || WINDOWSNT) */
2060 || IS_DIRECTORY_SEP (p
[0])
2061 #endif /* not (APOLLO || WINDOWSNT) */
2066 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2068 || IS_DIRECTORY_SEP (p
[-1])))
2070 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2075 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2077 o
= (unsigned char *) alloca (s
- p
+ 1);
2078 bcopy ((char *) p
, o
, s
- p
);
2081 pw
= (struct passwd
*) getpwnam (o
+ 1);
2083 /* If we have ~/ or ~user and `user' exists, discard
2084 everything up to ~. But if `user' does not exist, leave
2085 ~user alone, it might be a literal file name. */
2086 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2093 /* see comment in expand-file-name about drive specifiers */
2094 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2095 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2104 return build_string (nm
);
2107 /* See if any variables are substituted into the string
2108 and find the total length of their values in `total' */
2110 for (p
= nm
; p
!= endp
;)
2120 /* "$$" means a single "$" */
2129 while (p
!= endp
&& *p
!= '}') p
++;
2130 if (*p
!= '}') goto missingclose
;
2136 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2140 /* Copy out the variable name */
2141 target
= (unsigned char *) alloca (s
- o
+ 1);
2142 strncpy (target
, o
, s
- o
);
2145 strupr (target
); /* $home == $HOME etc. */
2148 /* Get variable value */
2149 o
= (unsigned char *) egetenv (target
);
2152 total
+= strlen (o
);
2162 /* If substitution required, recopy the string and do it */
2163 /* Make space in stack frame for the new copy */
2164 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2167 /* Copy the rest of the name through, replacing $ constructs with values */
2184 while (p
!= endp
&& *p
!= '}') p
++;
2185 if (*p
!= '}') goto missingclose
;
2191 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2195 /* Copy out the variable name */
2196 target
= (unsigned char *) alloca (s
- o
+ 1);
2197 strncpy (target
, o
, s
- o
);
2200 strupr (target
); /* $home == $HOME etc. */
2203 /* Get variable value */
2204 o
= (unsigned char *) egetenv (target
);
2208 strcpy (x
, target
); x
+= strlen (target
);
2210 else if (STRING_MULTIBYTE (filename
))
2212 /* If the original string is multibyte,
2213 convert what we substitute into multibyte. */
2216 int c
= unibyte_char_to_multibyte (*o
++);
2217 x
+= CHAR_STRING (c
, x
);
2229 /* If /~ or // appears, discard everything through first slash. */
2231 for (p
= xnm
; p
!= x
; p
++)
2233 #if defined (APOLLO) || defined (WINDOWSNT)
2234 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2235 #else /* not (APOLLO || WINDOWSNT) */
2236 || IS_DIRECTORY_SEP (p
[0])
2237 #endif /* not (APOLLO || WINDOWSNT) */
2239 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2242 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2243 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2247 if (STRING_MULTIBYTE (filename
))
2248 return make_string (xnm
, x
- xnm
);
2249 return make_unibyte_string (xnm
, x
- xnm
);
2252 error ("Bad format environment-variable substitution");
2254 error ("Missing \"}\" in environment-variable substitution");
2256 error ("Substituting nonexistent environment variable \"%s\"", target
);
2259 #endif /* not VMS */
2263 /* A slightly faster and more convenient way to get
2264 (directory-file-name (expand-file-name FOO)). */
2267 expand_and_dir_to_file (filename
, defdir
)
2268 Lisp_Object filename
, defdir
;
2270 register Lisp_Object absname
;
2272 absname
= Fexpand_file_name (filename
, defdir
);
2275 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2276 if (c
== ':' || c
== ']' || c
== '>')
2277 absname
= Fdirectory_file_name (absname
);
2280 /* Remove final slash, if any (unless this is the root dir).
2281 stat behaves differently depending! */
2282 if (SCHARS (absname
) > 1
2283 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2284 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2285 /* We cannot take shortcuts; they might be wrong for magic file names. */
2286 absname
= Fdirectory_file_name (absname
);
2291 /* Signal an error if the file ABSNAME already exists.
2292 If INTERACTIVE is nonzero, ask the user whether to proceed,
2293 and bypass the error if the user says to go ahead.
2294 QUERYSTRING is a name for the action that is being considered
2297 *STATPTR is used to store the stat information if the file exists.
2298 If the file does not exist, STATPTR->st_mode is set to 0.
2299 If STATPTR is null, we don't store into it.
2301 If QUICK is nonzero, we ask for y or n, not yes or no. */
2304 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2305 Lisp_Object absname
;
2306 unsigned char *querystring
;
2308 struct stat
*statptr
;
2311 register Lisp_Object tem
, encoded_filename
;
2312 struct stat statbuf
;
2313 struct gcpro gcpro1
;
2315 encoded_filename
= ENCODE_FILE (absname
);
2317 /* stat is a good way to tell whether the file exists,
2318 regardless of what access permissions it has. */
2319 if (stat (SDATA (encoded_filename
), &statbuf
) >= 0)
2322 Fsignal (Qfile_already_exists
,
2323 Fcons (build_string ("File already exists"),
2324 Fcons (absname
, Qnil
)));
2326 tem
= format1 ("File %s already exists; %s anyway? ",
2327 SDATA (absname
), querystring
);
2329 tem
= Fy_or_n_p (tem
);
2331 tem
= do_yes_or_no_p (tem
);
2334 Fsignal (Qfile_already_exists
,
2335 Fcons (build_string ("File already exists"),
2336 Fcons (absname
, Qnil
)));
2343 statptr
->st_mode
= 0;
2348 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2349 "fCopy file: \nFCopy %s to file: \np\nP",
2350 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2351 If NEWNAME names a directory, copy FILE there.
2352 Signals a `file-already-exists' error if file NEWNAME already exists,
2353 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2354 A number as third arg means request confirmation if NEWNAME already exists.
2355 This is what happens in interactive use with M-x.
2356 Fourth arg KEEP-TIME non-nil means give the new file the same
2357 last-modified time as the old one. (This works on only some systems.)
2358 A prefix arg makes KEEP-TIME non-nil. */)
2359 (file
, newname
, ok_if_already_exists
, keep_time
)
2360 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2363 char buf
[16 * 1024];
2364 struct stat st
, out_st
;
2365 Lisp_Object handler
;
2366 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2367 int count
= SPECPDL_INDEX ();
2368 int input_file_statable_p
;
2369 Lisp_Object encoded_file
, encoded_newname
;
2371 encoded_file
= encoded_newname
= Qnil
;
2372 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2373 CHECK_STRING (file
);
2374 CHECK_STRING (newname
);
2376 if (!NILP (Ffile_directory_p (newname
)))
2377 newname
= Fexpand_file_name (file
, newname
);
2379 newname
= Fexpand_file_name (newname
, Qnil
);
2381 file
= Fexpand_file_name (file
, Qnil
);
2383 /* If the input file name has special constructs in it,
2384 call the corresponding file handler. */
2385 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2386 /* Likewise for output file name. */
2388 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2389 if (!NILP (handler
))
2390 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2391 ok_if_already_exists
, keep_time
));
2393 encoded_file
= ENCODE_FILE (file
);
2394 encoded_newname
= ENCODE_FILE (newname
);
2396 if (NILP (ok_if_already_exists
)
2397 || INTEGERP (ok_if_already_exists
))
2398 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2399 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2400 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2404 if (!CopyFile (SDATA (encoded_file
),
2405 SDATA (encoded_newname
),
2407 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2408 else if (!NILP (keep_time
))
2414 EMACS_GET_TIME (now
);
2415 filename
= SDATA (encoded_newname
);
2417 /* Ensure file is writable while its modified time is set. */
2418 attributes
= GetFileAttributes (filename
);
2419 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2420 if (set_file_times (filename
, now
, now
))
2422 /* Restore original attributes. */
2423 SetFileAttributes (filename
, attributes
);
2424 Fsignal (Qfile_date_error
,
2425 Fcons (build_string ("Cannot set file date"),
2426 Fcons (newname
, Qnil
)));
2428 /* Restore original attributes. */
2429 SetFileAttributes (filename
, attributes
);
2431 #else /* not WINDOWSNT */
2433 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2437 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2439 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2441 /* We can only copy regular files and symbolic links. Other files are not
2443 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2445 #if !defined (DOS_NT) || __DJGPP__ > 1
2446 if (out_st
.st_mode
!= 0
2447 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2450 report_file_error ("Input and output files are the same",
2451 Fcons (file
, Fcons (newname
, Qnil
)));
2455 #if defined (S_ISREG) && defined (S_ISLNK)
2456 if (input_file_statable_p
)
2458 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2460 #if defined (EISDIR)
2461 /* Get a better looking error message. */
2464 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2467 #endif /* S_ISREG && S_ISLNK */
2470 /* Create the copy file with the same record format as the input file */
2471 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2474 /* System's default file type was set to binary by _fmode in emacs.c. */
2475 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2476 #else /* not MSDOS */
2477 ofd
= creat (SDATA (encoded_newname
), 0666);
2478 #endif /* not MSDOS */
2481 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2483 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2487 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2488 if (emacs_write (ofd
, buf
, n
) != n
)
2489 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2492 /* Closing the output clobbers the file times on some systems. */
2493 if (emacs_close (ofd
) < 0)
2494 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2496 if (input_file_statable_p
)
2498 if (!NILP (keep_time
))
2500 EMACS_TIME atime
, mtime
;
2501 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2502 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2503 if (set_file_times (SDATA (encoded_newname
),
2505 Fsignal (Qfile_date_error
,
2506 Fcons (build_string ("Cannot set file date"),
2507 Fcons (newname
, Qnil
)));
2510 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2512 #if defined (__DJGPP__) && __DJGPP__ > 1
2513 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2514 and if it can't, it tells so. Otherwise, under MSDOS we usually
2515 get only the READ bit, which will make the copied file read-only,
2516 so it's better not to chmod at all. */
2517 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2518 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2519 #endif /* DJGPP version 2 or newer */
2524 #endif /* WINDOWSNT */
2526 /* Discard the unwind protects. */
2527 specpdl_ptr
= specpdl
+ count
;
2533 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2534 Smake_directory_internal
, 1, 1, 0,
2535 doc
: /* Create a new directory named DIRECTORY. */)
2537 Lisp_Object directory
;
2539 const unsigned char *dir
;
2540 Lisp_Object handler
;
2541 Lisp_Object encoded_dir
;
2543 CHECK_STRING (directory
);
2544 directory
= Fexpand_file_name (directory
, Qnil
);
2546 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2547 if (!NILP (handler
))
2548 return call2 (handler
, Qmake_directory_internal
, directory
);
2550 encoded_dir
= ENCODE_FILE (directory
);
2552 dir
= SDATA (encoded_dir
);
2555 if (mkdir (dir
) != 0)
2557 if (mkdir (dir
, 0777) != 0)
2559 report_file_error ("Creating directory", Flist (1, &directory
));
2564 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2565 doc
: /* Delete the directory named DIRECTORY. */)
2567 Lisp_Object directory
;
2569 const unsigned char *dir
;
2570 Lisp_Object handler
;
2571 Lisp_Object encoded_dir
;
2573 CHECK_STRING (directory
);
2574 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2576 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2577 if (!NILP (handler
))
2578 return call2 (handler
, Qdelete_directory
, directory
);
2580 encoded_dir
= ENCODE_FILE (directory
);
2582 dir
= SDATA (encoded_dir
);
2584 if (rmdir (dir
) != 0)
2585 report_file_error ("Removing directory", Flist (1, &directory
));
2590 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2591 doc
: /* Delete file named FILENAME.
2592 If file has multiple names, it continues to exist with the other names. */)
2594 Lisp_Object filename
;
2596 Lisp_Object handler
;
2597 Lisp_Object encoded_file
;
2599 CHECK_STRING (filename
);
2600 filename
= Fexpand_file_name (filename
, Qnil
);
2602 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2603 if (!NILP (handler
))
2604 return call2 (handler
, Qdelete_file
, filename
);
2606 encoded_file
= ENCODE_FILE (filename
);
2608 if (0 > unlink (SDATA (encoded_file
)))
2609 report_file_error ("Removing old name", Flist (1, &filename
));
2614 internal_delete_file_1 (ignore
)
2620 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2623 internal_delete_file (filename
)
2624 Lisp_Object filename
;
2626 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2627 Qt
, internal_delete_file_1
));
2630 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2631 "fRename file: \nFRename %s to file: \np",
2632 doc
: /* Rename FILE as NEWNAME. Both args strings.
2633 If file has names other than FILE, it continues to have those names.
2634 Signals a `file-already-exists' error if a file NEWNAME already exists
2635 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2636 A number as third arg means request confirmation if NEWNAME already exists.
2637 This is what happens in interactive use with M-x. */)
2638 (file
, newname
, ok_if_already_exists
)
2639 Lisp_Object file
, newname
, ok_if_already_exists
;
2642 Lisp_Object args
[2];
2644 Lisp_Object handler
;
2645 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2646 Lisp_Object encoded_file
, encoded_newname
;
2648 encoded_file
= encoded_newname
= Qnil
;
2649 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2650 CHECK_STRING (file
);
2651 CHECK_STRING (newname
);
2652 file
= Fexpand_file_name (file
, Qnil
);
2653 newname
= Fexpand_file_name (newname
, Qnil
);
2655 /* If the file name has special constructs in it,
2656 call the corresponding file handler. */
2657 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2659 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2660 if (!NILP (handler
))
2661 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2662 file
, newname
, ok_if_already_exists
));
2664 encoded_file
= ENCODE_FILE (file
);
2665 encoded_newname
= ENCODE_FILE (newname
);
2668 /* If the file names are identical but for the case, don't ask for
2669 confirmation: they simply want to change the letter-case of the
2671 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2673 if (NILP (ok_if_already_exists
)
2674 || INTEGERP (ok_if_already_exists
))
2675 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2676 INTEGERP (ok_if_already_exists
), 0, 0);
2678 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2680 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2681 || 0 > unlink (SDATA (encoded_file
)))
2686 Fcopy_file (file
, newname
,
2687 /* We have already prompted if it was an integer,
2688 so don't have copy-file prompt again. */
2689 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2690 Fdelete_file (file
);
2697 report_file_error ("Renaming", Flist (2, args
));
2700 report_file_error ("Renaming", Flist (2, &file
));
2707 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2708 "fAdd name to file: \nFName to add to %s: \np",
2709 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2710 Signals a `file-already-exists' error if a file NEWNAME already exists
2711 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2712 A number as third arg means request confirmation if NEWNAME already exists.
2713 This is what happens in interactive use with M-x. */)
2714 (file
, newname
, ok_if_already_exists
)
2715 Lisp_Object file
, newname
, ok_if_already_exists
;
2718 Lisp_Object args
[2];
2720 Lisp_Object handler
;
2721 Lisp_Object encoded_file
, encoded_newname
;
2722 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2724 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2725 encoded_file
= encoded_newname
= Qnil
;
2726 CHECK_STRING (file
);
2727 CHECK_STRING (newname
);
2728 file
= Fexpand_file_name (file
, Qnil
);
2729 newname
= Fexpand_file_name (newname
, Qnil
);
2731 /* If the file name has special constructs in it,
2732 call the corresponding file handler. */
2733 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2734 if (!NILP (handler
))
2735 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2736 newname
, ok_if_already_exists
));
2738 /* If the new name has special constructs in it,
2739 call the corresponding file handler. */
2740 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2741 if (!NILP (handler
))
2742 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2743 newname
, ok_if_already_exists
));
2745 encoded_file
= ENCODE_FILE (file
);
2746 encoded_newname
= ENCODE_FILE (newname
);
2748 if (NILP (ok_if_already_exists
)
2749 || INTEGERP (ok_if_already_exists
))
2750 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2751 INTEGERP (ok_if_already_exists
), 0, 0);
2753 unlink (SDATA (newname
));
2754 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2759 report_file_error ("Adding new name", Flist (2, args
));
2761 report_file_error ("Adding new name", Flist (2, &file
));
2770 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2771 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2772 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2773 Signals a `file-already-exists' error if a file LINKNAME already exists
2774 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2775 A number as third arg means request confirmation if LINKNAME already exists.
2776 This happens for interactive use with M-x. */)
2777 (filename
, linkname
, ok_if_already_exists
)
2778 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2781 Lisp_Object args
[2];
2783 Lisp_Object handler
;
2784 Lisp_Object encoded_filename
, encoded_linkname
;
2785 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2787 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2788 encoded_filename
= encoded_linkname
= Qnil
;
2789 CHECK_STRING (filename
);
2790 CHECK_STRING (linkname
);
2791 /* If the link target has a ~, we must expand it to get
2792 a truly valid file name. Otherwise, do not expand;
2793 we want to permit links to relative file names. */
2794 if (SREF (filename
, 0) == '~')
2795 filename
= Fexpand_file_name (filename
, Qnil
);
2796 linkname
= Fexpand_file_name (linkname
, Qnil
);
2798 /* If the file name has special constructs in it,
2799 call the corresponding file handler. */
2800 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2801 if (!NILP (handler
))
2802 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2803 linkname
, ok_if_already_exists
));
2805 /* If the new link name has special constructs in it,
2806 call the corresponding file handler. */
2807 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2808 if (!NILP (handler
))
2809 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2810 linkname
, ok_if_already_exists
));
2812 encoded_filename
= ENCODE_FILE (filename
);
2813 encoded_linkname
= ENCODE_FILE (linkname
);
2815 if (NILP (ok_if_already_exists
)
2816 || INTEGERP (ok_if_already_exists
))
2817 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2818 INTEGERP (ok_if_already_exists
), 0, 0);
2819 if (0 > symlink (SDATA (encoded_filename
),
2820 SDATA (encoded_linkname
)))
2822 /* If we didn't complain already, silently delete existing file. */
2823 if (errno
== EEXIST
)
2825 unlink (SDATA (encoded_linkname
));
2826 if (0 <= symlink (SDATA (encoded_filename
),
2827 SDATA (encoded_linkname
)))
2837 report_file_error ("Making symbolic link", Flist (2, args
));
2839 report_file_error ("Making symbolic link", Flist (2, &filename
));
2845 #endif /* S_IFLNK */
2849 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2850 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2851 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2852 If STRING is nil or a null string, the logical name NAME is deleted. */)
2857 CHECK_STRING (name
);
2859 delete_logical_name (SDATA (name
));
2862 CHECK_STRING (string
);
2864 if (SCHARS (string
) == 0)
2865 delete_logical_name (SDATA (name
));
2867 define_logical_name (SDATA (name
), SDATA (string
));
2876 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2877 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2879 Lisp_Object path
, login
;
2883 CHECK_STRING (path
);
2884 CHECK_STRING (login
);
2886 netresult
= netunam (SDATA (path
), SDATA (login
));
2888 if (netresult
== -1)
2893 #endif /* HPUX_NET */
2895 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2897 doc
: /* Return t if file FILENAME specifies an absolute file name.
2898 On Unix, this is a name starting with a `/' or a `~'. */)
2900 Lisp_Object filename
;
2902 const unsigned char *ptr
;
2904 CHECK_STRING (filename
);
2905 ptr
= SDATA (filename
);
2906 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2908 /* ??? This criterion is probably wrong for '<'. */
2909 || index (ptr
, ':') || index (ptr
, '<')
2910 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2914 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2922 /* Return nonzero if file FILENAME exists and can be executed. */
2925 check_executable (filename
)
2929 int len
= strlen (filename
);
2932 if (stat (filename
, &st
) < 0)
2934 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2935 return ((st
.st_mode
& S_IEXEC
) != 0);
2937 return (S_ISREG (st
.st_mode
)
2939 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2940 || stricmp (suffix
, ".exe") == 0
2941 || stricmp (suffix
, ".bat") == 0)
2942 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2943 #endif /* not WINDOWSNT */
2944 #else /* not DOS_NT */
2945 #ifdef HAVE_EUIDACCESS
2946 return (euidaccess (filename
, 1) >= 0);
2948 /* Access isn't quite right because it uses the real uid
2949 and we really want to test with the effective uid.
2950 But Unix doesn't give us a right way to do it. */
2951 return (access (filename
, 1) >= 0);
2953 #endif /* not DOS_NT */
2956 /* Return nonzero if file FILENAME exists and can be written. */
2959 check_writable (filename
)
2964 if (stat (filename
, &st
) < 0)
2966 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2967 #else /* not MSDOS */
2968 #ifdef HAVE_EUIDACCESS
2969 return (euidaccess (filename
, 2) >= 0);
2971 /* Access isn't quite right because it uses the real uid
2972 and we really want to test with the effective uid.
2973 But Unix doesn't give us a right way to do it.
2974 Opening with O_WRONLY could work for an ordinary file,
2975 but would lose for directories. */
2976 return (access (filename
, 2) >= 0);
2978 #endif /* not MSDOS */
2981 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2982 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
2983 See also `file-readable-p' and `file-attributes'. */)
2985 Lisp_Object filename
;
2987 Lisp_Object absname
;
2988 Lisp_Object handler
;
2989 struct stat statbuf
;
2991 CHECK_STRING (filename
);
2992 absname
= Fexpand_file_name (filename
, Qnil
);
2994 /* If the file name has special constructs in it,
2995 call the corresponding file handler. */
2996 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2997 if (!NILP (handler
))
2998 return call2 (handler
, Qfile_exists_p
, absname
);
3000 absname
= ENCODE_FILE (absname
);
3002 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3005 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3006 doc
: /* Return t if FILENAME can be executed by you.
3007 For a directory, this means you can access files in that directory. */)
3009 Lisp_Object filename
;
3011 Lisp_Object absname
;
3012 Lisp_Object handler
;
3014 CHECK_STRING (filename
);
3015 absname
= Fexpand_file_name (filename
, Qnil
);
3017 /* If the file name has special constructs in it,
3018 call the corresponding file handler. */
3019 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3020 if (!NILP (handler
))
3021 return call2 (handler
, Qfile_executable_p
, absname
);
3023 absname
= ENCODE_FILE (absname
);
3025 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3028 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3029 doc
: /* Return t if file FILENAME exists and you can read it.
3030 See also `file-exists-p' and `file-attributes'. */)
3032 Lisp_Object filename
;
3034 Lisp_Object absname
;
3035 Lisp_Object handler
;
3038 struct stat statbuf
;
3040 CHECK_STRING (filename
);
3041 absname
= Fexpand_file_name (filename
, Qnil
);
3043 /* If the file name has special constructs in it,
3044 call the corresponding file handler. */
3045 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3046 if (!NILP (handler
))
3047 return call2 (handler
, Qfile_readable_p
, absname
);
3049 absname
= ENCODE_FILE (absname
);
3051 #if defined(DOS_NT) || defined(macintosh)
3052 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3054 if (access (SDATA (absname
), 0) == 0)
3057 #else /* not DOS_NT and not macintosh */
3059 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3060 /* Opening a fifo without O_NONBLOCK can wait.
3061 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3062 except in the case of a fifo, on a system which handles it. */
3063 desc
= stat (SDATA (absname
), &statbuf
);
3066 if (S_ISFIFO (statbuf
.st_mode
))
3067 flags
|= O_NONBLOCK
;
3069 desc
= emacs_open (SDATA (absname
), flags
, 0);
3074 #endif /* not DOS_NT and not macintosh */
3077 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3079 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3080 doc
: /* Return t if file FILENAME can be written or created by you. */)
3082 Lisp_Object filename
;
3084 Lisp_Object absname
, dir
, encoded
;
3085 Lisp_Object handler
;
3086 struct stat statbuf
;
3088 CHECK_STRING (filename
);
3089 absname
= Fexpand_file_name (filename
, Qnil
);
3091 /* If the file name has special constructs in it,
3092 call the corresponding file handler. */
3093 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3094 if (!NILP (handler
))
3095 return call2 (handler
, Qfile_writable_p
, absname
);
3097 encoded
= ENCODE_FILE (absname
);
3098 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3099 return (check_writable (SDATA (encoded
))
3102 dir
= Ffile_name_directory (absname
);
3105 dir
= Fdirectory_file_name (dir
);
3109 dir
= Fdirectory_file_name (dir
);
3112 dir
= ENCODE_FILE (dir
);
3114 /* The read-only attribute of the parent directory doesn't affect
3115 whether a file or directory can be created within it. Some day we
3116 should check ACLs though, which do affect this. */
3117 if (stat (SDATA (dir
), &statbuf
) < 0)
3119 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3121 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3126 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3127 doc
: /* Access file FILENAME, and get an error if that does not work.
3128 The second argument STRING is used in the error message.
3129 If there is no error, we return nil. */)
3131 Lisp_Object filename
, string
;
3133 Lisp_Object handler
, encoded_filename
, absname
;
3136 CHECK_STRING (filename
);
3137 absname
= Fexpand_file_name (filename
, Qnil
);
3139 CHECK_STRING (string
);
3141 /* If the file name has special constructs in it,
3142 call the corresponding file handler. */
3143 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3144 if (!NILP (handler
))
3145 return call3 (handler
, Qaccess_file
, absname
, string
);
3147 encoded_filename
= ENCODE_FILE (absname
);
3149 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3151 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3157 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3158 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3159 The value is the name of the file to which it is linked.
3160 Otherwise returns nil. */)
3162 Lisp_Object filename
;
3169 Lisp_Object handler
;
3171 CHECK_STRING (filename
);
3172 filename
= Fexpand_file_name (filename
, Qnil
);
3174 /* If the file name has special constructs in it,
3175 call the corresponding file handler. */
3176 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3177 if (!NILP (handler
))
3178 return call2 (handler
, Qfile_symlink_p
, filename
);
3180 filename
= ENCODE_FILE (filename
);
3187 buf
= (char *) xrealloc (buf
, bufsize
);
3188 bzero (buf
, bufsize
);
3191 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3195 /* HP-UX reports ERANGE if buffer is too small. */
3196 if (errno
== ERANGE
)
3206 while (valsize
>= bufsize
);
3208 val
= make_string (buf
, valsize
);
3209 if (buf
[0] == '/' && index (buf
, ':'))
3210 val
= concat2 (build_string ("/:"), val
);
3212 val
= DECODE_FILE (val
);
3214 #else /* not S_IFLNK */
3216 #endif /* not S_IFLNK */
3219 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3220 doc
: /* Return t if FILENAME names an existing directory.
3221 Symbolic links to directories count as directories.
3222 See `file-symlink-p' to distinguish symlinks. */)
3224 Lisp_Object filename
;
3226 register Lisp_Object absname
;
3228 Lisp_Object handler
;
3230 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3232 /* If the file name has special constructs in it,
3233 call the corresponding file handler. */
3234 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3235 if (!NILP (handler
))
3236 return call2 (handler
, Qfile_directory_p
, absname
);
3238 absname
= ENCODE_FILE (absname
);
3240 if (stat (SDATA (absname
), &st
) < 0)
3242 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3245 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3246 doc
: /* Return t if file FILENAME names a directory you can open.
3247 For the value to be t, FILENAME must specify the name of a directory as a file,
3248 and the directory must allow you to open files in it. In order to use a
3249 directory as a buffer's current directory, this predicate must return true.
3250 A directory name spec may be given instead; then the value is t
3251 if the directory so specified exists and really is a readable and
3252 searchable directory. */)
3254 Lisp_Object filename
;
3256 Lisp_Object handler
;
3258 struct gcpro gcpro1
;
3260 /* If the file name has special constructs in it,
3261 call the corresponding file handler. */
3262 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3263 if (!NILP (handler
))
3264 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3266 /* It's an unlikely combination, but yes we really do need to gcpro:
3267 Suppose that file-accessible-directory-p has no handler, but
3268 file-directory-p does have a handler; this handler causes a GC which
3269 relocates the string in `filename'; and finally file-directory-p
3270 returns non-nil. Then we would end up passing a garbaged string
3271 to file-executable-p. */
3273 tem
= (NILP (Ffile_directory_p (filename
))
3274 || NILP (Ffile_executable_p (filename
)));
3276 return tem
? Qnil
: Qt
;
3279 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3280 doc
: /* Return t if file FILENAME is the name of a regular file.
3281 This is the sort of file that holds an ordinary stream of data bytes. */)
3283 Lisp_Object filename
;
3285 register Lisp_Object absname
;
3287 Lisp_Object handler
;
3289 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3291 /* If the file name has special constructs in it,
3292 call the corresponding file handler. */
3293 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3294 if (!NILP (handler
))
3295 return call2 (handler
, Qfile_regular_p
, absname
);
3297 absname
= ENCODE_FILE (absname
);
3302 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3304 /* Tell stat to use expensive method to get accurate info. */
3305 Vw32_get_true_file_attributes
= Qt
;
3306 result
= stat (SDATA (absname
), &st
);
3307 Vw32_get_true_file_attributes
= tem
;
3311 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3314 if (stat (SDATA (absname
), &st
) < 0)
3316 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3320 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3321 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
3323 Lisp_Object filename
;
3325 Lisp_Object absname
;
3327 Lisp_Object handler
;
3329 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3331 /* If the file name has special constructs in it,
3332 call the corresponding file handler. */
3333 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3334 if (!NILP (handler
))
3335 return call2 (handler
, Qfile_modes
, absname
);
3337 absname
= ENCODE_FILE (absname
);
3339 if (stat (SDATA (absname
), &st
) < 0)
3341 #if defined (MSDOS) && __DJGPP__ < 2
3342 if (check_executable (SDATA (absname
)))
3343 st
.st_mode
|= S_IEXEC
;
3344 #endif /* MSDOS && __DJGPP__ < 2 */
3346 return make_number (st
.st_mode
& 07777);
3349 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3350 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3351 Only the 12 low bits of MODE are used. */)
3353 Lisp_Object filename
, mode
;
3355 Lisp_Object absname
, encoded_absname
;
3356 Lisp_Object handler
;
3358 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3359 CHECK_NUMBER (mode
);
3361 /* If the file name has special constructs in it,
3362 call the corresponding file handler. */
3363 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3364 if (!NILP (handler
))
3365 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3367 encoded_absname
= ENCODE_FILE (absname
);
3369 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3370 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3375 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3376 doc
: /* Set the file permission bits for newly created files.
3377 The argument MODE should be an integer; only the low 9 bits are used.
3378 This setting is inherited by subprocesses. */)
3382 CHECK_NUMBER (mode
);
3384 umask ((~ XINT (mode
)) & 0777);
3389 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3390 doc
: /* Return the default file protection for created files.
3391 The value is an integer. */)
3397 realmask
= umask (0);
3400 XSETINT (value
, (~ realmask
) & 0777);
3410 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3411 doc
: /* Tell Unix to finish all pending disk updates. */)
3420 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3421 doc
: /* Return t if file FILE1 is newer than file FILE2.
3422 If FILE1 does not exist, the answer is nil;
3423 otherwise, if FILE2 does not exist, the answer is t. */)
3425 Lisp_Object file1
, file2
;
3427 Lisp_Object absname1
, absname2
;
3430 Lisp_Object handler
;
3431 struct gcpro gcpro1
, gcpro2
;
3433 CHECK_STRING (file1
);
3434 CHECK_STRING (file2
);
3437 GCPRO2 (absname1
, file2
);
3438 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3439 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3442 /* If the file name has special constructs in it,
3443 call the corresponding file handler. */
3444 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3446 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3447 if (!NILP (handler
))
3448 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3450 GCPRO2 (absname1
, absname2
);
3451 absname1
= ENCODE_FILE (absname1
);
3452 absname2
= ENCODE_FILE (absname2
);
3455 if (stat (SDATA (absname1
), &st
) < 0)
3458 mtime1
= st
.st_mtime
;
3460 if (stat (SDATA (absname2
), &st
) < 0)
3463 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3467 Lisp_Object Qfind_buffer_file_type
;
3470 #ifndef READ_BUF_SIZE
3471 #define READ_BUF_SIZE (64 << 10)
3474 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3476 /* This function is called after Lisp functions to decide a coding
3477 system are called, or when they cause an error. Before they are
3478 called, the current buffer is set unibyte and it contains only a
3479 newly inserted text (thus the buffer was empty before the
3482 The functions may set markers, overlays, text properties, or even
3483 alter the buffer contents, change the current buffer.
3485 Here, we reset all those changes by:
3486 o set back the current buffer.
3487 o move all markers and overlays to BEG.
3488 o remove all text properties.
3489 o set back the buffer multibyteness. */
3492 decide_coding_unwind (unwind_data
)
3493 Lisp_Object unwind_data
;
3495 Lisp_Object multibyte
, undo_list
, buffer
;
3497 multibyte
= XCAR (unwind_data
);
3498 unwind_data
= XCDR (unwind_data
);
3499 undo_list
= XCAR (unwind_data
);
3500 buffer
= XCDR (unwind_data
);
3502 if (current_buffer
!= XBUFFER (buffer
))
3503 set_buffer_internal (XBUFFER (buffer
));
3504 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3505 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3506 BUF_INTERVALS (current_buffer
) = 0;
3507 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3509 /* Now we are safe to change the buffer's multibyteness directly. */
3510 current_buffer
->enable_multibyte_characters
= multibyte
;
3511 current_buffer
->undo_list
= undo_list
;
3517 /* Used to pass values from insert-file-contents to read_non_regular. */
3519 static int non_regular_fd
;
3520 static int non_regular_inserted
;
3521 static int non_regular_nbytes
;
3524 /* Read from a non-regular file.
3525 Read non_regular_trytry bytes max from non_regular_fd.
3526 Non_regular_inserted specifies where to put the read bytes.
3527 Value is the number of bytes read. */
3536 nbytes
= emacs_read (non_regular_fd
,
3537 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3538 non_regular_nbytes
);
3540 return make_number (nbytes
);
3544 /* Condition-case handler used when reading from non-regular files
3545 in insert-file-contents. */
3548 read_non_regular_quit ()
3554 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3556 doc
: /* Insert contents of file FILENAME after point.
3557 Returns list of absolute file name and number of bytes inserted.
3558 If second argument VISIT is non-nil, the buffer's visited filename
3559 and last save file modtime are set, and it is marked unmodified.
3560 If visiting and the file does not exist, visiting is completed
3561 before the error is signaled.
3562 The optional third and fourth arguments BEG and END
3563 specify what portion of the file to insert.
3564 These arguments count bytes in the file, not characters in the buffer.
3565 If VISIT is non-nil, BEG and END must be nil.
3567 If optional fifth argument REPLACE is non-nil,
3568 it means replace the current buffer contents (in the accessible portion)
3569 with the file contents. This is better than simply deleting and inserting
3570 the whole thing because (1) it preserves some marker positions
3571 and (2) it puts less data in the undo list.
3572 When REPLACE is non-nil, the value is the number of characters actually read,
3573 which is often less than the number of characters to be read.
3575 This does code conversion according to the value of
3576 `coding-system-for-read' or `file-coding-system-alist',
3577 and sets the variable `last-coding-system-used' to the coding system
3579 (filename
, visit
, beg
, end
, replace
)
3580 Lisp_Object filename
, visit
, beg
, end
, replace
;
3585 register int how_much
;
3586 register int unprocessed
;
3587 int count
= SPECPDL_INDEX ();
3588 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3589 Lisp_Object handler
, val
, insval
, orig_filename
;
3592 int not_regular
= 0;
3593 unsigned char read_buf
[READ_BUF_SIZE
];
3594 struct coding_system coding
;
3595 unsigned char buffer
[1 << 14];
3596 int replace_handled
= 0;
3597 int set_coding_system
= 0;
3598 int coding_system_decided
= 0;
3601 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3602 error ("Cannot do file visiting in an indirect buffer");
3604 if (!NILP (current_buffer
->read_only
))
3605 Fbarf_if_buffer_read_only ();
3609 orig_filename
= Qnil
;
3611 GCPRO4 (filename
, val
, p
, orig_filename
);
3613 CHECK_STRING (filename
);
3614 filename
= Fexpand_file_name (filename
, Qnil
);
3616 /* If the file name has special constructs in it,
3617 call the corresponding file handler. */
3618 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3619 if (!NILP (handler
))
3621 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3622 visit
, beg
, end
, replace
);
3623 if (CONSP (val
) && CONSP (XCDR (val
)))
3624 inserted
= XINT (XCAR (XCDR (val
)));
3628 orig_filename
= filename
;
3629 filename
= ENCODE_FILE (filename
);
3635 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3637 /* Tell stat to use expensive method to get accurate info. */
3638 Vw32_get_true_file_attributes
= Qt
;
3639 total
= stat (SDATA (filename
), &st
);
3640 Vw32_get_true_file_attributes
= tem
;
3645 if (stat (SDATA (filename
), &st
) < 0)
3647 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3648 || fstat (fd
, &st
) < 0)
3649 #endif /* not APOLLO */
3650 #endif /* WINDOWSNT */
3652 if (fd
>= 0) emacs_close (fd
);
3655 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3658 if (!NILP (Vcoding_system_for_read
))
3659 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3664 /* This code will need to be changed in order to work on named
3665 pipes, and it's probably just not worth it. So we should at
3666 least signal an error. */
3667 if (!S_ISREG (st
.st_mode
))
3674 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3675 Fsignal (Qfile_error
,
3676 Fcons (build_string ("not a regular file"),
3677 Fcons (orig_filename
, Qnil
)));
3682 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3685 /* Replacement should preserve point as it preserves markers. */
3686 if (!NILP (replace
))
3687 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3689 record_unwind_protect (close_file_unwind
, make_number (fd
));
3691 /* Supposedly happens on VMS. */
3692 /* Can happen on any platform that uses long as type of off_t, but allows
3693 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3694 give a message suitable for the latter case. */
3695 if (! not_regular
&& st
.st_size
< 0)
3696 error ("Maximum buffer size exceeded");
3698 /* Prevent redisplay optimizations. */
3699 current_buffer
->clip_changed
= 1;
3703 if (!NILP (beg
) || !NILP (end
))
3704 error ("Attempt to visit less than an entire file");
3705 if (BEG
< Z
&& NILP (replace
))
3706 error ("Cannot do file visiting in a non-empty buffer");
3712 XSETFASTINT (beg
, 0);
3720 XSETINT (end
, st
.st_size
);
3722 /* Arithmetic overflow can occur if an Emacs integer cannot
3723 represent the file size, or if the calculations below
3724 overflow. The calculations below double the file size
3725 twice, so check that it can be multiplied by 4 safely. */
3726 if (XINT (end
) != st
.st_size
3727 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3728 error ("Maximum buffer size exceeded");
3730 /* The file size returned from stat may be zero, but data
3731 may be readable nonetheless, for example when this is a
3732 file in the /proc filesystem. */
3733 if (st
.st_size
== 0)
3734 XSETINT (end
, READ_BUF_SIZE
);
3740 /* Decide the coding system to use for reading the file now
3741 because we can't use an optimized method for handling
3742 `coding:' tag if the current buffer is not empty. */
3746 if (!NILP (Vcoding_system_for_read
))
3747 val
= Vcoding_system_for_read
;
3748 else if (! NILP (replace
))
3749 /* In REPLACE mode, we can use the same coding system
3750 that was used to visit the file. */
3751 val
= current_buffer
->buffer_file_coding_system
;
3754 /* Don't try looking inside a file for a coding system
3755 specification if it is not seekable. */
3756 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3758 /* Find a coding system specified in the heading two
3759 lines or in the tailing several lines of the file.
3760 We assume that the 1K-byte and 3K-byte for heading
3761 and tailing respectively are sufficient for this
3765 if (st
.st_size
<= (1024 * 4))
3766 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3769 nread
= emacs_read (fd
, read_buf
, 1024);
3772 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3773 report_file_error ("Setting file position",
3774 Fcons (orig_filename
, Qnil
));
3775 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3780 error ("IO error reading %s: %s",
3781 SDATA (orig_filename
), emacs_strerror (errno
));
3784 struct buffer
*prev
= current_buffer
;
3788 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3790 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3791 buf
= XBUFFER (buffer
);
3793 buf
->directory
= current_buffer
->directory
;
3794 buf
->read_only
= Qnil
;
3795 buf
->filename
= Qnil
;
3796 buf
->undo_list
= Qt
;
3797 buf
->overlays_before
= Qnil
;
3798 buf
->overlays_after
= Qnil
;
3800 set_buffer_internal (buf
);
3802 buf
->enable_multibyte_characters
= Qnil
;
3804 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3805 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3806 val
= call2 (Vset_auto_coding_function
,
3807 filename
, make_number (nread
));
3808 set_buffer_internal (prev
);
3810 /* Discard the unwind protect for recovering the
3814 /* Rewind the file for the actual read done later. */
3815 if (lseek (fd
, 0, 0) < 0)
3816 report_file_error ("Setting file position",
3817 Fcons (orig_filename
, Qnil
));
3823 /* If we have not yet decided a coding system, check
3824 file-coding-system-alist. */
3825 Lisp_Object args
[6], coding_systems
;
3827 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3828 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3829 coding_systems
= Ffind_operation_coding_system (6, args
);
3830 if (CONSP (coding_systems
))
3831 val
= XCAR (coding_systems
);
3835 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3836 /* Ensure we set Vlast_coding_system_used. */
3837 set_coding_system
= 1;
3839 if (NILP (current_buffer
->enable_multibyte_characters
)
3841 /* We must suppress all character code conversion except for
3842 end-of-line conversion. */
3843 setup_raw_text_coding_system (&coding
);
3845 coding
.src_multibyte
= 0;
3846 coding
.dst_multibyte
3847 = !NILP (current_buffer
->enable_multibyte_characters
);
3848 coding_system_decided
= 1;
3851 /* If requested, replace the accessible part of the buffer
3852 with the file contents. Avoid replacing text at the
3853 beginning or end of the buffer that matches the file contents;
3854 that preserves markers pointing to the unchanged parts.
3856 Here we implement this feature in an optimized way
3857 for the case where code conversion is NOT needed.
3858 The following if-statement handles the case of conversion
3859 in a less optimal way.
3861 If the code conversion is "automatic" then we try using this
3862 method and hope for the best.
3863 But if we discover the need for conversion, we give up on this method
3864 and let the following if-statement handle the replace job. */
3867 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3869 /* same_at_start and same_at_end count bytes,
3870 because file access counts bytes
3871 and BEG and END count bytes. */
3872 int same_at_start
= BEGV_BYTE
;
3873 int same_at_end
= ZV_BYTE
;
3875 /* There is still a possibility we will find the need to do code
3876 conversion. If that happens, we set this variable to 1 to
3877 give up on handling REPLACE in the optimized way. */
3878 int giveup_match_end
= 0;
3880 if (XINT (beg
) != 0)
3882 if (lseek (fd
, XINT (beg
), 0) < 0)
3883 report_file_error ("Setting file position",
3884 Fcons (orig_filename
, Qnil
));
3889 /* Count how many chars at the start of the file
3890 match the text at the beginning of the buffer. */
3895 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3897 error ("IO error reading %s: %s",
3898 SDATA (orig_filename
), emacs_strerror (errno
));
3899 else if (nread
== 0)
3902 if (coding
.type
== coding_type_undecided
)
3903 detect_coding (&coding
, buffer
, nread
);
3904 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
3905 /* We found that the file should be decoded somehow.
3906 Let's give up here. */
3908 giveup_match_end
= 1;
3912 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3913 detect_eol (&coding
, buffer
, nread
);
3914 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3915 && coding
.eol_type
!= CODING_EOL_LF
)
3916 /* We found that the format of eol should be decoded.
3917 Let's give up here. */
3919 giveup_match_end
= 1;
3924 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3925 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3926 same_at_start
++, bufpos
++;
3927 /* If we found a discrepancy, stop the scan.
3928 Otherwise loop around and scan the next bufferful. */
3929 if (bufpos
!= nread
)
3933 /* If the file matches the buffer completely,
3934 there's no need to replace anything. */
3935 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3939 /* Truncate the buffer to the size of the file. */
3940 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3945 /* Count how many chars at the end of the file
3946 match the text at the end of the buffer. But, if we have
3947 already found that decoding is necessary, don't waste time. */
3948 while (!giveup_match_end
)
3950 int total_read
, nread
, bufpos
, curpos
, trial
;
3952 /* At what file position are we now scanning? */
3953 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3954 /* If the entire file matches the buffer tail, stop the scan. */
3957 /* How much can we scan in the next step? */
3958 trial
= min (curpos
, sizeof buffer
);
3959 if (lseek (fd
, curpos
- trial
, 0) < 0)
3960 report_file_error ("Setting file position",
3961 Fcons (orig_filename
, Qnil
));
3963 total_read
= nread
= 0;
3964 while (total_read
< trial
)
3966 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3968 error ("IO error reading %s: %s",
3969 SDATA (orig_filename
), emacs_strerror (errno
));
3970 else if (nread
== 0)
3972 total_read
+= nread
;
3975 /* Scan this bufferful from the end, comparing with
3976 the Emacs buffer. */
3977 bufpos
= total_read
;
3979 /* Compare with same_at_start to avoid counting some buffer text
3980 as matching both at the file's beginning and at the end. */
3981 while (bufpos
> 0 && same_at_end
> same_at_start
3982 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3983 same_at_end
--, bufpos
--;
3985 /* If we found a discrepancy, stop the scan.
3986 Otherwise loop around and scan the preceding bufferful. */
3989 /* If this discrepancy is because of code conversion,
3990 we cannot use this method; giveup and try the other. */
3991 if (same_at_end
> same_at_start
3992 && FETCH_BYTE (same_at_end
- 1) >= 0200
3993 && ! NILP (current_buffer
->enable_multibyte_characters
)
3994 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3995 giveup_match_end
= 1;
4004 if (! giveup_match_end
)
4008 /* We win! We can handle REPLACE the optimized way. */
4010 /* Extend the start of non-matching text area to multibyte
4011 character boundary. */
4012 if (! NILP (current_buffer
->enable_multibyte_characters
))
4013 while (same_at_start
> BEGV_BYTE
4014 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4017 /* Extend the end of non-matching text area to multibyte
4018 character boundary. */
4019 if (! NILP (current_buffer
->enable_multibyte_characters
))
4020 while (same_at_end
< ZV_BYTE
4021 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4024 /* Don't try to reuse the same piece of text twice. */
4025 overlap
= (same_at_start
- BEGV_BYTE
4026 - (same_at_end
+ st
.st_size
- ZV
));
4028 same_at_end
+= overlap
;
4030 /* Arrange to read only the nonmatching middle part of the file. */
4031 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4032 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4034 del_range_byte (same_at_start
, same_at_end
, 0);
4035 /* Insert from the file at the proper position. */
4036 temp
= BYTE_TO_CHAR (same_at_start
);
4037 SET_PT_BOTH (temp
, same_at_start
);
4039 /* If display currently starts at beginning of line,
4040 keep it that way. */
4041 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4042 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4044 replace_handled
= 1;
4048 /* If requested, replace the accessible part of the buffer
4049 with the file contents. Avoid replacing text at the
4050 beginning or end of the buffer that matches the file contents;
4051 that preserves markers pointing to the unchanged parts.
4053 Here we implement this feature for the case where code conversion
4054 is needed, in a simple way that needs a lot of memory.
4055 The preceding if-statement handles the case of no conversion
4056 in a more optimized way. */
4057 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4059 int same_at_start
= BEGV_BYTE
;
4060 int same_at_end
= ZV_BYTE
;
4063 /* Make sure that the gap is large enough. */
4064 int bufsize
= 2 * st
.st_size
;
4065 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4068 /* First read the whole file, performing code conversion into
4069 CONVERSION_BUFFER. */
4071 if (lseek (fd
, XINT (beg
), 0) < 0)
4073 xfree (conversion_buffer
);
4074 report_file_error ("Setting file position",
4075 Fcons (orig_filename
, Qnil
));
4078 total
= st
.st_size
; /* Total bytes in the file. */
4079 how_much
= 0; /* Bytes read from file so far. */
4080 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4081 unprocessed
= 0; /* Bytes not processed in previous loop. */
4083 while (how_much
< total
)
4085 /* try is reserved in some compilers (Microsoft C) */
4086 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4087 unsigned char *destination
= read_buf
+ unprocessed
;
4090 /* Allow quitting out of the actual I/O. */
4093 this = emacs_read (fd
, destination
, trytry
);
4096 if (this < 0 || this + unprocessed
== 0)
4104 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4106 int require
, result
;
4108 this += unprocessed
;
4110 /* If we are using more space than estimated,
4111 make CONVERSION_BUFFER bigger. */
4112 require
= decoding_buffer_size (&coding
, this);
4113 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4115 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4116 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4119 /* Convert this batch with results in CONVERSION_BUFFER. */
4120 if (how_much
>= total
) /* This is the last block. */
4121 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4122 if (coding
.composing
!= COMPOSITION_DISABLED
)
4123 coding_allocate_composition_data (&coding
, BEGV
);
4124 result
= decode_coding (&coding
, read_buf
,
4125 conversion_buffer
+ inserted
,
4126 this, bufsize
- inserted
);
4128 /* Save for next iteration whatever we didn't convert. */
4129 unprocessed
= this - coding
.consumed
;
4130 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4131 if (!NILP (current_buffer
->enable_multibyte_characters
))
4132 this = coding
.produced
;
4134 this = str_as_unibyte (conversion_buffer
+ inserted
,
4141 /* At this point, INSERTED is how many characters (i.e. bytes)
4142 are present in CONVERSION_BUFFER.
4143 HOW_MUCH should equal TOTAL,
4144 or should be <= 0 if we couldn't read the file. */
4148 xfree (conversion_buffer
);
4151 error ("IO error reading %s: %s",
4152 SDATA (orig_filename
), emacs_strerror (errno
));
4153 else if (how_much
== -2)
4154 error ("maximum buffer size exceeded");
4157 /* Compare the beginning of the converted file
4158 with the buffer text. */
4161 while (bufpos
< inserted
&& same_at_start
< same_at_end
4162 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4163 same_at_start
++, bufpos
++;
4165 /* If the file matches the buffer completely,
4166 there's no need to replace anything. */
4168 if (bufpos
== inserted
)
4170 xfree (conversion_buffer
);
4173 /* Truncate the buffer to the size of the file. */
4174 del_range_byte (same_at_start
, same_at_end
, 0);
4179 /* Extend the start of non-matching text area to multibyte
4180 character boundary. */
4181 if (! NILP (current_buffer
->enable_multibyte_characters
))
4182 while (same_at_start
> BEGV_BYTE
4183 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4186 /* Scan this bufferful from the end, comparing with
4187 the Emacs buffer. */
4190 /* Compare with same_at_start to avoid counting some buffer text
4191 as matching both at the file's beginning and at the end. */
4192 while (bufpos
> 0 && same_at_end
> same_at_start
4193 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4194 same_at_end
--, bufpos
--;
4196 /* Extend the end of non-matching text area to multibyte
4197 character boundary. */
4198 if (! NILP (current_buffer
->enable_multibyte_characters
))
4199 while (same_at_end
< ZV_BYTE
4200 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4203 /* Don't try to reuse the same piece of text twice. */
4204 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4206 same_at_end
+= overlap
;
4208 /* If display currently starts at beginning of line,
4209 keep it that way. */
4210 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4211 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4213 /* Replace the chars that we need to replace,
4214 and update INSERTED to equal the number of bytes
4215 we are taking from the file. */
4216 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4218 if (same_at_end
!= same_at_start
)
4220 del_range_byte (same_at_start
, same_at_end
, 0);
4222 same_at_start
= GPT_BYTE
;
4226 temp
= BYTE_TO_CHAR (same_at_start
);
4228 /* Insert from the file at the proper position. */
4229 SET_PT_BOTH (temp
, same_at_start
);
4230 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
4232 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4233 coding_restore_composition (&coding
, Fcurrent_buffer ());
4234 coding_free_composition_data (&coding
);
4236 /* Set `inserted' to the number of inserted characters. */
4237 inserted
= PT
- temp
;
4239 xfree (conversion_buffer
);
4248 register Lisp_Object temp
;
4250 total
= XINT (end
) - XINT (beg
);
4252 /* Make sure point-max won't overflow after this insertion. */
4253 XSETINT (temp
, total
);
4254 if (total
!= XINT (temp
))
4255 error ("Maximum buffer size exceeded");
4258 /* For a special file, all we can do is guess. */
4259 total
= READ_BUF_SIZE
;
4261 if (NILP (visit
) && total
> 0)
4262 prepare_to_modify_buffer (PT
, PT
, NULL
);
4265 if (GAP_SIZE
< total
)
4266 make_gap (total
- GAP_SIZE
);
4268 if (XINT (beg
) != 0 || !NILP (replace
))
4270 if (lseek (fd
, XINT (beg
), 0) < 0)
4271 report_file_error ("Setting file position",
4272 Fcons (orig_filename
, Qnil
));
4275 /* In the following loop, HOW_MUCH contains the total bytes read so
4276 far for a regular file, and not changed for a special file. But,
4277 before exiting the loop, it is set to a negative value if I/O
4281 /* Total bytes inserted. */
4284 /* Here, we don't do code conversion in the loop. It is done by
4285 code_convert_region after all data are read into the buffer. */
4287 int gap_size
= GAP_SIZE
;
4289 while (how_much
< total
)
4291 /* try is reserved in some compilers (Microsoft C) */
4292 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4299 /* Maybe make more room. */
4300 if (gap_size
< trytry
)
4302 make_gap (total
- gap_size
);
4303 gap_size
= GAP_SIZE
;
4306 /* Read from the file, capturing `quit'. When an
4307 error occurs, end the loop, and arrange for a quit
4308 to be signaled after decoding the text we read. */
4309 non_regular_fd
= fd
;
4310 non_regular_inserted
= inserted
;
4311 non_regular_nbytes
= trytry
;
4312 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4313 read_non_regular_quit
);
4324 /* Allow quitting out of the actual I/O. We don't make text
4325 part of the buffer until all the reading is done, so a C-g
4326 here doesn't do any harm. */
4329 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4341 /* For a regular file, where TOTAL is the real size,
4342 count HOW_MUCH to compare with it.
4343 For a special file, where TOTAL is just a buffer size,
4344 so don't bother counting in HOW_MUCH.
4345 (INSERTED is where we count the number of characters inserted.) */
4352 /* Make the text read part of the buffer. */
4353 GAP_SIZE
-= inserted
;
4355 GPT_BYTE
+= inserted
;
4357 ZV_BYTE
+= inserted
;
4362 /* Put an anchor to ensure multi-byte form ends at gap. */
4367 /* Discard the unwind protect for closing the file. */
4371 error ("IO error reading %s: %s",
4372 SDATA (orig_filename
), emacs_strerror (errno
));
4376 if (! coding_system_decided
)
4378 /* The coding system is not yet decided. Decide it by an
4379 optimized method for handling `coding:' tag.
4381 Note that we can get here only if the buffer was empty
4382 before the insertion. */
4386 if (!NILP (Vcoding_system_for_read
))
4387 val
= Vcoding_system_for_read
;
4390 /* Since we are sure that the current buffer was empty
4391 before the insertion, we can toggle
4392 enable-multibyte-characters directly here without taking
4393 care of marker adjustment and byte combining problem. By
4394 this way, we can run Lisp program safely before decoding
4395 the inserted text. */
4396 Lisp_Object unwind_data
;
4397 int count
= SPECPDL_INDEX ();
4399 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4400 Fcons (current_buffer
->undo_list
,
4401 Fcurrent_buffer ()));
4402 current_buffer
->enable_multibyte_characters
= Qnil
;
4403 current_buffer
->undo_list
= Qt
;
4404 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4406 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4408 val
= call2 (Vset_auto_coding_function
,
4409 filename
, make_number (inserted
));
4414 /* If the coding system is not yet decided, check
4415 file-coding-system-alist. */
4416 Lisp_Object args
[6], coding_systems
;
4418 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4419 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4420 coding_systems
= Ffind_operation_coding_system (6, args
);
4421 if (CONSP (coding_systems
))
4422 val
= XCAR (coding_systems
);
4425 unbind_to (count
, Qnil
);
4426 inserted
= Z_BYTE
- BEG_BYTE
;
4429 /* The following kludgy code is to avoid some compiler bug.
4431 setup_coding_system (val, &coding);
4434 struct coding_system temp_coding
;
4435 setup_coding_system (val
, &temp_coding
);
4436 bcopy (&temp_coding
, &coding
, sizeof coding
);
4438 /* Ensure we set Vlast_coding_system_used. */
4439 set_coding_system
= 1;
4441 if (NILP (current_buffer
->enable_multibyte_characters
)
4443 /* We must suppress all character code conversion except for
4444 end-of-line conversion. */
4445 setup_raw_text_coding_system (&coding
);
4446 coding
.src_multibyte
= 0;
4447 coding
.dst_multibyte
4448 = !NILP (current_buffer
->enable_multibyte_characters
);
4452 /* Can't do this if part of the buffer might be preserved. */
4454 && (coding
.type
== coding_type_no_conversion
4455 || coding
.type
== coding_type_raw_text
))
4457 /* Visiting a file with these coding system makes the buffer
4459 current_buffer
->enable_multibyte_characters
= Qnil
;
4460 coding
.dst_multibyte
= 0;
4463 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4465 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4467 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4469 inserted
= coding
.produced_char
;
4472 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4477 /* Use the conversion type to determine buffer-file-type
4478 (find-buffer-file-type is now used to help determine the
4480 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4481 || coding
.eol_type
== CODING_EOL_LF
)
4482 && ! CODING_REQUIRE_DECODING (&coding
))
4483 current_buffer
->buffer_file_type
= Qt
;
4485 current_buffer
->buffer_file_type
= Qnil
;
4492 if (!EQ (current_buffer
->undo_list
, Qt
))
4493 current_buffer
->undo_list
= Qnil
;
4495 stat (SDATA (filename
), &st
);
4500 current_buffer
->modtime
= st
.st_mtime
;
4501 current_buffer
->filename
= orig_filename
;
4504 SAVE_MODIFF
= MODIFF
;
4505 current_buffer
->auto_save_modified
= MODIFF
;
4506 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4507 #ifdef CLASH_DETECTION
4510 if (!NILP (current_buffer
->file_truename
))
4511 unlock_file (current_buffer
->file_truename
);
4512 unlock_file (filename
);
4514 #endif /* CLASH_DETECTION */
4516 Fsignal (Qfile_error
,
4517 Fcons (build_string ("not a regular file"),
4518 Fcons (orig_filename
, Qnil
)));
4521 /* Decode file format */
4524 int empty_undo_list_p
= 0;
4526 /* If we're anyway going to discard undo information, don't
4527 record it in the first place. The buffer's undo list at this
4528 point is either nil or t when visiting a file. */
4531 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4532 current_buffer
->undo_list
= Qt
;
4535 insval
= call3 (Qformat_decode
,
4536 Qnil
, make_number (inserted
), visit
);
4537 CHECK_NUMBER (insval
);
4538 inserted
= XFASTINT (insval
);
4541 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4544 if (set_coding_system
)
4545 Vlast_coding_system_used
= coding
.symbol
;
4547 /* Call after-change hooks for the inserted text, aside from the case
4548 of normal visiting (not with REPLACE), which is done in a new buffer
4549 "before" the buffer is changed. */
4550 if (inserted
> 0 && total
> 0
4551 && (NILP (visit
) || !NILP (replace
)))
4553 signal_after_change (PT
, 0, inserted
);
4554 update_compositions (PT
, PT
, CHECK_BORDER
);
4557 p
= Vafter_insert_file_functions
;
4560 insval
= call1 (XCAR (p
), make_number (inserted
));
4563 CHECK_NUMBER (insval
);
4564 inserted
= XFASTINT (insval
);
4571 && current_buffer
->modtime
== -1)
4573 /* If visiting nonexistent file, return nil. */
4574 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4578 Fsignal (Qquit
, Qnil
);
4580 /* ??? Retval needs to be dealt with in all cases consistently. */
4582 val
= Fcons (orig_filename
,
4583 Fcons (make_number (inserted
),
4586 RETURN_UNGCPRO (unbind_to (count
, val
));
4589 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4590 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4591 Lisp_Object
, Lisp_Object
));
4593 /* If build_annotations switched buffers, switch back to BUF.
4594 Kill the temporary buffer that was selected in the meantime.
4596 Since this kill only the last temporary buffer, some buffers remain
4597 not killed if build_annotations switched buffers more than once.
4601 build_annotations_unwind (buf
)
4606 if (XBUFFER (buf
) == current_buffer
)
4608 tembuf
= Fcurrent_buffer ();
4610 Fkill_buffer (tembuf
);
4614 /* Decide the coding-system to encode the data with. */
4617 choose_write_coding_system (start
, end
, filename
,
4618 append
, visit
, lockname
, coding
)
4619 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4620 struct coding_system
*coding
;
4626 else if (!NILP (Vcoding_system_for_write
))
4628 val
= Vcoding_system_for_write
;
4629 if (coding_system_require_warning
4630 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4631 /* Confirm that VAL can surely encode the current region. */
4632 val
= call5 (Vselect_safe_coding_system_function
,
4633 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4638 /* If the variable `buffer-file-coding-system' is set locally,
4639 it means that the file was read with some kind of code
4640 conversion or the variable is explicitly set by users. We
4641 had better write it out with the same coding system even if
4642 `enable-multibyte-characters' is nil.
4644 If it is not set locally, we anyway have to convert EOL
4645 format if the default value of `buffer-file-coding-system'
4646 tells that it is not Unix-like (LF only) format. */
4647 int using_default_coding
= 0;
4648 int force_raw_text
= 0;
4650 val
= current_buffer
->buffer_file_coding_system
;
4652 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4655 if (NILP (current_buffer
->enable_multibyte_characters
))
4661 /* Check file-coding-system-alist. */
4662 Lisp_Object args
[7], coding_systems
;
4664 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4665 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4667 coding_systems
= Ffind_operation_coding_system (7, args
);
4668 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4669 val
= XCDR (coding_systems
);
4673 && !NILP (current_buffer
->buffer_file_coding_system
))
4675 /* If we still have not decided a coding system, use the
4676 default value of buffer-file-coding-system. */
4677 val
= current_buffer
->buffer_file_coding_system
;
4678 using_default_coding
= 1;
4682 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4683 /* Confirm that VAL can surely encode the current region. */
4684 val
= call5 (Vselect_safe_coding_system_function
,
4685 start
, end
, val
, Qnil
, filename
);
4687 setup_coding_system (Fcheck_coding_system (val
), coding
);
4688 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4689 && !using_default_coding
)
4691 if (! EQ (default_buffer_file_coding
.symbol
,
4692 buffer_defaults
.buffer_file_coding_system
))
4693 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4694 &default_buffer_file_coding
);
4695 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4697 Lisp_Object subsidiaries
;
4699 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4700 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4701 if (VECTORP (subsidiaries
)
4702 && XVECTOR (subsidiaries
)->size
== 3)
4704 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4709 setup_raw_text_coding_system (coding
);
4710 goto done_setup_coding
;
4713 setup_coding_system (Fcheck_coding_system (val
), coding
);
4716 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4717 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4720 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4721 "r\nFWrite region to file: \ni\ni\ni\np",
4722 doc
: /* Write current region into specified file.
4723 When called from a program, requires three arguments:
4724 START, END and FILENAME. START and END are normally buffer positions
4725 specifying the part of the buffer to write.
4726 If START is nil, that means to use the entire buffer contents.
4727 If START is a string, then output that string to the file
4728 instead of any buffer contents; END is ignored.
4730 Optional fourth argument APPEND if non-nil means
4731 append to existing file contents (if any). If it is an integer,
4732 seek to that offset in the file before writing.
4733 Optional fifth argument VISIT if t means
4734 set the last-save-file-modtime of buffer to this file's modtime
4735 and mark buffer not modified.
4736 If VISIT is a string, it is a second file name;
4737 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4738 VISIT is also the file name to lock and unlock for clash detection.
4739 If VISIT is neither t nor nil nor a string,
4740 that means do not display the \"Wrote file\" message.
4741 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4742 use for locking and unlocking, overriding FILENAME and VISIT.
4743 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4744 for an existing file with the same name. If MUSTBENEW is `excl',
4745 that means to get an error if the file already exists; never overwrite.
4746 If MUSTBENEW is neither nil nor `excl', that means ask for
4747 confirmation before overwriting, but do go ahead and overwrite the file
4748 if the user confirms.
4750 This does code conversion according to the value of
4751 `coding-system-for-write', `buffer-file-coding-system', or
4752 `file-coding-system-alist', and sets the variable
4753 `last-coding-system-used' to the coding system actually used. */)
4754 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4755 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4760 const unsigned char *fn
;
4763 int count
= SPECPDL_INDEX ();
4766 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4768 Lisp_Object handler
;
4769 Lisp_Object visit_file
;
4770 Lisp_Object annotations
;
4771 Lisp_Object encoded_filename
;
4772 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4773 int quietly
= !NILP (visit
);
4774 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4775 struct buffer
*given_buffer
;
4777 int buffer_file_type
= O_BINARY
;
4779 struct coding_system coding
;
4781 if (current_buffer
->base_buffer
&& visiting
)
4782 error ("Cannot do file visiting in an indirect buffer");
4784 if (!NILP (start
) && !STRINGP (start
))
4785 validate_region (&start
, &end
);
4787 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4789 filename
= Fexpand_file_name (filename
, Qnil
);
4791 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4792 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4794 if (STRINGP (visit
))
4795 visit_file
= Fexpand_file_name (visit
, Qnil
);
4797 visit_file
= filename
;
4799 if (NILP (lockname
))
4800 lockname
= visit_file
;
4804 /* If the file name has special constructs in it,
4805 call the corresponding file handler. */
4806 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4807 /* If FILENAME has no handler, see if VISIT has one. */
4808 if (NILP (handler
) && STRINGP (visit
))
4809 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4811 if (!NILP (handler
))
4814 val
= call6 (handler
, Qwrite_region
, start
, end
,
4815 filename
, append
, visit
);
4819 SAVE_MODIFF
= MODIFF
;
4820 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4821 current_buffer
->filename
= visit_file
;
4827 /* Special kludge to simplify auto-saving. */
4830 XSETFASTINT (start
, BEG
);
4831 XSETFASTINT (end
, Z
);
4834 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4835 count1
= SPECPDL_INDEX ();
4837 given_buffer
= current_buffer
;
4839 if (!STRINGP (start
))
4841 annotations
= build_annotations (start
, end
);
4843 if (current_buffer
!= given_buffer
)
4845 XSETFASTINT (start
, BEGV
);
4846 XSETFASTINT (end
, ZV
);
4852 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4854 /* Decide the coding-system to encode the data with.
4855 We used to make this choice before calling build_annotations, but that
4856 leads to problems when a write-annotate-function takes care of
4857 unsavable chars (as was the case with X-Symbol). */
4858 choose_write_coding_system (start
, end
, filename
,
4859 append
, visit
, lockname
, &coding
);
4860 Vlast_coding_system_used
= coding
.symbol
;
4862 given_buffer
= current_buffer
;
4863 if (! STRINGP (start
))
4865 annotations
= build_annotations_2 (start
, end
,
4866 coding
.pre_write_conversion
, annotations
);
4867 if (current_buffer
!= given_buffer
)
4869 XSETFASTINT (start
, BEGV
);
4870 XSETFASTINT (end
, ZV
);
4874 #ifdef CLASH_DETECTION
4877 #if 0 /* This causes trouble for GNUS. */
4878 /* If we've locked this file for some other buffer,
4879 query before proceeding. */
4880 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4881 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4884 lock_file (lockname
);
4886 #endif /* CLASH_DETECTION */
4888 encoded_filename
= ENCODE_FILE (filename
);
4890 fn
= SDATA (encoded_filename
);
4894 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4895 #else /* not DOS_NT */
4896 desc
= emacs_open (fn
, O_WRONLY
, 0);
4897 #endif /* not DOS_NT */
4899 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4901 if (auto_saving
) /* Overwrite any previous version of autosave file */
4903 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4904 desc
= emacs_open (fn
, O_RDWR
, 0);
4906 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4907 ? SDATA (current_buffer
->filename
) : 0,
4910 else /* Write to temporary name and rename if no errors */
4912 Lisp_Object temp_name
;
4913 temp_name
= Ffile_name_directory (filename
);
4915 if (!NILP (temp_name
))
4917 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4918 build_string ("$$SAVE$$")));
4919 fname
= SDATA (filename
);
4920 fn
= SDATA (temp_name
);
4921 desc
= creat_copy_attrs (fname
, fn
);
4924 /* If we can't open the temporary file, try creating a new
4925 version of the original file. VMS "creat" creates a
4926 new version rather than truncating an existing file. */
4929 desc
= creat (fn
, 0666);
4930 #if 0 /* This can clobber an existing file and fail to replace it,
4931 if the user runs out of space. */
4934 /* We can't make a new version;
4935 try to truncate and rewrite existing version if any. */
4937 desc
= emacs_open (fn
, O_RDWR
, 0);
4943 desc
= creat (fn
, 0666);
4947 desc
= emacs_open (fn
,
4948 O_WRONLY
| O_CREAT
| buffer_file_type
4949 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4950 S_IREAD
| S_IWRITE
);
4951 #else /* not DOS_NT */
4952 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4953 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4954 auto_saving
? auto_save_mode_bits
: 0666);
4955 #endif /* not DOS_NT */
4956 #endif /* not VMS */
4960 #ifdef CLASH_DETECTION
4962 if (!auto_saving
) unlock_file (lockname
);
4964 #endif /* CLASH_DETECTION */
4966 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4969 record_unwind_protect (close_file_unwind
, make_number (desc
));
4971 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4975 if (NUMBERP (append
))
4976 ret
= lseek (desc
, XINT (append
), 1);
4978 ret
= lseek (desc
, 0, 2);
4981 #ifdef CLASH_DETECTION
4982 if (!auto_saving
) unlock_file (lockname
);
4983 #endif /* CLASH_DETECTION */
4985 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4993 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4994 * if we do writes that don't end with a carriage return. Furthermore
4995 * it cannot handle writes of more then 16K. The modified
4996 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4997 * this EXCEPT for the last record (iff it doesn't end with a carriage
4998 * return). This implies that if your buffer doesn't end with a carriage
4999 * return, you get one free... tough. However it also means that if
5000 * we make two calls to sys_write (a la the following code) you can
5001 * get one at the gap as well. The easiest way to fix this (honest)
5002 * is to move the gap to the next newline (or the end of the buffer).
5007 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5008 move_gap (find_next_newline (GPT
, 1));
5010 /* Whether VMS or not, we must move the gap to the next of newline
5011 when we must put designation sequences at beginning of line. */
5012 if (INTEGERP (start
)
5013 && coding
.type
== coding_type_iso2022
5014 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5015 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5017 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5018 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5019 move_gap_both (PT
, PT_BYTE
);
5020 SET_PT_BOTH (opoint
, opoint_byte
);
5027 if (STRINGP (start
))
5029 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5030 &annotations
, &coding
);
5033 else if (XINT (start
) != XINT (end
))
5035 tem
= CHAR_TO_BYTE (XINT (start
));
5037 if (XINT (start
) < GPT
)
5039 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5040 min (GPT
, XINT (end
)) - XINT (start
),
5041 &annotations
, &coding
);
5045 if (XINT (end
) > GPT
&& !failure
)
5047 tem
= max (XINT (start
), GPT
);
5048 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5049 &annotations
, &coding
);
5055 /* If file was empty, still need to write the annotations */
5056 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5057 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5061 if (CODING_REQUIRE_FLUSHING (&coding
)
5062 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5065 /* We have to flush out a data. */
5066 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5067 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5074 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5075 Disk full in NFS may be reported here. */
5076 /* mib says that closing the file will try to write as fast as NFS can do
5077 it, and that means the fsync here is not crucial for autosave files. */
5078 if (!auto_saving
&& fsync (desc
) < 0)
5080 /* If fsync fails with EINTR, don't treat that as serious. */
5082 failure
= 1, save_errno
= errno
;
5086 /* Spurious "file has changed on disk" warnings have been
5087 observed on Suns as well.
5088 It seems that `close' can change the modtime, under nfs.
5090 (This has supposedly been fixed in Sunos 4,
5091 but who knows about all the other machines with NFS?) */
5094 /* On VMS and APOLLO, must do the stat after the close
5095 since closing changes the modtime. */
5098 /* Recall that #if defined does not work on VMS. */
5105 /* NFS can report a write failure now. */
5106 if (emacs_close (desc
) < 0)
5107 failure
= 1, save_errno
= errno
;
5110 /* If we wrote to a temporary name and had no errors, rename to real name. */
5114 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5122 /* Discard the unwind protect for close_file_unwind. */
5123 specpdl_ptr
= specpdl
+ count1
;
5124 /* Restore the original current buffer. */
5125 visit_file
= unbind_to (count
, visit_file
);
5127 #ifdef CLASH_DETECTION
5129 unlock_file (lockname
);
5130 #endif /* CLASH_DETECTION */
5132 /* Do this before reporting IO error
5133 to avoid a "file has changed on disk" warning on
5134 next attempt to save. */
5136 current_buffer
->modtime
= st
.st_mtime
;
5139 error ("IO error writing %s: %s", SDATA (filename
),
5140 emacs_strerror (save_errno
));
5144 SAVE_MODIFF
= MODIFF
;
5145 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5146 current_buffer
->filename
= visit_file
;
5147 update_mode_lines
++;
5153 message_with_string ("Wrote %s", visit_file
, 1);
5158 Lisp_Object
merge ();
5160 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5161 doc
: /* Return t if (car A) is numerically less than (car B). */)
5165 return Flss (Fcar (a
), Fcar (b
));
5168 /* Build the complete list of annotations appropriate for writing out
5169 the text between START and END, by calling all the functions in
5170 write-region-annotate-functions and merging the lists they return.
5171 If one of these functions switches to a different buffer, we assume
5172 that buffer contains altered text. Therefore, the caller must
5173 make sure to restore the current buffer in all cases,
5174 as save-excursion would do. */
5177 build_annotations (start
, end
)
5178 Lisp_Object start
, end
;
5180 Lisp_Object annotations
;
5182 struct gcpro gcpro1
, gcpro2
;
5183 Lisp_Object original_buffer
;
5186 XSETBUFFER (original_buffer
, current_buffer
);
5189 p
= Vwrite_region_annotate_functions
;
5190 GCPRO2 (annotations
, p
);
5193 struct buffer
*given_buffer
= current_buffer
;
5194 Vwrite_region_annotations_so_far
= annotations
;
5195 res
= call2 (XCAR (p
), start
, end
);
5196 /* If the function makes a different buffer current,
5197 assume that means this buffer contains altered text to be output.
5198 Reset START and END from the buffer bounds
5199 and discard all previous annotations because they should have
5200 been dealt with by this function. */
5201 if (current_buffer
!= given_buffer
)
5203 XSETFASTINT (start
, BEGV
);
5204 XSETFASTINT (end
, ZV
);
5207 Flength (res
); /* Check basic validity of return value */
5208 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5212 /* Now do the same for annotation functions implied by the file-format */
5213 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5214 p
= Vauto_save_file_format
;
5216 p
= current_buffer
->file_format
;
5217 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5219 struct buffer
*given_buffer
= current_buffer
;
5221 Vwrite_region_annotations_so_far
= annotations
;
5223 /* Value is either a list of annotations or nil if the function
5224 has written annotations to a temporary buffer, which is now
5226 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5227 original_buffer
, make_number (i
));
5228 if (current_buffer
!= given_buffer
)
5230 XSETFASTINT (start
, BEGV
);
5231 XSETFASTINT (end
, ZV
);
5236 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5244 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5245 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5247 struct gcpro gcpro1
;
5250 GCPRO1 (annotations
);
5251 /* At last, do the same for the function PRE_WRITE_CONVERSION
5252 implied by the current coding-system. */
5253 if (!NILP (pre_write_conversion
))
5255 struct buffer
*given_buffer
= current_buffer
;
5256 Vwrite_region_annotations_so_far
= annotations
;
5257 res
= call2 (pre_write_conversion
, start
, end
);
5259 annotations
= (current_buffer
!= given_buffer
5261 : merge (annotations
, res
, Qcar_less_than_car
));
5268 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5269 If STRING is nil, POS is the character position in the current buffer.
5270 Intersperse with them the annotations from *ANNOT
5271 which fall within the range of POS to POS + NCHARS,
5272 each at its appropriate position.
5274 We modify *ANNOT by discarding elements as we use them up.
5276 The return value is negative in case of system call failure. */
5279 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5282 register int nchars
;
5285 struct coding_system
*coding
;
5289 int lastpos
= pos
+ nchars
;
5291 while (NILP (*annot
) || CONSP (*annot
))
5293 tem
= Fcar_safe (Fcar (*annot
));
5296 nextpos
= XFASTINT (tem
);
5298 /* If there are no more annotations in this range,
5299 output the rest of the range all at once. */
5300 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5301 return e_write (desc
, string
, pos
, lastpos
, coding
);
5303 /* Output buffer text up to the next annotation's position. */
5306 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5310 /* Output the annotation. */
5311 tem
= Fcdr (Fcar (*annot
));
5314 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5317 *annot
= Fcdr (*annot
);
5322 #ifndef WRITE_BUF_SIZE
5323 #define WRITE_BUF_SIZE (16 * 1024)
5326 /* Write text in the range START and END into descriptor DESC,
5327 encoding them with coding system CODING. If STRING is nil, START
5328 and END are character positions of the current buffer, else they
5329 are indexes to the string STRING. */
5332 e_write (desc
, string
, start
, end
, coding
)
5336 struct coding_system
*coding
;
5338 register char *addr
;
5339 register int nbytes
;
5340 char buf
[WRITE_BUF_SIZE
];
5344 coding
->composing
= COMPOSITION_DISABLED
;
5345 if (coding
->composing
!= COMPOSITION_DISABLED
)
5346 coding_save_composition (coding
, start
, end
, string
);
5348 if (STRINGP (string
))
5350 addr
= SDATA (string
);
5351 nbytes
= SBYTES (string
);
5352 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5354 else if (start
< end
)
5356 /* It is assured that the gap is not in the range START and END-1. */
5357 addr
= CHAR_POS_ADDR (start
);
5358 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5359 coding
->src_multibyte
5360 = !NILP (current_buffer
->enable_multibyte_characters
);
5366 coding
->src_multibyte
= 1;
5369 /* We used to have a code for handling selective display here. But,
5370 now it is handled within encode_coding. */
5375 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5376 if (coding
->produced
> 0)
5378 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5379 if (coding
->produced
)
5385 nbytes
-= coding
->consumed
;
5386 addr
+= coding
->consumed
;
5387 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5390 /* The source text ends by an incomplete multibyte form.
5391 There's no way other than write it out as is. */
5392 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5401 start
+= coding
->consumed_char
;
5402 if (coding
->cmp_data
)
5403 coding_adjust_composition_offset (coding
, start
);
5406 if (coding
->cmp_data
)
5407 coding_free_composition_data (coding
);
5412 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5413 Sverify_visited_file_modtime
, 1, 1, 0,
5414 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5415 This means that the file has not been changed since it was visited or saved. */)
5421 Lisp_Object handler
;
5422 Lisp_Object filename
;
5427 if (!STRINGP (b
->filename
)) return Qt
;
5428 if (b
->modtime
== 0) return Qt
;
5430 /* If the file name has special constructs in it,
5431 call the corresponding file handler. */
5432 handler
= Ffind_file_name_handler (b
->filename
,
5433 Qverify_visited_file_modtime
);
5434 if (!NILP (handler
))
5435 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5437 filename
= ENCODE_FILE (b
->filename
);
5439 if (stat (SDATA (filename
), &st
) < 0)
5441 /* If the file doesn't exist now and didn't exist before,
5442 we say that it isn't modified, provided the error is a tame one. */
5443 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5448 if (st
.st_mtime
== b
->modtime
5449 /* If both are positive, accept them if they are off by one second. */
5450 || (st
.st_mtime
> 0 && b
->modtime
> 0
5451 && (st
.st_mtime
== b
->modtime
+ 1
5452 || st
.st_mtime
== b
->modtime
- 1)))
5457 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5458 Sclear_visited_file_modtime
, 0, 0, 0,
5459 doc
: /* Clear out records of last mod time of visited file.
5460 Next attempt to save will certainly not complain of a discrepancy. */)
5463 current_buffer
->modtime
= 0;
5467 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5468 Svisited_file_modtime
, 0, 0, 0,
5469 doc
: /* Return the current buffer's recorded visited file modification time.
5470 The value is a list of the form (HIGH . LOW), like the time values
5471 that `file-attributes' returns. */)
5474 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5477 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5478 Sset_visited_file_modtime
, 0, 1, 0,
5479 doc
: /* Update buffer's recorded modification time from the visited file's time.
5480 Useful if the buffer was not read from the file normally
5481 or if the file itself has been changed for some known benign reason.
5482 An argument specifies the modification time value to use
5483 \(instead of that of the visited file), in the form of a list
5484 \(HIGH . LOW) or (HIGH LOW). */)
5486 Lisp_Object time_list
;
5488 if (!NILP (time_list
))
5489 current_buffer
->modtime
= cons_to_long (time_list
);
5492 register Lisp_Object filename
;
5494 Lisp_Object handler
;
5496 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5498 /* If the file name has special constructs in it,
5499 call the corresponding file handler. */
5500 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5501 if (!NILP (handler
))
5502 /* The handler can find the file name the same way we did. */
5503 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5505 filename
= ENCODE_FILE (filename
);
5507 if (stat (SDATA (filename
), &st
) >= 0)
5508 current_buffer
->modtime
= st
.st_mtime
;
5515 auto_save_error (error
)
5518 Lisp_Object args
[3], msg
;
5520 struct gcpro gcpro1
;
5524 args
[0] = build_string ("Auto-saving %s: %s");
5525 args
[1] = current_buffer
->name
;
5526 args
[2] = Ferror_message_string (error
);
5527 msg
= Fformat (3, args
);
5529 nbytes
= SBYTES (msg
);
5531 for (i
= 0; i
< 3; ++i
)
5534 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5536 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5537 Fsleep_for (make_number (1), Qnil
);
5549 /* Get visited file's mode to become the auto save file's mode. */
5550 if (! NILP (current_buffer
->filename
)
5551 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5552 /* But make sure we can overwrite it later! */
5553 auto_save_mode_bits
= st
.st_mode
| 0600;
5555 auto_save_mode_bits
= 0666;
5558 Fwrite_region (Qnil
, Qnil
,
5559 current_buffer
->auto_save_file_name
,
5560 Qnil
, Qlambda
, Qnil
, Qnil
);
5564 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5569 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5570 | XFASTINT (XCDR (stream
))));
5575 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5578 minibuffer_auto_raise
= XINT (value
);
5583 do_auto_save_make_dir (dir
)
5586 return call2 (Qmake_directory
, dir
, Qt
);
5590 do_auto_save_eh (ignore
)
5596 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5597 doc
: /* Auto-save all buffers that need it.
5598 This is all buffers that have auto-saving enabled
5599 and are changed since last auto-saved.
5600 Auto-saving writes the buffer into a file
5601 so that your editing is not lost if the system crashes.
5602 This file is not the file you visited; that changes only when you save.
5603 Normally we run the normal hook `auto-save-hook' before saving.
5605 A non-nil NO-MESSAGE argument means do not print any message if successful.
5606 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5607 (no_message
, current_only
)
5608 Lisp_Object no_message
, current_only
;
5610 struct buffer
*old
= current_buffer
, *b
;
5611 Lisp_Object tail
, buf
;
5613 int do_handled_files
;
5616 Lisp_Object lispstream
;
5617 int count
= SPECPDL_INDEX ();
5618 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5619 int old_message_p
= 0;
5621 if (max_specpdl_size
< specpdl_size
+ 40)
5622 max_specpdl_size
= specpdl_size
+ 40;
5627 if (NILP (no_message
))
5629 old_message_p
= push_message ();
5630 record_unwind_protect (pop_message_unwind
, Qnil
);
5633 /* Ordinarily don't quit within this function,
5634 but don't make it impossible to quit (in case we get hung in I/O). */
5638 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5639 point to non-strings reached from Vbuffer_alist. */
5641 if (!NILP (Vrun_hooks
))
5642 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5644 if (STRINGP (Vauto_save_list_file_name
))
5646 Lisp_Object listfile
;
5648 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5650 /* Don't try to create the directory when shutting down Emacs,
5651 because creating the directory might signal an error, and
5652 that would leave Emacs in a strange state. */
5653 if (!NILP (Vrun_hooks
))
5656 dir
= Ffile_name_directory (listfile
);
5657 if (NILP (Ffile_directory_p (dir
)))
5658 internal_condition_case_1 (do_auto_save_make_dir
,
5659 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5663 stream
= fopen (SDATA (listfile
), "w");
5666 /* Arrange to close that file whether or not we get an error.
5667 Also reset auto_saving to 0. */
5668 lispstream
= Fcons (Qnil
, Qnil
);
5669 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5670 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5681 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5682 record_unwind_protect (do_auto_save_unwind_1
,
5683 make_number (minibuffer_auto_raise
));
5684 minibuffer_auto_raise
= 0;
5687 /* First, save all files which don't have handlers. If Emacs is
5688 crashing, the handlers may tweak what is causing Emacs to crash
5689 in the first place, and it would be a shame if Emacs failed to
5690 autosave perfectly ordinary files because it couldn't handle some
5692 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5693 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5695 buf
= XCDR (XCAR (tail
));
5698 /* Record all the buffers that have auto save mode
5699 in the special file that lists them. For each of these buffers,
5700 Record visited name (if any) and auto save name. */
5701 if (STRINGP (b
->auto_save_file_name
)
5702 && stream
!= NULL
&& do_handled_files
== 0)
5704 if (!NILP (b
->filename
))
5706 fwrite (SDATA (b
->filename
), 1,
5707 SBYTES (b
->filename
), stream
);
5709 putc ('\n', stream
);
5710 fwrite (SDATA (b
->auto_save_file_name
), 1,
5711 SBYTES (b
->auto_save_file_name
), stream
);
5712 putc ('\n', stream
);
5715 if (!NILP (current_only
)
5716 && b
!= current_buffer
)
5719 /* Don't auto-save indirect buffers.
5720 The base buffer takes care of it. */
5724 /* Check for auto save enabled
5725 and file changed since last auto save
5726 and file changed since last real save. */
5727 if (STRINGP (b
->auto_save_file_name
)
5728 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5729 && b
->auto_save_modified
< BUF_MODIFF (b
)
5730 /* -1 means we've turned off autosaving for a while--see below. */
5731 && XINT (b
->save_length
) >= 0
5732 && (do_handled_files
5733 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5736 EMACS_TIME before_time
, after_time
;
5738 EMACS_GET_TIME (before_time
);
5740 /* If we had a failure, don't try again for 20 minutes. */
5741 if (b
->auto_save_failure_time
>= 0
5742 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5745 if ((XFASTINT (b
->save_length
) * 10
5746 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5747 /* A short file is likely to change a large fraction;
5748 spare the user annoying messages. */
5749 && XFASTINT (b
->save_length
) > 5000
5750 /* These messages are frequent and annoying for `*mail*'. */
5751 && !EQ (b
->filename
, Qnil
)
5752 && NILP (no_message
))
5754 /* It has shrunk too much; turn off auto-saving here. */
5755 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5756 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5758 minibuffer_auto_raise
= 0;
5759 /* Turn off auto-saving until there's a real save,
5760 and prevent any more warnings. */
5761 XSETINT (b
->save_length
, -1);
5762 Fsleep_for (make_number (1), Qnil
);
5765 set_buffer_internal (b
);
5766 if (!auto_saved
&& NILP (no_message
))
5767 message1 ("Auto-saving...");
5768 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5770 b
->auto_save_modified
= BUF_MODIFF (b
);
5771 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5772 set_buffer_internal (old
);
5774 EMACS_GET_TIME (after_time
);
5776 /* If auto-save took more than 60 seconds,
5777 assume it was an NFS failure that got a timeout. */
5778 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5779 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5783 /* Prevent another auto save till enough input events come in. */
5784 record_auto_save ();
5786 if (auto_saved
&& NILP (no_message
))
5790 /* If we are going to restore an old message,
5791 give time to read ours. */
5792 sit_for (1, 0, 0, 0, 0);
5796 /* If we displayed a message and then restored a state
5797 with no message, leave a "done" message on the screen. */
5798 message1 ("Auto-saving...done");
5803 /* This restores the message-stack status. */
5804 unbind_to (count
, Qnil
);
5808 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5809 Sset_buffer_auto_saved
, 0, 0, 0,
5810 doc
: /* Mark current buffer as auto-saved with its current text.
5811 No auto-save file will be written until the buffer changes again. */)
5814 current_buffer
->auto_save_modified
= MODIFF
;
5815 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5816 current_buffer
->auto_save_failure_time
= -1;
5820 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5821 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5822 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5825 current_buffer
->auto_save_failure_time
= -1;
5829 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5831 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
5834 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5837 /* Reading and completing file names */
5838 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5840 /* In the string VAL, change each $ to $$ and return the result. */
5843 double_dollars (val
)
5846 register const unsigned char *old
;
5847 register unsigned char *new;
5851 osize
= SBYTES (val
);
5853 /* Count the number of $ characters. */
5854 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
5855 if (*old
++ == '$') count
++;
5859 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
5862 for (n
= osize
; n
> 0; n
--)
5876 read_file_name_cleanup (arg
)
5879 return (current_buffer
->directory
= arg
);
5882 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5884 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
5885 (string
, dir
, action
)
5886 Lisp_Object string
, dir
, action
;
5887 /* action is nil for complete, t for return list of completions,
5888 lambda for verify final value */
5890 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5892 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5894 CHECK_STRING (string
);
5901 /* No need to protect ACTION--we only compare it with t and nil. */
5902 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5904 if (SCHARS (string
) == 0)
5906 if (EQ (action
, Qlambda
))
5914 orig_string
= string
;
5915 string
= Fsubstitute_in_file_name (string
);
5916 changed
= NILP (Fstring_equal (string
, orig_string
));
5917 name
= Ffile_name_nondirectory (string
);
5918 val
= Ffile_name_directory (string
);
5920 realdir
= Fexpand_file_name (val
, realdir
);
5925 specdir
= Ffile_name_directory (string
);
5926 val
= Ffile_name_completion (name
, realdir
);
5931 return double_dollars (string
);
5935 if (!NILP (specdir
))
5936 val
= concat2 (specdir
, val
);
5938 return double_dollars (val
);
5941 #endif /* not VMS */
5945 if (EQ (action
, Qt
))
5947 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
5951 if (NILP (Vread_file_name_predicate
)
5952 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
5956 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
5958 /* Brute-force speed up for directory checking:
5959 Discard strings which don't end in a slash. */
5960 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
5962 Lisp_Object tem
= XCAR (all
);
5964 if (STRINGP (tem
) &&
5965 (len
= SCHARS (tem
), len
> 0) &&
5966 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
5967 comp
= Fcons (tem
, comp
);
5973 /* Must do it the hard (and slow) way. */
5974 GCPRO3 (all
, comp
, specdir
);
5975 count
= SPECPDL_INDEX ();
5976 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
5977 current_buffer
->directory
= realdir
;
5978 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
5979 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
5980 comp
= Fcons (XCAR (all
), comp
);
5981 unbind_to (count
, Qnil
);
5984 return Fnreverse (comp
);
5987 /* Only other case actually used is ACTION = lambda */
5989 /* Supposedly this helps commands such as `cd' that read directory names,
5990 but can someone explain how it helps them? -- RMS */
5991 if (SCHARS (name
) == 0)
5994 if (!NILP (Vread_file_name_predicate
))
5995 return call1 (Vread_file_name_predicate
, string
);
5996 return Ffile_exists_p (string
);
5999 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6000 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6001 Value is not expanded---you must call `expand-file-name' yourself.
6002 Default name to DEFAULT-FILENAME if user enters a null string.
6003 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6004 except that if INITIAL is specified, that combined with DIR is used.)
6005 Fourth arg MUSTMATCH non-nil means require existing file's name.
6006 Non-nil and non-t means also require confirmation after completion.
6007 Fifth arg INITIAL specifies text to start with.
6008 If optional sixth arg PREDICATE is non-nil, possible completions and the
6009 resulting file name must satisfy (funcall PREDICATE NAME).
6010 DIR defaults to current buffer's directory default.
6012 If this command was invoked with the mouse, use a file dialog box if
6013 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6014 provides a file dialog box. */)
6015 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6016 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6018 Lisp_Object val
, insdef
, tem
;
6019 struct gcpro gcpro1
, gcpro2
;
6020 register char *homedir
;
6021 int replace_in_history
= 0;
6022 int add_to_history
= 0;
6026 dir
= current_buffer
->directory
;
6027 if (NILP (default_filename
))
6028 default_filename
= !NILP (initial
)
6029 ? Fexpand_file_name (initial
, dir
)
6030 : current_buffer
->filename
;
6032 /* If dir starts with user's homedir, change that to ~. */
6033 homedir
= (char *) egetenv ("HOME");
6035 /* homedir can be NULL in temacs, since Vprocess_environment is not
6036 yet set up. We shouldn't crash in that case. */
6039 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6040 CORRECT_DIR_SEPS (homedir
);
6045 && !strncmp (homedir
, SDATA (dir
), strlen (homedir
))
6046 && IS_DIRECTORY_SEP (SREF (dir
, strlen (homedir
))))
6048 dir
= make_string (SDATA (dir
) + strlen (homedir
) - 1,
6049 SBYTES (dir
) - strlen (homedir
) + 1);
6052 /* Likewise for default_filename. */
6054 && STRINGP (default_filename
)
6055 && !strncmp (homedir
, SDATA (default_filename
), strlen (homedir
))
6056 && IS_DIRECTORY_SEP (SREF (default_filename
, strlen (homedir
))))
6059 = make_string (SDATA (default_filename
) + strlen (homedir
) - 1,
6060 SBYTES (default_filename
) - strlen (homedir
) + 1);
6061 SSET (default_filename
, 0, '~');
6063 if (!NILP (default_filename
))
6065 CHECK_STRING (default_filename
);
6066 default_filename
= double_dollars (default_filename
);
6069 if (insert_default_directory
&& STRINGP (dir
))
6072 if (!NILP (initial
))
6074 Lisp_Object args
[2], pos
;
6078 insdef
= Fconcat (2, args
);
6079 pos
= make_number (SCHARS (double_dollars (dir
)));
6080 insdef
= Fcons (double_dollars (insdef
), pos
);
6083 insdef
= double_dollars (insdef
);
6085 else if (STRINGP (initial
))
6086 insdef
= Fcons (double_dollars (initial
), make_number (0));
6090 if (!NILP (Vread_file_name_function
))
6092 Lisp_Object args
[7];
6094 GCPRO2 (insdef
, default_filename
);
6095 args
[0] = Vread_file_name_function
;
6098 args
[3] = default_filename
;
6099 args
[4] = mustmatch
;
6101 args
[6] = predicate
;
6102 RETURN_UNGCPRO (Ffuncall (7, args
));
6105 count
= SPECPDL_INDEX ();
6107 specbind (intern ("completion-ignore-case"), Qt
);
6110 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6111 specbind (intern ("read-file-name-predicate"),
6112 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6114 GCPRO2 (insdef
, default_filename
);
6116 #if defined (USE_MOTIF) || defined (HAVE_NTGUI)
6117 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6121 /* If DIR contains a file name, split it. */
6123 file
= Ffile_name_nondirectory (dir
);
6124 if (SCHARS (file
) && NILP (default_filename
))
6126 default_filename
= file
;
6127 dir
= Ffile_name_directory (dir
);
6129 if (!NILP(default_filename
))
6130 default_filename
= Fexpand_file_name (default_filename
, dir
);
6131 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6136 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6137 dir
, mustmatch
, insdef
,
6138 Qfile_name_history
, default_filename
, Qnil
);
6140 tem
= Fsymbol_value (Qfile_name_history
);
6141 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6142 replace_in_history
= 1;
6144 /* If Fcompleting_read returned the inserted default string itself
6145 (rather than a new string with the same contents),
6146 it has to mean that the user typed RET with the minibuffer empty.
6147 In that case, we really want to return ""
6148 so that commands such as set-visited-file-name can distinguish. */
6149 if (EQ (val
, default_filename
))
6151 /* In this case, Fcompleting_read has not added an element
6152 to the history. Maybe we should. */
6153 if (! replace_in_history
)
6159 unbind_to (count
, Qnil
);
6162 error ("No file name specified");
6164 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6166 if (!NILP (tem
) && !NILP (default_filename
))
6167 val
= default_filename
;
6168 else if (SCHARS (val
) == 0 && NILP (insdef
))
6170 if (!NILP (default_filename
))
6171 val
= default_filename
;
6173 error ("No default file name");
6175 val
= Fsubstitute_in_file_name (val
);
6177 if (replace_in_history
)
6178 /* Replace what Fcompleting_read added to the history
6179 with what we will actually return. */
6180 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6181 else if (add_to_history
)
6183 /* Add the value to the history--but not if it matches
6184 the last value already there. */
6185 Lisp_Object val1
= double_dollars (val
);
6186 tem
= Fsymbol_value (Qfile_name_history
);
6187 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6188 Fset (Qfile_name_history
,
6199 /* Must be set before any path manipulation is performed. */
6200 XSETFASTINT (Vdirectory_sep_char
, '/');
6207 Qexpand_file_name
= intern ("expand-file-name");
6208 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6209 Qdirectory_file_name
= intern ("directory-file-name");
6210 Qfile_name_directory
= intern ("file-name-directory");
6211 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6212 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6213 Qfile_name_as_directory
= intern ("file-name-as-directory");
6214 Qcopy_file
= intern ("copy-file");
6215 Qmake_directory_internal
= intern ("make-directory-internal");
6216 Qmake_directory
= intern ("make-directory");
6217 Qdelete_directory
= intern ("delete-directory");
6218 Qdelete_file
= intern ("delete-file");
6219 Qrename_file
= intern ("rename-file");
6220 Qadd_name_to_file
= intern ("add-name-to-file");
6221 Qmake_symbolic_link
= intern ("make-symbolic-link");
6222 Qfile_exists_p
= intern ("file-exists-p");
6223 Qfile_executable_p
= intern ("file-executable-p");
6224 Qfile_readable_p
= intern ("file-readable-p");
6225 Qfile_writable_p
= intern ("file-writable-p");
6226 Qfile_symlink_p
= intern ("file-symlink-p");
6227 Qaccess_file
= intern ("access-file");
6228 Qfile_directory_p
= intern ("file-directory-p");
6229 Qfile_regular_p
= intern ("file-regular-p");
6230 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6231 Qfile_modes
= intern ("file-modes");
6232 Qset_file_modes
= intern ("set-file-modes");
6233 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6234 Qinsert_file_contents
= intern ("insert-file-contents");
6235 Qwrite_region
= intern ("write-region");
6236 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6237 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6239 staticpro (&Qexpand_file_name
);
6240 staticpro (&Qsubstitute_in_file_name
);
6241 staticpro (&Qdirectory_file_name
);
6242 staticpro (&Qfile_name_directory
);
6243 staticpro (&Qfile_name_nondirectory
);
6244 staticpro (&Qunhandled_file_name_directory
);
6245 staticpro (&Qfile_name_as_directory
);
6246 staticpro (&Qcopy_file
);
6247 staticpro (&Qmake_directory_internal
);
6248 staticpro (&Qmake_directory
);
6249 staticpro (&Qdelete_directory
);
6250 staticpro (&Qdelete_file
);
6251 staticpro (&Qrename_file
);
6252 staticpro (&Qadd_name_to_file
);
6253 staticpro (&Qmake_symbolic_link
);
6254 staticpro (&Qfile_exists_p
);
6255 staticpro (&Qfile_executable_p
);
6256 staticpro (&Qfile_readable_p
);
6257 staticpro (&Qfile_writable_p
);
6258 staticpro (&Qaccess_file
);
6259 staticpro (&Qfile_symlink_p
);
6260 staticpro (&Qfile_directory_p
);
6261 staticpro (&Qfile_regular_p
);
6262 staticpro (&Qfile_accessible_directory_p
);
6263 staticpro (&Qfile_modes
);
6264 staticpro (&Qset_file_modes
);
6265 staticpro (&Qfile_newer_than_file_p
);
6266 staticpro (&Qinsert_file_contents
);
6267 staticpro (&Qwrite_region
);
6268 staticpro (&Qverify_visited_file_modtime
);
6269 staticpro (&Qset_visited_file_modtime
);
6271 Qfile_name_history
= intern ("file-name-history");
6272 Fset (Qfile_name_history
, Qnil
);
6273 staticpro (&Qfile_name_history
);
6275 Qfile_error
= intern ("file-error");
6276 staticpro (&Qfile_error
);
6277 Qfile_already_exists
= intern ("file-already-exists");
6278 staticpro (&Qfile_already_exists
);
6279 Qfile_date_error
= intern ("file-date-error");
6280 staticpro (&Qfile_date_error
);
6281 Qexcl
= intern ("excl");
6285 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6286 staticpro (&Qfind_buffer_file_type
);
6289 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6290 doc
: /* *Coding system for encoding file names.
6291 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6292 Vfile_name_coding_system
= Qnil
;
6294 DEFVAR_LISP ("default-file-name-coding-system",
6295 &Vdefault_file_name_coding_system
,
6296 doc
: /* Default coding system for encoding file names.
6297 This variable is used only when `file-name-coding-system' is nil.
6299 This variable is set/changed by the command `set-language-environment'.
6300 User should not set this variable manually,
6301 instead use `file-name-coding-system' to get a constant encoding
6302 of file names regardless of the current language environment. */);
6303 Vdefault_file_name_coding_system
= Qnil
;
6305 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6306 doc
: /* *Format in which to write auto-save files.
6307 Should be a list of symbols naming formats that are defined in `format-alist'.
6308 If it is t, which is the default, auto-save files are written in the
6309 same format as a regular save would use. */);
6310 Vauto_save_file_format
= Qt
;
6312 Qformat_decode
= intern ("format-decode");
6313 staticpro (&Qformat_decode
);
6314 Qformat_annotate_function
= intern ("format-annotate-function");
6315 staticpro (&Qformat_annotate_function
);
6317 Qcar_less_than_car
= intern ("car-less-than-car");
6318 staticpro (&Qcar_less_than_car
);
6320 Fput (Qfile_error
, Qerror_conditions
,
6321 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6322 Fput (Qfile_error
, Qerror_message
,
6323 build_string ("File error"));
6325 Fput (Qfile_already_exists
, Qerror_conditions
,
6326 Fcons (Qfile_already_exists
,
6327 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6328 Fput (Qfile_already_exists
, Qerror_message
,
6329 build_string ("File already exists"));
6331 Fput (Qfile_date_error
, Qerror_conditions
,
6332 Fcons (Qfile_date_error
,
6333 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6334 Fput (Qfile_date_error
, Qerror_message
,
6335 build_string ("Cannot set file date"));
6337 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6338 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6339 Vread_file_name_function
= Qnil
;
6341 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6342 doc
: /* Current predicate used by `read-file-name-internal'. */);
6343 Vread_file_name_predicate
= Qnil
;
6345 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6346 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer. */);
6347 insert_default_directory
= 1;
6349 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6350 doc
: /* *Non-nil means write new files with record format `stmlf'.
6351 nil means use format `var'. This variable is meaningful only on VMS. */);
6352 vms_stmlf_recfm
= 0;
6354 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6355 doc
: /* Directory separator character for built-in functions that return file names.
6356 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
6357 This variable affects the built-in functions only on Windows,
6358 on other platforms, it is initialized so that Lisp code can find out
6359 what the normal separator is. */);
6361 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6362 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6363 If a file name matches REGEXP, then all I/O on that file is done by calling
6366 The first argument given to HANDLER is the name of the I/O primitive
6367 to be handled; the remaining arguments are the arguments that were
6368 passed to that primitive. For example, if you do
6369 (file-exists-p FILENAME)
6370 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6371 (funcall HANDLER 'file-exists-p FILENAME)
6372 The function `find-file-name-handler' checks this list for a handler
6373 for its argument. */);
6374 Vfile_name_handler_alist
= Qnil
;
6376 DEFVAR_LISP ("set-auto-coding-function",
6377 &Vset_auto_coding_function
,
6378 doc
: /* If non-nil, a function to call to decide a coding system of file.
6379 Two arguments are passed to this function: the file name
6380 and the length of a file contents following the point.
6381 This function should return a coding system to decode the file contents.
6382 It should check the file name against `auto-coding-alist'.
6383 If no coding system is decided, it should check a coding system
6384 specified in the heading lines with the format:
6385 -*- ... coding: CODING-SYSTEM; ... -*-
6386 or local variable spec of the tailing lines with `coding:' tag. */);
6387 Vset_auto_coding_function
= Qnil
;
6389 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6390 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6391 Each is passed one argument, the number of bytes inserted. It should return
6392 the new byte count, and leave point the same. If `insert-file-contents' is
6393 intercepted by a handler from `file-name-handler-alist', that handler is
6394 responsible for calling the after-insert-file-functions if appropriate. */);
6395 Vafter_insert_file_functions
= Qnil
;
6397 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6398 doc
: /* A list of functions to be called at the start of `write-region'.
6399 Each is passed two arguments, START and END as for `write-region'.
6400 These are usually two numbers but not always; see the documentation
6401 for `write-region'. The function should return a list of pairs
6402 of the form (POSITION . STRING), consisting of strings to be effectively
6403 inserted at the specified positions of the file being written (1 means to
6404 insert before the first byte written). The POSITIONs must be sorted into
6405 increasing order. If there are several functions in the list, the several
6406 lists are merged destructively. Alternatively, the function can return
6407 with a different buffer current and value nil.*/);
6408 Vwrite_region_annotate_functions
= Qnil
;
6410 DEFVAR_LISP ("write-region-annotations-so-far",
6411 &Vwrite_region_annotations_so_far
,
6412 doc
: /* When an annotation function is called, this holds the previous annotations.
6413 These are the annotations made by other annotation functions
6414 that were already called. See also `write-region-annotate-functions'. */);
6415 Vwrite_region_annotations_so_far
= Qnil
;
6417 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6418 doc
: /* A list of file name handlers that temporarily should not be used.
6419 This applies only to the operation `inhibit-file-name-operation'. */);
6420 Vinhibit_file_name_handlers
= Qnil
;
6422 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6423 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6424 Vinhibit_file_name_operation
= Qnil
;
6426 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6427 doc
: /* File name in which we write a list of all auto save file names.
6428 This variable is initialized automatically from `auto-save-list-file-prefix'
6429 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6430 a non-nil value. */);
6431 Vauto_save_list_file_name
= Qnil
;
6433 defsubr (&Sfind_file_name_handler
);
6434 defsubr (&Sfile_name_directory
);
6435 defsubr (&Sfile_name_nondirectory
);
6436 defsubr (&Sunhandled_file_name_directory
);
6437 defsubr (&Sfile_name_as_directory
);
6438 defsubr (&Sdirectory_file_name
);
6439 defsubr (&Smake_temp_name
);
6440 defsubr (&Sexpand_file_name
);
6441 defsubr (&Ssubstitute_in_file_name
);
6442 defsubr (&Scopy_file
);
6443 defsubr (&Smake_directory_internal
);
6444 defsubr (&Sdelete_directory
);
6445 defsubr (&Sdelete_file
);
6446 defsubr (&Srename_file
);
6447 defsubr (&Sadd_name_to_file
);
6449 defsubr (&Smake_symbolic_link
);
6450 #endif /* S_IFLNK */
6452 defsubr (&Sdefine_logical_name
);
6455 defsubr (&Ssysnetunam
);
6456 #endif /* HPUX_NET */
6457 defsubr (&Sfile_name_absolute_p
);
6458 defsubr (&Sfile_exists_p
);
6459 defsubr (&Sfile_executable_p
);
6460 defsubr (&Sfile_readable_p
);
6461 defsubr (&Sfile_writable_p
);
6462 defsubr (&Saccess_file
);
6463 defsubr (&Sfile_symlink_p
);
6464 defsubr (&Sfile_directory_p
);
6465 defsubr (&Sfile_accessible_directory_p
);
6466 defsubr (&Sfile_regular_p
);
6467 defsubr (&Sfile_modes
);
6468 defsubr (&Sset_file_modes
);
6469 defsubr (&Sset_default_file_modes
);
6470 defsubr (&Sdefault_file_modes
);
6471 defsubr (&Sfile_newer_than_file_p
);
6472 defsubr (&Sinsert_file_contents
);
6473 defsubr (&Swrite_region
);
6474 defsubr (&Scar_less_than_car
);
6475 defsubr (&Sverify_visited_file_modtime
);
6476 defsubr (&Sclear_visited_file_modtime
);
6477 defsubr (&Svisited_file_modtime
);
6478 defsubr (&Sset_visited_file_modtime
);
6479 defsubr (&Sdo_auto_save
);
6480 defsubr (&Sset_buffer_auto_saved
);
6481 defsubr (&Sclear_buffer_auto_save_failure
);
6482 defsubr (&Srecent_auto_save_p
);
6484 defsubr (&Sread_file_name_internal
);
6485 defsubr (&Sread_file_name
);
6488 defsubr (&Sunix_sync
);