1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
22 #include <sys/types.h>
29 #if !defined (S_ISLNK) && defined (S_IFLNK)
30 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
33 #if !defined (S_ISREG) && defined (S_IFREG)
34 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
45 #include <sys/param.h>
63 extern char *strerror ();
78 #include "intervals.h"
108 #define min(a, b) ((a) < (b) ? (a) : (b))
109 #define max(a, b) ((a) > (b) ? (a) : (b))
111 /* Nonzero during writing of auto-save files */
114 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
115 a new file with the same mode as the original */
116 int auto_save_mode_bits
;
118 /* Alist of elements (REGEXP . HANDLER) for file names
119 whose I/O is done with a special handler. */
120 Lisp_Object Vfile_name_handler_alist
;
122 /* Functions to be called to process text properties in inserted file. */
123 Lisp_Object Vafter_insert_file_functions
;
125 /* Functions to be called to create text property annotations for file. */
126 Lisp_Object Vwrite_region_annotate_functions
;
128 /* During build_annotations, each time an annotation function is called,
129 this holds the annotations made by the previous functions. */
130 Lisp_Object Vwrite_region_annotations_so_far
;
132 /* File name in which we write a list of all our auto save files. */
133 Lisp_Object Vauto_save_list_file_name
;
135 /* Nonzero means, when reading a filename in the minibuffer,
136 start out by inserting the default directory into the minibuffer. */
137 int insert_default_directory
;
139 /* On VMS, nonzero means write new files with record format stmlf.
140 Zero means use var format. */
143 /* These variables describe handlers that have "already" had a chance
144 to handle the current operation.
146 Vinhibit_file_name_handlers is a list of file name handlers.
147 Vinhibit_file_name_operation is the operation being handled.
148 If we try to handle that operation, we ignore those handlers. */
150 static Lisp_Object Vinhibit_file_name_handlers
;
151 static Lisp_Object Vinhibit_file_name_operation
;
153 Lisp_Object Qfile_error
, Qfile_already_exists
;
155 Lisp_Object Qfile_name_history
;
157 Lisp_Object Qcar_less_than_car
;
159 report_file_error (string
, data
)
163 Lisp_Object errstring
;
165 errstring
= build_string (strerror (errno
));
167 /* System error messages are capitalized. Downcase the initial
168 unless it is followed by a slash. */
169 if (XSTRING (errstring
)->data
[1] != '/')
170 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
173 Fsignal (Qfile_error
,
174 Fcons (build_string (string
), Fcons (errstring
, data
)));
177 close_file_unwind (fd
)
180 close (XFASTINT (fd
));
183 /* Restore point, having saved it as a marker. */
185 restore_point_unwind (location
)
186 Lisp_Object location
;
188 SET_PT (marker_position (location
));
189 Fset_marker (location
, Qnil
, Qnil
);
192 Lisp_Object Qexpand_file_name
;
193 Lisp_Object Qdirectory_file_name
;
194 Lisp_Object Qfile_name_directory
;
195 Lisp_Object Qfile_name_nondirectory
;
196 Lisp_Object Qunhandled_file_name_directory
;
197 Lisp_Object Qfile_name_as_directory
;
198 Lisp_Object Qcopy_file
;
199 Lisp_Object Qmake_directory_internal
;
200 Lisp_Object Qdelete_directory
;
201 Lisp_Object Qdelete_file
;
202 Lisp_Object Qrename_file
;
203 Lisp_Object Qadd_name_to_file
;
204 Lisp_Object Qmake_symbolic_link
;
205 Lisp_Object Qfile_exists_p
;
206 Lisp_Object Qfile_executable_p
;
207 Lisp_Object Qfile_readable_p
;
208 Lisp_Object Qfile_symlink_p
;
209 Lisp_Object Qfile_writable_p
;
210 Lisp_Object Qfile_directory_p
;
211 Lisp_Object Qfile_accessible_directory_p
;
212 Lisp_Object Qfile_modes
;
213 Lisp_Object Qset_file_modes
;
214 Lisp_Object Qfile_newer_than_file_p
;
215 Lisp_Object Qinsert_file_contents
;
216 Lisp_Object Qwrite_region
;
217 Lisp_Object Qverify_visited_file_modtime
;
218 Lisp_Object Qset_visited_file_modtime
;
220 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
221 "Return FILENAME's handler function for OPERATION, if it has one.\n\
222 Otherwise, return nil.\n\
223 A file name is handled if one of the regular expressions in\n\
224 `file-name-handler-alist' matches it.\n\n\
225 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
226 any handlers that are members of `inhibit-file-name-handlers',\n\
227 but we still do run any other handlers. This lets handlers\n\
228 use the standard functions without calling themselves recursively.")
229 (filename
, operation
)
230 Lisp_Object filename
, operation
;
232 /* This function must not munge the match data. */
233 Lisp_Object chain
, inhibited_handlers
;
235 CHECK_STRING (filename
, 0);
237 if (EQ (operation
, Vinhibit_file_name_operation
))
238 inhibited_handlers
= Vinhibit_file_name_handlers
;
240 inhibited_handlers
= Qnil
;
242 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
243 chain
= XCONS (chain
)->cdr
)
246 elt
= XCONS (chain
)->car
;
250 string
= XCONS (elt
)->car
;
251 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
253 Lisp_Object handler
, tem
;
255 handler
= XCONS (elt
)->cdr
;
256 tem
= Fmemq (handler
, inhibited_handlers
);
267 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
269 "Return the directory component in file name NAME.\n\
270 Return nil if NAME does not include a directory.\n\
271 Otherwise return a directory spec.\n\
272 Given a Unix syntax file name, returns a string ending in slash;\n\
273 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
277 register unsigned char *beg
;
278 register unsigned char *p
;
281 CHECK_STRING (file
, 0);
283 /* If the file name has special constructs in it,
284 call the corresponding file handler. */
285 handler
= Ffind_file_name_handler (file
, Qfile_name_directory
);
287 return call2 (handler
, Qfile_name_directory
, file
);
289 #ifdef FILE_SYSTEM_CASE
290 file
= FILE_SYSTEM_CASE (file
);
292 beg
= XSTRING (file
)->data
;
293 p
= beg
+ XSTRING (file
)->size
;
295 while (p
!= beg
&& p
[-1] != '/'
297 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
300 && p
[-1] != ':' && p
[-1] != '\\'
307 /* Expansion of "c:" to drive and default directory. */
308 if (p
== beg
+ 2 && beg
[1] == ':')
310 int drive
= (*beg
) - 'a';
311 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
312 unsigned char *res
= alloca (MAXPATHLEN
+ 5);
313 if (getdefdir (drive
+ 1, res
+ 2))
315 res
[0] = drive
+ 'a';
317 if (res
[strlen (res
) - 1] != '/')
320 p
= beg
+ strlen (beg
);
324 return make_string (beg
, p
- beg
);
327 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
329 "Return file name NAME sans its directory.\n\
330 For example, in a Unix-syntax file name,\n\
331 this is everything after the last slash,\n\
332 or the entire name if it contains no slash.")
336 register unsigned char *beg
, *p
, *end
;
339 CHECK_STRING (file
, 0);
341 /* If the file name has special constructs in it,
342 call the corresponding file handler. */
343 handler
= Ffind_file_name_handler (file
, Qfile_name_nondirectory
);
345 return call2 (handler
, Qfile_name_nondirectory
, file
);
347 beg
= XSTRING (file
)->data
;
348 end
= p
= beg
+ XSTRING (file
)->size
;
350 while (p
!= beg
&& p
[-1] != '/'
352 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
355 && p
[-1] != ':' && p
[-1] != '\\'
359 return make_string (p
, end
- p
);
362 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
363 "Return a directly usable directory name somehow associated with FILENAME.\n\
364 A `directly usable' directory name is one that may be used without the\n\
365 intervention of any file handler.\n\
366 If FILENAME is a directly usable file itself, return\n\
367 (file-name-directory FILENAME).\n\
368 The `call-process' and `start-process' functions use this function to\n\
369 get a current directory to run processes in.")
371 Lisp_Object filename
;
375 /* If the file name has special constructs in it,
376 call the corresponding file handler. */
377 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
379 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
381 return Ffile_name_directory (filename
);
386 file_name_as_directory (out
, in
)
389 int size
= strlen (in
) - 1;
394 /* Is it already a directory string? */
395 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
397 /* Is it a VMS directory file name? If so, hack VMS syntax. */
398 else if (! index (in
, '/')
399 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
400 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
401 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
402 || ! strncmp (&in
[size
- 5], ".dir", 4))
403 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
404 && in
[size
] == '1')))
406 register char *p
, *dot
;
410 dir:x.dir --> dir:[x]
411 dir:[x]y.dir --> dir:[x.y] */
413 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
416 strncpy (out
, in
, p
- in
);
435 dot
= index (p
, '.');
438 /* blindly remove any extension */
439 size
= strlen (out
) + (dot
- p
);
440 strncat (out
, p
, dot
- p
);
451 /* For Unix syntax, Append a slash if necessary */
453 if (out
[size
] != ':' && out
[size
] != '/' && out
[size
] != '\\')
455 if (out
[size
] != '/')
462 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
463 Sfile_name_as_directory
, 1, 1, 0,
464 "Return a string representing file FILENAME interpreted as a directory.\n\
465 This operation exists because a directory is also a file, but its name as\n\
466 a directory is different from its name as a file.\n\
467 The result can be used as the value of `default-directory'\n\
468 or passed as second argument to `expand-file-name'.\n\
469 For a Unix-syntax file name, just appends a slash.\n\
470 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
477 CHECK_STRING (file
, 0);
481 /* If the file name has special constructs in it,
482 call the corresponding file handler. */
483 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
485 return call2 (handler
, Qfile_name_as_directory
, file
);
487 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
488 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
492 * Convert from directory name to filename.
494 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
495 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
496 * On UNIX, it's simple: just make sure there is a terminating /
498 * Value is nonzero if the string output is different from the input.
501 directory_file_name (src
, dst
)
509 struct FAB fab
= cc$rms_fab
;
510 struct NAM nam
= cc$rms_nam
;
511 char esa
[NAM$C_MAXRSS
];
516 if (! index (src
, '/')
517 && (src
[slen
- 1] == ']'
518 || src
[slen
- 1] == ':'
519 || src
[slen
- 1] == '>'))
521 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
523 fab
.fab$b_fns
= slen
;
524 fab
.fab$l_nam
= &nam
;
525 fab
.fab$l_fop
= FAB$M_NAM
;
528 nam
.nam$b_ess
= sizeof esa
;
529 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
531 /* We call SYS$PARSE to handle such things as [--] for us. */
532 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
534 slen
= nam
.nam$b_esl
;
535 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
540 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
542 /* what about when we have logical_name:???? */
543 if (src
[slen
- 1] == ':')
544 { /* Xlate logical name and see what we get */
545 ptr
= strcpy (dst
, src
); /* upper case for getenv */
548 if ('a' <= *ptr
&& *ptr
<= 'z')
552 dst
[slen
- 1] = 0; /* remove colon */
553 if (!(src
= egetenv (dst
)))
555 /* should we jump to the beginning of this procedure?
556 Good points: allows us to use logical names that xlate
558 Bad points: can be a problem if we just translated to a device
560 For now, I'll punt and always expect VMS names, and hope for
563 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
564 { /* no recursion here! */
570 { /* not a directory spec */
575 bracket
= src
[slen
- 1];
577 /* If bracket is ']' or '>', bracket - 2 is the corresponding
579 ptr
= index (src
, bracket
- 2);
581 { /* no opening bracket */
585 if (!(rptr
= rindex (src
, '.')))
588 strncpy (dst
, src
, slen
);
592 dst
[slen
++] = bracket
;
597 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
598 then translate the device and recurse. */
599 if (dst
[slen
- 1] == ':'
600 && dst
[slen
- 2] != ':' /* skip decnet nodes */
601 && strcmp(src
+ slen
, "[000000]") == 0)
603 dst
[slen
- 1] = '\0';
604 if ((ptr
= egetenv (dst
))
605 && (rlen
= strlen (ptr
) - 1) > 0
606 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
607 && ptr
[rlen
- 1] == '.')
609 char * buf
= (char *) alloca (strlen (ptr
) + 1);
613 return directory_file_name (buf
, dst
);
618 strcat (dst
, "[000000]");
622 rlen
= strlen (rptr
) - 1;
623 strncat (dst
, rptr
, rlen
);
624 dst
[slen
+ rlen
] = '\0';
625 strcat (dst
, ".DIR.1");
629 /* Process as Unix format: just remove any final slash.
630 But leave "/" unchanged; do not change it to "". */
634 && (dst
[slen
- 1] == '/' || dst
[slen
- 1] == '/')
635 && dst
[slen
- 2] != ':'
637 && dst
[slen
- 1] == '/'
644 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
646 "Returns the file name of the directory named DIR.\n\
647 This is the name of the file that holds the data for the directory DIR.\n\
648 This operation exists because a directory is also a file, but its name as\n\
649 a directory is different from its name as a file.\n\
650 In Unix-syntax, this function just removes the final slash.\n\
651 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
652 it returns a file name such as \"[X]Y.DIR.1\".")
654 Lisp_Object directory
;
659 CHECK_STRING (directory
, 0);
661 if (NILP (directory
))
664 /* If the file name has special constructs in it,
665 call the corresponding file handler. */
666 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
668 return call2 (handler
, Qdirectory_file_name
, directory
);
671 /* 20 extra chars is insufficient for VMS, since we might perform a
672 logical name translation. an equivalence string can be up to 255
673 chars long, so grab that much extra space... - sss */
674 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
676 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
678 directory_file_name (XSTRING (directory
)->data
, buf
);
679 return build_string (buf
);
682 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
683 "Generate temporary file name (string) starting with PREFIX (a string).\n\
684 The Emacs process number forms part of the result,\n\
685 so there is no danger of generating a name being used by another process.")
690 val
= concat2 (prefix
, build_string ("XXXXXX"));
691 mktemp (XSTRING (val
)->data
);
695 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
696 "Convert FILENAME to absolute, and canonicalize it.\n\
697 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
698 (does not start with slash); if DEFAULT is nil or missing,\n\
699 the current buffer's value of default-directory is used.\n\
700 Path components that are `.' are removed, and \n\
701 path components followed by `..' are removed, along with the `..' itself;\n\
702 note that these simplifications are done without checking the resulting\n\
703 paths in the file system.\n\
704 An initial `~/' expands to your home directory.\n\
705 An initial `~USER/' expands to USER's home directory.\n\
706 See also the function `substitute-in-file-name'.")
708 Lisp_Object name
, defalt
;
712 register unsigned char *newdir
, *p
, *o
;
714 unsigned char *target
;
717 unsigned char * colon
= 0;
718 unsigned char * close
= 0;
719 unsigned char * slash
= 0;
720 unsigned char * brack
= 0;
721 int lbrack
= 0, rbrack
= 0;
724 #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */
727 unsigned char *tmp
, *defdir
;
731 CHECK_STRING (name
, 0);
733 /* If the file name has special constructs in it,
734 call the corresponding file handler. */
735 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
737 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
739 /* Use the buffer's default-directory if DEFALT is omitted. */
741 defalt
= current_buffer
->directory
;
742 CHECK_STRING (defalt
, 1);
744 /* Make sure DEFALT is properly expanded.
745 It would be better to do this down below where we actually use
746 defalt. Unfortunately, calling Fexpand_file_name recursively
747 could invoke GC, and the strings might be relocated. This would
748 be annoying because we have pointers into strings lying around
749 that would need adjusting, and people would add new pointers to
750 the code and forget to adjust them, resulting in intermittent bugs.
751 Putting this call here avoids all that crud.
753 The EQ test avoids infinite recursion. */
754 if (! NILP (defalt
) && !EQ (defalt
, name
)
755 /* This saves time in a common case. */
757 && (XSTRING (defalt
)->size
< 3
758 || XSTRING (defalt
)->data
[1] != ':'
759 || XSTRING (defalt
)->data
[2] != '/'))
761 && XSTRING (defalt
)->data
[0] != '/')
767 defalt
= Fexpand_file_name (defalt
, Qnil
);
772 /* Filenames on VMS are always upper case. */
773 name
= Fupcase (name
);
775 #ifdef FILE_SYSTEM_CASE
776 name
= FILE_SYSTEM_CASE (name
);
779 nm
= XSTRING (name
)->data
;
782 /* First map all backslashes to slashes. */
783 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
785 /* Now strip drive name. */
787 unsigned char *colon
= rindex (nm
, ':');
793 drive
= tolower (colon
[-1]) - 'a';
797 defdir
= alloca (MAXPATHLEN
+ 1);
798 relpath
= getdefdir (drive
+ 1, defdir
);
804 /* If nm is absolute, flush ...// and detect /./ and /../.
805 If no /./ or /../ we can return right away. */
813 /* If it turns out that the filename we want to return is just a
814 suffix of FILENAME, we don't need to go through and edit
815 things; we just need to construct a new string using data
816 starting at the middle of FILENAME. If we set lose to a
817 non-zero value, that means we've discovered that we can't do
824 /* Since we know the path is absolute, we can assume that each
825 element starts with a "/". */
827 /* "//" anywhere isn't necessarily hairy; we just start afresh
828 with the second slash. */
829 if (p
[0] == '/' && p
[1] == '/'
831 /* // at start of filename is meaningful on Apollo system */
837 /* "~" is hairy as the start of any path element. */
838 if (p
[0] == '/' && p
[1] == '~')
839 nm
= p
+ 1, lose
= 1;
841 /* "." and ".." are hairy. */
846 || (p
[2] == '.' && (p
[3] == '/'
853 /* if dev:[dir]/, move nm to / */
854 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
855 nm
= (brack
? brack
+ 1 : colon
+ 1);
864 /* VMS pre V4.4,convert '-'s in filenames. */
865 if (lbrack
== rbrack
)
867 if (dots
< 2) /* this is to allow negative version numbers */
872 if (lbrack
> rbrack
&&
873 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
874 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
880 /* count open brackets, reset close bracket pointer */
881 if (p
[0] == '[' || p
[0] == '<')
883 /* count close brackets, set close bracket pointer */
884 if (p
[0] == ']' || p
[0] == '>')
886 /* detect ][ or >< */
887 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
889 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
890 nm
= p
+ 1, lose
= 1;
891 if (p
[0] == ':' && (colon
|| slash
))
892 /* if dev1:[dir]dev2:, move nm to dev2: */
898 /* if /pathname/dev:, move nm to dev: */
901 /* if node::dev:, move colon following dev */
902 else if (colon
&& colon
[-1] == ':')
904 /* if dev1:dev2:, move nm to dev2: */
905 else if (colon
&& colon
[-1] != ':')
910 if (p
[0] == ':' && !colon
)
916 if (lbrack
== rbrack
)
919 else if (p
[0] == '.')
928 return build_string (sys_translate_unix (nm
));
931 if (nm
== XSTRING (name
)->data
)
933 return build_string (nm
);
938 /* Now determine directory to start with and put it in newdir */
942 if (nm
[0] == '~') /* prefix ~ */
948 || nm
[1] == 0) /* ~ by itself */
950 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
951 newdir
= (unsigned char *) "";
953 dostounix_filename (newdir
);
957 nm
++; /* Don't leave the slash in nm. */
960 else /* ~user/filename */
962 for (p
= nm
; *p
&& (*p
!= '/'
967 o
= (unsigned char *) alloca (p
- nm
+ 1);
968 bcopy ((char *) nm
, o
, p
- nm
);
971 pw
= (struct passwd
*) getpwnam (o
+ 1);
974 newdir
= (unsigned char *) pw
-> pw_dir
;
976 nm
= p
+ 1; /* skip the terminator */
982 /* If we don't find a user of that name, leave the name
983 unchanged; don't move nm forward to p. */
996 newdir
= XSTRING (defalt
)->data
;
1000 if (newdir
== 0 && relpath
)
1005 /* Get rid of any slash at the end of newdir. */
1006 int length
= strlen (newdir
);
1007 /* Adding `length > 1 &&' makes ~ expand into / when homedir
1008 is the root dir. People disagree about whether that is right.
1009 Anyway, we can't take the risk of this change now. */
1011 if (newdir
[1] != ':' && length
> 1)
1013 if (newdir
[length
- 1] == '/')
1015 unsigned char *temp
= (unsigned char *) alloca (length
);
1016 bcopy (newdir
, temp
, length
- 1);
1017 temp
[length
- 1] = 0;
1025 /* Now concatenate the directory and name to new space in the stack frame */
1026 tlen
+= strlen (nm
) + 1;
1028 /* Add reserved space for drive name. */
1029 target
= (unsigned char *) alloca (tlen
+ 2) + 2;
1031 target
= (unsigned char *) alloca (tlen
);
1038 if (nm
[0] == 0 || nm
[0] == '/')
1039 strcpy (target
, newdir
);
1042 file_name_as_directory (target
, newdir
);
1045 strcat (target
, nm
);
1047 if (index (target
, '/'))
1048 strcpy (target
, sys_translate_unix (target
));
1051 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1059 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1065 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1066 /* brackets are offset from each other by 2 */
1069 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1070 /* convert [foo][bar] to [bar] */
1071 while (o
[-1] != '[' && o
[-1] != '<')
1073 else if (*p
== '-' && *o
!= '.')
1076 else if (p
[0] == '-' && o
[-1] == '.' &&
1077 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1078 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1082 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1083 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1085 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1087 /* else [foo.-] ==> [-] */
1093 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1094 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1104 else if (!strncmp (p
, "//", 2)
1106 /* // at start of filename is meaningful in Apollo system */
1114 else if (p
[0] == '/'
1119 /* If "/." is the entire filename, keep the "/". Otherwise,
1120 just delete the whole "/.". */
1121 if (o
== target
&& p
[2] == '\0')
1125 else if (!strncmp (p
, "/..", 3)
1126 /* `/../' is the "superroot" on certain file systems. */
1128 && (p
[3] == '/' || p
[3] == 0))
1130 while (o
!= target
&& *--o
!= '/')
1133 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1137 if (o
== target
&& *o
== '/')
1145 #endif /* not VMS */
1149 /* at last, set drive name. */
1150 if (target
[1] != ':')
1153 target
[0] = (drive
< 0 ? getdisk () : drive
) + 'a';
1158 return make_string (target
, o
- target
);
1161 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
1162 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
1163 "Convert FILENAME to absolute, and canonicalize it.\n\
1164 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1165 (does not start with slash); if DEFAULT is nil or missing,\n\
1166 the current buffer's value of default-directory is used.\n\
1167 Filenames containing `.' or `..' as components are simplified;\n\
1168 initial `~/' expands to your home directory.\n\
1169 See also the function `substitute-in-file-name'.")
1171 Lisp_Object name, defalt;
1175 register unsigned char *newdir, *p, *o;
1177 unsigned char *target;
1181 unsigned char * colon = 0;
1182 unsigned char * close = 0;
1183 unsigned char * slash = 0;
1184 unsigned char * brack = 0;
1185 int lbrack = 0, rbrack = 0;
1189 CHECK_STRING (name
, 0);
1192 /* Filenames on VMS are always upper case. */
1193 name
= Fupcase (name
);
1196 nm
= XSTRING (name
)->data
;
1198 /* If nm is absolute, flush ...// and detect /./ and /../.
1199 If no /./ or /../ we can return right away. */
1211 if (p
[0] == '/' && p
[1] == '/'
1213 /* // at start of filename is meaningful on Apollo system */
1218 if (p
[0] == '/' && p
[1] == '~')
1219 nm
= p
+ 1, lose
= 1;
1220 if (p
[0] == '/' && p
[1] == '.'
1221 && (p
[2] == '/' || p
[2] == 0
1222 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1228 /* if dev:[dir]/, move nm to / */
1229 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1230 nm
= (brack
? brack
+ 1 : colon
+ 1);
1231 lbrack
= rbrack
= 0;
1239 /* VMS pre V4.4,convert '-'s in filenames. */
1240 if (lbrack
== rbrack
)
1242 if (dots
< 2) /* this is to allow negative version numbers */
1247 if (lbrack
> rbrack
&&
1248 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1249 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1255 /* count open brackets, reset close bracket pointer */
1256 if (p
[0] == '[' || p
[0] == '<')
1257 lbrack
++, brack
= 0;
1258 /* count close brackets, set close bracket pointer */
1259 if (p
[0] == ']' || p
[0] == '>')
1260 rbrack
++, brack
= p
;
1261 /* detect ][ or >< */
1262 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1264 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1265 nm
= p
+ 1, lose
= 1;
1266 if (p
[0] == ':' && (colon
|| slash
))
1267 /* if dev1:[dir]dev2:, move nm to dev2: */
1273 /* if /pathname/dev:, move nm to dev: */
1276 /* if node::dev:, move colon following dev */
1277 else if (colon
&& colon
[-1] == ':')
1279 /* if dev1:dev2:, move nm to dev2: */
1280 else if (colon
&& colon
[-1] != ':')
1285 if (p
[0] == ':' && !colon
)
1291 if (lbrack
== rbrack
)
1294 else if (p
[0] == '.')
1302 if (index (nm
, '/'))
1303 return build_string (sys_translate_unix (nm
));
1305 if (nm
== XSTRING (name
)->data
)
1307 return build_string (nm
);
1311 /* Now determine directory to start with and put it in NEWDIR */
1315 if (nm
[0] == '~') /* prefix ~ */
1320 || nm
[1] == 0)/* ~/filename */
1322 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1323 newdir
= (unsigned char *) "";
1326 nm
++; /* Don't leave the slash in nm. */
1329 else /* ~user/filename */
1331 /* Get past ~ to user */
1332 unsigned char *user
= nm
+ 1;
1333 /* Find end of name. */
1334 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1335 int len
= ptr
? ptr
- user
: strlen (user
);
1337 unsigned char *ptr1
= index (user
, ':');
1338 if (ptr1
!= 0 && ptr1
- user
< len
)
1341 /* Copy the user name into temp storage. */
1342 o
= (unsigned char *) alloca (len
+ 1);
1343 bcopy ((char *) user
, o
, len
);
1346 /* Look up the user name. */
1347 pw
= (struct passwd
*) getpwnam (o
+ 1);
1349 error ("\"%s\" isn't a registered user", o
+ 1);
1351 newdir
= (unsigned char *) pw
->pw_dir
;
1353 /* Discard the user name from NM. */
1360 #endif /* not VMS */
1364 defalt
= current_buffer
->directory
;
1365 CHECK_STRING (defalt
, 1);
1366 newdir
= XSTRING (defalt
)->data
;
1369 /* Now concatenate the directory and name to new space in the stack frame */
1371 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1372 target
= (unsigned char *) alloca (tlen
);
1378 if (nm
[0] == 0 || nm
[0] == '/')
1379 strcpy (target
, newdir
);
1382 file_name_as_directory (target
, newdir
);
1385 strcat (target
, nm
);
1387 if (index (target
, '/'))
1388 strcpy (target
, sys_translate_unix (target
));
1391 /* Now canonicalize by removing /. and /foo/.. if they appear */
1399 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1405 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1406 /* brackets are offset from each other by 2 */
1409 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1410 /* convert [foo][bar] to [bar] */
1411 while (o
[-1] != '[' && o
[-1] != '<')
1413 else if (*p
== '-' && *o
!= '.')
1416 else if (p
[0] == '-' && o
[-1] == '.' &&
1417 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1418 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1422 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1423 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1425 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1427 /* else [foo.-] ==> [-] */
1433 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1434 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1444 else if (!strncmp (p
, "//", 2)
1446 /* // at start of filename is meaningful in Apollo system */
1454 else if (p
[0] == '/' && p
[1] == '.' &&
1455 (p
[2] == '/' || p
[2] == 0))
1457 else if (!strncmp (p
, "/..", 3)
1458 /* `/../' is the "superroot" on certain file systems. */
1460 && (p
[3] == '/' || p
[3] == 0))
1462 while (o
!= target
&& *--o
!= '/')
1465 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1469 if (o
== target
&& *o
== '/')
1477 #endif /* not VMS */
1480 return make_string (target
, o
- target
);
1484 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1485 Ssubstitute_in_file_name
, 1, 1, 0,
1486 "Substitute environment variables referred to in FILENAME.\n\
1487 `$FOO' where FOO is an environment variable name means to substitute\n\
1488 the value of that variable. The variable name should be terminated\n\
1489 with a character not a letter, digit or underscore; otherwise, enclose\n\
1490 the entire variable name in braces.\n\
1491 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1492 On VMS, `$' substitution is not done; this function does little and only\n\
1493 duplicates what `expand-file-name' does.")
1499 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1500 unsigned char *target
;
1502 int substituted
= 0;
1505 CHECK_STRING (string
, 0);
1507 nm
= XSTRING (string
)->data
;
1509 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
1510 substituted
= !strcmp (nm
, XSTRING (string
)->data
);
1512 endp
= nm
+ XSTRING (string
)->size
;
1514 /* If /~ or // appears, discard everything through first slash. */
1516 for (p
= nm
; p
!= endp
; p
++)
1520 /* // at start of file name is meaningful in Apollo system */
1521 (p
[0] == '/' && p
- 1 != nm
)
1522 #else /* not APOLLO */
1524 #endif /* not APOLLO */
1528 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1539 if (p
[0] && p
[1] == ':')
1548 return build_string (nm
);
1551 /* See if any variables are substituted into the string
1552 and find the total length of their values in `total' */
1554 for (p
= nm
; p
!= endp
;)
1564 /* "$$" means a single "$" */
1573 while (p
!= endp
&& *p
!= '}') p
++;
1574 if (*p
!= '}') goto missingclose
;
1580 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1584 /* Copy out the variable name */
1585 target
= (unsigned char *) alloca (s
- o
+ 1);
1586 strncpy (target
, o
, s
- o
);
1589 strupr (target
); /* $home == $HOME etc. */
1592 /* Get variable value */
1593 o
= (unsigned char *) egetenv (target
);
1594 if (!o
) goto badvar
;
1595 total
+= strlen (o
);
1602 /* If substitution required, recopy the string and do it */
1603 /* Make space in stack frame for the new copy */
1604 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1607 /* Copy the rest of the name through, replacing $ constructs with values */
1624 while (p
!= endp
&& *p
!= '}') p
++;
1625 if (*p
!= '}') goto missingclose
;
1631 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1635 /* Copy out the variable name */
1636 target
= (unsigned char *) alloca (s
- o
+ 1);
1637 strncpy (target
, o
, s
- o
);
1640 strupr (target
); /* $home == $HOME etc. */
1643 /* Get variable value */
1644 o
= (unsigned char *) egetenv (target
);
1654 /* If /~ or // appears, discard everything through first slash. */
1656 for (p
= xnm
; p
!= x
; p
++)
1659 /* // at start of file name is meaningful in Apollo system */
1660 (p
[0] == '/' && p
- 1 != xnm
)
1661 #else /* not APOLLO */
1663 #endif /* not APOLLO */
1665 && p
!= nm
&& p
[-1] == '/')
1668 else if (p
[0] && p
[1] == ':')
1672 return make_string (xnm
, x
- xnm
);
1675 error ("Bad format environment-variable substitution");
1677 error ("Missing \"}\" in environment-variable substitution");
1679 error ("Substituting nonexistent environment variable \"%s\"", target
);
1682 #endif /* not VMS */
1685 /* A slightly faster and more convenient way to get
1686 (directory-file-name (expand-file-name FOO)). */
1689 expand_and_dir_to_file (filename
, defdir
)
1690 Lisp_Object filename
, defdir
;
1692 register Lisp_Object abspath
;
1694 abspath
= Fexpand_file_name (filename
, defdir
);
1697 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1698 if (c
== ':' || c
== ']' || c
== '>')
1699 abspath
= Fdirectory_file_name (abspath
);
1702 /* Remove final slash, if any (unless path is root).
1703 stat behaves differently depending! */
1704 if (XSTRING (abspath
)->size
> 1
1705 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1706 /* We cannot take shortcuts; they might be wrong for magic file names. */
1707 abspath
= Fdirectory_file_name (abspath
);
1713 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1714 Lisp_Object absname
;
1715 unsigned char *querystring
;
1718 register Lisp_Object tem
;
1719 struct stat statbuf
;
1720 struct gcpro gcpro1
;
1722 /* stat is a good way to tell whether the file exists,
1723 regardless of what access permissions it has. */
1724 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1727 Fsignal (Qfile_already_exists
,
1728 Fcons (build_string ("File already exists"),
1729 Fcons (absname
, Qnil
)));
1731 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1732 XSTRING (absname
)->data
, querystring
));
1735 Fsignal (Qfile_already_exists
,
1736 Fcons (build_string ("File already exists"),
1737 Fcons (absname
, Qnil
)));
1742 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1743 "fCopy file: \nFCopy %s to file: \np\nP",
1744 "Copy FILE to NEWNAME. Both args must be strings.\n\
1745 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1746 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1747 A number as third arg means request confirmation if NEWNAME already exists.\n\
1748 This is what happens in interactive use with M-x.\n\
1749 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1750 last-modified time as the old one. (This works on only some systems.)\n\
1751 A prefix arg makes KEEP-TIME non-nil.")
1752 (filename
, newname
, ok_if_already_exists
, keep_date
)
1753 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1756 char buf
[16 * 1024];
1758 Lisp_Object handler
;
1759 struct gcpro gcpro1
, gcpro2
;
1760 int count
= specpdl_ptr
- specpdl
;
1761 int input_file_statable_p
;
1763 GCPRO2 (filename
, newname
);
1764 CHECK_STRING (filename
, 0);
1765 CHECK_STRING (newname
, 1);
1766 filename
= Fexpand_file_name (filename
, Qnil
);
1767 newname
= Fexpand_file_name (newname
, Qnil
);
1769 /* If the input file name has special constructs in it,
1770 call the corresponding file handler. */
1771 handler
= Ffind_file_name_handler (filename
, Qcopy_file
);
1772 /* Likewise for output file name. */
1774 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1775 if (!NILP (handler
))
1776 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, filename
, newname
,
1777 ok_if_already_exists
, keep_date
));
1779 if (NILP (ok_if_already_exists
)
1780 || INTEGERP (ok_if_already_exists
))
1781 barf_or_query_if_file_exists (newname
, "copy to it",
1782 INTEGERP (ok_if_already_exists
));
1784 ifd
= open (XSTRING (filename
)->data
, O_RDONLY
);
1786 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1788 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1790 /* We can only copy regular files and symbolic links. Other files are not
1792 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1794 #if defined (S_ISREG) && defined (S_ISLNK)
1795 if (input_file_statable_p
)
1797 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1799 #if defined (EISDIR)
1800 /* Get a better looking error message. */
1803 report_file_error ("Non-regular file", Fcons (filename
, Qnil
));
1806 #endif /* S_ISREG && S_ISLNK */
1809 /* Create the copy file with the same record format as the input file */
1810 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1813 /* System's default file type was set to binary by _fmode in emacs.c. */
1814 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1815 #else /* not MSDOS */
1816 ofd
= creat (XSTRING (newname
)->data
, 0666);
1817 #endif /* not MSDOS */
1820 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1822 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1826 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1827 if (write (ofd
, buf
, n
) != n
)
1828 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1831 /* Closing the output clobbers the file times on some systems. */
1832 if (close (ofd
) < 0)
1833 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1835 if (input_file_statable_p
)
1837 if (!NILP (keep_date
))
1839 EMACS_TIME atime
, mtime
;
1840 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1841 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1842 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
1843 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1846 if (!egetenv ("USE_DOMAIN_ACLS"))
1848 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1853 /* Discard the unwind protects. */
1854 specpdl_ptr
= specpdl
+ count
;
1860 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1861 Smake_directory_internal
, 1, 1, 0,
1862 "Create a directory. One argument, a file name string.")
1864 Lisp_Object dirname
;
1867 Lisp_Object handler
;
1869 CHECK_STRING (dirname
, 0);
1870 dirname
= Fexpand_file_name (dirname
, Qnil
);
1872 handler
= Ffind_file_name_handler (dirname
, Qmake_directory_internal
);
1873 if (!NILP (handler
))
1874 return call2 (handler
, Qmake_directory_internal
, dirname
);
1876 dir
= XSTRING (dirname
)->data
;
1878 if (mkdir (dir
, 0777) != 0)
1879 report_file_error ("Creating directory", Flist (1, &dirname
));
1884 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1885 "Delete a directory. One argument, a file name or directory name string.")
1887 Lisp_Object dirname
;
1890 Lisp_Object handler
;
1892 CHECK_STRING (dirname
, 0);
1893 dirname
= Fdirectory_file_name (Fexpand_file_name (dirname
, Qnil
));
1894 dir
= XSTRING (dirname
)->data
;
1896 handler
= Ffind_file_name_handler (dirname
, Qdelete_directory
);
1897 if (!NILP (handler
))
1898 return call2 (handler
, Qdelete_directory
, dirname
);
1900 if (rmdir (dir
) != 0)
1901 report_file_error ("Removing directory", Flist (1, &dirname
));
1906 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1907 "Delete specified file. One argument, a file name string.\n\
1908 If file has multiple names, it continues to exist with the other names.")
1910 Lisp_Object filename
;
1912 Lisp_Object handler
;
1913 CHECK_STRING (filename
, 0);
1914 filename
= Fexpand_file_name (filename
, Qnil
);
1916 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
1917 if (!NILP (handler
))
1918 return call2 (handler
, Qdelete_file
, filename
);
1920 if (0 > unlink (XSTRING (filename
)->data
))
1921 report_file_error ("Removing old name", Flist (1, &filename
));
1925 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1926 "fRename file: \nFRename %s to file: \np",
1927 "Rename FILE as NEWNAME. Both args strings.\n\
1928 If file has names other than FILE, it continues to have those names.\n\
1929 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1930 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1931 A number as third arg means request confirmation if NEWNAME already exists.\n\
1932 This is what happens in interactive use with M-x.")
1933 (filename
, newname
, ok_if_already_exists
)
1934 Lisp_Object filename
, newname
, ok_if_already_exists
;
1937 Lisp_Object args
[2];
1939 Lisp_Object handler
;
1940 struct gcpro gcpro1
, gcpro2
;
1942 GCPRO2 (filename
, newname
);
1943 CHECK_STRING (filename
, 0);
1944 CHECK_STRING (newname
, 1);
1945 filename
= Fexpand_file_name (filename
, Qnil
);
1946 newname
= Fexpand_file_name (newname
, Qnil
);
1948 /* If the file name has special constructs in it,
1949 call the corresponding file handler. */
1950 handler
= Ffind_file_name_handler (filename
, Qrename_file
);
1952 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
1953 if (!NILP (handler
))
1954 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
1955 filename
, newname
, ok_if_already_exists
));
1957 if (NILP (ok_if_already_exists
)
1958 || INTEGERP (ok_if_already_exists
))
1959 barf_or_query_if_file_exists (newname
, "rename to it",
1960 INTEGERP (ok_if_already_exists
));
1962 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1964 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1965 || 0 > unlink (XSTRING (filename
)->data
))
1970 Fcopy_file (filename
, newname
,
1971 /* We have already prompted if it was an integer,
1972 so don't have copy-file prompt again. */
1973 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
1974 Fdelete_file (filename
);
1981 report_file_error ("Renaming", Flist (2, args
));
1984 report_file_error ("Renaming", Flist (2, &filename
));
1991 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1992 "fAdd name to file: \nFName to add to %s: \np",
1993 "Give FILE additional name NEWNAME. Both args strings.\n\
1994 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1995 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1996 A number as third arg means request confirmation if NEWNAME already exists.\n\
1997 This is what happens in interactive use with M-x.")
1998 (filename
, newname
, ok_if_already_exists
)
1999 Lisp_Object filename
, newname
, ok_if_already_exists
;
2002 Lisp_Object args
[2];
2004 Lisp_Object handler
;
2005 struct gcpro gcpro1
, gcpro2
;
2007 GCPRO2 (filename
, newname
);
2008 CHECK_STRING (filename
, 0);
2009 CHECK_STRING (newname
, 1);
2010 filename
= Fexpand_file_name (filename
, Qnil
);
2011 newname
= Fexpand_file_name (newname
, Qnil
);
2013 /* If the file name has special constructs in it,
2014 call the corresponding file handler. */
2015 handler
= Ffind_file_name_handler (filename
, Qadd_name_to_file
);
2016 if (!NILP (handler
))
2017 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
2018 newname
, ok_if_already_exists
));
2020 if (NILP (ok_if_already_exists
)
2021 || INTEGERP (ok_if_already_exists
))
2022 barf_or_query_if_file_exists (newname
, "make it a new name",
2023 INTEGERP (ok_if_already_exists
));
2024 unlink (XSTRING (newname
)->data
);
2025 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2030 report_file_error ("Adding new name", Flist (2, args
));
2032 report_file_error ("Adding new name", Flist (2, &filename
));
2041 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2042 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2043 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2044 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2045 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2046 A number as third arg means request confirmation if LINKNAME already exists.\n\
2047 This happens for interactive use with M-x.")
2048 (filename
, linkname
, ok_if_already_exists
)
2049 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2052 Lisp_Object args
[2];
2054 Lisp_Object handler
;
2055 struct gcpro gcpro1
, gcpro2
;
2057 GCPRO2 (filename
, linkname
);
2058 CHECK_STRING (filename
, 0);
2059 CHECK_STRING (linkname
, 1);
2060 /* If the link target has a ~, we must expand it to get
2061 a truly valid file name. Otherwise, do not expand;
2062 we want to permit links to relative file names. */
2063 if (XSTRING (filename
)->data
[0] == '~')
2064 filename
= Fexpand_file_name (filename
, Qnil
);
2065 linkname
= Fexpand_file_name (linkname
, Qnil
);
2067 /* If the file name has special constructs in it,
2068 call the corresponding file handler. */
2069 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2070 if (!NILP (handler
))
2071 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2072 linkname
, ok_if_already_exists
));
2074 if (NILP (ok_if_already_exists
)
2075 || INTEGERP (ok_if_already_exists
))
2076 barf_or_query_if_file_exists (linkname
, "make it a link",
2077 INTEGERP (ok_if_already_exists
));
2078 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2080 /* If we didn't complain already, silently delete existing file. */
2081 if (errno
== EEXIST
)
2083 unlink (XSTRING (linkname
)->data
);
2084 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2094 report_file_error ("Making symbolic link", Flist (2, args
));
2096 report_file_error ("Making symbolic link", Flist (2, &filename
));
2102 #endif /* S_IFLNK */
2106 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2107 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2108 "Define the job-wide logical name NAME to have the value STRING.\n\
2109 If STRING is nil or a null string, the logical name NAME is deleted.")
2111 Lisp_Object varname
;
2114 CHECK_STRING (varname
, 0);
2116 delete_logical_name (XSTRING (varname
)->data
);
2119 CHECK_STRING (string
, 1);
2121 if (XSTRING (string
)->size
== 0)
2122 delete_logical_name (XSTRING (varname
)->data
);
2124 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2133 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2134 "Open a network connection to PATH using LOGIN as the login string.")
2136 Lisp_Object path
, login
;
2140 CHECK_STRING (path
, 0);
2141 CHECK_STRING (login
, 0);
2143 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2145 if (netresult
== -1)
2150 #endif /* HPUX_NET */
2152 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2154 "Return t if file FILENAME specifies an absolute path name.\n\
2155 On Unix, this is a name starting with a `/' or a `~'.")
2157 Lisp_Object filename
;
2161 CHECK_STRING (filename
, 0);
2162 ptr
= XSTRING (filename
)->data
;
2163 if (*ptr
== '/' || *ptr
== '~'
2165 /* ??? This criterion is probably wrong for '<'. */
2166 || index (ptr
, ':') || index (ptr
, '<')
2167 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2171 || (*ptr
!= 0 && ptr
[1] == ':' && (ptr
[2] == '/' || ptr
[2] == '\\'))
2179 /* Return nonzero if file FILENAME exists and can be executed. */
2182 check_executable (filename
)
2186 return (eaccess (filename
, 1) >= 0);
2188 /* Access isn't quite right because it uses the real uid
2189 and we really want to test with the effective uid.
2190 But Unix doesn't give us a right way to do it. */
2191 return (access (filename
, 1) >= 0);
2195 /* Return nonzero if file FILENAME exists and can be written. */
2198 check_writable (filename
)
2202 return (eaccess (filename
, 2) >= 0);
2204 /* Access isn't quite right because it uses the real uid
2205 and we really want to test with the effective uid.
2206 But Unix doesn't give us a right way to do it.
2207 Opening with O_WRONLY could work for an ordinary file,
2208 but would lose for directories. */
2209 return (access (filename
, 2) >= 0);
2213 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2214 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2215 See also `file-readable-p' and `file-attributes'.")
2217 Lisp_Object filename
;
2219 Lisp_Object abspath
;
2220 Lisp_Object handler
;
2221 struct stat statbuf
;
2223 CHECK_STRING (filename
, 0);
2224 abspath
= Fexpand_file_name (filename
, Qnil
);
2226 /* If the file name has special constructs in it,
2227 call the corresponding file handler. */
2228 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2229 if (!NILP (handler
))
2230 return call2 (handler
, Qfile_exists_p
, abspath
);
2232 return (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2235 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2236 "Return t if FILENAME can be executed by you.\n\
2237 For a directory, this means you can access files in that directory.")
2239 Lisp_Object filename
;
2242 Lisp_Object abspath
;
2243 Lisp_Object handler
;
2245 CHECK_STRING (filename
, 0);
2246 abspath
= Fexpand_file_name (filename
, Qnil
);
2248 /* If the file name has special constructs in it,
2249 call the corresponding file handler. */
2250 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2251 if (!NILP (handler
))
2252 return call2 (handler
, Qfile_executable_p
, abspath
);
2254 return (check_executable (XSTRING (abspath
)->data
) ? Qt
: Qnil
);
2257 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2258 "Return t if file FILENAME exists and you can read it.\n\
2259 See also `file-exists-p' and `file-attributes'.")
2261 Lisp_Object filename
;
2263 Lisp_Object abspath
;
2264 Lisp_Object handler
;
2267 CHECK_STRING (filename
, 0);
2268 abspath
= Fexpand_file_name (filename
, Qnil
);
2270 /* If the file name has special constructs in it,
2271 call the corresponding file handler. */
2272 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2273 if (!NILP (handler
))
2274 return call2 (handler
, Qfile_readable_p
, abspath
);
2276 desc
= open (XSTRING (abspath
)->data
, O_RDONLY
);
2283 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2285 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2286 "Return t if file FILENAME can be written or created by you.")
2288 Lisp_Object filename
;
2290 Lisp_Object abspath
, dir
;
2291 Lisp_Object handler
;
2292 struct stat statbuf
;
2294 CHECK_STRING (filename
, 0);
2295 abspath
= Fexpand_file_name (filename
, Qnil
);
2297 /* If the file name has special constructs in it,
2298 call the corresponding file handler. */
2299 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2300 if (!NILP (handler
))
2301 return call2 (handler
, Qfile_writable_p
, abspath
);
2303 if (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0)
2304 return (check_writable (XSTRING (abspath
)->data
)
2306 dir
= Ffile_name_directory (abspath
);
2309 dir
= Fdirectory_file_name (dir
);
2313 dir
= Fdirectory_file_name (dir
);
2315 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2319 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2320 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2321 The value is the name of the file to which it is linked.\n\
2322 Otherwise returns nil.")
2324 Lisp_Object filename
;
2331 Lisp_Object handler
;
2333 CHECK_STRING (filename
, 0);
2334 filename
= Fexpand_file_name (filename
, Qnil
);
2336 /* If the file name has special constructs in it,
2337 call the corresponding file handler. */
2338 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2339 if (!NILP (handler
))
2340 return call2 (handler
, Qfile_symlink_p
, filename
);
2345 buf
= (char *) xmalloc (bufsize
);
2346 bzero (buf
, bufsize
);
2347 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2348 if (valsize
< bufsize
) break;
2349 /* Buffer was not long enough */
2358 val
= make_string (buf
, valsize
);
2361 #else /* not S_IFLNK */
2363 #endif /* not S_IFLNK */
2366 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2367 "Return t if file FILENAME is the name of a directory as a file.\n\
2368 A directory name spec may be given instead; then the value is t\n\
2369 if the directory so specified exists and really is a directory.")
2371 Lisp_Object filename
;
2373 register Lisp_Object abspath
;
2375 Lisp_Object handler
;
2377 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2379 /* If the file name has special constructs in it,
2380 call the corresponding file handler. */
2381 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2382 if (!NILP (handler
))
2383 return call2 (handler
, Qfile_directory_p
, abspath
);
2385 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2387 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2390 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2391 "Return t if file FILENAME is the name of a directory as a file,\n\
2392 and files in that directory can be opened by you. In order to use a\n\
2393 directory as a buffer's current directory, this predicate must return true.\n\
2394 A directory name spec may be given instead; then the value is t\n\
2395 if the directory so specified exists and really is a readable and\n\
2396 searchable directory.")
2398 Lisp_Object filename
;
2400 Lisp_Object handler
;
2402 struct gcpro gcpro1
;
2404 /* If the file name has special constructs in it,
2405 call the corresponding file handler. */
2406 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2407 if (!NILP (handler
))
2408 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2410 /* It's an unlikely combination, but yes we really do need to gcpro:
2411 Suppose that file-accessible-directory-p has no handler, but
2412 file-directory-p does have a handler; this handler causes a GC which
2413 relocates the string in `filename'; and finally file-directory-p
2414 returns non-nil. Then we would end up passing a garbaged string
2415 to file-executable-p. */
2417 tem
= (NILP (Ffile_directory_p (filename
))
2418 || NILP (Ffile_executable_p (filename
)));
2420 return tem
? Qnil
: Qt
;
2423 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2424 "Return t if file FILENAME is the name of a regular file.\n\
2425 This is the sort of file that holds an ordinary stream of data bytes.")
2427 Lisp_Object filename
;
2429 register Lisp_Object abspath
;
2431 Lisp_Object handler
;
2433 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2435 /* If the file name has special constructs in it,
2436 call the corresponding file handler. */
2437 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2438 if (!NILP (handler
))
2439 return call2 (handler
, Qfile_directory_p
, abspath
);
2441 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2443 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2446 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2447 "Return mode bits of FILE, as an integer.")
2449 Lisp_Object filename
;
2451 Lisp_Object abspath
;
2453 Lisp_Object handler
;
2455 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2457 /* If the file name has special constructs in it,
2458 call the corresponding file handler. */
2459 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2460 if (!NILP (handler
))
2461 return call2 (handler
, Qfile_modes
, abspath
);
2463 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2469 if (S_ISREG (st
.st_mode
)
2470 && (len
= XSTRING (abspath
)->size
) >= 5
2471 && (stricmp ((suffix
= XSTRING (abspath
)->data
+ len
-4), ".com") == 0
2472 || stricmp (suffix
, ".exe") == 0
2473 || stricmp (suffix
, ".bat") == 0))
2474 st
.st_mode
|= S_IEXEC
;
2478 return make_number (st
.st_mode
& 07777);
2481 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2482 "Set mode bits of FILE to MODE (an integer).\n\
2483 Only the 12 low bits of MODE are used.")
2485 Lisp_Object filename
, mode
;
2487 Lisp_Object abspath
;
2488 Lisp_Object handler
;
2490 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2491 CHECK_NUMBER (mode
, 1);
2493 /* If the file name has special constructs in it,
2494 call the corresponding file handler. */
2495 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2496 if (!NILP (handler
))
2497 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2500 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2501 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2503 if (!egetenv ("USE_DOMAIN_ACLS"))
2506 struct timeval tvp
[2];
2508 /* chmod on apollo also change the file's modtime; need to save the
2509 modtime and then restore it. */
2510 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2512 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2516 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2517 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2519 /* reset the old accessed and modified times. */
2520 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2522 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2525 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2526 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2533 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2534 "Set the file permission bits for newly created files.\n\
2535 The argument MODE should be an integer; only the low 9 bits are used.\n\
2536 This setting is inherited by subprocesses.")
2540 CHECK_NUMBER (mode
, 0);
2542 umask ((~ XINT (mode
)) & 0777);
2547 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2548 "Return the default file protection for created files.\n\
2549 The value is an integer.")
2555 realmask
= umask (0);
2558 XSETINT (value
, (~ realmask
) & 0777);
2564 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2565 "Tell Unix to finish all pending disk updates.")
2574 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2575 "Return t if file FILE1 is newer than file FILE2.\n\
2576 If FILE1 does not exist, the answer is nil;\n\
2577 otherwise, if FILE2 does not exist, the answer is t.")
2579 Lisp_Object file1
, file2
;
2581 Lisp_Object abspath1
, abspath2
;
2584 Lisp_Object handler
;
2585 struct gcpro gcpro1
, gcpro2
;
2587 CHECK_STRING (file1
, 0);
2588 CHECK_STRING (file2
, 0);
2591 GCPRO2 (abspath1
, file2
);
2592 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2593 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2596 /* If the file name has special constructs in it,
2597 call the corresponding file handler. */
2598 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2600 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2601 if (!NILP (handler
))
2602 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2604 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2607 mtime1
= st
.st_mtime
;
2609 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2612 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2616 Lisp_Object Qfind_buffer_file_type
;
2619 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2621 "Insert contents of file FILENAME after point.\n\
2622 Returns list of absolute file name and length of data inserted.\n\
2623 If second argument VISIT is non-nil, the buffer's visited filename\n\
2624 and last save file modtime are set, and it is marked unmodified.\n\
2625 If visiting and the file does not exist, visiting is completed\n\
2626 before the error is signaled.\n\n\
2627 The optional third and fourth arguments BEG and END\n\
2628 specify what portion of the file to insert.\n\
2629 If VISIT is non-nil, BEG and END must be nil.\n\
2630 If optional fifth argument REPLACE is non-nil,\n\
2631 it means replace the current buffer contents (in the accessible portion)\n\
2632 with the file contents. This is better than simply deleting and inserting\n\
2633 the whole thing because (1) it preserves some marker positions\n\
2634 and (2) it puts less data in the undo list.")
2635 (filename
, visit
, beg
, end
, replace
)
2636 Lisp_Object filename
, visit
, beg
, end
, replace
;
2640 register int inserted
= 0;
2641 register int how_much
;
2642 int count
= specpdl_ptr
- specpdl
;
2643 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2644 Lisp_Object handler
, val
, insval
;
2651 GCPRO3 (filename
, val
, p
);
2652 if (!NILP (current_buffer
->read_only
))
2653 Fbarf_if_buffer_read_only();
2655 CHECK_STRING (filename
, 0);
2656 filename
= Fexpand_file_name (filename
, Qnil
);
2658 /* If the file name has special constructs in it,
2659 call the corresponding file handler. */
2660 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2661 if (!NILP (handler
))
2663 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2664 visit
, beg
, end
, replace
);
2671 if (stat (XSTRING (filename
)->data
, &st
) < 0)
2673 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
2674 || fstat (fd
, &st
) < 0)
2675 #endif /* not APOLLO */
2677 if (fd
>= 0) close (fd
);
2680 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2687 /* This code will need to be changed in order to work on named
2688 pipes, and it's probably just not worth it. So we should at
2689 least signal an error. */
2690 if (!S_ISREG (st
.st_mode
))
2691 Fsignal (Qfile_error
,
2692 Fcons (build_string ("not a regular file"),
2693 Fcons (filename
, Qnil
)));
2697 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
2700 /* Replacement should preserve point as it preserves markers. */
2701 if (!NILP (replace
))
2702 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2704 record_unwind_protect (close_file_unwind
, make_number (fd
));
2706 /* Supposedly happens on VMS. */
2708 error ("File size is negative");
2710 if (!NILP (beg
) || !NILP (end
))
2712 error ("Attempt to visit less than an entire file");
2715 CHECK_NUMBER (beg
, 0);
2717 XSETFASTINT (beg
, 0);
2720 CHECK_NUMBER (end
, 0);
2723 XSETINT (end
, st
.st_size
);
2724 if (XINT (end
) != st
.st_size
)
2725 error ("maximum buffer size exceeded");
2728 /* If requested, replace the accessible part of the buffer
2729 with the file contents. Avoid replacing text at the
2730 beginning or end of the buffer that matches the file contents;
2731 that preserves markers pointing to the unchanged parts. */
2733 /* On MSDOS, replace mode doesn't really work, except for binary files,
2734 and it's not worth supporting just for them. */
2735 if (!NILP (replace
))
2738 XSETFASTINT (beg
, 0);
2739 XSETFASTINT (end
, st
.st_size
);
2740 del_range_1 (BEGV
, ZV
, 0);
2743 if (!NILP (replace
))
2745 unsigned char buffer
[1 << 14];
2746 int same_at_start
= BEGV
;
2747 int same_at_end
= ZV
;
2752 /* Count how many chars at the start of the file
2753 match the text at the beginning of the buffer. */
2758 nread
= read (fd
, buffer
, sizeof buffer
);
2760 error ("IO error reading %s: %s",
2761 XSTRING (filename
)->data
, strerror (errno
));
2762 else if (nread
== 0)
2765 while (bufpos
< nread
&& same_at_start
< ZV
2766 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2767 same_at_start
++, bufpos
++;
2768 /* If we found a discrepancy, stop the scan.
2769 Otherwise loop around and scan the next bufferfull. */
2770 if (bufpos
!= nread
)
2774 /* If the file matches the buffer completely,
2775 there's no need to replace anything. */
2776 if (same_at_start
- BEGV
== st
.st_size
)
2780 /* Truncate the buffer to the size of the file. */
2781 del_range_1 (same_at_start
, same_at_end
, 0);
2786 /* Count how many chars at the end of the file
2787 match the text at the end of the buffer. */
2790 int total_read
, nread
, bufpos
, curpos
, trial
;
2792 /* At what file position are we now scanning? */
2793 curpos
= st
.st_size
- (ZV
- same_at_end
);
2794 /* If the entire file matches the buffer tail, stop the scan. */
2797 /* How much can we scan in the next step? */
2798 trial
= min (curpos
, sizeof buffer
);
2799 if (lseek (fd
, curpos
- trial
, 0) < 0)
2800 report_file_error ("Setting file position",
2801 Fcons (filename
, Qnil
));
2804 while (total_read
< trial
)
2806 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2808 error ("IO error reading %s: %s",
2809 XSTRING (filename
)->data
, strerror (errno
));
2810 total_read
+= nread
;
2812 /* Scan this bufferfull from the end, comparing with
2813 the Emacs buffer. */
2814 bufpos
= total_read
;
2815 /* Compare with same_at_start to avoid counting some buffer text
2816 as matching both at the file's beginning and at the end. */
2817 while (bufpos
> 0 && same_at_end
> same_at_start
2818 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2819 same_at_end
--, bufpos
--;
2820 /* If we found a discrepancy, stop the scan.
2821 Otherwise loop around and scan the preceding bufferfull. */
2827 /* Don't try to reuse the same piece of text twice. */
2828 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2830 same_at_end
+= overlap
;
2832 /* Arrange to read only the nonmatching middle part of the file. */
2833 XSETFASTINT (beg
, same_at_start
- BEGV
);
2834 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
2836 del_range_1 (same_at_start
, same_at_end
, 0);
2837 /* Insert from the file at the proper position. */
2838 SET_PT (same_at_start
);
2842 total
= XINT (end
) - XINT (beg
);
2845 register Lisp_Object temp
;
2847 /* Make sure point-max won't overflow after this insertion. */
2848 XSETINT (temp
, total
);
2849 if (total
!= XINT (temp
))
2850 error ("maximum buffer size exceeded");
2853 if (NILP (visit
) && total
> 0)
2854 prepare_to_modify_buffer (point
, point
);
2857 if (GAP_SIZE
< total
)
2858 make_gap (total
- GAP_SIZE
);
2860 if (XINT (beg
) != 0 || !NILP (replace
))
2862 if (lseek (fd
, XINT (beg
), 0) < 0)
2863 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2867 while (inserted
< total
)
2869 int try = min (total
- inserted
, 64 << 10);
2872 /* Allow quitting out of the actual I/O. */
2875 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2892 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
2893 /* Determine file type from name and remove LFs from CR-LFs if the file
2894 is deemed to be a text file. */
2896 current_buffer
->buffer_file_type
2897 = call1 (Qfind_buffer_file_type
, filename
);
2898 if (NILP (current_buffer
->buffer_file_type
))
2901 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
2904 GPT
-= reduced_size
;
2905 GAP_SIZE
+= reduced_size
;
2906 inserted
-= reduced_size
;
2913 record_insert (point
, inserted
);
2915 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2916 offset_intervals (current_buffer
, point
, inserted
);
2922 /* Discard the unwind protect for closing the file. */
2926 error ("IO error reading %s: %s",
2927 XSTRING (filename
)->data
, strerror (errno
));
2934 if (!EQ (current_buffer
->undo_list
, Qt
))
2935 current_buffer
->undo_list
= Qnil
;
2937 stat (XSTRING (filename
)->data
, &st
);
2942 current_buffer
->modtime
= st
.st_mtime
;
2943 current_buffer
->filename
= filename
;
2946 current_buffer
->save_modified
= MODIFF
;
2947 current_buffer
->auto_save_modified
= MODIFF
;
2948 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
2949 #ifdef CLASH_DETECTION
2952 if (!NILP (current_buffer
->filename
))
2953 unlock_file (current_buffer
->filename
);
2954 unlock_file (filename
);
2956 #endif /* CLASH_DETECTION */
2957 /* If visiting nonexistent file, return nil. */
2958 if (current_buffer
->modtime
== -1)
2959 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2962 if (inserted
> 0 && NILP (visit
) && total
> 0)
2963 signal_after_change (point
, 0, inserted
);
2967 p
= Vafter_insert_file_functions
;
2970 insval
= call1 (Fcar (p
), make_number (inserted
));
2973 CHECK_NUMBER (insval
, 0);
2974 inserted
= XFASTINT (insval
);
2982 val
= Fcons (filename
,
2983 Fcons (make_number (inserted
),
2986 RETURN_UNGCPRO (unbind_to (count
, val
));
2989 static Lisp_Object
build_annotations ();
2991 /* If build_annotations switched buffers, switch back to BUF.
2992 Kill the temporary buffer that was selected in the meantime. */
2995 build_annotations_unwind (buf
)
3000 if (XBUFFER (buf
) == current_buffer
)
3002 tembuf
= Fcurrent_buffer ();
3004 Fkill_buffer (tembuf
);
3008 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
3009 "r\nFWrite region to file: ",
3010 "Write current region into specified file.\n\
3011 When called from a program, takes three arguments:\n\
3012 START, END and FILENAME. START and END are buffer positions.\n\
3013 Optional fourth argument APPEND if non-nil means\n\
3014 append to existing file contents (if any).\n\
3015 Optional fifth argument VISIT if t means\n\
3016 set the last-save-file-modtime of buffer to this file's modtime\n\
3017 and mark buffer not modified.\n\
3018 If VISIT is a string, it is a second file name;\n\
3019 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3020 VISIT is also the file name to lock and unlock for clash detection.\n\
3021 If VISIT is neither t nor nil nor a string,\n\
3022 that means do not print the \"Wrote file\" message.\n\
3023 Kludgy feature: if START is a string, then that string is written\n\
3024 to the file, instead of any buffer contents, and END is ignored.")
3025 (start
, end
, filename
, append
, visit
)
3026 Lisp_Object start
, end
, filename
, append
, visit
;
3034 int count
= specpdl_ptr
- specpdl
;
3037 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3039 Lisp_Object handler
;
3040 Lisp_Object visit_file
;
3041 Lisp_Object annotations
;
3042 int visiting
, quietly
;
3043 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3044 struct buffer
*given_buffer
;
3046 int buffer_file_type
3047 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3050 if (!NILP (start
) && !STRINGP (start
))
3051 validate_region (&start
, &end
);
3053 GCPRO2 (filename
, visit
);
3054 filename
= Fexpand_file_name (filename
, Qnil
);
3055 if (STRINGP (visit
))
3056 visit_file
= Fexpand_file_name (visit
, Qnil
);
3058 visit_file
= filename
;
3061 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3062 quietly
= !NILP (visit
);
3066 GCPRO4 (start
, filename
, annotations
, visit_file
);
3068 /* If the file name has special constructs in it,
3069 call the corresponding file handler. */
3070 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3071 /* If FILENAME has no handler, see if VISIT has one. */
3072 if (NILP (handler
) && STRINGP (visit
))
3073 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3075 if (!NILP (handler
))
3078 val
= call6 (handler
, Qwrite_region
, start
, end
,
3079 filename
, append
, visit
);
3083 current_buffer
->save_modified
= MODIFF
;
3084 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3085 current_buffer
->filename
= visit_file
;
3091 /* Special kludge to simplify auto-saving. */
3094 XSETFASTINT (start
, BEG
);
3095 XSETFASTINT (end
, Z
);
3098 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3099 count1
= specpdl_ptr
- specpdl
;
3101 given_buffer
= current_buffer
;
3102 annotations
= build_annotations (start
, end
);
3103 if (current_buffer
!= given_buffer
)
3109 #ifdef CLASH_DETECTION
3111 lock_file (visit_file
);
3112 #endif /* CLASH_DETECTION */
3114 fn
= XSTRING (filename
)->data
;
3118 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3120 desc
= open (fn
, O_WRONLY
);
3125 if (auto_saving
) /* Overwrite any previous version of autosave file */
3127 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3128 desc
= open (fn
, O_RDWR
);
3130 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3131 ? XSTRING (current_buffer
->filename
)->data
: 0,
3134 else /* Write to temporary name and rename if no errors */
3136 Lisp_Object temp_name
;
3137 temp_name
= Ffile_name_directory (filename
);
3139 if (!NILP (temp_name
))
3141 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3142 build_string ("$$SAVE$$")));
3143 fname
= XSTRING (filename
)->data
;
3144 fn
= XSTRING (temp_name
)->data
;
3145 desc
= creat_copy_attrs (fname
, fn
);
3148 /* If we can't open the temporary file, try creating a new
3149 version of the original file. VMS "creat" creates a
3150 new version rather than truncating an existing file. */
3153 desc
= creat (fn
, 0666);
3154 #if 0 /* This can clobber an existing file and fail to replace it,
3155 if the user runs out of space. */
3158 /* We can't make a new version;
3159 try to truncate and rewrite existing version if any. */
3161 desc
= open (fn
, O_RDWR
);
3167 desc
= creat (fn
, 0666);
3172 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3173 S_IREAD
| S_IWRITE
);
3174 #else /* not MSDOS */
3175 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3176 #endif /* not MSDOS */
3177 #endif /* not VMS */
3183 #ifdef CLASH_DETECTION
3185 if (!auto_saving
) unlock_file (visit_file
);
3187 #endif /* CLASH_DETECTION */
3188 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3191 record_unwind_protect (close_file_unwind
, make_number (desc
));
3194 if (lseek (desc
, 0, 2) < 0)
3196 #ifdef CLASH_DETECTION
3197 if (!auto_saving
) unlock_file (visit_file
);
3198 #endif /* CLASH_DETECTION */
3199 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3204 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3205 * if we do writes that don't end with a carriage return. Furthermore
3206 * it cannot handle writes of more then 16K. The modified
3207 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3208 * this EXCEPT for the last record (iff it doesn't end with a carriage
3209 * return). This implies that if your buffer doesn't end with a carriage
3210 * return, you get one free... tough. However it also means that if
3211 * we make two calls to sys_write (a la the following code) you can
3212 * get one at the gap as well. The easiest way to fix this (honest)
3213 * is to move the gap to the next newline (or the end of the buffer).
3218 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3219 move_gap (find_next_newline (GPT
, 1));
3225 if (STRINGP (start
))
3227 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3228 XSTRING (start
)->size
, 0, &annotations
);
3231 else if (XINT (start
) != XINT (end
))
3234 if (XINT (start
) < GPT
)
3236 register int end1
= XINT (end
);
3238 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3239 min (GPT
, end1
) - tem
, tem
, &annotations
);
3240 nwritten
+= min (GPT
, end1
) - tem
;
3244 if (XINT (end
) > GPT
&& !failure
)
3247 tem
= max (tem
, GPT
);
3248 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3250 nwritten
+= XINT (end
) - tem
;
3256 /* If file was empty, still need to write the annotations */
3257 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3265 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3266 Disk full in NFS may be reported here. */
3267 /* mib says that closing the file will try to write as fast as NFS can do
3268 it, and that means the fsync here is not crucial for autosave files. */
3269 if (!auto_saving
&& fsync (desc
) < 0)
3270 failure
= 1, save_errno
= errno
;
3273 /* Spurious "file has changed on disk" warnings have been
3274 observed on Suns as well.
3275 It seems that `close' can change the modtime, under nfs.
3277 (This has supposedly been fixed in Sunos 4,
3278 but who knows about all the other machines with NFS?) */
3281 /* On VMS and APOLLO, must do the stat after the close
3282 since closing changes the modtime. */
3285 /* Recall that #if defined does not work on VMS. */
3292 /* NFS can report a write failure now. */
3293 if (close (desc
) < 0)
3294 failure
= 1, save_errno
= errno
;
3297 /* If we wrote to a temporary name and had no errors, rename to real name. */
3301 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3309 /* Discard the unwind protect for close_file_unwind. */
3310 specpdl_ptr
= specpdl
+ count1
;
3311 /* Restore the original current buffer. */
3312 visit_file
= unbind_to (count
, visit_file
);
3314 #ifdef CLASH_DETECTION
3316 unlock_file (visit_file
);
3317 #endif /* CLASH_DETECTION */
3319 /* Do this before reporting IO error
3320 to avoid a "file has changed on disk" warning on
3321 next attempt to save. */
3323 current_buffer
->modtime
= st
.st_mtime
;
3326 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3330 current_buffer
->save_modified
= MODIFF
;
3331 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3332 current_buffer
->filename
= visit_file
;
3333 update_mode_lines
++;
3339 message ("Wrote %s", XSTRING (visit_file
)->data
);
3344 Lisp_Object
merge ();
3346 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3347 "Return t if (car A) is numerically less than (car B).")
3351 return Flss (Fcar (a
), Fcar (b
));
3354 /* Build the complete list of annotations appropriate for writing out
3355 the text between START and END, by calling all the functions in
3356 write-region-annotate-functions and merging the lists they return.
3357 If one of these functions switches to a different buffer, we assume
3358 that buffer contains altered text. Therefore, the caller must
3359 make sure to restore the current buffer in all cases,
3360 as save-excursion would do. */
3363 build_annotations (start
, end
)
3364 Lisp_Object start
, end
;
3366 Lisp_Object annotations
;
3368 struct gcpro gcpro1
, gcpro2
;
3371 p
= Vwrite_region_annotate_functions
;
3372 GCPRO2 (annotations
, p
);
3375 struct buffer
*given_buffer
= current_buffer
;
3376 Vwrite_region_annotations_so_far
= annotations
;
3377 res
= call2 (Fcar (p
), start
, end
);
3378 /* If the function makes a different buffer current,
3379 assume that means this buffer contains altered text to be output.
3380 Reset START and END from the buffer bounds
3381 and discard all previous annotations because they should have
3382 been dealt with by this function. */
3383 if (current_buffer
!= given_buffer
)
3389 Flength (res
); /* Check basic validity of return value */
3390 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3397 /* Write to descriptor DESC the LEN characters starting at ADDR,
3398 assuming they start at position POS in the buffer.
3399 Intersperse with them the annotations from *ANNOT
3400 (those which fall within the range of positions POS to POS + LEN),
3401 each at its appropriate position.
3403 Modify *ANNOT by discarding elements as we output them.
3404 The return value is negative in case of system call failure. */
3407 a_write (desc
, addr
, len
, pos
, annot
)
3409 register char *addr
;
3416 int lastpos
= pos
+ len
;
3418 while (NILP (*annot
) || CONSP (*annot
))
3420 tem
= Fcar_safe (Fcar (*annot
));
3421 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3422 nextpos
= XFASTINT (tem
);
3424 return e_write (desc
, addr
, lastpos
- pos
);
3427 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3429 addr
+= nextpos
- pos
;
3432 tem
= Fcdr (Fcar (*annot
));
3435 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3438 *annot
= Fcdr (*annot
);
3443 e_write (desc
, addr
, len
)
3445 register char *addr
;
3448 char buf
[16 * 1024];
3449 register char *p
, *end
;
3451 if (!EQ (current_buffer
->selective_display
, Qt
))
3452 return write (desc
, addr
, len
) - len
;
3456 end
= p
+ sizeof buf
;
3461 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3470 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3476 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3477 Sverify_visited_file_modtime
, 1, 1, 0,
3478 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3479 This means that the file has not been changed since it was visited or saved.")
3485 Lisp_Object handler
;
3487 CHECK_BUFFER (buf
, 0);
3490 if (!STRINGP (b
->filename
)) return Qt
;
3491 if (b
->modtime
== 0) return Qt
;
3493 /* If the file name has special constructs in it,
3494 call the corresponding file handler. */
3495 handler
= Ffind_file_name_handler (b
->filename
,
3496 Qverify_visited_file_modtime
);
3497 if (!NILP (handler
))
3498 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3500 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3502 /* If the file doesn't exist now and didn't exist before,
3503 we say that it isn't modified, provided the error is a tame one. */
3504 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3509 if (st
.st_mtime
== b
->modtime
3510 /* If both are positive, accept them if they are off by one second. */
3511 || (st
.st_mtime
> 0 && b
->modtime
> 0
3512 && (st
.st_mtime
== b
->modtime
+ 1
3513 || st
.st_mtime
== b
->modtime
- 1)))
3518 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3519 Sclear_visited_file_modtime
, 0, 0, 0,
3520 "Clear out records of last mod time of visited file.\n\
3521 Next attempt to save will certainly not complain of a discrepancy.")
3524 current_buffer
->modtime
= 0;
3528 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3529 Svisited_file_modtime
, 0, 0, 0,
3530 "Return the current buffer's recorded visited file modification time.\n\
3531 The value is a list of the form (HIGH . LOW), like the time values\n\
3532 that `file-attributes' returns.")
3535 return long_to_cons (current_buffer
->modtime
);
3538 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3539 Sset_visited_file_modtime
, 0, 1, 0,
3540 "Update buffer's recorded modification time from the visited file's time.\n\
3541 Useful if the buffer was not read from the file normally\n\
3542 or if the file itself has been changed for some known benign reason.\n\
3543 An argument specifies the modification time value to use\n\
3544 \(instead of that of the visited file), in the form of a list\n\
3545 \(HIGH . LOW) or (HIGH LOW).")
3547 Lisp_Object time_list
;
3549 if (!NILP (time_list
))
3550 current_buffer
->modtime
= cons_to_long (time_list
);
3553 register Lisp_Object filename
;
3555 Lisp_Object handler
;
3557 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3559 /* If the file name has special constructs in it,
3560 call the corresponding file handler. */
3561 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3562 if (!NILP (handler
))
3563 /* The handler can find the file name the same way we did. */
3564 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3565 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3566 current_buffer
->modtime
= st
.st_mtime
;
3576 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3577 Fsleep_for (make_number (1), Qnil
);
3578 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3579 Fsleep_for (make_number (1), Qnil
);
3580 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3581 Fsleep_for (make_number (1), Qnil
);
3591 /* Get visited file's mode to become the auto save file's mode. */
3592 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3593 /* But make sure we can overwrite it later! */
3594 auto_save_mode_bits
= st
.st_mode
| 0600;
3596 auto_save_mode_bits
= 0666;
3599 Fwrite_region (Qnil
, Qnil
,
3600 current_buffer
->auto_save_file_name
,
3605 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3608 close (XINT (desc
));
3612 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3613 "Auto-save all buffers that need it.\n\
3614 This is all buffers that have auto-saving enabled\n\
3615 and are changed since last auto-saved.\n\
3616 Auto-saving writes the buffer into a file\n\
3617 so that your editing is not lost if the system crashes.\n\
3618 This file is not the file you visited; that changes only when you save.\n\
3619 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3620 Non-nil first argument means do not print any message if successful.\n\
3621 Non-nil second argument means save only current buffer.")
3622 (no_message
, current_only
)
3623 Lisp_Object no_message
, current_only
;
3625 struct buffer
*old
= current_buffer
, *b
;
3626 Lisp_Object tail
, buf
;
3628 char *omessage
= echo_area_glyphs
;
3629 int omessage_length
= echo_area_glyphs_length
;
3630 extern int minibuf_level
;
3631 int do_handled_files
;
3634 int count
= specpdl_ptr
- specpdl
;
3637 /* Ordinarily don't quit within this function,
3638 but don't make it impossible to quit (in case we get hung in I/O). */
3642 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3643 point to non-strings reached from Vbuffer_alist. */
3649 if (!NILP (Vrun_hooks
))
3650 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3652 if (STRINGP (Vauto_save_list_file_name
))
3655 listdesc
= open (XSTRING (Vauto_save_list_file_name
)->data
,
3656 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3657 S_IREAD
| S_IWRITE
);
3658 #else /* not MSDOS */
3659 listdesc
= creat (XSTRING (Vauto_save_list_file_name
)->data
, 0666);
3660 #endif /* not MSDOS */
3665 /* Arrange to close that file whether or not we get an error. */
3667 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3669 /* First, save all files which don't have handlers. If Emacs is
3670 crashing, the handlers may tweak what is causing Emacs to crash
3671 in the first place, and it would be a shame if Emacs failed to
3672 autosave perfectly ordinary files because it couldn't handle some
3674 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3675 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
3676 tail
= XCONS (tail
)->cdr
)
3678 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3681 /* Record all the buffers that have auto save mode
3682 in the special file that lists them. */
3683 if (STRINGP (b
->auto_save_file_name
)
3684 && listdesc
>= 0 && do_handled_files
== 0)
3686 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3687 XSTRING (b
->auto_save_file_name
)->size
);
3688 write (listdesc
, "\n", 1);
3691 if (!NILP (current_only
)
3692 && b
!= current_buffer
)
3695 /* Check for auto save enabled
3696 and file changed since last auto save
3697 and file changed since last real save. */
3698 if (STRINGP (b
->auto_save_file_name
)
3699 && b
->save_modified
< BUF_MODIFF (b
)
3700 && b
->auto_save_modified
< BUF_MODIFF (b
)
3701 /* -1 means we've turned off autosaving for a while--see below. */
3702 && XINT (b
->save_length
) >= 0
3703 && (do_handled_files
3704 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3707 EMACS_TIME before_time
, after_time
;
3709 EMACS_GET_TIME (before_time
);
3711 /* If we had a failure, don't try again for 20 minutes. */
3712 if (b
->auto_save_failure_time
>= 0
3713 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3716 if ((XFASTINT (b
->save_length
) * 10
3717 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3718 /* A short file is likely to change a large fraction;
3719 spare the user annoying messages. */
3720 && XFASTINT (b
->save_length
) > 5000
3721 /* These messages are frequent and annoying for `*mail*'. */
3722 && !EQ (b
->filename
, Qnil
)
3723 && NILP (no_message
))
3725 /* It has shrunk too much; turn off auto-saving here. */
3726 message ("Buffer %s has shrunk a lot; auto save turned off there",
3727 XSTRING (b
->name
)->data
);
3728 /* Turn off auto-saving until there's a real save,
3729 and prevent any more warnings. */
3730 XSETINT (b
->save_length
, -1);
3731 Fsleep_for (make_number (1), Qnil
);
3734 set_buffer_internal (b
);
3735 if (!auto_saved
&& NILP (no_message
))
3736 message1 ("Auto-saving...");
3737 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3739 b
->auto_save_modified
= BUF_MODIFF (b
);
3740 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3741 set_buffer_internal (old
);
3743 EMACS_GET_TIME (after_time
);
3745 /* If auto-save took more than 60 seconds,
3746 assume it was an NFS failure that got a timeout. */
3747 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3748 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3752 /* Prevent another auto save till enough input events come in. */
3753 record_auto_save ();
3755 if (auto_saved
&& NILP (no_message
))
3758 message2 (omessage
, omessage_length
);
3760 message1 ("Auto-saving...done");
3766 unbind_to (count
, Qnil
);
3770 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3771 Sset_buffer_auto_saved
, 0, 0, 0,
3772 "Mark current buffer as auto-saved with its current text.\n\
3773 No auto-save file will be written until the buffer changes again.")
3776 current_buffer
->auto_save_modified
= MODIFF
;
3777 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3778 current_buffer
->auto_save_failure_time
= -1;
3782 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3783 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3784 "Clear any record of a recent auto-save failure in the current buffer.")
3787 current_buffer
->auto_save_failure_time
= -1;
3791 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3793 "Return t if buffer has been auto-saved since last read in or saved.")
3796 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3799 /* Reading and completing file names */
3800 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3802 /* In the string VAL, change each $ to $$ and return the result. */
3805 double_dollars (val
)
3808 register unsigned char *old
, *new;
3812 osize
= XSTRING (val
)->size
;
3813 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3814 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3815 if (*old
++ == '$') count
++;
3818 old
= XSTRING (val
)->data
;
3819 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3820 new = XSTRING (val
)->data
;
3821 for (n
= osize
; n
> 0; n
--)
3834 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3836 "Internal subroutine for read-file-name. Do not call this.")
3837 (string
, dir
, action
)
3838 Lisp_Object string
, dir
, action
;
3839 /* action is nil for complete, t for return list of completions,
3840 lambda for verify final value */
3842 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3844 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3851 /* No need to protect ACTION--we only compare it with t and nil. */
3852 GCPRO4 (string
, realdir
, name
, specdir
);
3854 if (XSTRING (string
)->size
== 0)
3856 if (EQ (action
, Qlambda
))
3864 orig_string
= string
;
3865 string
= Fsubstitute_in_file_name (string
);
3866 changed
= NILP (Fstring_equal (string
, orig_string
));
3867 name
= Ffile_name_nondirectory (string
);
3868 val
= Ffile_name_directory (string
);
3870 realdir
= Fexpand_file_name (val
, realdir
);
3875 specdir
= Ffile_name_directory (string
);
3876 val
= Ffile_name_completion (name
, realdir
);
3881 return double_dollars (string
);
3885 if (!NILP (specdir
))
3886 val
= concat2 (specdir
, val
);
3888 return double_dollars (val
);
3891 #endif /* not VMS */
3895 if (EQ (action
, Qt
))
3896 return Ffile_name_all_completions (name
, realdir
);
3897 /* Only other case actually used is ACTION = lambda */
3899 /* Supposedly this helps commands such as `cd' that read directory names,
3900 but can someone explain how it helps them? -- RMS */
3901 if (XSTRING (name
)->size
== 0)
3904 return Ffile_exists_p (string
);
3907 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3908 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3909 Value is not expanded---you must call `expand-file-name' yourself.\n\
3910 Default name to DEFAULT if user enters a null string.\n\
3911 (If DEFAULT is omitted, the visited file name is used,\n\
3912 except that if INITIAL is specified, that combined with DIR is used.)\n\
3913 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3914 Non-nil and non-t means also require confirmation after completion.\n\
3915 Fifth arg INITIAL specifies text to start with.\n\
3916 DIR defaults to current buffer's directory default.")
3917 (prompt
, dir
, defalt
, mustmatch
, initial
)
3918 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3920 Lisp_Object val
, insdef
, insdef1
, tem
;
3921 struct gcpro gcpro1
, gcpro2
;
3922 register char *homedir
;
3926 dir
= current_buffer
->directory
;
3929 if (! NILP (initial
))
3930 defalt
= Fexpand_file_name (initial
, dir
);
3932 defalt
= current_buffer
->filename
;
3935 /* If dir starts with user's homedir, change that to ~. */
3936 homedir
= (char *) egetenv ("HOME");
3939 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3940 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3942 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3943 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3944 XSTRING (dir
)->data
[0] = '~';
3947 if (insert_default_directory
)
3950 if (!NILP (initial
))
3952 Lisp_Object args
[2], pos
;
3956 insdef
= Fconcat (2, args
);
3957 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
3958 insdef1
= Fcons (double_dollars (insdef
), pos
);
3961 insdef1
= double_dollars (insdef
);
3963 else if (!NILP (initial
))
3966 insdef1
= Fcons (double_dollars (insdef
), 0);
3969 insdef
= Qnil
, insdef1
= Qnil
;
3972 count
= specpdl_ptr
- specpdl
;
3973 specbind (intern ("completion-ignore-case"), Qt
);
3976 GCPRO2 (insdef
, defalt
);
3977 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3978 dir
, mustmatch
, insdef1
,
3979 Qfile_name_history
);
3982 unbind_to (count
, Qnil
);
3987 error ("No file name specified");
3988 tem
= Fstring_equal (val
, insdef
);
3989 if (!NILP (tem
) && !NILP (defalt
))
3991 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3996 error ("No default file name");
3998 return Fsubstitute_in_file_name (val
);
4001 #if 0 /* Old version */
4002 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4003 /* Don't confuse make-docfile by having two doc strings for this function.
4004 make-docfile does not pay attention to #if, for good reason! */
4006 (prompt
, dir
, defalt
, mustmatch
, initial
)
4007 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4009 Lisp_Object val
, insdef
, tem
;
4010 struct gcpro gcpro1
, gcpro2
;
4011 register char *homedir
;
4015 dir
= current_buffer
->directory
;
4017 defalt
= current_buffer
->filename
;
4019 /* If dir starts with user's homedir, change that to ~. */
4020 homedir
= (char *) egetenv ("HOME");
4023 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4024 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4026 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4027 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4028 XSTRING (dir
)->data
[0] = '~';
4031 if (!NILP (initial
))
4033 else if (insert_default_directory
)
4036 insdef
= build_string ("");
4039 count
= specpdl_ptr
- specpdl
;
4040 specbind (intern ("completion-ignore-case"), Qt
);
4043 GCPRO2 (insdef
, defalt
);
4044 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4046 insert_default_directory
? insdef
: Qnil
,
4047 Qfile_name_history
);
4050 unbind_to (count
, Qnil
);
4055 error ("No file name specified");
4056 tem
= Fstring_equal (val
, insdef
);
4057 if (!NILP (tem
) && !NILP (defalt
))
4059 return Fsubstitute_in_file_name (val
);
4061 #endif /* Old version */
4065 Qexpand_file_name
= intern ("expand-file-name");
4066 Qdirectory_file_name
= intern ("directory-file-name");
4067 Qfile_name_directory
= intern ("file-name-directory");
4068 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4069 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4070 Qfile_name_as_directory
= intern ("file-name-as-directory");
4071 Qcopy_file
= intern ("copy-file");
4072 Qmake_directory_internal
= intern ("make-directory-internal");
4073 Qdelete_directory
= intern ("delete-directory");
4074 Qdelete_file
= intern ("delete-file");
4075 Qrename_file
= intern ("rename-file");
4076 Qadd_name_to_file
= intern ("add-name-to-file");
4077 Qmake_symbolic_link
= intern ("make-symbolic-link");
4078 Qfile_exists_p
= intern ("file-exists-p");
4079 Qfile_executable_p
= intern ("file-executable-p");
4080 Qfile_readable_p
= intern ("file-readable-p");
4081 Qfile_symlink_p
= intern ("file-symlink-p");
4082 Qfile_writable_p
= intern ("file-writable-p");
4083 Qfile_directory_p
= intern ("file-directory-p");
4084 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4085 Qfile_modes
= intern ("file-modes");
4086 Qset_file_modes
= intern ("set-file-modes");
4087 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4088 Qinsert_file_contents
= intern ("insert-file-contents");
4089 Qwrite_region
= intern ("write-region");
4090 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4091 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4093 staticpro (&Qexpand_file_name
);
4094 staticpro (&Qdirectory_file_name
);
4095 staticpro (&Qfile_name_directory
);
4096 staticpro (&Qfile_name_nondirectory
);
4097 staticpro (&Qunhandled_file_name_directory
);
4098 staticpro (&Qfile_name_as_directory
);
4099 staticpro (&Qcopy_file
);
4100 staticpro (&Qmake_directory_internal
);
4101 staticpro (&Qdelete_directory
);
4102 staticpro (&Qdelete_file
);
4103 staticpro (&Qrename_file
);
4104 staticpro (&Qadd_name_to_file
);
4105 staticpro (&Qmake_symbolic_link
);
4106 staticpro (&Qfile_exists_p
);
4107 staticpro (&Qfile_executable_p
);
4108 staticpro (&Qfile_readable_p
);
4109 staticpro (&Qfile_symlink_p
);
4110 staticpro (&Qfile_writable_p
);
4111 staticpro (&Qfile_directory_p
);
4112 staticpro (&Qfile_accessible_directory_p
);
4113 staticpro (&Qfile_modes
);
4114 staticpro (&Qset_file_modes
);
4115 staticpro (&Qfile_newer_than_file_p
);
4116 staticpro (&Qinsert_file_contents
);
4117 staticpro (&Qwrite_region
);
4118 staticpro (&Qverify_visited_file_modtime
);
4120 Qfile_name_history
= intern ("file-name-history");
4121 Fset (Qfile_name_history
, Qnil
);
4122 staticpro (&Qfile_name_history
);
4124 Qfile_error
= intern ("file-error");
4125 staticpro (&Qfile_error
);
4126 Qfile_already_exists
= intern("file-already-exists");
4127 staticpro (&Qfile_already_exists
);
4130 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4131 staticpro (&Qfind_buffer_file_type
);
4134 Qcar_less_than_car
= intern ("car-less-than-car");
4135 staticpro (&Qcar_less_than_car
);
4137 Fput (Qfile_error
, Qerror_conditions
,
4138 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4139 Fput (Qfile_error
, Qerror_message
,
4140 build_string ("File error"));
4142 Fput (Qfile_already_exists
, Qerror_conditions
,
4143 Fcons (Qfile_already_exists
,
4144 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4145 Fput (Qfile_already_exists
, Qerror_message
,
4146 build_string ("File already exists"));
4148 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4149 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4150 insert_default_directory
= 1;
4152 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4153 "*Non-nil means write new files with record format `stmlf'.\n\
4154 nil means use format `var'. This variable is meaningful only on VMS.");
4155 vms_stmlf_recfm
= 0;
4157 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4158 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4159 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4162 The first argument given to HANDLER is the name of the I/O primitive\n\
4163 to be handled; the remaining arguments are the arguments that were\n\
4164 passed to that primitive. For example, if you do\n\
4165 (file-exists-p FILENAME)\n\
4166 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4167 (funcall HANDLER 'file-exists-p FILENAME)\n\
4168 The function `find-file-name-handler' checks this list for a handler\n\
4169 for its argument.");
4170 Vfile_name_handler_alist
= Qnil
;
4172 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4173 "A list of functions to be called at the end of `insert-file-contents'.\n\
4174 Each is passed one argument, the number of bytes inserted. It should return\n\
4175 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4176 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4177 responsible for calling the after-insert-file-functions if appropriate.");
4178 Vafter_insert_file_functions
= Qnil
;
4180 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4181 "A list of functions to be called at the start of `write-region'.\n\
4182 Each is passed two arguments, START and END as for `write-region'. It should\n\
4183 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4184 inserted at the specified positions of the file being written (1 means to\n\
4185 insert before the first byte written). The POSITIONs must be sorted into\n\
4186 increasing order. If there are several functions in the list, the several\n\
4187 lists are merged destructively.");
4188 Vwrite_region_annotate_functions
= Qnil
;
4190 DEFVAR_LISP ("write-region-annotations-so-far",
4191 &Vwrite_region_annotations_so_far
,
4192 "When an annotation function is called, this holds the previous annotations.\n\
4193 These are the annotations made by other annotation functions\n\
4194 that were already called. See also `write-region-annotate-functions'.");
4195 Vwrite_region_annotations_so_far
= Qnil
;
4197 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4198 "A list of file name handlers that temporarily should not be used.\n\
4199 This applies only to the operation `inhibit-file-name-operation'.");
4200 Vinhibit_file_name_handlers
= Qnil
;
4202 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4203 "The operation for which `inhibit-file-name-handlers' is applicable.");
4204 Vinhibit_file_name_operation
= Qnil
;
4206 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4207 "File name in which we write a list of all auto save file names.");
4208 Vauto_save_list_file_name
= Qnil
;
4210 defsubr (&Sfind_file_name_handler
);
4211 defsubr (&Sfile_name_directory
);
4212 defsubr (&Sfile_name_nondirectory
);
4213 defsubr (&Sunhandled_file_name_directory
);
4214 defsubr (&Sfile_name_as_directory
);
4215 defsubr (&Sdirectory_file_name
);
4216 defsubr (&Smake_temp_name
);
4217 defsubr (&Sexpand_file_name
);
4218 defsubr (&Ssubstitute_in_file_name
);
4219 defsubr (&Scopy_file
);
4220 defsubr (&Smake_directory_internal
);
4221 defsubr (&Sdelete_directory
);
4222 defsubr (&Sdelete_file
);
4223 defsubr (&Srename_file
);
4224 defsubr (&Sadd_name_to_file
);
4226 defsubr (&Smake_symbolic_link
);
4227 #endif /* S_IFLNK */
4229 defsubr (&Sdefine_logical_name
);
4232 defsubr (&Ssysnetunam
);
4233 #endif /* HPUX_NET */
4234 defsubr (&Sfile_name_absolute_p
);
4235 defsubr (&Sfile_exists_p
);
4236 defsubr (&Sfile_executable_p
);
4237 defsubr (&Sfile_readable_p
);
4238 defsubr (&Sfile_writable_p
);
4239 defsubr (&Sfile_symlink_p
);
4240 defsubr (&Sfile_directory_p
);
4241 defsubr (&Sfile_accessible_directory_p
);
4242 defsubr (&Sfile_regular_p
);
4243 defsubr (&Sfile_modes
);
4244 defsubr (&Sset_file_modes
);
4245 defsubr (&Sset_default_file_modes
);
4246 defsubr (&Sdefault_file_modes
);
4247 defsubr (&Sfile_newer_than_file_p
);
4248 defsubr (&Sinsert_file_contents
);
4249 defsubr (&Swrite_region
);
4250 defsubr (&Scar_less_than_car
);
4251 defsubr (&Sverify_visited_file_modtime
);
4252 defsubr (&Sclear_visited_file_modtime
);
4253 defsubr (&Svisited_file_modtime
);
4254 defsubr (&Sset_visited_file_modtime
);
4255 defsubr (&Sdo_auto_save
);
4256 defsubr (&Sset_buffer_auto_saved
);
4257 defsubr (&Sclear_buffer_auto_save_failure
);
4258 defsubr (&Srecent_auto_save_p
);
4260 defsubr (&Sread_file_name_internal
);
4261 defsubr (&Sread_file_name
);
4264 defsubr (&Sunix_sync
);