1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993 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>
44 extern char *sys_errlist
[];
48 #define err_str(a) ((a) < sys_nerr ? sys_errlist[a] : "unknown error")
63 #include "intervals.h"
87 #define min(a, b) ((a) < (b) ? (a) : (b))
88 #define max(a, b) ((a) > (b) ? (a) : (b))
90 /* Nonzero during writing of auto-save files */
93 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
94 a new file with the same mode as the original */
95 int auto_save_mode_bits
;
97 /* Alist of elements (REGEXP . HANDLER) for file names
98 whose I/O is done with a special handler. */
99 Lisp_Object Vfile_name_handler_alist
;
101 /* Nonzero means, when reading a filename in the minibuffer,
102 start out by inserting the default directory into the minibuffer. */
103 int insert_default_directory
;
105 /* On VMS, nonzero means write new files with record format stmlf.
106 Zero means use var format. */
109 Lisp_Object Qfile_error
, Qfile_already_exists
;
111 Lisp_Object Qfile_name_history
;
113 report_file_error (string
, data
)
117 Lisp_Object errstring
;
119 if (errno
>= 0 && errno
< sys_nerr
)
120 errstring
= build_string (sys_errlist
[errno
]);
122 errstring
= build_string ("undocumented error code");
124 /* System error messages are capitalized. Downcase the initial
125 unless it is followed by a slash. */
126 if (XSTRING (errstring
)->data
[1] != '/')
127 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
130 Fsignal (Qfile_error
,
131 Fcons (build_string (string
), Fcons (errstring
, data
)));
134 close_file_unwind (fd
)
137 close (XFASTINT (fd
));
140 Lisp_Object Qexpand_file_name
;
141 Lisp_Object Qdirectory_file_name
;
142 Lisp_Object Qfile_name_directory
;
143 Lisp_Object Qfile_name_nondirectory
;
144 Lisp_Object Qunhandled_file_name_directory
;
145 Lisp_Object Qfile_name_as_directory
;
146 Lisp_Object Qcopy_file
;
147 Lisp_Object Qmake_directory
;
148 Lisp_Object Qdelete_directory
;
149 Lisp_Object Qdelete_file
;
150 Lisp_Object Qrename_file
;
151 Lisp_Object Qadd_name_to_file
;
152 Lisp_Object Qmake_symbolic_link
;
153 Lisp_Object Qfile_exists_p
;
154 Lisp_Object Qfile_executable_p
;
155 Lisp_Object Qfile_readable_p
;
156 Lisp_Object Qfile_symlink_p
;
157 Lisp_Object Qfile_writable_p
;
158 Lisp_Object Qfile_directory_p
;
159 Lisp_Object Qfile_accessible_directory_p
;
160 Lisp_Object Qfile_modes
;
161 Lisp_Object Qset_file_modes
;
162 Lisp_Object Qfile_newer_than_file_p
;
163 Lisp_Object Qinsert_file_contents
;
164 Lisp_Object Qwrite_region
;
165 Lisp_Object Qverify_visited_file_modtime
;
167 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 1, 1, 0,
168 "Return FILENAME's handler function, if its syntax is handled specially.\n\
169 Otherwise, return nil.\n\
170 A file name is handled if one of the regular expressions in\n\
171 `file-name-handler-alist' matches it.")
173 Lisp_Object filename
;
175 /* This function must not munge the match data. */
177 CHECK_STRING (filename
, 0);
180 for (chain
= Vfile_name_handler_alist
; XTYPE (chain
) == Lisp_Cons
;
181 chain
= XCONS (chain
)->cdr
)
184 elt
= XCONS (chain
)->car
;
185 if (XTYPE (elt
) == Lisp_Cons
)
188 string
= XCONS (elt
)->car
;
189 if (XTYPE (string
) == Lisp_String
190 && fast_string_match (string
, filename
) >= 0)
191 return XCONS (elt
)->cdr
;
199 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
201 "Return the directory component in file name NAME.\n\
202 Return nil if NAME does not include a directory.\n\
203 Otherwise return a directory spec.\n\
204 Given a Unix syntax file name, returns a string ending in slash;\n\
205 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
209 register unsigned char *beg
;
210 register unsigned char *p
;
213 CHECK_STRING (file
, 0);
215 /* If the file name has special constructs in it,
216 call the corresponding file handler. */
217 handler
= Ffind_file_name_handler (file
);
219 return call2 (handler
, Qfile_name_directory
, file
);
221 beg
= XSTRING (file
)->data
;
222 p
= beg
+ XSTRING (file
)->size
;
224 while (p
!= beg
&& p
[-1] != '/'
226 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
232 return make_string (beg
, p
- beg
);
235 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
237 "Return file name NAME sans its directory.\n\
238 For example, in a Unix-syntax file name,\n\
239 this is everything after the last slash,\n\
240 or the entire name if it contains no slash.")
244 register unsigned char *beg
, *p
, *end
;
247 CHECK_STRING (file
, 0);
249 /* If the file name has special constructs in it,
250 call the corresponding file handler. */
251 handler
= Ffind_file_name_handler (file
);
253 return call2 (handler
, Qfile_name_nondirectory
, file
);
255 beg
= XSTRING (file
)->data
;
256 end
= p
= beg
+ XSTRING (file
)->size
;
258 while (p
!= beg
&& p
[-1] != '/'
260 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
264 return make_string (p
, end
- p
);
267 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
268 "Return a directly usable directory name somehow associated with FILENAME.\n\
269 A `directly usable' directory name is one that may be used without the\n\
270 intervention of any file handler.\n\
271 If FILENAME is a directly usable file itself, return\n\
272 (file-name-directory FILENAME).\n\
273 The `call-process' and `start-process' functions use this function to\n\
274 get a current directory to run processes in.")
276 Lisp_Object filename
;
280 /* If the file name has special constructs in it,
281 call the corresponding file handler. */
282 handler
= Ffind_file_name_handler (filename
);
284 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
286 return Ffile_name_directory (filename
);
291 file_name_as_directory (out
, in
)
294 int size
= strlen (in
) - 1;
299 /* Is it already a directory string? */
300 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
302 /* Is it a VMS directory file name? If so, hack VMS syntax. */
303 else if (! index (in
, '/')
304 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
305 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
306 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
307 || ! strncmp (&in
[size
- 5], ".dir", 4))
308 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
309 && in
[size
] == '1')))
311 register char *p
, *dot
;
315 dir:x.dir --> dir:[x]
316 dir:[x]y.dir --> dir:[x.y] */
318 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
321 strncpy (out
, in
, p
- in
);
340 dot
= index (p
, '.');
343 /* blindly remove any extension */
344 size
= strlen (out
) + (dot
- p
);
345 strncat (out
, p
, dot
- p
);
356 /* For Unix syntax, Append a slash if necessary */
357 if (out
[size
] != '/')
363 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
364 Sfile_name_as_directory
, 1, 1, 0,
365 "Return a string representing file FILENAME interpreted as a directory.\n\
366 This operation exists because a directory is also a file, but its name as\n\
367 a directory is different from its name as a file.\n\
368 The result can be used as the value of `default-directory'\n\
369 or passed as second argument to `expand-file-name'.\n\
370 For a Unix-syntax file name, just appends a slash.\n\
371 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
378 CHECK_STRING (file
, 0);
382 /* If the file name has special constructs in it,
383 call the corresponding file handler. */
384 handler
= Ffind_file_name_handler (file
);
386 return call2 (handler
, Qfile_name_as_directory
, file
);
388 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
389 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
393 * Convert from directory name to filename.
395 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
396 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
397 * On UNIX, it's simple: just make sure there is a terminating /
399 * Value is nonzero if the string output is different from the input.
402 directory_file_name (src
, dst
)
410 struct FAB fab
= cc$rms_fab
;
411 struct NAM nam
= cc$rms_nam
;
412 char esa
[NAM$C_MAXRSS
];
417 if (! index (src
, '/')
418 && (src
[slen
- 1] == ']'
419 || src
[slen
- 1] == ':'
420 || src
[slen
- 1] == '>'))
422 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
424 fab
.fab$b_fns
= slen
;
425 fab
.fab$l_nam
= &nam
;
426 fab
.fab$l_fop
= FAB$M_NAM
;
429 nam
.nam$b_ess
= sizeof esa
;
430 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
432 /* We call SYS$PARSE to handle such things as [--] for us. */
433 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
435 slen
= nam
.nam$b_esl
;
436 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
441 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
443 /* what about when we have logical_name:???? */
444 if (src
[slen
- 1] == ':')
445 { /* Xlate logical name and see what we get */
446 ptr
= strcpy (dst
, src
); /* upper case for getenv */
449 if ('a' <= *ptr
&& *ptr
<= 'z')
453 dst
[slen
- 1] = 0; /* remove colon */
454 if (!(src
= egetenv (dst
)))
456 /* should we jump to the beginning of this procedure?
457 Good points: allows us to use logical names that xlate
459 Bad points: can be a problem if we just translated to a device
461 For now, I'll punt and always expect VMS names, and hope for
464 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
465 { /* no recursion here! */
471 { /* not a directory spec */
476 bracket
= src
[slen
- 1];
478 /* If bracket is ']' or '>', bracket - 2 is the corresponding
480 ptr
= index (src
, bracket
- 2);
482 { /* no opening bracket */
486 if (!(rptr
= rindex (src
, '.')))
489 strncpy (dst
, src
, slen
);
493 dst
[slen
++] = bracket
;
498 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
499 then translate the device and recurse. */
500 if (dst
[slen
- 1] == ':'
501 && dst
[slen
- 2] != ':' /* skip decnet nodes */
502 && strcmp(src
+ slen
, "[000000]") == 0)
504 dst
[slen
- 1] = '\0';
505 if ((ptr
= egetenv (dst
))
506 && (rlen
= strlen (ptr
) - 1) > 0
507 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
508 && ptr
[rlen
- 1] == '.')
510 char * buf
= (char *) alloca (strlen (ptr
) + 1);
514 return directory_file_name (buf
, dst
);
519 strcat (dst
, "[000000]");
523 rlen
= strlen (rptr
) - 1;
524 strncat (dst
, rptr
, rlen
);
525 dst
[slen
+ rlen
] = '\0';
526 strcat (dst
, ".DIR.1");
530 /* Process as Unix format: just remove any final slash.
531 But leave "/" unchanged; do not change it to "". */
533 if (slen
> 1 && dst
[slen
- 1] == '/')
538 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
540 "Returns the file name of the directory named DIR.\n\
541 This is the name of the file that holds the data for the directory DIR.\n\
542 This operation exists because a directory is also a file, but its name as\n\
543 a directory is different from its name as a file.\n\
544 In Unix-syntax, this function just removes the final slash.\n\
545 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
546 it returns a file name such as \"[X]Y.DIR.1\".")
548 Lisp_Object directory
;
553 CHECK_STRING (directory
, 0);
555 if (NILP (directory
))
558 /* If the file name has special constructs in it,
559 call the corresponding file handler. */
560 handler
= Ffind_file_name_handler (directory
);
562 return call2 (handler
, Qdirectory_file_name
, directory
);
565 /* 20 extra chars is insufficient for VMS, since we might perform a
566 logical name translation. an equivalence string can be up to 255
567 chars long, so grab that much extra space... - sss */
568 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
570 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
572 directory_file_name (XSTRING (directory
)->data
, buf
);
573 return build_string (buf
);
576 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
577 "Generate temporary file name (string) starting with PREFIX (a string).\n\
578 The Emacs process number forms part of the result,\n\
579 so there is no danger of generating a name being used by another process.")
584 val
= concat2 (prefix
, build_string ("XXXXXX"));
585 mktemp (XSTRING (val
)->data
);
589 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
590 "Convert FILENAME to absolute, and canonicalize it.\n\
591 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
592 (does not start with slash); if DEFAULT is nil or missing,\n\
593 the current buffer's value of default-directory is used.\n\
594 Path components that are `.' are removed, and \n\
595 path components followed by `..' are removed, along with the `..' itself;\n\
596 note that these simplifications are done without checking the resulting\n\
597 paths in the file system.\n\
598 An initial `~/' expands to your home directory.\n\
599 An initial `~USER/' expands to USER's home directory.\n\
600 See also the function `substitute-in-file-name'.")
602 Lisp_Object name
, defalt
;
606 register unsigned char *newdir
, *p
, *o
;
608 unsigned char *target
;
611 unsigned char * colon
= 0;
612 unsigned char * close
= 0;
613 unsigned char * slash
= 0;
614 unsigned char * brack
= 0;
615 int lbrack
= 0, rbrack
= 0;
620 CHECK_STRING (name
, 0);
622 /* If the file name has special constructs in it,
623 call the corresponding file handler. */
624 handler
= Ffind_file_name_handler (name
);
626 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
628 /* Use the buffer's default-directory if DEFALT is omitted. */
630 defalt
= current_buffer
->directory
;
631 CHECK_STRING (defalt
, 1);
633 /* Make sure DEFALT is properly expanded.
634 It would be better to do this down below where we actually use
635 defalt. Unfortunately, calling Fexpand_file_name recursively
636 could invoke GC, and the strings might be relocated. This would
637 be annoying because we have pointers into strings lying around
638 that would need adjusting, and people would add new pointers to
639 the code and forget to adjust them, resulting in intermittent bugs.
640 Putting this call here avoids all that crud.
642 The EQ test avoids infinite recursion. */
643 if (! NILP (defalt
) && !EQ (defalt
, name
)
644 /* This saves time in a common case. */
645 && XSTRING (defalt
)->data
[0] != '/')
650 defalt
= Fexpand_file_name (defalt
, Qnil
);
655 /* Filenames on VMS are always upper case. */
656 name
= Fupcase (name
);
659 nm
= XSTRING (name
)->data
;
661 /* If nm is absolute, flush ...// and detect /./ and /../.
662 If no /./ or /../ we can return right away. */
670 /* If it turns out that the filename we want to return is just a
671 suffix of FILENAME, we don't need to go through and edit
672 things; we just need to construct a new string using data
673 starting at the middle of FILENAME. If we set lose to a
674 non-zero value, that means we've discovered that we can't do
681 /* Since we know the path is absolute, we can assume that each
682 element starts with a "/". */
684 /* "//" anywhere isn't necessarily hairy; we just start afresh
685 with the second slash. */
686 if (p
[0] == '/' && p
[1] == '/'
688 /* // at start of filename is meaningful on Apollo system */
694 /* "~" is hairy as the start of any path element. */
695 if (p
[0] == '/' && p
[1] == '~')
696 nm
= p
+ 1, lose
= 1;
698 /* "." and ".." are hairy. */
703 || (p
[2] == '.' && (p
[3] == '/'
710 /* if dev:[dir]/, move nm to / */
711 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
712 nm
= (brack
? brack
+ 1 : colon
+ 1);
721 /* VMS pre V4.4,convert '-'s in filenames. */
722 if (lbrack
== rbrack
)
724 if (dots
< 2) /* this is to allow negative version numbers */
729 if (lbrack
> rbrack
&&
730 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
731 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
737 /* count open brackets, reset close bracket pointer */
738 if (p
[0] == '[' || p
[0] == '<')
740 /* count close brackets, set close bracket pointer */
741 if (p
[0] == ']' || p
[0] == '>')
743 /* detect ][ or >< */
744 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
746 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
747 nm
= p
+ 1, lose
= 1;
748 if (p
[0] == ':' && (colon
|| slash
))
749 /* if dev1:[dir]dev2:, move nm to dev2: */
755 /* if /pathname/dev:, move nm to dev: */
758 /* if node::dev:, move colon following dev */
759 else if (colon
&& colon
[-1] == ':')
761 /* if dev1:dev2:, move nm to dev2: */
762 else if (colon
&& colon
[-1] != ':')
767 if (p
[0] == ':' && !colon
)
773 if (lbrack
== rbrack
)
776 else if (p
[0] == '.')
785 return build_string (sys_translate_unix (nm
));
787 if (nm
== XSTRING (name
)->data
)
789 return build_string (nm
);
793 /* Now determine directory to start with and put it in newdir */
797 if (nm
[0] == '~') /* prefix ~ */
803 || nm
[1] == 0) /* ~ by itself */
805 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
806 newdir
= (unsigned char *) "";
809 nm
++; /* Don't leave the slash in nm. */
812 else /* ~user/filename */
814 for (p
= nm
; *p
&& (*p
!= '/'
819 o
= (unsigned char *) alloca (p
- nm
+ 1);
820 bcopy ((char *) nm
, o
, p
- nm
);
823 pw
= (struct passwd
*) getpwnam (o
+ 1);
826 newdir
= (unsigned char *) pw
-> pw_dir
;
828 nm
= p
+ 1; /* skip the terminator */
834 /* If we don't find a user of that name, leave the name
835 unchanged; don't move nm forward to p. */
845 newdir
= XSTRING (defalt
)->data
;
850 /* Get rid of any slash at the end of newdir. */
851 int length
= strlen (newdir
);
852 /* Adding `length > 1 &&' makes ~ expand into / when homedir
853 is the root dir. People disagree about whether that is right.
854 Anyway, we can't take the risk of this change now. */
855 if (newdir
[length
- 1] == '/')
857 unsigned char *temp
= (unsigned char *) alloca (length
);
858 bcopy (newdir
, temp
, length
- 1);
859 temp
[length
- 1] = 0;
867 /* Now concatenate the directory and name to new space in the stack frame */
868 tlen
+= strlen (nm
) + 1;
869 target
= (unsigned char *) alloca (tlen
);
875 if (nm
[0] == 0 || nm
[0] == '/')
876 strcpy (target
, newdir
);
879 file_name_as_directory (target
, newdir
);
884 if (index (target
, '/'))
885 strcpy (target
, sys_translate_unix (target
));
888 /* Now canonicalize by removing /. and /foo/.. if they appear. */
896 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
902 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
903 /* brackets are offset from each other by 2 */
906 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
907 /* convert [foo][bar] to [bar] */
908 while (o
[-1] != '[' && o
[-1] != '<')
910 else if (*p
== '-' && *o
!= '.')
913 else if (p
[0] == '-' && o
[-1] == '.' &&
914 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
915 /* flush .foo.- ; leave - if stopped by '[' or '<' */
919 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
920 if (p
[1] == '.') /* foo.-.bar ==> bar*/
922 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
924 /* else [foo.-] ==> [-] */
930 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
931 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
941 else if (!strncmp (p
, "//", 2)
943 /* // at start of filename is meaningful in Apollo system */
956 /* If "/." is the entire filename, keep the "/". Otherwise,
957 just delete the whole "/.". */
958 if (o
== target
&& p
[2] == '\0')
962 else if (!strncmp (p
, "/..", 3)
963 /* `/../' is the "superroot" on certain file systems. */
965 && (p
[3] == '/' || p
[3] == 0))
967 while (o
!= target
&& *--o
!= '/')
970 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
974 if (o
== target
&& *o
== '/')
985 return make_string (target
, o
- target
);
988 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
989 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
990 "Convert FILENAME to absolute, and canonicalize it.\n\
991 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
992 (does not start with slash); if DEFAULT is nil or missing,\n\
993 the current buffer's value of default-directory is used.\n\
994 Filenames containing `.' or `..' as components are simplified;\n\
995 initial `~/' expands to your home directory.\n\
996 See also the function `substitute-in-file-name'.")
998 Lisp_Object name, defalt;
1002 register unsigned char *newdir, *p, *o;
1004 unsigned char *target;
1008 unsigned char * colon = 0;
1009 unsigned char * close = 0;
1010 unsigned char * slash = 0;
1011 unsigned char * brack = 0;
1012 int lbrack = 0, rbrack = 0;
1016 CHECK_STRING (name
, 0);
1019 /* Filenames on VMS are always upper case. */
1020 name
= Fupcase (name
);
1023 nm
= XSTRING (name
)->data
;
1025 /* If nm is absolute, flush ...// and detect /./ and /../.
1026 If no /./ or /../ we can return right away. */
1038 if (p
[0] == '/' && p
[1] == '/'
1040 /* // at start of filename is meaningful on Apollo system */
1045 if (p
[0] == '/' && p
[1] == '~')
1046 nm
= p
+ 1, lose
= 1;
1047 if (p
[0] == '/' && p
[1] == '.'
1048 && (p
[2] == '/' || p
[2] == 0
1049 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1055 /* if dev:[dir]/, move nm to / */
1056 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1057 nm
= (brack
? brack
+ 1 : colon
+ 1);
1058 lbrack
= rbrack
= 0;
1066 /* VMS pre V4.4,convert '-'s in filenames. */
1067 if (lbrack
== rbrack
)
1069 if (dots
< 2) /* this is to allow negative version numbers */
1074 if (lbrack
> rbrack
&&
1075 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1076 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1082 /* count open brackets, reset close bracket pointer */
1083 if (p
[0] == '[' || p
[0] == '<')
1084 lbrack
++, brack
= 0;
1085 /* count close brackets, set close bracket pointer */
1086 if (p
[0] == ']' || p
[0] == '>')
1087 rbrack
++, brack
= p
;
1088 /* detect ][ or >< */
1089 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1091 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1092 nm
= p
+ 1, lose
= 1;
1093 if (p
[0] == ':' && (colon
|| slash
))
1094 /* if dev1:[dir]dev2:, move nm to dev2: */
1100 /* if /pathname/dev:, move nm to dev: */
1103 /* if node::dev:, move colon following dev */
1104 else if (colon
&& colon
[-1] == ':')
1106 /* if dev1:dev2:, move nm to dev2: */
1107 else if (colon
&& colon
[-1] != ':')
1112 if (p
[0] == ':' && !colon
)
1118 if (lbrack
== rbrack
)
1121 else if (p
[0] == '.')
1129 if (index (nm
, '/'))
1130 return build_string (sys_translate_unix (nm
));
1132 if (nm
== XSTRING (name
)->data
)
1134 return build_string (nm
);
1138 /* Now determine directory to start with and put it in NEWDIR */
1142 if (nm
[0] == '~') /* prefix ~ */
1147 || nm
[1] == 0)/* ~/filename */
1149 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1150 newdir
= (unsigned char *) "";
1153 nm
++; /* Don't leave the slash in nm. */
1156 else /* ~user/filename */
1158 /* Get past ~ to user */
1159 unsigned char *user
= nm
+ 1;
1160 /* Find end of name. */
1161 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1162 int len
= ptr
? ptr
- user
: strlen (user
);
1164 unsigned char *ptr1
= index (user
, ':');
1165 if (ptr1
!= 0 && ptr1
- user
< len
)
1168 /* Copy the user name into temp storage. */
1169 o
= (unsigned char *) alloca (len
+ 1);
1170 bcopy ((char *) user
, o
, len
);
1173 /* Look up the user name. */
1174 pw
= (struct passwd
*) getpwnam (o
+ 1);
1176 error ("\"%s\" isn't a registered user", o
+ 1);
1178 newdir
= (unsigned char *) pw
->pw_dir
;
1180 /* Discard the user name from NM. */
1187 #endif /* not VMS */
1191 defalt
= current_buffer
->directory
;
1192 CHECK_STRING (defalt
, 1);
1193 newdir
= XSTRING (defalt
)->data
;
1196 /* Now concatenate the directory and name to new space in the stack frame */
1198 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1199 target
= (unsigned char *) alloca (tlen
);
1205 if (nm
[0] == 0 || nm
[0] == '/')
1206 strcpy (target
, newdir
);
1209 file_name_as_directory (target
, newdir
);
1212 strcat (target
, nm
);
1214 if (index (target
, '/'))
1215 strcpy (target
, sys_translate_unix (target
));
1218 /* Now canonicalize by removing /. and /foo/.. if they appear */
1226 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1232 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1233 /* brackets are offset from each other by 2 */
1236 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1237 /* convert [foo][bar] to [bar] */
1238 while (o
[-1] != '[' && o
[-1] != '<')
1240 else if (*p
== '-' && *o
!= '.')
1243 else if (p
[0] == '-' && o
[-1] == '.' &&
1244 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1245 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1249 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1250 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1252 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1254 /* else [foo.-] ==> [-] */
1260 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1261 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1271 else if (!strncmp (p
, "//", 2)
1273 /* // at start of filename is meaningful in Apollo system */
1281 else if (p
[0] == '/' && p
[1] == '.' &&
1282 (p
[2] == '/' || p
[2] == 0))
1284 else if (!strncmp (p
, "/..", 3)
1285 /* `/../' is the "superroot" on certain file systems. */
1287 && (p
[3] == '/' || p
[3] == 0))
1289 while (o
!= target
&& *--o
!= '/')
1292 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1296 if (o
== target
&& *o
== '/')
1304 #endif /* not VMS */
1307 return make_string (target
, o
- target
);
1311 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1312 Ssubstitute_in_file_name
, 1, 1, 0,
1313 "Substitute environment variables referred to in FILENAME.\n\
1314 `$FOO' where FOO is an environment variable name means to substitute\n\
1315 the value of that variable. The variable name should be terminated\n\
1316 with a character not a letter, digit or underscore; otherwise, enclose\n\
1317 the entire variable name in braces.\n\
1318 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1319 On VMS, `$' substitution is not done; this function does little and only\n\
1320 duplicates what `expand-file-name' does.")
1326 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1327 unsigned char *target
;
1329 int substituted
= 0;
1332 CHECK_STRING (string
, 0);
1334 nm
= XSTRING (string
)->data
;
1335 endp
= nm
+ XSTRING (string
)->size
;
1337 /* If /~ or // appears, discard everything through first slash. */
1339 for (p
= nm
; p
!= endp
; p
++)
1343 /* // at start of file name is meaningful in Apollo system */
1344 (p
[0] == '/' && p
- 1 != nm
)
1345 #else /* not APOLLO */
1347 #endif /* not APOLLO */
1351 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1364 return build_string (nm
);
1367 /* See if any variables are substituted into the string
1368 and find the total length of their values in `total' */
1370 for (p
= nm
; p
!= endp
;)
1380 /* "$$" means a single "$" */
1389 while (p
!= endp
&& *p
!= '}') p
++;
1390 if (*p
!= '}') goto missingclose
;
1396 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1400 /* Copy out the variable name */
1401 target
= (unsigned char *) alloca (s
- o
+ 1);
1402 strncpy (target
, o
, s
- o
);
1405 /* Get variable value */
1406 o
= (unsigned char *) egetenv (target
);
1407 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1410 if (!o
&& !strcmp (target
, "USER"))
1411 o
= egetenv ("LOGNAME");
1414 if (!o
) goto badvar
;
1415 total
+= strlen (o
);
1422 /* If substitution required, recopy the string and do it */
1423 /* Make space in stack frame for the new copy */
1424 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1427 /* Copy the rest of the name through, replacing $ constructs with values */
1444 while (p
!= endp
&& *p
!= '}') p
++;
1445 if (*p
!= '}') goto missingclose
;
1451 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1455 /* Copy out the variable name */
1456 target
= (unsigned char *) alloca (s
- o
+ 1);
1457 strncpy (target
, o
, s
- o
);
1460 /* Get variable value */
1461 o
= (unsigned char *) egetenv (target
);
1462 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1465 if (!o
&& !strcmp (target
, "USER"))
1466 o
= egetenv ("LOGNAME");
1478 /* If /~ or // appears, discard everything through first slash. */
1480 for (p
= xnm
; p
!= x
; p
++)
1483 /* // at start of file name is meaningful in Apollo system */
1484 (p
[0] == '/' && p
- 1 != xnm
)
1485 #else /* not APOLLO */
1487 #endif /* not APOLLO */
1489 && p
!= nm
&& p
[-1] == '/')
1492 return make_string (xnm
, x
- xnm
);
1495 error ("Bad format environment-variable substitution");
1497 error ("Missing \"}\" in environment-variable substitution");
1499 error ("Substituting nonexistent environment variable \"%s\"", target
);
1502 #endif /* not VMS */
1505 /* A slightly faster and more convenient way to get
1506 (directory-file-name (expand-file-name FOO)). The return value may
1507 have had its last character zapped with a '\0' character, meaning
1508 that it is acceptable to system calls, but not to other lisp
1509 functions. Callers should make sure that the return value doesn't
1513 expand_and_dir_to_file (filename
, defdir
)
1514 Lisp_Object filename
, defdir
;
1516 register Lisp_Object abspath
;
1518 abspath
= Fexpand_file_name (filename
, defdir
);
1521 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1522 if (c
== ':' || c
== ']' || c
== '>')
1523 abspath
= Fdirectory_file_name (abspath
);
1526 /* Remove final slash, if any (unless path is root).
1527 stat behaves differently depending! */
1528 if (XSTRING (abspath
)->size
> 1
1529 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1531 if (EQ (abspath
, filename
))
1532 abspath
= Fcopy_sequence (abspath
);
1533 XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] = 0;
1539 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1540 Lisp_Object absname
;
1541 unsigned char *querystring
;
1544 register Lisp_Object tem
;
1545 struct gcpro gcpro1
;
1547 if (access (XSTRING (absname
)->data
, 4) >= 0)
1550 Fsignal (Qfile_already_exists
,
1551 Fcons (build_string ("File already exists"),
1552 Fcons (absname
, Qnil
)));
1554 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1555 XSTRING (absname
)->data
, querystring
));
1558 Fsignal (Qfile_already_exists
,
1559 Fcons (build_string ("File already exists"),
1560 Fcons (absname
, Qnil
)));
1565 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1566 "fCopy file: \nFCopy %s to file: \np\nP",
1567 "Copy FILE to NEWNAME. Both args must be strings.\n\
1568 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1569 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1570 A number as third arg means request confirmation if NEWNAME already exists.\n\
1571 This is what happens in interactive use with M-x.\n\
1572 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1573 last-modified time as the old one. (This works on only some systems.)\n\
1574 A prefix arg makes KEEP-TIME non-nil.")
1575 (filename
, newname
, ok_if_already_exists
, keep_date
)
1576 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1579 char buf
[16 * 1024];
1581 Lisp_Object handler
;
1582 struct gcpro gcpro1
, gcpro2
;
1583 int count
= specpdl_ptr
- specpdl
;
1585 GCPRO2 (filename
, newname
);
1586 CHECK_STRING (filename
, 0);
1587 CHECK_STRING (newname
, 1);
1588 filename
= Fexpand_file_name (filename
, Qnil
);
1589 newname
= Fexpand_file_name (newname
, Qnil
);
1591 /* If the input file name has special constructs in it,
1592 call the corresponding file handler. */
1593 handler
= Ffind_file_name_handler (filename
);
1594 if (!NILP (handler
))
1595 return call3 (handler
, Qcopy_file
, filename
, newname
);
1596 /* Likewise for output file name. */
1597 handler
= Ffind_file_name_handler (newname
);
1598 if (!NILP (handler
))
1599 return call3 (handler
, Qcopy_file
, filename
, newname
);
1601 if (NILP (ok_if_already_exists
)
1602 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1603 barf_or_query_if_file_exists (newname
, "copy to it",
1604 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1606 ifd
= open (XSTRING (filename
)->data
, 0);
1608 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1610 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1613 /* Create the copy file with the same record format as the input file */
1614 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1616 ofd
= creat (XSTRING (newname
)->data
, 0666);
1619 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1621 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1625 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1626 if (write (ofd
, buf
, n
) != n
)
1627 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1630 if (fstat (ifd
, &st
) >= 0)
1632 if (!NILP (keep_date
))
1634 EMACS_TIME atime
, mtime
;
1635 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1636 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1637 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1640 if (!egetenv ("USE_DOMAIN_ACLS"))
1642 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1645 /* Discard the unwind protects. */
1646 specpdl_ptr
= specpdl
+ count
;
1649 if (close (ofd
) < 0)
1650 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1656 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1657 Smake_directory_internal
, 1, 1, 0,
1658 "Create a directory. One argument, a file name string.")
1660 Lisp_Object dirname
;
1663 Lisp_Object handler
;
1665 CHECK_STRING (dirname
, 0);
1666 dirname
= Fexpand_file_name (dirname
, Qnil
);
1668 handler
= Ffind_file_name_handler (dirname
);
1669 if (!NILP (handler
))
1670 return call3 (handler
, Qmake_directory
, dirname
, Qnil
);
1672 dir
= XSTRING (dirname
)->data
;
1674 if (mkdir (dir
, 0777) != 0)
1675 report_file_error ("Creating directory", Flist (1, &dirname
));
1680 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1681 "Delete a directory. One argument, a file name string.")
1683 Lisp_Object dirname
;
1686 Lisp_Object handler
;
1688 CHECK_STRING (dirname
, 0);
1689 dirname
= Fexpand_file_name (dirname
, Qnil
);
1690 dir
= XSTRING (dirname
)->data
;
1692 handler
= Ffind_file_name_handler (dirname
);
1693 if (!NILP (handler
))
1694 return call2 (handler
, Qdelete_directory
, dirname
);
1696 if (rmdir (dir
) != 0)
1697 report_file_error ("Removing directory", Flist (1, &dirname
));
1702 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1703 "Delete specified file. One argument, a file name string.\n\
1704 If file has multiple names, it continues to exist with the other names.")
1706 Lisp_Object filename
;
1708 Lisp_Object handler
;
1709 CHECK_STRING (filename
, 0);
1710 filename
= Fexpand_file_name (filename
, Qnil
);
1712 handler
= Ffind_file_name_handler (filename
);
1713 if (!NILP (handler
))
1714 return call2 (handler
, Qdelete_file
, filename
);
1716 if (0 > unlink (XSTRING (filename
)->data
))
1717 report_file_error ("Removing old name", Flist (1, &filename
));
1721 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1722 "fRename file: \nFRename %s to file: \np",
1723 "Rename FILE as NEWNAME. Both args strings.\n\
1724 If file has names other than FILE, it continues to have those names.\n\
1725 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1726 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1727 A number as third arg means request confirmation if NEWNAME already exists.\n\
1728 This is what happens in interactive use with M-x.")
1729 (filename
, newname
, ok_if_already_exists
)
1730 Lisp_Object filename
, newname
, ok_if_already_exists
;
1733 Lisp_Object args
[2];
1735 Lisp_Object handler
;
1736 struct gcpro gcpro1
, gcpro2
;
1738 GCPRO2 (filename
, newname
);
1739 CHECK_STRING (filename
, 0);
1740 CHECK_STRING (newname
, 1);
1741 filename
= Fexpand_file_name (filename
, Qnil
);
1742 newname
= Fexpand_file_name (newname
, Qnil
);
1744 /* If the file name has special constructs in it,
1745 call the corresponding file handler. */
1746 handler
= Ffind_file_name_handler (filename
);
1747 if (!NILP (handler
))
1748 return call3 (handler
, Qrename_file
, filename
, newname
);
1750 if (NILP (ok_if_already_exists
)
1751 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1752 barf_or_query_if_file_exists (newname
, "rename to it",
1753 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1755 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1757 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1758 || 0 > unlink (XSTRING (filename
)->data
))
1763 Fcopy_file (filename
, newname
, ok_if_already_exists
, Qt
);
1764 Fdelete_file (filename
);
1771 report_file_error ("Renaming", Flist (2, args
));
1774 report_file_error ("Renaming", Flist (2, &filename
));
1781 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1782 "fAdd name to file: \nFName to add to %s: \np",
1783 "Give FILE additional name NEWNAME. Both args strings.\n\
1784 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1785 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1786 A number as third arg means request confirmation if NEWNAME already exists.\n\
1787 This is what happens in interactive use with M-x.")
1788 (filename
, newname
, ok_if_already_exists
)
1789 Lisp_Object filename
, newname
, ok_if_already_exists
;
1792 Lisp_Object args
[2];
1794 Lisp_Object handler
;
1795 struct gcpro gcpro1
, gcpro2
;
1797 GCPRO2 (filename
, newname
);
1798 CHECK_STRING (filename
, 0);
1799 CHECK_STRING (newname
, 1);
1800 filename
= Fexpand_file_name (filename
, Qnil
);
1801 newname
= Fexpand_file_name (newname
, Qnil
);
1803 /* If the file name has special constructs in it,
1804 call the corresponding file handler. */
1805 handler
= Ffind_file_name_handler (filename
);
1806 if (!NILP (handler
))
1807 return call3 (handler
, Qadd_name_to_file
, filename
, newname
);
1809 if (NILP (ok_if_already_exists
)
1810 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1811 barf_or_query_if_file_exists (newname
, "make it a new name",
1812 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1813 unlink (XSTRING (newname
)->data
);
1814 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1819 report_file_error ("Adding new name", Flist (2, args
));
1821 report_file_error ("Adding new name", Flist (2, &filename
));
1830 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1831 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1832 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1833 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1834 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1835 A number as third arg means request confirmation if NEWNAME already exists.\n\
1836 This happens for interactive use with M-x.")
1837 (filename
, linkname
, ok_if_already_exists
)
1838 Lisp_Object filename
, linkname
, ok_if_already_exists
;
1841 Lisp_Object args
[2];
1843 Lisp_Object handler
;
1844 struct gcpro gcpro1
, gcpro2
;
1846 GCPRO2 (filename
, linkname
);
1847 CHECK_STRING (filename
, 0);
1848 CHECK_STRING (linkname
, 1);
1849 #if 0 /* This made it impossible to make a link to a relative name. */
1850 filename
= Fexpand_file_name (filename
, Qnil
);
1852 linkname
= Fexpand_file_name (linkname
, Qnil
);
1854 /* If the file name has special constructs in it,
1855 call the corresponding file handler. */
1856 handler
= Ffind_file_name_handler (filename
);
1857 if (!NILP (handler
))
1858 return call3 (handler
, Qmake_symbolic_link
, filename
, linkname
);
1860 if (NILP (ok_if_already_exists
)
1861 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1862 barf_or_query_if_file_exists (linkname
, "make it a link",
1863 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1864 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1866 /* If we didn't complain already, silently delete existing file. */
1867 if (errno
== EEXIST
)
1869 unlink (XSTRING (linkname
)->data
);
1870 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1877 report_file_error ("Making symbolic link", Flist (2, args
));
1879 report_file_error ("Making symbolic link", Flist (2, &filename
));
1885 #endif /* S_IFLNK */
1889 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
1890 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1891 "Define the job-wide logical name NAME to have the value STRING.\n\
1892 If STRING is nil or a null string, the logical name NAME is deleted.")
1894 Lisp_Object varname
;
1897 CHECK_STRING (varname
, 0);
1899 delete_logical_name (XSTRING (varname
)->data
);
1902 CHECK_STRING (string
, 1);
1904 if (XSTRING (string
)->size
== 0)
1905 delete_logical_name (XSTRING (varname
)->data
);
1907 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
1916 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
1917 "Open a network connection to PATH using LOGIN as the login string.")
1919 Lisp_Object path
, login
;
1923 CHECK_STRING (path
, 0);
1924 CHECK_STRING (login
, 0);
1926 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
1928 if (netresult
== -1)
1933 #endif /* HPUX_NET */
1935 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
1937 "Return t if file FILENAME specifies an absolute path name.\n\
1938 On Unix, this is a name starting with a `/' or a `~'.")
1940 Lisp_Object filename
;
1944 CHECK_STRING (filename
, 0);
1945 ptr
= XSTRING (filename
)->data
;
1946 if (*ptr
== '/' || *ptr
== '~'
1948 /* ??? This criterion is probably wrong for '<'. */
1949 || index (ptr
, ':') || index (ptr
, '<')
1950 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
1959 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
1960 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1961 See also `file-readable-p' and `file-attributes'.")
1963 Lisp_Object filename
;
1965 Lisp_Object abspath
;
1966 Lisp_Object handler
;
1968 CHECK_STRING (filename
, 0);
1969 abspath
= Fexpand_file_name (filename
, Qnil
);
1971 /* If the file name has special constructs in it,
1972 call the corresponding file handler. */
1973 handler
= Ffind_file_name_handler (abspath
);
1974 if (!NILP (handler
))
1975 return call2 (handler
, Qfile_exists_p
, abspath
);
1977 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
1980 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
1981 "Return t if FILENAME can be executed by you.\n\
1982 For a directory, this means you can access files in that directory.")
1984 Lisp_Object filename
;
1987 Lisp_Object abspath
;
1988 Lisp_Object handler
;
1990 CHECK_STRING (filename
, 0);
1991 abspath
= Fexpand_file_name (filename
, Qnil
);
1993 /* If the file name has special constructs in it,
1994 call the corresponding file handler. */
1995 handler
= Ffind_file_name_handler (abspath
);
1996 if (!NILP (handler
))
1997 return call2 (handler
, Qfile_executable_p
, abspath
);
1999 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
2002 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2003 "Return t if file FILENAME exists and you can read it.\n\
2004 See also `file-exists-p' and `file-attributes'.")
2006 Lisp_Object filename
;
2008 Lisp_Object abspath
;
2009 Lisp_Object handler
;
2011 CHECK_STRING (filename
, 0);
2012 abspath
= Fexpand_file_name (filename
, Qnil
);
2014 /* If the file name has special constructs in it,
2015 call the corresponding file handler. */
2016 handler
= Ffind_file_name_handler (abspath
);
2017 if (!NILP (handler
))
2018 return call2 (handler
, Qfile_readable_p
, abspath
);
2020 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
2023 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2024 "If file FILENAME is the name of a symbolic link\n\
2025 returns the name of the file to which it is linked.\n\
2026 Otherwise returns NIL.")
2028 Lisp_Object filename
;
2035 Lisp_Object handler
;
2037 CHECK_STRING (filename
, 0);
2038 filename
= Fexpand_file_name (filename
, Qnil
);
2040 /* If the file name has special constructs in it,
2041 call the corresponding file handler. */
2042 handler
= Ffind_file_name_handler (filename
);
2043 if (!NILP (handler
))
2044 return call2 (handler
, Qfile_symlink_p
, filename
);
2049 buf
= (char *) xmalloc (bufsize
);
2050 bzero (buf
, bufsize
);
2051 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2052 if (valsize
< bufsize
) break;
2053 /* Buffer was not long enough */
2062 val
= make_string (buf
, valsize
);
2065 #else /* not S_IFLNK */
2067 #endif /* not S_IFLNK */
2070 #ifdef SOLARIS_BROKEN_ACCESS
2071 /* In Solaris 2.1, the readonly-ness of the filesystem is not
2072 considered by the access system call. This is Sun's bug, but we
2073 still have to make Emacs work. */
2075 #include <sys/statvfs.h>
2081 struct statvfs statvfsb
;
2083 if (statvfs(path
, &statvfsb
))
2084 return 1; /* error from statvfs, be conservative and say not wrtable */
2086 /* Otherwise, fsys is ro if bit is set. */
2087 return statvfsb
.f_flag
& ST_RDONLY
;
2090 /* But on every other os, access has already done the right thing. */
2091 #define ro_fsys(path) 0
2094 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2096 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2097 "Return t if file FILENAME can be written or created by you.")
2099 Lisp_Object filename
;
2101 Lisp_Object abspath
, dir
;
2102 Lisp_Object handler
;
2104 CHECK_STRING (filename
, 0);
2105 abspath
= Fexpand_file_name (filename
, Qnil
);
2107 /* If the file name has special constructs in it,
2108 call the corresponding file handler. */
2109 handler
= Ffind_file_name_handler (abspath
);
2110 if (!NILP (handler
))
2111 return call2 (handler
, Qfile_writable_p
, abspath
);
2113 if (access (XSTRING (abspath
)->data
, 0) >= 0)
2114 return ((access (XSTRING (abspath
)->data
, 2) >= 0
2115 && ! ro_fsys (XSTRING (abspath
)))
2117 dir
= Ffile_name_directory (abspath
);
2120 dir
= Fdirectory_file_name (dir
);
2122 return ((access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2123 && ! ro_fsys ((char *) XSTRING (dir
)))
2127 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2128 "Return t if file FILENAME is the name of a directory as a file.\n\
2129 A directory name spec may be given instead; then the value is t\n\
2130 if the directory so specified exists and really is a directory.")
2132 Lisp_Object filename
;
2134 register Lisp_Object abspath
;
2136 Lisp_Object handler
;
2138 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2140 /* If the file name has special constructs in it,
2141 call the corresponding file handler. */
2142 handler
= Ffind_file_name_handler (abspath
);
2143 if (!NILP (handler
))
2144 return call2 (handler
, Qfile_directory_p
, abspath
);
2146 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2148 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2151 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2152 "Return t if file FILENAME is the name of a directory as a file,\n\
2153 and files in that directory can be opened by you. In order to use a\n\
2154 directory as a buffer's current directory, this predicate must return true.\n\
2155 A directory name spec may be given instead; then the value is t\n\
2156 if the directory so specified exists and really is a readable and\n\
2157 searchable directory.")
2159 Lisp_Object filename
;
2161 Lisp_Object handler
;
2163 /* If the file name has special constructs in it,
2164 call the corresponding file handler. */
2165 handler
= Ffind_file_name_handler (filename
);
2166 if (!NILP (handler
))
2167 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2169 if (NILP (Ffile_directory_p (filename
))
2170 || NILP (Ffile_executable_p (filename
)))
2176 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2177 "Return mode bits of FILE, as an integer.")
2179 Lisp_Object filename
;
2181 Lisp_Object abspath
;
2183 Lisp_Object handler
;
2185 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2187 /* If the file name has special constructs in it,
2188 call the corresponding file handler. */
2189 handler
= Ffind_file_name_handler (abspath
);
2190 if (!NILP (handler
))
2191 return call2 (handler
, Qfile_modes
, abspath
);
2193 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2195 return make_number (st
.st_mode
& 07777);
2198 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2199 "Set mode bits of FILE to MODE (an integer).\n\
2200 Only the 12 low bits of MODE are used.")
2202 Lisp_Object filename
, mode
;
2204 Lisp_Object abspath
;
2205 Lisp_Object handler
;
2207 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2208 CHECK_NUMBER (mode
, 1);
2210 /* If the file name has special constructs in it,
2211 call the corresponding file handler. */
2212 handler
= Ffind_file_name_handler (abspath
);
2213 if (!NILP (handler
))
2214 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2217 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2218 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2220 if (!egetenv ("USE_DOMAIN_ACLS"))
2223 struct timeval tvp
[2];
2225 /* chmod on apollo also change the file's modtime; need to save the
2226 modtime and then restore it. */
2227 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2229 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2233 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2234 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2236 /* reset the old accessed and modified times. */
2237 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2239 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2242 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2243 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2250 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2251 "Set the file permission bits for newly created files.\n\
2252 The argument MODE should be an integer; only the low 9 bits are used.\n\
2253 This setting is inherited by subprocesses.")
2257 CHECK_NUMBER (mode
, 0);
2259 umask ((~ XINT (mode
)) & 0777);
2264 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2265 "Return the default file protection for created files.\n\
2266 The value is an integer.")
2272 realmask
= umask (0);
2275 XSET (value
, Lisp_Int
, (~ realmask
) & 0777);
2281 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2282 "Tell Unix to finish all pending disk updates.")
2291 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2292 "Return t if file FILE1 is newer than file FILE2.\n\
2293 If FILE1 does not exist, the answer is nil;\n\
2294 otherwise, if FILE2 does not exist, the answer is t.")
2296 Lisp_Object file1
, file2
;
2298 Lisp_Object abspath1
, abspath2
;
2301 Lisp_Object handler
;
2302 struct gcpro gcpro1
, gcpro2
;
2304 CHECK_STRING (file1
, 0);
2305 CHECK_STRING (file2
, 0);
2308 GCPRO2 (abspath1
, file2
);
2309 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2310 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2313 /* If the file name has special constructs in it,
2314 call the corresponding file handler. */
2315 handler
= Ffind_file_name_handler (abspath1
);
2316 if (!NILP (handler
))
2317 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2319 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2322 mtime1
= st
.st_mtime
;
2324 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2327 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2330 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2332 "Insert contents of file FILENAME after point.\n\
2333 Returns list of absolute pathname and length of data inserted.\n\
2334 If second argument VISIT is non-nil, the buffer's visited filename\n\
2335 and last save file modtime are set, and it is marked unmodified.\n\
2336 If visiting and the file does not exist, visiting is completed\n\
2337 before the error is signaled.")
2339 Lisp_Object filename
, visit
;
2343 register int inserted
= 0;
2344 register int how_much
;
2345 int count
= specpdl_ptr
- specpdl
;
2346 struct gcpro gcpro1
;
2347 Lisp_Object handler
, val
;
2352 if (!NILP (current_buffer
->read_only
))
2353 Fbarf_if_buffer_read_only();
2355 CHECK_STRING (filename
, 0);
2356 filename
= Fexpand_file_name (filename
, Qnil
);
2358 /* If the file name has special constructs in it,
2359 call the corresponding file handler. */
2360 handler
= Ffind_file_name_handler (filename
);
2361 if (!NILP (handler
))
2363 val
= call3 (handler
, Qinsert_file_contents
, filename
, visit
);
2371 if (stat (XSTRING (filename
)->data
, &st
) < 0
2372 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2374 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2375 || fstat (fd
, &st
) < 0)
2376 #endif /* not APOLLO */
2378 if (fd
>= 0) close (fd
);
2380 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2386 record_unwind_protect (close_file_unwind
, make_number (fd
));
2389 /* This code will need to be changed in order to work on named
2390 pipes, and it's probably just not worth it. So we should at
2391 least signal an error. */
2392 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2393 Fsignal (Qfile_error
,
2394 Fcons (build_string ("reading from named pipe"),
2395 Fcons (filename
, Qnil
)));
2398 /* Supposedly happens on VMS. */
2400 error ("File size is negative");
2403 register Lisp_Object temp
;
2405 /* Make sure point-max won't overflow after this insertion. */
2406 XSET (temp
, Lisp_Int
, st
.st_size
+ Z
);
2407 if (st
.st_size
+ Z
!= XINT (temp
))
2408 error ("maximum buffer size exceeded");
2412 prepare_to_modify_buffer (point
, point
);
2415 if (GAP_SIZE
< st
.st_size
)
2416 make_gap (st
.st_size
- GAP_SIZE
);
2420 int try = min (st
.st_size
- inserted
, 64 << 10);
2423 /* Allow quitting out of the actual I/O. */
2426 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2444 record_insert (point
, inserted
);
2446 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2447 offset_intervals (current_buffer
, point
, inserted
);
2453 /* Discard the unwind protect */
2454 specpdl_ptr
= specpdl
+ count
;
2457 error ("IO error reading %s: %s",
2458 XSTRING (filename
)->data
, err_str (errno
));
2465 current_buffer
->undo_list
= Qnil
;
2467 stat (XSTRING (filename
)->data
, &st
);
2469 current_buffer
->modtime
= st
.st_mtime
;
2470 current_buffer
->save_modified
= MODIFF
;
2471 current_buffer
->auto_save_modified
= MODIFF
;
2472 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2473 #ifdef CLASH_DETECTION
2476 if (!NILP (current_buffer
->filename
))
2477 unlock_file (current_buffer
->filename
);
2478 unlock_file (filename
);
2480 #endif /* CLASH_DETECTION */
2481 current_buffer
->filename
= filename
;
2482 /* If visiting nonexistent file, return nil. */
2483 if (current_buffer
->modtime
== -1)
2484 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2487 signal_after_change (point
, 0, inserted
);
2490 RETURN_UNGCPRO (val
);
2491 RETURN_UNGCPRO (Fcons (filename
,
2492 Fcons (make_number (inserted
),
2496 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2497 "r\nFWrite region to file: ",
2498 "Write current region into specified file.\n\
2499 When called from a program, takes three arguments:\n\
2500 START, END and FILENAME. START and END are buffer positions.\n\
2501 Optional fourth argument APPEND if non-nil means\n\
2502 append to existing file contents (if any).\n\
2503 Optional fifth argument VISIT if t means\n\
2504 set the last-save-file-modtime of buffer to this file's modtime\n\
2505 and mark buffer not modified.\n\
2506 If VISIT is a string, it is a second file name;\n\
2507 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2508 VISIT is also the file name to lock and unlock for clash detection.\n\
2509 If VISIT is neither t nor nil nor a string,\n\
2510 that means do not print the \"Wrote file\" message.\n\
2511 Kludgy feature: if START is a string, then that string is written\n\
2512 to the file, instead of any buffer contents, and END is ignored.")
2513 (start
, end
, filename
, append
, visit
)
2514 Lisp_Object start
, end
, filename
, append
, visit
;
2522 int count
= specpdl_ptr
- specpdl
;
2524 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2526 Lisp_Object handler
;
2527 Lisp_Object visit_file
;
2528 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2530 /* Special kludge to simplify auto-saving */
2533 XFASTINT (start
) = BEG
;
2536 else if (XTYPE (start
) != Lisp_String
)
2537 validate_region (&start
, &end
);
2539 filename
= Fexpand_file_name (filename
, Qnil
);
2540 if (XTYPE (visit
) == Lisp_String
)
2541 visit_file
= Fexpand_file_name (visit
, Qnil
);
2543 visit_file
= filename
;
2545 GCPRO4 (start
, filename
, visit
, visit_file
);
2547 /* If the file name has special constructs in it,
2548 call the corresponding file handler. */
2549 handler
= Ffind_file_name_handler (filename
);
2551 if (!NILP (handler
))
2553 Lisp_Object args
[7];
2556 args
[1] = Qwrite_region
;
2562 val
= Ffuncall (7, args
);
2564 /* Do this before reporting IO error
2565 to avoid a "file has changed on disk" warning on
2566 next attempt to save. */
2567 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2569 current_buffer
->modtime
= 0;
2570 current_buffer
->save_modified
= MODIFF
;
2571 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2572 current_buffer
->filename
= visit_file
;
2578 #ifdef CLASH_DETECTION
2580 lock_file (visit_file
);
2581 #endif /* CLASH_DETECTION */
2583 fn
= XSTRING (filename
)->data
;
2586 desc
= open (fn
, O_WRONLY
);
2590 if (auto_saving
) /* Overwrite any previous version of autosave file */
2592 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2593 desc
= open (fn
, O_RDWR
);
2595 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2596 ? XSTRING (current_buffer
->filename
)->data
: 0,
2599 else /* Write to temporary name and rename if no errors */
2601 Lisp_Object temp_name
;
2602 temp_name
= Ffile_name_directory (filename
);
2604 if (!NILP (temp_name
))
2606 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2607 build_string ("$$SAVE$$")));
2608 fname
= XSTRING (filename
)->data
;
2609 fn
= XSTRING (temp_name
)->data
;
2610 desc
= creat_copy_attrs (fname
, fn
);
2613 /* If we can't open the temporary file, try creating a new
2614 version of the original file. VMS "creat" creates a
2615 new version rather than truncating an existing file. */
2618 desc
= creat (fn
, 0666);
2619 #if 0 /* This can clobber an existing file and fail to replace it,
2620 if the user runs out of space. */
2623 /* We can't make a new version;
2624 try to truncate and rewrite existing version if any. */
2626 desc
= open (fn
, O_RDWR
);
2632 desc
= creat (fn
, 0666);
2635 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2636 #endif /* not VMS */
2642 #ifdef CLASH_DETECTION
2644 if (!auto_saving
) unlock_file (visit_file
);
2646 #endif /* CLASH_DETECTION */
2647 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2650 record_unwind_protect (close_file_unwind
, make_number (desc
));
2653 if (lseek (desc
, 0, 2) < 0)
2655 #ifdef CLASH_DETECTION
2656 if (!auto_saving
) unlock_file (visit_file
);
2657 #endif /* CLASH_DETECTION */
2658 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2663 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2664 * if we do writes that don't end with a carriage return. Furthermore
2665 * it cannot handle writes of more then 16K. The modified
2666 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2667 * this EXCEPT for the last record (iff it doesn't end with a carriage
2668 * return). This implies that if your buffer doesn't end with a carriage
2669 * return, you get one free... tough. However it also means that if
2670 * we make two calls to sys_write (a la the following code) you can
2671 * get one at the gap as well. The easiest way to fix this (honest)
2672 * is to move the gap to the next newline (or the end of the buffer).
2677 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2678 move_gap (find_next_newline (GPT
, 1));
2684 if (XTYPE (start
) == Lisp_String
)
2686 failure
= 0 > e_write (desc
, XSTRING (start
)->data
,
2687 XSTRING (start
)->size
);
2690 else if (XINT (start
) != XINT (end
))
2692 if (XINT (start
) < GPT
)
2694 register int end1
= XINT (end
);
2696 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
),
2697 min (GPT
, end1
) - tem
);
2701 if (XINT (end
) > GPT
&& !failure
)
2704 tem
= max (tem
, GPT
);
2705 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
);
2713 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2714 Disk full in NFS may be reported here. */
2715 if (fsync (desc
) < 0)
2716 failure
= 1, save_errno
= errno
;
2719 /* Spurious "file has changed on disk" warnings have been
2720 observed on Suns as well.
2721 It seems that `close' can change the modtime, under nfs.
2723 (This has supposedly been fixed in Sunos 4,
2724 but who knows about all the other machines with NFS?) */
2727 /* On VMS and APOLLO, must do the stat after the close
2728 since closing changes the modtime. */
2731 /* Recall that #if defined does not work on VMS. */
2738 /* NFS can report a write failure now. */
2739 if (close (desc
) < 0)
2740 failure
= 1, save_errno
= errno
;
2743 /* If we wrote to a temporary name and had no errors, rename to real name. */
2747 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2755 /* Discard the unwind protect */
2756 specpdl_ptr
= specpdl
+ count
;
2758 #ifdef CLASH_DETECTION
2760 unlock_file (visit_file
);
2761 #endif /* CLASH_DETECTION */
2763 /* Do this before reporting IO error
2764 to avoid a "file has changed on disk" warning on
2765 next attempt to save. */
2766 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2767 current_buffer
->modtime
= st
.st_mtime
;
2770 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2772 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2774 current_buffer
->save_modified
= MODIFF
;
2775 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2776 current_buffer
->filename
= visit_file
;
2778 else if (!NILP (visit
))
2782 message ("Wrote %s", XSTRING (visit_file
)->data
);
2788 e_write (desc
, addr
, len
)
2790 register char *addr
;
2793 char buf
[16 * 1024];
2794 register char *p
, *end
;
2796 if (!EQ (current_buffer
->selective_display
, Qt
))
2797 return write (desc
, addr
, len
) - len
;
2801 end
= p
+ sizeof buf
;
2806 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
2815 if (write (desc
, buf
, p
- buf
) != p
- buf
)
2821 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
2822 Sverify_visited_file_modtime
, 1, 1, 0,
2823 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2824 This means that the file has not been changed since it was visited or saved.")
2830 Lisp_Object handler
;
2832 CHECK_BUFFER (buf
, 0);
2835 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
2836 if (b
->modtime
== 0) return Qt
;
2838 /* If the file name has special constructs in it,
2839 call the corresponding file handler. */
2840 handler
= Ffind_file_name_handler (b
->filename
);
2841 if (!NILP (handler
))
2842 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
2844 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
2846 /* If the file doesn't exist now and didn't exist before,
2847 we say that it isn't modified, provided the error is a tame one. */
2848 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
2853 if (st
.st_mtime
== b
->modtime
2854 /* If both are positive, accept them if they are off by one second. */
2855 || (st
.st_mtime
> 0 && b
->modtime
> 0
2856 && (st
.st_mtime
== b
->modtime
+ 1
2857 || st
.st_mtime
== b
->modtime
- 1)))
2862 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
2863 Sclear_visited_file_modtime
, 0, 0, 0,
2864 "Clear out records of last mod time of visited file.\n\
2865 Next attempt to save will certainly not complain of a discrepancy.")
2868 current_buffer
->modtime
= 0;
2872 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
2873 Svisited_file_modtime
, 0, 0, 0,
2874 "Return the current buffer's recorded visited file modification time.\n\
2875 The value is a list of the form (HIGH . LOW), like the time values\n\
2876 that `file-attributes' returns.")
2879 return long_to_cons (current_buffer
->modtime
);
2882 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
2883 Sset_visited_file_modtime
, 0, 1, 0,
2884 "Update buffer's recorded modification time from the visited file's time.\n\
2885 Useful if the buffer was not read from the file normally\n\
2886 or if the file itself has been changed for some known benign reason.\n\
2887 An argument specifies the modification time value to use\n\
2888 \(instead of that of the visited file), in the form of a list\n\
2889 \(HIGH . LOW) or (HIGH LOW).")
2891 Lisp_Object time_list
;
2893 if (!NILP (time_list
))
2894 current_buffer
->modtime
= cons_to_long (time_list
);
2897 register Lisp_Object filename
;
2899 Lisp_Object handler
;
2901 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
2903 /* If the file name has special constructs in it,
2904 call the corresponding file handler. */
2905 handler
= Ffind_file_name_handler (filename
);
2906 if (!NILP (handler
))
2907 return call3 (handler
, Qfile_name_directory
, filename
, Qnil
);
2908 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
2909 current_buffer
->modtime
= st
.st_mtime
;
2918 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
2921 message ("Autosaving...error for %s", name
);
2922 Fsleep_for (make_number (1), Qnil
);
2923 message ("Autosaving...error!for %s", name
);
2924 Fsleep_for (make_number (1), Qnil
);
2925 message ("Autosaving...error for %s", name
);
2926 Fsleep_for (make_number (1), Qnil
);
2936 /* Get visited file's mode to become the auto save file's mode. */
2937 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
2938 /* But make sure we can overwrite it later! */
2939 auto_save_mode_bits
= st
.st_mode
| 0600;
2941 auto_save_mode_bits
= 0666;
2944 Fwrite_region (Qnil
, Qnil
,
2945 current_buffer
->auto_save_file_name
,
2949 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
2950 "Auto-save all buffers that need it.\n\
2951 This is all buffers that have auto-saving enabled\n\
2952 and are changed since last auto-saved.\n\
2953 Auto-saving writes the buffer into a file\n\
2954 so that your editing is not lost if the system crashes.\n\
2955 This file is not the file you visited; that changes only when you save.\n\n\
2956 Non-nil first argument means do not print any message if successful.\n\
2957 Non-nil second argument means save only current buffer.")
2958 (no_message
, current_only
)
2959 Lisp_Object no_message
, current_only
;
2961 struct buffer
*old
= current_buffer
, *b
;
2962 Lisp_Object tail
, buf
;
2964 char *omessage
= echo_area_glyphs
;
2965 extern int minibuf_level
;
2966 int do_handled_files
;
2968 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2969 point to non-strings reached from Vbuffer_alist. */
2975 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2976 eventually call do-auto-save, so don't err here in that case. */
2977 if (!NILP (Vrun_hooks
))
2978 call1 (Vrun_hooks
, intern ("auto-save-hook"));
2980 /* First, save all files which don't have handlers. If Emacs is
2981 crashing, the handlers may tweak what is causing Emacs to crash
2982 in the first place, and it would be a shame if Emacs failed to
2983 autosave perfectly ordinary files because it couldn't handle some
2985 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
2986 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2987 tail
= XCONS (tail
)->cdr
)
2989 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
2992 if (!NILP (current_only
)
2993 && b
!= current_buffer
)
2996 /* Check for auto save enabled
2997 and file changed since last auto save
2998 and file changed since last real save. */
2999 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3000 && b
->save_modified
< BUF_MODIFF (b
)
3001 && b
->auto_save_modified
< BUF_MODIFF (b
)
3002 && (do_handled_files
3003 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
))))
3005 if ((XFASTINT (b
->save_length
) * 10
3006 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3007 /* A short file is likely to change a large fraction;
3008 spare the user annoying messages. */
3009 && XFASTINT (b
->save_length
) > 5000
3010 /* These messages are frequent and annoying for `*mail*'. */
3011 && !EQ (b
->filename
, Qnil
)
3012 && NILP (no_message
))
3014 /* It has shrunk too much; turn off auto-saving here. */
3015 message ("Buffer %s has shrunk a lot; auto save turned off there",
3016 XSTRING (b
->name
)->data
);
3017 /* User can reenable saving with M-x auto-save. */
3018 b
->auto_save_file_name
= Qnil
;
3019 /* Prevent warning from repeating if user does so. */
3020 XFASTINT (b
->save_length
) = 0;
3021 Fsleep_for (make_number (1), Qnil
);
3024 set_buffer_internal (b
);
3025 if (!auto_saved
&& NILP (no_message
))
3026 message1 ("Auto-saving...");
3027 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3029 b
->auto_save_modified
= BUF_MODIFF (b
);
3030 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3031 set_buffer_internal (old
);
3035 /* Prevent another auto save till enough input events come in. */
3036 record_auto_save ();
3038 if (auto_saved
&& NILP (no_message
))
3039 message1 (omessage
? omessage
: "Auto-saving...done");
3045 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3046 Sset_buffer_auto_saved
, 0, 0, 0,
3047 "Mark current buffer as auto-saved with its current text.\n\
3048 No auto-save file will be written until the buffer changes again.")
3051 current_buffer
->auto_save_modified
= MODIFF
;
3052 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3056 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3058 "Return t if buffer has been auto-saved since last read in or saved.")
3061 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3064 /* Reading and completing file names */
3065 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3067 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3069 "Internal subroutine for read-file-name. Do not call this.")
3070 (string
, dir
, action
)
3071 Lisp_Object string
, dir
, action
;
3072 /* action is nil for complete, t for return list of completions,
3073 lambda for verify final value */
3075 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3077 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3084 /* No need to protect ACTION--we only compare it with t and nil. */
3085 GCPRO4 (string
, realdir
, name
, specdir
);
3087 if (XSTRING (string
)->size
== 0)
3089 if (EQ (action
, Qlambda
))
3097 orig_string
= string
;
3098 string
= Fsubstitute_in_file_name (string
);
3099 changed
= NILP (Fstring_equal (string
, orig_string
));
3100 name
= Ffile_name_nondirectory (string
);
3101 val
= Ffile_name_directory (string
);
3103 realdir
= Fexpand_file_name (val
, realdir
);
3108 specdir
= Ffile_name_directory (string
);
3109 val
= Ffile_name_completion (name
, realdir
);
3111 if (XTYPE (val
) != Lisp_String
)
3118 if (!NILP (specdir
))
3119 val
= concat2 (specdir
, val
);
3122 register unsigned char *old
, *new;
3126 osize
= XSTRING (val
)->size
;
3127 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3128 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3129 if (*old
++ == '$') count
++;
3132 old
= XSTRING (val
)->data
;
3133 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3134 new = XSTRING (val
)->data
;
3135 for (n
= osize
; n
> 0; n
--)
3146 #endif /* Not VMS */
3151 if (EQ (action
, Qt
))
3152 return Ffile_name_all_completions (name
, realdir
);
3153 /* Only other case actually used is ACTION = lambda */
3155 /* Supposedly this helps commands such as `cd' that read directory names,
3156 but can someone explain how it helps them? -- RMS */
3157 if (XSTRING (name
)->size
== 0)
3160 return Ffile_exists_p (string
);
3163 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3164 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3165 Value is not expanded---you must call `expand-file-name' yourself.\n\
3166 Default name to DEFAULT if user enters a null string.\n\
3167 (If DEFAULT is omitted, the visited file name is used.)\n\
3168 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3169 Non-nil and non-t means also require confirmation after completion.\n\
3170 Fifth arg INITIAL specifies text to start with.\n\
3171 DIR defaults to current buffer's directory default.")
3172 (prompt
, dir
, defalt
, mustmatch
, initial
)
3173 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3175 Lisp_Object val
, insdef
, insdef1
, tem
;
3176 struct gcpro gcpro1
, gcpro2
;
3177 register char *homedir
;
3181 dir
= current_buffer
->directory
;
3183 defalt
= current_buffer
->filename
;
3185 /* If dir starts with user's homedir, change that to ~. */
3186 homedir
= (char *) egetenv ("HOME");
3188 && XTYPE (dir
) == Lisp_String
3189 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3190 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3192 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3193 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3194 XSTRING (dir
)->data
[0] = '~';
3197 if (insert_default_directory
)
3201 if (!NILP (initial
))
3203 Lisp_Object args
[2], pos
;
3207 insdef
= Fconcat (2, args
);
3208 pos
= make_number (XSTRING (dir
)->size
);
3209 insdef1
= Fcons (insdef
, pos
);
3213 insdef
= Qnil
, insdef1
= Qnil
;
3216 count
= specpdl_ptr
- specpdl
;
3217 specbind (intern ("completion-ignore-case"), Qt
);
3220 GCPRO2 (insdef
, defalt
);
3221 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3222 dir
, mustmatch
, insdef1
,
3223 Qfile_name_history
);
3226 unbind_to (count
, Qnil
);
3231 error ("No file name specified");
3232 tem
= Fstring_equal (val
, insdef
);
3233 if (!NILP (tem
) && !NILP (defalt
))
3235 return Fsubstitute_in_file_name (val
);
3238 #if 0 /* Old version */
3239 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3240 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3241 Value is not expanded---you must call `expand-file-name' yourself.\n\
3242 Default name to DEFAULT if user enters a null string.\n\
3243 (If DEFAULT is omitted, the visited file name is used.)\n\
3244 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3245 Non-nil and non-t means also require confirmation after completion.\n\
3246 Fifth arg INITIAL specifies text to start with.\n\
3247 DIR defaults to current buffer's directory default.")
3248 (prompt
, dir
, defalt
, mustmatch
, initial
)
3249 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3251 Lisp_Object val
, insdef
, tem
;
3252 struct gcpro gcpro1
, gcpro2
;
3253 register char *homedir
;
3257 dir
= current_buffer
->directory
;
3259 defalt
= current_buffer
->filename
;
3261 /* If dir starts with user's homedir, change that to ~. */
3262 homedir
= (char *) egetenv ("HOME");
3264 && XTYPE (dir
) == Lisp_String
3265 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3266 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3268 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3269 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3270 XSTRING (dir
)->data
[0] = '~';
3273 if (!NILP (initial
))
3275 else if (insert_default_directory
)
3278 insdef
= build_string ("");
3281 count
= specpdl_ptr
- specpdl
;
3282 specbind (intern ("completion-ignore-case"), Qt
);
3285 GCPRO2 (insdef
, defalt
);
3286 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3288 insert_default_directory
? insdef
: Qnil
,
3289 Qfile_name_history
);
3292 unbind_to (count
, Qnil
);
3297 error ("No file name specified");
3298 tem
= Fstring_equal (val
, insdef
);
3299 if (!NILP (tem
) && !NILP (defalt
))
3301 return Fsubstitute_in_file_name (val
);
3303 #endif /* Old version */
3307 Qexpand_file_name
= intern ("expand-file-name");
3308 Qdirectory_file_name
= intern ("directory-file-name");
3309 Qfile_name_directory
= intern ("file-name-directory");
3310 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3311 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
3312 Qfile_name_as_directory
= intern ("file-name-as-directory");
3313 Qcopy_file
= intern ("copy-file");
3314 Qmake_directory
= intern ("make-directory");
3315 Qdelete_directory
= intern ("delete-directory");
3316 Qdelete_file
= intern ("delete-file");
3317 Qrename_file
= intern ("rename-file");
3318 Qadd_name_to_file
= intern ("add-name-to-file");
3319 Qmake_symbolic_link
= intern ("make-symbolic-link");
3320 Qfile_exists_p
= intern ("file-exists-p");
3321 Qfile_executable_p
= intern ("file-executable-p");
3322 Qfile_readable_p
= intern ("file-readable-p");
3323 Qfile_symlink_p
= intern ("file-symlink-p");
3324 Qfile_writable_p
= intern ("file-writable-p");
3325 Qfile_directory_p
= intern ("file-directory-p");
3326 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3327 Qfile_modes
= intern ("file-modes");
3328 Qset_file_modes
= intern ("set-file-modes");
3329 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3330 Qinsert_file_contents
= intern ("insert-file-contents");
3331 Qwrite_region
= intern ("write-region");
3332 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3334 staticpro (&Qexpand_file_name
);
3335 staticpro (&Qdirectory_file_name
);
3336 staticpro (&Qfile_name_directory
);
3337 staticpro (&Qfile_name_nondirectory
);
3338 staticpro (&Qunhandled_file_name_directory
);
3339 staticpro (&Qfile_name_as_directory
);
3340 staticpro (&Qcopy_file
);
3341 staticpro (&Qmake_directory
);
3342 staticpro (&Qdelete_directory
);
3343 staticpro (&Qdelete_file
);
3344 staticpro (&Qrename_file
);
3345 staticpro (&Qadd_name_to_file
);
3346 staticpro (&Qmake_symbolic_link
);
3347 staticpro (&Qfile_exists_p
);
3348 staticpro (&Qfile_executable_p
);
3349 staticpro (&Qfile_readable_p
);
3350 staticpro (&Qfile_symlink_p
);
3351 staticpro (&Qfile_writable_p
);
3352 staticpro (&Qfile_directory_p
);
3353 staticpro (&Qfile_accessible_directory_p
);
3354 staticpro (&Qfile_modes
);
3355 staticpro (&Qset_file_modes
);
3356 staticpro (&Qfile_newer_than_file_p
);
3357 staticpro (&Qinsert_file_contents
);
3358 staticpro (&Qwrite_region
);
3359 staticpro (&Qverify_visited_file_modtime
);
3361 Qfile_name_history
= intern ("file-name-history");
3362 Fset (Qfile_name_history
, Qnil
);
3363 staticpro (&Qfile_name_history
);
3365 Qfile_error
= intern ("file-error");
3366 staticpro (&Qfile_error
);
3367 Qfile_already_exists
= intern("file-already-exists");
3368 staticpro (&Qfile_already_exists
);
3370 Fput (Qfile_error
, Qerror_conditions
,
3371 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3372 Fput (Qfile_error
, Qerror_message
,
3373 build_string ("File error"));
3375 Fput (Qfile_already_exists
, Qerror_conditions
,
3376 Fcons (Qfile_already_exists
,
3377 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3378 Fput (Qfile_already_exists
, Qerror_message
,
3379 build_string ("File already exists"));
3381 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3382 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3383 insert_default_directory
= 1;
3385 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3386 "*Non-nil means write new files with record format `stmlf'.\n\
3387 nil means use format `var'. This variable is meaningful only on VMS.");
3388 vms_stmlf_recfm
= 0;
3390 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
3391 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3392 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3395 The first argument given to HANDLER is the name of the I/O primitive\n\
3396 to be handled; the remaining arguments are the arguments that were\n\
3397 passed to that primitive. For example, if you do\n\
3398 (file-exists-p FILENAME)\n\
3399 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
3400 (funcall HANDLER 'file-exists-p FILENAME)\n\
3401 The function `find-file-name-handler' checks this list for a handler\n\
3402 for its argument.");
3403 Vfile_name_handler_alist
= Qnil
;
3405 defsubr (&Sfind_file_name_handler
);
3406 defsubr (&Sfile_name_directory
);
3407 defsubr (&Sfile_name_nondirectory
);
3408 defsubr (&Sunhandled_file_name_directory
);
3409 defsubr (&Sfile_name_as_directory
);
3410 defsubr (&Sdirectory_file_name
);
3411 defsubr (&Smake_temp_name
);
3412 defsubr (&Sexpand_file_name
);
3413 defsubr (&Ssubstitute_in_file_name
);
3414 defsubr (&Scopy_file
);
3415 defsubr (&Smake_directory_internal
);
3416 defsubr (&Sdelete_directory
);
3417 defsubr (&Sdelete_file
);
3418 defsubr (&Srename_file
);
3419 defsubr (&Sadd_name_to_file
);
3421 defsubr (&Smake_symbolic_link
);
3422 #endif /* S_IFLNK */
3424 defsubr (&Sdefine_logical_name
);
3427 defsubr (&Ssysnetunam
);
3428 #endif /* HPUX_NET */
3429 defsubr (&Sfile_name_absolute_p
);
3430 defsubr (&Sfile_exists_p
);
3431 defsubr (&Sfile_executable_p
);
3432 defsubr (&Sfile_readable_p
);
3433 defsubr (&Sfile_writable_p
);
3434 defsubr (&Sfile_symlink_p
);
3435 defsubr (&Sfile_directory_p
);
3436 defsubr (&Sfile_accessible_directory_p
);
3437 defsubr (&Sfile_modes
);
3438 defsubr (&Sset_file_modes
);
3439 defsubr (&Sset_default_file_modes
);
3440 defsubr (&Sdefault_file_modes
);
3441 defsubr (&Sfile_newer_than_file_p
);
3442 defsubr (&Sinsert_file_contents
);
3443 defsubr (&Swrite_region
);
3444 defsubr (&Sverify_visited_file_modtime
);
3445 defsubr (&Sclear_visited_file_modtime
);
3446 defsubr (&Svisited_file_modtime
);
3447 defsubr (&Sset_visited_file_modtime
);
3448 defsubr (&Sdo_auto_save
);
3449 defsubr (&Sset_buffer_auto_saved
);
3450 defsubr (&Srecent_auto_save_p
);
3452 defsubr (&Sread_file_name_internal
);
3453 defsubr (&Sread_file_name
);
3456 defsubr (&Sunix_sync
);