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>
30 extern char *sys_errlist
[];
34 #define err_str(a) ((a) < sys_nerr ? sys_errlist[a] : "unknown error")
58 #else /* not NEED_TIME_H */
61 #endif /* HAVE_TIMEVAL */
62 #endif /* not NEED_TIME_H */
75 #define min(a, b) ((a) < (b) ? (a) : (b))
76 #define max(a, b) ((a) > (b) ? (a) : (b))
78 /* Nonzero during writing of auto-save files */
81 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
82 a new file with the same mode as the original */
83 int auto_save_mode_bits
;
85 /* Nonzero means, when reading a filename in the minibuffer,
86 start out by inserting the default directory into the minibuffer. */
87 int insert_default_directory
;
89 /* On VMS, nonzero means write new files with record format stmlf.
90 Zero means use var format. */
93 Lisp_Object Qfile_error
, Qfile_already_exists
;
95 report_file_error (string
, data
)
99 Lisp_Object errstring
;
101 if (errno
>= 0 && errno
< sys_nerr
)
102 errstring
= build_string (sys_errlist
[errno
]);
104 errstring
= build_string ("undocumented error code");
106 /* System error messages are capitalized. Downcase the initial
107 unless it is followed by a slash. */
108 if (XSTRING (errstring
)->data
[1] != '/')
109 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
112 Fsignal (Qfile_error
,
113 Fcons (build_string (string
), Fcons (errstring
, data
)));
116 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
118 "Return the directory component in file name NAME.\n\
119 Return nil if NAME does not include a directory.\n\
120 Otherwise return a directory spec.\n\
121 Given a Unix syntax file name, returns a string ending in slash;\n\
122 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
126 register unsigned char *beg
;
127 register unsigned char *p
;
129 CHECK_STRING (file
, 0);
131 beg
= XSTRING (file
)->data
;
132 p
= beg
+ XSTRING (file
)->size
;
134 while (p
!= beg
&& p
[-1] != '/'
136 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
142 return make_string (beg
, p
- beg
);
145 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
147 "Return file name NAME sans its directory.\n\
148 For example, in a Unix-syntax file name,\n\
149 this is everything after the last slash,\n\
150 or the entire name if it contains no slash.")
154 register unsigned char *beg
, *p
, *end
;
156 CHECK_STRING (file
, 0);
158 beg
= XSTRING (file
)->data
;
159 end
= p
= beg
+ XSTRING (file
)->size
;
161 while (p
!= beg
&& p
[-1] != '/'
163 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
167 return make_string (p
, end
- p
);
171 file_name_as_directory (out
, in
)
174 int size
= strlen (in
) - 1;
179 /* Is it already a directory string? */
180 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
182 /* Is it a VMS directory file name? If so, hack VMS syntax. */
183 else if (! index (in
, '/')
184 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
185 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
186 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
187 || ! strncmp (&in
[size
- 5], ".dir", 4))
188 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
189 && in
[size
] == '1')))
191 register char *p
, *dot
;
195 dir:x.dir --> dir:[x]
196 dir:[x]y.dir --> dir:[x.y] */
198 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
201 strncpy (out
, in
, p
- in
);
220 if (dot
= index (p
, '.'))
222 /* blindly remove any extension */
223 size
= strlen (out
) + (dot
- p
);
224 strncat (out
, p
, dot
- p
);
235 /* For Unix syntax, Append a slash if necessary */
236 if (out
[size
] != '/')
242 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
243 Sfile_name_as_directory
, 1, 1, 0,
244 "Return a string representing file FILENAME interpreted as a directory.\n\
245 This operation exists because a directory is also a file, but its name as\n\
246 a directory is different from its name as a file.\n\
247 The result can be used as the value of `default-directory'\n\
248 or passed as second argument to `expand-file-name'.\n\
249 For a Unix-syntax file name, just appends a slash.\n\
250 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
256 CHECK_STRING (file
, 0);
259 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
260 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
264 * Convert from directory name to filename.
266 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
267 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
268 * On UNIX, it's simple: just make sure there is a terminating /
270 * Value is nonzero if the string output is different from the input.
273 directory_file_name (src
, dst
)
281 struct FAB fab
= cc$rms_fab
;
282 struct NAM nam
= cc$rms_nam
;
283 char esa
[NAM$C_MAXRSS
];
288 if (! index (src
, '/')
289 && (src
[slen
- 1] == ']'
290 || src
[slen
- 1] == ':'
291 || src
[slen
- 1] == '>'))
293 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
295 fab
.fab$b_fns
= slen
;
296 fab
.fab$l_nam
= &nam
;
297 fab
.fab$l_fop
= FAB$M_NAM
;
300 nam
.nam$b_ess
= sizeof esa
;
301 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
303 /* We call SYS$PARSE to handle such things as [--] for us. */
304 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
306 slen
= nam
.nam$b_esl
;
307 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
312 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
314 /* what about when we have logical_name:???? */
315 if (src
[slen
- 1] == ':')
316 { /* Xlate logical name and see what we get */
317 ptr
= strcpy (dst
, src
); /* upper case for getenv */
320 if ('a' <= *ptr
&& *ptr
<= 'z')
324 dst
[slen
- 1] = 0; /* remove colon */
325 if (!(src
= egetenv (dst
)))
327 /* should we jump to the beginning of this procedure?
328 Good points: allows us to use logical names that xlate
330 Bad points: can be a problem if we just translated to a device
332 For now, I'll punt and always expect VMS names, and hope for
335 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
336 { /* no recursion here! */
342 { /* not a directory spec */
347 bracket
= src
[slen
- 1];
349 /* If bracket is ']' or '>', bracket - 2 is the corresponding
351 if (!(ptr
= index (src
, bracket
- 2)))
352 { /* no opening bracket */
356 if (!(rptr
= rindex (src
, '.')))
359 strncpy (dst
, src
, slen
);
363 dst
[slen
++] = bracket
;
368 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
369 then translate the device and recurse. */
370 if (dst
[slen
- 1] == ':'
371 && dst
[slen
- 2] != ':' /* skip decnet nodes */
372 && strcmp(src
+ slen
, "[000000]") == 0)
374 dst
[slen
- 1] = '\0';
375 if ((ptr
= egetenv (dst
))
376 && (rlen
= strlen (ptr
) - 1) > 0
377 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
378 && ptr
[rlen
- 1] == '.')
382 return directory_file_name (ptr
, dst
);
387 strcat (dst
, "[000000]");
391 rlen
= strlen (rptr
) - 1;
392 strncat (dst
, rptr
, rlen
);
393 dst
[slen
+ rlen
] = '\0';
394 strcat (dst
, ".DIR.1");
398 /* Process as Unix format: just remove any final slash.
399 But leave "/" unchanged; do not change it to "". */
401 if (dst
[slen
- 1] == '/' && slen
> 1)
406 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
408 "Returns the file name of the directory named DIR.\n\
409 This is the name of the file that holds the data for the directory DIR.\n\
410 This operation exists because a directory is also a file, but its name as\n\
411 a directory is different from its name as a file.\n\
412 In Unix-syntax, this function just removes the final slash.\n\
413 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
414 it returns a file name such as \"[X]Y.DIR.1\".")
416 Lisp_Object directory
;
420 CHECK_STRING (directory
, 0);
422 if (NULL (directory
))
425 /* 20 extra chars is insufficient for VMS, since we might perform a
426 logical name translation. an equivalence string can be up to 255
427 chars long, so grab that much extra space... - sss */
428 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
430 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
432 directory_file_name (XSTRING (directory
)->data
, buf
);
433 return build_string (buf
);
436 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
437 "Generate temporary file name (string) starting with PREFIX (a string).\n\
438 The Emacs process number forms part of the result,\n\
439 so there is no danger of generating a name being used by another process.")
444 val
= concat2 (prefix
, build_string ("XXXXXX"));
445 mktemp (XSTRING (val
)->data
);
449 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
450 "Convert FILENAME to absolute, and canonicalize it.\n\
451 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
452 (does not start with slash); if DEFAULT is nil or missing,\n\
453 the current buffer's value of default-directory is used.\n\
454 Filenames containing `.' or `..' as components are simplified;\n\
455 initial `~/' expands to your home directory.\n\
456 See also the function `substitute-in-file-name'.")
458 Lisp_Object name
, defalt
;
462 register unsigned char *newdir
, *p
, *o
;
464 unsigned char *target
;
468 unsigned char * colon
= 0;
469 unsigned char * close
= 0;
470 unsigned char * slash
= 0;
471 unsigned char * brack
= 0;
472 int lbrack
= 0, rbrack
= 0;
476 CHECK_STRING (name
, 0);
479 /* Filenames on VMS are always upper case. */
480 name
= Fupcase (name
);
483 nm
= XSTRING (name
)->data
;
485 /* If nm is absolute, flush ...// and detect /./ and /../.
486 If no /./ or /../ we can return right away. */
498 if (p
[0] == '/' && p
[1] == '/'
500 /* // at start of filename is meaningful on Apollo system */
505 if (p
[0] == '/' && p
[1] == '~')
506 nm
= p
+ 1, lose
= 1;
507 if (p
[0] == '/' && p
[1] == '.'
508 && (p
[2] == '/' || p
[2] == 0
509 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
515 /* if dev:[dir]/, move nm to / */
516 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
517 nm
= (brack
? brack
+ 1 : colon
+ 1);
526 /* VMS pre V4.4,convert '-'s in filenames. */
527 if (lbrack
== rbrack
)
529 if (dots
< 2) /* this is to allow negative version numbers */
534 if (lbrack
> rbrack
&&
535 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
536 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
542 /* count open brackets, reset close bracket pointer */
543 if (p
[0] == '[' || p
[0] == '<')
545 /* count close brackets, set close bracket pointer */
546 if (p
[0] == ']' || p
[0] == '>')
548 /* detect ][ or >< */
549 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
551 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
552 nm
= p
+ 1, lose
= 1;
553 if (p
[0] == ':' && (colon
|| slash
))
554 /* if dev1:[dir]dev2:, move nm to dev2: */
560 /* if /pathname/dev:, move nm to dev: */
563 /* if node::dev:, move colon following dev */
564 else if (colon
&& colon
[-1] == ':')
566 /* if dev1:dev2:, move nm to dev2: */
567 else if (colon
&& colon
[-1] != ':')
572 if (p
[0] == ':' && !colon
)
578 if (lbrack
== rbrack
)
581 else if (p
[0] == '.')
590 return build_string (sys_translate_unix (nm
));
592 if (nm
== XSTRING (name
)->data
)
594 return build_string (nm
);
598 /* Now determine directory to start with and put it in newdir */
602 if (nm
[0] == '~') /* prefix ~ */
607 || nm
[1] == 0)/* ~/filename */
609 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
610 newdir
= (unsigned char *) "";
613 nm
++; /* Don't leave the slash in nm. */
616 else /* ~user/filename */
618 for (p
= nm
; *p
&& (*p
!= '/'
623 o
= (unsigned char *) alloca (p
- nm
+ 1);
624 bcopy ((char *) nm
, o
, p
- nm
);
627 pw
= (struct passwd
*) getpwnam (o
+ 1);
629 error ("\"%s\" isn't a registered user", o
+ 1);
632 nm
= p
+ 1; /* skip the terminator */
636 newdir
= (unsigned char *) pw
-> pw_dir
;
646 defalt
= current_buffer
->directory
;
647 CHECK_STRING (defalt
, 1);
648 newdir
= XSTRING (defalt
)->data
;
651 /* Now concatenate the directory and name to new space in the stack frame */
653 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
654 target
= (unsigned char *) alloca (tlen
);
660 if (nm
[0] == 0 || nm
[0] == '/')
661 strcpy (target
, newdir
);
664 file_name_as_directory (target
, newdir
);
669 if (index (target
, '/'))
670 strcpy (target
, sys_translate_unix (target
));
673 /* Now canonicalize by removing /. and /foo/.. if they appear */
681 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
687 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
688 /* brackets are offset from each other by 2 */
691 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
692 /* convert [foo][bar] to [bar] */
693 while (o
[-1] != '[' && o
[-1] != '<')
695 else if (*p
== '-' && *o
!= '.')
698 else if (p
[0] == '-' && o
[-1] == '.' &&
699 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
700 /* flush .foo.- ; leave - if stopped by '[' or '<' */
704 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
705 if (p
[1] == '.') /* foo.-.bar ==> bar*/
707 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
709 /* else [foo.-] ==> [-] */
715 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
716 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
726 else if (!strncmp (p
, "//", 2)
728 /* // at start of filename is meaningful in Apollo system */
736 else if (p
[0] == '/' && p
[1] == '.' &&
737 (p
[2] == '/' || p
[2] == 0))
739 else if (!strncmp (p
, "/..", 3)
740 /* `/../' is the "superroot" on certain file systems. */
742 && (p
[3] == '/' || p
[3] == 0))
744 while (o
!= target
&& *--o
!= '/')
747 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
751 if (o
== target
&& *o
== '/')
762 return make_string (target
, o
- target
);
765 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
766 "Convert FILENAME to absolute, and canonicalize it.\n\
767 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
768 (does not start with slash); if DEFAULT is nil or missing,\n\
769 the current buffer's value of default-directory is used.\n\
770 Filenames containing `.' or `..' as components are simplified;\n\
771 initial `~/' expands to your home directory.\n\
772 See also the function `substitute-in-file-name'.")
774 Lisp_Object name
, defalt
;
778 register unsigned char *newdir
, *p
, *o
;
780 unsigned char *target
;
784 unsigned char * colon
= 0;
785 unsigned char * close
= 0;
786 unsigned char * slash
= 0;
787 unsigned char * brack
= 0;
788 int lbrack
= 0, rbrack
= 0;
792 CHECK_STRING (name
, 0);
795 /* Filenames on VMS are always upper case. */
796 name
= Fupcase (name
);
799 nm
= XSTRING (name
)->data
;
801 /* If nm is absolute, flush ...// and detect /./ and /../.
802 If no /./ or /../ we can return right away. */
814 if (p
[0] == '/' && p
[1] == '/'
816 /* // at start of filename is meaningful on Apollo system */
821 if (p
[0] == '/' && p
[1] == '~')
822 nm
= p
+ 1, lose
= 1;
823 if (p
[0] == '/' && p
[1] == '.'
824 && (p
[2] == '/' || p
[2] == 0
825 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
831 /* if dev:[dir]/, move nm to / */
832 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
833 nm
= (brack
? brack
+ 1 : colon
+ 1);
842 /* VMS pre V4.4,convert '-'s in filenames. */
843 if (lbrack
== rbrack
)
845 if (dots
< 2) /* this is to allow negative version numbers */
850 if (lbrack
> rbrack
&&
851 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
852 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
858 /* count open brackets, reset close bracket pointer */
859 if (p
[0] == '[' || p
[0] == '<')
861 /* count close brackets, set close bracket pointer */
862 if (p
[0] == ']' || p
[0] == '>')
864 /* detect ][ or >< */
865 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
867 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
868 nm
= p
+ 1, lose
= 1;
869 if (p
[0] == ':' && (colon
|| slash
))
870 /* if dev1:[dir]dev2:, move nm to dev2: */
876 /* if /pathname/dev:, move nm to dev: */
879 /* if node::dev:, move colon following dev */
880 else if (colon
&& colon
[-1] == ':')
882 /* if dev1:dev2:, move nm to dev2: */
883 else if (colon
&& colon
[-1] != ':')
888 if (p
[0] == ':' && !colon
)
894 if (lbrack
== rbrack
)
897 else if (p
[0] == '.')
906 return build_string (sys_translate_unix (nm
));
908 if (nm
== XSTRING (name
)->data
)
910 return build_string (nm
);
914 /* Now determine directory to start with and put it in NEWDIR */
918 if (nm
[0] == '~') /* prefix ~ */
923 || nm
[1] == 0)/* ~/filename */
925 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
926 newdir
= (unsigned char *) "";
929 nm
++; /* Don't leave the slash in nm. */
932 else /* ~user/filename */
934 /* Get past ~ to user */
935 unsigned char *user
= nm
+ 1;
936 /* Find end of name. */
937 unsigned char *ptr
= (unsigned char *) index (user
, '/');
938 int len
= ptr
? ptr
- user
: strlen (user
);
940 unsigned char *ptr1
= index (user
, ':');
941 if (ptr1
!= 0 && ptr1
- user
< len
)
944 /* Copy the user name into temp storage. */
945 o
= (unsigned char *) alloca (len
+ 1);
946 bcopy ((char *) user
, o
, len
);
949 /* Look up the user name. */
950 pw
= (struct passwd
*) getpwnam (o
+ 1);
952 error ("\"%s\" isn't a registered user", o
+ 1);
954 newdir
= (unsigned char *) pw
->pw_dir
;
956 /* Discard the user name from NM. */
967 defalt
= current_buffer
->directory
;
968 CHECK_STRING (defalt
, 1);
969 newdir
= XSTRING (defalt
)->data
;
972 /* Now concatenate the directory and name to new space in the stack frame */
974 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
975 target
= (unsigned char *) alloca (tlen
);
981 if (nm
[0] == 0 || nm
[0] == '/')
982 strcpy (target
, newdir
);
985 file_name_as_directory (target
, newdir
);
990 if (index (target
, '/'))
991 strcpy (target
, sys_translate_unix (target
));
994 /* Now canonicalize by removing /. and /foo/.. if they appear */
1002 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1008 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1009 /* brackets are offset from each other by 2 */
1012 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1013 /* convert [foo][bar] to [bar] */
1014 while (o
[-1] != '[' && o
[-1] != '<')
1016 else if (*p
== '-' && *o
!= '.')
1019 else if (p
[0] == '-' && o
[-1] == '.' &&
1020 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1021 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1025 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1026 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1028 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1030 /* else [foo.-] ==> [-] */
1036 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1037 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1047 else if (!strncmp (p
, "//", 2)
1049 /* // at start of filename is meaningful in Apollo system */
1057 else if (p
[0] == '/' && p
[1] == '.' &&
1058 (p
[2] == '/' || p
[2] == 0))
1060 else if (!strncmp (p
, "/..", 3)
1061 /* `/../' is the "superroot" on certain file systems. */
1063 && (p
[3] == '/' || p
[3] == 0))
1065 while (o
!= target
&& *--o
!= '/')
1068 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1072 if (o
== target
&& *o
== '/')
1080 #endif /* not VMS */
1083 return make_string (target
, o
- target
);
1087 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1088 Ssubstitute_in_file_name
, 1, 1, 0,
1089 "Substitute environment variables referred to in FILENAME.\n\
1090 `$FOO' where FOO is an environment variable name means to substitute\n\
1091 the value of that variable. The variable name should be terminated\n\
1092 with a character not a letter, digit or underscore; otherwise, enclose\n\
1093 the entire variable name in braces.\n\
1094 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1095 On VMS, `$' substitution is not done; this function does little and only\n\
1096 duplicates what `expand-file-name' does.")
1102 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1103 unsigned char *target
;
1105 int substituted
= 0;
1108 CHECK_STRING (string
, 0);
1110 nm
= XSTRING (string
)->data
;
1111 endp
= nm
+ XSTRING (string
)->size
;
1113 /* If /~ or // appears, discard everything through first slash. */
1115 for (p
= nm
; p
!= endp
; p
++)
1119 /* // at start of file name is meaningful in Apollo system */
1120 (p
[0] == '/' && p
- 1 != nm
)
1121 #else /* not APOLLO */
1123 #endif /* not APOLLO */
1127 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1140 return build_string (nm
);
1143 /* See if any variables are substituted into the string
1144 and find the total length of their values in `total' */
1146 for (p
= nm
; p
!= endp
;)
1156 /* "$$" means a single "$" */
1165 while (p
!= endp
&& *p
!= '}') p
++;
1166 if (*p
!= '}') goto missingclose
;
1172 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1176 /* Copy out the variable name */
1177 target
= (unsigned char *) alloca (s
- o
+ 1);
1178 strncpy (target
, o
, s
- o
);
1181 /* Get variable value */
1182 o
= (unsigned char *) egetenv (target
);
1183 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1186 if (!o
&& !strcmp (target
, "USER"))
1187 o
= egetenv ("LOGNAME");
1190 if (!o
) goto badvar
;
1191 total
+= strlen (o
);
1198 /* If substitution required, recopy the string and do it */
1199 /* Make space in stack frame for the new copy */
1200 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1203 /* Copy the rest of the name through, replacing $ constructs with values */
1220 while (p
!= endp
&& *p
!= '}') p
++;
1221 if (*p
!= '}') goto missingclose
;
1227 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1231 /* Copy out the variable name */
1232 target
= (unsigned char *) alloca (s
- o
+ 1);
1233 strncpy (target
, o
, s
- o
);
1236 /* Get variable value */
1237 o
= (unsigned char *) egetenv (target
);
1238 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1241 if (!o
&& !strcmp (target
, "USER"))
1242 o
= egetenv ("LOGNAME");
1254 /* If /~ or // appears, discard everything through first slash. */
1256 for (p
= xnm
; p
!= x
; p
++)
1259 /* // at start of file name is meaningful in Apollo system */
1260 (p
[0] == '/' && p
- 1 != xnm
)
1261 #else /* not APOLLO */
1263 #endif /* not APOLLO */
1265 && p
!= nm
&& p
[-1] == '/')
1268 return make_string (xnm
, x
- xnm
);
1271 error ("Bad format environment-variable substitution");
1273 error ("Missing \"}\" in environment-variable substitution");
1275 error ("Substituting nonexistent environment variable \"%s\"", target
);
1278 #endif /* not VMS */
1282 expand_and_dir_to_file (filename
, defdir
)
1283 Lisp_Object filename
, defdir
;
1285 register Lisp_Object abspath
;
1287 abspath
= Fexpand_file_name (filename
, defdir
);
1290 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1291 if (c
== ':' || c
== ']' || c
== '>')
1292 abspath
= Fdirectory_file_name (abspath
);
1295 /* Remove final slash, if any (unless path is root).
1296 stat behaves differently depending! */
1297 if (XSTRING (abspath
)->size
> 1
1298 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1300 if (EQ (abspath
, filename
))
1301 abspath
= Fcopy_sequence (abspath
);
1302 XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] = 0;
1308 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1309 Lisp_Object absname
;
1310 unsigned char *querystring
;
1313 register Lisp_Object tem
;
1314 struct gcpro gcpro1
;
1316 if (access (XSTRING (absname
)->data
, 4) >= 0)
1319 Fsignal (Qfile_already_exists
,
1320 Fcons (build_string ("File already exists"),
1321 Fcons (absname
, Qnil
)));
1323 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1324 XSTRING (absname
)->data
, querystring
));
1327 Fsignal (Qfile_already_exists
,
1328 Fcons (build_string ("File already exists"),
1329 Fcons (absname
, Qnil
)));
1334 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1335 "fCopy file: \nFCopy %s to file: \np",
1336 "Copy FILE to NEWNAME. Both args must be strings.\n\
1337 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1338 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1339 A number as third arg means request confirmation if NEWNAME already exists.\n\
1340 This is what happens in interactive use with M-x.\n\
1341 Fourth arg non-nil means give the new file the same last-modified time\n\
1342 that the old one has. (This works on only some systems.)")
1343 (filename
, newname
, ok_if_already_exists
, keep_date
)
1344 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1347 char buf
[16 * 1024];
1349 struct gcpro gcpro1
, gcpro2
;
1351 GCPRO2 (filename
, newname
);
1352 CHECK_STRING (filename
, 0);
1353 CHECK_STRING (newname
, 1);
1354 filename
= Fexpand_file_name (filename
, Qnil
);
1355 newname
= Fexpand_file_name (newname
, Qnil
);
1356 if (NULL (ok_if_already_exists
)
1357 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1358 barf_or_query_if_file_exists (newname
, "copy to it",
1359 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1361 ifd
= open (XSTRING (filename
)->data
, 0);
1363 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1366 /* Create the copy file with the same record format as the input file */
1367 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1369 ofd
= creat (XSTRING (newname
)->data
, 0666);
1374 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1377 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1378 if (write (ofd
, buf
, n
) != n
)
1382 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1385 if (fstat (ifd
, &st
) >= 0)
1388 if (!NULL (keep_date
))
1391 /* AIX has utimes() in compatibility package, but it dies. So use good old
1392 utime interface instead. */
1397 tv
.atime
= st
.st_atime
;
1398 tv
.mtime
= st
.st_mtime
;
1399 utime (XSTRING (newname
)->data
, &tv
);
1400 #else /* not USE_UTIME */
1401 struct timeval timevals
[2];
1402 timevals
[0].tv_sec
= st
.st_atime
;
1403 timevals
[1].tv_sec
= st
.st_mtime
;
1404 timevals
[0].tv_usec
= timevals
[1].tv_usec
= 0;
1405 utimes (XSTRING (newname
)->data
, timevals
);
1406 #endif /* not USE_UTIME */
1408 #endif /* HAVE_TIMEVALS */
1411 if (!egetenv ("USE_DOMAIN_ACLS"))
1413 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1417 if (close (ofd
) < 0)
1418 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1424 DEFUN ("make-directory", Fmake_directory
, Smake_directory
, 1, 1, "FMake directory: ",
1425 "Create a directory. One argument, a file name string.")
1427 Lisp_Object dirname
;
1431 CHECK_STRING (dirname
, 0);
1432 dirname
= Fexpand_file_name (dirname
, Qnil
);
1433 dir
= XSTRING (dirname
)->data
;
1435 if (mkdir (dir
, 0777) != 0)
1436 report_file_error ("Creating directory", Flist (1, &dirname
));
1441 DEFUN ("remove-directory", Fremove_directory
, Sremove_directory
, 1, 1, "FRemove directory: ",
1442 "Remove a directory. One argument, a file name string.")
1444 Lisp_Object dirname
;
1448 CHECK_STRING (dirname
, 0);
1449 dirname
= Fexpand_file_name (dirname
, Qnil
);
1450 dir
= XSTRING (dirname
)->data
;
1452 if (rmdir (dir
) != 0)
1453 report_file_error ("Removing directory", Flist (1, &dirname
));
1458 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1459 "Delete specified file. One argument, a file name string.\n\
1460 If file has multiple names, it continues to exist with the other names.")
1462 Lisp_Object filename
;
1464 CHECK_STRING (filename
, 0);
1465 filename
= Fexpand_file_name (filename
, Qnil
);
1466 if (0 > unlink (XSTRING (filename
)->data
))
1467 report_file_error ("Removing old name", Flist (1, &filename
));
1471 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1472 "fRename file: \nFRename %s to file: \np",
1473 "Rename FILE as NEWNAME. Both args strings.\n\
1474 If file has names other than FILE, it continues to have those names.\n\
1475 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1476 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1477 A number as third arg means request confirmation if NEWNAME already exists.\n\
1478 This is what happens in interactive use with M-x.")
1479 (filename
, newname
, ok_if_already_exists
)
1480 Lisp_Object filename
, newname
, ok_if_already_exists
;
1483 Lisp_Object args
[2];
1485 struct gcpro gcpro1
, gcpro2
;
1487 GCPRO2 (filename
, newname
);
1488 CHECK_STRING (filename
, 0);
1489 CHECK_STRING (newname
, 1);
1490 filename
= Fexpand_file_name (filename
, Qnil
);
1491 newname
= Fexpand_file_name (newname
, Qnil
);
1492 if (NULL (ok_if_already_exists
)
1493 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1494 barf_or_query_if_file_exists (newname
, "rename to it",
1495 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1497 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1499 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1500 || 0 > unlink (XSTRING (filename
)->data
))
1505 Fcopy_file (filename
, newname
, ok_if_already_exists
, Qt
);
1506 Fdelete_file (filename
);
1513 report_file_error ("Renaming", Flist (2, args
));
1516 report_file_error ("Renaming", Flist (2, &filename
));
1523 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1524 "fAdd name to file: \nFName to add to %s: \np",
1525 "Give FILE additional name NEWNAME. Both args strings.\n\
1526 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1527 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1528 A number as third arg means request confirmation if NEWNAME already exists.\n\
1529 This is what happens in interactive use with M-x.")
1530 (filename
, newname
, ok_if_already_exists
)
1531 Lisp_Object filename
, newname
, ok_if_already_exists
;
1534 Lisp_Object args
[2];
1536 struct gcpro gcpro1
, gcpro2
;
1538 GCPRO2 (filename
, newname
);
1539 CHECK_STRING (filename
, 0);
1540 CHECK_STRING (newname
, 1);
1541 filename
= Fexpand_file_name (filename
, Qnil
);
1542 newname
= Fexpand_file_name (newname
, Qnil
);
1543 if (NULL (ok_if_already_exists
)
1544 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1545 barf_or_query_if_file_exists (newname
, "make it a new name",
1546 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1547 unlink (XSTRING (newname
)->data
);
1548 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1553 report_file_error ("Adding new name", Flist (2, args
));
1555 report_file_error ("Adding new name", Flist (2, &filename
));
1564 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1565 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1566 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1567 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1568 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1569 A number as third arg means request confirmation if NEWNAME already exists.\n\
1570 This happens for interactive use with M-x.")
1571 (filename
, newname
, ok_if_already_exists
)
1572 Lisp_Object filename
, newname
, ok_if_already_exists
;
1575 Lisp_Object args
[2];
1577 struct gcpro gcpro1
, gcpro2
;
1579 GCPRO2 (filename
, newname
);
1580 CHECK_STRING (filename
, 0);
1581 CHECK_STRING (newname
, 1);
1582 #if 0 /* This made it impossible to make a link to a relative name. */
1583 filename
= Fexpand_file_name (filename
, Qnil
);
1585 newname
= Fexpand_file_name (newname
, Qnil
);
1586 if (NULL (ok_if_already_exists
)
1587 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1588 barf_or_query_if_file_exists (newname
, "make it a link",
1589 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1590 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1592 /* If we didn't complain already, silently delete existing file. */
1593 if (errno
== EEXIST
)
1595 unlink (XSTRING (filename
)->data
);
1596 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1603 report_file_error ("Making symbolic link", Flist (2, args
));
1605 report_file_error ("Making symbolic link", Flist (2, &filename
));
1611 #endif /* S_IFLNK */
1615 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
1616 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1617 "Define the job-wide logical name NAME to have the value STRING.\n\
1618 If STRING is nil or a null string, the logical name NAME is deleted.")
1620 Lisp_Object varname
;
1623 CHECK_STRING (varname
, 0);
1625 delete_logical_name (XSTRING (varname
)->data
);
1628 CHECK_STRING (string
, 1);
1630 if (XSTRING (string
)->size
== 0)
1631 delete_logical_name (XSTRING (varname
)->data
);
1633 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
1642 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
1643 "Open a network connection to PATH using LOGIN as the login string.")
1645 Lisp_Object path
, login
;
1649 CHECK_STRING (path
, 0);
1650 CHECK_STRING (login
, 0);
1652 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
1654 if (netresult
== -1)
1659 #endif /* HPUX_NET */
1661 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
1663 "Return t if file FILENAME specifies an absolute path name.\n\
1664 On Unix, this is a name starting with a `/' or a `~'.")
1666 Lisp_Object filename
;
1670 CHECK_STRING (filename
, 0);
1671 ptr
= XSTRING (filename
)->data
;
1672 if (*ptr
== '/' || *ptr
== '~'
1674 /* ??? This criterion is probably wrong for '<'. */
1675 || index (ptr
, ':') || index (ptr
, '<')
1676 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
1685 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
1686 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1687 See also `file-readable-p' and `file-attributes'.")
1689 Lisp_Object filename
;
1691 Lisp_Object abspath
;
1693 CHECK_STRING (filename
, 0);
1694 abspath
= Fexpand_file_name (filename
, Qnil
);
1695 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
1698 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
1699 "Return t if FILENAME can be executed by you.\n\
1700 For directories this means you can change to that directory.")
1702 Lisp_Object filename
;
1705 Lisp_Object abspath
;
1707 CHECK_STRING (filename
, 0);
1708 abspath
= Fexpand_file_name (filename
, Qnil
);
1709 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
1712 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
1713 "Return t if file FILENAME exists and you can read it.\n\
1714 See also `file-exists-p' and `file-attributes'.")
1716 Lisp_Object filename
;
1718 Lisp_Object abspath
;
1720 CHECK_STRING (filename
, 0);
1721 abspath
= Fexpand_file_name (filename
, Qnil
);
1722 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
1725 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
1726 "If file FILENAME is the name of a symbolic link\n\
1727 returns the name of the file to which it is linked.\n\
1728 Otherwise returns NIL.")
1730 Lisp_Object filename
;
1738 CHECK_STRING (filename
, 0);
1739 filename
= Fexpand_file_name (filename
, Qnil
);
1744 buf
= (char *) xmalloc (bufsize
);
1745 bzero (buf
, bufsize
);
1746 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
1747 if (valsize
< bufsize
) break;
1748 /* Buffer was not long enough */
1757 val
= make_string (buf
, valsize
);
1760 #else /* not S_IFLNK */
1762 #endif /* not S_IFLNK */
1765 /* Having this before file-symlink-p mysteriously caused it to be forgotten
1767 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
1768 "Return t if file FILENAME can be written or created by you.")
1770 Lisp_Object filename
;
1772 Lisp_Object abspath
, dir
;
1774 CHECK_STRING (filename
, 0);
1775 abspath
= Fexpand_file_name (filename
, Qnil
);
1776 if (access (XSTRING (abspath
)->data
, 0) >= 0)
1777 return (access (XSTRING (abspath
)->data
, 2) >= 0) ? Qt
: Qnil
;
1778 dir
= Ffile_name_directory (abspath
);
1781 dir
= Fdirectory_file_name (dir
);
1783 return (access (!NULL (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
1787 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
1788 "Return t if file FILENAME is the name of a directory as a file.\n\
1789 A directory name spec may be given instead; then the value is t\n\
1790 if the directory so specified exists and really is a directory.")
1792 Lisp_Object filename
;
1794 register Lisp_Object abspath
;
1797 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
1799 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1801 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
1804 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
1805 "Return mode bits of FILE, as an integer.")
1807 Lisp_Object filename
;
1809 Lisp_Object abspath
;
1812 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
1814 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1816 return make_number (st
.st_mode
& 07777);
1819 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
1820 "Set mode bits of FILE to MODE (an integer).\n\
1821 Only the 12 low bits of MODE are used.")
1823 Lisp_Object filename
, mode
;
1825 Lisp_Object abspath
;
1827 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
1828 CHECK_NUMBER (mode
, 1);
1831 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
1832 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
1834 if (!egetenv ("USE_DOMAIN_ACLS"))
1837 struct timeval tvp
[2];
1839 /* chmod on apollo also change the file's modtime; need to save the
1840 modtime and then restore it. */
1841 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1843 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
1847 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
1848 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
1850 /* reset the old accessed and modified times. */
1851 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
1853 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
1856 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
1857 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
1864 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
1865 "Return t if file FILE1 is newer than file FILE2.\n\
1866 If FILE1 does not exist, the answer is nil;\n\
1867 otherwise, if FILE2 does not exist, the answer is t.")
1869 Lisp_Object file1
, file2
;
1871 Lisp_Object abspath
;
1875 CHECK_STRING (file1
, 0);
1876 CHECK_STRING (file2
, 0);
1878 abspath
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
1880 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1883 mtime1
= st
.st_mtime
;
1885 abspath
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
1887 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1890 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
1893 close_file_unwind (fd
)
1896 close (XFASTINT (fd
));
1899 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
1901 "Insert contents of file FILENAME after point.\n\
1902 Returns list of absolute pathname and length of data inserted.\n\
1903 If second argument VISIT is non-nil, the buffer's visited filename\n\
1904 and last save file modtime are set, and it is marked unmodified.\n\
1905 If visiting and the file does not exist, visiting is completed\n\
1906 before the error is signaled.")
1908 Lisp_Object filename
, visit
;
1912 register int inserted
= 0;
1913 register int how_much
;
1914 int count
= specpdl_ptr
- specpdl
;
1915 struct gcpro gcpro1
;
1918 if (!NULL (current_buffer
->read_only
))
1919 Fbarf_if_buffer_read_only();
1921 CHECK_STRING (filename
, 0);
1922 filename
= Fexpand_file_name (filename
, Qnil
);
1927 if (stat (XSTRING (filename
)->data
, &st
) < 0
1928 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
1930 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
1931 || fstat (fd
, &st
) < 0)
1932 #endif /* not APOLLO */
1934 if (fd
>= 0) close (fd
);
1936 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1942 record_unwind_protect (close_file_unwind
, make_number (fd
));
1944 /* Supposedly happens on VMS. */
1946 error ("File size is negative");
1948 register Lisp_Object temp
;
1950 /* Make sure point-max won't overflow after this insertion. */
1951 XSET (temp
, Lisp_Int
, st
.st_size
+ Z
);
1952 if (st
.st_size
+ Z
!= XINT (temp
))
1953 error ("maximum buffer size exceeded");
1957 prepare_to_modify_buffer (point
, point
);
1960 if (GAP_SIZE
< st
.st_size
)
1961 make_gap (st
.st_size
- GAP_SIZE
);
1965 int try = min (st
.st_size
- inserted
, 64 << 10);
1966 int this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
1983 record_insert (point
, inserted
);
1987 /* Discard the unwind protect */
1988 specpdl_ptr
= specpdl
+ count
;
1991 error ("IO error reading %s: %s",
1992 XSTRING (filename
)->data
, err_str (errno
));
1998 current_buffer
->undo_list
= Qnil
;
2000 stat (XSTRING (filename
)->data
, &st
);
2002 current_buffer
->modtime
= st
.st_mtime
;
2003 current_buffer
->save_modified
= MODIFF
;
2004 current_buffer
->auto_save_modified
= MODIFF
;
2005 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2006 #ifdef CLASH_DETECTION
2007 if (!NULL (current_buffer
->filename
))
2008 unlock_file (current_buffer
->filename
);
2009 unlock_file (filename
);
2010 #endif /* CLASH_DETECTION */
2011 current_buffer
->filename
= filename
;
2012 /* If visiting nonexistent file, return nil. */
2013 if (st
.st_mtime
== -1)
2014 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2017 signal_after_change (point
, 0, inserted
);
2019 RETURN_UNGCPRO (Fcons (filename
,
2020 Fcons (make_number (inserted
),
2024 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2025 "r\nFWrite region to file: ",
2026 "Write current region into specified file.\n\
2027 When called from a program, takes three arguments:\n\
2028 START, END and FILENAME. START and END are buffer positions.\n\
2029 Optional fourth argument APPEND if non-nil means\n\
2030 append to existing file contents (if any).\n\
2031 Optional fifth argument VISIT if t means\n\
2032 set the last-save-file-modtime of buffer to this file's modtime\n\
2033 and mark buffer not modified.\n\
2034 If VISIT is neither t nor nil, it means do not print\n\
2035 the \"Wrote file\" message.\n\
2036 Kludgy feature: if START is a string, then that string is written\n\
2037 to the file, instead of any buffer contents, and END is ignored.")
2038 (start
, end
, filename
, append
, visit
)
2039 Lisp_Object start
, end
, filename
, append
, visit
;
2047 int count
= specpdl_ptr
- specpdl
;
2049 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2052 /* Special kludge to simplify auto-saving */
2055 XFASTINT (start
) = BEG
;
2058 else if (XTYPE (start
) != Lisp_String
)
2059 validate_region (&start
, &end
);
2061 filename
= Fexpand_file_name (filename
, Qnil
);
2062 fn
= XSTRING (filename
)->data
;
2064 #ifdef CLASH_DETECTION
2066 lock_file (filename
);
2067 #endif /* CLASH_DETECTION */
2071 desc
= open (fn
, O_WRONLY
);
2075 if (auto_saving
) /* Overwrite any previous version of autosave file */
2077 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2078 desc
= open (fn
, O_RDWR
);
2080 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2081 ? XSTRING (current_buffer
->filename
)->data
: 0,
2084 else /* Write to temporary name and rename if no errors */
2086 Lisp_Object temp_name
;
2087 temp_name
= Ffile_name_directory (filename
);
2089 if (!NULL (temp_name
))
2091 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2092 build_string ("$$SAVE$$")));
2093 fname
= XSTRING (filename
)->data
;
2094 fn
= XSTRING (temp_name
)->data
;
2095 desc
= creat_copy_attrs (fname
, fn
);
2098 /* If we can't open the temporary file, try creating a new
2099 version of the original file. VMS "creat" creates a
2100 new version rather than truncating an existing file. */
2103 desc
= creat (fn
, 0666);
2104 #if 0 /* This can clobber an existing file and fail to replace it,
2105 if the user runs out of space. */
2108 /* We can't make a new version;
2109 try to truncate and rewrite existing version if any. */
2111 desc
= open (fn
, O_RDWR
);
2117 desc
= creat (fn
, 0666);
2120 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2121 #endif /* not VMS */
2125 #ifdef CLASH_DETECTION
2127 if (!auto_saving
) unlock_file (filename
);
2129 #endif /* CLASH_DETECTION */
2130 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2133 record_unwind_protect (close_file_unwind
, make_number (desc
));
2136 if (lseek (desc
, 0, 2) < 0)
2138 #ifdef CLASH_DETECTION
2139 if (!auto_saving
) unlock_file (filename
);
2140 #endif /* CLASH_DETECTION */
2141 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2146 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2147 * if we do writes that don't end with a carriage return. Furthermore
2148 * it cannot handle writes of more then 16K. The modified
2149 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2150 * this EXCEPT for the last record (iff it doesn't end with a carriage
2151 * return). This implies that if your buffer doesn't end with a carriage
2152 * return, you get one free... tough. However it also means that if
2153 * we make two calls to sys_write (a la the following code) you can
2154 * get one at the gap as well. The easiest way to fix this (honest)
2155 * is to move the gap to the next newline (or the end of the buffer).
2160 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2161 move_gap (find_next_newline (GPT
, 1));
2167 if (XTYPE (start
) == Lisp_String
)
2169 failure
= 0 > e_write (desc
, XSTRING (start
)->data
,
2170 XSTRING (start
)->size
);
2173 else if (XINT (start
) != XINT (end
))
2175 if (XINT (start
) < GPT
)
2177 register int end1
= XINT (end
);
2179 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
),
2180 min (GPT
, end1
) - tem
);
2184 if (XINT (end
) > GPT
&& !failure
)
2187 tem
= max (tem
, GPT
);
2188 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
);
2198 #ifndef alliant /* trinkle@cs.purdue.edu says fsync can return EBUSY
2199 on alliant, for no visible reason. */
2200 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2201 Disk full in NFS may be reported here. */
2202 if (fsync (desc
) < 0)
2203 failure
= 1, save_errno
= errno
;
2209 /* Spurious "file has changed on disk" warnings have been
2210 observed on Suns as well.
2211 It seems that `close' can change the modtime, under nfs.
2213 (This has supposedly been fixed in Sunos 4,
2214 but who knows about all the other machines with NFS?) */
2217 /* On VMS and APOLLO, must do the stat after the close
2218 since closing changes the modtime. */
2221 /* Recall that #if defined does not work on VMS. */
2228 /* NFS can report a write failure now. */
2229 if (close (desc
) < 0)
2230 failure
= 1, save_errno
= errno
;
2233 /* If we wrote to a temporary name and had no errors, rename to real name. */
2237 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2245 /* Discard the unwind protect */
2246 specpdl_ptr
= specpdl
+ count
;
2248 #ifdef CLASH_DETECTION
2250 unlock_file (filename
);
2251 #endif /* CLASH_DETECTION */
2253 /* Do this before reporting IO error
2254 to avoid a "file has changed on disk" warning on
2255 next attempt to save. */
2257 current_buffer
->modtime
= st
.st_mtime
;
2260 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2264 current_buffer
->save_modified
= MODIFF
;
2265 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2266 current_buffer
->filename
= filename
;
2268 else if (!NULL (visit
))
2272 message ("Wrote %s", fn
);
2278 e_write (desc
, addr
, len
)
2280 register char *addr
;
2283 char buf
[16 * 1024];
2284 register char *p
, *end
;
2286 if (!EQ (current_buffer
->selective_display
, Qt
))
2287 return write (desc
, addr
, len
) - len
;
2291 end
= p
+ sizeof buf
;
2296 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
2305 if (write (desc
, buf
, p
- buf
) != p
- buf
)
2311 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
2312 Sverify_visited_file_modtime
, 1, 1, 0,
2313 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2314 This means that the file has not been changed since it was visited or saved.")
2321 CHECK_BUFFER (buf
, 0);
2324 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
2325 if (b
->modtime
== 0) return Qt
;
2327 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
2329 /* If the file doesn't exist now and didn't exist before,
2330 we say that it isn't modified, provided the error is a tame one. */
2331 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
2336 if (st
.st_mtime
== b
->modtime
2337 /* If both are positive, accept them if they are off by one second. */
2338 || (st
.st_mtime
> 0 && b
->modtime
> 0
2339 && (st
.st_mtime
== b
->modtime
+ 1
2340 || st
.st_mtime
== b
->modtime
- 1)))
2345 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
2346 Sclear_visited_file_modtime
, 0, 0, 0,
2347 "Clear out records of last mod time of visited file.\n\
2348 Next attempt to save will certainly not complain of a discrepancy.")
2351 current_buffer
->modtime
= 0;
2355 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
2356 Sset_visited_file_modtime
, 0, 0, 0,
2357 "Update buffer's recorded modification time from the visited file's time.\n\
2358 Useful if the buffer was not read from the file normally\n\
2359 or if the file itself has been changed for some known benign reason.")
2362 register Lisp_Object filename
;
2365 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
2367 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
2368 current_buffer
->modtime
= st
.st_mtime
;
2376 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
2379 message ("Autosaving...error for %s", name
);
2380 Fsleep_for (make_number (1));
2381 message ("Autosaving...error!for %s", name
);
2382 Fsleep_for (make_number (1));
2383 message ("Autosaving...error for %s", name
);
2384 Fsleep_for (make_number (1));
2394 /* Get visited file's mode to become the auto save file's mode. */
2395 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
2396 /* But make sure we can overwrite it later! */
2397 auto_save_mode_bits
= st
.st_mode
| 0600;
2399 auto_save_mode_bits
= 0666;
2402 Fwrite_region (Qnil
, Qnil
,
2403 current_buffer
->auto_save_file_name
,
2407 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
2408 "Auto-save all buffers that need it.\n\
2409 This is all buffers that have auto-saving enabled\n\
2410 and are changed since last auto-saved.\n\
2411 Auto-saving writes the buffer into a file\n\
2412 so that your editing is not lost if the system crashes.\n\
2413 This file is not the file you visited; that changes only when you save.\n\n\
2414 Non-nil first argument means do not print any message if successful.\n\
2415 Non-nil second argumet means save only current buffer.")
2419 struct buffer
*old
= current_buffer
, *b
;
2420 Lisp_Object tail
, buf
;
2422 char *omessage
= echo_area_glyphs
;
2423 extern minibuf_level
;
2425 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2426 point to non-strings reached from Vbuffer_alist. */
2432 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2433 eventually call do-auto-save, so don't err here in that case. */
2434 if (!NULL (Vrun_hooks
))
2435 call1 (Vrun_hooks
, intern ("auto-save-hook"));
2437 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2438 tail
= XCONS (tail
)->cdr
)
2440 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
2442 /* Check for auto save enabled
2443 and file changed since last auto save
2444 and file changed since last real save. */
2445 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
2446 && b
->save_modified
< BUF_MODIFF (b
)
2447 && b
->auto_save_modified
< BUF_MODIFF (b
))
2449 if ((XFASTINT (b
->save_length
) * 10
2450 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
2451 /* A short file is likely to change a large fraction;
2452 spare the user annoying messages. */
2453 && XFASTINT (b
->save_length
) > 5000
2454 /* These messages are frequent and annoying for `*mail*'. */
2455 && !EQ (b
->filename
, Qnil
))
2457 /* It has shrunk too much; turn off auto-saving here. */
2458 message ("Buffer %s has shrunk a lot; auto save turned off there",
2459 XSTRING (b
->name
)->data
);
2460 /* User can reenable saving with M-x auto-save. */
2461 b
->auto_save_file_name
= Qnil
;
2462 /* Prevent warning from repeating if user does so. */
2463 XFASTINT (b
->save_length
) = 0;
2464 Fsleep_for (make_number (1));
2467 set_buffer_internal (b
);
2468 if (!auto_saved
&& NULL (nomsg
))
2469 message1 ("Auto-saving...");
2470 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
2472 b
->auto_save_modified
= BUF_MODIFF (b
);
2473 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2474 set_buffer_internal (old
);
2479 record_auto_save ();
2481 if (auto_saved
&& NULL (nomsg
))
2482 message1 (omessage
? omessage
: "Auto-saving...done");
2488 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
2489 Sset_buffer_auto_saved
, 0, 0, 0,
2490 "Mark current buffer as auto-saved with its current text.\n\
2491 No auto-save file will be written until the buffer changes again.")
2494 current_buffer
->auto_save_modified
= MODIFF
;
2495 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2499 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
2501 "Return t if buffer has been auto-saved since last read in or saved.")
2504 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
2507 /* Reading and completing file names */
2508 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
2510 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
2512 "Internal subroutine for read-file-name. Do not call this.")
2513 (string
, dir
, action
)
2514 Lisp_Object string
, dir
, action
;
2515 /* action is nil for complete, t for return list of completions,
2516 lambda for verify final value */
2518 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
2520 if (XSTRING (string
)->size
== 0)
2525 if (EQ (action
, Qlambda
))
2530 orig_string
= string
;
2531 string
= Fsubstitute_in_file_name (string
);
2532 name
= Ffile_name_nondirectory (string
);
2533 realdir
= Ffile_name_directory (string
);
2537 realdir
= Fexpand_file_name (realdir
, dir
);
2542 specdir
= Ffile_name_directory (string
);
2543 val
= Ffile_name_completion (name
, realdir
);
2544 if (XTYPE (val
) != Lisp_String
)
2546 if (NULL (Fstring_equal (string
, orig_string
)))
2551 if (!NULL (specdir
))
2552 val
= concat2 (specdir
, val
);
2555 register unsigned char *old
, *new;
2559 osize
= XSTRING (val
)->size
;
2560 /* Quote "$" as "$$" to get it past substitute-in-file-name */
2561 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
2562 if (*old
++ == '$') count
++;
2565 old
= XSTRING (val
)->data
;
2566 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
2567 new = XSTRING (val
)->data
;
2568 for (n
= osize
; n
> 0; n
--)
2579 #endif /* Not VMS */
2583 if (EQ (action
, Qt
))
2584 return Ffile_name_all_completions (name
, realdir
);
2585 /* Only other case actually used is ACTION = lambda */
2587 /* Supposedly this helps commands such as `cd' that read directory names,
2588 but can someone explain how it helps them? -- RMS */
2589 if (XSTRING (name
)->size
== 0)
2592 return Ffile_exists_p (string
);
2595 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
2596 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
2597 Value is not expanded---you must call `expand-file-name' yourself.\n\
2598 Default name to DEFAULT if user enters a null string.\n\
2599 (If DEFAULT is omitted, the visited file name is used.)\n\
2600 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
2601 Non-nil and non-t means also require confirmation after completion.\n\
2602 Fifth arg INITIAL specifies text to start with.\n\
2603 DIR defaults to current buffer's directory default.")
2604 (prompt
, dir
, defalt
, mustmatch
, initial
)
2605 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
2607 Lisp_Object val
, insdef
, tem
, backup_n
;
2608 struct gcpro gcpro1
, gcpro2
;
2609 register char *homedir
;
2613 dir
= current_buffer
->directory
;
2615 defalt
= current_buffer
->filename
;
2617 /* If dir starts with user's homedir, change that to ~. */
2618 homedir
= (char *) egetenv ("HOME");
2620 && XTYPE (dir
) == Lisp_String
2621 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
2622 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
2624 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
2625 XSTRING (dir
)->size
- strlen (homedir
) + 1);
2626 XSTRING (dir
)->data
[0] = '~';
2629 if (insert_default_directory
)
2632 if (!NULL (initial
))
2634 Lisp_Object args
[2];
2638 insdef
= Fconcat (2, args
);
2639 backup_n
= make_number (- (XSTRING (initial
)->size
));
2646 insdef
= build_string ("");
2651 count
= specpdl_ptr
- specpdl
;
2652 specbind (intern ("completion-ignore-case"), Qt
);
2655 GCPRO2 (insdef
, defalt
);
2656 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
2658 insert_default_directory
? insdef
: Qnil
, backup_n
);
2661 unbind_to (count
, Qnil
);
2666 error ("No file name specified");
2667 tem
= Fstring_equal (val
, insdef
);
2668 if (!NULL (tem
) && !NULL (defalt
))
2670 return Fsubstitute_in_file_name (val
);
2673 #if 0 /* Old version */
2674 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
2675 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
2676 Value is not expanded---you must call `expand-file-name' yourself.\n\
2677 Default name to DEFAULT if user enters a null string.\n\
2678 (If DEFAULT is omitted, the visited file name is used.)\n\
2679 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
2680 Non-nil and non-t means also require confirmation after completion.\n\
2681 Fifth arg INITIAL specifies text to start with.\n\
2682 DIR defaults to current buffer's directory default.")
2683 (prompt
, dir
, defalt
, mustmatch
, initial
)
2684 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
2686 Lisp_Object val
, insdef
, tem
;
2687 struct gcpro gcpro1
, gcpro2
;
2688 register char *homedir
;
2692 dir
= current_buffer
->directory
;
2694 defalt
= current_buffer
->filename
;
2696 /* If dir starts with user's homedir, change that to ~. */
2697 homedir
= (char *) egetenv ("HOME");
2699 && XTYPE (dir
) == Lisp_String
2700 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
2701 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
2703 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
2704 XSTRING (dir
)->size
- strlen (homedir
) + 1);
2705 XSTRING (dir
)->data
[0] = '~';
2708 if (!NULL (initial
))
2710 else if (insert_default_directory
)
2713 insdef
= build_string ("");
2716 count
= specpdl_ptr
- specpdl
;
2717 specbind (intern ("completion-ignore-case"), Qt
);
2720 GCPRO2 (insdef
, defalt
);
2721 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
2723 insert_default_directory
? insdef
: Qnil
, Qnil
);
2726 unbind_to (count
, Qnil
);
2731 error ("No file name specified");
2732 tem
= Fstring_equal (val
, insdef
);
2733 if (!NULL (tem
) && !NULL (defalt
))
2735 return Fsubstitute_in_file_name (val
);
2737 #endif /* Old version */
2741 Qfile_error
= intern ("file-error");
2742 staticpro (&Qfile_error
);
2743 Qfile_already_exists
= intern("file-already-exists");
2744 staticpro (&Qfile_already_exists
);
2746 Fput (Qfile_error
, Qerror_conditions
,
2747 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
2748 Fput (Qfile_error
, Qerror_message
,
2749 build_string ("File error"));
2751 Fput (Qfile_already_exists
, Qerror_conditions
,
2752 Fcons (Qfile_already_exists
,
2753 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
2754 Fput (Qfile_already_exists
, Qerror_message
,
2755 build_string ("File already exists"));
2757 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
2758 "*Non-nil means when reading a filename start with default dir in minibuffer.");
2759 insert_default_directory
= 1;
2761 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
2762 "*Non-nil means write new files with record format `stmlf'.\n\
2763 nil means use format `var'. This variable is meaningful only on VMS.");
2764 vms_stmlf_recfm
= 0;
2766 defsubr (&Sfile_name_directory
);
2767 defsubr (&Sfile_name_nondirectory
);
2768 defsubr (&Sfile_name_as_directory
);
2769 defsubr (&Sdirectory_file_name
);
2770 defsubr (&Smake_temp_name
);
2771 defsubr (&Sexpand_file_name
);
2772 defsubr (&Ssubstitute_in_file_name
);
2773 defsubr (&Scopy_file
);
2774 defsubr (&Smake_directory
);
2775 defsubr (&Sremove_directory
);
2776 defsubr (&Sdelete_file
);
2777 defsubr (&Srename_file
);
2778 defsubr (&Sadd_name_to_file
);
2780 defsubr (&Smake_symbolic_link
);
2781 #endif /* S_IFLNK */
2783 defsubr (&Sdefine_logical_name
);
2786 defsubr (&Ssysnetunam
);
2787 #endif /* HPUX_NET */
2788 defsubr (&Sfile_name_absolute_p
);
2789 defsubr (&Sfile_exists_p
);
2790 defsubr (&Sfile_executable_p
);
2791 defsubr (&Sfile_readable_p
);
2792 defsubr (&Sfile_writable_p
);
2793 defsubr (&Sfile_symlink_p
);
2794 defsubr (&Sfile_directory_p
);
2795 defsubr (&Sfile_modes
);
2796 defsubr (&Sset_file_modes
);
2797 defsubr (&Sfile_newer_than_file_p
);
2798 defsubr (&Sinsert_file_contents
);
2799 defsubr (&Swrite_region
);
2800 defsubr (&Sverify_visited_file_modtime
);
2801 defsubr (&Sclear_visited_file_modtime
);
2802 defsubr (&Sset_visited_file_modtime
);
2803 defsubr (&Sdo_auto_save
);
2804 defsubr (&Sset_buffer_auto_saved
);
2805 defsubr (&Srecent_auto_save_p
);
2807 defsubr (&Sread_file_name_internal
);
2808 defsubr (&Sread_file_name
);