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 current_buffer
->buffer_file_type
2862 = call1 (Qfind_buffer_file_type
, filename
);
2863 if (NILP (current_buffer
->buffer_file_type
))
2866 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
2869 GPT
-= reduced_size
;
2870 GAP_SIZE
+= reduced_size
;
2871 inserted
-= reduced_size
;
2878 record_insert (point
, inserted
);
2880 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2881 offset_intervals (current_buffer
, point
, inserted
);
2887 /* Discard the unwind protect for closing the file. */
2891 error ("IO error reading %s: %s",
2892 XSTRING (filename
)->data
, strerror (errno
));
2899 if (!EQ (current_buffer
->undo_list
, Qt
))
2900 current_buffer
->undo_list
= Qnil
;
2902 stat (XSTRING (filename
)->data
, &st
);
2907 current_buffer
->modtime
= st
.st_mtime
;
2908 current_buffer
->filename
= filename
;
2911 current_buffer
->save_modified
= MODIFF
;
2912 current_buffer
->auto_save_modified
= MODIFF
;
2913 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2914 #ifdef CLASH_DETECTION
2917 if (!NILP (current_buffer
->filename
))
2918 unlock_file (current_buffer
->filename
);
2919 unlock_file (filename
);
2921 #endif /* CLASH_DETECTION */
2922 /* If visiting nonexistent file, return nil. */
2923 if (current_buffer
->modtime
== -1)
2924 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2927 if (inserted
> 0 && NILP (visit
) && total
> 0)
2928 signal_after_change (point
, 0, inserted
);
2932 p
= Vafter_insert_file_functions
;
2935 insval
= call1 (Fcar (p
), make_number (inserted
));
2938 CHECK_NUMBER (insval
, 0);
2939 inserted
= XFASTINT (insval
);
2947 val
= Fcons (filename
,
2948 Fcons (make_number (inserted
),
2951 RETURN_UNGCPRO (unbind_to (count
, val
));
2954 static Lisp_Object
build_annotations ();
2956 /* If build_annotations switched buffers, switch back to BUF.
2957 Kill the temporary buffer that was selected in the meantime. */
2960 build_annotations_unwind (buf
)
2965 if (XBUFFER (buf
) == current_buffer
)
2967 tembuf
= Fcurrent_buffer ();
2969 Fkill_buffer (tembuf
);
2973 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2974 "r\nFWrite region to file: ",
2975 "Write current region into specified file.\n\
2976 When called from a program, takes three arguments:\n\
2977 START, END and FILENAME. START and END are buffer positions.\n\
2978 Optional fourth argument APPEND if non-nil means\n\
2979 append to existing file contents (if any).\n\
2980 Optional fifth argument VISIT if t means\n\
2981 set the last-save-file-modtime of buffer to this file's modtime\n\
2982 and mark buffer not modified.\n\
2983 If VISIT is a string, it is a second file name;\n\
2984 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2985 VISIT is also the file name to lock and unlock for clash detection.\n\
2986 If VISIT is neither t nor nil nor a string,\n\
2987 that means do not print the \"Wrote file\" message.\n\
2988 Kludgy feature: if START is a string, then that string is written\n\
2989 to the file, instead of any buffer contents, and END is ignored.")
2990 (start
, end
, filename
, append
, visit
)
2991 Lisp_Object start
, end
, filename
, append
, visit
;
2999 int count
= specpdl_ptr
- specpdl
;
3002 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3004 Lisp_Object handler
;
3005 Lisp_Object visit_file
;
3006 Lisp_Object annotations
;
3007 int visiting
, quietly
;
3008 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3009 struct buffer
*given_buffer
;
3011 int buffer_file_type
3012 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3015 if (!NILP (start
) && !STRINGP (start
))
3016 validate_region (&start
, &end
);
3018 GCPRO2 (filename
, visit
);
3019 filename
= Fexpand_file_name (filename
, Qnil
);
3020 if (STRINGP (visit
))
3021 visit_file
= Fexpand_file_name (visit
, Qnil
);
3023 visit_file
= filename
;
3026 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3027 quietly
= !NILP (visit
);
3031 GCPRO4 (start
, filename
, annotations
, visit_file
);
3033 /* If the file name has special constructs in it,
3034 call the corresponding file handler. */
3035 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3036 /* If FILENAME has no handler, see if VISIT has one. */
3037 if (NILP (handler
) && XTYPE (visit
) == Lisp_String
)
3038 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3040 if (!NILP (handler
))
3043 val
= call6 (handler
, Qwrite_region
, start
, end
,
3044 filename
, append
, visit
);
3048 current_buffer
->save_modified
= MODIFF
;
3049 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3050 current_buffer
->filename
= visit_file
;
3056 /* Special kludge to simplify auto-saving. */
3059 XFASTINT (start
) = BEG
;
3063 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3064 count1
= specpdl_ptr
- specpdl
;
3066 given_buffer
= current_buffer
;
3067 annotations
= build_annotations (start
, end
);
3068 if (current_buffer
!= given_buffer
)
3074 #ifdef CLASH_DETECTION
3076 lock_file (visit_file
);
3077 #endif /* CLASH_DETECTION */
3079 fn
= XSTRING (filename
)->data
;
3083 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3085 desc
= open (fn
, O_WRONLY
);
3090 if (auto_saving
) /* Overwrite any previous version of autosave file */
3092 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3093 desc
= open (fn
, O_RDWR
);
3095 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3096 ? XSTRING (current_buffer
->filename
)->data
: 0,
3099 else /* Write to temporary name and rename if no errors */
3101 Lisp_Object temp_name
;
3102 temp_name
= Ffile_name_directory (filename
);
3104 if (!NILP (temp_name
))
3106 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3107 build_string ("$$SAVE$$")));
3108 fname
= XSTRING (filename
)->data
;
3109 fn
= XSTRING (temp_name
)->data
;
3110 desc
= creat_copy_attrs (fname
, fn
);
3113 /* If we can't open the temporary file, try creating a new
3114 version of the original file. VMS "creat" creates a
3115 new version rather than truncating an existing file. */
3118 desc
= creat (fn
, 0666);
3119 #if 0 /* This can clobber an existing file and fail to replace it,
3120 if the user runs out of space. */
3123 /* We can't make a new version;
3124 try to truncate and rewrite existing version if any. */
3126 desc
= open (fn
, O_RDWR
);
3132 desc
= creat (fn
, 0666);
3137 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3138 S_IREAD
| S_IWRITE
);
3139 #else /* not MSDOS */
3140 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3141 #endif /* not MSDOS */
3142 #endif /* not VMS */
3148 #ifdef CLASH_DETECTION
3150 if (!auto_saving
) unlock_file (visit_file
);
3152 #endif /* CLASH_DETECTION */
3153 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3156 record_unwind_protect (close_file_unwind
, make_number (desc
));
3159 if (lseek (desc
, 0, 2) < 0)
3161 #ifdef CLASH_DETECTION
3162 if (!auto_saving
) unlock_file (visit_file
);
3163 #endif /* CLASH_DETECTION */
3164 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3169 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3170 * if we do writes that don't end with a carriage return. Furthermore
3171 * it cannot handle writes of more then 16K. The modified
3172 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3173 * this EXCEPT for the last record (iff it doesn't end with a carriage
3174 * return). This implies that if your buffer doesn't end with a carriage
3175 * return, you get one free... tough. However it also means that if
3176 * we make two calls to sys_write (a la the following code) you can
3177 * get one at the gap as well. The easiest way to fix this (honest)
3178 * is to move the gap to the next newline (or the end of the buffer).
3183 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3184 move_gap (find_next_newline (GPT
, 1));
3190 if (STRINGP (start
))
3192 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3193 XSTRING (start
)->size
, 0, &annotations
);
3196 else if (XINT (start
) != XINT (end
))
3199 if (XINT (start
) < GPT
)
3201 register int end1
= XINT (end
);
3203 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3204 min (GPT
, end1
) - tem
, tem
, &annotations
);
3205 nwritten
+= min (GPT
, end1
) - tem
;
3209 if (XINT (end
) > GPT
&& !failure
)
3212 tem
= max (tem
, GPT
);
3213 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3215 nwritten
+= XINT (end
) - tem
;
3221 /* If file was empty, still need to write the annotations */
3222 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3230 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3231 Disk full in NFS may be reported here. */
3232 /* mib says that closing the file will try to write as fast as NFS can do
3233 it, and that means the fsync here is not crucial for autosave files. */
3234 if (!auto_saving
&& fsync (desc
) < 0)
3235 failure
= 1, save_errno
= errno
;
3238 /* Spurious "file has changed on disk" warnings have been
3239 observed on Suns as well.
3240 It seems that `close' can change the modtime, under nfs.
3242 (This has supposedly been fixed in Sunos 4,
3243 but who knows about all the other machines with NFS?) */
3246 /* On VMS and APOLLO, must do the stat after the close
3247 since closing changes the modtime. */
3250 /* Recall that #if defined does not work on VMS. */
3257 /* NFS can report a write failure now. */
3258 if (close (desc
) < 0)
3259 failure
= 1, save_errno
= errno
;
3262 /* If we wrote to a temporary name and had no errors, rename to real name. */
3266 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3274 /* Discard the unwind protect for close_file_unwind. */
3275 specpdl_ptr
= specpdl
+ count1
;
3276 /* Restore the original current buffer. */
3277 visit_file
= unbind_to (count
, visit_file
);
3279 #ifdef CLASH_DETECTION
3281 unlock_file (visit_file
);
3282 #endif /* CLASH_DETECTION */
3284 /* Do this before reporting IO error
3285 to avoid a "file has changed on disk" warning on
3286 next attempt to save. */
3288 current_buffer
->modtime
= st
.st_mtime
;
3291 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3295 current_buffer
->save_modified
= MODIFF
;
3296 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3297 current_buffer
->filename
= visit_file
;
3298 update_mode_lines
++;
3304 message ("Wrote %s", XSTRING (visit_file
)->data
);
3309 Lisp_Object
merge ();
3311 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3312 "Return t if (car A) is numerically less than (car B).")
3316 return Flss (Fcar (a
), Fcar (b
));
3319 /* Build the complete list of annotations appropriate for writing out
3320 the text between START and END, by calling all the functions in
3321 write-region-annotate-functions and merging the lists they return.
3322 If one of these functions switches to a different buffer, we assume
3323 that buffer contains altered text. Therefore, the caller must
3324 make sure to restore the current buffer in all cases,
3325 as save-excursion would do. */
3328 build_annotations (start
, end
)
3329 Lisp_Object start
, end
;
3331 Lisp_Object annotations
;
3333 struct gcpro gcpro1
, gcpro2
;
3336 p
= Vwrite_region_annotate_functions
;
3337 GCPRO2 (annotations
, p
);
3340 struct buffer
*given_buffer
= current_buffer
;
3341 Vwrite_region_annotations_so_far
= annotations
;
3342 res
= call2 (Fcar (p
), start
, end
);
3343 /* If the function makes a different buffer current,
3344 assume that means this buffer contains altered text to be output.
3345 Reset START and END from the buffer bounds
3346 and discard all previous annotations because they should have
3347 been dealt with by this function. */
3348 if (current_buffer
!= given_buffer
)
3354 Flength (res
); /* Check basic validity of return value */
3355 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3362 /* Write to descriptor DESC the LEN characters starting at ADDR,
3363 assuming they start at position POS in the buffer.
3364 Intersperse with them the annotations from *ANNOT
3365 (those which fall within the range of positions POS to POS + LEN),
3366 each at its appropriate position.
3368 Modify *ANNOT by discarding elements as we output them.
3369 The return value is negative in case of system call failure. */
3372 a_write (desc
, addr
, len
, pos
, annot
)
3374 register char *addr
;
3381 int lastpos
= pos
+ len
;
3383 while (NILP (*annot
) || CONSP (*annot
))
3385 tem
= Fcar_safe (Fcar (*annot
));
3386 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3387 nextpos
= XFASTINT (tem
);
3389 return e_write (desc
, addr
, lastpos
- pos
);
3392 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3394 addr
+= nextpos
- pos
;
3397 tem
= Fcdr (Fcar (*annot
));
3400 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3403 *annot
= Fcdr (*annot
);
3408 e_write (desc
, addr
, len
)
3410 register char *addr
;
3413 char buf
[16 * 1024];
3414 register char *p
, *end
;
3416 if (!EQ (current_buffer
->selective_display
, Qt
))
3417 return write (desc
, addr
, len
) - len
;
3421 end
= p
+ sizeof buf
;
3426 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3435 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3441 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3442 Sverify_visited_file_modtime
, 1, 1, 0,
3443 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3444 This means that the file has not been changed since it was visited or saved.")
3450 Lisp_Object handler
;
3452 CHECK_BUFFER (buf
, 0);
3455 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
3456 if (b
->modtime
== 0) return Qt
;
3458 /* If the file name has special constructs in it,
3459 call the corresponding file handler. */
3460 handler
= Ffind_file_name_handler (b
->filename
,
3461 Qverify_visited_file_modtime
);
3462 if (!NILP (handler
))
3463 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3465 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3467 /* If the file doesn't exist now and didn't exist before,
3468 we say that it isn't modified, provided the error is a tame one. */
3469 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3474 if (st
.st_mtime
== b
->modtime
3475 /* If both are positive, accept them if they are off by one second. */
3476 || (st
.st_mtime
> 0 && b
->modtime
> 0
3477 && (st
.st_mtime
== b
->modtime
+ 1
3478 || st
.st_mtime
== b
->modtime
- 1)))
3483 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3484 Sclear_visited_file_modtime
, 0, 0, 0,
3485 "Clear out records of last mod time of visited file.\n\
3486 Next attempt to save will certainly not complain of a discrepancy.")
3489 current_buffer
->modtime
= 0;
3493 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3494 Svisited_file_modtime
, 0, 0, 0,
3495 "Return the current buffer's recorded visited file modification time.\n\
3496 The value is a list of the form (HIGH . LOW), like the time values\n\
3497 that `file-attributes' returns.")
3500 return long_to_cons (current_buffer
->modtime
);
3503 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3504 Sset_visited_file_modtime
, 0, 1, 0,
3505 "Update buffer's recorded modification time from the visited file's time.\n\
3506 Useful if the buffer was not read from the file normally\n\
3507 or if the file itself has been changed for some known benign reason.\n\
3508 An argument specifies the modification time value to use\n\
3509 \(instead of that of the visited file), in the form of a list\n\
3510 \(HIGH . LOW) or (HIGH LOW).")
3512 Lisp_Object time_list
;
3514 if (!NILP (time_list
))
3515 current_buffer
->modtime
= cons_to_long (time_list
);
3518 register Lisp_Object filename
;
3520 Lisp_Object handler
;
3522 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3524 /* If the file name has special constructs in it,
3525 call the corresponding file handler. */
3526 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3527 if (!NILP (handler
))
3528 /* The handler can find the file name the same way we did. */
3529 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3530 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3531 current_buffer
->modtime
= st
.st_mtime
;
3541 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3542 Fsleep_for (make_number (1), Qnil
);
3543 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3544 Fsleep_for (make_number (1), Qnil
);
3545 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3546 Fsleep_for (make_number (1), Qnil
);
3556 /* Get visited file's mode to become the auto save file's mode. */
3557 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3558 /* But make sure we can overwrite it later! */
3559 auto_save_mode_bits
= st
.st_mode
| 0600;
3561 auto_save_mode_bits
= 0666;
3564 Fwrite_region (Qnil
, Qnil
,
3565 current_buffer
->auto_save_file_name
,
3570 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3573 close (XINT (desc
));
3577 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3578 "Auto-save all buffers that need it.\n\
3579 This is all buffers that have auto-saving enabled\n\
3580 and are changed since last auto-saved.\n\
3581 Auto-saving writes the buffer into a file\n\
3582 so that your editing is not lost if the system crashes.\n\
3583 This file is not the file you visited; that changes only when you save.\n\
3584 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3585 Non-nil first argument means do not print any message if successful.\n\
3586 Non-nil second argument means save only current buffer.")
3587 (no_message
, current_only
)
3588 Lisp_Object no_message
, current_only
;
3590 struct buffer
*old
= current_buffer
, *b
;
3591 Lisp_Object tail
, buf
;
3593 char *omessage
= echo_area_glyphs
;
3594 int omessage_length
= echo_area_glyphs_length
;
3595 extern int minibuf_level
;
3596 int do_handled_files
;
3599 int count
= specpdl_ptr
- specpdl
;
3602 /* Ordinarily don't quit within this function,
3603 but don't make it impossible to quit (in case we get hung in I/O). */
3607 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3608 point to non-strings reached from Vbuffer_alist. */
3614 if (!NILP (Vrun_hooks
))
3615 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3617 if (STRINGP (Vauto_save_list_file_name
))
3620 listdesc
= open (XSTRING (Vauto_save_list_file_name
)->data
,
3621 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3622 S_IREAD
| S_IWRITE
);
3623 #else /* not MSDOS */
3624 listdesc
= creat (XSTRING (Vauto_save_list_file_name
)->data
, 0666);
3625 #endif /* not MSDOS */
3630 /* Arrange to close that file whether or not we get an error. */
3632 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3634 /* First, save all files which don't have handlers. If Emacs is
3635 crashing, the handlers may tweak what is causing Emacs to crash
3636 in the first place, and it would be a shame if Emacs failed to
3637 autosave perfectly ordinary files because it couldn't handle some
3639 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3640 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
3641 tail
= XCONS (tail
)->cdr
)
3643 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3646 /* Record all the buffers that have auto save mode
3647 in the special file that lists them. */
3648 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3649 && listdesc
>= 0 && do_handled_files
== 0)
3651 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3652 XSTRING (b
->auto_save_file_name
)->size
);
3653 write (listdesc
, "\n", 1);
3656 if (!NILP (current_only
)
3657 && b
!= current_buffer
)
3660 /* Check for auto save enabled
3661 and file changed since last auto save
3662 and file changed since last real save. */
3663 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3664 && b
->save_modified
< BUF_MODIFF (b
)
3665 && b
->auto_save_modified
< BUF_MODIFF (b
)
3666 /* -1 means we've turned off autosaving for a while--see below. */
3667 && XINT (b
->save_length
) >= 0
3668 && (do_handled_files
3669 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3672 EMACS_TIME before_time
, after_time
;
3674 EMACS_GET_TIME (before_time
);
3676 /* If we had a failure, don't try again for 20 minutes. */
3677 if (b
->auto_save_failure_time
>= 0
3678 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3681 if ((XFASTINT (b
->save_length
) * 10
3682 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3683 /* A short file is likely to change a large fraction;
3684 spare the user annoying messages. */
3685 && XFASTINT (b
->save_length
) > 5000
3686 /* These messages are frequent and annoying for `*mail*'. */
3687 && !EQ (b
->filename
, Qnil
)
3688 && NILP (no_message
))
3690 /* It has shrunk too much; turn off auto-saving here. */
3691 message ("Buffer %s has shrunk a lot; auto save turned off there",
3692 XSTRING (b
->name
)->data
);
3693 /* Turn off auto-saving until there's a real save,
3694 and prevent any more warnings. */
3695 XSET (b
->save_length
, Lisp_Int
, -1);
3696 Fsleep_for (make_number (1), Qnil
);
3699 set_buffer_internal (b
);
3700 if (!auto_saved
&& NILP (no_message
))
3701 message1 ("Auto-saving...");
3702 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3704 b
->auto_save_modified
= BUF_MODIFF (b
);
3705 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3706 set_buffer_internal (old
);
3708 EMACS_GET_TIME (after_time
);
3710 /* If auto-save took more than 60 seconds,
3711 assume it was an NFS failure that got a timeout. */
3712 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3713 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3717 /* Prevent another auto save till enough input events come in. */
3718 record_auto_save ();
3720 if (auto_saved
&& NILP (no_message
))
3723 message2 (omessage
, omessage_length
);
3725 message1 ("Auto-saving...done");
3731 unbind_to (count
, Qnil
);
3735 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3736 Sset_buffer_auto_saved
, 0, 0, 0,
3737 "Mark current buffer as auto-saved with its current text.\n\
3738 No auto-save file will be written until the buffer changes again.")
3741 current_buffer
->auto_save_modified
= MODIFF
;
3742 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3743 current_buffer
->auto_save_failure_time
= -1;
3747 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3748 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3749 "Clear any record of a recent auto-save failure in the current buffer.")
3752 current_buffer
->auto_save_failure_time
= -1;
3756 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3758 "Return t if buffer has been auto-saved since last read in or saved.")
3761 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3764 /* Reading and completing file names */
3765 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3767 /* In the string VAL, change each $ to $$ and return the result. */
3770 double_dollars (val
)
3773 register unsigned char *old
, *new;
3777 osize
= XSTRING (val
)->size
;
3778 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3779 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3780 if (*old
++ == '$') count
++;
3783 old
= XSTRING (val
)->data
;
3784 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3785 new = XSTRING (val
)->data
;
3786 for (n
= osize
; n
> 0; n
--)
3799 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3801 "Internal subroutine for read-file-name. Do not call this.")
3802 (string
, dir
, action
)
3803 Lisp_Object string
, dir
, action
;
3804 /* action is nil for complete, t for return list of completions,
3805 lambda for verify final value */
3807 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3809 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3816 /* No need to protect ACTION--we only compare it with t and nil. */
3817 GCPRO4 (string
, realdir
, name
, specdir
);
3819 if (XSTRING (string
)->size
== 0)
3821 if (EQ (action
, Qlambda
))
3829 orig_string
= string
;
3830 string
= Fsubstitute_in_file_name (string
);
3831 changed
= NILP (Fstring_equal (string
, orig_string
));
3832 name
= Ffile_name_nondirectory (string
);
3833 val
= Ffile_name_directory (string
);
3835 realdir
= Fexpand_file_name (val
, realdir
);
3840 specdir
= Ffile_name_directory (string
);
3841 val
= Ffile_name_completion (name
, realdir
);
3843 if (XTYPE (val
) != Lisp_String
)
3846 return double_dollars (string
);
3850 if (!NILP (specdir
))
3851 val
= concat2 (specdir
, val
);
3853 return double_dollars (val
);
3856 #endif /* not VMS */
3860 if (EQ (action
, Qt
))
3861 return Ffile_name_all_completions (name
, realdir
);
3862 /* Only other case actually used is ACTION = lambda */
3864 /* Supposedly this helps commands such as `cd' that read directory names,
3865 but can someone explain how it helps them? -- RMS */
3866 if (XSTRING (name
)->size
== 0)
3869 return Ffile_exists_p (string
);
3872 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3873 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3874 Value is not expanded---you must call `expand-file-name' yourself.\n\
3875 Default name to DEFAULT if user enters a null string.\n\
3876 (If DEFAULT is omitted, the visited file name is used.)\n\
3877 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3878 Non-nil and non-t means also require confirmation after completion.\n\
3879 Fifth arg INITIAL specifies text to start with.\n\
3880 DIR defaults to current buffer's directory default.")
3881 (prompt
, dir
, defalt
, mustmatch
, initial
)
3882 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3884 Lisp_Object val
, insdef
, insdef1
, tem
;
3885 struct gcpro gcpro1
, gcpro2
;
3886 register char *homedir
;
3890 dir
= current_buffer
->directory
;
3892 defalt
= current_buffer
->filename
;
3894 /* If dir starts with user's homedir, change that to ~. */
3895 homedir
= (char *) egetenv ("HOME");
3897 && XTYPE (dir
) == Lisp_String
3898 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3899 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3901 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3902 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3903 XSTRING (dir
)->data
[0] = '~';
3906 if (insert_default_directory
)
3909 if (!NILP (initial
))
3911 Lisp_Object args
[2], pos
;
3915 insdef
= Fconcat (2, args
);
3916 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
3917 insdef1
= Fcons (double_dollars (insdef
), pos
);
3920 insdef1
= double_dollars (insdef
);
3922 else if (!NILP (initial
))
3925 insdef1
= Fcons (double_dollars (insdef
), 0);
3928 insdef
= Qnil
, insdef1
= Qnil
;
3931 count
= specpdl_ptr
- specpdl
;
3932 specbind (intern ("completion-ignore-case"), Qt
);
3935 GCPRO2 (insdef
, defalt
);
3936 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3937 dir
, mustmatch
, insdef1
,
3938 Qfile_name_history
);
3941 unbind_to (count
, Qnil
);
3946 error ("No file name specified");
3947 tem
= Fstring_equal (val
, insdef
);
3948 if (!NILP (tem
) && !NILP (defalt
))
3950 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3955 error ("No default file name");
3957 return Fsubstitute_in_file_name (val
);
3960 #if 0 /* Old version */
3961 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3962 /* Don't confuse make-docfile by having two doc strings for this function.
3963 make-docfile does not pay attention to #if, for good reason! */
3965 (prompt
, dir
, defalt
, mustmatch
, initial
)
3966 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3968 Lisp_Object val
, insdef
, tem
;
3969 struct gcpro gcpro1
, gcpro2
;
3970 register char *homedir
;
3974 dir
= current_buffer
->directory
;
3976 defalt
= current_buffer
->filename
;
3978 /* If dir starts with user's homedir, change that to ~. */
3979 homedir
= (char *) egetenv ("HOME");
3981 && XTYPE (dir
) == Lisp_String
3982 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3983 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3985 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3986 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3987 XSTRING (dir
)->data
[0] = '~';
3990 if (!NILP (initial
))
3992 else if (insert_default_directory
)
3995 insdef
= build_string ("");
3998 count
= specpdl_ptr
- specpdl
;
3999 specbind (intern ("completion-ignore-case"), Qt
);
4002 GCPRO2 (insdef
, defalt
);
4003 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4005 insert_default_directory
? insdef
: Qnil
,
4006 Qfile_name_history
);
4009 unbind_to (count
, Qnil
);
4014 error ("No file name specified");
4015 tem
= Fstring_equal (val
, insdef
);
4016 if (!NILP (tem
) && !NILP (defalt
))
4018 return Fsubstitute_in_file_name (val
);
4020 #endif /* Old version */
4024 Qexpand_file_name
= intern ("expand-file-name");
4025 Qdirectory_file_name
= intern ("directory-file-name");
4026 Qfile_name_directory
= intern ("file-name-directory");
4027 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4028 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4029 Qfile_name_as_directory
= intern ("file-name-as-directory");
4030 Qcopy_file
= intern ("copy-file");
4031 Qmake_directory_internal
= intern ("make-directory-internal");
4032 Qdelete_directory
= intern ("delete-directory");
4033 Qdelete_file
= intern ("delete-file");
4034 Qrename_file
= intern ("rename-file");
4035 Qadd_name_to_file
= intern ("add-name-to-file");
4036 Qmake_symbolic_link
= intern ("make-symbolic-link");
4037 Qfile_exists_p
= intern ("file-exists-p");
4038 Qfile_executable_p
= intern ("file-executable-p");
4039 Qfile_readable_p
= intern ("file-readable-p");
4040 Qfile_symlink_p
= intern ("file-symlink-p");
4041 Qfile_writable_p
= intern ("file-writable-p");
4042 Qfile_directory_p
= intern ("file-directory-p");
4043 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4044 Qfile_modes
= intern ("file-modes");
4045 Qset_file_modes
= intern ("set-file-modes");
4046 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4047 Qinsert_file_contents
= intern ("insert-file-contents");
4048 Qwrite_region
= intern ("write-region");
4049 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4050 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4052 staticpro (&Qexpand_file_name
);
4053 staticpro (&Qdirectory_file_name
);
4054 staticpro (&Qfile_name_directory
);
4055 staticpro (&Qfile_name_nondirectory
);
4056 staticpro (&Qunhandled_file_name_directory
);
4057 staticpro (&Qfile_name_as_directory
);
4058 staticpro (&Qcopy_file
);
4059 staticpro (&Qmake_directory_internal
);
4060 staticpro (&Qdelete_directory
);
4061 staticpro (&Qdelete_file
);
4062 staticpro (&Qrename_file
);
4063 staticpro (&Qadd_name_to_file
);
4064 staticpro (&Qmake_symbolic_link
);
4065 staticpro (&Qfile_exists_p
);
4066 staticpro (&Qfile_executable_p
);
4067 staticpro (&Qfile_readable_p
);
4068 staticpro (&Qfile_symlink_p
);
4069 staticpro (&Qfile_writable_p
);
4070 staticpro (&Qfile_directory_p
);
4071 staticpro (&Qfile_accessible_directory_p
);
4072 staticpro (&Qfile_modes
);
4073 staticpro (&Qset_file_modes
);
4074 staticpro (&Qfile_newer_than_file_p
);
4075 staticpro (&Qinsert_file_contents
);
4076 staticpro (&Qwrite_region
);
4077 staticpro (&Qverify_visited_file_modtime
);
4079 Qfile_name_history
= intern ("file-name-history");
4080 Fset (Qfile_name_history
, Qnil
);
4081 staticpro (&Qfile_name_history
);
4083 Qfile_error
= intern ("file-error");
4084 staticpro (&Qfile_error
);
4085 Qfile_already_exists
= intern("file-already-exists");
4086 staticpro (&Qfile_already_exists
);
4089 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4090 staticpro (&Qfind_buffer_file_type
);
4093 Qcar_less_than_car
= intern ("car-less-than-car");
4094 staticpro (&Qcar_less_than_car
);
4096 Fput (Qfile_error
, Qerror_conditions
,
4097 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4098 Fput (Qfile_error
, Qerror_message
,
4099 build_string ("File error"));
4101 Fput (Qfile_already_exists
, Qerror_conditions
,
4102 Fcons (Qfile_already_exists
,
4103 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4104 Fput (Qfile_already_exists
, Qerror_message
,
4105 build_string ("File already exists"));
4107 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4108 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4109 insert_default_directory
= 1;
4111 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4112 "*Non-nil means write new files with record format `stmlf'.\n\
4113 nil means use format `var'. This variable is meaningful only on VMS.");
4114 vms_stmlf_recfm
= 0;
4116 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4117 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4118 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4121 The first argument given to HANDLER is the name of the I/O primitive\n\
4122 to be handled; the remaining arguments are the arguments that were\n\
4123 passed to that primitive. For example, if you do\n\
4124 (file-exists-p FILENAME)\n\
4125 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4126 (funcall HANDLER 'file-exists-p FILENAME)\n\
4127 The function `find-file-name-handler' checks this list for a handler\n\
4128 for its argument.");
4129 Vfile_name_handler_alist
= Qnil
;
4131 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4132 "A list of functions to be called at the end of `insert-file-contents'.\n\
4133 Each is passed one argument, the number of bytes inserted. It should return\n\
4134 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4135 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4136 responsible for calling the after-insert-file-functions if appropriate.");
4137 Vafter_insert_file_functions
= Qnil
;
4139 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4140 "A list of functions to be called at the start of `write-region'.\n\
4141 Each is passed two arguments, START and END as for `write-region'. It should\n\
4142 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4143 inserted at the specified positions of the file being written (1 means to\n\
4144 insert before the first byte written). The POSITIONs must be sorted into\n\
4145 increasing order. If there are several functions in the list, the several\n\
4146 lists are merged destructively.");
4147 Vwrite_region_annotate_functions
= Qnil
;
4149 DEFVAR_LISP ("write-region-annotations-so-far",
4150 &Vwrite_region_annotations_so_far
,
4151 "When an annotation function is called, this holds the previous annotations.\n\
4152 These are the annotations made by other annotation functions\n\
4153 that were already called. See also `write-region-annotate-functions'.");
4154 Vwrite_region_annotations_so_far
= Qnil
;
4156 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4157 "A list of file name handlers that temporarily should not be used.\n\
4158 This applies only to the operation `inhibit-file-name-operation'.");
4159 Vinhibit_file_name_handlers
= Qnil
;
4161 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4162 "The operation for which `inhibit-file-name-handlers' is applicable.");
4163 Vinhibit_file_name_operation
= Qnil
;
4165 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4166 "File name in which we write a list of all auto save file names.");
4167 Vauto_save_list_file_name
= Qnil
;
4169 defsubr (&Sfind_file_name_handler
);
4170 defsubr (&Sfile_name_directory
);
4171 defsubr (&Sfile_name_nondirectory
);
4172 defsubr (&Sunhandled_file_name_directory
);
4173 defsubr (&Sfile_name_as_directory
);
4174 defsubr (&Sdirectory_file_name
);
4175 defsubr (&Smake_temp_name
);
4176 defsubr (&Sexpand_file_name
);
4177 defsubr (&Ssubstitute_in_file_name
);
4178 defsubr (&Scopy_file
);
4179 defsubr (&Smake_directory_internal
);
4180 defsubr (&Sdelete_directory
);
4181 defsubr (&Sdelete_file
);
4182 defsubr (&Srename_file
);
4183 defsubr (&Sadd_name_to_file
);
4185 defsubr (&Smake_symbolic_link
);
4186 #endif /* S_IFLNK */
4188 defsubr (&Sdefine_logical_name
);
4191 defsubr (&Ssysnetunam
);
4192 #endif /* HPUX_NET */
4193 defsubr (&Sfile_name_absolute_p
);
4194 defsubr (&Sfile_exists_p
);
4195 defsubr (&Sfile_executable_p
);
4196 defsubr (&Sfile_readable_p
);
4197 defsubr (&Sfile_writable_p
);
4198 defsubr (&Sfile_symlink_p
);
4199 defsubr (&Sfile_directory_p
);
4200 defsubr (&Sfile_accessible_directory_p
);
4201 defsubr (&Sfile_modes
);
4202 defsubr (&Sset_file_modes
);
4203 defsubr (&Sset_default_file_modes
);
4204 defsubr (&Sdefault_file_modes
);
4205 defsubr (&Sfile_newer_than_file_p
);
4206 defsubr (&Sinsert_file_contents
);
4207 defsubr (&Swrite_region
);
4208 defsubr (&Scar_less_than_car
);
4209 defsubr (&Sverify_visited_file_modtime
);
4210 defsubr (&Sclear_visited_file_modtime
);
4211 defsubr (&Svisited_file_modtime
);
4212 defsubr (&Sset_visited_file_modtime
);
4213 defsubr (&Sdo_auto_save
);
4214 defsubr (&Sset_buffer_auto_saved
);
4215 defsubr (&Sclear_buffer_auto_save_failure
);
4216 defsubr (&Srecent_auto_save_p
);
4218 defsubr (&Sread_file_name_internal
);
4219 defsubr (&Sread_file_name
);
4222 defsubr (&Sunix_sync
);