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")
72 #else /* not NEED_TIME_H */
75 #endif /* HAVE_TIMEVAL */
76 #endif /* not NEED_TIME_H */
89 #define min(a, b) ((a) < (b) ? (a) : (b))
90 #define max(a, b) ((a) > (b) ? (a) : (b))
92 /* Nonzero during writing of auto-save files */
95 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
96 a new file with the same mode as the original */
97 int auto_save_mode_bits
;
99 /* Nonzero means, when reading a filename in the minibuffer,
100 start out by inserting the default directory into the minibuffer. */
101 int insert_default_directory
;
103 /* On VMS, nonzero means write new files with record format stmlf.
104 Zero means use var format. */
107 Lisp_Object Qfile_error
, Qfile_already_exists
;
109 report_file_error (string
, data
)
113 Lisp_Object errstring
;
115 if (errno
>= 0 && errno
< sys_nerr
)
116 errstring
= build_string (sys_errlist
[errno
]);
118 errstring
= build_string ("undocumented error code");
120 /* System error messages are capitalized. Downcase the initial
121 unless it is followed by a slash. */
122 if (XSTRING (errstring
)->data
[1] != '/')
123 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
126 Fsignal (Qfile_error
,
127 Fcons (build_string (string
), Fcons (errstring
, data
)));
130 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
132 "Return the directory component in file name NAME.\n\
133 Return nil if NAME does not include a directory.\n\
134 Otherwise return a directory spec.\n\
135 Given a Unix syntax file name, returns a string ending in slash;\n\
136 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
140 register unsigned char *beg
;
141 register unsigned char *p
;
143 CHECK_STRING (file
, 0);
145 beg
= XSTRING (file
)->data
;
146 p
= beg
+ XSTRING (file
)->size
;
148 while (p
!= beg
&& p
[-1] != '/'
150 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
156 return make_string (beg
, p
- beg
);
159 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
161 "Return file name NAME sans its directory.\n\
162 For example, in a Unix-syntax file name,\n\
163 this is everything after the last slash,\n\
164 or the entire name if it contains no slash.")
168 register unsigned char *beg
, *p
, *end
;
170 CHECK_STRING (file
, 0);
172 beg
= XSTRING (file
)->data
;
173 end
= p
= beg
+ XSTRING (file
)->size
;
175 while (p
!= beg
&& p
[-1] != '/'
177 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
181 return make_string (p
, end
- p
);
185 file_name_as_directory (out
, in
)
188 int size
= strlen (in
) - 1;
193 /* Is it already a directory string? */
194 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
196 /* Is it a VMS directory file name? If so, hack VMS syntax. */
197 else if (! index (in
, '/')
198 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
199 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
200 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
201 || ! strncmp (&in
[size
- 5], ".dir", 4))
202 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
203 && in
[size
] == '1')))
205 register char *p
, *dot
;
209 dir:x.dir --> dir:[x]
210 dir:[x]y.dir --> dir:[x.y] */
212 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
215 strncpy (out
, in
, p
- in
);
234 dot
= index (p
, '.');
237 /* blindly remove any extension */
238 size
= strlen (out
) + (dot
- p
);
239 strncat (out
, p
, dot
- p
);
250 /* For Unix syntax, Append a slash if necessary */
251 if (out
[size
] != '/')
257 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
258 Sfile_name_as_directory
, 1, 1, 0,
259 "Return a string representing file FILENAME interpreted as a directory.\n\
260 This operation exists because a directory is also a file, but its name as\n\
261 a directory is different from its name as a file.\n\
262 The result can be used as the value of `default-directory'\n\
263 or passed as second argument to `expand-file-name'.\n\
264 For a Unix-syntax file name, just appends a slash.\n\
265 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
271 CHECK_STRING (file
, 0);
274 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
275 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
279 * Convert from directory name to filename.
281 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
282 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
283 * On UNIX, it's simple: just make sure there is a terminating /
285 * Value is nonzero if the string output is different from the input.
288 directory_file_name (src
, dst
)
296 struct FAB fab
= cc$rms_fab
;
297 struct NAM nam
= cc$rms_nam
;
298 char esa
[NAM$C_MAXRSS
];
303 if (! index (src
, '/')
304 && (src
[slen
- 1] == ']'
305 || src
[slen
- 1] == ':'
306 || src
[slen
- 1] == '>'))
308 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
310 fab
.fab$b_fns
= slen
;
311 fab
.fab$l_nam
= &nam
;
312 fab
.fab$l_fop
= FAB$M_NAM
;
315 nam
.nam$b_ess
= sizeof esa
;
316 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
318 /* We call SYS$PARSE to handle such things as [--] for us. */
319 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
321 slen
= nam
.nam$b_esl
;
322 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
327 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
329 /* what about when we have logical_name:???? */
330 if (src
[slen
- 1] == ':')
331 { /* Xlate logical name and see what we get */
332 ptr
= strcpy (dst
, src
); /* upper case for getenv */
335 if ('a' <= *ptr
&& *ptr
<= 'z')
339 dst
[slen
- 1] = 0; /* remove colon */
340 if (!(src
= egetenv (dst
)))
342 /* should we jump to the beginning of this procedure?
343 Good points: allows us to use logical names that xlate
345 Bad points: can be a problem if we just translated to a device
347 For now, I'll punt and always expect VMS names, and hope for
350 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
351 { /* no recursion here! */
357 { /* not a directory spec */
362 bracket
= src
[slen
- 1];
364 /* If bracket is ']' or '>', bracket - 2 is the corresponding
366 ptr
= index (src
, bracket
- 2);
368 { /* no opening bracket */
372 if (!(rptr
= rindex (src
, '.')))
375 strncpy (dst
, src
, slen
);
379 dst
[slen
++] = bracket
;
384 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
385 then translate the device and recurse. */
386 if (dst
[slen
- 1] == ':'
387 && dst
[slen
- 2] != ':' /* skip decnet nodes */
388 && strcmp(src
+ slen
, "[000000]") == 0)
390 dst
[slen
- 1] = '\0';
391 if ((ptr
= egetenv (dst
))
392 && (rlen
= strlen (ptr
) - 1) > 0
393 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
394 && ptr
[rlen
- 1] == '.')
398 return directory_file_name (ptr
, dst
);
403 strcat (dst
, "[000000]");
407 rlen
= strlen (rptr
) - 1;
408 strncat (dst
, rptr
, rlen
);
409 dst
[slen
+ rlen
] = '\0';
410 strcat (dst
, ".DIR.1");
414 /* Process as Unix format: just remove any final slash.
415 But leave "/" unchanged; do not change it to "". */
417 if (dst
[slen
- 1] == '/' && slen
> 1)
422 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
424 "Returns the file name of the directory named DIR.\n\
425 This is the name of the file that holds the data for the directory DIR.\n\
426 This operation exists because a directory is also a file, but its name as\n\
427 a directory is different from its name as a file.\n\
428 In Unix-syntax, this function just removes the final slash.\n\
429 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
430 it returns a file name such as \"[X]Y.DIR.1\".")
432 Lisp_Object directory
;
436 CHECK_STRING (directory
, 0);
438 if (NULL (directory
))
441 /* 20 extra chars is insufficient for VMS, since we might perform a
442 logical name translation. an equivalence string can be up to 255
443 chars long, so grab that much extra space... - sss */
444 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
446 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
448 directory_file_name (XSTRING (directory
)->data
, buf
);
449 return build_string (buf
);
452 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
453 "Generate temporary file name (string) starting with PREFIX (a string).\n\
454 The Emacs process number forms part of the result,\n\
455 so there is no danger of generating a name being used by another process.")
460 val
= concat2 (prefix
, build_string ("XXXXXX"));
461 mktemp (XSTRING (val
)->data
);
465 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
466 "Convert FILENAME to absolute, and canonicalize it.\n\
467 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
468 (does not start with slash); if DEFAULT is nil or missing,\n\
469 the current buffer's value of default-directory is used.\n\
470 Filenames containing `.' or `..' as components are simplified;\n\
471 initial `~/' expands to your home directory.\n\
472 See also the function `substitute-in-file-name'.")
474 Lisp_Object name
, defalt
;
478 register unsigned char *newdir
, *p
, *o
;
480 unsigned char *target
;
484 unsigned char * colon
= 0;
485 unsigned char * close
= 0;
486 unsigned char * slash
= 0;
487 unsigned char * brack
= 0;
488 int lbrack
= 0, rbrack
= 0;
492 CHECK_STRING (name
, 0);
495 /* Filenames on VMS are always upper case. */
496 name
= Fupcase (name
);
499 nm
= XSTRING (name
)->data
;
501 /* If nm is absolute, flush ...// and detect /./ and /../.
502 If no /./ or /../ we can return right away. */
514 if (p
[0] == '/' && p
[1] == '/'
516 /* // at start of filename is meaningful on Apollo system */
521 if (p
[0] == '/' && p
[1] == '~')
522 nm
= p
+ 1, lose
= 1;
523 if (p
[0] == '/' && p
[1] == '.'
524 && (p
[2] == '/' || p
[2] == 0
525 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
531 /* if dev:[dir]/, move nm to / */
532 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
533 nm
= (brack
? brack
+ 1 : colon
+ 1);
542 /* VMS pre V4.4,convert '-'s in filenames. */
543 if (lbrack
== rbrack
)
545 if (dots
< 2) /* this is to allow negative version numbers */
550 if (lbrack
> rbrack
&&
551 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
552 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
558 /* count open brackets, reset close bracket pointer */
559 if (p
[0] == '[' || p
[0] == '<')
561 /* count close brackets, set close bracket pointer */
562 if (p
[0] == ']' || p
[0] == '>')
564 /* detect ][ or >< */
565 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
567 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
568 nm
= p
+ 1, lose
= 1;
569 if (p
[0] == ':' && (colon
|| slash
))
570 /* if dev1:[dir]dev2:, move nm to dev2: */
576 /* if /pathname/dev:, move nm to dev: */
579 /* if node::dev:, move colon following dev */
580 else if (colon
&& colon
[-1] == ':')
582 /* if dev1:dev2:, move nm to dev2: */
583 else if (colon
&& colon
[-1] != ':')
588 if (p
[0] == ':' && !colon
)
594 if (lbrack
== rbrack
)
597 else if (p
[0] == '.')
606 return build_string (sys_translate_unix (nm
));
608 if (nm
== XSTRING (name
)->data
)
610 return build_string (nm
);
614 /* Now determine directory to start with and put it in newdir */
618 if (nm
[0] == '~') /* prefix ~ */
623 || nm
[1] == 0)/* ~/filename */
625 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
626 newdir
= (unsigned char *) "";
629 nm
++; /* Don't leave the slash in nm. */
632 else /* ~user/filename */
634 for (p
= nm
; *p
&& (*p
!= '/'
639 o
= (unsigned char *) alloca (p
- nm
+ 1);
640 bcopy ((char *) nm
, o
, p
- nm
);
643 pw
= (struct passwd
*) getpwnam (o
+ 1);
645 error ("\"%s\" isn't a registered user", o
+ 1);
648 nm
= p
+ 1; /* skip the terminator */
652 newdir
= (unsigned char *) pw
-> pw_dir
;
662 defalt
= current_buffer
->directory
;
663 CHECK_STRING (defalt
, 1);
664 newdir
= XSTRING (defalt
)->data
;
669 /* Get rid of any slash at the end of newdir. */
670 int length
= strlen (newdir
);
671 if (newdir
[length
- 1] == '/')
673 unsigned char *temp
= (unsigned char *) alloca (length
);
674 bcopy (newdir
, temp
, length
- 1);
675 temp
[length
- 1] = 0;
683 /* Now concatenate the directory and name to new space in the stack frame */
684 tlen
+= strlen (nm
) + 1;
685 target
= (unsigned char *) alloca (tlen
);
691 if (nm
[0] == 0 || nm
[0] == '/')
692 strcpy (target
, newdir
);
695 file_name_as_directory (target
, newdir
);
700 if (index (target
, '/'))
701 strcpy (target
, sys_translate_unix (target
));
704 /* Now canonicalize by removing /. and /foo/.. if they appear */
712 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
718 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
719 /* brackets are offset from each other by 2 */
722 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
723 /* convert [foo][bar] to [bar] */
724 while (o
[-1] != '[' && o
[-1] != '<')
726 else if (*p
== '-' && *o
!= '.')
729 else if (p
[0] == '-' && o
[-1] == '.' &&
730 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
731 /* flush .foo.- ; leave - if stopped by '[' or '<' */
735 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
736 if (p
[1] == '.') /* foo.-.bar ==> bar*/
738 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
740 /* else [foo.-] ==> [-] */
746 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
747 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
757 else if (!strncmp (p
, "//", 2)
759 /* // at start of filename is meaningful in Apollo system */
767 else if (p
[0] == '/' && p
[1] == '.' &&
768 (p
[2] == '/' || p
[2] == 0))
770 else if (!strncmp (p
, "/..", 3)
771 /* `/../' is the "superroot" on certain file systems. */
773 && (p
[3] == '/' || p
[3] == 0))
775 while (o
!= target
&& *--o
!= '/')
778 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
782 if (o
== target
&& *o
== '/')
793 return make_string (target
, o
- target
);
796 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
797 "Convert FILENAME to absolute, and canonicalize it.\n\
798 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
799 (does not start with slash); if DEFAULT is nil or missing,\n\
800 the current buffer's value of default-directory is used.\n\
801 Filenames containing `.' or `..' as components are simplified;\n\
802 initial `~/' expands to your home directory.\n\
803 See also the function `substitute-in-file-name'.")
805 Lisp_Object name
, defalt
;
809 register unsigned char *newdir
, *p
, *o
;
811 unsigned char *target
;
815 unsigned char * colon
= 0;
816 unsigned char * close
= 0;
817 unsigned char * slash
= 0;
818 unsigned char * brack
= 0;
819 int lbrack
= 0, rbrack
= 0;
823 CHECK_STRING (name
, 0);
826 /* Filenames on VMS are always upper case. */
827 name
= Fupcase (name
);
830 nm
= XSTRING (name
)->data
;
832 /* If nm is absolute, flush ...// and detect /./ and /../.
833 If no /./ or /../ we can return right away. */
845 if (p
[0] == '/' && p
[1] == '/'
847 /* // at start of filename is meaningful on Apollo system */
852 if (p
[0] == '/' && p
[1] == '~')
853 nm
= p
+ 1, lose
= 1;
854 if (p
[0] == '/' && p
[1] == '.'
855 && (p
[2] == '/' || p
[2] == 0
856 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
862 /* if dev:[dir]/, move nm to / */
863 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
864 nm
= (brack
? brack
+ 1 : colon
+ 1);
873 /* VMS pre V4.4,convert '-'s in filenames. */
874 if (lbrack
== rbrack
)
876 if (dots
< 2) /* this is to allow negative version numbers */
881 if (lbrack
> rbrack
&&
882 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
883 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
889 /* count open brackets, reset close bracket pointer */
890 if (p
[0] == '[' || p
[0] == '<')
892 /* count close brackets, set close bracket pointer */
893 if (p
[0] == ']' || p
[0] == '>')
895 /* detect ][ or >< */
896 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
898 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
899 nm
= p
+ 1, lose
= 1;
900 if (p
[0] == ':' && (colon
|| slash
))
901 /* if dev1:[dir]dev2:, move nm to dev2: */
907 /* if /pathname/dev:, move nm to dev: */
910 /* if node::dev:, move colon following dev */
911 else if (colon
&& colon
[-1] == ':')
913 /* if dev1:dev2:, move nm to dev2: */
914 else if (colon
&& colon
[-1] != ':')
919 if (p
[0] == ':' && !colon
)
925 if (lbrack
== rbrack
)
928 else if (p
[0] == '.')
937 return build_string (sys_translate_unix (nm
));
939 if (nm
== XSTRING (name
)->data
)
941 return build_string (nm
);
945 /* Now determine directory to start with and put it in NEWDIR */
949 if (nm
[0] == '~') /* prefix ~ */
954 || nm
[1] == 0)/* ~/filename */
956 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
957 newdir
= (unsigned char *) "";
960 nm
++; /* Don't leave the slash in nm. */
963 else /* ~user/filename */
965 /* Get past ~ to user */
966 unsigned char *user
= nm
+ 1;
967 /* Find end of name. */
968 unsigned char *ptr
= (unsigned char *) index (user
, '/');
969 int len
= ptr
? ptr
- user
: strlen (user
);
971 unsigned char *ptr1
= index (user
, ':');
972 if (ptr1
!= 0 && ptr1
- user
< len
)
975 /* Copy the user name into temp storage. */
976 o
= (unsigned char *) alloca (len
+ 1);
977 bcopy ((char *) user
, o
, len
);
980 /* Look up the user name. */
981 pw
= (struct passwd
*) getpwnam (o
+ 1);
983 error ("\"%s\" isn't a registered user", o
+ 1);
985 newdir
= (unsigned char *) pw
->pw_dir
;
987 /* Discard the user name from NM. */
998 defalt
= current_buffer
->directory
;
999 CHECK_STRING (defalt
, 1);
1000 newdir
= XSTRING (defalt
)->data
;
1003 /* Now concatenate the directory and name to new space in the stack frame */
1005 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1006 target
= (unsigned char *) alloca (tlen
);
1012 if (nm
[0] == 0 || nm
[0] == '/')
1013 strcpy (target
, newdir
);
1016 file_name_as_directory (target
, newdir
);
1019 strcat (target
, nm
);
1021 if (index (target
, '/'))
1022 strcpy (target
, sys_translate_unix (target
));
1025 /* Now canonicalize by removing /. and /foo/.. if they appear */
1033 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1039 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1040 /* brackets are offset from each other by 2 */
1043 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1044 /* convert [foo][bar] to [bar] */
1045 while (o
[-1] != '[' && o
[-1] != '<')
1047 else if (*p
== '-' && *o
!= '.')
1050 else if (p
[0] == '-' && o
[-1] == '.' &&
1051 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1052 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1056 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1057 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1059 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1061 /* else [foo.-] ==> [-] */
1067 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1068 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1078 else if (!strncmp (p
, "//", 2)
1080 /* // at start of filename is meaningful in Apollo system */
1088 else if (p
[0] == '/' && p
[1] == '.' &&
1089 (p
[2] == '/' || p
[2] == 0))
1091 else if (!strncmp (p
, "/..", 3)
1092 /* `/../' is the "superroot" on certain file systems. */
1094 && (p
[3] == '/' || p
[3] == 0))
1096 while (o
!= target
&& *--o
!= '/')
1099 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1103 if (o
== target
&& *o
== '/')
1111 #endif /* not VMS */
1114 return make_string (target
, o
- target
);
1118 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1119 Ssubstitute_in_file_name
, 1, 1, 0,
1120 "Substitute environment variables referred to in FILENAME.\n\
1121 `$FOO' where FOO is an environment variable name means to substitute\n\
1122 the value of that variable. The variable name should be terminated\n\
1123 with a character not a letter, digit or underscore; otherwise, enclose\n\
1124 the entire variable name in braces.\n\
1125 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1126 On VMS, `$' substitution is not done; this function does little and only\n\
1127 duplicates what `expand-file-name' does.")
1133 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1134 unsigned char *target
;
1136 int substituted
= 0;
1139 CHECK_STRING (string
, 0);
1141 nm
= XSTRING (string
)->data
;
1142 endp
= nm
+ XSTRING (string
)->size
;
1144 /* If /~ or // appears, discard everything through first slash. */
1146 for (p
= nm
; p
!= endp
; p
++)
1150 /* // at start of file name is meaningful in Apollo system */
1151 (p
[0] == '/' && p
- 1 != nm
)
1152 #else /* not APOLLO */
1154 #endif /* not APOLLO */
1158 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1171 return build_string (nm
);
1174 /* See if any variables are substituted into the string
1175 and find the total length of their values in `total' */
1177 for (p
= nm
; p
!= endp
;)
1187 /* "$$" means a single "$" */
1196 while (p
!= endp
&& *p
!= '}') p
++;
1197 if (*p
!= '}') goto missingclose
;
1203 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1207 /* Copy out the variable name */
1208 target
= (unsigned char *) alloca (s
- o
+ 1);
1209 strncpy (target
, o
, s
- o
);
1212 /* Get variable value */
1213 o
= (unsigned char *) egetenv (target
);
1214 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1217 if (!o
&& !strcmp (target
, "USER"))
1218 o
= egetenv ("LOGNAME");
1221 if (!o
) goto badvar
;
1222 total
+= strlen (o
);
1229 /* If substitution required, recopy the string and do it */
1230 /* Make space in stack frame for the new copy */
1231 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1234 /* Copy the rest of the name through, replacing $ constructs with values */
1251 while (p
!= endp
&& *p
!= '}') p
++;
1252 if (*p
!= '}') goto missingclose
;
1258 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1262 /* Copy out the variable name */
1263 target
= (unsigned char *) alloca (s
- o
+ 1);
1264 strncpy (target
, o
, s
- o
);
1267 /* Get variable value */
1268 o
= (unsigned char *) egetenv (target
);
1269 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1272 if (!o
&& !strcmp (target
, "USER"))
1273 o
= egetenv ("LOGNAME");
1285 /* If /~ or // appears, discard everything through first slash. */
1287 for (p
= xnm
; p
!= x
; p
++)
1290 /* // at start of file name is meaningful in Apollo system */
1291 (p
[0] == '/' && p
- 1 != xnm
)
1292 #else /* not APOLLO */
1294 #endif /* not APOLLO */
1296 && p
!= nm
&& p
[-1] == '/')
1299 return make_string (xnm
, x
- xnm
);
1302 error ("Bad format environment-variable substitution");
1304 error ("Missing \"}\" in environment-variable substitution");
1306 error ("Substituting nonexistent environment variable \"%s\"", target
);
1309 #endif /* not VMS */
1313 expand_and_dir_to_file (filename
, defdir
)
1314 Lisp_Object filename
, defdir
;
1316 register Lisp_Object abspath
;
1318 abspath
= Fexpand_file_name (filename
, defdir
);
1321 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1322 if (c
== ':' || c
== ']' || c
== '>')
1323 abspath
= Fdirectory_file_name (abspath
);
1326 /* Remove final slash, if any (unless path is root).
1327 stat behaves differently depending! */
1328 if (XSTRING (abspath
)->size
> 1
1329 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1331 if (EQ (abspath
, filename
))
1332 abspath
= Fcopy_sequence (abspath
);
1333 XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] = 0;
1339 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1340 Lisp_Object absname
;
1341 unsigned char *querystring
;
1344 register Lisp_Object tem
;
1345 struct gcpro gcpro1
;
1347 if (access (XSTRING (absname
)->data
, 4) >= 0)
1350 Fsignal (Qfile_already_exists
,
1351 Fcons (build_string ("File already exists"),
1352 Fcons (absname
, Qnil
)));
1354 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1355 XSTRING (absname
)->data
, querystring
));
1358 Fsignal (Qfile_already_exists
,
1359 Fcons (build_string ("File already exists"),
1360 Fcons (absname
, Qnil
)));
1365 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1366 "fCopy file: \nFCopy %s to file: \np",
1367 "Copy FILE to NEWNAME. Both args must be strings.\n\
1368 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1369 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1370 A number as third arg means request confirmation if NEWNAME already exists.\n\
1371 This is what happens in interactive use with M-x.\n\
1372 Fourth arg non-nil means give the new file the same last-modified time\n\
1373 that the old one has. (This works on only some systems.)")
1374 (filename
, newname
, ok_if_already_exists
, keep_date
)
1375 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1378 char buf
[16 * 1024];
1380 struct gcpro gcpro1
, gcpro2
;
1382 GCPRO2 (filename
, newname
);
1383 CHECK_STRING (filename
, 0);
1384 CHECK_STRING (newname
, 1);
1385 filename
= Fexpand_file_name (filename
, Qnil
);
1386 newname
= Fexpand_file_name (newname
, Qnil
);
1387 if (NULL (ok_if_already_exists
)
1388 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1389 barf_or_query_if_file_exists (newname
, "copy to it",
1390 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1392 ifd
= open (XSTRING (filename
)->data
, 0);
1394 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1397 /* Create the copy file with the same record format as the input file */
1398 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1400 ofd
= creat (XSTRING (newname
)->data
, 0666);
1405 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1408 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1409 if (write (ofd
, buf
, n
) != n
)
1413 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1416 if (fstat (ifd
, &st
) >= 0)
1419 if (!NULL (keep_date
))
1422 /* AIX has utimes() in compatibility package, but it dies. So use good old
1423 utime interface instead. */
1428 tv
.atime
= st
.st_atime
;
1429 tv
.mtime
= st
.st_mtime
;
1430 utime (XSTRING (newname
)->data
, &tv
);
1431 #else /* not USE_UTIME */
1432 struct timeval timevals
[2];
1433 timevals
[0].tv_sec
= st
.st_atime
;
1434 timevals
[1].tv_sec
= st
.st_mtime
;
1435 timevals
[0].tv_usec
= timevals
[1].tv_usec
= 0;
1436 utimes (XSTRING (newname
)->data
, timevals
);
1437 #endif /* not USE_UTIME */
1439 #endif /* HAVE_TIMEVALS */
1442 if (!egetenv ("USE_DOMAIN_ACLS"))
1444 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1448 if (close (ofd
) < 0)
1449 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1455 DEFUN ("make-directory", Fmake_directory
, Smake_directory
, 1, 1, "FMake directory: ",
1456 "Create a directory. One argument, a file name string.")
1458 Lisp_Object dirname
;
1462 CHECK_STRING (dirname
, 0);
1463 dirname
= Fexpand_file_name (dirname
, Qnil
);
1464 dir
= XSTRING (dirname
)->data
;
1466 if (mkdir (dir
, 0777) != 0)
1467 report_file_error ("Creating directory", Flist (1, &dirname
));
1472 DEFUN ("remove-directory", Fremove_directory
, Sremove_directory
, 1, 1, "FRemove directory: ",
1473 "Remove a directory. One argument, a file name string.")
1475 Lisp_Object dirname
;
1479 CHECK_STRING (dirname
, 0);
1480 dirname
= Fexpand_file_name (dirname
, Qnil
);
1481 dir
= XSTRING (dirname
)->data
;
1483 if (rmdir (dir
) != 0)
1484 report_file_error ("Removing directory", Flist (1, &dirname
));
1489 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1490 "Delete specified file. One argument, a file name string.\n\
1491 If file has multiple names, it continues to exist with the other names.")
1493 Lisp_Object filename
;
1495 CHECK_STRING (filename
, 0);
1496 filename
= Fexpand_file_name (filename
, Qnil
);
1497 if (0 > unlink (XSTRING (filename
)->data
))
1498 report_file_error ("Removing old name", Flist (1, &filename
));
1502 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1503 "fRename file: \nFRename %s to file: \np",
1504 "Rename FILE as NEWNAME. Both args strings.\n\
1505 If file has names other than FILE, it continues to have those names.\n\
1506 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1507 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1508 A number as third arg means request confirmation if NEWNAME already exists.\n\
1509 This is what happens in interactive use with M-x.")
1510 (filename
, newname
, ok_if_already_exists
)
1511 Lisp_Object filename
, newname
, ok_if_already_exists
;
1514 Lisp_Object args
[2];
1516 struct gcpro gcpro1
, gcpro2
;
1518 GCPRO2 (filename
, newname
);
1519 CHECK_STRING (filename
, 0);
1520 CHECK_STRING (newname
, 1);
1521 filename
= Fexpand_file_name (filename
, Qnil
);
1522 newname
= Fexpand_file_name (newname
, Qnil
);
1523 if (NULL (ok_if_already_exists
)
1524 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1525 barf_or_query_if_file_exists (newname
, "rename to it",
1526 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1528 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1530 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1531 || 0 > unlink (XSTRING (filename
)->data
))
1536 Fcopy_file (filename
, newname
, ok_if_already_exists
, Qt
);
1537 Fdelete_file (filename
);
1544 report_file_error ("Renaming", Flist (2, args
));
1547 report_file_error ("Renaming", Flist (2, &filename
));
1554 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1555 "fAdd name to file: \nFName to add to %s: \np",
1556 "Give FILE additional name NEWNAME. Both args strings.\n\
1557 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1558 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1559 A number as third arg means request confirmation if NEWNAME already exists.\n\
1560 This is what happens in interactive use with M-x.")
1561 (filename
, newname
, ok_if_already_exists
)
1562 Lisp_Object filename
, newname
, ok_if_already_exists
;
1565 Lisp_Object args
[2];
1567 struct gcpro gcpro1
, gcpro2
;
1569 GCPRO2 (filename
, newname
);
1570 CHECK_STRING (filename
, 0);
1571 CHECK_STRING (newname
, 1);
1572 filename
= Fexpand_file_name (filename
, Qnil
);
1573 newname
= Fexpand_file_name (newname
, Qnil
);
1574 if (NULL (ok_if_already_exists
)
1575 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1576 barf_or_query_if_file_exists (newname
, "make it a new name",
1577 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1578 unlink (XSTRING (newname
)->data
);
1579 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1584 report_file_error ("Adding new name", Flist (2, args
));
1586 report_file_error ("Adding new name", Flist (2, &filename
));
1595 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1596 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1597 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1598 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1599 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1600 A number as third arg means request confirmation if NEWNAME already exists.\n\
1601 This happens for interactive use with M-x.")
1602 (filename
, newname
, ok_if_already_exists
)
1603 Lisp_Object filename
, newname
, ok_if_already_exists
;
1606 Lisp_Object args
[2];
1608 struct gcpro gcpro1
, gcpro2
;
1610 GCPRO2 (filename
, newname
);
1611 CHECK_STRING (filename
, 0);
1612 CHECK_STRING (newname
, 1);
1613 #if 0 /* This made it impossible to make a link to a relative name. */
1614 filename
= Fexpand_file_name (filename
, Qnil
);
1616 newname
= Fexpand_file_name (newname
, Qnil
);
1617 if (NULL (ok_if_already_exists
)
1618 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1619 barf_or_query_if_file_exists (newname
, "make it a link",
1620 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1621 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1623 /* If we didn't complain already, silently delete existing file. */
1624 if (errno
== EEXIST
)
1626 unlink (XSTRING (filename
)->data
);
1627 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1634 report_file_error ("Making symbolic link", Flist (2, args
));
1636 report_file_error ("Making symbolic link", Flist (2, &filename
));
1642 #endif /* S_IFLNK */
1646 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
1647 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1648 "Define the job-wide logical name NAME to have the value STRING.\n\
1649 If STRING is nil or a null string, the logical name NAME is deleted.")
1651 Lisp_Object varname
;
1654 CHECK_STRING (varname
, 0);
1656 delete_logical_name (XSTRING (varname
)->data
);
1659 CHECK_STRING (string
, 1);
1661 if (XSTRING (string
)->size
== 0)
1662 delete_logical_name (XSTRING (varname
)->data
);
1664 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
1673 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
1674 "Open a network connection to PATH using LOGIN as the login string.")
1676 Lisp_Object path
, login
;
1680 CHECK_STRING (path
, 0);
1681 CHECK_STRING (login
, 0);
1683 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
1685 if (netresult
== -1)
1690 #endif /* HPUX_NET */
1692 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
1694 "Return t if file FILENAME specifies an absolute path name.\n\
1695 On Unix, this is a name starting with a `/' or a `~'.")
1697 Lisp_Object filename
;
1701 CHECK_STRING (filename
, 0);
1702 ptr
= XSTRING (filename
)->data
;
1703 if (*ptr
== '/' || *ptr
== '~'
1705 /* ??? This criterion is probably wrong for '<'. */
1706 || index (ptr
, ':') || index (ptr
, '<')
1707 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
1716 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
1717 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1718 See also `file-readable-p' and `file-attributes'.")
1720 Lisp_Object filename
;
1722 Lisp_Object abspath
;
1724 CHECK_STRING (filename
, 0);
1725 abspath
= Fexpand_file_name (filename
, Qnil
);
1726 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
1729 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
1730 "Return t if FILENAME can be executed by you.\n\
1731 For directories this means you can change to that directory.")
1733 Lisp_Object filename
;
1736 Lisp_Object abspath
;
1738 CHECK_STRING (filename
, 0);
1739 abspath
= Fexpand_file_name (filename
, Qnil
);
1740 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
1743 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
1744 "Return t if file FILENAME exists and you can read it.\n\
1745 See also `file-exists-p' and `file-attributes'.")
1747 Lisp_Object filename
;
1749 Lisp_Object abspath
;
1751 CHECK_STRING (filename
, 0);
1752 abspath
= Fexpand_file_name (filename
, Qnil
);
1753 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
1756 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
1757 "If file FILENAME is the name of a symbolic link\n\
1758 returns the name of the file to which it is linked.\n\
1759 Otherwise returns NIL.")
1761 Lisp_Object filename
;
1769 CHECK_STRING (filename
, 0);
1770 filename
= Fexpand_file_name (filename
, Qnil
);
1775 buf
= (char *) xmalloc (bufsize
);
1776 bzero (buf
, bufsize
);
1777 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
1778 if (valsize
< bufsize
) break;
1779 /* Buffer was not long enough */
1788 val
= make_string (buf
, valsize
);
1791 #else /* not S_IFLNK */
1793 #endif /* not S_IFLNK */
1796 /* Having this before file-symlink-p mysteriously caused it to be forgotten
1798 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
1799 "Return t if file FILENAME can be written or created by you.")
1801 Lisp_Object filename
;
1803 Lisp_Object abspath
, dir
;
1805 CHECK_STRING (filename
, 0);
1806 abspath
= Fexpand_file_name (filename
, Qnil
);
1807 if (access (XSTRING (abspath
)->data
, 0) >= 0)
1808 return (access (XSTRING (abspath
)->data
, 2) >= 0) ? Qt
: Qnil
;
1809 dir
= Ffile_name_directory (abspath
);
1812 dir
= Fdirectory_file_name (dir
);
1814 return (access (!NULL (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
1818 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
1819 "Return t if file FILENAME is the name of a directory as a file.\n\
1820 A directory name spec may be given instead; then the value is t\n\
1821 if the directory so specified exists and really is a directory.")
1823 Lisp_Object filename
;
1825 register Lisp_Object abspath
;
1828 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
1830 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1832 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
1835 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
1836 "Return mode bits of FILE, as an integer.")
1838 Lisp_Object filename
;
1840 Lisp_Object abspath
;
1843 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
1845 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1847 return make_number (st
.st_mode
& 07777);
1850 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
1851 "Set mode bits of FILE to MODE (an integer).\n\
1852 Only the 12 low bits of MODE are used.")
1854 Lisp_Object filename
, mode
;
1856 Lisp_Object abspath
;
1858 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
1859 CHECK_NUMBER (mode
, 1);
1862 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
1863 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
1865 if (!egetenv ("USE_DOMAIN_ACLS"))
1868 struct timeval tvp
[2];
1870 /* chmod on apollo also change the file's modtime; need to save the
1871 modtime and then restore it. */
1872 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1874 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
1878 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
1879 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
1881 /* reset the old accessed and modified times. */
1882 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
1884 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
1887 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
1888 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
1895 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
1896 "Return t if file FILE1 is newer than file FILE2.\n\
1897 If FILE1 does not exist, the answer is nil;\n\
1898 otherwise, if FILE2 does not exist, the answer is t.")
1900 Lisp_Object file1
, file2
;
1902 Lisp_Object abspath
;
1906 CHECK_STRING (file1
, 0);
1907 CHECK_STRING (file2
, 0);
1909 abspath
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
1911 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1914 mtime1
= st
.st_mtime
;
1916 abspath
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
1918 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1921 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
1924 close_file_unwind (fd
)
1927 close (XFASTINT (fd
));
1930 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
1932 "Insert contents of file FILENAME after point.\n\
1933 Returns list of absolute pathname and length of data inserted.\n\
1934 If second argument VISIT is non-nil, the buffer's visited filename\n\
1935 and last save file modtime are set, and it is marked unmodified.\n\
1936 If visiting and the file does not exist, visiting is completed\n\
1937 before the error is signaled.")
1939 Lisp_Object filename
, visit
;
1943 register int inserted
= 0;
1944 register int how_much
;
1945 int count
= specpdl_ptr
- specpdl
;
1946 struct gcpro gcpro1
;
1949 if (!NULL (current_buffer
->read_only
))
1950 Fbarf_if_buffer_read_only();
1952 CHECK_STRING (filename
, 0);
1953 filename
= Fexpand_file_name (filename
, Qnil
);
1958 if (stat (XSTRING (filename
)->data
, &st
) < 0
1959 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
1961 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
1962 || fstat (fd
, &st
) < 0)
1963 #endif /* not APOLLO */
1965 if (fd
>= 0) close (fd
);
1967 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1973 record_unwind_protect (close_file_unwind
, make_number (fd
));
1975 /* Supposedly happens on VMS. */
1977 error ("File size is negative");
1979 register Lisp_Object temp
;
1981 /* Make sure point-max won't overflow after this insertion. */
1982 XSET (temp
, Lisp_Int
, st
.st_size
+ Z
);
1983 if (st
.st_size
+ Z
!= XINT (temp
))
1984 error ("maximum buffer size exceeded");
1988 prepare_to_modify_buffer (point
, point
);
1991 if (GAP_SIZE
< st
.st_size
)
1992 make_gap (st
.st_size
- GAP_SIZE
);
1996 int try = min (st
.st_size
- inserted
, 64 << 10);
1997 int this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2014 record_insert (point
, inserted
);
2018 /* Discard the unwind protect */
2019 specpdl_ptr
= specpdl
+ count
;
2022 error ("IO error reading %s: %s",
2023 XSTRING (filename
)->data
, err_str (errno
));
2029 current_buffer
->undo_list
= Qnil
;
2031 stat (XSTRING (filename
)->data
, &st
);
2033 current_buffer
->modtime
= st
.st_mtime
;
2034 current_buffer
->save_modified
= MODIFF
;
2035 current_buffer
->auto_save_modified
= MODIFF
;
2036 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2037 #ifdef CLASH_DETECTION
2038 if (!NULL (current_buffer
->filename
))
2039 unlock_file (current_buffer
->filename
);
2040 unlock_file (filename
);
2041 #endif /* CLASH_DETECTION */
2042 current_buffer
->filename
= filename
;
2043 /* If visiting nonexistent file, return nil. */
2044 if (st
.st_mtime
== -1)
2045 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2048 signal_after_change (point
, 0, inserted
);
2050 RETURN_UNGCPRO (Fcons (filename
,
2051 Fcons (make_number (inserted
),
2055 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2056 "r\nFWrite region to file: ",
2057 "Write current region into specified file.\n\
2058 When called from a program, takes three arguments:\n\
2059 START, END and FILENAME. START and END are buffer positions.\n\
2060 Optional fourth argument APPEND if non-nil means\n\
2061 append to existing file contents (if any).\n\
2062 Optional fifth argument VISIT if t means\n\
2063 set the last-save-file-modtime of buffer to this file's modtime\n\
2064 and mark buffer not modified.\n\
2065 If VISIT is neither t nor nil, it means do not print\n\
2066 the \"Wrote file\" message.\n\
2067 Kludgy feature: if START is a string, then that string is written\n\
2068 to the file, instead of any buffer contents, and END is ignored.")
2069 (start
, end
, filename
, append
, visit
)
2070 Lisp_Object start
, end
, filename
, append
, visit
;
2078 int count
= specpdl_ptr
- specpdl
;
2080 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2083 /* Special kludge to simplify auto-saving */
2086 XFASTINT (start
) = BEG
;
2089 else if (XTYPE (start
) != Lisp_String
)
2090 validate_region (&start
, &end
);
2092 filename
= Fexpand_file_name (filename
, Qnil
);
2093 fn
= XSTRING (filename
)->data
;
2095 #ifdef CLASH_DETECTION
2097 lock_file (filename
);
2098 #endif /* CLASH_DETECTION */
2102 desc
= open (fn
, O_WRONLY
);
2106 if (auto_saving
) /* Overwrite any previous version of autosave file */
2108 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2109 desc
= open (fn
, O_RDWR
);
2111 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2112 ? XSTRING (current_buffer
->filename
)->data
: 0,
2115 else /* Write to temporary name and rename if no errors */
2117 Lisp_Object temp_name
;
2118 temp_name
= Ffile_name_directory (filename
);
2120 if (!NULL (temp_name
))
2122 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2123 build_string ("$$SAVE$$")));
2124 fname
= XSTRING (filename
)->data
;
2125 fn
= XSTRING (temp_name
)->data
;
2126 desc
= creat_copy_attrs (fname
, fn
);
2129 /* If we can't open the temporary file, try creating a new
2130 version of the original file. VMS "creat" creates a
2131 new version rather than truncating an existing file. */
2134 desc
= creat (fn
, 0666);
2135 #if 0 /* This can clobber an existing file and fail to replace it,
2136 if the user runs out of space. */
2139 /* We can't make a new version;
2140 try to truncate and rewrite existing version if any. */
2142 desc
= open (fn
, O_RDWR
);
2148 desc
= creat (fn
, 0666);
2151 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2152 #endif /* not VMS */
2156 #ifdef CLASH_DETECTION
2158 if (!auto_saving
) unlock_file (filename
);
2160 #endif /* CLASH_DETECTION */
2161 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2164 record_unwind_protect (close_file_unwind
, make_number (desc
));
2167 if (lseek (desc
, 0, 2) < 0)
2169 #ifdef CLASH_DETECTION
2170 if (!auto_saving
) unlock_file (filename
);
2171 #endif /* CLASH_DETECTION */
2172 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2177 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2178 * if we do writes that don't end with a carriage return. Furthermore
2179 * it cannot handle writes of more then 16K. The modified
2180 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2181 * this EXCEPT for the last record (iff it doesn't end with a carriage
2182 * return). This implies that if your buffer doesn't end with a carriage
2183 * return, you get one free... tough. However it also means that if
2184 * we make two calls to sys_write (a la the following code) you can
2185 * get one at the gap as well. The easiest way to fix this (honest)
2186 * is to move the gap to the next newline (or the end of the buffer).
2191 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2192 move_gap (find_next_newline (GPT
, 1));
2198 if (XTYPE (start
) == Lisp_String
)
2200 failure
= 0 > e_write (desc
, XSTRING (start
)->data
,
2201 XSTRING (start
)->size
);
2204 else if (XINT (start
) != XINT (end
))
2206 if (XINT (start
) < GPT
)
2208 register int end1
= XINT (end
);
2210 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
),
2211 min (GPT
, end1
) - tem
);
2215 if (XINT (end
) > GPT
&& !failure
)
2218 tem
= max (tem
, GPT
);
2219 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
);
2229 #ifndef alliant /* trinkle@cs.purdue.edu says fsync can return EBUSY
2230 on alliant, for no visible reason. */
2231 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2232 Disk full in NFS may be reported here. */
2233 if (fsync (desc
) < 0)
2234 failure
= 1, save_errno
= errno
;
2240 /* Spurious "file has changed on disk" warnings have been
2241 observed on Suns as well.
2242 It seems that `close' can change the modtime, under nfs.
2244 (This has supposedly been fixed in Sunos 4,
2245 but who knows about all the other machines with NFS?) */
2248 /* On VMS and APOLLO, must do the stat after the close
2249 since closing changes the modtime. */
2252 /* Recall that #if defined does not work on VMS. */
2259 /* NFS can report a write failure now. */
2260 if (close (desc
) < 0)
2261 failure
= 1, save_errno
= errno
;
2264 /* If we wrote to a temporary name and had no errors, rename to real name. */
2268 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2276 /* Discard the unwind protect */
2277 specpdl_ptr
= specpdl
+ count
;
2279 #ifdef CLASH_DETECTION
2281 unlock_file (filename
);
2282 #endif /* CLASH_DETECTION */
2284 /* Do this before reporting IO error
2285 to avoid a "file has changed on disk" warning on
2286 next attempt to save. */
2288 current_buffer
->modtime
= st
.st_mtime
;
2291 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2295 current_buffer
->save_modified
= MODIFF
;
2296 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2297 current_buffer
->filename
= filename
;
2299 else if (!NULL (visit
))
2303 message ("Wrote %s", fn
);
2309 e_write (desc
, addr
, len
)
2311 register char *addr
;
2314 char buf
[16 * 1024];
2315 register char *p
, *end
;
2317 if (!EQ (current_buffer
->selective_display
, Qt
))
2318 return write (desc
, addr
, len
) - len
;
2322 end
= p
+ sizeof buf
;
2327 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
2336 if (write (desc
, buf
, p
- buf
) != p
- buf
)
2342 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
2343 Sverify_visited_file_modtime
, 1, 1, 0,
2344 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2345 This means that the file has not been changed since it was visited or saved.")
2352 CHECK_BUFFER (buf
, 0);
2355 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
2356 if (b
->modtime
== 0) return Qt
;
2358 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
2360 /* If the file doesn't exist now and didn't exist before,
2361 we say that it isn't modified, provided the error is a tame one. */
2362 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
2367 if (st
.st_mtime
== b
->modtime
2368 /* If both are positive, accept them if they are off by one second. */
2369 || (st
.st_mtime
> 0 && b
->modtime
> 0
2370 && (st
.st_mtime
== b
->modtime
+ 1
2371 || st
.st_mtime
== b
->modtime
- 1)))
2376 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
2377 Sclear_visited_file_modtime
, 0, 0, 0,
2378 "Clear out records of last mod time of visited file.\n\
2379 Next attempt to save will certainly not complain of a discrepancy.")
2382 current_buffer
->modtime
= 0;
2386 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
2387 Sset_visited_file_modtime
, 0, 0, 0,
2388 "Update buffer's recorded modification time from the visited file's time.\n\
2389 Useful if the buffer was not read from the file normally\n\
2390 or if the file itself has been changed for some known benign reason.")
2393 register Lisp_Object filename
;
2396 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
2398 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
2399 current_buffer
->modtime
= st
.st_mtime
;
2407 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
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));
2414 message ("Autosaving...error for %s", name
);
2415 Fsleep_for (make_number (1));
2425 /* Get visited file's mode to become the auto save file's mode. */
2426 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
2427 /* But make sure we can overwrite it later! */
2428 auto_save_mode_bits
= st
.st_mode
| 0600;
2430 auto_save_mode_bits
= 0666;
2433 Fwrite_region (Qnil
, Qnil
,
2434 current_buffer
->auto_save_file_name
,
2438 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
2439 "Auto-save all buffers that need it.\n\
2440 This is all buffers that have auto-saving enabled\n\
2441 and are changed since last auto-saved.\n\
2442 Auto-saving writes the buffer into a file\n\
2443 so that your editing is not lost if the system crashes.\n\
2444 This file is not the file you visited; that changes only when you save.\n\n\
2445 Non-nil first argument means do not print any message if successful.\n\
2446 Non-nil second argumet means save only current buffer.")
2450 struct buffer
*old
= current_buffer
, *b
;
2451 Lisp_Object tail
, buf
;
2453 char *omessage
= echo_area_glyphs
;
2454 extern minibuf_level
;
2456 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2457 point to non-strings reached from Vbuffer_alist. */
2463 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2464 eventually call do-auto-save, so don't err here in that case. */
2465 if (!NULL (Vrun_hooks
))
2466 call1 (Vrun_hooks
, intern ("auto-save-hook"));
2468 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2469 tail
= XCONS (tail
)->cdr
)
2471 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
2473 /* Check for auto save enabled
2474 and file changed since last auto save
2475 and file changed since last real save. */
2476 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
2477 && b
->save_modified
< BUF_MODIFF (b
)
2478 && b
->auto_save_modified
< BUF_MODIFF (b
))
2480 if ((XFASTINT (b
->save_length
) * 10
2481 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
2482 /* A short file is likely to change a large fraction;
2483 spare the user annoying messages. */
2484 && XFASTINT (b
->save_length
) > 5000
2485 /* These messages are frequent and annoying for `*mail*'. */
2486 && !EQ (b
->filename
, Qnil
))
2488 /* It has shrunk too much; turn off auto-saving here. */
2489 message ("Buffer %s has shrunk a lot; auto save turned off there",
2490 XSTRING (b
->name
)->data
);
2491 /* User can reenable saving with M-x auto-save. */
2492 b
->auto_save_file_name
= Qnil
;
2493 /* Prevent warning from repeating if user does so. */
2494 XFASTINT (b
->save_length
) = 0;
2495 Fsleep_for (make_number (1));
2498 set_buffer_internal (b
);
2499 if (!auto_saved
&& NULL (nomsg
))
2500 message1 ("Auto-saving...");
2501 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
2503 b
->auto_save_modified
= BUF_MODIFF (b
);
2504 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2505 set_buffer_internal (old
);
2510 record_auto_save ();
2512 if (auto_saved
&& NULL (nomsg
))
2513 message1 (omessage
? omessage
: "Auto-saving...done");
2519 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
2520 Sset_buffer_auto_saved
, 0, 0, 0,
2521 "Mark current buffer as auto-saved with its current text.\n\
2522 No auto-save file will be written until the buffer changes again.")
2525 current_buffer
->auto_save_modified
= MODIFF
;
2526 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2530 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
2532 "Return t if buffer has been auto-saved since last read in or saved.")
2535 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
2538 /* Reading and completing file names */
2539 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
2541 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
2543 "Internal subroutine for read-file-name. Do not call this.")
2544 (string
, dir
, action
)
2545 Lisp_Object string
, dir
, action
;
2546 /* action is nil for complete, t for return list of completions,
2547 lambda for verify final value */
2549 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
2551 if (XSTRING (string
)->size
== 0)
2556 if (EQ (action
, Qlambda
))
2561 orig_string
= string
;
2562 string
= Fsubstitute_in_file_name (string
);
2563 name
= Ffile_name_nondirectory (string
);
2564 realdir
= Ffile_name_directory (string
);
2568 realdir
= Fexpand_file_name (realdir
, dir
);
2573 specdir
= Ffile_name_directory (string
);
2574 val
= Ffile_name_completion (name
, realdir
);
2575 if (XTYPE (val
) != Lisp_String
)
2577 if (NULL (Fstring_equal (string
, orig_string
)))
2582 if (!NULL (specdir
))
2583 val
= concat2 (specdir
, val
);
2586 register unsigned char *old
, *new;
2590 osize
= XSTRING (val
)->size
;
2591 /* Quote "$" as "$$" to get it past substitute-in-file-name */
2592 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
2593 if (*old
++ == '$') count
++;
2596 old
= XSTRING (val
)->data
;
2597 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
2598 new = XSTRING (val
)->data
;
2599 for (n
= osize
; n
> 0; n
--)
2610 #endif /* Not VMS */
2614 if (EQ (action
, Qt
))
2615 return Ffile_name_all_completions (name
, realdir
);
2616 /* Only other case actually used is ACTION = lambda */
2618 /* Supposedly this helps commands such as `cd' that read directory names,
2619 but can someone explain how it helps them? -- RMS */
2620 if (XSTRING (name
)->size
== 0)
2623 return Ffile_exists_p (string
);
2626 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
2627 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
2628 Value is not expanded---you must call `expand-file-name' yourself.\n\
2629 Default name to DEFAULT if user enters a null string.\n\
2630 (If DEFAULT is omitted, the visited file name is used.)\n\
2631 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
2632 Non-nil and non-t means also require confirmation after completion.\n\
2633 Fifth arg INITIAL specifies text to start with.\n\
2634 DIR defaults to current buffer's directory default.")
2635 (prompt
, dir
, defalt
, mustmatch
, initial
)
2636 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
2638 Lisp_Object val
, insdef
, tem
, backup_n
;
2639 struct gcpro gcpro1
, gcpro2
;
2640 register char *homedir
;
2644 dir
= current_buffer
->directory
;
2646 defalt
= current_buffer
->filename
;
2648 /* If dir starts with user's homedir, change that to ~. */
2649 homedir
= (char *) egetenv ("HOME");
2651 && XTYPE (dir
) == Lisp_String
2652 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
2653 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
2655 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
2656 XSTRING (dir
)->size
- strlen (homedir
) + 1);
2657 XSTRING (dir
)->data
[0] = '~';
2660 if (insert_default_directory
)
2663 if (!NULL (initial
))
2665 Lisp_Object args
[2];
2669 insdef
= Fconcat (2, args
);
2670 backup_n
= make_number (- (XSTRING (initial
)->size
));
2677 insdef
= build_string ("");
2682 count
= specpdl_ptr
- specpdl
;
2683 specbind (intern ("completion-ignore-case"), Qt
);
2686 GCPRO2 (insdef
, defalt
);
2687 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
2689 insert_default_directory
? insdef
: Qnil
, backup_n
);
2692 unbind_to (count
, Qnil
);
2697 error ("No file name specified");
2698 tem
= Fstring_equal (val
, insdef
);
2699 if (!NULL (tem
) && !NULL (defalt
))
2701 return Fsubstitute_in_file_name (val
);
2704 #if 0 /* Old version */
2705 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
2706 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
2707 Value is not expanded---you must call `expand-file-name' yourself.\n\
2708 Default name to DEFAULT if user enters a null string.\n\
2709 (If DEFAULT is omitted, the visited file name is used.)\n\
2710 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
2711 Non-nil and non-t means also require confirmation after completion.\n\
2712 Fifth arg INITIAL specifies text to start with.\n\
2713 DIR defaults to current buffer's directory default.")
2714 (prompt
, dir
, defalt
, mustmatch
, initial
)
2715 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
2717 Lisp_Object val
, insdef
, tem
;
2718 struct gcpro gcpro1
, gcpro2
;
2719 register char *homedir
;
2723 dir
= current_buffer
->directory
;
2725 defalt
= current_buffer
->filename
;
2727 /* If dir starts with user's homedir, change that to ~. */
2728 homedir
= (char *) egetenv ("HOME");
2730 && XTYPE (dir
) == Lisp_String
2731 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
2732 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
2734 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
2735 XSTRING (dir
)->size
- strlen (homedir
) + 1);
2736 XSTRING (dir
)->data
[0] = '~';
2739 if (!NULL (initial
))
2741 else if (insert_default_directory
)
2744 insdef
= build_string ("");
2747 count
= specpdl_ptr
- specpdl
;
2748 specbind (intern ("completion-ignore-case"), Qt
);
2751 GCPRO2 (insdef
, defalt
);
2752 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
2754 insert_default_directory
? insdef
: Qnil
, Qnil
);
2757 unbind_to (count
, Qnil
);
2762 error ("No file name specified");
2763 tem
= Fstring_equal (val
, insdef
);
2764 if (!NULL (tem
) && !NULL (defalt
))
2766 return Fsubstitute_in_file_name (val
);
2768 #endif /* Old version */
2772 Qfile_error
= intern ("file-error");
2773 staticpro (&Qfile_error
);
2774 Qfile_already_exists
= intern("file-already-exists");
2775 staticpro (&Qfile_already_exists
);
2777 Fput (Qfile_error
, Qerror_conditions
,
2778 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
2779 Fput (Qfile_error
, Qerror_message
,
2780 build_string ("File error"));
2782 Fput (Qfile_already_exists
, Qerror_conditions
,
2783 Fcons (Qfile_already_exists
,
2784 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
2785 Fput (Qfile_already_exists
, Qerror_message
,
2786 build_string ("File already exists"));
2788 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
2789 "*Non-nil means when reading a filename start with default dir in minibuffer.");
2790 insert_default_directory
= 1;
2792 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
2793 "*Non-nil means write new files with record format `stmlf'.\n\
2794 nil means use format `var'. This variable is meaningful only on VMS.");
2795 vms_stmlf_recfm
= 0;
2797 defsubr (&Sfile_name_directory
);
2798 defsubr (&Sfile_name_nondirectory
);
2799 defsubr (&Sfile_name_as_directory
);
2800 defsubr (&Sdirectory_file_name
);
2801 defsubr (&Smake_temp_name
);
2802 defsubr (&Sexpand_file_name
);
2803 defsubr (&Ssubstitute_in_file_name
);
2804 defsubr (&Scopy_file
);
2805 defsubr (&Smake_directory
);
2806 defsubr (&Sremove_directory
);
2807 defsubr (&Sdelete_file
);
2808 defsubr (&Srename_file
);
2809 defsubr (&Sadd_name_to_file
);
2811 defsubr (&Smake_symbolic_link
);
2812 #endif /* S_IFLNK */
2814 defsubr (&Sdefine_logical_name
);
2817 defsubr (&Ssysnetunam
);
2818 #endif /* HPUX_NET */
2819 defsubr (&Sfile_name_absolute_p
);
2820 defsubr (&Sfile_exists_p
);
2821 defsubr (&Sfile_executable_p
);
2822 defsubr (&Sfile_readable_p
);
2823 defsubr (&Sfile_writable_p
);
2824 defsubr (&Sfile_symlink_p
);
2825 defsubr (&Sfile_directory_p
);
2826 defsubr (&Sfile_modes
);
2827 defsubr (&Sset_file_modes
);
2828 defsubr (&Sfile_newer_than_file_p
);
2829 defsubr (&Sinsert_file_contents
);
2830 defsubr (&Swrite_region
);
2831 defsubr (&Sverify_visited_file_modtime
);
2832 defsubr (&Sclear_visited_file_modtime
);
2833 defsubr (&Sset_visited_file_modtime
);
2834 defsubr (&Sdo_auto_save
);
2835 defsubr (&Sset_buffer_auto_saved
);
2836 defsubr (&Srecent_auto_save_p
);
2838 defsubr (&Sread_file_name_internal
);
2839 defsubr (&Sread_file_name
);