1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
22 #include <sys/types.h>
46 extern char *sys_errlist
[];
50 #define err_str(a) ((a) < sys_nerr ? sys_errlist[a] : "unknown error")
80 #define min(a, b) ((a) < (b) ? (a) : (b))
81 #define max(a, b) ((a) > (b) ? (a) : (b))
83 /* Nonzero during writing of auto-save files */
86 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
87 a new file with the same mode as the original */
88 int auto_save_mode_bits
;
90 /* Nonzero means, when reading a filename in the minibuffer,
91 start out by inserting the default directory into the minibuffer. */
92 int insert_default_directory
;
94 /* On VMS, nonzero means write new files with record format stmlf.
95 Zero means use var format. */
98 Lisp_Object Qfile_error
, Qfile_already_exists
;
100 report_file_error (string
, data
)
104 Lisp_Object errstring
;
106 if (errno
>= 0 && errno
< sys_nerr
)
107 errstring
= build_string (sys_errlist
[errno
]);
109 errstring
= build_string ("undocumented error code");
111 /* System error messages are capitalized. Downcase the initial
112 unless it is followed by a slash. */
113 if (XSTRING (errstring
)->data
[1] != '/')
114 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
117 Fsignal (Qfile_error
,
118 Fcons (build_string (string
), Fcons (errstring
, data
)));
121 close_file_unwind (fd
)
124 close (XFASTINT (fd
));
127 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
129 "Return the directory component in file name NAME.\n\
130 Return nil if NAME does not include a directory.\n\
131 Otherwise return a directory spec.\n\
132 Given a Unix syntax file name, returns a string ending in slash;\n\
133 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
137 register unsigned char *beg
;
138 register unsigned char *p
;
140 CHECK_STRING (file
, 0);
142 beg
= XSTRING (file
)->data
;
143 p
= beg
+ XSTRING (file
)->size
;
145 while (p
!= beg
&& p
[-1] != '/'
147 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
153 return make_string (beg
, p
- beg
);
156 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
158 "Return file name NAME sans its directory.\n\
159 For example, in a Unix-syntax file name,\n\
160 this is everything after the last slash,\n\
161 or the entire name if it contains no slash.")
165 register unsigned char *beg
, *p
, *end
;
167 CHECK_STRING (file
, 0);
169 beg
= XSTRING (file
)->data
;
170 end
= p
= beg
+ XSTRING (file
)->size
;
172 while (p
!= beg
&& p
[-1] != '/'
174 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
178 return make_string (p
, end
- p
);
182 file_name_as_directory (out
, in
)
185 int size
= strlen (in
) - 1;
190 /* Is it already a directory string? */
191 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
193 /* Is it a VMS directory file name? If so, hack VMS syntax. */
194 else if (! index (in
, '/')
195 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
196 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
197 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
198 || ! strncmp (&in
[size
- 5], ".dir", 4))
199 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
200 && in
[size
] == '1')))
202 register char *p
, *dot
;
206 dir:x.dir --> dir:[x]
207 dir:[x]y.dir --> dir:[x.y] */
209 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
212 strncpy (out
, in
, p
- in
);
231 dot
= index (p
, '.');
234 /* blindly remove any extension */
235 size
= strlen (out
) + (dot
- p
);
236 strncat (out
, p
, dot
- p
);
247 /* For Unix syntax, Append a slash if necessary */
248 if (out
[size
] != '/')
254 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
255 Sfile_name_as_directory
, 1, 1, 0,
256 "Return a string representing file FILENAME interpreted as a directory.\n\
257 This operation exists because a directory is also a file, but its name as\n\
258 a directory is different from its name as a file.\n\
259 The result can be used as the value of `default-directory'\n\
260 or passed as second argument to `expand-file-name'.\n\
261 For a Unix-syntax file name, just appends a slash.\n\
262 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
268 CHECK_STRING (file
, 0);
271 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
272 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
276 * Convert from directory name to filename.
278 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
279 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
280 * On UNIX, it's simple: just make sure there is a terminating /
282 * Value is nonzero if the string output is different from the input.
285 directory_file_name (src
, dst
)
293 struct FAB fab
= cc$rms_fab
;
294 struct NAM nam
= cc$rms_nam
;
295 char esa
[NAM$C_MAXRSS
];
300 if (! index (src
, '/')
301 && (src
[slen
- 1] == ']'
302 || src
[slen
- 1] == ':'
303 || src
[slen
- 1] == '>'))
305 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
307 fab
.fab$b_fns
= slen
;
308 fab
.fab$l_nam
= &nam
;
309 fab
.fab$l_fop
= FAB$M_NAM
;
312 nam
.nam$b_ess
= sizeof esa
;
313 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
315 /* We call SYS$PARSE to handle such things as [--] for us. */
316 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
318 slen
= nam
.nam$b_esl
;
319 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
324 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
326 /* what about when we have logical_name:???? */
327 if (src
[slen
- 1] == ':')
328 { /* Xlate logical name and see what we get */
329 ptr
= strcpy (dst
, src
); /* upper case for getenv */
332 if ('a' <= *ptr
&& *ptr
<= 'z')
336 dst
[slen
- 1] = 0; /* remove colon */
337 if (!(src
= egetenv (dst
)))
339 /* should we jump to the beginning of this procedure?
340 Good points: allows us to use logical names that xlate
342 Bad points: can be a problem if we just translated to a device
344 For now, I'll punt and always expect VMS names, and hope for
347 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
348 { /* no recursion here! */
354 { /* not a directory spec */
359 bracket
= src
[slen
- 1];
361 /* If bracket is ']' or '>', bracket - 2 is the corresponding
363 ptr
= index (src
, bracket
- 2);
365 { /* no opening bracket */
369 if (!(rptr
= rindex (src
, '.')))
372 strncpy (dst
, src
, slen
);
376 dst
[slen
++] = bracket
;
381 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
382 then translate the device and recurse. */
383 if (dst
[slen
- 1] == ':'
384 && dst
[slen
- 2] != ':' /* skip decnet nodes */
385 && strcmp(src
+ slen
, "[000000]") == 0)
387 dst
[slen
- 1] = '\0';
388 if ((ptr
= egetenv (dst
))
389 && (rlen
= strlen (ptr
) - 1) > 0
390 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
391 && ptr
[rlen
- 1] == '.')
395 return directory_file_name (ptr
, dst
);
400 strcat (dst
, "[000000]");
404 rlen
= strlen (rptr
) - 1;
405 strncat (dst
, rptr
, rlen
);
406 dst
[slen
+ rlen
] = '\0';
407 strcat (dst
, ".DIR.1");
411 /* Process as Unix format: just remove any final slash.
412 But leave "/" unchanged; do not change it to "". */
414 if (slen
> 1 && dst
[slen
- 1] == '/')
419 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
421 "Returns the file name of the directory named DIR.\n\
422 This is the name of the file that holds the data for the directory DIR.\n\
423 This operation exists because a directory is also a file, but its name as\n\
424 a directory is different from its name as a file.\n\
425 In Unix-syntax, this function just removes the final slash.\n\
426 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
427 it returns a file name such as \"[X]Y.DIR.1\".")
429 Lisp_Object directory
;
433 CHECK_STRING (directory
, 0);
435 if (NILP (directory
))
438 /* 20 extra chars is insufficient for VMS, since we might perform a
439 logical name translation. an equivalence string can be up to 255
440 chars long, so grab that much extra space... - sss */
441 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
443 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
445 directory_file_name (XSTRING (directory
)->data
, buf
);
446 return build_string (buf
);
449 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
450 "Generate temporary file name (string) starting with PREFIX (a string).\n\
451 The Emacs process number forms part of the result,\n\
452 so there is no danger of generating a name being used by another process.")
457 val
= concat2 (prefix
, build_string ("XXXXXX"));
458 mktemp (XSTRING (val
)->data
);
462 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
463 "Convert FILENAME to absolute, and canonicalize it.\n\
464 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
465 (does not start with slash); if DEFAULT is nil or missing,\n\
466 the current buffer's value of default-directory is used.\n\
467 Path components that are `.' are removed, and \n\
468 path components followed by `..' are removed, along with the `..' itself;\n\
469 note that these simplifications are done without checking the resulting\n\
470 paths in the file system.\n\
471 An initial `~/' expands to your home directory.\n\
472 An initial `~USER/' expands to USER's home directory.\n\
473 See also the function `substitute-in-file-name'.")
475 Lisp_Object name
, defalt
;
479 register unsigned char *newdir
, *p
, *o
;
481 unsigned char *target
;
485 unsigned char * colon
= 0;
486 unsigned char * close
= 0;
487 unsigned char * slash
= 0;
488 unsigned char * brack
= 0;
489 int lbrack
= 0, rbrack
= 0;
493 CHECK_STRING (name
, 0);
496 /* Filenames on VMS are always upper case. */
497 name
= Fupcase (name
);
500 nm
= XSTRING (name
)->data
;
502 /* If nm is absolute, flush ...// and detect /./ and /../.
503 If no /./ or /../ we can return right away. */
515 if (p
[0] == '/' && p
[1] == '/'
517 /* // at start of filename is meaningful on Apollo system */
522 if (p
[0] == '/' && p
[1] == '~')
523 nm
= p
+ 1, lose
= 1;
524 if (p
[0] == '/' && p
[1] == '.'
525 && (p
[2] == '/' || p
[2] == 0
526 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
532 /* if dev:[dir]/, move nm to / */
533 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
534 nm
= (brack
? brack
+ 1 : colon
+ 1);
543 /* VMS pre V4.4,convert '-'s in filenames. */
544 if (lbrack
== rbrack
)
546 if (dots
< 2) /* this is to allow negative version numbers */
551 if (lbrack
> rbrack
&&
552 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
553 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
559 /* count open brackets, reset close bracket pointer */
560 if (p
[0] == '[' || p
[0] == '<')
562 /* count close brackets, set close bracket pointer */
563 if (p
[0] == ']' || p
[0] == '>')
565 /* detect ][ or >< */
566 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
568 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
569 nm
= p
+ 1, lose
= 1;
570 if (p
[0] == ':' && (colon
|| slash
))
571 /* if dev1:[dir]dev2:, move nm to dev2: */
577 /* if /pathname/dev:, move nm to dev: */
580 /* if node::dev:, move colon following dev */
581 else if (colon
&& colon
[-1] == ':')
583 /* if dev1:dev2:, move nm to dev2: */
584 else if (colon
&& colon
[-1] != ':')
589 if (p
[0] == ':' && !colon
)
595 if (lbrack
== rbrack
)
598 else if (p
[0] == '.')
607 return build_string (sys_translate_unix (nm
));
609 if (nm
== XSTRING (name
)->data
)
611 return build_string (nm
);
615 /* Now determine directory to start with and put it in newdir */
619 if (nm
[0] == '~') /* prefix ~ */
624 || nm
[1] == 0)/* ~ by itself */
626 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
627 newdir
= (unsigned char *) "";
630 nm
++; /* Don't leave the slash in nm. */
633 else /* ~user/filename */
635 for (p
= nm
; *p
&& (*p
!= '/'
640 o
= (unsigned char *) alloca (p
- nm
+ 1);
641 bcopy ((char *) nm
, o
, p
- nm
);
644 pw
= (struct passwd
*) getpwnam (o
+ 1);
647 newdir
= (unsigned char *) pw
-> pw_dir
;
649 nm
= p
+ 1; /* skip the terminator */
655 /* If we don't find a user of that name, leave the name
656 unchanged; don't move nm forward to p. */
666 defalt
= current_buffer
->directory
;
667 CHECK_STRING (defalt
, 1);
668 newdir
= XSTRING (defalt
)->data
;
673 /* Get rid of any slash at the end of newdir. */
674 int length
= strlen (newdir
);
675 if (newdir
[length
- 1] == '/')
677 unsigned char *temp
= (unsigned char *) alloca (length
);
678 bcopy (newdir
, temp
, length
- 1);
679 temp
[length
- 1] = 0;
687 /* Now concatenate the directory and name to new space in the stack frame */
688 tlen
+= strlen (nm
) + 1;
689 target
= (unsigned char *) alloca (tlen
);
695 if (nm
[0] == 0 || nm
[0] == '/')
696 strcpy (target
, newdir
);
699 file_name_as_directory (target
, newdir
);
704 if (index (target
, '/'))
705 strcpy (target
, sys_translate_unix (target
));
708 /* Now canonicalize by removing /. and /foo/.. if they appear */
716 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
722 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
723 /* brackets are offset from each other by 2 */
726 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
727 /* convert [foo][bar] to [bar] */
728 while (o
[-1] != '[' && o
[-1] != '<')
730 else if (*p
== '-' && *o
!= '.')
733 else if (p
[0] == '-' && o
[-1] == '.' &&
734 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
735 /* flush .foo.- ; leave - if stopped by '[' or '<' */
739 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
740 if (p
[1] == '.') /* foo.-.bar ==> bar*/
742 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
744 /* else [foo.-] ==> [-] */
750 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
751 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
761 else if (!strncmp (p
, "//", 2)
763 /* // at start of filename is meaningful in Apollo system */
771 else if (p
[0] == '/' && p
[1] == '.' &&
772 (p
[2] == '/' || p
[2] == 0))
774 else if (!strncmp (p
, "/..", 3)
775 /* `/../' is the "superroot" on certain file systems. */
777 && (p
[3] == '/' || p
[3] == 0))
779 while (o
!= target
&& *--o
!= '/')
782 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
786 if (o
== target
&& *o
== '/')
797 return make_string (target
, o
- target
);
800 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
801 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
802 "Convert FILENAME to absolute, and canonicalize it.\n\
803 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
804 (does not start with slash); if DEFAULT is nil or missing,\n\
805 the current buffer's value of default-directory is used.\n\
806 Filenames containing `.' or `..' as components are simplified;\n\
807 initial `~/' expands to your home directory.\n\
808 See also the function `substitute-in-file-name'.")
810 Lisp_Object name, defalt;
814 register unsigned char *newdir, *p, *o;
816 unsigned char *target;
820 unsigned char * colon = 0;
821 unsigned char * close = 0;
822 unsigned char * slash = 0;
823 unsigned char * brack = 0;
824 int lbrack = 0, rbrack = 0;
828 CHECK_STRING (name
, 0);
831 /* Filenames on VMS are always upper case. */
832 name
= Fupcase (name
);
835 nm
= XSTRING (name
)->data
;
837 /* If nm is absolute, flush ...// and detect /./ and /../.
838 If no /./ or /../ we can return right away. */
850 if (p
[0] == '/' && p
[1] == '/'
852 /* // at start of filename is meaningful on Apollo system */
857 if (p
[0] == '/' && p
[1] == '~')
858 nm
= p
+ 1, lose
= 1;
859 if (p
[0] == '/' && p
[1] == '.'
860 && (p
[2] == '/' || p
[2] == 0
861 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
867 /* if dev:[dir]/, move nm to / */
868 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
869 nm
= (brack
? brack
+ 1 : colon
+ 1);
878 /* VMS pre V4.4,convert '-'s in filenames. */
879 if (lbrack
== rbrack
)
881 if (dots
< 2) /* this is to allow negative version numbers */
886 if (lbrack
> rbrack
&&
887 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
888 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
894 /* count open brackets, reset close bracket pointer */
895 if (p
[0] == '[' || p
[0] == '<')
897 /* count close brackets, set close bracket pointer */
898 if (p
[0] == ']' || p
[0] == '>')
900 /* detect ][ or >< */
901 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
903 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
904 nm
= p
+ 1, lose
= 1;
905 if (p
[0] == ':' && (colon
|| slash
))
906 /* if dev1:[dir]dev2:, move nm to dev2: */
912 /* if /pathname/dev:, move nm to dev: */
915 /* if node::dev:, move colon following dev */
916 else if (colon
&& colon
[-1] == ':')
918 /* if dev1:dev2:, move nm to dev2: */
919 else if (colon
&& colon
[-1] != ':')
924 if (p
[0] == ':' && !colon
)
930 if (lbrack
== rbrack
)
933 else if (p
[0] == '.')
942 return build_string (sys_translate_unix (nm
));
944 if (nm
== XSTRING (name
)->data
)
946 return build_string (nm
);
950 /* Now determine directory to start with and put it in NEWDIR */
954 if (nm
[0] == '~') /* prefix ~ */
959 || nm
[1] == 0)/* ~/filename */
961 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
962 newdir
= (unsigned char *) "";
965 nm
++; /* Don't leave the slash in nm. */
968 else /* ~user/filename */
970 /* Get past ~ to user */
971 unsigned char *user
= nm
+ 1;
972 /* Find end of name. */
973 unsigned char *ptr
= (unsigned char *) index (user
, '/');
974 int len
= ptr
? ptr
- user
: strlen (user
);
976 unsigned char *ptr1
= index (user
, ':');
977 if (ptr1
!= 0 && ptr1
- user
< len
)
980 /* Copy the user name into temp storage. */
981 o
= (unsigned char *) alloca (len
+ 1);
982 bcopy ((char *) user
, o
, len
);
985 /* Look up the user name. */
986 pw
= (struct passwd
*) getpwnam (o
+ 1);
988 error ("\"%s\" isn't a registered user", o
+ 1);
990 newdir
= (unsigned char *) pw
->pw_dir
;
992 /* Discard the user name from NM. */
1003 defalt
= current_buffer
->directory
;
1004 CHECK_STRING (defalt
, 1);
1005 newdir
= XSTRING (defalt
)->data
;
1008 /* Now concatenate the directory and name to new space in the stack frame */
1010 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1011 target
= (unsigned char *) alloca (tlen
);
1017 if (nm
[0] == 0 || nm
[0] == '/')
1018 strcpy (target
, newdir
);
1021 file_name_as_directory (target
, newdir
);
1024 strcat (target
, nm
);
1026 if (index (target
, '/'))
1027 strcpy (target
, sys_translate_unix (target
));
1030 /* Now canonicalize by removing /. and /foo/.. if they appear */
1038 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1044 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1045 /* brackets are offset from each other by 2 */
1048 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1049 /* convert [foo][bar] to [bar] */
1050 while (o
[-1] != '[' && o
[-1] != '<')
1052 else if (*p
== '-' && *o
!= '.')
1055 else if (p
[0] == '-' && o
[-1] == '.' &&
1056 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1057 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1061 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1062 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1064 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1066 /* else [foo.-] ==> [-] */
1072 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1073 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1083 else if (!strncmp (p
, "//", 2)
1085 /* // at start of filename is meaningful in Apollo system */
1093 else if (p
[0] == '/' && p
[1] == '.' &&
1094 (p
[2] == '/' || p
[2] == 0))
1096 else if (!strncmp (p
, "/..", 3)
1097 /* `/../' is the "superroot" on certain file systems. */
1099 && (p
[3] == '/' || p
[3] == 0))
1101 while (o
!= target
&& *--o
!= '/')
1104 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1108 if (o
== target
&& *o
== '/')
1116 #endif /* not VMS */
1119 return make_string (target
, o
- target
);
1123 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1124 Ssubstitute_in_file_name
, 1, 1, 0,
1125 "Substitute environment variables referred to in FILENAME.\n\
1126 `$FOO' where FOO is an environment variable name means to substitute\n\
1127 the value of that variable. The variable name should be terminated\n\
1128 with a character not a letter, digit or underscore; otherwise, enclose\n\
1129 the entire variable name in braces.\n\
1130 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1131 On VMS, `$' substitution is not done; this function does little and only\n\
1132 duplicates what `expand-file-name' does.")
1138 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1139 unsigned char *target
;
1141 int substituted
= 0;
1144 CHECK_STRING (string
, 0);
1146 nm
= XSTRING (string
)->data
;
1147 endp
= nm
+ XSTRING (string
)->size
;
1149 /* If /~ or // appears, discard everything through first slash. */
1151 for (p
= nm
; p
!= endp
; p
++)
1155 /* // at start of file name is meaningful in Apollo system */
1156 (p
[0] == '/' && p
- 1 != nm
)
1157 #else /* not APOLLO */
1159 #endif /* not APOLLO */
1163 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1176 return build_string (nm
);
1179 /* See if any variables are substituted into the string
1180 and find the total length of their values in `total' */
1182 for (p
= nm
; p
!= endp
;)
1192 /* "$$" means a single "$" */
1201 while (p
!= endp
&& *p
!= '}') p
++;
1202 if (*p
!= '}') goto missingclose
;
1208 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1212 /* Copy out the variable name */
1213 target
= (unsigned char *) alloca (s
- o
+ 1);
1214 strncpy (target
, o
, s
- o
);
1217 /* Get variable value */
1218 o
= (unsigned char *) egetenv (target
);
1219 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1222 if (!o
&& !strcmp (target
, "USER"))
1223 o
= egetenv ("LOGNAME");
1226 if (!o
) goto badvar
;
1227 total
+= strlen (o
);
1234 /* If substitution required, recopy the string and do it */
1235 /* Make space in stack frame for the new copy */
1236 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1239 /* Copy the rest of the name through, replacing $ constructs with values */
1256 while (p
!= endp
&& *p
!= '}') p
++;
1257 if (*p
!= '}') goto missingclose
;
1263 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1267 /* Copy out the variable name */
1268 target
= (unsigned char *) alloca (s
- o
+ 1);
1269 strncpy (target
, o
, s
- o
);
1272 /* Get variable value */
1273 o
= (unsigned char *) egetenv (target
);
1274 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1277 if (!o
&& !strcmp (target
, "USER"))
1278 o
= egetenv ("LOGNAME");
1290 /* If /~ or // appears, discard everything through first slash. */
1292 for (p
= xnm
; p
!= x
; p
++)
1295 /* // at start of file name is meaningful in Apollo system */
1296 (p
[0] == '/' && p
- 1 != xnm
)
1297 #else /* not APOLLO */
1299 #endif /* not APOLLO */
1301 && p
!= nm
&& p
[-1] == '/')
1304 return make_string (xnm
, x
- xnm
);
1307 error ("Bad format environment-variable substitution");
1309 error ("Missing \"}\" in environment-variable substitution");
1311 error ("Substituting nonexistent environment variable \"%s\"", target
);
1314 #endif /* not VMS */
1318 expand_and_dir_to_file (filename
, defdir
)
1319 Lisp_Object filename
, defdir
;
1321 register Lisp_Object abspath
;
1323 abspath
= Fexpand_file_name (filename
, defdir
);
1326 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1327 if (c
== ':' || c
== ']' || c
== '>')
1328 abspath
= Fdirectory_file_name (abspath
);
1331 /* Remove final slash, if any (unless path is root).
1332 stat behaves differently depending! */
1333 if (XSTRING (abspath
)->size
> 1
1334 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1336 if (EQ (abspath
, filename
))
1337 abspath
= Fcopy_sequence (abspath
);
1338 XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] = 0;
1344 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1345 Lisp_Object absname
;
1346 unsigned char *querystring
;
1349 register Lisp_Object tem
;
1350 struct gcpro gcpro1
;
1352 if (access (XSTRING (absname
)->data
, 4) >= 0)
1355 Fsignal (Qfile_already_exists
,
1356 Fcons (build_string ("File already exists"),
1357 Fcons (absname
, Qnil
)));
1359 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1360 XSTRING (absname
)->data
, querystring
));
1363 Fsignal (Qfile_already_exists
,
1364 Fcons (build_string ("File already exists"),
1365 Fcons (absname
, Qnil
)));
1370 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1371 "fCopy file: \nFCopy %s to file: \np\nP",
1372 "Copy FILE to NEWNAME. Both args must be strings.\n\
1373 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1374 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1375 A number as third arg means request confirmation if NEWNAME already exists.\n\
1376 This is what happens in interactive use with M-x.\n\
1377 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1378 last-modified time as the old one. (This works on only some systems.)\n\
1379 A prefix arg makes KEEP-TIME non-nil.")
1380 (filename
, newname
, ok_if_already_exists
, keep_date
)
1381 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1384 char buf
[16 * 1024];
1386 struct gcpro gcpro1
, gcpro2
;
1387 int count
= specpdl_ptr
- specpdl
;
1389 GCPRO2 (filename
, newname
);
1390 CHECK_STRING (filename
, 0);
1391 CHECK_STRING (newname
, 1);
1392 filename
= Fexpand_file_name (filename
, Qnil
);
1393 newname
= Fexpand_file_name (newname
, Qnil
);
1394 if (NILP (ok_if_already_exists
)
1395 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1396 barf_or_query_if_file_exists (newname
, "copy to it",
1397 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1399 ifd
= open (XSTRING (filename
)->data
, 0);
1401 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1403 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1406 /* Create the copy file with the same record format as the input file */
1407 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1409 ofd
= creat (XSTRING (newname
)->data
, 0666);
1412 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1414 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1418 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1419 if (write (ofd
, buf
, n
) != n
)
1420 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1423 if (fstat (ifd
, &st
) >= 0)
1425 if (!NILP (keep_date
))
1427 EMACS_TIME atime
, mtime
;
1428 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1429 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1430 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1433 if (!egetenv ("USE_DOMAIN_ACLS"))
1435 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1438 /* Discard the unwind protects. */
1439 specpdl_ptr
= specpdl
+ count
;
1442 if (close (ofd
) < 0)
1443 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1449 DEFUN ("make-directory", Fmake_directory
, Smake_directory
, 1, 1, "FMake directory: ",
1450 "Create a directory. One argument, a file name string.")
1452 Lisp_Object dirname
;
1456 CHECK_STRING (dirname
, 0);
1457 dirname
= Fexpand_file_name (dirname
, Qnil
);
1458 dir
= XSTRING (dirname
)->data
;
1460 if (mkdir (dir
, 0777) != 0)
1461 report_file_error ("Creating directory", Flist (1, &dirname
));
1466 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1467 "Delete a directory. One argument, a file name string.")
1469 Lisp_Object dirname
;
1473 CHECK_STRING (dirname
, 0);
1474 dirname
= Fexpand_file_name (dirname
, Qnil
);
1475 dir
= XSTRING (dirname
)->data
;
1477 if (rmdir (dir
) != 0)
1478 report_file_error ("Removing directory", Flist (1, &dirname
));
1483 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1484 "Delete specified file. One argument, a file name string.\n\
1485 If file has multiple names, it continues to exist with the other names.")
1487 Lisp_Object filename
;
1489 CHECK_STRING (filename
, 0);
1490 filename
= Fexpand_file_name (filename
, Qnil
);
1491 if (0 > unlink (XSTRING (filename
)->data
))
1492 report_file_error ("Removing old name", Flist (1, &filename
));
1496 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1497 "fRename file: \nFRename %s to file: \np",
1498 "Rename FILE as NEWNAME. Both args strings.\n\
1499 If file has names other than FILE, it continues to have those names.\n\
1500 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1501 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1502 A number as third arg means request confirmation if NEWNAME already exists.\n\
1503 This is what happens in interactive use with M-x.")
1504 (filename
, newname
, ok_if_already_exists
)
1505 Lisp_Object filename
, newname
, ok_if_already_exists
;
1508 Lisp_Object args
[2];
1510 struct gcpro gcpro1
, gcpro2
;
1512 GCPRO2 (filename
, newname
);
1513 CHECK_STRING (filename
, 0);
1514 CHECK_STRING (newname
, 1);
1515 filename
= Fexpand_file_name (filename
, Qnil
);
1516 newname
= Fexpand_file_name (newname
, Qnil
);
1517 if (NILP (ok_if_already_exists
)
1518 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1519 barf_or_query_if_file_exists (newname
, "rename to it",
1520 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1522 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1524 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1525 || 0 > unlink (XSTRING (filename
)->data
))
1530 Fcopy_file (filename
, newname
, ok_if_already_exists
, Qt
);
1531 Fdelete_file (filename
);
1538 report_file_error ("Renaming", Flist (2, args
));
1541 report_file_error ("Renaming", Flist (2, &filename
));
1548 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1549 "fAdd name to file: \nFName to add to %s: \np",
1550 "Give FILE additional name NEWNAME. Both args strings.\n\
1551 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1552 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1553 A number as third arg means request confirmation if NEWNAME already exists.\n\
1554 This is what happens in interactive use with M-x.")
1555 (filename
, newname
, ok_if_already_exists
)
1556 Lisp_Object filename
, newname
, ok_if_already_exists
;
1559 Lisp_Object args
[2];
1561 struct gcpro gcpro1
, gcpro2
;
1563 GCPRO2 (filename
, newname
);
1564 CHECK_STRING (filename
, 0);
1565 CHECK_STRING (newname
, 1);
1566 filename
= Fexpand_file_name (filename
, Qnil
);
1567 newname
= Fexpand_file_name (newname
, Qnil
);
1568 if (NILP (ok_if_already_exists
)
1569 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1570 barf_or_query_if_file_exists (newname
, "make it a new name",
1571 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1572 unlink (XSTRING (newname
)->data
);
1573 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1578 report_file_error ("Adding new name", Flist (2, args
));
1580 report_file_error ("Adding new name", Flist (2, &filename
));
1589 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1590 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1591 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1592 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1593 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1594 A number as third arg means request confirmation if NEWNAME already exists.\n\
1595 This happens for interactive use with M-x.")
1596 (filename
, linkname
, ok_if_already_exists
)
1597 Lisp_Object filename
, linkname
, ok_if_already_exists
;
1600 Lisp_Object args
[2];
1602 struct gcpro gcpro1
, gcpro2
;
1604 GCPRO2 (filename
, linkname
);
1605 CHECK_STRING (filename
, 0);
1606 CHECK_STRING (linkname
, 1);
1607 #if 0 /* This made it impossible to make a link to a relative name. */
1608 filename
= Fexpand_file_name (filename
, Qnil
);
1610 linkname
= Fexpand_file_name (linkname
, Qnil
);
1611 if (NILP (ok_if_already_exists
)
1612 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1613 barf_or_query_if_file_exists (linkname
, "make it a link",
1614 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1615 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1617 /* If we didn't complain already, silently delete existing file. */
1618 if (errno
== EEXIST
)
1620 unlink (XSTRING (filename
)->data
);
1621 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1628 report_file_error ("Making symbolic link", Flist (2, args
));
1630 report_file_error ("Making symbolic link", Flist (2, &filename
));
1636 #endif /* S_IFLNK */
1640 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
1641 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1642 "Define the job-wide logical name NAME to have the value STRING.\n\
1643 If STRING is nil or a null string, the logical name NAME is deleted.")
1645 Lisp_Object varname
;
1648 CHECK_STRING (varname
, 0);
1650 delete_logical_name (XSTRING (varname
)->data
);
1653 CHECK_STRING (string
, 1);
1655 if (XSTRING (string
)->size
== 0)
1656 delete_logical_name (XSTRING (varname
)->data
);
1658 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
1667 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
1668 "Open a network connection to PATH using LOGIN as the login string.")
1670 Lisp_Object path
, login
;
1674 CHECK_STRING (path
, 0);
1675 CHECK_STRING (login
, 0);
1677 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
1679 if (netresult
== -1)
1684 #endif /* HPUX_NET */
1686 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
1688 "Return t if file FILENAME specifies an absolute path name.\n\
1689 On Unix, this is a name starting with a `/' or a `~'.")
1691 Lisp_Object filename
;
1695 CHECK_STRING (filename
, 0);
1696 ptr
= XSTRING (filename
)->data
;
1697 if (*ptr
== '/' || *ptr
== '~'
1699 /* ??? This criterion is probably wrong for '<'. */
1700 || index (ptr
, ':') || index (ptr
, '<')
1701 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
1710 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
1711 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1712 See also `file-readable-p' and `file-attributes'.")
1714 Lisp_Object filename
;
1716 Lisp_Object abspath
;
1718 CHECK_STRING (filename
, 0);
1719 abspath
= Fexpand_file_name (filename
, Qnil
);
1720 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
1723 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
1724 "Return t if FILENAME can be executed by you.\n\
1725 For directories this means you can change to that directory.")
1727 Lisp_Object filename
;
1730 Lisp_Object abspath
;
1732 CHECK_STRING (filename
, 0);
1733 abspath
= Fexpand_file_name (filename
, Qnil
);
1734 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
1737 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
1738 "Return t if file FILENAME exists and you can read it.\n\
1739 See also `file-exists-p' and `file-attributes'.")
1741 Lisp_Object filename
;
1743 Lisp_Object abspath
;
1745 CHECK_STRING (filename
, 0);
1746 abspath
= Fexpand_file_name (filename
, Qnil
);
1747 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
1750 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
1751 "If file FILENAME is the name of a symbolic link\n\
1752 returns the name of the file to which it is linked.\n\
1753 Otherwise returns NIL.")
1755 Lisp_Object filename
;
1763 CHECK_STRING (filename
, 0);
1764 filename
= Fexpand_file_name (filename
, Qnil
);
1769 buf
= (char *) xmalloc (bufsize
);
1770 bzero (buf
, bufsize
);
1771 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
1772 if (valsize
< bufsize
) break;
1773 /* Buffer was not long enough */
1782 val
= make_string (buf
, valsize
);
1785 #else /* not S_IFLNK */
1787 #endif /* not S_IFLNK */
1790 /* Having this before file-symlink-p mysteriously caused it to be forgotten
1792 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
1793 "Return t if file FILENAME can be written or created by you.")
1795 Lisp_Object filename
;
1797 Lisp_Object abspath
, dir
;
1799 CHECK_STRING (filename
, 0);
1800 abspath
= Fexpand_file_name (filename
, Qnil
);
1801 if (access (XSTRING (abspath
)->data
, 0) >= 0)
1802 return (access (XSTRING (abspath
)->data
, 2) >= 0) ? Qt
: Qnil
;
1803 dir
= Ffile_name_directory (abspath
);
1806 dir
= Fdirectory_file_name (dir
);
1808 return (access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
1812 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
1813 "Return t if file FILENAME is the name of a directory as a file.\n\
1814 A directory name spec may be given instead; then the value is t\n\
1815 if the directory so specified exists and really is a directory.")
1817 Lisp_Object filename
;
1819 register Lisp_Object abspath
;
1822 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
1824 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1826 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
1829 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
1830 "Return t if file FILENAME is the name of a directory as a file,\n\
1831 and files in that directory can be opened by you. In order to use a\n\
1832 directory as a buffer's current directory, this predicate must return true.\n\
1833 A directory name spec may be given instead; then the value is t\n\
1834 if the directory so specified exists and really is a readable and\n\
1835 searchable directory.")
1837 Lisp_Object filename
;
1839 if (NILP (Ffile_directory_p (filename
))
1840 || NILP (Ffile_executable_p (filename
)))
1846 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
1847 "Return mode bits of FILE, as an integer.")
1849 Lisp_Object filename
;
1851 Lisp_Object abspath
;
1854 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
1856 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1858 return make_number (st
.st_mode
& 07777);
1861 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
1862 "Set mode bits of FILE to MODE (an integer).\n\
1863 Only the 12 low bits of MODE are used.")
1865 Lisp_Object filename
, mode
;
1867 Lisp_Object abspath
;
1869 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
1870 CHECK_NUMBER (mode
, 1);
1873 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
1874 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
1876 if (!egetenv ("USE_DOMAIN_ACLS"))
1879 struct timeval tvp
[2];
1881 /* chmod on apollo also change the file's modtime; need to save the
1882 modtime and then restore it. */
1883 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1885 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
1889 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
1890 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
1892 /* reset the old accessed and modified times. */
1893 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
1895 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
1898 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
1899 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
1906 DEFUN ("set-umask", Fset_umask
, Sset_umask
, 1, 1, 0,
1907 "Select which permission bits to disable in newly created files.\n\
1908 MASK should be an integer; if a permission's bit in MASK is 1,\n\
1909 subsequently created files will not have that permission enabled.\n\
1910 Only the low 9 bits are used.\n\
1911 This setting is inherited by subprocesses.")
1915 CHECK_NUMBER (mask
, 0);
1917 umask (XINT (mask
) & 0777);
1922 DEFUN ("umask", Fumask
, Sumask
, 0, 0, 0,
1923 "Return the current umask value.\n\
1924 The umask value determines which permissions are enabled in newly\n\
1925 created files. If a permission's bit in the umask is 1, subsequently\n\
1926 created files will not have that permission enabled.")
1931 XSET (mask
, Lisp_Int
, umask (0));
1932 umask (XINT (mask
));
1939 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
1940 "Tell Unix to finish all pending disk updates.")
1949 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
1950 "Return t if file FILE1 is newer than file FILE2.\n\
1951 If FILE1 does not exist, the answer is nil;\n\
1952 otherwise, if FILE2 does not exist, the answer is t.")
1954 Lisp_Object file1
, file2
;
1956 Lisp_Object abspath
;
1960 CHECK_STRING (file1
, 0);
1961 CHECK_STRING (file2
, 0);
1963 abspath
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
1965 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1968 mtime1
= st
.st_mtime
;
1970 abspath
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
1972 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1975 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
1978 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
1980 "Insert contents of file FILENAME after point.\n\
1981 Returns list of absolute pathname and length of data inserted.\n\
1982 If second argument VISIT is non-nil, the buffer's visited filename\n\
1983 and last save file modtime are set, and it is marked unmodified.\n\
1984 If visiting and the file does not exist, visiting is completed\n\
1985 before the error is signaled.")
1987 Lisp_Object filename
, visit
;
1991 register int inserted
= 0;
1992 register int how_much
;
1993 int count
= specpdl_ptr
- specpdl
;
1994 struct gcpro gcpro1
;
1997 if (!NILP (current_buffer
->read_only
))
1998 Fbarf_if_buffer_read_only();
2000 CHECK_STRING (filename
, 0);
2001 filename
= Fexpand_file_name (filename
, Qnil
);
2006 if (stat (XSTRING (filename
)->data
, &st
) < 0
2007 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2009 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2010 || fstat (fd
, &st
) < 0)
2011 #endif /* not APOLLO */
2013 if (fd
>= 0) close (fd
);
2015 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2021 record_unwind_protect (close_file_unwind
, make_number (fd
));
2024 /* This code will need to be changed in order to work on named
2025 pipes, and it's probably just not worth it. So we should at
2026 least signal an error. */
2027 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2028 Fsignal (Qfile_error
,
2029 Fcons (build_string ("reading from named pipe"),
2030 Fcons (filename
, Qnil
)));
2033 /* Supposedly happens on VMS. */
2035 error ("File size is negative");
2038 register Lisp_Object temp
;
2040 /* Make sure point-max won't overflow after this insertion. */
2041 XSET (temp
, Lisp_Int
, st
.st_size
+ Z
);
2042 if (st
.st_size
+ Z
!= XINT (temp
))
2043 error ("maximum buffer size exceeded");
2047 prepare_to_modify_buffer (point
, point
);
2050 if (GAP_SIZE
< st
.st_size
)
2051 make_gap (st
.st_size
- GAP_SIZE
);
2055 int try = min (st
.st_size
- inserted
, 64 << 10);
2058 /* Allow quitting out of the actual I/O. */
2061 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2079 record_insert (point
, inserted
);
2083 /* Discard the unwind protect */
2084 specpdl_ptr
= specpdl
+ count
;
2087 error ("IO error reading %s: %s",
2088 XSTRING (filename
)->data
, err_str (errno
));
2094 current_buffer
->undo_list
= Qnil
;
2096 stat (XSTRING (filename
)->data
, &st
);
2098 current_buffer
->modtime
= st
.st_mtime
;
2099 current_buffer
->save_modified
= MODIFF
;
2100 current_buffer
->auto_save_modified
= MODIFF
;
2101 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2102 #ifdef CLASH_DETECTION
2103 if (!NILP (current_buffer
->filename
))
2104 unlock_file (current_buffer
->filename
);
2105 unlock_file (filename
);
2106 #endif /* CLASH_DETECTION */
2107 current_buffer
->filename
= filename
;
2108 /* If visiting nonexistent file, return nil. */
2109 if (st
.st_mtime
== -1)
2110 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2113 signal_after_change (point
, 0, inserted
);
2115 RETURN_UNGCPRO (Fcons (filename
,
2116 Fcons (make_number (inserted
),
2120 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2121 "r\nFWrite region to file: ",
2122 "Write current region into specified file.\n\
2123 When called from a program, takes three arguments:\n\
2124 START, END and FILENAME. START and END are buffer positions.\n\
2125 Optional fourth argument APPEND if non-nil means\n\
2126 append to existing file contents (if any).\n\
2127 Optional fifth argument VISIT if t means\n\
2128 set the last-save-file-modtime of buffer to this file's modtime\n\
2129 and mark buffer not modified.\n\
2130 If VISIT is neither t nor nil, it means do not print\n\
2131 the \"Wrote file\" message.\n\
2132 Kludgy feature: if START is a string, then that string is written\n\
2133 to the file, instead of any buffer contents, and END is ignored.")
2134 (start
, end
, filename
, append
, visit
)
2135 Lisp_Object start
, end
, filename
, append
, visit
;
2143 int count
= specpdl_ptr
- specpdl
;
2145 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2148 /* Special kludge to simplify auto-saving */
2151 XFASTINT (start
) = BEG
;
2154 else if (XTYPE (start
) != Lisp_String
)
2155 validate_region (&start
, &end
);
2157 filename
= Fexpand_file_name (filename
, Qnil
);
2158 fn
= XSTRING (filename
)->data
;
2160 #ifdef CLASH_DETECTION
2162 lock_file (filename
);
2163 #endif /* CLASH_DETECTION */
2167 desc
= open (fn
, O_WRONLY
);
2171 if (auto_saving
) /* Overwrite any previous version of autosave file */
2173 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2174 desc
= open (fn
, O_RDWR
);
2176 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2177 ? XSTRING (current_buffer
->filename
)->data
: 0,
2180 else /* Write to temporary name and rename if no errors */
2182 Lisp_Object temp_name
;
2183 temp_name
= Ffile_name_directory (filename
);
2185 if (!NILP (temp_name
))
2187 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2188 build_string ("$$SAVE$$")));
2189 fname
= XSTRING (filename
)->data
;
2190 fn
= XSTRING (temp_name
)->data
;
2191 desc
= creat_copy_attrs (fname
, fn
);
2194 /* If we can't open the temporary file, try creating a new
2195 version of the original file. VMS "creat" creates a
2196 new version rather than truncating an existing file. */
2199 desc
= creat (fn
, 0666);
2200 #if 0 /* This can clobber an existing file and fail to replace it,
2201 if the user runs out of space. */
2204 /* We can't make a new version;
2205 try to truncate and rewrite existing version if any. */
2207 desc
= open (fn
, O_RDWR
);
2213 desc
= creat (fn
, 0666);
2216 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2217 #endif /* not VMS */
2221 #ifdef CLASH_DETECTION
2223 if (!auto_saving
) unlock_file (filename
);
2225 #endif /* CLASH_DETECTION */
2226 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2229 record_unwind_protect (close_file_unwind
, make_number (desc
));
2232 if (lseek (desc
, 0, 2) < 0)
2234 #ifdef CLASH_DETECTION
2235 if (!auto_saving
) unlock_file (filename
);
2236 #endif /* CLASH_DETECTION */
2237 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2242 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2243 * if we do writes that don't end with a carriage return. Furthermore
2244 * it cannot handle writes of more then 16K. The modified
2245 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2246 * this EXCEPT for the last record (iff it doesn't end with a carriage
2247 * return). This implies that if your buffer doesn't end with a carriage
2248 * return, you get one free... tough. However it also means that if
2249 * we make two calls to sys_write (a la the following code) you can
2250 * get one at the gap as well. The easiest way to fix this (honest)
2251 * is to move the gap to the next newline (or the end of the buffer).
2256 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2257 move_gap (find_next_newline (GPT
, 1));
2263 if (XTYPE (start
) == Lisp_String
)
2265 failure
= 0 > e_write (desc
, XSTRING (start
)->data
,
2266 XSTRING (start
)->size
);
2269 else if (XINT (start
) != XINT (end
))
2271 if (XINT (start
) < GPT
)
2273 register int end1
= XINT (end
);
2275 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
),
2276 min (GPT
, end1
) - tem
);
2280 if (XINT (end
) > GPT
&& !failure
)
2283 tem
= max (tem
, GPT
);
2284 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
);
2294 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2295 Disk full in NFS may be reported here. */
2296 if (fsync (desc
) < 0)
2297 failure
= 1, save_errno
= errno
;
2302 /* Spurious "file has changed on disk" warnings have been
2303 observed on Suns as well.
2304 It seems that `close' can change the modtime, under nfs.
2306 (This has supposedly been fixed in Sunos 4,
2307 but who knows about all the other machines with NFS?) */
2310 /* On VMS and APOLLO, must do the stat after the close
2311 since closing changes the modtime. */
2314 /* Recall that #if defined does not work on VMS. */
2321 /* NFS can report a write failure now. */
2322 if (close (desc
) < 0)
2323 failure
= 1, save_errno
= errno
;
2326 /* If we wrote to a temporary name and had no errors, rename to real name. */
2330 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2338 /* Discard the unwind protect */
2339 specpdl_ptr
= specpdl
+ count
;
2341 #ifdef CLASH_DETECTION
2343 unlock_file (filename
);
2344 #endif /* CLASH_DETECTION */
2346 /* Do this before reporting IO error
2347 to avoid a "file has changed on disk" warning on
2348 next attempt to save. */
2350 current_buffer
->modtime
= st
.st_mtime
;
2353 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2357 current_buffer
->save_modified
= MODIFF
;
2358 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2359 current_buffer
->filename
= filename
;
2361 else if (!NILP (visit
))
2365 message ("Wrote %s", fn
);
2371 e_write (desc
, addr
, len
)
2373 register char *addr
;
2376 char buf
[16 * 1024];
2377 register char *p
, *end
;
2379 if (!EQ (current_buffer
->selective_display
, Qt
))
2380 return write (desc
, addr
, len
) - len
;
2384 end
= p
+ sizeof buf
;
2389 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
2398 if (write (desc
, buf
, p
- buf
) != p
- buf
)
2404 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
2405 Sverify_visited_file_modtime
, 1, 1, 0,
2406 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2407 This means that the file has not been changed since it was visited or saved.")
2414 CHECK_BUFFER (buf
, 0);
2417 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
2418 if (b
->modtime
== 0) return Qt
;
2420 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
2422 /* If the file doesn't exist now and didn't exist before,
2423 we say that it isn't modified, provided the error is a tame one. */
2424 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
2429 if (st
.st_mtime
== b
->modtime
2430 /* If both are positive, accept them if they are off by one second. */
2431 || (st
.st_mtime
> 0 && b
->modtime
> 0
2432 && (st
.st_mtime
== b
->modtime
+ 1
2433 || st
.st_mtime
== b
->modtime
- 1)))
2438 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
2439 Sclear_visited_file_modtime
, 0, 0, 0,
2440 "Clear out records of last mod time of visited file.\n\
2441 Next attempt to save will certainly not complain of a discrepancy.")
2444 current_buffer
->modtime
= 0;
2448 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
2449 Sset_visited_file_modtime
, 0, 0, 0,
2450 "Update buffer's recorded modification time from the visited file's time.\n\
2451 Useful if the buffer was not read from the file normally\n\
2452 or if the file itself has been changed for some known benign reason.")
2455 register Lisp_Object filename
;
2458 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
2460 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
2461 current_buffer
->modtime
= st
.st_mtime
;
2469 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
2472 message ("Autosaving...error for %s", name
);
2473 Fsleep_for (make_number (1), Qnil
);
2474 message ("Autosaving...error!for %s", name
);
2475 Fsleep_for (make_number (1), Qnil
);
2476 message ("Autosaving...error for %s", name
);
2477 Fsleep_for (make_number (1), Qnil
);
2487 /* Get visited file's mode to become the auto save file's mode. */
2488 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
2489 /* But make sure we can overwrite it later! */
2490 auto_save_mode_bits
= st
.st_mode
| 0600;
2492 auto_save_mode_bits
= 0666;
2495 Fwrite_region (Qnil
, Qnil
,
2496 current_buffer
->auto_save_file_name
,
2500 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
2501 "Auto-save all buffers that need it.\n\
2502 This is all buffers that have auto-saving enabled\n\
2503 and are changed since last auto-saved.\n\
2504 Auto-saving writes the buffer into a file\n\
2505 so that your editing is not lost if the system crashes.\n\
2506 This file is not the file you visited; that changes only when you save.\n\n\
2507 Non-nil first argument means do not print any message if successful.\n\
2508 Non-nil second argument means save only current buffer.")
2512 struct buffer
*old
= current_buffer
, *b
;
2513 Lisp_Object tail
, buf
;
2515 char *omessage
= echo_area_glyphs
;
2516 extern minibuf_level
;
2518 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2519 point to non-strings reached from Vbuffer_alist. */
2525 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2526 eventually call do-auto-save, so don't err here in that case. */
2527 if (!NILP (Vrun_hooks
))
2528 call1 (Vrun_hooks
, intern ("auto-save-hook"));
2530 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2531 tail
= XCONS (tail
)->cdr
)
2533 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
2535 /* Check for auto save enabled
2536 and file changed since last auto save
2537 and file changed since last real save. */
2538 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
2539 && b
->save_modified
< BUF_MODIFF (b
)
2540 && b
->auto_save_modified
< BUF_MODIFF (b
))
2542 if ((XFASTINT (b
->save_length
) * 10
2543 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
2544 /* A short file is likely to change a large fraction;
2545 spare the user annoying messages. */
2546 && XFASTINT (b
->save_length
) > 5000
2547 /* These messages are frequent and annoying for `*mail*'. */
2548 && !EQ (b
->filename
, Qnil
))
2550 /* It has shrunk too much; turn off auto-saving here. */
2551 message ("Buffer %s has shrunk a lot; auto save turned off there",
2552 XSTRING (b
->name
)->data
);
2553 /* User can reenable saving with M-x auto-save. */
2554 b
->auto_save_file_name
= Qnil
;
2555 /* Prevent warning from repeating if user does so. */
2556 XFASTINT (b
->save_length
) = 0;
2557 Fsleep_for (make_number (1));
2560 set_buffer_internal (b
);
2561 if (!auto_saved
&& NILP (nomsg
))
2562 message1 ("Auto-saving...");
2563 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
2565 b
->auto_save_modified
= BUF_MODIFF (b
);
2566 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2567 set_buffer_internal (old
);
2572 record_auto_save ();
2574 if (auto_saved
&& NILP (nomsg
))
2575 message1 (omessage
? omessage
: "Auto-saving...done");
2581 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
2582 Sset_buffer_auto_saved
, 0, 0, 0,
2583 "Mark current buffer as auto-saved with its current text.\n\
2584 No auto-save file will be written until the buffer changes again.")
2587 current_buffer
->auto_save_modified
= MODIFF
;
2588 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2592 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
2594 "Return t if buffer has been auto-saved since last read in or saved.")
2597 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
2600 /* Reading and completing file names */
2601 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
2603 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
2605 "Internal subroutine for read-file-name. Do not call this.")
2606 (string
, dir
, action
)
2607 Lisp_Object string
, dir
, action
;
2608 /* action is nil for complete, t for return list of completions,
2609 lambda for verify final value */
2611 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
2613 if (XSTRING (string
)->size
== 0)
2618 if (EQ (action
, Qlambda
))
2623 orig_string
= string
;
2624 string
= Fsubstitute_in_file_name (string
);
2625 name
= Ffile_name_nondirectory (string
);
2626 realdir
= Ffile_name_directory (string
);
2630 realdir
= Fexpand_file_name (realdir
, dir
);
2635 specdir
= Ffile_name_directory (string
);
2636 val
= Ffile_name_completion (name
, realdir
);
2637 if (XTYPE (val
) != Lisp_String
)
2639 if (NILP (Fstring_equal (string
, orig_string
)))
2644 if (!NILP (specdir
))
2645 val
= concat2 (specdir
, val
);
2648 register unsigned char *old
, *new;
2652 osize
= XSTRING (val
)->size
;
2653 /* Quote "$" as "$$" to get it past substitute-in-file-name */
2654 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
2655 if (*old
++ == '$') count
++;
2658 old
= XSTRING (val
)->data
;
2659 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
2660 new = XSTRING (val
)->data
;
2661 for (n
= osize
; n
> 0; n
--)
2672 #endif /* Not VMS */
2676 if (EQ (action
, Qt
))
2677 return Ffile_name_all_completions (name
, realdir
);
2678 /* Only other case actually used is ACTION = lambda */
2680 /* Supposedly this helps commands such as `cd' that read directory names,
2681 but can someone explain how it helps them? -- RMS */
2682 if (XSTRING (name
)->size
== 0)
2685 return Ffile_exists_p (string
);
2688 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
2689 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
2690 Value is not expanded---you must call `expand-file-name' yourself.\n\
2691 Default name to DEFAULT if user enters a null string.\n\
2692 (If DEFAULT is omitted, the visited file name is used.)\n\
2693 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
2694 Non-nil and non-t means also require confirmation after completion.\n\
2695 Fifth arg INITIAL specifies text to start with.\n\
2696 DIR defaults to current buffer's directory default.")
2697 (prompt
, dir
, defalt
, mustmatch
, initial
)
2698 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
2700 Lisp_Object val
, insdef
, tem
, backup_n
;
2701 struct gcpro gcpro1
, gcpro2
;
2702 register char *homedir
;
2706 dir
= current_buffer
->directory
;
2708 defalt
= current_buffer
->filename
;
2710 /* If dir starts with user's homedir, change that to ~. */
2711 homedir
= (char *) egetenv ("HOME");
2713 && XTYPE (dir
) == Lisp_String
2714 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
2715 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
2717 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
2718 XSTRING (dir
)->size
- strlen (homedir
) + 1);
2719 XSTRING (dir
)->data
[0] = '~';
2722 if (insert_default_directory
)
2725 if (!NILP (initial
))
2727 Lisp_Object args
[2];
2731 insdef
= Fconcat (2, args
);
2732 backup_n
= make_number (- (XSTRING (initial
)->size
));
2739 insdef
= build_string ("");
2744 count
= specpdl_ptr
- specpdl
;
2745 specbind (intern ("completion-ignore-case"), Qt
);
2748 GCPRO2 (insdef
, defalt
);
2749 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
2751 insert_default_directory
? insdef
: Qnil
, backup_n
);
2754 unbind_to (count
, Qnil
);
2759 error ("No file name specified");
2760 tem
= Fstring_equal (val
, insdef
);
2761 if (!NILP (tem
) && !NILP (defalt
))
2763 return Fsubstitute_in_file_name (val
);
2766 #if 0 /* Old version */
2767 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
2768 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
2769 Value is not expanded---you must call `expand-file-name' yourself.\n\
2770 Default name to DEFAULT if user enters a null string.\n\
2771 (If DEFAULT is omitted, the visited file name is used.)\n\
2772 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
2773 Non-nil and non-t means also require confirmation after completion.\n\
2774 Fifth arg INITIAL specifies text to start with.\n\
2775 DIR defaults to current buffer's directory default.")
2776 (prompt
, dir
, defalt
, mustmatch
, initial
)
2777 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
2779 Lisp_Object val
, insdef
, tem
;
2780 struct gcpro gcpro1
, gcpro2
;
2781 register char *homedir
;
2785 dir
= current_buffer
->directory
;
2787 defalt
= current_buffer
->filename
;
2789 /* If dir starts with user's homedir, change that to ~. */
2790 homedir
= (char *) egetenv ("HOME");
2792 && XTYPE (dir
) == Lisp_String
2793 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
2794 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
2796 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
2797 XSTRING (dir
)->size
- strlen (homedir
) + 1);
2798 XSTRING (dir
)->data
[0] = '~';
2801 if (!NILP (initial
))
2803 else if (insert_default_directory
)
2806 insdef
= build_string ("");
2809 count
= specpdl_ptr
- specpdl
;
2810 specbind (intern ("completion-ignore-case"), Qt
);
2813 GCPRO2 (insdef
, defalt
);
2814 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
2816 insert_default_directory
? insdef
: Qnil
, Qnil
);
2819 unbind_to (count
, Qnil
);
2824 error ("No file name specified");
2825 tem
= Fstring_equal (val
, insdef
);
2826 if (!NILP (tem
) && !NILP (defalt
))
2828 return Fsubstitute_in_file_name (val
);
2830 #endif /* Old version */
2834 Qfile_error
= intern ("file-error");
2835 staticpro (&Qfile_error
);
2836 Qfile_already_exists
= intern("file-already-exists");
2837 staticpro (&Qfile_already_exists
);
2839 Fput (Qfile_error
, Qerror_conditions
,
2840 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
2841 Fput (Qfile_error
, Qerror_message
,
2842 build_string ("File error"));
2844 Fput (Qfile_already_exists
, Qerror_conditions
,
2845 Fcons (Qfile_already_exists
,
2846 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
2847 Fput (Qfile_already_exists
, Qerror_message
,
2848 build_string ("File already exists"));
2850 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
2851 "*Non-nil means when reading a filename start with default dir in minibuffer.");
2852 insert_default_directory
= 1;
2854 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
2855 "*Non-nil means write new files with record format `stmlf'.\n\
2856 nil means use format `var'. This variable is meaningful only on VMS.");
2857 vms_stmlf_recfm
= 0;
2859 defsubr (&Sfile_name_directory
);
2860 defsubr (&Sfile_name_nondirectory
);
2861 defsubr (&Sfile_name_as_directory
);
2862 defsubr (&Sdirectory_file_name
);
2863 defsubr (&Smake_temp_name
);
2864 defsubr (&Sexpand_file_name
);
2865 defsubr (&Ssubstitute_in_file_name
);
2866 defsubr (&Scopy_file
);
2867 defsubr (&Smake_directory
);
2868 defsubr (&Sdelete_directory
);
2869 defsubr (&Sdelete_file
);
2870 defsubr (&Srename_file
);
2871 defsubr (&Sadd_name_to_file
);
2873 defsubr (&Smake_symbolic_link
);
2874 #endif /* S_IFLNK */
2876 defsubr (&Sdefine_logical_name
);
2879 defsubr (&Ssysnetunam
);
2880 #endif /* HPUX_NET */
2881 defsubr (&Sfile_name_absolute_p
);
2882 defsubr (&Sfile_exists_p
);
2883 defsubr (&Sfile_executable_p
);
2884 defsubr (&Sfile_readable_p
);
2885 defsubr (&Sfile_writable_p
);
2886 defsubr (&Sfile_symlink_p
);
2887 defsubr (&Sfile_directory_p
);
2888 defsubr (&Sfile_accessible_directory_p
);
2889 defsubr (&Sfile_modes
);
2890 defsubr (&Sset_file_modes
);
2891 defsubr (&Sset_umask
);
2893 defsubr (&Sfile_newer_than_file_p
);
2894 defsubr (&Sinsert_file_contents
);
2895 defsubr (&Swrite_region
);
2896 defsubr (&Sverify_visited_file_modtime
);
2897 defsubr (&Sclear_visited_file_modtime
);
2898 defsubr (&Sset_visited_file_modtime
);
2899 defsubr (&Sdo_auto_save
);
2900 defsubr (&Sset_buffer_auto_saved
);
2901 defsubr (&Srecent_auto_save_p
);
2903 defsubr (&Sread_file_name_internal
);
2904 defsubr (&Sread_file_name
);
2906 defsubr (&Sunix_sync
);