1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988 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 1, 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. */
21 #include <sys/types.h>
45 extern char *sys_errlist
[];
49 #define err_str(a) ((a) < sys_nerr ? sys_errlist[a] : "unknown error")
69 #else /* not NEED_TIME_H */
72 #endif /* HAVE_TIMEVAL */
73 #endif /* not NEED_TIME_H */
86 #define min(a, b) ((a) < (b) ? (a) : (b))
87 #define max(a, b) ((a) > (b) ? (a) : (b))
89 /* Nonzero during writing of auto-save files */
92 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
93 a new file with the same mode as the original */
94 int auto_save_mode_bits
;
96 /* Nonzero means, when reading a filename in the minibuffer,
97 start out by inserting the default directory into the minibuffer. */
98 int insert_default_directory
;
100 /* On VMS, nonzero means write new files with record format stmlf.
101 Zero means use var format. */
104 Lisp_Object Qfile_error
, Qfile_already_exists
;
106 report_file_error (string
, data
)
110 Lisp_Object errstring
;
112 if (errno
>= 0 && errno
< sys_nerr
)
113 errstring
= build_string (sys_errlist
[errno
]);
115 errstring
= build_string ("undocumented error code");
117 /* System error messages are capitalized. Downcase the initial
118 unless it is followed by a slash. */
119 if (XSTRING (errstring
)->data
[1] != '/')
120 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
123 Fsignal (Qfile_error
,
124 Fcons (build_string (string
), Fcons (errstring
, data
)));
127 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
129 "Return the directory component in file name NAME.\n\
130 Return nil if NAME does not include a directory.\n\
131 Otherwise return a directory spec.\n\
132 Given a Unix syntax file name, returns a string ending in slash;\n\
133 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
137 register unsigned char *beg
;
138 register unsigned char *p
;
140 CHECK_STRING (file
, 0);
142 beg
= XSTRING (file
)->data
;
143 p
= beg
+ XSTRING (file
)->size
;
145 while (p
!= beg
&& p
[-1] != '/'
147 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
153 return make_string (beg
, p
- beg
);
156 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
158 "Return file name NAME sans its directory.\n\
159 For example, in a Unix-syntax file name,\n\
160 this is everything after the last slash,\n\
161 or the entire name if it contains no slash.")
165 register unsigned char *beg
, *p
, *end
;
167 CHECK_STRING (file
, 0);
169 beg
= XSTRING (file
)->data
;
170 end
= p
= beg
+ XSTRING (file
)->size
;
172 while (p
!= beg
&& p
[-1] != '/'
174 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
178 return make_string (p
, end
- p
);
182 file_name_as_directory (out
, in
)
185 int size
= strlen (in
) - 1;
190 /* Is it already a directory string? */
191 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
193 /* Is it a VMS directory file name? If so, hack VMS syntax. */
194 else if (! index (in
, '/')
195 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
196 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
197 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
198 || ! strncmp (&in
[size
- 5], ".dir", 4))
199 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
200 && in
[size
] == '1')))
202 register char *p
, *dot
;
206 dir:x.dir --> dir:[x]
207 dir:[x]y.dir --> dir:[x.y] */
209 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
212 strncpy (out
, in
, p
- in
);
231 dot
= index (p
, '.');
234 /* blindly remove any extension */
235 size
= strlen (out
) + (dot
- p
);
236 strncat (out
, p
, dot
- p
);
247 /* For Unix syntax, Append a slash if necessary */
248 if (out
[size
] != '/')
254 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
255 Sfile_name_as_directory
, 1, 1, 0,
256 "Return a string representing file FILENAME interpreted as a directory.\n\
257 This operation exists because a directory is also a file, but its name as\n\
258 a directory is different from its name as a file.\n\
259 The result can be used as the value of `default-directory'\n\
260 or passed as second argument to `expand-file-name'.\n\
261 For a Unix-syntax file name, just appends a slash.\n\
262 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
268 CHECK_STRING (file
, 0);
271 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
272 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
276 * Convert from directory name to filename.
278 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
279 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
280 * On UNIX, it's simple: just make sure there is a terminating /
282 * Value is nonzero if the string output is different from the input.
285 directory_file_name (src
, dst
)
293 struct FAB fab
= cc$rms_fab
;
294 struct NAM nam
= cc$rms_nam
;
295 char esa
[NAM$C_MAXRSS
];
300 if (! index (src
, '/')
301 && (src
[slen
- 1] == ']'
302 || src
[slen
- 1] == ':'
303 || src
[slen
- 1] == '>'))
305 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
307 fab
.fab$b_fns
= slen
;
308 fab
.fab$l_nam
= &nam
;
309 fab
.fab$l_fop
= FAB$M_NAM
;
312 nam
.nam$b_ess
= sizeof esa
;
313 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
315 /* We call SYS$PARSE to handle such things as [--] for us. */
316 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
318 slen
= nam
.nam$b_esl
;
319 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
324 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
326 /* what about when we have logical_name:???? */
327 if (src
[slen
- 1] == ':')
328 { /* Xlate logical name and see what we get */
329 ptr
= strcpy (dst
, src
); /* upper case for getenv */
332 if ('a' <= *ptr
&& *ptr
<= 'z')
336 dst
[slen
- 1] = 0; /* remove colon */
337 if (!(src
= egetenv (dst
)))
339 /* should we jump to the beginning of this procedure?
340 Good points: allows us to use logical names that xlate
342 Bad points: can be a problem if we just translated to a device
344 For now, I'll punt and always expect VMS names, and hope for
347 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
348 { /* no recursion here! */
354 { /* not a directory spec */
359 bracket
= src
[slen
- 1];
361 /* If bracket is ']' or '>', bracket - 2 is the corresponding
363 ptr
= index (src
, bracket
- 2);
365 { /* no opening bracket */
369 if (!(rptr
= rindex (src
, '.')))
372 strncpy (dst
, src
, slen
);
376 dst
[slen
++] = bracket
;
381 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
382 then translate the device and recurse. */
383 if (dst
[slen
- 1] == ':'
384 && dst
[slen
- 2] != ':' /* skip decnet nodes */
385 && strcmp(src
+ slen
, "[000000]") == 0)
387 dst
[slen
- 1] = '\0';
388 if ((ptr
= egetenv (dst
))
389 && (rlen
= strlen (ptr
) - 1) > 0
390 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
391 && ptr
[rlen
- 1] == '.')
395 return directory_file_name (ptr
, dst
);
400 strcat (dst
, "[000000]");
404 rlen
= strlen (rptr
) - 1;
405 strncat (dst
, rptr
, rlen
);
406 dst
[slen
+ rlen
] = '\0';
407 strcat (dst
, ".DIR.1");
411 /* Process as Unix format: just remove any final slash.
412 But leave "/" unchanged; do not change it to "". */
414 if (dst
[slen
- 1] == '/' && slen
> 1)
419 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
421 "Returns the file name of the directory named DIR.\n\
422 This is the name of the file that holds the data for the directory DIR.\n\
423 This operation exists because a directory is also a file, but its name as\n\
424 a directory is different from its name as a file.\n\
425 In Unix-syntax, this function just removes the final slash.\n\
426 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
427 it returns a file name such as \"[X]Y.DIR.1\".")
429 Lisp_Object directory
;
433 CHECK_STRING (directory
, 0);
435 if (NILP (directory
))
438 /* 20 extra chars is insufficient for VMS, since we might perform a
439 logical name translation. an equivalence string can be up to 255
440 chars long, so grab that much extra space... - sss */
441 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
443 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
445 directory_file_name (XSTRING (directory
)->data
, buf
);
446 return build_string (buf
);
449 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
450 "Generate temporary file name (string) starting with PREFIX (a string).\n\
451 The Emacs process number forms part of the result,\n\
452 so there is no danger of generating a name being used by another process.")
457 val
= concat2 (prefix
, build_string ("XXXXXX"));
458 mktemp (XSTRING (val
)->data
);
462 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
463 "Convert FILENAME to absolute, and canonicalize it.\n\
464 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
465 (does not start with slash); if DEFAULT is nil or missing,\n\
466 the current buffer's value of default-directory is used.\n\
467 Filenames containing `.' or `..' as components are simplified;\n\
468 initial `~/' expands to your home directory.\n\
469 See also the function `substitute-in-file-name'.")
471 Lisp_Object name
, defalt
;
475 register unsigned char *newdir
, *p
, *o
;
477 unsigned char *target
;
481 unsigned char * colon
= 0;
482 unsigned char * close
= 0;
483 unsigned char * slash
= 0;
484 unsigned char * brack
= 0;
485 int lbrack
= 0, rbrack
= 0;
489 CHECK_STRING (name
, 0);
492 /* Filenames on VMS are always upper case. */
493 name
= Fupcase (name
);
496 nm
= XSTRING (name
)->data
;
498 /* If nm is absolute, flush ...// and detect /./ and /../.
499 If no /./ or /../ we can return right away. */
511 if (p
[0] == '/' && p
[1] == '/'
513 /* // at start of filename is meaningful on Apollo system */
518 if (p
[0] == '/' && p
[1] == '~')
519 nm
= p
+ 1, lose
= 1;
520 if (p
[0] == '/' && p
[1] == '.'
521 && (p
[2] == '/' || p
[2] == 0
522 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
528 /* if dev:[dir]/, move nm to / */
529 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
530 nm
= (brack
? brack
+ 1 : colon
+ 1);
539 /* VMS pre V4.4,convert '-'s in filenames. */
540 if (lbrack
== rbrack
)
542 if (dots
< 2) /* this is to allow negative version numbers */
547 if (lbrack
> rbrack
&&
548 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
549 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
555 /* count open brackets, reset close bracket pointer */
556 if (p
[0] == '[' || p
[0] == '<')
558 /* count close brackets, set close bracket pointer */
559 if (p
[0] == ']' || p
[0] == '>')
561 /* detect ][ or >< */
562 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
564 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
565 nm
= p
+ 1, lose
= 1;
566 if (p
[0] == ':' && (colon
|| slash
))
567 /* if dev1:[dir]dev2:, move nm to dev2: */
573 /* if /pathname/dev:, move nm to dev: */
576 /* if node::dev:, move colon following dev */
577 else if (colon
&& colon
[-1] == ':')
579 /* if dev1:dev2:, move nm to dev2: */
580 else if (colon
&& colon
[-1] != ':')
585 if (p
[0] == ':' && !colon
)
591 if (lbrack
== rbrack
)
594 else if (p
[0] == '.')
603 return build_string (sys_translate_unix (nm
));
605 if (nm
== XSTRING (name
)->data
)
607 return build_string (nm
);
611 /* Now determine directory to start with and put it in newdir */
615 if (nm
[0] == '~') /* prefix ~ */
620 || nm
[1] == 0)/* ~/filename */
622 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
623 newdir
= (unsigned char *) "";
626 nm
++; /* Don't leave the slash in nm. */
629 else /* ~user/filename */
631 for (p
= nm
; *p
&& (*p
!= '/'
636 o
= (unsigned char *) alloca (p
- nm
+ 1);
637 bcopy ((char *) nm
, o
, p
- nm
);
640 pw
= (struct passwd
*) getpwnam (o
+ 1);
642 error ("\"%s\" isn't a registered user", o
+ 1);
645 nm
= p
+ 1; /* skip the terminator */
649 newdir
= (unsigned char *) pw
-> pw_dir
;
659 defalt
= current_buffer
->directory
;
660 CHECK_STRING (defalt
, 1);
661 newdir
= XSTRING (defalt
)->data
;
666 /* Get rid of any slash at the end of newdir. */
667 int length
= strlen (newdir
);
668 if (newdir
[length
- 1] == '/')
670 unsigned char *temp
= (unsigned char *) alloca (length
);
671 bcopy (newdir
, temp
, length
- 1);
672 temp
[length
- 1] = 0;
680 /* Now concatenate the directory and name to new space in the stack frame */
681 tlen
+= strlen (nm
) + 1;
682 target
= (unsigned char *) alloca (tlen
);
688 if (nm
[0] == 0 || nm
[0] == '/')
689 strcpy (target
, newdir
);
692 file_name_as_directory (target
, newdir
);
697 if (index (target
, '/'))
698 strcpy (target
, sys_translate_unix (target
));
701 /* Now canonicalize by removing /. and /foo/.. if they appear */
709 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
715 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
716 /* brackets are offset from each other by 2 */
719 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
720 /* convert [foo][bar] to [bar] */
721 while (o
[-1] != '[' && o
[-1] != '<')
723 else if (*p
== '-' && *o
!= '.')
726 else if (p
[0] == '-' && o
[-1] == '.' &&
727 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
728 /* flush .foo.- ; leave - if stopped by '[' or '<' */
732 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
733 if (p
[1] == '.') /* foo.-.bar ==> bar*/
735 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
737 /* else [foo.-] ==> [-] */
743 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
744 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
754 else if (!strncmp (p
, "//", 2)
756 /* // at start of filename is meaningful in Apollo system */
764 else if (p
[0] == '/' && p
[1] == '.' &&
765 (p
[2] == '/' || p
[2] == 0))
767 else if (!strncmp (p
, "/..", 3)
768 /* `/../' is the "superroot" on certain file systems. */
770 && (p
[3] == '/' || p
[3] == 0))
772 while (o
!= target
&& *--o
!= '/')
775 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
779 if (o
== target
&& *o
== '/')
790 return make_string (target
, o
- target
);
793 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
794 "Convert FILENAME to absolute, and canonicalize it.\n\
795 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
796 (does not start with slash); if DEFAULT is nil or missing,\n\
797 the current buffer's value of default-directory is used.\n\
798 Filenames containing `.' or `..' as components are simplified;\n\
799 initial `~/' expands to your home directory.\n\
800 See also the function `substitute-in-file-name'.")
802 Lisp_Object name
, defalt
;
806 register unsigned char *newdir
, *p
, *o
;
808 unsigned char *target
;
812 unsigned char * colon
= 0;
813 unsigned char * close
= 0;
814 unsigned char * slash
= 0;
815 unsigned char * brack
= 0;
816 int lbrack
= 0, rbrack
= 0;
820 CHECK_STRING (name
, 0);
823 /* Filenames on VMS are always upper case. */
824 name
= Fupcase (name
);
827 nm
= XSTRING (name
)->data
;
829 /* If nm is absolute, flush ...// and detect /./ and /../.
830 If no /./ or /../ we can return right away. */
842 if (p
[0] == '/' && p
[1] == '/'
844 /* // at start of filename is meaningful on Apollo system */
849 if (p
[0] == '/' && p
[1] == '~')
850 nm
= p
+ 1, lose
= 1;
851 if (p
[0] == '/' && p
[1] == '.'
852 && (p
[2] == '/' || p
[2] == 0
853 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
859 /* if dev:[dir]/, move nm to / */
860 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
861 nm
= (brack
? brack
+ 1 : colon
+ 1);
870 /* VMS pre V4.4,convert '-'s in filenames. */
871 if (lbrack
== rbrack
)
873 if (dots
< 2) /* this is to allow negative version numbers */
878 if (lbrack
> rbrack
&&
879 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
880 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
886 /* count open brackets, reset close bracket pointer */
887 if (p
[0] == '[' || p
[0] == '<')
889 /* count close brackets, set close bracket pointer */
890 if (p
[0] == ']' || p
[0] == '>')
892 /* detect ][ or >< */
893 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
895 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
896 nm
= p
+ 1, lose
= 1;
897 if (p
[0] == ':' && (colon
|| slash
))
898 /* if dev1:[dir]dev2:, move nm to dev2: */
904 /* if /pathname/dev:, move nm to dev: */
907 /* if node::dev:, move colon following dev */
908 else if (colon
&& colon
[-1] == ':')
910 /* if dev1:dev2:, move nm to dev2: */
911 else if (colon
&& colon
[-1] != ':')
916 if (p
[0] == ':' && !colon
)
922 if (lbrack
== rbrack
)
925 else if (p
[0] == '.')
934 return build_string (sys_translate_unix (nm
));
936 if (nm
== XSTRING (name
)->data
)
938 return build_string (nm
);
942 /* Now determine directory to start with and put it in NEWDIR */
946 if (nm
[0] == '~') /* prefix ~ */
951 || nm
[1] == 0)/* ~/filename */
953 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
954 newdir
= (unsigned char *) "";
957 nm
++; /* Don't leave the slash in nm. */
960 else /* ~user/filename */
962 /* Get past ~ to user */
963 unsigned char *user
= nm
+ 1;
964 /* Find end of name. */
965 unsigned char *ptr
= (unsigned char *) index (user
, '/');
966 int len
= ptr
? ptr
- user
: strlen (user
);
968 unsigned char *ptr1
= index (user
, ':');
969 if (ptr1
!= 0 && ptr1
- user
< len
)
972 /* Copy the user name into temp storage. */
973 o
= (unsigned char *) alloca (len
+ 1);
974 bcopy ((char *) user
, o
, len
);
977 /* Look up the user name. */
978 pw
= (struct passwd
*) getpwnam (o
+ 1);
980 error ("\"%s\" isn't a registered user", o
+ 1);
982 newdir
= (unsigned char *) pw
->pw_dir
;
984 /* Discard the user name from NM. */
995 defalt
= current_buffer
->directory
;
996 CHECK_STRING (defalt
, 1);
997 newdir
= XSTRING (defalt
)->data
;
1000 /* Now concatenate the directory and name to new space in the stack frame */
1002 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1003 target
= (unsigned char *) alloca (tlen
);
1009 if (nm
[0] == 0 || nm
[0] == '/')
1010 strcpy (target
, newdir
);
1013 file_name_as_directory (target
, newdir
);
1016 strcat (target
, nm
);
1018 if (index (target
, '/'))
1019 strcpy (target
, sys_translate_unix (target
));
1022 /* Now canonicalize by removing /. and /foo/.. if they appear */
1030 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1036 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1037 /* brackets are offset from each other by 2 */
1040 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1041 /* convert [foo][bar] to [bar] */
1042 while (o
[-1] != '[' && o
[-1] != '<')
1044 else if (*p
== '-' && *o
!= '.')
1047 else if (p
[0] == '-' && o
[-1] == '.' &&
1048 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1049 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1053 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1054 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1056 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1058 /* else [foo.-] ==> [-] */
1064 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1065 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1075 else if (!strncmp (p
, "//", 2)
1077 /* // at start of filename is meaningful in Apollo system */
1085 else if (p
[0] == '/' && p
[1] == '.' &&
1086 (p
[2] == '/' || p
[2] == 0))
1088 else if (!strncmp (p
, "/..", 3)
1089 /* `/../' is the "superroot" on certain file systems. */
1091 && (p
[3] == '/' || p
[3] == 0))
1093 while (o
!= target
&& *--o
!= '/')
1096 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1100 if (o
== target
&& *o
== '/')
1108 #endif /* not VMS */
1111 return make_string (target
, o
- target
);
1115 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1116 Ssubstitute_in_file_name
, 1, 1, 0,
1117 "Substitute environment variables referred to in FILENAME.\n\
1118 `$FOO' where FOO is an environment variable name means to substitute\n\
1119 the value of that variable. The variable name should be terminated\n\
1120 with a character not a letter, digit or underscore; otherwise, enclose\n\
1121 the entire variable name in braces.\n\
1122 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1123 On VMS, `$' substitution is not done; this function does little and only\n\
1124 duplicates what `expand-file-name' does.")
1130 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1131 unsigned char *target
;
1133 int substituted
= 0;
1136 CHECK_STRING (string
, 0);
1138 nm
= XSTRING (string
)->data
;
1139 endp
= nm
+ XSTRING (string
)->size
;
1141 /* If /~ or // appears, discard everything through first slash. */
1143 for (p
= nm
; p
!= endp
; p
++)
1147 /* // at start of file name is meaningful in Apollo system */
1148 (p
[0] == '/' && p
- 1 != nm
)
1149 #else /* not APOLLO */
1151 #endif /* not APOLLO */
1155 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1168 return build_string (nm
);
1171 /* See if any variables are substituted into the string
1172 and find the total length of their values in `total' */
1174 for (p
= nm
; p
!= endp
;)
1184 /* "$$" means a single "$" */
1193 while (p
!= endp
&& *p
!= '}') p
++;
1194 if (*p
!= '}') goto missingclose
;
1200 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1204 /* Copy out the variable name */
1205 target
= (unsigned char *) alloca (s
- o
+ 1);
1206 strncpy (target
, o
, s
- o
);
1209 /* Get variable value */
1210 o
= (unsigned char *) egetenv (target
);
1211 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1214 if (!o
&& !strcmp (target
, "USER"))
1215 o
= egetenv ("LOGNAME");
1218 if (!o
) goto badvar
;
1219 total
+= strlen (o
);
1226 /* If substitution required, recopy the string and do it */
1227 /* Make space in stack frame for the new copy */
1228 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1231 /* Copy the rest of the name through, replacing $ constructs with values */
1248 while (p
!= endp
&& *p
!= '}') p
++;
1249 if (*p
!= '}') goto missingclose
;
1255 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1259 /* Copy out the variable name */
1260 target
= (unsigned char *) alloca (s
- o
+ 1);
1261 strncpy (target
, o
, s
- o
);
1264 /* Get variable value */
1265 o
= (unsigned char *) egetenv (target
);
1266 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1269 if (!o
&& !strcmp (target
, "USER"))
1270 o
= egetenv ("LOGNAME");
1282 /* If /~ or // appears, discard everything through first slash. */
1284 for (p
= xnm
; p
!= x
; p
++)
1287 /* // at start of file name is meaningful in Apollo system */
1288 (p
[0] == '/' && p
- 1 != xnm
)
1289 #else /* not APOLLO */
1291 #endif /* not APOLLO */
1293 && p
!= nm
&& p
[-1] == '/')
1296 return make_string (xnm
, x
- xnm
);
1299 error ("Bad format environment-variable substitution");
1301 error ("Missing \"}\" in environment-variable substitution");
1303 error ("Substituting nonexistent environment variable \"%s\"", target
);
1306 #endif /* not VMS */
1310 expand_and_dir_to_file (filename
, defdir
)
1311 Lisp_Object filename
, defdir
;
1313 register Lisp_Object abspath
;
1315 abspath
= Fexpand_file_name (filename
, defdir
);
1318 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1319 if (c
== ':' || c
== ']' || c
== '>')
1320 abspath
= Fdirectory_file_name (abspath
);
1323 /* Remove final slash, if any (unless path is root).
1324 stat behaves differently depending! */
1325 if (XSTRING (abspath
)->size
> 1
1326 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1328 if (EQ (abspath
, filename
))
1329 abspath
= Fcopy_sequence (abspath
);
1330 XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] = 0;
1336 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1337 Lisp_Object absname
;
1338 unsigned char *querystring
;
1341 register Lisp_Object tem
;
1342 struct gcpro gcpro1
;
1344 if (access (XSTRING (absname
)->data
, 4) >= 0)
1347 Fsignal (Qfile_already_exists
,
1348 Fcons (build_string ("File already exists"),
1349 Fcons (absname
, Qnil
)));
1351 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1352 XSTRING (absname
)->data
, querystring
));
1355 Fsignal (Qfile_already_exists
,
1356 Fcons (build_string ("File already exists"),
1357 Fcons (absname
, Qnil
)));
1362 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1363 "fCopy file: \nFCopy %s to file: \np\nP",
1364 "Copy FILE to NEWNAME. Both args must be strings.\n\
1365 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1366 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1367 A number as third arg means request confirmation if NEWNAME already exists.\n\
1368 This is what happens in interactive use with M-x.\n\
1369 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1370 last-modified time as the old one. (This works on only some systems.)\n\
1371 A prefix arg makes KEEP-TIME non-nil.")
1372 (filename
, newname
, ok_if_already_exists
, keep_date
)
1373 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1376 char buf
[16 * 1024];
1378 struct gcpro gcpro1
, gcpro2
;
1380 GCPRO2 (filename
, newname
);
1381 CHECK_STRING (filename
, 0);
1382 CHECK_STRING (newname
, 1);
1383 filename
= Fexpand_file_name (filename
, Qnil
);
1384 newname
= Fexpand_file_name (newname
, Qnil
);
1385 if (NILP (ok_if_already_exists
)
1386 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1387 barf_or_query_if_file_exists (newname
, "copy to it",
1388 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1390 ifd
= open (XSTRING (filename
)->data
, 0);
1392 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1395 /* Create the copy file with the same record format as the input file */
1396 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1398 ofd
= creat (XSTRING (newname
)->data
, 0666);
1403 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1406 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1407 if (write (ofd
, buf
, n
) != n
)
1411 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1414 if (fstat (ifd
, &st
) >= 0)
1417 if (!NILP (keep_date
))
1420 /* AIX has utimes() in compatibility package, but it dies. So use good old
1421 utime interface instead. */
1426 tv
.atime
= st
.st_atime
;
1427 tv
.mtime
= st
.st_mtime
;
1428 utime (XSTRING (newname
)->data
, &tv
);
1429 #else /* not USE_UTIME */
1430 struct timeval timevals
[2];
1431 timevals
[0].tv_sec
= st
.st_atime
;
1432 timevals
[1].tv_sec
= st
.st_mtime
;
1433 timevals
[0].tv_usec
= timevals
[1].tv_usec
= 0;
1434 utimes (XSTRING (newname
)->data
, timevals
);
1435 #endif /* not USE_UTIME */
1437 #endif /* HAVE_TIMEVALS */
1440 if (!egetenv ("USE_DOMAIN_ACLS"))
1442 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1446 if (close (ofd
) < 0)
1447 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1453 DEFUN ("make-directory", Fmake_directory
, Smake_directory
, 1, 1, "FMake directory: ",
1454 "Create a directory. One argument, a file name string.")
1456 Lisp_Object dirname
;
1460 CHECK_STRING (dirname
, 0);
1461 dirname
= Fexpand_file_name (dirname
, Qnil
);
1462 dir
= XSTRING (dirname
)->data
;
1464 if (mkdir (dir
, 0777) != 0)
1465 report_file_error ("Creating directory", Flist (1, &dirname
));
1470 DEFUN ("remove-directory", Fremove_directory
, Sremove_directory
, 1, 1, "FRemove directory: ",
1471 "Remove a directory. One argument, a file name string.")
1473 Lisp_Object dirname
;
1477 CHECK_STRING (dirname
, 0);
1478 dirname
= Fexpand_file_name (dirname
, Qnil
);
1479 dir
= XSTRING (dirname
)->data
;
1481 if (rmdir (dir
) != 0)
1482 report_file_error ("Removing directory", Flist (1, &dirname
));
1487 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1488 "Delete specified file. One argument, a file name string.\n\
1489 If file has multiple names, it continues to exist with the other names.")
1491 Lisp_Object filename
;
1493 CHECK_STRING (filename
, 0);
1494 filename
= Fexpand_file_name (filename
, Qnil
);
1495 if (0 > unlink (XSTRING (filename
)->data
))
1496 report_file_error ("Removing old name", Flist (1, &filename
));
1500 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1501 "fRename file: \nFRename %s to file: \np",
1502 "Rename FILE as NEWNAME. Both args strings.\n\
1503 If file has names other than FILE, it continues to have those names.\n\
1504 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1505 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1506 A number as third arg means request confirmation if NEWNAME already exists.\n\
1507 This is what happens in interactive use with M-x.")
1508 (filename
, newname
, ok_if_already_exists
)
1509 Lisp_Object filename
, newname
, ok_if_already_exists
;
1512 Lisp_Object args
[2];
1514 struct gcpro gcpro1
, gcpro2
;
1516 GCPRO2 (filename
, newname
);
1517 CHECK_STRING (filename
, 0);
1518 CHECK_STRING (newname
, 1);
1519 filename
= Fexpand_file_name (filename
, Qnil
);
1520 newname
= Fexpand_file_name (newname
, Qnil
);
1521 if (NILP (ok_if_already_exists
)
1522 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1523 barf_or_query_if_file_exists (newname
, "rename to it",
1524 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1526 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1528 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1529 || 0 > unlink (XSTRING (filename
)->data
))
1534 Fcopy_file (filename
, newname
, ok_if_already_exists
, Qt
);
1535 Fdelete_file (filename
);
1542 report_file_error ("Renaming", Flist (2, args
));
1545 report_file_error ("Renaming", Flist (2, &filename
));
1552 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1553 "fAdd name to file: \nFName to add to %s: \np",
1554 "Give FILE additional name NEWNAME. Both args strings.\n\
1555 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1556 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1557 A number as third arg means request confirmation if NEWNAME already exists.\n\
1558 This is what happens in interactive use with M-x.")
1559 (filename
, newname
, ok_if_already_exists
)
1560 Lisp_Object filename
, newname
, ok_if_already_exists
;
1563 Lisp_Object args
[2];
1565 struct gcpro gcpro1
, gcpro2
;
1567 GCPRO2 (filename
, newname
);
1568 CHECK_STRING (filename
, 0);
1569 CHECK_STRING (newname
, 1);
1570 filename
= Fexpand_file_name (filename
, Qnil
);
1571 newname
= Fexpand_file_name (newname
, Qnil
);
1572 if (NILP (ok_if_already_exists
)
1573 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1574 barf_or_query_if_file_exists (newname
, "make it a new name",
1575 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1576 unlink (XSTRING (newname
)->data
);
1577 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1582 report_file_error ("Adding new name", Flist (2, args
));
1584 report_file_error ("Adding new name", Flist (2, &filename
));
1593 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1594 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1595 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1596 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1597 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1598 A number as third arg means request confirmation if NEWNAME already exists.\n\
1599 This happens for interactive use with M-x.")
1600 (filename
, newname
, ok_if_already_exists
)
1601 Lisp_Object filename
, newname
, ok_if_already_exists
;
1604 Lisp_Object args
[2];
1606 struct gcpro gcpro1
, gcpro2
;
1608 GCPRO2 (filename
, newname
);
1609 CHECK_STRING (filename
, 0);
1610 CHECK_STRING (newname
, 1);
1611 #if 0 /* This made it impossible to make a link to a relative name. */
1612 filename
= Fexpand_file_name (filename
, Qnil
);
1614 newname
= Fexpand_file_name (newname
, Qnil
);
1615 if (NILP (ok_if_already_exists
)
1616 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1617 barf_or_query_if_file_exists (newname
, "make it a link",
1618 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1619 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1621 /* If we didn't complain already, silently delete existing file. */
1622 if (errno
== EEXIST
)
1624 unlink (XSTRING (filename
)->data
);
1625 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1632 report_file_error ("Making symbolic link", Flist (2, args
));
1634 report_file_error ("Making symbolic link", Flist (2, &filename
));
1640 #endif /* S_IFLNK */
1644 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
1645 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1646 "Define the job-wide logical name NAME to have the value STRING.\n\
1647 If STRING is nil or a null string, the logical name NAME is deleted.")
1649 Lisp_Object varname
;
1652 CHECK_STRING (varname
, 0);
1654 delete_logical_name (XSTRING (varname
)->data
);
1657 CHECK_STRING (string
, 1);
1659 if (XSTRING (string
)->size
== 0)
1660 delete_logical_name (XSTRING (varname
)->data
);
1662 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
1671 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
1672 "Open a network connection to PATH using LOGIN as the login string.")
1674 Lisp_Object path
, login
;
1678 CHECK_STRING (path
, 0);
1679 CHECK_STRING (login
, 0);
1681 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
1683 if (netresult
== -1)
1688 #endif /* HPUX_NET */
1690 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
1692 "Return t if file FILENAME specifies an absolute path name.\n\
1693 On Unix, this is a name starting with a `/' or a `~'.")
1695 Lisp_Object filename
;
1699 CHECK_STRING (filename
, 0);
1700 ptr
= XSTRING (filename
)->data
;
1701 if (*ptr
== '/' || *ptr
== '~'
1703 /* ??? This criterion is probably wrong for '<'. */
1704 || index (ptr
, ':') || index (ptr
, '<')
1705 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
1714 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
1715 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1716 See also `file-readable-p' and `file-attributes'.")
1718 Lisp_Object filename
;
1720 Lisp_Object abspath
;
1722 CHECK_STRING (filename
, 0);
1723 abspath
= Fexpand_file_name (filename
, Qnil
);
1724 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
1727 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
1728 "Return t if FILENAME can be executed by you.\n\
1729 For directories this means you can change to that directory.")
1731 Lisp_Object filename
;
1734 Lisp_Object abspath
;
1736 CHECK_STRING (filename
, 0);
1737 abspath
= Fexpand_file_name (filename
, Qnil
);
1738 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
1741 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
1742 "Return t if file FILENAME exists and you can read it.\n\
1743 See also `file-exists-p' and `file-attributes'.")
1745 Lisp_Object filename
;
1747 Lisp_Object abspath
;
1749 CHECK_STRING (filename
, 0);
1750 abspath
= Fexpand_file_name (filename
, Qnil
);
1751 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
1754 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
1755 "If file FILENAME is the name of a symbolic link\n\
1756 returns the name of the file to which it is linked.\n\
1757 Otherwise returns NIL.")
1759 Lisp_Object filename
;
1767 CHECK_STRING (filename
, 0);
1768 filename
= Fexpand_file_name (filename
, Qnil
);
1773 buf
= (char *) xmalloc (bufsize
);
1774 bzero (buf
, bufsize
);
1775 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
1776 if (valsize
< bufsize
) break;
1777 /* Buffer was not long enough */
1786 val
= make_string (buf
, valsize
);
1789 #else /* not S_IFLNK */
1791 #endif /* not S_IFLNK */
1794 /* Having this before file-symlink-p mysteriously caused it to be forgotten
1796 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
1797 "Return t if file FILENAME can be written or created by you.")
1799 Lisp_Object filename
;
1801 Lisp_Object abspath
, dir
;
1803 CHECK_STRING (filename
, 0);
1804 abspath
= Fexpand_file_name (filename
, Qnil
);
1805 if (access (XSTRING (abspath
)->data
, 0) >= 0)
1806 return (access (XSTRING (abspath
)->data
, 2) >= 0) ? Qt
: Qnil
;
1807 dir
= Ffile_name_directory (abspath
);
1810 dir
= Fdirectory_file_name (dir
);
1812 return (access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
1816 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
1817 "Return t if file FILENAME is the name of a directory as a file.\n\
1818 A directory name spec may be given instead; then the value is t\n\
1819 if the directory so specified exists and really is a directory.")
1821 Lisp_Object filename
;
1823 register Lisp_Object abspath
;
1826 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
1828 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1830 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
1833 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
1834 "Return mode bits of FILE, as an integer.")
1836 Lisp_Object filename
;
1838 Lisp_Object abspath
;
1841 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
1843 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1845 return make_number (st
.st_mode
& 07777);
1848 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
1849 "Set mode bits of FILE to MODE (an integer).\n\
1850 Only the 12 low bits of MODE are used.")
1852 Lisp_Object filename
, mode
;
1854 Lisp_Object abspath
;
1856 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
1857 CHECK_NUMBER (mode
, 1);
1860 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
1861 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
1863 if (!egetenv ("USE_DOMAIN_ACLS"))
1866 struct timeval tvp
[2];
1868 /* chmod on apollo also change the file's modtime; need to save the
1869 modtime and then restore it. */
1870 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1872 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
1876 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
1877 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
1879 /* reset the old accessed and modified times. */
1880 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
1882 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
1885 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
1886 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
1893 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
1894 "Return t if file FILE1 is newer than file FILE2.\n\
1895 If FILE1 does not exist, the answer is nil;\n\
1896 otherwise, if FILE2 does not exist, the answer is t.")
1898 Lisp_Object file1
, file2
;
1900 Lisp_Object abspath
;
1904 CHECK_STRING (file1
, 0);
1905 CHECK_STRING (file2
, 0);
1907 abspath
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
1909 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1912 mtime1
= st
.st_mtime
;
1914 abspath
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
1916 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1919 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
1922 close_file_unwind (fd
)
1925 close (XFASTINT (fd
));
1928 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
1930 "Insert contents of file FILENAME after point.\n\
1931 Returns list of absolute pathname and length of data inserted.\n\
1932 If second argument VISIT is non-nil, the buffer's visited filename\n\
1933 and last save file modtime are set, and it is marked unmodified.\n\
1934 If visiting and the file does not exist, visiting is completed\n\
1935 before the error is signaled.")
1937 Lisp_Object filename
, visit
;
1941 register int inserted
= 0;
1942 register int how_much
;
1943 int count
= specpdl_ptr
- specpdl
;
1944 struct gcpro gcpro1
;
1947 if (!NILP (current_buffer
->read_only
))
1948 Fbarf_if_buffer_read_only();
1950 CHECK_STRING (filename
, 0);
1951 filename
= Fexpand_file_name (filename
, Qnil
);
1956 if (stat (XSTRING (filename
)->data
, &st
) < 0
1957 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
1959 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
1960 || fstat (fd
, &st
) < 0)
1961 #endif /* not APOLLO */
1963 if (fd
>= 0) close (fd
);
1965 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1971 record_unwind_protect (close_file_unwind
, make_number (fd
));
1973 /* Supposedly happens on VMS. */
1975 error ("File size is negative");
1977 register Lisp_Object temp
;
1979 /* Make sure point-max won't overflow after this insertion. */
1980 XSET (temp
, Lisp_Int
, st
.st_size
+ Z
);
1981 if (st
.st_size
+ Z
!= XINT (temp
))
1982 error ("maximum buffer size exceeded");
1986 prepare_to_modify_buffer (point
, point
);
1989 if (GAP_SIZE
< st
.st_size
)
1990 make_gap (st
.st_size
- GAP_SIZE
);
1994 int try = min (st
.st_size
- inserted
, 64 << 10);
1995 int this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2012 record_insert (point
, inserted
);
2016 /* Discard the unwind protect */
2017 specpdl_ptr
= specpdl
+ count
;
2020 error ("IO error reading %s: %s",
2021 XSTRING (filename
)->data
, err_str (errno
));
2027 current_buffer
->undo_list
= Qnil
;
2029 stat (XSTRING (filename
)->data
, &st
);
2031 current_buffer
->modtime
= st
.st_mtime
;
2032 current_buffer
->save_modified
= MODIFF
;
2033 current_buffer
->auto_save_modified
= MODIFF
;
2034 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2035 #ifdef CLASH_DETECTION
2036 if (!NILP (current_buffer
->filename
))
2037 unlock_file (current_buffer
->filename
);
2038 unlock_file (filename
);
2039 #endif /* CLASH_DETECTION */
2040 current_buffer
->filename
= filename
;
2041 /* If visiting nonexistent file, return nil. */
2042 if (st
.st_mtime
== -1)
2043 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2046 signal_after_change (point
, 0, inserted
);
2048 RETURN_UNGCPRO (Fcons (filename
,
2049 Fcons (make_number (inserted
),
2053 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2054 "r\nFWrite region to file: ",
2055 "Write current region into specified file.\n\
2056 When called from a program, takes three arguments:\n\
2057 START, END and FILENAME. START and END are buffer positions.\n\
2058 Optional fourth argument APPEND if non-nil means\n\
2059 append to existing file contents (if any).\n\
2060 Optional fifth argument VISIT if t means\n\
2061 set the last-save-file-modtime of buffer to this file's modtime\n\
2062 and mark buffer not modified.\n\
2063 If VISIT is neither t nor nil, it means do not print\n\
2064 the \"Wrote file\" message.\n\
2065 Kludgy feature: if START is a string, then that string is written\n\
2066 to the file, instead of any buffer contents, and END is ignored.")
2067 (start
, end
, filename
, append
, visit
)
2068 Lisp_Object start
, end
, filename
, append
, visit
;
2076 int count
= specpdl_ptr
- specpdl
;
2078 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2081 /* Special kludge to simplify auto-saving */
2084 XFASTINT (start
) = BEG
;
2087 else if (XTYPE (start
) != Lisp_String
)
2088 validate_region (&start
, &end
);
2090 filename
= Fexpand_file_name (filename
, Qnil
);
2091 fn
= XSTRING (filename
)->data
;
2093 #ifdef CLASH_DETECTION
2095 lock_file (filename
);
2096 #endif /* CLASH_DETECTION */
2100 desc
= open (fn
, O_WRONLY
);
2104 if (auto_saving
) /* Overwrite any previous version of autosave file */
2106 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2107 desc
= open (fn
, O_RDWR
);
2109 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2110 ? XSTRING (current_buffer
->filename
)->data
: 0,
2113 else /* Write to temporary name and rename if no errors */
2115 Lisp_Object temp_name
;
2116 temp_name
= Ffile_name_directory (filename
);
2118 if (!NILP (temp_name
))
2120 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2121 build_string ("$$SAVE$$")));
2122 fname
= XSTRING (filename
)->data
;
2123 fn
= XSTRING (temp_name
)->data
;
2124 desc
= creat_copy_attrs (fname
, fn
);
2127 /* If we can't open the temporary file, try creating a new
2128 version of the original file. VMS "creat" creates a
2129 new version rather than truncating an existing file. */
2132 desc
= creat (fn
, 0666);
2133 #if 0 /* This can clobber an existing file and fail to replace it,
2134 if the user runs out of space. */
2137 /* We can't make a new version;
2138 try to truncate and rewrite existing version if any. */
2140 desc
= open (fn
, O_RDWR
);
2146 desc
= creat (fn
, 0666);
2149 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2150 #endif /* not VMS */
2154 #ifdef CLASH_DETECTION
2156 if (!auto_saving
) unlock_file (filename
);
2158 #endif /* CLASH_DETECTION */
2159 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2162 record_unwind_protect (close_file_unwind
, make_number (desc
));
2165 if (lseek (desc
, 0, 2) < 0)
2167 #ifdef CLASH_DETECTION
2168 if (!auto_saving
) unlock_file (filename
);
2169 #endif /* CLASH_DETECTION */
2170 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2175 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2176 * if we do writes that don't end with a carriage return. Furthermore
2177 * it cannot handle writes of more then 16K. The modified
2178 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2179 * this EXCEPT for the last record (iff it doesn't end with a carriage
2180 * return). This implies that if your buffer doesn't end with a carriage
2181 * return, you get one free... tough. However it also means that if
2182 * we make two calls to sys_write (a la the following code) you can
2183 * get one at the gap as well. The easiest way to fix this (honest)
2184 * is to move the gap to the next newline (or the end of the buffer).
2189 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2190 move_gap (find_next_newline (GPT
, 1));
2196 if (XTYPE (start
) == Lisp_String
)
2198 failure
= 0 > e_write (desc
, XSTRING (start
)->data
,
2199 XSTRING (start
)->size
);
2202 else if (XINT (start
) != XINT (end
))
2204 if (XINT (start
) < GPT
)
2206 register int end1
= XINT (end
);
2208 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
),
2209 min (GPT
, end1
) - tem
);
2213 if (XINT (end
) > GPT
&& !failure
)
2216 tem
= max (tem
, GPT
);
2217 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
);
2227 #ifndef alliant /* trinkle@cs.purdue.edu says fsync can return EBUSY
2228 on alliant, for no visible reason. */
2229 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2230 Disk full in NFS may be reported here. */
2231 if (fsync (desc
) < 0)
2232 failure
= 1, save_errno
= errno
;
2238 /* Spurious "file has changed on disk" warnings have been
2239 observed on Suns as well.
2240 It seems that `close' can change the modtime, under nfs.
2242 (This has supposedly been fixed in Sunos 4,
2243 but who knows about all the other machines with NFS?) */
2246 /* On VMS and APOLLO, must do the stat after the close
2247 since closing changes the modtime. */
2250 /* Recall that #if defined does not work on VMS. */
2257 /* NFS can report a write failure now. */
2258 if (close (desc
) < 0)
2259 failure
= 1, save_errno
= errno
;
2262 /* If we wrote to a temporary name and had no errors, rename to real name. */
2266 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2274 /* Discard the unwind protect */
2275 specpdl_ptr
= specpdl
+ count
;
2277 #ifdef CLASH_DETECTION
2279 unlock_file (filename
);
2280 #endif /* CLASH_DETECTION */
2282 /* Do this before reporting IO error
2283 to avoid a "file has changed on disk" warning on
2284 next attempt to save. */
2286 current_buffer
->modtime
= st
.st_mtime
;
2289 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2293 current_buffer
->save_modified
= MODIFF
;
2294 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2295 current_buffer
->filename
= filename
;
2297 else if (!NILP (visit
))
2301 message ("Wrote %s", fn
);
2307 e_write (desc
, addr
, len
)
2309 register char *addr
;
2312 char buf
[16 * 1024];
2313 register char *p
, *end
;
2315 if (!EQ (current_buffer
->selective_display
, Qt
))
2316 return write (desc
, addr
, len
) - len
;
2320 end
= p
+ sizeof buf
;
2325 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
2334 if (write (desc
, buf
, p
- buf
) != p
- buf
)
2340 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
2341 Sverify_visited_file_modtime
, 1, 1, 0,
2342 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2343 This means that the file has not been changed since it was visited or saved.")
2350 CHECK_BUFFER (buf
, 0);
2353 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
2354 if (b
->modtime
== 0) return Qt
;
2356 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
2358 /* If the file doesn't exist now and didn't exist before,
2359 we say that it isn't modified, provided the error is a tame one. */
2360 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
2365 if (st
.st_mtime
== b
->modtime
2366 /* If both are positive, accept them if they are off by one second. */
2367 || (st
.st_mtime
> 0 && b
->modtime
> 0
2368 && (st
.st_mtime
== b
->modtime
+ 1
2369 || st
.st_mtime
== b
->modtime
- 1)))
2374 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
2375 Sclear_visited_file_modtime
, 0, 0, 0,
2376 "Clear out records of last mod time of visited file.\n\
2377 Next attempt to save will certainly not complain of a discrepancy.")
2380 current_buffer
->modtime
= 0;
2384 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
2385 Sset_visited_file_modtime
, 0, 0, 0,
2386 "Update buffer's recorded modification time from the visited file's time.\n\
2387 Useful if the buffer was not read from the file normally\n\
2388 or if the file itself has been changed for some known benign reason.")
2391 register Lisp_Object filename
;
2394 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
2396 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
2397 current_buffer
->modtime
= st
.st_mtime
;
2405 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
2408 message ("Autosaving...error for %s", name
);
2409 Fsleep_for (make_number (1));
2410 message ("Autosaving...error!for %s", name
);
2411 Fsleep_for (make_number (1));
2412 message ("Autosaving...error for %s", name
);
2413 Fsleep_for (make_number (1));
2423 /* Get visited file's mode to become the auto save file's mode. */
2424 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
2425 /* But make sure we can overwrite it later! */
2426 auto_save_mode_bits
= st
.st_mode
| 0600;
2428 auto_save_mode_bits
= 0666;
2431 Fwrite_region (Qnil
, Qnil
,
2432 current_buffer
->auto_save_file_name
,
2436 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
2437 "Auto-save all buffers that need it.\n\
2438 This is all buffers that have auto-saving enabled\n\
2439 and are changed since last auto-saved.\n\
2440 Auto-saving writes the buffer into a file\n\
2441 so that your editing is not lost if the system crashes.\n\
2442 This file is not the file you visited; that changes only when you save.\n\n\
2443 Non-nil first argument means do not print any message if successful.\n\
2444 Non-nil second argumet means save only current buffer.")
2448 struct buffer
*old
= current_buffer
, *b
;
2449 Lisp_Object tail
, buf
;
2451 char *omessage
= echo_area_glyphs
;
2452 extern minibuf_level
;
2454 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2455 point to non-strings reached from Vbuffer_alist. */
2461 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2462 eventually call do-auto-save, so don't err here in that case. */
2463 if (!NILP (Vrun_hooks
))
2464 call1 (Vrun_hooks
, intern ("auto-save-hook"));
2466 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2467 tail
= XCONS (tail
)->cdr
)
2469 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
2471 /* Check for auto save enabled
2472 and file changed since last auto save
2473 and file changed since last real save. */
2474 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
2475 && b
->save_modified
< BUF_MODIFF (b
)
2476 && b
->auto_save_modified
< BUF_MODIFF (b
))
2478 if ((XFASTINT (b
->save_length
) * 10
2479 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
2480 /* A short file is likely to change a large fraction;
2481 spare the user annoying messages. */
2482 && XFASTINT (b
->save_length
) > 5000
2483 /* These messages are frequent and annoying for `*mail*'. */
2484 && !EQ (b
->filename
, Qnil
))
2486 /* It has shrunk too much; turn off auto-saving here. */
2487 message ("Buffer %s has shrunk a lot; auto save turned off there",
2488 XSTRING (b
->name
)->data
);
2489 /* User can reenable saving with M-x auto-save. */
2490 b
->auto_save_file_name
= Qnil
;
2491 /* Prevent warning from repeating if user does so. */
2492 XFASTINT (b
->save_length
) = 0;
2493 Fsleep_for (make_number (1));
2496 set_buffer_internal (b
);
2497 if (!auto_saved
&& NILP (nomsg
))
2498 message1 ("Auto-saving...");
2499 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
2501 b
->auto_save_modified
= BUF_MODIFF (b
);
2502 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2503 set_buffer_internal (old
);
2508 record_auto_save ();
2510 if (auto_saved
&& NILP (nomsg
))
2511 message1 (omessage
? omessage
: "Auto-saving...done");
2517 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
2518 Sset_buffer_auto_saved
, 0, 0, 0,
2519 "Mark current buffer as auto-saved with its current text.\n\
2520 No auto-save file will be written until the buffer changes again.")
2523 current_buffer
->auto_save_modified
= MODIFF
;
2524 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2528 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
2530 "Return t if buffer has been auto-saved since last read in or saved.")
2533 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
2536 /* Reading and completing file names */
2537 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
2539 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
2541 "Internal subroutine for read-file-name. Do not call this.")
2542 (string
, dir
, action
)
2543 Lisp_Object string
, dir
, action
;
2544 /* action is nil for complete, t for return list of completions,
2545 lambda for verify final value */
2547 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
2549 if (XSTRING (string
)->size
== 0)
2554 if (EQ (action
, Qlambda
))
2559 orig_string
= string
;
2560 string
= Fsubstitute_in_file_name (string
);
2561 name
= Ffile_name_nondirectory (string
);
2562 realdir
= Ffile_name_directory (string
);
2566 realdir
= Fexpand_file_name (realdir
, dir
);
2571 specdir
= Ffile_name_directory (string
);
2572 val
= Ffile_name_completion (name
, realdir
);
2573 if (XTYPE (val
) != Lisp_String
)
2575 if (NILP (Fstring_equal (string
, orig_string
)))
2580 if (!NILP (specdir
))
2581 val
= concat2 (specdir
, val
);
2584 register unsigned char *old
, *new;
2588 osize
= XSTRING (val
)->size
;
2589 /* Quote "$" as "$$" to get it past substitute-in-file-name */
2590 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
2591 if (*old
++ == '$') count
++;
2594 old
= XSTRING (val
)->data
;
2595 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
2596 new = XSTRING (val
)->data
;
2597 for (n
= osize
; n
> 0; n
--)
2608 #endif /* Not VMS */
2612 if (EQ (action
, Qt
))
2613 return Ffile_name_all_completions (name
, realdir
);
2614 /* Only other case actually used is ACTION = lambda */
2616 /* Supposedly this helps commands such as `cd' that read directory names,
2617 but can someone explain how it helps them? -- RMS */
2618 if (XSTRING (name
)->size
== 0)
2621 return Ffile_exists_p (string
);
2624 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
2625 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
2626 Value is not expanded---you must call `expand-file-name' yourself.\n\
2627 Default name to DEFAULT if user enters a null string.\n\
2628 (If DEFAULT is omitted, the visited file name is used.)\n\
2629 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
2630 Non-nil and non-t means also require confirmation after completion.\n\
2631 Fifth arg INITIAL specifies text to start with.\n\
2632 DIR defaults to current buffer's directory default.")
2633 (prompt
, dir
, defalt
, mustmatch
, initial
)
2634 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
2636 Lisp_Object val
, insdef
, tem
, backup_n
;
2637 struct gcpro gcpro1
, gcpro2
;
2638 register char *homedir
;
2642 dir
= current_buffer
->directory
;
2644 defalt
= current_buffer
->filename
;
2646 /* If dir starts with user's homedir, change that to ~. */
2647 homedir
= (char *) egetenv ("HOME");
2649 && XTYPE (dir
) == Lisp_String
2650 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
2651 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
2653 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
2654 XSTRING (dir
)->size
- strlen (homedir
) + 1);
2655 XSTRING (dir
)->data
[0] = '~';
2658 if (insert_default_directory
)
2661 if (!NILP (initial
))
2663 Lisp_Object args
[2];
2667 insdef
= Fconcat (2, args
);
2668 backup_n
= make_number (- (XSTRING (initial
)->size
));
2675 insdef
= build_string ("");
2680 count
= specpdl_ptr
- specpdl
;
2681 specbind (intern ("completion-ignore-case"), Qt
);
2684 GCPRO2 (insdef
, defalt
);
2685 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
2687 insert_default_directory
? insdef
: Qnil
, backup_n
);
2690 unbind_to (count
, Qnil
);
2695 error ("No file name specified");
2696 tem
= Fstring_equal (val
, insdef
);
2697 if (!NILP (tem
) && !NILP (defalt
))
2699 return Fsubstitute_in_file_name (val
);
2702 #if 0 /* Old version */
2703 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
2704 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
2705 Value is not expanded---you must call `expand-file-name' yourself.\n\
2706 Default name to DEFAULT if user enters a null string.\n\
2707 (If DEFAULT is omitted, the visited file name is used.)\n\
2708 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
2709 Non-nil and non-t means also require confirmation after completion.\n\
2710 Fifth arg INITIAL specifies text to start with.\n\
2711 DIR defaults to current buffer's directory default.")
2712 (prompt
, dir
, defalt
, mustmatch
, initial
)
2713 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
2715 Lisp_Object val
, insdef
, tem
;
2716 struct gcpro gcpro1
, gcpro2
;
2717 register char *homedir
;
2721 dir
= current_buffer
->directory
;
2723 defalt
= current_buffer
->filename
;
2725 /* If dir starts with user's homedir, change that to ~. */
2726 homedir
= (char *) egetenv ("HOME");
2728 && XTYPE (dir
) == Lisp_String
2729 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
2730 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
2732 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
2733 XSTRING (dir
)->size
- strlen (homedir
) + 1);
2734 XSTRING (dir
)->data
[0] = '~';
2737 if (!NILP (initial
))
2739 else if (insert_default_directory
)
2742 insdef
= build_string ("");
2745 count
= specpdl_ptr
- specpdl
;
2746 specbind (intern ("completion-ignore-case"), Qt
);
2749 GCPRO2 (insdef
, defalt
);
2750 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
2752 insert_default_directory
? insdef
: Qnil
, Qnil
);
2755 unbind_to (count
, Qnil
);
2760 error ("No file name specified");
2761 tem
= Fstring_equal (val
, insdef
);
2762 if (!NILP (tem
) && !NILP (defalt
))
2764 return Fsubstitute_in_file_name (val
);
2766 #endif /* Old version */
2770 Qfile_error
= intern ("file-error");
2771 staticpro (&Qfile_error
);
2772 Qfile_already_exists
= intern("file-already-exists");
2773 staticpro (&Qfile_already_exists
);
2775 Fput (Qfile_error
, Qerror_conditions
,
2776 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
2777 Fput (Qfile_error
, Qerror_message
,
2778 build_string ("File error"));
2780 Fput (Qfile_already_exists
, Qerror_conditions
,
2781 Fcons (Qfile_already_exists
,
2782 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
2783 Fput (Qfile_already_exists
, Qerror_message
,
2784 build_string ("File already exists"));
2786 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
2787 "*Non-nil means when reading a filename start with default dir in minibuffer.");
2788 insert_default_directory
= 1;
2790 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
2791 "*Non-nil means write new files with record format `stmlf'.\n\
2792 nil means use format `var'. This variable is meaningful only on VMS.");
2793 vms_stmlf_recfm
= 0;
2795 defsubr (&Sfile_name_directory
);
2796 defsubr (&Sfile_name_nondirectory
);
2797 defsubr (&Sfile_name_as_directory
);
2798 defsubr (&Sdirectory_file_name
);
2799 defsubr (&Smake_temp_name
);
2800 defsubr (&Sexpand_file_name
);
2801 defsubr (&Ssubstitute_in_file_name
);
2802 defsubr (&Scopy_file
);
2803 defsubr (&Smake_directory
);
2804 defsubr (&Sremove_directory
);
2805 defsubr (&Sdelete_file
);
2806 defsubr (&Srename_file
);
2807 defsubr (&Sadd_name_to_file
);
2809 defsubr (&Smake_symbolic_link
);
2810 #endif /* S_IFLNK */
2812 defsubr (&Sdefine_logical_name
);
2815 defsubr (&Ssysnetunam
);
2816 #endif /* HPUX_NET */
2817 defsubr (&Sfile_name_absolute_p
);
2818 defsubr (&Sfile_exists_p
);
2819 defsubr (&Sfile_executable_p
);
2820 defsubr (&Sfile_readable_p
);
2821 defsubr (&Sfile_writable_p
);
2822 defsubr (&Sfile_symlink_p
);
2823 defsubr (&Sfile_directory_p
);
2824 defsubr (&Sfile_modes
);
2825 defsubr (&Sset_file_modes
);
2826 defsubr (&Sfile_newer_than_file_p
);
2827 defsubr (&Sinsert_file_contents
);
2828 defsubr (&Swrite_region
);
2829 defsubr (&Sverify_visited_file_modtime
);
2830 defsubr (&Sclear_visited_file_modtime
);
2831 defsubr (&Sset_visited_file_modtime
);
2832 defsubr (&Sdo_auto_save
);
2833 defsubr (&Sset_buffer_auto_saved
);
2834 defsubr (&Srecent_auto_save_p
);
2836 defsubr (&Sread_file_name_internal
);
2837 defsubr (&Sread_file_name
);