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 extern Lisp_Object Qcompletion_ignored_extensions
;
155 Lisp_Object Qfile_error
, Qfile_already_exists
;
157 Lisp_Object Qfile_name_history
;
159 Lisp_Object Qcar_less_than_car
;
161 report_file_error (string
, data
)
165 Lisp_Object errstring
;
167 errstring
= build_string (strerror (errno
));
169 /* System error messages are capitalized. Downcase the initial
170 unless it is followed by a slash. */
171 if (XSTRING (errstring
)->data
[1] != '/')
172 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
175 Fsignal (Qfile_error
,
176 Fcons (build_string (string
), Fcons (errstring
, data
)));
179 close_file_unwind (fd
)
182 close (XFASTINT (fd
));
185 /* Restore point, having saved it as a marker. */
187 restore_point_unwind (location
)
188 Lisp_Object location
;
190 SET_PT (marker_position (location
));
191 Fset_marker (location
, Qnil
, Qnil
);
194 Lisp_Object Qexpand_file_name
;
195 Lisp_Object Qdirectory_file_name
;
196 Lisp_Object Qfile_name_directory
;
197 Lisp_Object Qfile_name_nondirectory
;
198 Lisp_Object Qunhandled_file_name_directory
;
199 Lisp_Object Qfile_name_as_directory
;
200 Lisp_Object Qcopy_file
;
201 Lisp_Object Qmake_directory_internal
;
202 Lisp_Object Qdelete_directory
;
203 Lisp_Object Qdelete_file
;
204 Lisp_Object Qrename_file
;
205 Lisp_Object Qadd_name_to_file
;
206 Lisp_Object Qmake_symbolic_link
;
207 Lisp_Object Qfile_exists_p
;
208 Lisp_Object Qfile_executable_p
;
209 Lisp_Object Qfile_readable_p
;
210 Lisp_Object Qfile_symlink_p
;
211 Lisp_Object Qfile_writable_p
;
212 Lisp_Object Qfile_directory_p
;
213 Lisp_Object Qfile_accessible_directory_p
;
214 Lisp_Object Qfile_modes
;
215 Lisp_Object Qset_file_modes
;
216 Lisp_Object Qfile_newer_than_file_p
;
217 Lisp_Object Qinsert_file_contents
;
218 Lisp_Object Qwrite_region
;
219 Lisp_Object Qverify_visited_file_modtime
;
220 Lisp_Object Qset_visited_file_modtime
;
222 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
223 "Return FILENAME's handler function for OPERATION, if it has one.\n\
224 Otherwise, return nil.\n\
225 A file name is handled if one of the regular expressions in\n\
226 `file-name-handler-alist' matches it.\n\n\
227 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
228 any handlers that are members of `inhibit-file-name-handlers',\n\
229 but we still do run any other handlers. This lets handlers\n\
230 use the standard functions without calling themselves recursively.")
231 (filename
, operation
)
232 Lisp_Object filename
, operation
;
234 /* This function must not munge the match data. */
235 Lisp_Object chain
, inhibited_handlers
;
237 CHECK_STRING (filename
, 0);
239 if (EQ (operation
, Vinhibit_file_name_operation
))
240 inhibited_handlers
= Vinhibit_file_name_handlers
;
242 inhibited_handlers
= Qnil
;
244 for (chain
= Vfile_name_handler_alist
; XTYPE (chain
) == Lisp_Cons
;
245 chain
= XCONS (chain
)->cdr
)
248 elt
= XCONS (chain
)->car
;
249 if (XTYPE (elt
) == Lisp_Cons
)
252 string
= XCONS (elt
)->car
;
253 if (XTYPE (string
) == Lisp_String
254 && fast_string_match (string
, filename
) >= 0)
256 Lisp_Object handler
, tem
;
258 handler
= XCONS (elt
)->cdr
;
259 tem
= Fmemq (handler
, inhibited_handlers
);
270 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
272 "Return the directory component in file name NAME.\n\
273 Return nil if NAME does not include a directory.\n\
274 Otherwise return a directory spec.\n\
275 Given a Unix syntax file name, returns a string ending in slash;\n\
276 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
280 register unsigned char *beg
;
281 register unsigned char *p
;
284 CHECK_STRING (file
, 0);
286 /* If the file name has special constructs in it,
287 call the corresponding file handler. */
288 handler
= Ffind_file_name_handler (file
, Qfile_name_directory
);
290 return call2 (handler
, Qfile_name_directory
, file
);
292 #ifdef FILE_SYSTEM_CASE
293 file
= FILE_SYSTEM_CASE (file
);
295 beg
= XSTRING (file
)->data
;
296 p
= beg
+ XSTRING (file
)->size
;
298 while (p
!= beg
&& p
[-1] != '/'
300 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
303 && p
[-1] != ':' && p
[-1] != '\\'
310 /* Expansion of "c:" to drive and default directory. */
311 if (p
== beg
+ 2 && beg
[1] == ':')
313 int drive
= (*beg
) - 'a';
314 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
315 unsigned char *res
= alloca (MAXPATHLEN
+ 5);
316 if (getdefdir (drive
+ 1, res
+ 2))
318 res
[0] = drive
+ 'a';
320 if (res
[strlen (res
) - 1] != '/')
323 p
= beg
+ strlen (beg
);
327 return make_string (beg
, p
- beg
);
330 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
332 "Return file name NAME sans its directory.\n\
333 For example, in a Unix-syntax file name,\n\
334 this is everything after the last slash,\n\
335 or the entire name if it contains no slash.")
339 register unsigned char *beg
, *p
, *end
;
342 CHECK_STRING (file
, 0);
344 /* If the file name has special constructs in it,
345 call the corresponding file handler. */
346 handler
= Ffind_file_name_handler (file
, Qfile_name_nondirectory
);
348 return call2 (handler
, Qfile_name_nondirectory
, file
);
350 beg
= XSTRING (file
)->data
;
351 end
= p
= beg
+ XSTRING (file
)->size
;
353 while (p
!= beg
&& p
[-1] != '/'
355 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
358 && p
[-1] != ':' && p
[-1] != '\\'
362 return make_string (p
, end
- p
);
365 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
366 "Return a directly usable directory name somehow associated with FILENAME.\n\
367 A `directly usable' directory name is one that may be used without the\n\
368 intervention of any file handler.\n\
369 If FILENAME is a directly usable file itself, return\n\
370 (file-name-directory FILENAME).\n\
371 The `call-process' and `start-process' functions use this function to\n\
372 get a current directory to run processes in.")
374 Lisp_Object filename
;
378 /* If the file name has special constructs in it,
379 call the corresponding file handler. */
380 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
382 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
384 return Ffile_name_directory (filename
);
389 file_name_as_directory (out
, in
)
392 int size
= strlen (in
) - 1;
397 /* Is it already a directory string? */
398 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
400 /* Is it a VMS directory file name? If so, hack VMS syntax. */
401 else if (! index (in
, '/')
402 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
403 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
404 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
405 || ! strncmp (&in
[size
- 5], ".dir", 4))
406 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
407 && in
[size
] == '1')))
409 register char *p
, *dot
;
413 dir:x.dir --> dir:[x]
414 dir:[x]y.dir --> dir:[x.y] */
416 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
419 strncpy (out
, in
, p
- in
);
438 dot
= index (p
, '.');
441 /* blindly remove any extension */
442 size
= strlen (out
) + (dot
- p
);
443 strncat (out
, p
, dot
- p
);
454 /* For Unix syntax, Append a slash if necessary */
456 if (out
[size
] != ':' && out
[size
] != '/' && out
[size
] != '\\')
458 if (out
[size
] != '/')
465 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
466 Sfile_name_as_directory
, 1, 1, 0,
467 "Return a string representing file FILENAME interpreted as a directory.\n\
468 This operation exists because a directory is also a file, but its name as\n\
469 a directory is different from its name as a file.\n\
470 The result can be used as the value of `default-directory'\n\
471 or passed as second argument to `expand-file-name'.\n\
472 For a Unix-syntax file name, just appends a slash.\n\
473 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
480 CHECK_STRING (file
, 0);
484 /* If the file name has special constructs in it,
485 call the corresponding file handler. */
486 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
488 return call2 (handler
, Qfile_name_as_directory
, file
);
490 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
491 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
495 * Convert from directory name to filename.
497 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
498 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
499 * On UNIX, it's simple: just make sure there is a terminating /
501 * Value is nonzero if the string output is different from the input.
504 directory_file_name (src
, dst
)
512 struct FAB fab
= cc$rms_fab
;
513 struct NAM nam
= cc$rms_nam
;
514 char esa
[NAM$C_MAXRSS
];
519 if (! index (src
, '/')
520 && (src
[slen
- 1] == ']'
521 || src
[slen
- 1] == ':'
522 || src
[slen
- 1] == '>'))
524 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
526 fab
.fab$b_fns
= slen
;
527 fab
.fab$l_nam
= &nam
;
528 fab
.fab$l_fop
= FAB$M_NAM
;
531 nam
.nam$b_ess
= sizeof esa
;
532 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
534 /* We call SYS$PARSE to handle such things as [--] for us. */
535 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
537 slen
= nam
.nam$b_esl
;
538 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
543 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
545 /* what about when we have logical_name:???? */
546 if (src
[slen
- 1] == ':')
547 { /* Xlate logical name and see what we get */
548 ptr
= strcpy (dst
, src
); /* upper case for getenv */
551 if ('a' <= *ptr
&& *ptr
<= 'z')
555 dst
[slen
- 1] = 0; /* remove colon */
556 if (!(src
= egetenv (dst
)))
558 /* should we jump to the beginning of this procedure?
559 Good points: allows us to use logical names that xlate
561 Bad points: can be a problem if we just translated to a device
563 For now, I'll punt and always expect VMS names, and hope for
566 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
567 { /* no recursion here! */
573 { /* not a directory spec */
578 bracket
= src
[slen
- 1];
580 /* If bracket is ']' or '>', bracket - 2 is the corresponding
582 ptr
= index (src
, bracket
- 2);
584 { /* no opening bracket */
588 if (!(rptr
= rindex (src
, '.')))
591 strncpy (dst
, src
, slen
);
595 dst
[slen
++] = bracket
;
600 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
601 then translate the device and recurse. */
602 if (dst
[slen
- 1] == ':'
603 && dst
[slen
- 2] != ':' /* skip decnet nodes */
604 && strcmp(src
+ slen
, "[000000]") == 0)
606 dst
[slen
- 1] = '\0';
607 if ((ptr
= egetenv (dst
))
608 && (rlen
= strlen (ptr
) - 1) > 0
609 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
610 && ptr
[rlen
- 1] == '.')
612 char * buf
= (char *) alloca (strlen (ptr
) + 1);
616 return directory_file_name (buf
, dst
);
621 strcat (dst
, "[000000]");
625 rlen
= strlen (rptr
) - 1;
626 strncat (dst
, rptr
, rlen
);
627 dst
[slen
+ rlen
] = '\0';
628 strcat (dst
, ".DIR.1");
632 /* Process as Unix format: just remove any final slash.
633 But leave "/" unchanged; do not change it to "". */
637 && (dst
[slen
- 1] == '/' || dst
[slen
- 1] == '/')
638 && dst
[slen
- 2] != ':'
640 && dst
[slen
- 1] == '/'
647 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
649 "Returns the file name of the directory named DIR.\n\
650 This is the name of the file that holds the data for the directory DIR.\n\
651 This operation exists because a directory is also a file, but its name as\n\
652 a directory is different from its name as a file.\n\
653 In Unix-syntax, this function just removes the final slash.\n\
654 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
655 it returns a file name such as \"[X]Y.DIR.1\".")
657 Lisp_Object directory
;
662 CHECK_STRING (directory
, 0);
664 if (NILP (directory
))
667 /* If the file name has special constructs in it,
668 call the corresponding file handler. */
669 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
671 return call2 (handler
, Qdirectory_file_name
, directory
);
674 /* 20 extra chars is insufficient for VMS, since we might perform a
675 logical name translation. an equivalence string can be up to 255
676 chars long, so grab that much extra space... - sss */
677 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
679 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
681 directory_file_name (XSTRING (directory
)->data
, buf
);
682 return build_string (buf
);
685 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
686 "Generate temporary file name (string) starting with PREFIX (a string).\n\
687 The Emacs process number forms part of the result,\n\
688 so there is no danger of generating a name being used by another process.")
693 val
= concat2 (prefix
, build_string ("XXXXXX"));
694 mktemp (XSTRING (val
)->data
);
698 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
699 "Convert FILENAME to absolute, and canonicalize it.\n\
700 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
701 (does not start with slash); if DEFAULT is nil or missing,\n\
702 the current buffer's value of default-directory is used.\n\
703 Path components that are `.' are removed, and \n\
704 path components followed by `..' are removed, along with the `..' itself;\n\
705 note that these simplifications are done without checking the resulting\n\
706 paths in the file system.\n\
707 An initial `~/' expands to your home directory.\n\
708 An initial `~USER/' expands to USER's home directory.\n\
709 See also the function `substitute-in-file-name'.")
711 Lisp_Object name
, defalt
;
715 register unsigned char *newdir
, *p
, *o
;
717 unsigned char *target
;
720 unsigned char * colon
= 0;
721 unsigned char * close
= 0;
722 unsigned char * slash
= 0;
723 unsigned char * brack
= 0;
724 int lbrack
= 0, rbrack
= 0;
727 #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */
730 unsigned char *tmp
, *defdir
;
734 CHECK_STRING (name
, 0);
736 /* If the file name has special constructs in it,
737 call the corresponding file handler. */
738 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
740 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
742 /* Use the buffer's default-directory if DEFALT is omitted. */
744 defalt
= current_buffer
->directory
;
745 CHECK_STRING (defalt
, 1);
747 /* Make sure DEFALT is properly expanded.
748 It would be better to do this down below where we actually use
749 defalt. Unfortunately, calling Fexpand_file_name recursively
750 could invoke GC, and the strings might be relocated. This would
751 be annoying because we have pointers into strings lying around
752 that would need adjusting, and people would add new pointers to
753 the code and forget to adjust them, resulting in intermittent bugs.
754 Putting this call here avoids all that crud.
756 The EQ test avoids infinite recursion. */
757 if (! NILP (defalt
) && !EQ (defalt
, name
)
758 /* This saves time in a common case. */
759 && XSTRING (defalt
)->data
[0] != '/')
764 defalt
= Fexpand_file_name (defalt
, Qnil
);
769 /* Filenames on VMS are always upper case. */
770 name
= Fupcase (name
);
772 #ifdef FILE_SYSTEM_CASE
773 name
= FILE_SYSTEM_CASE (name
);
776 nm
= XSTRING (name
)->data
;
779 /* First map all backslashes to slashes. */
780 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
782 /* Now strip drive name. */
784 unsigned char *colon
= rindex (nm
, ':');
790 drive
= tolower (colon
[-1]) - 'a';
794 defdir
= alloca (MAXPATHLEN
+ 1);
795 relpath
= getdefdir (drive
+ 1, defdir
);
801 /* If nm is absolute, flush ...// and detect /./ and /../.
802 If no /./ or /../ we can return right away. */
810 /* If it turns out that the filename we want to return is just a
811 suffix of FILENAME, we don't need to go through and edit
812 things; we just need to construct a new string using data
813 starting at the middle of FILENAME. If we set lose to a
814 non-zero value, that means we've discovered that we can't do
821 /* Since we know the path is absolute, we can assume that each
822 element starts with a "/". */
824 /* "//" anywhere isn't necessarily hairy; we just start afresh
825 with the second slash. */
826 if (p
[0] == '/' && p
[1] == '/'
828 /* // at start of filename is meaningful on Apollo system */
834 /* "~" is hairy as the start of any path element. */
835 if (p
[0] == '/' && p
[1] == '~')
836 nm
= p
+ 1, lose
= 1;
838 /* "." and ".." are hairy. */
843 || (p
[2] == '.' && (p
[3] == '/'
850 /* if dev:[dir]/, move nm to / */
851 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
852 nm
= (brack
? brack
+ 1 : colon
+ 1);
861 /* VMS pre V4.4,convert '-'s in filenames. */
862 if (lbrack
== rbrack
)
864 if (dots
< 2) /* this is to allow negative version numbers */
869 if (lbrack
> rbrack
&&
870 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
871 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
877 /* count open brackets, reset close bracket pointer */
878 if (p
[0] == '[' || p
[0] == '<')
880 /* count close brackets, set close bracket pointer */
881 if (p
[0] == ']' || p
[0] == '>')
883 /* detect ][ or >< */
884 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
886 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
887 nm
= p
+ 1, lose
= 1;
888 if (p
[0] == ':' && (colon
|| slash
))
889 /* if dev1:[dir]dev2:, move nm to dev2: */
895 /* if /pathname/dev:, move nm to dev: */
898 /* if node::dev:, move colon following dev */
899 else if (colon
&& colon
[-1] == ':')
901 /* if dev1:dev2:, move nm to dev2: */
902 else if (colon
&& colon
[-1] != ':')
907 if (p
[0] == ':' && !colon
)
913 if (lbrack
== rbrack
)
916 else if (p
[0] == '.')
925 return build_string (sys_translate_unix (nm
));
928 if (nm
== XSTRING (name
)->data
)
930 return build_string (nm
);
935 /* Now determine directory to start with and put it in newdir */
939 if (nm
[0] == '~') /* prefix ~ */
945 || nm
[1] == 0) /* ~ by itself */
947 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
948 newdir
= (unsigned char *) "";
950 dostounix_filename (newdir
);
954 nm
++; /* Don't leave the slash in nm. */
957 else /* ~user/filename */
959 for (p
= nm
; *p
&& (*p
!= '/'
964 o
= (unsigned char *) alloca (p
- nm
+ 1);
965 bcopy ((char *) nm
, o
, p
- nm
);
968 pw
= (struct passwd
*) getpwnam (o
+ 1);
971 newdir
= (unsigned char *) pw
-> pw_dir
;
973 nm
= p
+ 1; /* skip the terminator */
979 /* If we don't find a user of that name, leave the name
980 unchanged; don't move nm forward to p. */
993 newdir
= XSTRING (defalt
)->data
;
997 if (newdir
== 0 && relpath
)
1002 /* Get rid of any slash at the end of newdir. */
1003 int length
= strlen (newdir
);
1004 /* Adding `length > 1 &&' makes ~ expand into / when homedir
1005 is the root dir. People disagree about whether that is right.
1006 Anyway, we can't take the risk of this change now. */
1008 if (newdir
[1] != ':' && length
> 1)
1010 if (newdir
[length
- 1] == '/')
1012 unsigned char *temp
= (unsigned char *) alloca (length
);
1013 bcopy (newdir
, temp
, length
- 1);
1014 temp
[length
- 1] = 0;
1022 /* Now concatenate the directory and name to new space in the stack frame */
1023 tlen
+= strlen (nm
) + 1;
1025 /* Add reserved space for drive name. */
1026 target
= (unsigned char *) alloca (tlen
+ 2) + 2;
1028 target
= (unsigned char *) alloca (tlen
);
1035 if (nm
[0] == 0 || nm
[0] == '/')
1036 strcpy (target
, newdir
);
1039 file_name_as_directory (target
, newdir
);
1042 strcat (target
, nm
);
1044 if (index (target
, '/'))
1045 strcpy (target
, sys_translate_unix (target
));
1048 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1056 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1062 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1063 /* brackets are offset from each other by 2 */
1066 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1067 /* convert [foo][bar] to [bar] */
1068 while (o
[-1] != '[' && o
[-1] != '<')
1070 else if (*p
== '-' && *o
!= '.')
1073 else if (p
[0] == '-' && o
[-1] == '.' &&
1074 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1075 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1079 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1080 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1082 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1084 /* else [foo.-] ==> [-] */
1090 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1091 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1101 else if (!strncmp (p
, "//", 2)
1103 /* // at start of filename is meaningful in Apollo system */
1111 else if (p
[0] == '/'
1116 /* If "/." is the entire filename, keep the "/". Otherwise,
1117 just delete the whole "/.". */
1118 if (o
== target
&& p
[2] == '\0')
1122 else if (!strncmp (p
, "/..", 3)
1123 /* `/../' is the "superroot" on certain file systems. */
1125 && (p
[3] == '/' || p
[3] == 0))
1127 while (o
!= target
&& *--o
!= '/')
1130 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1134 if (o
== target
&& *o
== '/')
1142 #endif /* not VMS */
1146 /* at last, set drive name. */
1147 if (target
[1] != ':')
1150 target
[0] = (drive
< 0 ? getdisk () : drive
) + 'a';
1155 return make_string (target
, o
- target
);
1158 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
1159 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
1160 "Convert FILENAME to absolute, and canonicalize it.\n\
1161 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1162 (does not start with slash); if DEFAULT is nil or missing,\n\
1163 the current buffer's value of default-directory is used.\n\
1164 Filenames containing `.' or `..' as components are simplified;\n\
1165 initial `~/' expands to your home directory.\n\
1166 See also the function `substitute-in-file-name'.")
1168 Lisp_Object name, defalt;
1172 register unsigned char *newdir, *p, *o;
1174 unsigned char *target;
1178 unsigned char * colon = 0;
1179 unsigned char * close = 0;
1180 unsigned char * slash = 0;
1181 unsigned char * brack = 0;
1182 int lbrack = 0, rbrack = 0;
1186 CHECK_STRING (name
, 0);
1189 /* Filenames on VMS are always upper case. */
1190 name
= Fupcase (name
);
1193 nm
= XSTRING (name
)->data
;
1195 /* If nm is absolute, flush ...// and detect /./ and /../.
1196 If no /./ or /../ we can return right away. */
1208 if (p
[0] == '/' && p
[1] == '/'
1210 /* // at start of filename is meaningful on Apollo system */
1215 if (p
[0] == '/' && p
[1] == '~')
1216 nm
= p
+ 1, lose
= 1;
1217 if (p
[0] == '/' && p
[1] == '.'
1218 && (p
[2] == '/' || p
[2] == 0
1219 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1225 /* if dev:[dir]/, move nm to / */
1226 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1227 nm
= (brack
? brack
+ 1 : colon
+ 1);
1228 lbrack
= rbrack
= 0;
1236 /* VMS pre V4.4,convert '-'s in filenames. */
1237 if (lbrack
== rbrack
)
1239 if (dots
< 2) /* this is to allow negative version numbers */
1244 if (lbrack
> rbrack
&&
1245 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1246 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1252 /* count open brackets, reset close bracket pointer */
1253 if (p
[0] == '[' || p
[0] == '<')
1254 lbrack
++, brack
= 0;
1255 /* count close brackets, set close bracket pointer */
1256 if (p
[0] == ']' || p
[0] == '>')
1257 rbrack
++, brack
= p
;
1258 /* detect ][ or >< */
1259 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1261 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1262 nm
= p
+ 1, lose
= 1;
1263 if (p
[0] == ':' && (colon
|| slash
))
1264 /* if dev1:[dir]dev2:, move nm to dev2: */
1270 /* if /pathname/dev:, move nm to dev: */
1273 /* if node::dev:, move colon following dev */
1274 else if (colon
&& colon
[-1] == ':')
1276 /* if dev1:dev2:, move nm to dev2: */
1277 else if (colon
&& colon
[-1] != ':')
1282 if (p
[0] == ':' && !colon
)
1288 if (lbrack
== rbrack
)
1291 else if (p
[0] == '.')
1299 if (index (nm
, '/'))
1300 return build_string (sys_translate_unix (nm
));
1302 if (nm
== XSTRING (name
)->data
)
1304 return build_string (nm
);
1308 /* Now determine directory to start with and put it in NEWDIR */
1312 if (nm
[0] == '~') /* prefix ~ */
1317 || nm
[1] == 0)/* ~/filename */
1319 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1320 newdir
= (unsigned char *) "";
1323 nm
++; /* Don't leave the slash in nm. */
1326 else /* ~user/filename */
1328 /* Get past ~ to user */
1329 unsigned char *user
= nm
+ 1;
1330 /* Find end of name. */
1331 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1332 int len
= ptr
? ptr
- user
: strlen (user
);
1334 unsigned char *ptr1
= index (user
, ':');
1335 if (ptr1
!= 0 && ptr1
- user
< len
)
1338 /* Copy the user name into temp storage. */
1339 o
= (unsigned char *) alloca (len
+ 1);
1340 bcopy ((char *) user
, o
, len
);
1343 /* Look up the user name. */
1344 pw
= (struct passwd
*) getpwnam (o
+ 1);
1346 error ("\"%s\" isn't a registered user", o
+ 1);
1348 newdir
= (unsigned char *) pw
->pw_dir
;
1350 /* Discard the user name from NM. */
1357 #endif /* not VMS */
1361 defalt
= current_buffer
->directory
;
1362 CHECK_STRING (defalt
, 1);
1363 newdir
= XSTRING (defalt
)->data
;
1366 /* Now concatenate the directory and name to new space in the stack frame */
1368 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1369 target
= (unsigned char *) alloca (tlen
);
1375 if (nm
[0] == 0 || nm
[0] == '/')
1376 strcpy (target
, newdir
);
1379 file_name_as_directory (target
, newdir
);
1382 strcat (target
, nm
);
1384 if (index (target
, '/'))
1385 strcpy (target
, sys_translate_unix (target
));
1388 /* Now canonicalize by removing /. and /foo/.. if they appear */
1396 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1402 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1403 /* brackets are offset from each other by 2 */
1406 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1407 /* convert [foo][bar] to [bar] */
1408 while (o
[-1] != '[' && o
[-1] != '<')
1410 else if (*p
== '-' && *o
!= '.')
1413 else if (p
[0] == '-' && o
[-1] == '.' &&
1414 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1415 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1419 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1420 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1422 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1424 /* else [foo.-] ==> [-] */
1430 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1431 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1441 else if (!strncmp (p
, "//", 2)
1443 /* // at start of filename is meaningful in Apollo system */
1451 else if (p
[0] == '/' && p
[1] == '.' &&
1452 (p
[2] == '/' || p
[2] == 0))
1454 else if (!strncmp (p
, "/..", 3)
1455 /* `/../' is the "superroot" on certain file systems. */
1457 && (p
[3] == '/' || p
[3] == 0))
1459 while (o
!= target
&& *--o
!= '/')
1462 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1466 if (o
== target
&& *o
== '/')
1474 #endif /* not VMS */
1477 return make_string (target
, o
- target
);
1481 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1482 Ssubstitute_in_file_name
, 1, 1, 0,
1483 "Substitute environment variables referred to in FILENAME.\n\
1484 `$FOO' where FOO is an environment variable name means to substitute\n\
1485 the value of that variable. The variable name should be terminated\n\
1486 with a character not a letter, digit or underscore; otherwise, enclose\n\
1487 the entire variable name in braces.\n\
1488 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1489 On VMS, `$' substitution is not done; this function does little and only\n\
1490 duplicates what `expand-file-name' does.")
1496 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1497 unsigned char *target
;
1499 int substituted
= 0;
1502 CHECK_STRING (string
, 0);
1504 nm
= XSTRING (string
)->data
;
1506 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
1507 substituted
= !strcmp (nm
, XSTRING (string
)->data
);
1509 endp
= nm
+ XSTRING (string
)->size
;
1511 /* If /~ or // appears, discard everything through first slash. */
1513 for (p
= nm
; p
!= endp
; p
++)
1517 /* // at start of file name is meaningful in Apollo system */
1518 (p
[0] == '/' && p
- 1 != nm
)
1519 #else /* not APOLLO */
1521 #endif /* not APOLLO */
1525 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1536 if (p
[0] && p
[1] == ':')
1545 return build_string (nm
);
1548 /* See if any variables are substituted into the string
1549 and find the total length of their values in `total' */
1551 for (p
= nm
; p
!= endp
;)
1561 /* "$$" means a single "$" */
1570 while (p
!= endp
&& *p
!= '}') p
++;
1571 if (*p
!= '}') goto missingclose
;
1577 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1581 /* Copy out the variable name */
1582 target
= (unsigned char *) alloca (s
- o
+ 1);
1583 strncpy (target
, o
, s
- o
);
1586 strupr (target
); /* $home == $HOME etc. */
1589 /* Get variable value */
1590 o
= (unsigned char *) egetenv (target
);
1591 if (!o
) goto badvar
;
1592 total
+= strlen (o
);
1599 /* If substitution required, recopy the string and do it */
1600 /* Make space in stack frame for the new copy */
1601 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1604 /* Copy the rest of the name through, replacing $ constructs with values */
1621 while (p
!= endp
&& *p
!= '}') p
++;
1622 if (*p
!= '}') goto missingclose
;
1628 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1632 /* Copy out the variable name */
1633 target
= (unsigned char *) alloca (s
- o
+ 1);
1634 strncpy (target
, o
, s
- o
);
1637 strupr (target
); /* $home == $HOME etc. */
1640 /* Get variable value */
1641 o
= (unsigned char *) egetenv (target
);
1651 /* If /~ or // appears, discard everything through first slash. */
1653 for (p
= xnm
; p
!= x
; p
++)
1656 /* // at start of file name is meaningful in Apollo system */
1657 (p
[0] == '/' && p
- 1 != xnm
)
1658 #else /* not APOLLO */
1660 #endif /* not APOLLO */
1662 && p
!= nm
&& p
[-1] == '/')
1665 else if (p
[0] && p
[1] == ':')
1669 return make_string (xnm
, x
- xnm
);
1672 error ("Bad format environment-variable substitution");
1674 error ("Missing \"}\" in environment-variable substitution");
1676 error ("Substituting nonexistent environment variable \"%s\"", target
);
1679 #endif /* not VMS */
1682 /* A slightly faster and more convenient way to get
1683 (directory-file-name (expand-file-name FOO)). */
1686 expand_and_dir_to_file (filename
, defdir
)
1687 Lisp_Object filename
, defdir
;
1689 register Lisp_Object abspath
;
1691 abspath
= Fexpand_file_name (filename
, defdir
);
1694 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1695 if (c
== ':' || c
== ']' || c
== '>')
1696 abspath
= Fdirectory_file_name (abspath
);
1699 /* Remove final slash, if any (unless path is root).
1700 stat behaves differently depending! */
1701 if (XSTRING (abspath
)->size
> 1
1702 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1703 /* We cannot take shortcuts; they might be wrong for magic file names. */
1704 abspath
= Fdirectory_file_name (abspath
);
1709 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1710 Lisp_Object absname
;
1711 unsigned char *querystring
;
1714 register Lisp_Object tem
;
1715 struct stat statbuf
;
1716 struct gcpro gcpro1
;
1718 /* stat is a good way to tell whether the file exists,
1719 regardless of what access permissions it has. */
1720 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1723 Fsignal (Qfile_already_exists
,
1724 Fcons (build_string ("File already exists"),
1725 Fcons (absname
, Qnil
)));
1727 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1728 XSTRING (absname
)->data
, querystring
));
1731 Fsignal (Qfile_already_exists
,
1732 Fcons (build_string ("File already exists"),
1733 Fcons (absname
, Qnil
)));
1738 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1739 "fCopy file: \nFCopy %s to file: \np\nP",
1740 "Copy FILE to NEWNAME. Both args must be strings.\n\
1741 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1742 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1743 A number as third arg means request confirmation if NEWNAME already exists.\n\
1744 This is what happens in interactive use with M-x.\n\
1745 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1746 last-modified time as the old one. (This works on only some systems.)\n\
1747 A prefix arg makes KEEP-TIME non-nil.")
1748 (filename
, newname
, ok_if_already_exists
, keep_date
)
1749 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1752 char buf
[16 * 1024];
1754 Lisp_Object handler
;
1755 struct gcpro gcpro1
, gcpro2
;
1756 int count
= specpdl_ptr
- specpdl
;
1757 int input_file_statable_p
;
1759 GCPRO2 (filename
, newname
);
1760 CHECK_STRING (filename
, 0);
1761 CHECK_STRING (newname
, 1);
1762 filename
= Fexpand_file_name (filename
, Qnil
);
1763 newname
= Fexpand_file_name (newname
, Qnil
);
1765 /* If the input file name has special constructs in it,
1766 call the corresponding file handler. */
1767 handler
= Ffind_file_name_handler (filename
, Qcopy_file
);
1768 /* Likewise for output file name. */
1770 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1771 if (!NILP (handler
))
1772 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, filename
, newname
,
1773 ok_if_already_exists
, keep_date
));
1775 if (NILP (ok_if_already_exists
)
1776 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1777 barf_or_query_if_file_exists (newname
, "copy to it",
1778 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1780 ifd
= open (XSTRING (filename
)->data
, O_RDONLY
);
1782 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1784 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1786 /* We can only copy regular files and symbolic links. Other files are not
1788 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1790 #if defined (S_ISREG) && defined (S_ISLNK)
1791 if (input_file_statable_p
)
1793 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1795 #if defined (EISDIR)
1796 /* Get a better looking error message. */
1799 report_file_error ("Non-regular file", Fcons (filename
, Qnil
));
1802 #endif /* S_ISREG && S_ISLNK */
1805 /* Create the copy file with the same record format as the input file */
1806 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1809 /* System's default file type was set to binary by _fmode in emacs.c. */
1810 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1811 #else /* not MSDOS */
1812 ofd
= creat (XSTRING (newname
)->data
, 0666);
1813 #endif /* not MSDOS */
1816 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1818 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1822 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1823 if (write (ofd
, buf
, n
) != n
)
1824 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1827 /* Closing the output clobbers the file times on some systems. */
1828 if (close (ofd
) < 0)
1829 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1831 if (input_file_statable_p
)
1833 if (!NILP (keep_date
))
1835 EMACS_TIME atime
, mtime
;
1836 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1837 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1838 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1841 if (!egetenv ("USE_DOMAIN_ACLS"))
1843 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1848 /* Discard the unwind protects. */
1849 specpdl_ptr
= specpdl
+ count
;
1855 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1856 Smake_directory_internal
, 1, 1, 0,
1857 "Create a directory. One argument, a file name string.")
1859 Lisp_Object dirname
;
1862 Lisp_Object handler
;
1864 CHECK_STRING (dirname
, 0);
1865 dirname
= Fexpand_file_name (dirname
, Qnil
);
1867 handler
= Ffind_file_name_handler (dirname
, Qmake_directory_internal
);
1868 if (!NILP (handler
))
1869 return call2 (handler
, Qmake_directory_internal
, dirname
);
1871 dir
= XSTRING (dirname
)->data
;
1873 if (mkdir (dir
, 0777) != 0)
1874 report_file_error ("Creating directory", Flist (1, &dirname
));
1879 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1880 "Delete a directory. One argument, a file name or directory name string.")
1882 Lisp_Object dirname
;
1885 Lisp_Object handler
;
1887 CHECK_STRING (dirname
, 0);
1888 dirname
= Fdirectory_file_name (Fexpand_file_name (dirname
, Qnil
));
1889 dir
= XSTRING (dirname
)->data
;
1891 handler
= Ffind_file_name_handler (dirname
, Qdelete_directory
);
1892 if (!NILP (handler
))
1893 return call2 (handler
, Qdelete_directory
, dirname
);
1895 if (rmdir (dir
) != 0)
1896 report_file_error ("Removing directory", Flist (1, &dirname
));
1901 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1902 "Delete specified file. One argument, a file name string.\n\
1903 If file has multiple names, it continues to exist with the other names.")
1905 Lisp_Object filename
;
1907 int count
= specpdl_ptr
- specpdl
;
1908 Lisp_Object handler
;
1909 CHECK_STRING (filename
, 0);
1910 filename
= Fexpand_file_name (filename
, Qnil
);
1912 specbind (Qcompletion_ignored_extensions
, Qnil
);
1913 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
1914 if (!NILP (handler
))
1915 return unbind_to (count
, call2 (handler
, Qdelete_file
, filename
));
1917 if (0 > unlink (XSTRING (filename
)->data
))
1918 report_file_error ("Removing old name", Flist (1, &filename
));
1919 return unbind_to (count
, Qnil
);
1922 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1923 "fRename file: \nFRename %s to file: \np",
1924 "Rename FILE as NEWNAME. Both args strings.\n\
1925 If file has names other than FILE, it continues to have those names.\n\
1926 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1927 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1928 A number as third arg means request confirmation if NEWNAME already exists.\n\
1929 This is what happens in interactive use with M-x.")
1930 (filename
, newname
, ok_if_already_exists
)
1931 Lisp_Object filename
, newname
, ok_if_already_exists
;
1934 Lisp_Object args
[2];
1936 Lisp_Object handler
;
1937 struct gcpro gcpro1
, gcpro2
;
1939 GCPRO2 (filename
, newname
);
1940 CHECK_STRING (filename
, 0);
1941 CHECK_STRING (newname
, 1);
1942 filename
= Fexpand_file_name (filename
, Qnil
);
1943 newname
= Fexpand_file_name (newname
, Qnil
);
1945 /* If the file name has special constructs in it,
1946 call the corresponding file handler. */
1947 handler
= Ffind_file_name_handler (filename
, Qrename_file
);
1949 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
1950 if (!NILP (handler
))
1951 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
1952 filename
, newname
, ok_if_already_exists
));
1954 if (NILP (ok_if_already_exists
)
1955 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1956 barf_or_query_if_file_exists (newname
, "rename to it",
1957 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1959 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1961 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1962 || 0 > unlink (XSTRING (filename
)->data
))
1967 Fcopy_file (filename
, newname
,
1968 /* We have already prompted if it was an integer,
1969 so don't have copy-file prompt again. */
1970 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
1971 Fdelete_file (filename
);
1978 report_file_error ("Renaming", Flist (2, args
));
1981 report_file_error ("Renaming", Flist (2, &filename
));
1988 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1989 "fAdd name to file: \nFName to add to %s: \np",
1990 "Give FILE additional name NEWNAME. Both args strings.\n\
1991 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1992 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1993 A number as third arg means request confirmation if NEWNAME already exists.\n\
1994 This is what happens in interactive use with M-x.")
1995 (filename
, newname
, ok_if_already_exists
)
1996 Lisp_Object filename
, newname
, ok_if_already_exists
;
1999 Lisp_Object args
[2];
2001 Lisp_Object handler
;
2002 struct gcpro gcpro1
, gcpro2
;
2004 GCPRO2 (filename
, newname
);
2005 CHECK_STRING (filename
, 0);
2006 CHECK_STRING (newname
, 1);
2007 filename
= Fexpand_file_name (filename
, Qnil
);
2008 newname
= Fexpand_file_name (newname
, Qnil
);
2010 /* If the file name has special constructs in it,
2011 call the corresponding file handler. */
2012 handler
= Ffind_file_name_handler (filename
, Qadd_name_to_file
);
2013 if (!NILP (handler
))
2014 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
2015 newname
, ok_if_already_exists
));
2017 if (NILP (ok_if_already_exists
)
2018 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
2019 barf_or_query_if_file_exists (newname
, "make it a new name",
2020 XTYPE (ok_if_already_exists
) == Lisp_Int
);
2021 unlink (XSTRING (newname
)->data
);
2022 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2027 report_file_error ("Adding new name", Flist (2, args
));
2029 report_file_error ("Adding new name", Flist (2, &filename
));
2038 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2039 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2040 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2041 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2042 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2043 A number as third arg means request confirmation if LINKNAME already exists.\n\
2044 This happens for interactive use with M-x.")
2045 (filename
, linkname
, ok_if_already_exists
)
2046 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2049 Lisp_Object args
[2];
2051 Lisp_Object handler
;
2052 struct gcpro gcpro1
, gcpro2
;
2054 GCPRO2 (filename
, linkname
);
2055 CHECK_STRING (filename
, 0);
2056 CHECK_STRING (linkname
, 1);
2057 /* If the link target has a ~, we must expand it to get
2058 a truly valid file name. Otherwise, do not expand;
2059 we want to permit links to relative file names. */
2060 if (XSTRING (filename
)->data
[0] == '~')
2061 filename
= Fexpand_file_name (filename
, Qnil
);
2062 linkname
= Fexpand_file_name (linkname
, Qnil
);
2064 /* If the file name has special constructs in it,
2065 call the corresponding file handler. */
2066 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2067 if (!NILP (handler
))
2068 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2069 linkname
, ok_if_already_exists
));
2071 if (NILP (ok_if_already_exists
)
2072 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
2073 barf_or_query_if_file_exists (linkname
, "make it a link",
2074 XTYPE (ok_if_already_exists
) == Lisp_Int
);
2075 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2077 /* If we didn't complain already, silently delete existing file. */
2078 if (errno
== EEXIST
)
2080 unlink (XSTRING (linkname
)->data
);
2081 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2091 report_file_error ("Making symbolic link", Flist (2, args
));
2093 report_file_error ("Making symbolic link", Flist (2, &filename
));
2099 #endif /* S_IFLNK */
2103 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2104 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2105 "Define the job-wide logical name NAME to have the value STRING.\n\
2106 If STRING is nil or a null string, the logical name NAME is deleted.")
2108 Lisp_Object varname
;
2111 CHECK_STRING (varname
, 0);
2113 delete_logical_name (XSTRING (varname
)->data
);
2116 CHECK_STRING (string
, 1);
2118 if (XSTRING (string
)->size
== 0)
2119 delete_logical_name (XSTRING (varname
)->data
);
2121 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2130 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2131 "Open a network connection to PATH using LOGIN as the login string.")
2133 Lisp_Object path
, login
;
2137 CHECK_STRING (path
, 0);
2138 CHECK_STRING (login
, 0);
2140 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2142 if (netresult
== -1)
2147 #endif /* HPUX_NET */
2149 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2151 "Return t if file FILENAME specifies an absolute path name.\n\
2152 On Unix, this is a name starting with a `/' or a `~'.")
2154 Lisp_Object filename
;
2158 CHECK_STRING (filename
, 0);
2159 ptr
= XSTRING (filename
)->data
;
2160 if (*ptr
== '/' || *ptr
== '~'
2162 /* ??? This criterion is probably wrong for '<'. */
2163 || index (ptr
, ':') || index (ptr
, '<')
2164 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2168 || (*ptr
!= 0 && ptr
[1] == ':' && (ptr
[2] == '/' || ptr
[2] == '\\'))
2176 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2177 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2178 See also `file-readable-p' and `file-attributes'.")
2180 Lisp_Object filename
;
2182 Lisp_Object abspath
;
2183 Lisp_Object handler
;
2184 struct stat statbuf
;
2186 CHECK_STRING (filename
, 0);
2187 abspath
= Fexpand_file_name (filename
, Qnil
);
2189 /* If the file name has special constructs in it,
2190 call the corresponding file handler. */
2191 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2192 if (!NILP (handler
))
2193 return call2 (handler
, Qfile_exists_p
, abspath
);
2195 return (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2198 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2199 "Return t if FILENAME can be executed by you.\n\
2200 For a directory, this means you can access files in that directory.")
2202 Lisp_Object filename
;
2205 Lisp_Object abspath
;
2206 Lisp_Object handler
;
2208 CHECK_STRING (filename
, 0);
2209 abspath
= Fexpand_file_name (filename
, Qnil
);
2211 /* If the file name has special constructs in it,
2212 call the corresponding file handler. */
2213 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2214 if (!NILP (handler
))
2215 return call2 (handler
, Qfile_executable_p
, abspath
);
2217 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
2220 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2221 "Return t if file FILENAME exists and you can read it.\n\
2222 See also `file-exists-p' and `file-attributes'.")
2224 Lisp_Object filename
;
2226 Lisp_Object abspath
;
2227 Lisp_Object handler
;
2230 CHECK_STRING (filename
, 0);
2231 abspath
= Fexpand_file_name (filename
, Qnil
);
2233 /* If the file name has special constructs in it,
2234 call the corresponding file handler. */
2235 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2236 if (!NILP (handler
))
2237 return call2 (handler
, Qfile_readable_p
, abspath
);
2239 desc
= open (XSTRING (abspath
)->data
, O_RDONLY
);
2246 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2247 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2248 The value is the name of the file to which it is linked.\n\
2249 Otherwise returns nil.")
2251 Lisp_Object filename
;
2258 Lisp_Object handler
;
2260 CHECK_STRING (filename
, 0);
2261 filename
= Fexpand_file_name (filename
, Qnil
);
2263 /* If the file name has special constructs in it,
2264 call the corresponding file handler. */
2265 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2266 if (!NILP (handler
))
2267 return call2 (handler
, Qfile_symlink_p
, filename
);
2272 buf
= (char *) xmalloc (bufsize
);
2273 bzero (buf
, bufsize
);
2274 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2275 if (valsize
< bufsize
) break;
2276 /* Buffer was not long enough */
2285 val
= make_string (buf
, valsize
);
2288 #else /* not S_IFLNK */
2290 #endif /* not S_IFLNK */
2293 #ifdef SOLARIS_BROKEN_ACCESS
2294 /* In Solaris 2.1, the readonly-ness of the filesystem is not
2295 considered by the access system call. This is Sun's bug, but we
2296 still have to make Emacs work. */
2298 #include <sys/statvfs.h>
2304 struct statvfs statvfsb
;
2306 if (statvfs(path
, &statvfsb
))
2307 return 1; /* error from statvfs, be conservative and say not wrtable */
2309 /* Otherwise, fsys is ro if bit is set. */
2310 return statvfsb
.f_flag
& ST_RDONLY
;
2313 /* But on every other os, access has already done the right thing. */
2314 #define ro_fsys(path) 0
2317 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2319 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2320 "Return t if file FILENAME can be written or created by you.")
2322 Lisp_Object filename
;
2324 Lisp_Object abspath
, dir
;
2325 Lisp_Object handler
;
2327 CHECK_STRING (filename
, 0);
2328 abspath
= Fexpand_file_name (filename
, Qnil
);
2330 /* If the file name has special constructs in it,
2331 call the corresponding file handler. */
2332 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2333 if (!NILP (handler
))
2334 return call2 (handler
, Qfile_writable_p
, abspath
);
2336 if (access (XSTRING (abspath
)->data
, 0) >= 0)
2337 return ((access (XSTRING (abspath
)->data
, 2) >= 0
2338 && ! ro_fsys ((char *) XSTRING (abspath
)->data
))
2340 dir
= Ffile_name_directory (abspath
);
2343 dir
= Fdirectory_file_name (dir
);
2347 dir
= Fdirectory_file_name (dir
);
2349 return ((access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2350 && ! ro_fsys ((char *) XSTRING (dir
)->data
))
2354 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2355 "Return t if file FILENAME is the name of a directory as a file.\n\
2356 A directory name spec may be given instead; then the value is t\n\
2357 if the directory so specified exists and really is a directory.")
2359 Lisp_Object filename
;
2361 register Lisp_Object abspath
;
2363 Lisp_Object handler
;
2365 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2367 /* If the file name has special constructs in it,
2368 call the corresponding file handler. */
2369 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2370 if (!NILP (handler
))
2371 return call2 (handler
, Qfile_directory_p
, abspath
);
2373 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2375 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2378 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2379 "Return t if file FILENAME is the name of a directory as a file,\n\
2380 and files in that directory can be opened by you. In order to use a\n\
2381 directory as a buffer's current directory, this predicate must return true.\n\
2382 A directory name spec may be given instead; then the value is t\n\
2383 if the directory so specified exists and really is a readable and\n\
2384 searchable directory.")
2386 Lisp_Object filename
;
2388 Lisp_Object handler
;
2390 struct gcpro gcpro1
;
2392 /* If the file name has special constructs in it,
2393 call the corresponding file handler. */
2394 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2395 if (!NILP (handler
))
2396 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2398 /* It's an unlikely combination, but yes we really do need to gcpro:
2399 Suppose that file-accessible-directory-p has no handler, but
2400 file-directory-p does have a handler; this handler causes a GC which
2401 relocates the string in `filename'; and finally file-directory-p
2402 returns non-nil. Then we would end up passing a garbaged string
2403 to file-executable-p. */
2405 tem
= (NILP (Ffile_directory_p (filename
))
2406 || NILP (Ffile_executable_p (filename
)));
2408 return tem
? Qnil
: Qt
;
2411 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2412 "Return mode bits of FILE, as an integer.")
2414 Lisp_Object filename
;
2416 Lisp_Object abspath
;
2418 Lisp_Object handler
;
2420 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2422 /* If the file name has special constructs in it,
2423 call the corresponding file handler. */
2424 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2425 if (!NILP (handler
))
2426 return call2 (handler
, Qfile_modes
, abspath
);
2428 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2434 if (S_ISREG (st
.st_mode
)
2435 && (len
= XSTRING (abspath
)->size
) >= 5
2436 && (stricmp ((suffix
= XSTRING (abspath
)->data
+ len
-4), ".com") == 0
2437 || stricmp (suffix
, ".exe") == 0
2438 || stricmp (suffix
, ".bat") == 0))
2439 st
.st_mode
|= S_IEXEC
;
2443 return make_number (st
.st_mode
& 07777);
2446 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2447 "Set mode bits of FILE to MODE (an integer).\n\
2448 Only the 12 low bits of MODE are used.")
2450 Lisp_Object filename
, mode
;
2452 Lisp_Object abspath
;
2453 Lisp_Object handler
;
2455 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2456 CHECK_NUMBER (mode
, 1);
2458 /* If the file name has special constructs in it,
2459 call the corresponding file handler. */
2460 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2461 if (!NILP (handler
))
2462 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2465 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2466 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2468 if (!egetenv ("USE_DOMAIN_ACLS"))
2471 struct timeval tvp
[2];
2473 /* chmod on apollo also change the file's modtime; need to save the
2474 modtime and then restore it. */
2475 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2477 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2481 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2482 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2484 /* reset the old accessed and modified times. */
2485 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2487 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2490 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2491 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2498 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2499 "Set the file permission bits for newly created files.\n\
2500 The argument MODE should be an integer; only the low 9 bits are used.\n\
2501 This setting is inherited by subprocesses.")
2505 CHECK_NUMBER (mode
, 0);
2507 umask ((~ XINT (mode
)) & 0777);
2512 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2513 "Return the default file protection for created files.\n\
2514 The value is an integer.")
2520 realmask
= umask (0);
2523 XSET (value
, Lisp_Int
, (~ realmask
) & 0777);
2529 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2530 "Tell Unix to finish all pending disk updates.")
2539 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2540 "Return t if file FILE1 is newer than file FILE2.\n\
2541 If FILE1 does not exist, the answer is nil;\n\
2542 otherwise, if FILE2 does not exist, the answer is t.")
2544 Lisp_Object file1
, file2
;
2546 Lisp_Object abspath1
, abspath2
;
2549 Lisp_Object handler
;
2550 struct gcpro gcpro1
, gcpro2
;
2552 CHECK_STRING (file1
, 0);
2553 CHECK_STRING (file2
, 0);
2556 GCPRO2 (abspath1
, file2
);
2557 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2558 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2561 /* If the file name has special constructs in it,
2562 call the corresponding file handler. */
2563 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2565 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2566 if (!NILP (handler
))
2567 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2569 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2572 mtime1
= st
.st_mtime
;
2574 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2577 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2581 Lisp_Object Qfind_buffer_file_type
;
2584 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2586 "Insert contents of file FILENAME after point.\n\
2587 Returns list of absolute file name and length of data inserted.\n\
2588 If second argument VISIT is non-nil, the buffer's visited filename\n\
2589 and last save file modtime are set, and it is marked unmodified.\n\
2590 If visiting and the file does not exist, visiting is completed\n\
2591 before the error is signaled.\n\n\
2592 The optional third and fourth arguments BEG and END\n\
2593 specify what portion of the file to insert.\n\
2594 If VISIT is non-nil, BEG and END must be nil.\n\
2595 If optional fifth argument REPLACE is non-nil,\n\
2596 it means replace the current buffer contents (in the accessible portion)\n\
2597 with the file contents. This is better than simply deleting and inserting\n\
2598 the whole thing because (1) it preserves some marker positions\n\
2599 and (2) it puts less data in the undo list.")
2600 (filename
, visit
, beg
, end
, replace
)
2601 Lisp_Object filename
, visit
, beg
, end
, replace
;
2605 register int inserted
= 0;
2606 register int how_much
;
2607 int count
= specpdl_ptr
- specpdl
;
2608 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2609 Lisp_Object handler
, val
, insval
;
2616 GCPRO3 (filename
, val
, p
);
2617 if (!NILP (current_buffer
->read_only
))
2618 Fbarf_if_buffer_read_only();
2620 CHECK_STRING (filename
, 0);
2621 filename
= Fexpand_file_name (filename
, Qnil
);
2623 /* If the file name has special constructs in it,
2624 call the corresponding file handler. */
2625 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2626 if (!NILP (handler
))
2628 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2629 visit
, beg
, end
, replace
);
2636 if (stat (XSTRING (filename
)->data
, &st
) < 0)
2638 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
2639 || fstat (fd
, &st
) < 0)
2640 #endif /* not APOLLO */
2642 if (fd
>= 0) close (fd
);
2645 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2652 /* This code will need to be changed in order to work on named
2653 pipes, and it's probably just not worth it. So we should at
2654 least signal an error. */
2655 if (!S_ISREG (st
.st_mode
))
2656 Fsignal (Qfile_error
,
2657 Fcons (build_string ("not a regular file"),
2658 Fcons (filename
, Qnil
)));
2662 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
2665 /* Replacement should preserve point as it preserves markers. */
2666 if (!NILP (replace
))
2667 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2669 record_unwind_protect (close_file_unwind
, make_number (fd
));
2671 /* Supposedly happens on VMS. */
2673 error ("File size is negative");
2675 if (!NILP (beg
) || !NILP (end
))
2677 error ("Attempt to visit less than an entire file");
2680 CHECK_NUMBER (beg
, 0);
2685 CHECK_NUMBER (end
, 0);
2688 XSETINT (end
, st
.st_size
);
2689 if (XINT (end
) != st
.st_size
)
2690 error ("maximum buffer size exceeded");
2693 /* If requested, replace the accessible part of the buffer
2694 with the file contents. Avoid replacing text at the
2695 beginning or end of the buffer that matches the file contents;
2696 that preserves markers pointing to the unchanged parts. */
2698 /* On MSDOS, replace mode doesn't really work, except for binary files,
2699 and it's not worth supporting just for them. */
2700 if (!NILP (replace
))
2704 XFASTINT (end
) = st
.st_size
;
2705 del_range_1 (BEGV
, ZV
, 0);
2708 if (!NILP (replace
))
2710 unsigned char buffer
[1 << 14];
2711 int same_at_start
= BEGV
;
2712 int same_at_end
= ZV
;
2717 /* Count how many chars at the start of the file
2718 match the text at the beginning of the buffer. */
2723 nread
= read (fd
, buffer
, sizeof buffer
);
2725 error ("IO error reading %s: %s",
2726 XSTRING (filename
)->data
, strerror (errno
));
2727 else if (nread
== 0)
2730 while (bufpos
< nread
&& same_at_start
< ZV
2731 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2732 same_at_start
++, bufpos
++;
2733 /* If we found a discrepancy, stop the scan.
2734 Otherwise loop around and scan the next bufferfull. */
2735 if (bufpos
!= nread
)
2739 /* If the file matches the buffer completely,
2740 there's no need to replace anything. */
2741 if (same_at_start
- BEGV
== st
.st_size
)
2745 /* Truncate the buffer to the size of the file. */
2746 del_range_1 (same_at_start
, same_at_end
, 0);
2751 /* Count how many chars at the end of the file
2752 match the text at the end of the buffer. */
2755 int total_read
, nread
, bufpos
, curpos
, trial
;
2757 /* At what file position are we now scanning? */
2758 curpos
= st
.st_size
- (ZV
- same_at_end
);
2759 /* If the entire file matches the buffer tail, stop the scan. */
2762 /* How much can we scan in the next step? */
2763 trial
= min (curpos
, sizeof buffer
);
2764 if (lseek (fd
, curpos
- trial
, 0) < 0)
2765 report_file_error ("Setting file position",
2766 Fcons (filename
, Qnil
));
2769 while (total_read
< trial
)
2771 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2773 error ("IO error reading %s: %s",
2774 XSTRING (filename
)->data
, strerror (errno
));
2775 total_read
+= nread
;
2777 /* Scan this bufferfull from the end, comparing with
2778 the Emacs buffer. */
2779 bufpos
= total_read
;
2780 /* Compare with same_at_start to avoid counting some buffer text
2781 as matching both at the file's beginning and at the end. */
2782 while (bufpos
> 0 && same_at_end
> same_at_start
2783 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2784 same_at_end
--, bufpos
--;
2785 /* If we found a discrepancy, stop the scan.
2786 Otherwise loop around and scan the preceding bufferfull. */
2792 /* Don't try to reuse the same piece of text twice. */
2793 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2795 same_at_end
+= overlap
;
2797 /* Arrange to read only the nonmatching middle part of the file. */
2798 XFASTINT (beg
) = same_at_start
- BEGV
;
2799 XFASTINT (end
) = st
.st_size
- (ZV
- same_at_end
);
2801 del_range_1 (same_at_start
, same_at_end
, 0);
2802 /* Insert from the file at the proper position. */
2803 SET_PT (same_at_start
);
2807 total
= XINT (end
) - XINT (beg
);
2810 register Lisp_Object temp
;
2812 /* Make sure point-max won't overflow after this insertion. */
2813 XSET (temp
, Lisp_Int
, total
);
2814 if (total
!= XINT (temp
))
2815 error ("maximum buffer size exceeded");
2818 if (NILP (visit
) && total
> 0)
2819 prepare_to_modify_buffer (point
, point
);
2822 if (GAP_SIZE
< total
)
2823 make_gap (total
- GAP_SIZE
);
2825 if (XINT (beg
) != 0 || !NILP (replace
))
2827 if (lseek (fd
, XINT (beg
), 0) < 0)
2828 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2832 while (inserted
< total
)
2834 int try = min (total
- inserted
, 64 << 10);
2837 /* Allow quitting out of the actual I/O. */
2840 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2857 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
2858 /* Determine file type from name and remove LFs from CR-LFs if the file
2859 is deemed to be a text file. */
2861 struct gcpro gcpro1
;
2865 current_buffer
->buffer_file_type
2866 = call1 (Qfind_buffer_file_type
, filename
);
2868 if (NILP (current_buffer
->buffer_file_type
))
2871 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
2874 GPT
-= reduced_size
;
2875 GAP_SIZE
+= reduced_size
;
2876 inserted
-= reduced_size
;
2883 record_insert (point
, inserted
);
2885 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2886 offset_intervals (current_buffer
, point
, inserted
);
2892 /* Discard the unwind protect for closing the file. */
2896 error ("IO error reading %s: %s",
2897 XSTRING (filename
)->data
, strerror (errno
));
2904 if (!EQ (current_buffer
->undo_list
, Qt
))
2905 current_buffer
->undo_list
= Qnil
;
2907 stat (XSTRING (filename
)->data
, &st
);
2912 current_buffer
->modtime
= st
.st_mtime
;
2913 current_buffer
->filename
= filename
;
2916 current_buffer
->save_modified
= MODIFF
;
2917 current_buffer
->auto_save_modified
= MODIFF
;
2918 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2919 #ifdef CLASH_DETECTION
2922 if (!NILP (current_buffer
->filename
))
2923 unlock_file (current_buffer
->filename
);
2924 unlock_file (filename
);
2926 #endif /* CLASH_DETECTION */
2927 /* If visiting nonexistent file, return nil. */
2928 if (current_buffer
->modtime
== -1)
2929 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2932 if (inserted
> 0 && NILP (visit
) && total
> 0)
2933 signal_after_change (point
, 0, inserted
);
2937 p
= Vafter_insert_file_functions
;
2940 insval
= call1 (Fcar (p
), make_number (inserted
));
2943 CHECK_NUMBER (insval
, 0);
2944 inserted
= XFASTINT (insval
);
2952 val
= Fcons (filename
,
2953 Fcons (make_number (inserted
),
2956 RETURN_UNGCPRO (unbind_to (count
, val
));
2959 static Lisp_Object
build_annotations ();
2961 /* If build_annotations switched buffers, switch back to BUF.
2962 Kill the temporary buffer that was selected in the meantime. */
2965 build_annotations_unwind (buf
)
2970 if (XBUFFER (buf
) == current_buffer
)
2972 tembuf
= Fcurrent_buffer ();
2974 Fkill_buffer (tembuf
);
2978 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2979 "r\nFWrite region to file: ",
2980 "Write current region into specified file.\n\
2981 When called from a program, takes three arguments:\n\
2982 START, END and FILENAME. START and END are buffer positions.\n\
2983 Optional fourth argument APPEND if non-nil means\n\
2984 append to existing file contents (if any).\n\
2985 Optional fifth argument VISIT if t means\n\
2986 set the last-save-file-modtime of buffer to this file's modtime\n\
2987 and mark buffer not modified.\n\
2988 If VISIT is a string, it is a second file name;\n\
2989 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2990 VISIT is also the file name to lock and unlock for clash detection.\n\
2991 If VISIT is neither t nor nil nor a string,\n\
2992 that means do not print the \"Wrote file\" message.\n\
2993 Kludgy feature: if START is a string, then that string is written\n\
2994 to the file, instead of any buffer contents, and END is ignored.")
2995 (start
, end
, filename
, append
, visit
)
2996 Lisp_Object start
, end
, filename
, append
, visit
;
3004 int count
= specpdl_ptr
- specpdl
;
3007 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3009 Lisp_Object handler
;
3010 Lisp_Object visit_file
;
3011 Lisp_Object annotations
;
3012 int visiting
, quietly
;
3013 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3014 struct buffer
*given_buffer
;
3016 int buffer_file_type
3017 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3020 if (!NILP (start
) && !STRINGP (start
))
3021 validate_region (&start
, &end
);
3023 GCPRO2 (filename
, visit
);
3024 filename
= Fexpand_file_name (filename
, Qnil
);
3025 if (STRINGP (visit
))
3026 visit_file
= Fexpand_file_name (visit
, Qnil
);
3028 visit_file
= filename
;
3031 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3032 quietly
= !NILP (visit
);
3036 GCPRO4 (start
, filename
, annotations
, visit_file
);
3038 /* If the file name has special constructs in it,
3039 call the corresponding file handler. */
3040 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3041 /* If FILENAME has no handler, see if VISIT has one. */
3042 if (NILP (handler
) && XTYPE (visit
) == Lisp_String
)
3043 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3045 if (!NILP (handler
))
3048 val
= call6 (handler
, Qwrite_region
, start
, end
,
3049 filename
, append
, visit
);
3053 current_buffer
->save_modified
= MODIFF
;
3054 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3055 current_buffer
->filename
= visit_file
;
3061 /* Special kludge to simplify auto-saving. */
3064 XFASTINT (start
) = BEG
;
3068 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3069 count1
= specpdl_ptr
- specpdl
;
3071 given_buffer
= current_buffer
;
3072 annotations
= build_annotations (start
, end
);
3073 if (current_buffer
!= given_buffer
)
3079 #ifdef CLASH_DETECTION
3081 lock_file (visit_file
);
3082 #endif /* CLASH_DETECTION */
3084 fn
= XSTRING (filename
)->data
;
3088 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3090 desc
= open (fn
, O_WRONLY
);
3095 if (auto_saving
) /* Overwrite any previous version of autosave file */
3097 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3098 desc
= open (fn
, O_RDWR
);
3100 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3101 ? XSTRING (current_buffer
->filename
)->data
: 0,
3104 else /* Write to temporary name and rename if no errors */
3106 Lisp_Object temp_name
;
3107 temp_name
= Ffile_name_directory (filename
);
3109 if (!NILP (temp_name
))
3111 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3112 build_string ("$$SAVE$$")));
3113 fname
= XSTRING (filename
)->data
;
3114 fn
= XSTRING (temp_name
)->data
;
3115 desc
= creat_copy_attrs (fname
, fn
);
3118 /* If we can't open the temporary file, try creating a new
3119 version of the original file. VMS "creat" creates a
3120 new version rather than truncating an existing file. */
3123 desc
= creat (fn
, 0666);
3124 #if 0 /* This can clobber an existing file and fail to replace it,
3125 if the user runs out of space. */
3128 /* We can't make a new version;
3129 try to truncate and rewrite existing version if any. */
3131 desc
= open (fn
, O_RDWR
);
3137 desc
= creat (fn
, 0666);
3142 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3143 S_IREAD
| S_IWRITE
);
3144 #else /* not MSDOS */
3145 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3146 #endif /* not MSDOS */
3147 #endif /* not VMS */
3153 #ifdef CLASH_DETECTION
3155 if (!auto_saving
) unlock_file (visit_file
);
3157 #endif /* CLASH_DETECTION */
3158 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3161 record_unwind_protect (close_file_unwind
, make_number (desc
));
3164 if (lseek (desc
, 0, 2) < 0)
3166 #ifdef CLASH_DETECTION
3167 if (!auto_saving
) unlock_file (visit_file
);
3168 #endif /* CLASH_DETECTION */
3169 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3174 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3175 * if we do writes that don't end with a carriage return. Furthermore
3176 * it cannot handle writes of more then 16K. The modified
3177 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3178 * this EXCEPT for the last record (iff it doesn't end with a carriage
3179 * return). This implies that if your buffer doesn't end with a carriage
3180 * return, you get one free... tough. However it also means that if
3181 * we make two calls to sys_write (a la the following code) you can
3182 * get one at the gap as well. The easiest way to fix this (honest)
3183 * is to move the gap to the next newline (or the end of the buffer).
3188 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3189 move_gap (find_next_newline (GPT
, 1));
3195 if (STRINGP (start
))
3197 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3198 XSTRING (start
)->size
, 0, &annotations
);
3201 else if (XINT (start
) != XINT (end
))
3204 if (XINT (start
) < GPT
)
3206 register int end1
= XINT (end
);
3208 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3209 min (GPT
, end1
) - tem
, tem
, &annotations
);
3210 nwritten
+= min (GPT
, end1
) - tem
;
3214 if (XINT (end
) > GPT
&& !failure
)
3217 tem
= max (tem
, GPT
);
3218 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3220 nwritten
+= XINT (end
) - tem
;
3226 /* If file was empty, still need to write the annotations */
3227 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3235 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3236 Disk full in NFS may be reported here. */
3237 /* mib says that closing the file will try to write as fast as NFS can do
3238 it, and that means the fsync here is not crucial for autosave files. */
3239 if (!auto_saving
&& fsync (desc
) < 0)
3240 failure
= 1, save_errno
= errno
;
3243 /* Spurious "file has changed on disk" warnings have been
3244 observed on Suns as well.
3245 It seems that `close' can change the modtime, under nfs.
3247 (This has supposedly been fixed in Sunos 4,
3248 but who knows about all the other machines with NFS?) */
3251 /* On VMS and APOLLO, must do the stat after the close
3252 since closing changes the modtime. */
3255 /* Recall that #if defined does not work on VMS. */
3262 /* NFS can report a write failure now. */
3263 if (close (desc
) < 0)
3264 failure
= 1, save_errno
= errno
;
3267 /* If we wrote to a temporary name and had no errors, rename to real name. */
3271 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3279 /* Discard the unwind protect for close_file_unwind. */
3280 specpdl_ptr
= specpdl
+ count1
;
3281 /* Restore the original current buffer. */
3282 visit_file
= unbind_to (count
, visit_file
);
3284 #ifdef CLASH_DETECTION
3286 unlock_file (visit_file
);
3287 #endif /* CLASH_DETECTION */
3289 /* Do this before reporting IO error
3290 to avoid a "file has changed on disk" warning on
3291 next attempt to save. */
3293 current_buffer
->modtime
= st
.st_mtime
;
3296 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3300 current_buffer
->save_modified
= MODIFF
;
3301 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3302 current_buffer
->filename
= visit_file
;
3303 update_mode_lines
++;
3309 message ("Wrote %s", XSTRING (visit_file
)->data
);
3314 Lisp_Object
merge ();
3316 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3317 "Return t if (car A) is numerically less than (car B).")
3321 return Flss (Fcar (a
), Fcar (b
));
3324 /* Build the complete list of annotations appropriate for writing out
3325 the text between START and END, by calling all the functions in
3326 write-region-annotate-functions and merging the lists they return.
3327 If one of these functions switches to a different buffer, we assume
3328 that buffer contains altered text. Therefore, the caller must
3329 make sure to restore the current buffer in all cases,
3330 as save-excursion would do. */
3333 build_annotations (start
, end
)
3334 Lisp_Object start
, end
;
3336 Lisp_Object annotations
;
3338 struct gcpro gcpro1
, gcpro2
;
3341 p
= Vwrite_region_annotate_functions
;
3342 GCPRO2 (annotations
, p
);
3345 struct buffer
*given_buffer
= current_buffer
;
3346 Vwrite_region_annotations_so_far
= annotations
;
3347 res
= call2 (Fcar (p
), start
, end
);
3348 /* If the function makes a different buffer current,
3349 assume that means this buffer contains altered text to be output.
3350 Reset START and END from the buffer bounds
3351 and discard all previous annotations because they should have
3352 been dealt with by this function. */
3353 if (current_buffer
!= given_buffer
)
3359 Flength (res
); /* Check basic validity of return value */
3360 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3367 /* Write to descriptor DESC the LEN characters starting at ADDR,
3368 assuming they start at position POS in the buffer.
3369 Intersperse with them the annotations from *ANNOT
3370 (those which fall within the range of positions POS to POS + LEN),
3371 each at its appropriate position.
3373 Modify *ANNOT by discarding elements as we output them.
3374 The return value is negative in case of system call failure. */
3377 a_write (desc
, addr
, len
, pos
, annot
)
3379 register char *addr
;
3386 int lastpos
= pos
+ len
;
3388 while (NILP (*annot
) || CONSP (*annot
))
3390 tem
= Fcar_safe (Fcar (*annot
));
3391 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3392 nextpos
= XFASTINT (tem
);
3394 return e_write (desc
, addr
, lastpos
- pos
);
3397 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3399 addr
+= nextpos
- pos
;
3402 tem
= Fcdr (Fcar (*annot
));
3405 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3408 *annot
= Fcdr (*annot
);
3413 e_write (desc
, addr
, len
)
3415 register char *addr
;
3418 char buf
[16 * 1024];
3419 register char *p
, *end
;
3421 if (!EQ (current_buffer
->selective_display
, Qt
))
3422 return write (desc
, addr
, len
) - len
;
3426 end
= p
+ sizeof buf
;
3431 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3440 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3446 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3447 Sverify_visited_file_modtime
, 1, 1, 0,
3448 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3449 This means that the file has not been changed since it was visited or saved.")
3455 Lisp_Object handler
;
3457 CHECK_BUFFER (buf
, 0);
3460 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
3461 if (b
->modtime
== 0) return Qt
;
3463 /* If the file name has special constructs in it,
3464 call the corresponding file handler. */
3465 handler
= Ffind_file_name_handler (b
->filename
,
3466 Qverify_visited_file_modtime
);
3467 if (!NILP (handler
))
3468 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3470 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3472 /* If the file doesn't exist now and didn't exist before,
3473 we say that it isn't modified, provided the error is a tame one. */
3474 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3479 if (st
.st_mtime
== b
->modtime
3480 /* If both are positive, accept them if they are off by one second. */
3481 || (st
.st_mtime
> 0 && b
->modtime
> 0
3482 && (st
.st_mtime
== b
->modtime
+ 1
3483 || st
.st_mtime
== b
->modtime
- 1)))
3488 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3489 Sclear_visited_file_modtime
, 0, 0, 0,
3490 "Clear out records of last mod time of visited file.\n\
3491 Next attempt to save will certainly not complain of a discrepancy.")
3494 current_buffer
->modtime
= 0;
3498 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3499 Svisited_file_modtime
, 0, 0, 0,
3500 "Return the current buffer's recorded visited file modification time.\n\
3501 The value is a list of the form (HIGH . LOW), like the time values\n\
3502 that `file-attributes' returns.")
3505 return long_to_cons (current_buffer
->modtime
);
3508 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3509 Sset_visited_file_modtime
, 0, 1, 0,
3510 "Update buffer's recorded modification time from the visited file's time.\n\
3511 Useful if the buffer was not read from the file normally\n\
3512 or if the file itself has been changed for some known benign reason.\n\
3513 An argument specifies the modification time value to use\n\
3514 \(instead of that of the visited file), in the form of a list\n\
3515 \(HIGH . LOW) or (HIGH LOW).")
3517 Lisp_Object time_list
;
3519 if (!NILP (time_list
))
3520 current_buffer
->modtime
= cons_to_long (time_list
);
3523 register Lisp_Object filename
;
3525 Lisp_Object handler
;
3527 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3529 /* If the file name has special constructs in it,
3530 call the corresponding file handler. */
3531 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3532 if (!NILP (handler
))
3533 /* The handler can find the file name the same way we did. */
3534 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3535 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3536 current_buffer
->modtime
= st
.st_mtime
;
3546 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3547 Fsleep_for (make_number (1), Qnil
);
3548 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3549 Fsleep_for (make_number (1), Qnil
);
3550 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3551 Fsleep_for (make_number (1), Qnil
);
3561 /* Get visited file's mode to become the auto save file's mode. */
3562 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3563 /* But make sure we can overwrite it later! */
3564 auto_save_mode_bits
= st
.st_mode
| 0600;
3566 auto_save_mode_bits
= 0666;
3569 Fwrite_region (Qnil
, Qnil
,
3570 current_buffer
->auto_save_file_name
,
3575 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3578 close (XINT (desc
));
3582 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3583 "Auto-save all buffers that need it.\n\
3584 This is all buffers that have auto-saving enabled\n\
3585 and are changed since last auto-saved.\n\
3586 Auto-saving writes the buffer into a file\n\
3587 so that your editing is not lost if the system crashes.\n\
3588 This file is not the file you visited; that changes only when you save.\n\
3589 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3590 Non-nil first argument means do not print any message if successful.\n\
3591 Non-nil second argument means save only current buffer.")
3592 (no_message
, current_only
)
3593 Lisp_Object no_message
, current_only
;
3595 struct buffer
*old
= current_buffer
, *b
;
3596 Lisp_Object tail
, buf
;
3598 char *omessage
= echo_area_glyphs
;
3599 int omessage_length
= echo_area_glyphs_length
;
3600 extern int minibuf_level
;
3601 int do_handled_files
;
3604 int count
= specpdl_ptr
- specpdl
;
3607 /* Ordinarily don't quit within this function,
3608 but don't make it impossible to quit (in case we get hung in I/O). */
3612 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3613 point to non-strings reached from Vbuffer_alist. */
3619 if (!NILP (Vrun_hooks
))
3620 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3622 if (STRINGP (Vauto_save_list_file_name
))
3625 listdesc
= open (XSTRING (Vauto_save_list_file_name
)->data
,
3626 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3627 S_IREAD
| S_IWRITE
);
3628 #else /* not MSDOS */
3629 listdesc
= creat (XSTRING (Vauto_save_list_file_name
)->data
, 0666);
3630 #endif /* not MSDOS */
3635 /* Arrange to close that file whether or not we get an error. */
3637 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3639 /* First, save all files which don't have handlers. If Emacs is
3640 crashing, the handlers may tweak what is causing Emacs to crash
3641 in the first place, and it would be a shame if Emacs failed to
3642 autosave perfectly ordinary files because it couldn't handle some
3644 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3645 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
3646 tail
= XCONS (tail
)->cdr
)
3648 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3651 /* Record all the buffers that have auto save mode
3652 in the special file that lists them. */
3653 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3654 && listdesc
>= 0 && do_handled_files
== 0)
3656 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3657 XSTRING (b
->auto_save_file_name
)->size
);
3658 write (listdesc
, "\n", 1);
3661 if (!NILP (current_only
)
3662 && b
!= current_buffer
)
3665 /* Check for auto save enabled
3666 and file changed since last auto save
3667 and file changed since last real save. */
3668 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3669 && b
->save_modified
< BUF_MODIFF (b
)
3670 && b
->auto_save_modified
< BUF_MODIFF (b
)
3671 /* -1 means we've turned off autosaving for a while--see below. */
3672 && XINT (b
->save_length
) >= 0
3673 && (do_handled_files
3674 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3677 EMACS_TIME before_time
, after_time
;
3679 EMACS_GET_TIME (before_time
);
3681 /* If we had a failure, don't try again for 20 minutes. */
3682 if (b
->auto_save_failure_time
>= 0
3683 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3686 if ((XFASTINT (b
->save_length
) * 10
3687 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3688 /* A short file is likely to change a large fraction;
3689 spare the user annoying messages. */
3690 && XFASTINT (b
->save_length
) > 5000
3691 /* These messages are frequent and annoying for `*mail*'. */
3692 && !EQ (b
->filename
, Qnil
)
3693 && NILP (no_message
))
3695 /* It has shrunk too much; turn off auto-saving here. */
3696 message ("Buffer %s has shrunk a lot; auto save turned off there",
3697 XSTRING (b
->name
)->data
);
3698 /* Turn off auto-saving until there's a real save,
3699 and prevent any more warnings. */
3700 XSET (b
->save_length
, Lisp_Int
, -1);
3701 Fsleep_for (make_number (1), Qnil
);
3704 set_buffer_internal (b
);
3705 if (!auto_saved
&& NILP (no_message
))
3706 message1 ("Auto-saving...");
3707 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3709 b
->auto_save_modified
= BUF_MODIFF (b
);
3710 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3711 set_buffer_internal (old
);
3713 EMACS_GET_TIME (after_time
);
3715 /* If auto-save took more than 60 seconds,
3716 assume it was an NFS failure that got a timeout. */
3717 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3718 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3722 /* Prevent another auto save till enough input events come in. */
3723 record_auto_save ();
3725 if (auto_saved
&& NILP (no_message
))
3728 message2 (omessage
, omessage_length
);
3730 message1 ("Auto-saving...done");
3736 unbind_to (count
, Qnil
);
3740 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3741 Sset_buffer_auto_saved
, 0, 0, 0,
3742 "Mark current buffer as auto-saved with its current text.\n\
3743 No auto-save file will be written until the buffer changes again.")
3746 current_buffer
->auto_save_modified
= MODIFF
;
3747 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3748 current_buffer
->auto_save_failure_time
= -1;
3752 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3753 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3754 "Clear any record of a recent auto-save failure in the current buffer.")
3757 current_buffer
->auto_save_failure_time
= -1;
3761 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3763 "Return t if buffer has been auto-saved since last read in or saved.")
3766 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3769 /* Reading and completing file names */
3770 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3772 /* In the string VAL, change each $ to $$ and return the result. */
3775 double_dollars (val
)
3778 register unsigned char *old
, *new;
3782 osize
= XSTRING (val
)->size
;
3783 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3784 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3785 if (*old
++ == '$') count
++;
3788 old
= XSTRING (val
)->data
;
3789 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3790 new = XSTRING (val
)->data
;
3791 for (n
= osize
; n
> 0; n
--)
3804 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3806 "Internal subroutine for read-file-name. Do not call this.")
3807 (string
, dir
, action
)
3808 Lisp_Object string
, dir
, action
;
3809 /* action is nil for complete, t for return list of completions,
3810 lambda for verify final value */
3812 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3814 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3821 /* No need to protect ACTION--we only compare it with t and nil. */
3822 GCPRO4 (string
, realdir
, name
, specdir
);
3824 if (XSTRING (string
)->size
== 0)
3826 if (EQ (action
, Qlambda
))
3834 orig_string
= string
;
3835 string
= Fsubstitute_in_file_name (string
);
3836 changed
= NILP (Fstring_equal (string
, orig_string
));
3837 name
= Ffile_name_nondirectory (string
);
3838 val
= Ffile_name_directory (string
);
3840 realdir
= Fexpand_file_name (val
, realdir
);
3845 specdir
= Ffile_name_directory (string
);
3846 val
= Ffile_name_completion (name
, realdir
);
3848 if (XTYPE (val
) != Lisp_String
)
3851 return double_dollars (string
);
3855 if (!NILP (specdir
))
3856 val
= concat2 (specdir
, val
);
3858 return double_dollars (val
);
3861 #endif /* not VMS */
3865 if (EQ (action
, Qt
))
3866 return Ffile_name_all_completions (name
, realdir
);
3867 /* Only other case actually used is ACTION = lambda */
3869 /* Supposedly this helps commands such as `cd' that read directory names,
3870 but can someone explain how it helps them? -- RMS */
3871 if (XSTRING (name
)->size
== 0)
3874 return Ffile_exists_p (string
);
3877 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3878 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3879 Value is not expanded---you must call `expand-file-name' yourself.\n\
3880 Default name to DEFAULT if user enters a null string.\n\
3881 (If DEFAULT is omitted, the visited file name is used.)\n\
3882 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3883 Non-nil and non-t means also require confirmation after completion.\n\
3884 Fifth arg INITIAL specifies text to start with.\n\
3885 DIR defaults to current buffer's directory default.")
3886 (prompt
, dir
, defalt
, mustmatch
, initial
)
3887 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3889 Lisp_Object val
, insdef
, insdef1
, tem
;
3890 struct gcpro gcpro1
, gcpro2
;
3891 register char *homedir
;
3895 dir
= current_buffer
->directory
;
3897 defalt
= current_buffer
->filename
;
3899 /* If dir starts with user's homedir, change that to ~. */
3900 homedir
= (char *) egetenv ("HOME");
3902 && XTYPE (dir
) == Lisp_String
3903 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3904 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3906 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3907 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3908 XSTRING (dir
)->data
[0] = '~';
3911 if (insert_default_directory
)
3914 if (!NILP (initial
))
3916 Lisp_Object args
[2], pos
;
3920 insdef
= Fconcat (2, args
);
3921 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
3922 insdef1
= Fcons (double_dollars (insdef
), pos
);
3925 insdef1
= double_dollars (insdef
);
3927 else if (!NILP (initial
))
3930 insdef1
= Fcons (double_dollars (insdef
), 0);
3933 insdef
= Qnil
, insdef1
= Qnil
;
3936 count
= specpdl_ptr
- specpdl
;
3937 specbind (intern ("completion-ignore-case"), Qt
);
3940 GCPRO2 (insdef
, defalt
);
3941 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3942 dir
, mustmatch
, insdef1
,
3943 Qfile_name_history
);
3946 unbind_to (count
, Qnil
);
3951 error ("No file name specified");
3952 tem
= Fstring_equal (val
, insdef
);
3953 if (!NILP (tem
) && !NILP (defalt
))
3955 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3960 error ("No default file name");
3962 return Fsubstitute_in_file_name (val
);
3965 #if 0 /* Old version */
3966 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3967 /* Don't confuse make-docfile by having two doc strings for this function.
3968 make-docfile does not pay attention to #if, for good reason! */
3970 (prompt
, dir
, defalt
, mustmatch
, initial
)
3971 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3973 Lisp_Object val
, insdef
, tem
;
3974 struct gcpro gcpro1
, gcpro2
;
3975 register char *homedir
;
3979 dir
= current_buffer
->directory
;
3981 defalt
= current_buffer
->filename
;
3983 /* If dir starts with user's homedir, change that to ~. */
3984 homedir
= (char *) egetenv ("HOME");
3986 && XTYPE (dir
) == Lisp_String
3987 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3988 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3990 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3991 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3992 XSTRING (dir
)->data
[0] = '~';
3995 if (!NILP (initial
))
3997 else if (insert_default_directory
)
4000 insdef
= build_string ("");
4003 count
= specpdl_ptr
- specpdl
;
4004 specbind (intern ("completion-ignore-case"), Qt
);
4007 GCPRO2 (insdef
, defalt
);
4008 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4010 insert_default_directory
? insdef
: Qnil
,
4011 Qfile_name_history
);
4014 unbind_to (count
, Qnil
);
4019 error ("No file name specified");
4020 tem
= Fstring_equal (val
, insdef
);
4021 if (!NILP (tem
) && !NILP (defalt
))
4023 return Fsubstitute_in_file_name (val
);
4025 #endif /* Old version */
4029 Qexpand_file_name
= intern ("expand-file-name");
4030 Qdirectory_file_name
= intern ("directory-file-name");
4031 Qfile_name_directory
= intern ("file-name-directory");
4032 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4033 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4034 Qfile_name_as_directory
= intern ("file-name-as-directory");
4035 Qcopy_file
= intern ("copy-file");
4036 Qmake_directory_internal
= intern ("make-directory-internal");
4037 Qdelete_directory
= intern ("delete-directory");
4038 Qdelete_file
= intern ("delete-file");
4039 Qrename_file
= intern ("rename-file");
4040 Qadd_name_to_file
= intern ("add-name-to-file");
4041 Qmake_symbolic_link
= intern ("make-symbolic-link");
4042 Qfile_exists_p
= intern ("file-exists-p");
4043 Qfile_executable_p
= intern ("file-executable-p");
4044 Qfile_readable_p
= intern ("file-readable-p");
4045 Qfile_symlink_p
= intern ("file-symlink-p");
4046 Qfile_writable_p
= intern ("file-writable-p");
4047 Qfile_directory_p
= intern ("file-directory-p");
4048 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4049 Qfile_modes
= intern ("file-modes");
4050 Qset_file_modes
= intern ("set-file-modes");
4051 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4052 Qinsert_file_contents
= intern ("insert-file-contents");
4053 Qwrite_region
= intern ("write-region");
4054 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4055 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4057 staticpro (&Qexpand_file_name
);
4058 staticpro (&Qdirectory_file_name
);
4059 staticpro (&Qfile_name_directory
);
4060 staticpro (&Qfile_name_nondirectory
);
4061 staticpro (&Qunhandled_file_name_directory
);
4062 staticpro (&Qfile_name_as_directory
);
4063 staticpro (&Qcopy_file
);
4064 staticpro (&Qmake_directory_internal
);
4065 staticpro (&Qdelete_directory
);
4066 staticpro (&Qdelete_file
);
4067 staticpro (&Qrename_file
);
4068 staticpro (&Qadd_name_to_file
);
4069 staticpro (&Qmake_symbolic_link
);
4070 staticpro (&Qfile_exists_p
);
4071 staticpro (&Qfile_executable_p
);
4072 staticpro (&Qfile_readable_p
);
4073 staticpro (&Qfile_symlink_p
);
4074 staticpro (&Qfile_writable_p
);
4075 staticpro (&Qfile_directory_p
);
4076 staticpro (&Qfile_accessible_directory_p
);
4077 staticpro (&Qfile_modes
);
4078 staticpro (&Qset_file_modes
);
4079 staticpro (&Qfile_newer_than_file_p
);
4080 staticpro (&Qinsert_file_contents
);
4081 staticpro (&Qwrite_region
);
4082 staticpro (&Qverify_visited_file_modtime
);
4084 Qfile_name_history
= intern ("file-name-history");
4085 Fset (Qfile_name_history
, Qnil
);
4086 staticpro (&Qfile_name_history
);
4088 Qfile_error
= intern ("file-error");
4089 staticpro (&Qfile_error
);
4090 Qfile_already_exists
= intern("file-already-exists");
4091 staticpro (&Qfile_already_exists
);
4094 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4095 staticpro (&Qfind_buffer_file_type
);
4098 Qcar_less_than_car
= intern ("car-less-than-car");
4099 staticpro (&Qcar_less_than_car
);
4101 Fput (Qfile_error
, Qerror_conditions
,
4102 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4103 Fput (Qfile_error
, Qerror_message
,
4104 build_string ("File error"));
4106 Fput (Qfile_already_exists
, Qerror_conditions
,
4107 Fcons (Qfile_already_exists
,
4108 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4109 Fput (Qfile_already_exists
, Qerror_message
,
4110 build_string ("File already exists"));
4112 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4113 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4114 insert_default_directory
= 1;
4116 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4117 "*Non-nil means write new files with record format `stmlf'.\n\
4118 nil means use format `var'. This variable is meaningful only on VMS.");
4119 vms_stmlf_recfm
= 0;
4121 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4122 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4123 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4126 The first argument given to HANDLER is the name of the I/O primitive\n\
4127 to be handled; the remaining arguments are the arguments that were\n\
4128 passed to that primitive. For example, if you do\n\
4129 (file-exists-p FILENAME)\n\
4130 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4131 (funcall HANDLER 'file-exists-p FILENAME)\n\
4132 The function `find-file-name-handler' checks this list for a handler\n\
4133 for its argument.");
4134 Vfile_name_handler_alist
= Qnil
;
4136 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4137 "A list of functions to be called at the end of `insert-file-contents'.\n\
4138 Each is passed one argument, the number of bytes inserted. It should return\n\
4139 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4140 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4141 responsible for calling the after-insert-file-functions if appropriate.");
4142 Vafter_insert_file_functions
= Qnil
;
4144 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4145 "A list of functions to be called at the start of `write-region'.\n\
4146 Each is passed two arguments, START and END as for `write-region'. It should\n\
4147 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4148 inserted at the specified positions of the file being written (1 means to\n\
4149 insert before the first byte written). The POSITIONs must be sorted into\n\
4150 increasing order. If there are several functions in the list, the several\n\
4151 lists are merged destructively.");
4152 Vwrite_region_annotate_functions
= Qnil
;
4154 DEFVAR_LISP ("write-region-annotations-so-far",
4155 &Vwrite_region_annotations_so_far
,
4156 "When an annotation function is called, this holds the previous annotations.\n\
4157 These are the annotations made by other annotation functions\n\
4158 that were already called. See also `write-region-annotate-functions'.");
4159 Vwrite_region_annotations_so_far
= Qnil
;
4161 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4162 "A list of file name handlers that temporarily should not be used.\n\
4163 This applies only to the operation `inhibit-file-name-operation'.");
4164 Vinhibit_file_name_handlers
= Qnil
;
4166 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4167 "The operation for which `inhibit-file-name-handlers' is applicable.");
4168 Vinhibit_file_name_operation
= Qnil
;
4170 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4171 "File name in which we write a list of all auto save file names.");
4172 Vauto_save_list_file_name
= Qnil
;
4174 defsubr (&Sfind_file_name_handler
);
4175 defsubr (&Sfile_name_directory
);
4176 defsubr (&Sfile_name_nondirectory
);
4177 defsubr (&Sunhandled_file_name_directory
);
4178 defsubr (&Sfile_name_as_directory
);
4179 defsubr (&Sdirectory_file_name
);
4180 defsubr (&Smake_temp_name
);
4181 defsubr (&Sexpand_file_name
);
4182 defsubr (&Ssubstitute_in_file_name
);
4183 defsubr (&Scopy_file
);
4184 defsubr (&Smake_directory_internal
);
4185 defsubr (&Sdelete_directory
);
4186 defsubr (&Sdelete_file
);
4187 defsubr (&Srename_file
);
4188 defsubr (&Sadd_name_to_file
);
4190 defsubr (&Smake_symbolic_link
);
4191 #endif /* S_IFLNK */
4193 defsubr (&Sdefine_logical_name
);
4196 defsubr (&Ssysnetunam
);
4197 #endif /* HPUX_NET */
4198 defsubr (&Sfile_name_absolute_p
);
4199 defsubr (&Sfile_exists_p
);
4200 defsubr (&Sfile_executable_p
);
4201 defsubr (&Sfile_readable_p
);
4202 defsubr (&Sfile_writable_p
);
4203 defsubr (&Sfile_symlink_p
);
4204 defsubr (&Sfile_directory_p
);
4205 defsubr (&Sfile_accessible_directory_p
);
4206 defsubr (&Sfile_modes
);
4207 defsubr (&Sset_file_modes
);
4208 defsubr (&Sset_default_file_modes
);
4209 defsubr (&Sdefault_file_modes
);
4210 defsubr (&Sfile_newer_than_file_p
);
4211 defsubr (&Sinsert_file_contents
);
4212 defsubr (&Swrite_region
);
4213 defsubr (&Scar_less_than_car
);
4214 defsubr (&Sverify_visited_file_modtime
);
4215 defsubr (&Sclear_visited_file_modtime
);
4216 defsubr (&Svisited_file_modtime
);
4217 defsubr (&Sset_visited_file_modtime
);
4218 defsubr (&Sdo_auto_save
);
4219 defsubr (&Sset_buffer_auto_saved
);
4220 defsubr (&Sclear_buffer_auto_save_failure
);
4221 defsubr (&Srecent_auto_save_p
);
4223 defsubr (&Sread_file_name_internal
);
4224 defsubr (&Sread_file_name
);
4227 defsubr (&Sunix_sync
);