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\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 KEEP-TIME non-nil means give the new file the same\n\
1373 last-modified time as the old one. (This works on only some systems.)\n\
1374 A prefix arg makes KEEP-TIME non-nil.")
1375 (filename
, newname
, ok_if_already_exists
, keep_date
)
1376 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1379 char buf
[16 * 1024];
1381 struct gcpro gcpro1
, gcpro2
;
1383 GCPRO2 (filename
, newname
);
1384 CHECK_STRING (filename
, 0);
1385 CHECK_STRING (newname
, 1);
1386 filename
= Fexpand_file_name (filename
, Qnil
);
1387 newname
= Fexpand_file_name (newname
, Qnil
);
1388 if (NULL (ok_if_already_exists
)
1389 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1390 barf_or_query_if_file_exists (newname
, "copy to it",
1391 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1393 ifd
= open (XSTRING (filename
)->data
, 0);
1395 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1398 /* Create the copy file with the same record format as the input file */
1399 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1401 ofd
= creat (XSTRING (newname
)->data
, 0666);
1406 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1409 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1410 if (write (ofd
, buf
, n
) != n
)
1414 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1417 if (fstat (ifd
, &st
) >= 0)
1420 if (!NULL (keep_date
))
1423 /* AIX has utimes() in compatibility package, but it dies. So use good old
1424 utime interface instead. */
1429 tv
.atime
= st
.st_atime
;
1430 tv
.mtime
= st
.st_mtime
;
1431 utime (XSTRING (newname
)->data
, &tv
);
1432 #else /* not USE_UTIME */
1433 struct timeval timevals
[2];
1434 timevals
[0].tv_sec
= st
.st_atime
;
1435 timevals
[1].tv_sec
= st
.st_mtime
;
1436 timevals
[0].tv_usec
= timevals
[1].tv_usec
= 0;
1437 utimes (XSTRING (newname
)->data
, timevals
);
1438 #endif /* not USE_UTIME */
1440 #endif /* HAVE_TIMEVALS */
1443 if (!egetenv ("USE_DOMAIN_ACLS"))
1445 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1449 if (close (ofd
) < 0)
1450 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1456 DEFUN ("make-directory", Fmake_directory
, Smake_directory
, 1, 1, "FMake directory: ",
1457 "Create a directory. One argument, a file name string.")
1459 Lisp_Object dirname
;
1463 CHECK_STRING (dirname
, 0);
1464 dirname
= Fexpand_file_name (dirname
, Qnil
);
1465 dir
= XSTRING (dirname
)->data
;
1467 if (mkdir (dir
, 0777) != 0)
1468 report_file_error ("Creating directory", Flist (1, &dirname
));
1473 DEFUN ("remove-directory", Fremove_directory
, Sremove_directory
, 1, 1, "FRemove directory: ",
1474 "Remove a directory. One argument, a file name string.")
1476 Lisp_Object dirname
;
1480 CHECK_STRING (dirname
, 0);
1481 dirname
= Fexpand_file_name (dirname
, Qnil
);
1482 dir
= XSTRING (dirname
)->data
;
1484 if (rmdir (dir
) != 0)
1485 report_file_error ("Removing directory", Flist (1, &dirname
));
1490 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1491 "Delete specified file. One argument, a file name string.\n\
1492 If file has multiple names, it continues to exist with the other names.")
1494 Lisp_Object filename
;
1496 CHECK_STRING (filename
, 0);
1497 filename
= Fexpand_file_name (filename
, Qnil
);
1498 if (0 > unlink (XSTRING (filename
)->data
))
1499 report_file_error ("Removing old name", Flist (1, &filename
));
1503 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1504 "fRename file: \nFRename %s to file: \np",
1505 "Rename FILE as NEWNAME. Both args strings.\n\
1506 If file has names other than FILE, it continues to have those names.\n\
1507 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1508 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1509 A number as third arg means request confirmation if NEWNAME already exists.\n\
1510 This is what happens in interactive use with M-x.")
1511 (filename
, newname
, ok_if_already_exists
)
1512 Lisp_Object filename
, newname
, ok_if_already_exists
;
1515 Lisp_Object args
[2];
1517 struct gcpro gcpro1
, gcpro2
;
1519 GCPRO2 (filename
, newname
);
1520 CHECK_STRING (filename
, 0);
1521 CHECK_STRING (newname
, 1);
1522 filename
= Fexpand_file_name (filename
, Qnil
);
1523 newname
= Fexpand_file_name (newname
, Qnil
);
1524 if (NULL (ok_if_already_exists
)
1525 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1526 barf_or_query_if_file_exists (newname
, "rename to it",
1527 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1529 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1531 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1532 || 0 > unlink (XSTRING (filename
)->data
))
1537 Fcopy_file (filename
, newname
, ok_if_already_exists
, Qt
);
1538 Fdelete_file (filename
);
1545 report_file_error ("Renaming", Flist (2, args
));
1548 report_file_error ("Renaming", Flist (2, &filename
));
1555 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1556 "fAdd name to file: \nFName to add to %s: \np",
1557 "Give FILE additional name NEWNAME. Both args strings.\n\
1558 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1559 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1560 A number as third arg means request confirmation if NEWNAME already exists.\n\
1561 This is what happens in interactive use with M-x.")
1562 (filename
, newname
, ok_if_already_exists
)
1563 Lisp_Object filename
, newname
, ok_if_already_exists
;
1566 Lisp_Object args
[2];
1568 struct gcpro gcpro1
, gcpro2
;
1570 GCPRO2 (filename
, newname
);
1571 CHECK_STRING (filename
, 0);
1572 CHECK_STRING (newname
, 1);
1573 filename
= Fexpand_file_name (filename
, Qnil
);
1574 newname
= Fexpand_file_name (newname
, Qnil
);
1575 if (NULL (ok_if_already_exists
)
1576 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1577 barf_or_query_if_file_exists (newname
, "make it a new name",
1578 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1579 unlink (XSTRING (newname
)->data
);
1580 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1585 report_file_error ("Adding new name", Flist (2, args
));
1587 report_file_error ("Adding new name", Flist (2, &filename
));
1596 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1597 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1598 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1599 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1600 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1601 A number as third arg means request confirmation if NEWNAME already exists.\n\
1602 This happens for interactive use with M-x.")
1603 (filename
, newname
, ok_if_already_exists
)
1604 Lisp_Object filename
, newname
, ok_if_already_exists
;
1607 Lisp_Object args
[2];
1609 struct gcpro gcpro1
, gcpro2
;
1611 GCPRO2 (filename
, newname
);
1612 CHECK_STRING (filename
, 0);
1613 CHECK_STRING (newname
, 1);
1614 #if 0 /* This made it impossible to make a link to a relative name. */
1615 filename
= Fexpand_file_name (filename
, Qnil
);
1617 newname
= Fexpand_file_name (newname
, Qnil
);
1618 if (NULL (ok_if_already_exists
)
1619 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1620 barf_or_query_if_file_exists (newname
, "make it a link",
1621 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1622 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1624 /* If we didn't complain already, silently delete existing file. */
1625 if (errno
== EEXIST
)
1627 unlink (XSTRING (filename
)->data
);
1628 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1635 report_file_error ("Making symbolic link", Flist (2, args
));
1637 report_file_error ("Making symbolic link", Flist (2, &filename
));
1643 #endif /* S_IFLNK */
1647 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
1648 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1649 "Define the job-wide logical name NAME to have the value STRING.\n\
1650 If STRING is nil or a null string, the logical name NAME is deleted.")
1652 Lisp_Object varname
;
1655 CHECK_STRING (varname
, 0);
1657 delete_logical_name (XSTRING (varname
)->data
);
1660 CHECK_STRING (string
, 1);
1662 if (XSTRING (string
)->size
== 0)
1663 delete_logical_name (XSTRING (varname
)->data
);
1665 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
1674 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
1675 "Open a network connection to PATH using LOGIN as the login string.")
1677 Lisp_Object path
, login
;
1681 CHECK_STRING (path
, 0);
1682 CHECK_STRING (login
, 0);
1684 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
1686 if (netresult
== -1)
1691 #endif /* HPUX_NET */
1693 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
1695 "Return t if file FILENAME specifies an absolute path name.\n\
1696 On Unix, this is a name starting with a `/' or a `~'.")
1698 Lisp_Object filename
;
1702 CHECK_STRING (filename
, 0);
1703 ptr
= XSTRING (filename
)->data
;
1704 if (*ptr
== '/' || *ptr
== '~'
1706 /* ??? This criterion is probably wrong for '<'. */
1707 || index (ptr
, ':') || index (ptr
, '<')
1708 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
1717 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
1718 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1719 See also `file-readable-p' and `file-attributes'.")
1721 Lisp_Object filename
;
1723 Lisp_Object abspath
;
1725 CHECK_STRING (filename
, 0);
1726 abspath
= Fexpand_file_name (filename
, Qnil
);
1727 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
1730 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
1731 "Return t if FILENAME can be executed by you.\n\
1732 For directories this means you can change to that directory.")
1734 Lisp_Object filename
;
1737 Lisp_Object abspath
;
1739 CHECK_STRING (filename
, 0);
1740 abspath
= Fexpand_file_name (filename
, Qnil
);
1741 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
1744 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
1745 "Return t if file FILENAME exists and you can read it.\n\
1746 See also `file-exists-p' and `file-attributes'.")
1748 Lisp_Object filename
;
1750 Lisp_Object abspath
;
1752 CHECK_STRING (filename
, 0);
1753 abspath
= Fexpand_file_name (filename
, Qnil
);
1754 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
1757 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
1758 "If file FILENAME is the name of a symbolic link\n\
1759 returns the name of the file to which it is linked.\n\
1760 Otherwise returns NIL.")
1762 Lisp_Object filename
;
1770 CHECK_STRING (filename
, 0);
1771 filename
= Fexpand_file_name (filename
, Qnil
);
1776 buf
= (char *) xmalloc (bufsize
);
1777 bzero (buf
, bufsize
);
1778 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
1779 if (valsize
< bufsize
) break;
1780 /* Buffer was not long enough */
1789 val
= make_string (buf
, valsize
);
1792 #else /* not S_IFLNK */
1794 #endif /* not S_IFLNK */
1797 /* Having this before file-symlink-p mysteriously caused it to be forgotten
1799 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
1800 "Return t if file FILENAME can be written or created by you.")
1802 Lisp_Object filename
;
1804 Lisp_Object abspath
, dir
;
1806 CHECK_STRING (filename
, 0);
1807 abspath
= Fexpand_file_name (filename
, Qnil
);
1808 if (access (XSTRING (abspath
)->data
, 0) >= 0)
1809 return (access (XSTRING (abspath
)->data
, 2) >= 0) ? Qt
: Qnil
;
1810 dir
= Ffile_name_directory (abspath
);
1813 dir
= Fdirectory_file_name (dir
);
1815 return (access (!NULL (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
1819 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
1820 "Return t if file FILENAME is the name of a directory as a file.\n\
1821 A directory name spec may be given instead; then the value is t\n\
1822 if the directory so specified exists and really is a directory.")
1824 Lisp_Object filename
;
1826 register Lisp_Object abspath
;
1829 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
1831 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1833 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
1836 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
1837 "Return mode bits of FILE, as an integer.")
1839 Lisp_Object filename
;
1841 Lisp_Object abspath
;
1844 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
1846 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1848 return make_number (st
.st_mode
& 07777);
1851 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
1852 "Set mode bits of FILE to MODE (an integer).\n\
1853 Only the 12 low bits of MODE are used.")
1855 Lisp_Object filename
, mode
;
1857 Lisp_Object abspath
;
1859 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
1860 CHECK_NUMBER (mode
, 1);
1863 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
1864 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
1866 if (!egetenv ("USE_DOMAIN_ACLS"))
1869 struct timeval tvp
[2];
1871 /* chmod on apollo also change the file's modtime; need to save the
1872 modtime and then restore it. */
1873 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1875 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
1879 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
1880 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
1882 /* reset the old accessed and modified times. */
1883 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
1885 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
1888 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
1889 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
1896 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
1897 "Return t if file FILE1 is newer than file FILE2.\n\
1898 If FILE1 does not exist, the answer is nil;\n\
1899 otherwise, if FILE2 does not exist, the answer is t.")
1901 Lisp_Object file1
, file2
;
1903 Lisp_Object abspath
;
1907 CHECK_STRING (file1
, 0);
1908 CHECK_STRING (file2
, 0);
1910 abspath
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
1912 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1915 mtime1
= st
.st_mtime
;
1917 abspath
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
1919 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1922 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
1925 close_file_unwind (fd
)
1928 close (XFASTINT (fd
));
1931 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
1933 "Insert contents of file FILENAME after point.\n\
1934 Returns list of absolute pathname and length of data inserted.\n\
1935 If second argument VISIT is non-nil, the buffer's visited filename\n\
1936 and last save file modtime are set, and it is marked unmodified.\n\
1937 If visiting and the file does not exist, visiting is completed\n\
1938 before the error is signaled.")
1940 Lisp_Object filename
, visit
;
1944 register int inserted
= 0;
1945 register int how_much
;
1946 int count
= specpdl_ptr
- specpdl
;
1947 struct gcpro gcpro1
;
1950 if (!NULL (current_buffer
->read_only
))
1951 Fbarf_if_buffer_read_only();
1953 CHECK_STRING (filename
, 0);
1954 filename
= Fexpand_file_name (filename
, Qnil
);
1959 if (stat (XSTRING (filename
)->data
, &st
) < 0
1960 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
1962 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
1963 || fstat (fd
, &st
) < 0)
1964 #endif /* not APOLLO */
1966 if (fd
>= 0) close (fd
);
1968 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1974 record_unwind_protect (close_file_unwind
, make_number (fd
));
1976 /* Supposedly happens on VMS. */
1978 error ("File size is negative");
1980 register Lisp_Object temp
;
1982 /* Make sure point-max won't overflow after this insertion. */
1983 XSET (temp
, Lisp_Int
, st
.st_size
+ Z
);
1984 if (st
.st_size
+ Z
!= XINT (temp
))
1985 error ("maximum buffer size exceeded");
1989 prepare_to_modify_buffer (point
, point
);
1992 if (GAP_SIZE
< st
.st_size
)
1993 make_gap (st
.st_size
- GAP_SIZE
);
1997 int try = min (st
.st_size
- inserted
, 64 << 10);
1998 int this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2015 record_insert (point
, inserted
);
2019 /* Discard the unwind protect */
2020 specpdl_ptr
= specpdl
+ count
;
2023 error ("IO error reading %s: %s",
2024 XSTRING (filename
)->data
, err_str (errno
));
2030 current_buffer
->undo_list
= Qnil
;
2032 stat (XSTRING (filename
)->data
, &st
);
2034 current_buffer
->modtime
= st
.st_mtime
;
2035 current_buffer
->save_modified
= MODIFF
;
2036 current_buffer
->auto_save_modified
= MODIFF
;
2037 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2038 #ifdef CLASH_DETECTION
2039 if (!NULL (current_buffer
->filename
))
2040 unlock_file (current_buffer
->filename
);
2041 unlock_file (filename
);
2042 #endif /* CLASH_DETECTION */
2043 current_buffer
->filename
= filename
;
2044 /* If visiting nonexistent file, return nil. */
2045 if (st
.st_mtime
== -1)
2046 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2049 signal_after_change (point
, 0, inserted
);
2051 RETURN_UNGCPRO (Fcons (filename
,
2052 Fcons (make_number (inserted
),
2056 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2057 "r\nFWrite region to file: ",
2058 "Write current region into specified file.\n\
2059 When called from a program, takes three arguments:\n\
2060 START, END and FILENAME. START and END are buffer positions.\n\
2061 Optional fourth argument APPEND if non-nil means\n\
2062 append to existing file contents (if any).\n\
2063 Optional fifth argument VISIT if t means\n\
2064 set the last-save-file-modtime of buffer to this file's modtime\n\
2065 and mark buffer not modified.\n\
2066 If VISIT is neither t nor nil, it means do not print\n\
2067 the \"Wrote file\" message.\n\
2068 Kludgy feature: if START is a string, then that string is written\n\
2069 to the file, instead of any buffer contents, and END is ignored.")
2070 (start
, end
, filename
, append
, visit
)
2071 Lisp_Object start
, end
, filename
, append
, visit
;
2079 int count
= specpdl_ptr
- specpdl
;
2081 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2084 /* Special kludge to simplify auto-saving */
2087 XFASTINT (start
) = BEG
;
2090 else if (XTYPE (start
) != Lisp_String
)
2091 validate_region (&start
, &end
);
2093 filename
= Fexpand_file_name (filename
, Qnil
);
2094 fn
= XSTRING (filename
)->data
;
2096 #ifdef CLASH_DETECTION
2098 lock_file (filename
);
2099 #endif /* CLASH_DETECTION */
2103 desc
= open (fn
, O_WRONLY
);
2107 if (auto_saving
) /* Overwrite any previous version of autosave file */
2109 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2110 desc
= open (fn
, O_RDWR
);
2112 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2113 ? XSTRING (current_buffer
->filename
)->data
: 0,
2116 else /* Write to temporary name and rename if no errors */
2118 Lisp_Object temp_name
;
2119 temp_name
= Ffile_name_directory (filename
);
2121 if (!NULL (temp_name
))
2123 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2124 build_string ("$$SAVE$$")));
2125 fname
= XSTRING (filename
)->data
;
2126 fn
= XSTRING (temp_name
)->data
;
2127 desc
= creat_copy_attrs (fname
, fn
);
2130 /* If we can't open the temporary file, try creating a new
2131 version of the original file. VMS "creat" creates a
2132 new version rather than truncating an existing file. */
2135 desc
= creat (fn
, 0666);
2136 #if 0 /* This can clobber an existing file and fail to replace it,
2137 if the user runs out of space. */
2140 /* We can't make a new version;
2141 try to truncate and rewrite existing version if any. */
2143 desc
= open (fn
, O_RDWR
);
2149 desc
= creat (fn
, 0666);
2152 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2153 #endif /* not VMS */
2157 #ifdef CLASH_DETECTION
2159 if (!auto_saving
) unlock_file (filename
);
2161 #endif /* CLASH_DETECTION */
2162 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2165 record_unwind_protect (close_file_unwind
, make_number (desc
));
2168 if (lseek (desc
, 0, 2) < 0)
2170 #ifdef CLASH_DETECTION
2171 if (!auto_saving
) unlock_file (filename
);
2172 #endif /* CLASH_DETECTION */
2173 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2178 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2179 * if we do writes that don't end with a carriage return. Furthermore
2180 * it cannot handle writes of more then 16K. The modified
2181 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2182 * this EXCEPT for the last record (iff it doesn't end with a carriage
2183 * return). This implies that if your buffer doesn't end with a carriage
2184 * return, you get one free... tough. However it also means that if
2185 * we make two calls to sys_write (a la the following code) you can
2186 * get one at the gap as well. The easiest way to fix this (honest)
2187 * is to move the gap to the next newline (or the end of the buffer).
2192 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2193 move_gap (find_next_newline (GPT
, 1));
2199 if (XTYPE (start
) == Lisp_String
)
2201 failure
= 0 > e_write (desc
, XSTRING (start
)->data
,
2202 XSTRING (start
)->size
);
2205 else if (XINT (start
) != XINT (end
))
2207 if (XINT (start
) < GPT
)
2209 register int end1
= XINT (end
);
2211 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
),
2212 min (GPT
, end1
) - tem
);
2216 if (XINT (end
) > GPT
&& !failure
)
2219 tem
= max (tem
, GPT
);
2220 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
);
2230 #ifndef alliant /* trinkle@cs.purdue.edu says fsync can return EBUSY
2231 on alliant, for no visible reason. */
2232 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2233 Disk full in NFS may be reported here. */
2234 if (fsync (desc
) < 0)
2235 failure
= 1, save_errno
= errno
;
2241 /* Spurious "file has changed on disk" warnings have been
2242 observed on Suns as well.
2243 It seems that `close' can change the modtime, under nfs.
2245 (This has supposedly been fixed in Sunos 4,
2246 but who knows about all the other machines with NFS?) */
2249 /* On VMS and APOLLO, must do the stat after the close
2250 since closing changes the modtime. */
2253 /* Recall that #if defined does not work on VMS. */
2260 /* NFS can report a write failure now. */
2261 if (close (desc
) < 0)
2262 failure
= 1, save_errno
= errno
;
2265 /* If we wrote to a temporary name and had no errors, rename to real name. */
2269 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2277 /* Discard the unwind protect */
2278 specpdl_ptr
= specpdl
+ count
;
2280 #ifdef CLASH_DETECTION
2282 unlock_file (filename
);
2283 #endif /* CLASH_DETECTION */
2285 /* Do this before reporting IO error
2286 to avoid a "file has changed on disk" warning on
2287 next attempt to save. */
2289 current_buffer
->modtime
= st
.st_mtime
;
2292 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2296 current_buffer
->save_modified
= MODIFF
;
2297 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2298 current_buffer
->filename
= filename
;
2300 else if (!NULL (visit
))
2304 message ("Wrote %s", fn
);
2310 e_write (desc
, addr
, len
)
2312 register char *addr
;
2315 char buf
[16 * 1024];
2316 register char *p
, *end
;
2318 if (!EQ (current_buffer
->selective_display
, Qt
))
2319 return write (desc
, addr
, len
) - len
;
2323 end
= p
+ sizeof buf
;
2328 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
2337 if (write (desc
, buf
, p
- buf
) != p
- buf
)
2343 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
2344 Sverify_visited_file_modtime
, 1, 1, 0,
2345 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2346 This means that the file has not been changed since it was visited or saved.")
2353 CHECK_BUFFER (buf
, 0);
2356 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
2357 if (b
->modtime
== 0) return Qt
;
2359 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
2361 /* If the file doesn't exist now and didn't exist before,
2362 we say that it isn't modified, provided the error is a tame one. */
2363 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
2368 if (st
.st_mtime
== b
->modtime
2369 /* If both are positive, accept them if they are off by one second. */
2370 || (st
.st_mtime
> 0 && b
->modtime
> 0
2371 && (st
.st_mtime
== b
->modtime
+ 1
2372 || st
.st_mtime
== b
->modtime
- 1)))
2377 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
2378 Sclear_visited_file_modtime
, 0, 0, 0,
2379 "Clear out records of last mod time of visited file.\n\
2380 Next attempt to save will certainly not complain of a discrepancy.")
2383 current_buffer
->modtime
= 0;
2387 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
2388 Sset_visited_file_modtime
, 0, 0, 0,
2389 "Update buffer's recorded modification time from the visited file's time.\n\
2390 Useful if the buffer was not read from the file normally\n\
2391 or if the file itself has been changed for some known benign reason.")
2394 register Lisp_Object filename
;
2397 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
2399 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
2400 current_buffer
->modtime
= st
.st_mtime
;
2408 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
2411 message ("Autosaving...error for %s", name
);
2412 Fsleep_for (make_number (1));
2413 message ("Autosaving...error!for %s", name
);
2414 Fsleep_for (make_number (1));
2415 message ("Autosaving...error for %s", name
);
2416 Fsleep_for (make_number (1));
2426 /* Get visited file's mode to become the auto save file's mode. */
2427 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
2428 /* But make sure we can overwrite it later! */
2429 auto_save_mode_bits
= st
.st_mode
| 0600;
2431 auto_save_mode_bits
= 0666;
2434 Fwrite_region (Qnil
, Qnil
,
2435 current_buffer
->auto_save_file_name
,
2439 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
2440 "Auto-save all buffers that need it.\n\
2441 This is all buffers that have auto-saving enabled\n\
2442 and are changed since last auto-saved.\n\
2443 Auto-saving writes the buffer into a file\n\
2444 so that your editing is not lost if the system crashes.\n\
2445 This file is not the file you visited; that changes only when you save.\n\n\
2446 Non-nil first argument means do not print any message if successful.\n\
2447 Non-nil second argumet means save only current buffer.")
2451 struct buffer
*old
= current_buffer
, *b
;
2452 Lisp_Object tail
, buf
;
2454 char *omessage
= echo_area_glyphs
;
2455 extern minibuf_level
;
2457 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2458 point to non-strings reached from Vbuffer_alist. */
2464 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2465 eventually call do-auto-save, so don't err here in that case. */
2466 if (!NULL (Vrun_hooks
))
2467 call1 (Vrun_hooks
, intern ("auto-save-hook"));
2469 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2470 tail
= XCONS (tail
)->cdr
)
2472 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
2474 /* Check for auto save enabled
2475 and file changed since last auto save
2476 and file changed since last real save. */
2477 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
2478 && b
->save_modified
< BUF_MODIFF (b
)
2479 && b
->auto_save_modified
< BUF_MODIFF (b
))
2481 if ((XFASTINT (b
->save_length
) * 10
2482 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
2483 /* A short file is likely to change a large fraction;
2484 spare the user annoying messages. */
2485 && XFASTINT (b
->save_length
) > 5000
2486 /* These messages are frequent and annoying for `*mail*'. */
2487 && !EQ (b
->filename
, Qnil
))
2489 /* It has shrunk too much; turn off auto-saving here. */
2490 message ("Buffer %s has shrunk a lot; auto save turned off there",
2491 XSTRING (b
->name
)->data
);
2492 /* User can reenable saving with M-x auto-save. */
2493 b
->auto_save_file_name
= Qnil
;
2494 /* Prevent warning from repeating if user does so. */
2495 XFASTINT (b
->save_length
) = 0;
2496 Fsleep_for (make_number (1));
2499 set_buffer_internal (b
);
2500 if (!auto_saved
&& NULL (nomsg
))
2501 message1 ("Auto-saving...");
2502 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
2504 b
->auto_save_modified
= BUF_MODIFF (b
);
2505 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2506 set_buffer_internal (old
);
2511 record_auto_save ();
2513 if (auto_saved
&& NULL (nomsg
))
2514 message1 (omessage
? omessage
: "Auto-saving...done");
2520 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
2521 Sset_buffer_auto_saved
, 0, 0, 0,
2522 "Mark current buffer as auto-saved with its current text.\n\
2523 No auto-save file will be written until the buffer changes again.")
2526 current_buffer
->auto_save_modified
= MODIFF
;
2527 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2531 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
2533 "Return t if buffer has been auto-saved since last read in or saved.")
2536 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
2539 /* Reading and completing file names */
2540 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
2542 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
2544 "Internal subroutine for read-file-name. Do not call this.")
2545 (string
, dir
, action
)
2546 Lisp_Object string
, dir
, action
;
2547 /* action is nil for complete, t for return list of completions,
2548 lambda for verify final value */
2550 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
2552 if (XSTRING (string
)->size
== 0)
2557 if (EQ (action
, Qlambda
))
2562 orig_string
= string
;
2563 string
= Fsubstitute_in_file_name (string
);
2564 name
= Ffile_name_nondirectory (string
);
2565 realdir
= Ffile_name_directory (string
);
2569 realdir
= Fexpand_file_name (realdir
, dir
);
2574 specdir
= Ffile_name_directory (string
);
2575 val
= Ffile_name_completion (name
, realdir
);
2576 if (XTYPE (val
) != Lisp_String
)
2578 if (NULL (Fstring_equal (string
, orig_string
)))
2583 if (!NULL (specdir
))
2584 val
= concat2 (specdir
, val
);
2587 register unsigned char *old
, *new;
2591 osize
= XSTRING (val
)->size
;
2592 /* Quote "$" as "$$" to get it past substitute-in-file-name */
2593 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
2594 if (*old
++ == '$') count
++;
2597 old
= XSTRING (val
)->data
;
2598 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
2599 new = XSTRING (val
)->data
;
2600 for (n
= osize
; n
> 0; n
--)
2611 #endif /* Not VMS */
2615 if (EQ (action
, Qt
))
2616 return Ffile_name_all_completions (name
, realdir
);
2617 /* Only other case actually used is ACTION = lambda */
2619 /* Supposedly this helps commands such as `cd' that read directory names,
2620 but can someone explain how it helps them? -- RMS */
2621 if (XSTRING (name
)->size
== 0)
2624 return Ffile_exists_p (string
);
2627 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
2628 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
2629 Value is not expanded---you must call `expand-file-name' yourself.\n\
2630 Default name to DEFAULT if user enters a null string.\n\
2631 (If DEFAULT is omitted, the visited file name is used.)\n\
2632 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
2633 Non-nil and non-t means also require confirmation after completion.\n\
2634 Fifth arg INITIAL specifies text to start with.\n\
2635 DIR defaults to current buffer's directory default.")
2636 (prompt
, dir
, defalt
, mustmatch
, initial
)
2637 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
2639 Lisp_Object val
, insdef
, tem
, backup_n
;
2640 struct gcpro gcpro1
, gcpro2
;
2641 register char *homedir
;
2645 dir
= current_buffer
->directory
;
2647 defalt
= current_buffer
->filename
;
2649 /* If dir starts with user's homedir, change that to ~. */
2650 homedir
= (char *) egetenv ("HOME");
2652 && XTYPE (dir
) == Lisp_String
2653 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
2654 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
2656 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
2657 XSTRING (dir
)->size
- strlen (homedir
) + 1);
2658 XSTRING (dir
)->data
[0] = '~';
2661 if (insert_default_directory
)
2664 if (!NULL (initial
))
2666 Lisp_Object args
[2];
2670 insdef
= Fconcat (2, args
);
2671 backup_n
= make_number (- (XSTRING (initial
)->size
));
2678 insdef
= build_string ("");
2683 count
= specpdl_ptr
- specpdl
;
2684 specbind (intern ("completion-ignore-case"), Qt
);
2687 GCPRO2 (insdef
, defalt
);
2688 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
2690 insert_default_directory
? insdef
: Qnil
, backup_n
);
2693 unbind_to (count
, Qnil
);
2698 error ("No file name specified");
2699 tem
= Fstring_equal (val
, insdef
);
2700 if (!NULL (tem
) && !NULL (defalt
))
2702 return Fsubstitute_in_file_name (val
);
2705 #if 0 /* Old version */
2706 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
2707 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
2708 Value is not expanded---you must call `expand-file-name' yourself.\n\
2709 Default name to DEFAULT if user enters a null string.\n\
2710 (If DEFAULT is omitted, the visited file name is used.)\n\
2711 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
2712 Non-nil and non-t means also require confirmation after completion.\n\
2713 Fifth arg INITIAL specifies text to start with.\n\
2714 DIR defaults to current buffer's directory default.")
2715 (prompt
, dir
, defalt
, mustmatch
, initial
)
2716 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
2718 Lisp_Object val
, insdef
, tem
;
2719 struct gcpro gcpro1
, gcpro2
;
2720 register char *homedir
;
2724 dir
= current_buffer
->directory
;
2726 defalt
= current_buffer
->filename
;
2728 /* If dir starts with user's homedir, change that to ~. */
2729 homedir
= (char *) egetenv ("HOME");
2731 && XTYPE (dir
) == Lisp_String
2732 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
2733 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
2735 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
2736 XSTRING (dir
)->size
- strlen (homedir
) + 1);
2737 XSTRING (dir
)->data
[0] = '~';
2740 if (!NULL (initial
))
2742 else if (insert_default_directory
)
2745 insdef
= build_string ("");
2748 count
= specpdl_ptr
- specpdl
;
2749 specbind (intern ("completion-ignore-case"), Qt
);
2752 GCPRO2 (insdef
, defalt
);
2753 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
2755 insert_default_directory
? insdef
: Qnil
, Qnil
);
2758 unbind_to (count
, Qnil
);
2763 error ("No file name specified");
2764 tem
= Fstring_equal (val
, insdef
);
2765 if (!NULL (tem
) && !NULL (defalt
))
2767 return Fsubstitute_in_file_name (val
);
2769 #endif /* Old version */
2773 Qfile_error
= intern ("file-error");
2774 staticpro (&Qfile_error
);
2775 Qfile_already_exists
= intern("file-already-exists");
2776 staticpro (&Qfile_already_exists
);
2778 Fput (Qfile_error
, Qerror_conditions
,
2779 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
2780 Fput (Qfile_error
, Qerror_message
,
2781 build_string ("File error"));
2783 Fput (Qfile_already_exists
, Qerror_conditions
,
2784 Fcons (Qfile_already_exists
,
2785 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
2786 Fput (Qfile_already_exists
, Qerror_message
,
2787 build_string ("File already exists"));
2789 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
2790 "*Non-nil means when reading a filename start with default dir in minibuffer.");
2791 insert_default_directory
= 1;
2793 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
2794 "*Non-nil means write new files with record format `stmlf'.\n\
2795 nil means use format `var'. This variable is meaningful only on VMS.");
2796 vms_stmlf_recfm
= 0;
2798 defsubr (&Sfile_name_directory
);
2799 defsubr (&Sfile_name_nondirectory
);
2800 defsubr (&Sfile_name_as_directory
);
2801 defsubr (&Sdirectory_file_name
);
2802 defsubr (&Smake_temp_name
);
2803 defsubr (&Sexpand_file_name
);
2804 defsubr (&Ssubstitute_in_file_name
);
2805 defsubr (&Scopy_file
);
2806 defsubr (&Smake_directory
);
2807 defsubr (&Sremove_directory
);
2808 defsubr (&Sdelete_file
);
2809 defsubr (&Srename_file
);
2810 defsubr (&Sadd_name_to_file
);
2812 defsubr (&Smake_symbolic_link
);
2813 #endif /* S_IFLNK */
2815 defsubr (&Sdefine_logical_name
);
2818 defsubr (&Ssysnetunam
);
2819 #endif /* HPUX_NET */
2820 defsubr (&Sfile_name_absolute_p
);
2821 defsubr (&Sfile_exists_p
);
2822 defsubr (&Sfile_executable_p
);
2823 defsubr (&Sfile_readable_p
);
2824 defsubr (&Sfile_writable_p
);
2825 defsubr (&Sfile_symlink_p
);
2826 defsubr (&Sfile_directory_p
);
2827 defsubr (&Sfile_modes
);
2828 defsubr (&Sset_file_modes
);
2829 defsubr (&Sfile_newer_than_file_p
);
2830 defsubr (&Sinsert_file_contents
);
2831 defsubr (&Swrite_region
);
2832 defsubr (&Sverify_visited_file_modtime
);
2833 defsubr (&Sclear_visited_file_modtime
);
2834 defsubr (&Sset_visited_file_modtime
);
2835 defsubr (&Sdo_auto_save
);
2836 defsubr (&Sset_buffer_auto_saved
);
2837 defsubr (&Srecent_auto_save_p
);
2839 defsubr (&Sread_file_name_internal
);
2840 defsubr (&Sread_file_name
);