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>
44 extern char *sys_errlist
[];
48 #define err_str(a) ((a) < sys_nerr ? sys_errlist[a] : "unknown error")
78 #define min(a, b) ((a) < (b) ? (a) : (b))
79 #define max(a, b) ((a) > (b) ? (a) : (b))
81 /* Nonzero during writing of auto-save files */
84 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
85 a new file with the same mode as the original */
86 int auto_save_mode_bits
;
88 /* Alist of elements (REGEXP . HANDLER) for file names
89 whose I/O is done with a special handler. */
90 Lisp_Object Vfile_name_handler_alist
;
92 /* Nonzero means, when reading a filename in the minibuffer,
93 start out by inserting the default directory into the minibuffer. */
94 int insert_default_directory
;
96 /* On VMS, nonzero means write new files with record format stmlf.
97 Zero means use var format. */
100 Lisp_Object Qfile_error
, Qfile_already_exists
;
102 Lisp_Object Qfile_name_history
;
104 report_file_error (string
, data
)
108 Lisp_Object errstring
;
110 if (errno
>= 0 && errno
< sys_nerr
)
111 errstring
= build_string (sys_errlist
[errno
]);
113 errstring
= build_string ("undocumented error code");
115 /* System error messages are capitalized. Downcase the initial
116 unless it is followed by a slash. */
117 if (XSTRING (errstring
)->data
[1] != '/')
118 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
121 Fsignal (Qfile_error
,
122 Fcons (build_string (string
), Fcons (errstring
, data
)));
125 close_file_unwind (fd
)
128 close (XFASTINT (fd
));
131 Lisp_Object Qexpand_file_name
;
132 Lisp_Object Qdirectory_file_name
;
133 Lisp_Object Qfile_name_directory
;
134 Lisp_Object Qfile_name_nondirectory
;
135 Lisp_Object Qfile_name_as_directory
;
136 Lisp_Object Qcopy_file
;
137 Lisp_Object Qmake_directory
;
138 Lisp_Object Qdelete_directory
;
139 Lisp_Object Qdelete_file
;
140 Lisp_Object Qrename_file
;
141 Lisp_Object Qadd_name_to_file
;
142 Lisp_Object Qmake_symbolic_link
;
143 Lisp_Object Qfile_exists_p
;
144 Lisp_Object Qfile_executable_p
;
145 Lisp_Object Qfile_readable_p
;
146 Lisp_Object Qfile_symlink_p
;
147 Lisp_Object Qfile_writable_p
;
148 Lisp_Object Qfile_directory_p
;
149 Lisp_Object Qfile_accessible_directory_p
;
150 Lisp_Object Qfile_modes
;
151 Lisp_Object Qset_file_modes
;
152 Lisp_Object Qfile_newer_than_file_p
;
153 Lisp_Object Qinsert_file_contents
;
154 Lisp_Object Qwrite_region
;
155 Lisp_Object Qverify_visited_file_modtime
;
157 /* If FILENAME is handled specially on account of its syntax,
158 return its handler function. Otherwise, return nil. */
161 find_file_handler (filename
)
162 Lisp_Object filename
;
165 for (chain
= Vfile_name_handler_alist
; XTYPE (chain
) == Lisp_Cons
;
166 chain
= XCONS (chain
)->cdr
)
169 elt
= XCONS (chain
)->car
;
170 if (XTYPE (elt
) == Lisp_Cons
)
173 string
= XCONS (elt
)->car
;
174 if (XTYPE (string
) == Lisp_String
175 && fast_string_match (string
, filename
) >= 0)
176 return XCONS (elt
)->cdr
;
182 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
184 "Return the directory component in file name NAME.\n\
185 Return nil if NAME does not include a directory.\n\
186 Otherwise return a directory spec.\n\
187 Given a Unix syntax file name, returns a string ending in slash;\n\
188 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
192 register unsigned char *beg
;
193 register unsigned char *p
;
196 CHECK_STRING (file
, 0);
198 /* If the file name has special constructs in it,
199 call the corresponding file handler. */
200 handler
= find_file_handler (file
);
202 return call2 (handler
, Qfile_name_directory
, file
);
204 beg
= XSTRING (file
)->data
;
205 p
= beg
+ XSTRING (file
)->size
;
207 while (p
!= beg
&& p
[-1] != '/'
209 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
215 return make_string (beg
, p
- beg
);
218 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
220 "Return file name NAME sans its directory.\n\
221 For example, in a Unix-syntax file name,\n\
222 this is everything after the last slash,\n\
223 or the entire name if it contains no slash.")
227 register unsigned char *beg
, *p
, *end
;
230 CHECK_STRING (file
, 0);
232 /* If the file name has special constructs in it,
233 call the corresponding file handler. */
234 handler
= find_file_handler (file
);
236 return call2 (handler
, Qfile_name_nondirectory
, file
);
238 beg
= XSTRING (file
)->data
;
239 end
= p
= beg
+ XSTRING (file
)->size
;
241 while (p
!= beg
&& p
[-1] != '/'
243 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
247 return make_string (p
, end
- p
);
251 file_name_as_directory (out
, in
)
254 int size
= strlen (in
) - 1;
259 /* Is it already a directory string? */
260 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
262 /* Is it a VMS directory file name? If so, hack VMS syntax. */
263 else if (! index (in
, '/')
264 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
265 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
266 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
267 || ! strncmp (&in
[size
- 5], ".dir", 4))
268 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
269 && in
[size
] == '1')))
271 register char *p
, *dot
;
275 dir:x.dir --> dir:[x]
276 dir:[x]y.dir --> dir:[x.y] */
278 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
281 strncpy (out
, in
, p
- in
);
300 dot
= index (p
, '.');
303 /* blindly remove any extension */
304 size
= strlen (out
) + (dot
- p
);
305 strncat (out
, p
, dot
- p
);
316 /* For Unix syntax, Append a slash if necessary */
317 if (out
[size
] != '/')
323 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
324 Sfile_name_as_directory
, 1, 1, 0,
325 "Return a string representing file FILENAME interpreted as a directory.\n\
326 This operation exists because a directory is also a file, but its name as\n\
327 a directory is different from its name as a file.\n\
328 The result can be used as the value of `default-directory'\n\
329 or passed as second argument to `expand-file-name'.\n\
330 For a Unix-syntax file name, just appends a slash.\n\
331 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
338 CHECK_STRING (file
, 0);
342 /* If the file name has special constructs in it,
343 call the corresponding file handler. */
344 handler
= find_file_handler (file
);
346 return call2 (handler
, Qfile_name_as_directory
, file
);
348 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
349 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
353 * Convert from directory name to filename.
355 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
356 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
357 * On UNIX, it's simple: just make sure there is a terminating /
359 * Value is nonzero if the string output is different from the input.
362 directory_file_name (src
, dst
)
370 struct FAB fab
= cc$rms_fab
;
371 struct NAM nam
= cc$rms_nam
;
372 char esa
[NAM$C_MAXRSS
];
377 if (! index (src
, '/')
378 && (src
[slen
- 1] == ']'
379 || src
[slen
- 1] == ':'
380 || src
[slen
- 1] == '>'))
382 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
384 fab
.fab$b_fns
= slen
;
385 fab
.fab$l_nam
= &nam
;
386 fab
.fab$l_fop
= FAB$M_NAM
;
389 nam
.nam$b_ess
= sizeof esa
;
390 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
392 /* We call SYS$PARSE to handle such things as [--] for us. */
393 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
395 slen
= nam
.nam$b_esl
;
396 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
401 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
403 /* what about when we have logical_name:???? */
404 if (src
[slen
- 1] == ':')
405 { /* Xlate logical name and see what we get */
406 ptr
= strcpy (dst
, src
); /* upper case for getenv */
409 if ('a' <= *ptr
&& *ptr
<= 'z')
413 dst
[slen
- 1] = 0; /* remove colon */
414 if (!(src
= egetenv (dst
)))
416 /* should we jump to the beginning of this procedure?
417 Good points: allows us to use logical names that xlate
419 Bad points: can be a problem if we just translated to a device
421 For now, I'll punt and always expect VMS names, and hope for
424 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
425 { /* no recursion here! */
431 { /* not a directory spec */
436 bracket
= src
[slen
- 1];
438 /* If bracket is ']' or '>', bracket - 2 is the corresponding
440 ptr
= index (src
, bracket
- 2);
442 { /* no opening bracket */
446 if (!(rptr
= rindex (src
, '.')))
449 strncpy (dst
, src
, slen
);
453 dst
[slen
++] = bracket
;
458 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
459 then translate the device and recurse. */
460 if (dst
[slen
- 1] == ':'
461 && dst
[slen
- 2] != ':' /* skip decnet nodes */
462 && strcmp(src
+ slen
, "[000000]") == 0)
464 dst
[slen
- 1] = '\0';
465 if ((ptr
= egetenv (dst
))
466 && (rlen
= strlen (ptr
) - 1) > 0
467 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
468 && ptr
[rlen
- 1] == '.')
472 return directory_file_name (ptr
, dst
);
477 strcat (dst
, "[000000]");
481 rlen
= strlen (rptr
) - 1;
482 strncat (dst
, rptr
, rlen
);
483 dst
[slen
+ rlen
] = '\0';
484 strcat (dst
, ".DIR.1");
488 /* Process as Unix format: just remove any final slash.
489 But leave "/" unchanged; do not change it to "". */
491 if (slen
> 1 && dst
[slen
- 1] == '/')
496 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
498 "Returns the file name of the directory named DIR.\n\
499 This is the name of the file that holds the data for the directory DIR.\n\
500 This operation exists because a directory is also a file, but its name as\n\
501 a directory is different from its name as a file.\n\
502 In Unix-syntax, this function just removes the final slash.\n\
503 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
504 it returns a file name such as \"[X]Y.DIR.1\".")
506 Lisp_Object directory
;
511 CHECK_STRING (directory
, 0);
513 if (NILP (directory
))
516 /* If the file name has special constructs in it,
517 call the corresponding file handler. */
518 handler
= find_file_handler (directory
);
520 return call2 (handler
, Qdirectory_file_name
, directory
);
523 /* 20 extra chars is insufficient for VMS, since we might perform a
524 logical name translation. an equivalence string can be up to 255
525 chars long, so grab that much extra space... - sss */
526 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
528 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
530 directory_file_name (XSTRING (directory
)->data
, buf
);
531 return build_string (buf
);
534 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
535 "Generate temporary file name (string) starting with PREFIX (a string).\n\
536 The Emacs process number forms part of the result,\n\
537 so there is no danger of generating a name being used by another process.")
542 val
= concat2 (prefix
, build_string ("XXXXXX"));
543 mktemp (XSTRING (val
)->data
);
547 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
548 "Convert FILENAME to absolute, and canonicalize it.\n\
549 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
550 (does not start with slash); if DEFAULT is nil or missing,\n\
551 the current buffer's value of default-directory is used.\n\
552 Path components that are `.' are removed, and \n\
553 path components followed by `..' are removed, along with the `..' itself;\n\
554 note that these simplifications are done without checking the resulting\n\
555 paths in the file system.\n\
556 An initial `~/' expands to your home directory.\n\
557 An initial `~USER/' expands to USER's home directory.\n\
558 See also the function `substitute-in-file-name'.")
560 Lisp_Object name
, defalt
;
564 register unsigned char *newdir
, *p
, *o
;
566 unsigned char *target
;
570 unsigned char * colon
= 0;
571 unsigned char * close
= 0;
572 unsigned char * slash
= 0;
573 unsigned char * brack
= 0;
574 int lbrack
= 0, rbrack
= 0;
579 CHECK_STRING (name
, 0);
581 /* If the file name has special constructs in it,
582 call the corresponding file handler. */
583 handler
= find_file_handler (name
);
585 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
588 /* Filenames on VMS are always upper case. */
589 name
= Fupcase (name
);
592 nm
= XSTRING (name
)->data
;
594 /* If nm is absolute, flush ...// and detect /./ and /../.
595 If no /./ or /../ we can return right away. */
607 if (p
[0] == '/' && p
[1] == '/'
609 /* // at start of filename is meaningful on Apollo system */
614 if (p
[0] == '/' && p
[1] == '~')
615 nm
= p
+ 1, lose
= 1;
616 if (p
[0] == '/' && p
[1] == '.'
617 && (p
[2] == '/' || p
[2] == 0
618 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
624 /* if dev:[dir]/, move nm to / */
625 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
626 nm
= (brack
? brack
+ 1 : colon
+ 1);
635 /* VMS pre V4.4,convert '-'s in filenames. */
636 if (lbrack
== rbrack
)
638 if (dots
< 2) /* this is to allow negative version numbers */
643 if (lbrack
> rbrack
&&
644 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
645 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
651 /* count open brackets, reset close bracket pointer */
652 if (p
[0] == '[' || p
[0] == '<')
654 /* count close brackets, set close bracket pointer */
655 if (p
[0] == ']' || p
[0] == '>')
657 /* detect ][ or >< */
658 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
660 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
661 nm
= p
+ 1, lose
= 1;
662 if (p
[0] == ':' && (colon
|| slash
))
663 /* if dev1:[dir]dev2:, move nm to dev2: */
669 /* if /pathname/dev:, move nm to dev: */
672 /* if node::dev:, move colon following dev */
673 else if (colon
&& colon
[-1] == ':')
675 /* if dev1:dev2:, move nm to dev2: */
676 else if (colon
&& colon
[-1] != ':')
681 if (p
[0] == ':' && !colon
)
687 if (lbrack
== rbrack
)
690 else if (p
[0] == '.')
699 return build_string (sys_translate_unix (nm
));
701 if (nm
== XSTRING (name
)->data
)
703 return build_string (nm
);
707 /* Now determine directory to start with and put it in newdir */
711 if (nm
[0] == '~') /* prefix ~ */
716 || nm
[1] == 0)/* ~ by itself */
718 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
719 newdir
= (unsigned char *) "";
722 nm
++; /* Don't leave the slash in nm. */
725 else /* ~user/filename */
727 for (p
= nm
; *p
&& (*p
!= '/'
732 o
= (unsigned char *) alloca (p
- nm
+ 1);
733 bcopy ((char *) nm
, o
, p
- nm
);
736 pw
= (struct passwd
*) getpwnam (o
+ 1);
739 newdir
= (unsigned char *) pw
-> pw_dir
;
741 nm
= p
+ 1; /* skip the terminator */
747 /* If we don't find a user of that name, leave the name
748 unchanged; don't move nm forward to p. */
758 defalt
= current_buffer
->directory
;
759 CHECK_STRING (defalt
, 1);
760 newdir
= XSTRING (defalt
)->data
;
765 /* Get rid of any slash at the end of newdir. */
766 int length
= strlen (newdir
);
767 if (newdir
[length
- 1] == '/')
769 unsigned char *temp
= (unsigned char *) alloca (length
);
770 bcopy (newdir
, temp
, length
- 1);
771 temp
[length
- 1] = 0;
779 /* Now concatenate the directory and name to new space in the stack frame */
780 tlen
+= strlen (nm
) + 1;
781 target
= (unsigned char *) alloca (tlen
);
787 if (nm
[0] == 0 || nm
[0] == '/')
788 strcpy (target
, newdir
);
791 file_name_as_directory (target
, newdir
);
796 if (index (target
, '/'))
797 strcpy (target
, sys_translate_unix (target
));
800 /* Now canonicalize by removing /. and /foo/.. if they appear */
808 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
814 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
815 /* brackets are offset from each other by 2 */
818 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
819 /* convert [foo][bar] to [bar] */
820 while (o
[-1] != '[' && o
[-1] != '<')
822 else if (*p
== '-' && *o
!= '.')
825 else if (p
[0] == '-' && o
[-1] == '.' &&
826 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
827 /* flush .foo.- ; leave - if stopped by '[' or '<' */
831 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
832 if (p
[1] == '.') /* foo.-.bar ==> bar*/
834 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
836 /* else [foo.-] ==> [-] */
842 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
843 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
853 else if (!strncmp (p
, "//", 2)
855 /* // at start of filename is meaningful in Apollo system */
863 else if (p
[0] == '/' && p
[1] == '.' &&
864 (p
[2] == '/' || p
[2] == 0))
866 else if (!strncmp (p
, "/..", 3)
867 /* `/../' is the "superroot" on certain file systems. */
869 && (p
[3] == '/' || p
[3] == 0))
871 while (o
!= target
&& *--o
!= '/')
874 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
878 if (o
== target
&& *o
== '/')
889 return make_string (target
, o
- target
);
892 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
893 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
894 "Convert FILENAME to absolute, and canonicalize it.\n\
895 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
896 (does not start with slash); if DEFAULT is nil or missing,\n\
897 the current buffer's value of default-directory is used.\n\
898 Filenames containing `.' or `..' as components are simplified;\n\
899 initial `~/' expands to your home directory.\n\
900 See also the function `substitute-in-file-name'.")
902 Lisp_Object name, defalt;
906 register unsigned char *newdir, *p, *o;
908 unsigned char *target;
912 unsigned char * colon = 0;
913 unsigned char * close = 0;
914 unsigned char * slash = 0;
915 unsigned char * brack = 0;
916 int lbrack = 0, rbrack = 0;
920 CHECK_STRING (name
, 0);
923 /* Filenames on VMS are always upper case. */
924 name
= Fupcase (name
);
927 nm
= XSTRING (name
)->data
;
929 /* If nm is absolute, flush ...// and detect /./ and /../.
930 If no /./ or /../ we can return right away. */
942 if (p
[0] == '/' && p
[1] == '/'
944 /* // at start of filename is meaningful on Apollo system */
949 if (p
[0] == '/' && p
[1] == '~')
950 nm
= p
+ 1, lose
= 1;
951 if (p
[0] == '/' && p
[1] == '.'
952 && (p
[2] == '/' || p
[2] == 0
953 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
959 /* if dev:[dir]/, move nm to / */
960 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
961 nm
= (brack
? brack
+ 1 : colon
+ 1);
970 /* VMS pre V4.4,convert '-'s in filenames. */
971 if (lbrack
== rbrack
)
973 if (dots
< 2) /* this is to allow negative version numbers */
978 if (lbrack
> rbrack
&&
979 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
980 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
986 /* count open brackets, reset close bracket pointer */
987 if (p
[0] == '[' || p
[0] == '<')
989 /* count close brackets, set close bracket pointer */
990 if (p
[0] == ']' || p
[0] == '>')
992 /* detect ][ or >< */
993 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
995 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
996 nm
= p
+ 1, lose
= 1;
997 if (p
[0] == ':' && (colon
|| slash
))
998 /* if dev1:[dir]dev2:, move nm to dev2: */
1004 /* if /pathname/dev:, move nm to dev: */
1007 /* if node::dev:, move colon following dev */
1008 else if (colon
&& colon
[-1] == ':')
1010 /* if dev1:dev2:, move nm to dev2: */
1011 else if (colon
&& colon
[-1] != ':')
1016 if (p
[0] == ':' && !colon
)
1022 if (lbrack
== rbrack
)
1025 else if (p
[0] == '.')
1033 if (index (nm
, '/'))
1034 return build_string (sys_translate_unix (nm
));
1036 if (nm
== XSTRING (name
)->data
)
1038 return build_string (nm
);
1042 /* Now determine directory to start with and put it in NEWDIR */
1046 if (nm
[0] == '~') /* prefix ~ */
1051 || nm
[1] == 0)/* ~/filename */
1053 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1054 newdir
= (unsigned char *) "";
1057 nm
++; /* Don't leave the slash in nm. */
1060 else /* ~user/filename */
1062 /* Get past ~ to user */
1063 unsigned char *user
= nm
+ 1;
1064 /* Find end of name. */
1065 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1066 int len
= ptr
? ptr
- user
: strlen (user
);
1068 unsigned char *ptr1
= index (user
, ':');
1069 if (ptr1
!= 0 && ptr1
- user
< len
)
1072 /* Copy the user name into temp storage. */
1073 o
= (unsigned char *) alloca (len
+ 1);
1074 bcopy ((char *) user
, o
, len
);
1077 /* Look up the user name. */
1078 pw
= (struct passwd
*) getpwnam (o
+ 1);
1080 error ("\"%s\" isn't a registered user", o
+ 1);
1082 newdir
= (unsigned char *) pw
->pw_dir
;
1084 /* Discard the user name from NM. */
1091 #endif /* not VMS */
1095 defalt
= current_buffer
->directory
;
1096 CHECK_STRING (defalt
, 1);
1097 newdir
= XSTRING (defalt
)->data
;
1100 /* Now concatenate the directory and name to new space in the stack frame */
1102 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1103 target
= (unsigned char *) alloca (tlen
);
1109 if (nm
[0] == 0 || nm
[0] == '/')
1110 strcpy (target
, newdir
);
1113 file_name_as_directory (target
, newdir
);
1116 strcat (target
, nm
);
1118 if (index (target
, '/'))
1119 strcpy (target
, sys_translate_unix (target
));
1122 /* Now canonicalize by removing /. and /foo/.. if they appear */
1130 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1136 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1137 /* brackets are offset from each other by 2 */
1140 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1141 /* convert [foo][bar] to [bar] */
1142 while (o
[-1] != '[' && o
[-1] != '<')
1144 else if (*p
== '-' && *o
!= '.')
1147 else if (p
[0] == '-' && o
[-1] == '.' &&
1148 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1149 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1153 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1154 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1156 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1158 /* else [foo.-] ==> [-] */
1164 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1165 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1175 else if (!strncmp (p
, "//", 2)
1177 /* // at start of filename is meaningful in Apollo system */
1185 else if (p
[0] == '/' && p
[1] == '.' &&
1186 (p
[2] == '/' || p
[2] == 0))
1188 else if (!strncmp (p
, "/..", 3)
1189 /* `/../' is the "superroot" on certain file systems. */
1191 && (p
[3] == '/' || p
[3] == 0))
1193 while (o
!= target
&& *--o
!= '/')
1196 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1200 if (o
== target
&& *o
== '/')
1208 #endif /* not VMS */
1211 return make_string (target
, o
- target
);
1215 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1216 Ssubstitute_in_file_name
, 1, 1, 0,
1217 "Substitute environment variables referred to in FILENAME.\n\
1218 `$FOO' where FOO is an environment variable name means to substitute\n\
1219 the value of that variable. The variable name should be terminated\n\
1220 with a character not a letter, digit or underscore; otherwise, enclose\n\
1221 the entire variable name in braces.\n\
1222 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1223 On VMS, `$' substitution is not done; this function does little and only\n\
1224 duplicates what `expand-file-name' does.")
1230 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1231 unsigned char *target
;
1233 int substituted
= 0;
1236 CHECK_STRING (string
, 0);
1238 nm
= XSTRING (string
)->data
;
1239 endp
= nm
+ XSTRING (string
)->size
;
1241 /* If /~ or // appears, discard everything through first slash. */
1243 for (p
= nm
; p
!= endp
; p
++)
1247 /* // at start of file name is meaningful in Apollo system */
1248 (p
[0] == '/' && p
- 1 != nm
)
1249 #else /* not APOLLO */
1251 #endif /* not APOLLO */
1255 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1268 return build_string (nm
);
1271 /* See if any variables are substituted into the string
1272 and find the total length of their values in `total' */
1274 for (p
= nm
; p
!= endp
;)
1284 /* "$$" means a single "$" */
1293 while (p
!= endp
&& *p
!= '}') p
++;
1294 if (*p
!= '}') goto missingclose
;
1300 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1304 /* Copy out the variable name */
1305 target
= (unsigned char *) alloca (s
- o
+ 1);
1306 strncpy (target
, o
, s
- o
);
1309 /* Get variable value */
1310 o
= (unsigned char *) egetenv (target
);
1311 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1314 if (!o
&& !strcmp (target
, "USER"))
1315 o
= egetenv ("LOGNAME");
1318 if (!o
) goto badvar
;
1319 total
+= strlen (o
);
1326 /* If substitution required, recopy the string and do it */
1327 /* Make space in stack frame for the new copy */
1328 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1331 /* Copy the rest of the name through, replacing $ constructs with values */
1348 while (p
!= endp
&& *p
!= '}') p
++;
1349 if (*p
!= '}') goto missingclose
;
1355 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1359 /* Copy out the variable name */
1360 target
= (unsigned char *) alloca (s
- o
+ 1);
1361 strncpy (target
, o
, s
- o
);
1364 /* Get variable value */
1365 o
= (unsigned char *) egetenv (target
);
1366 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1369 if (!o
&& !strcmp (target
, "USER"))
1370 o
= egetenv ("LOGNAME");
1382 /* If /~ or // appears, discard everything through first slash. */
1384 for (p
= xnm
; p
!= x
; p
++)
1387 /* // at start of file name is meaningful in Apollo system */
1388 (p
[0] == '/' && p
- 1 != xnm
)
1389 #else /* not APOLLO */
1391 #endif /* not APOLLO */
1393 && p
!= nm
&& p
[-1] == '/')
1396 return make_string (xnm
, x
- xnm
);
1399 error ("Bad format environment-variable substitution");
1401 error ("Missing \"}\" in environment-variable substitution");
1403 error ("Substituting nonexistent environment variable \"%s\"", target
);
1406 #endif /* not VMS */
1409 /* A slightly faster and more convenient way to get
1410 (directory-file-name (expand-file-name FOO)). The return value may
1411 have had its last character zapped with a '\0' character, meaning
1412 that it is acceptable to system calls, but not to other lisp
1413 functions. Callers should make sure that the return value doesn't
1417 expand_and_dir_to_file (filename
, defdir
)
1418 Lisp_Object filename
, defdir
;
1420 register Lisp_Object abspath
;
1422 abspath
= Fexpand_file_name (filename
, defdir
);
1425 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1426 if (c
== ':' || c
== ']' || c
== '>')
1427 abspath
= Fdirectory_file_name (abspath
);
1430 /* Remove final slash, if any (unless path is root).
1431 stat behaves differently depending! */
1432 if (XSTRING (abspath
)->size
> 1
1433 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1435 if (EQ (abspath
, filename
))
1436 abspath
= Fcopy_sequence (abspath
);
1437 XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] = 0;
1443 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1444 Lisp_Object absname
;
1445 unsigned char *querystring
;
1448 register Lisp_Object tem
;
1449 struct gcpro gcpro1
;
1451 if (access (XSTRING (absname
)->data
, 4) >= 0)
1454 Fsignal (Qfile_already_exists
,
1455 Fcons (build_string ("File already exists"),
1456 Fcons (absname
, Qnil
)));
1458 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1459 XSTRING (absname
)->data
, querystring
));
1462 Fsignal (Qfile_already_exists
,
1463 Fcons (build_string ("File already exists"),
1464 Fcons (absname
, Qnil
)));
1469 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1470 "fCopy file: \nFCopy %s to file: \np\nP",
1471 "Copy FILE to NEWNAME. Both args must be strings.\n\
1472 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1473 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1474 A number as third arg means request confirmation if NEWNAME already exists.\n\
1475 This is what happens in interactive use with M-x.\n\
1476 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1477 last-modified time as the old one. (This works on only some systems.)\n\
1478 A prefix arg makes KEEP-TIME non-nil.")
1479 (filename
, newname
, ok_if_already_exists
, keep_date
)
1480 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1483 char buf
[16 * 1024];
1485 Lisp_Object handler
;
1486 struct gcpro gcpro1
, gcpro2
;
1487 int count
= specpdl_ptr
- specpdl
;
1489 GCPRO2 (filename
, newname
);
1490 CHECK_STRING (filename
, 0);
1491 CHECK_STRING (newname
, 1);
1492 filename
= Fexpand_file_name (filename
, Qnil
);
1493 newname
= Fexpand_file_name (newname
, Qnil
);
1495 /* If the input file name has special constructs in it,
1496 call the corresponding file handler. */
1497 handler
= find_file_handler (filename
);
1498 if (!NILP (handler
))
1499 return call3 (handler
, Qcopy_file
, filename
, newname
);
1500 /* Likewise for output file name. */
1501 handler
= find_file_handler (newname
);
1502 if (!NILP (handler
))
1503 return call3 (handler
, Qcopy_file
, filename
, newname
);
1505 if (NILP (ok_if_already_exists
)
1506 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1507 barf_or_query_if_file_exists (newname
, "copy to it",
1508 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1510 ifd
= open (XSTRING (filename
)->data
, 0);
1512 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1514 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1517 /* Create the copy file with the same record format as the input file */
1518 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1520 ofd
= creat (XSTRING (newname
)->data
, 0666);
1523 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1525 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1529 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1530 if (write (ofd
, buf
, n
) != n
)
1531 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1534 if (fstat (ifd
, &st
) >= 0)
1536 if (!NILP (keep_date
))
1538 EMACS_TIME atime
, mtime
;
1539 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1540 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1541 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1544 if (!egetenv ("USE_DOMAIN_ACLS"))
1546 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1549 /* Discard the unwind protects. */
1550 specpdl_ptr
= specpdl
+ count
;
1553 if (close (ofd
) < 0)
1554 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1560 DEFUN ("make-directory", Fmake_directory
, Smake_directory
, 1, 1, "FMake directory: ",
1561 "Create a directory. One argument, a file name string.")
1563 Lisp_Object dirname
;
1566 Lisp_Object handler
;
1568 CHECK_STRING (dirname
, 0);
1569 dirname
= Fexpand_file_name (dirname
, Qnil
);
1571 handler
= find_file_handler (dirname
);
1572 if (!NILP (handler
))
1573 return call2 (handler
, Qmake_directory
, dirname
);
1575 dir
= XSTRING (dirname
)->data
;
1577 if (mkdir (dir
, 0777) != 0)
1578 report_file_error ("Creating directory", Flist (1, &dirname
));
1583 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1584 "Delete a directory. One argument, a file name string.")
1586 Lisp_Object dirname
;
1589 Lisp_Object handler
;
1591 CHECK_STRING (dirname
, 0);
1592 dirname
= Fexpand_file_name (dirname
, Qnil
);
1593 dir
= XSTRING (dirname
)->data
;
1595 handler
= find_file_handler (dirname
);
1596 if (!NILP (handler
))
1597 return call2 (handler
, Qdelete_directory
, dirname
);
1599 if (rmdir (dir
) != 0)
1600 report_file_error ("Removing directory", Flist (1, &dirname
));
1605 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1606 "Delete specified file. One argument, a file name string.\n\
1607 If file has multiple names, it continues to exist with the other names.")
1609 Lisp_Object filename
;
1611 Lisp_Object handler
;
1612 CHECK_STRING (filename
, 0);
1613 filename
= Fexpand_file_name (filename
, Qnil
);
1615 handler
= find_file_handler (filename
);
1616 if (!NILP (handler
))
1617 return call2 (handler
, Qdelete_file
, filename
);
1619 if (0 > unlink (XSTRING (filename
)->data
))
1620 report_file_error ("Removing old name", Flist (1, &filename
));
1624 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1625 "fRename file: \nFRename %s to file: \np",
1626 "Rename FILE as NEWNAME. Both args strings.\n\
1627 If file has names other than FILE, it continues to have those names.\n\
1628 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1629 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1630 A number as third arg means request confirmation if NEWNAME already exists.\n\
1631 This is what happens in interactive use with M-x.")
1632 (filename
, newname
, ok_if_already_exists
)
1633 Lisp_Object filename
, newname
, ok_if_already_exists
;
1636 Lisp_Object args
[2];
1638 Lisp_Object handler
;
1639 struct gcpro gcpro1
, gcpro2
;
1641 GCPRO2 (filename
, newname
);
1642 CHECK_STRING (filename
, 0);
1643 CHECK_STRING (newname
, 1);
1644 filename
= Fexpand_file_name (filename
, Qnil
);
1645 newname
= Fexpand_file_name (newname
, Qnil
);
1647 /* If the file name has special constructs in it,
1648 call the corresponding file handler. */
1649 handler
= find_file_handler (filename
);
1650 if (!NILP (handler
))
1651 return call3 (handler
, Qrename_file
, filename
, newname
);
1653 if (NILP (ok_if_already_exists
)
1654 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1655 barf_or_query_if_file_exists (newname
, "rename to it",
1656 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1658 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1660 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1661 || 0 > unlink (XSTRING (filename
)->data
))
1666 Fcopy_file (filename
, newname
, ok_if_already_exists
, Qt
);
1667 Fdelete_file (filename
);
1674 report_file_error ("Renaming", Flist (2, args
));
1677 report_file_error ("Renaming", Flist (2, &filename
));
1684 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1685 "fAdd name to file: \nFName to add to %s: \np",
1686 "Give FILE additional name NEWNAME. Both args strings.\n\
1687 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1688 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1689 A number as third arg means request confirmation if NEWNAME already exists.\n\
1690 This is what happens in interactive use with M-x.")
1691 (filename
, newname
, ok_if_already_exists
)
1692 Lisp_Object filename
, newname
, ok_if_already_exists
;
1695 Lisp_Object args
[2];
1697 Lisp_Object handler
;
1698 struct gcpro gcpro1
, gcpro2
;
1700 GCPRO2 (filename
, newname
);
1701 CHECK_STRING (filename
, 0);
1702 CHECK_STRING (newname
, 1);
1703 filename
= Fexpand_file_name (filename
, Qnil
);
1704 newname
= Fexpand_file_name (newname
, Qnil
);
1706 /* If the file name has special constructs in it,
1707 call the corresponding file handler. */
1708 handler
= find_file_handler (filename
);
1709 if (!NILP (handler
))
1710 return call3 (handler
, Qadd_name_to_file
, filename
, newname
);
1712 if (NILP (ok_if_already_exists
)
1713 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1714 barf_or_query_if_file_exists (newname
, "make it a new name",
1715 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1716 unlink (XSTRING (newname
)->data
);
1717 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1722 report_file_error ("Adding new name", Flist (2, args
));
1724 report_file_error ("Adding new name", Flist (2, &filename
));
1733 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1734 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1735 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1736 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1737 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1738 A number as third arg means request confirmation if NEWNAME already exists.\n\
1739 This happens for interactive use with M-x.")
1740 (filename
, linkname
, ok_if_already_exists
)
1741 Lisp_Object filename
, linkname
, ok_if_already_exists
;
1744 Lisp_Object args
[2];
1746 Lisp_Object handler
;
1747 struct gcpro gcpro1
, gcpro2
;
1749 GCPRO2 (filename
, linkname
);
1750 CHECK_STRING (filename
, 0);
1751 CHECK_STRING (linkname
, 1);
1752 #if 0 /* This made it impossible to make a link to a relative name. */
1753 filename
= Fexpand_file_name (filename
, Qnil
);
1755 linkname
= Fexpand_file_name (linkname
, Qnil
);
1757 /* If the file name has special constructs in it,
1758 call the corresponding file handler. */
1759 handler
= find_file_handler (filename
);
1760 if (!NILP (handler
))
1761 return call3 (handler
, Qmake_symbolic_link
, filename
, linkname
);
1763 if (NILP (ok_if_already_exists
)
1764 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1765 barf_or_query_if_file_exists (linkname
, "make it a link",
1766 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1767 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1769 /* If we didn't complain already, silently delete existing file. */
1770 if (errno
== EEXIST
)
1772 unlink (XSTRING (filename
)->data
);
1773 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1780 report_file_error ("Making symbolic link", Flist (2, args
));
1782 report_file_error ("Making symbolic link", Flist (2, &filename
));
1788 #endif /* S_IFLNK */
1792 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
1793 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1794 "Define the job-wide logical name NAME to have the value STRING.\n\
1795 If STRING is nil or a null string, the logical name NAME is deleted.")
1797 Lisp_Object varname
;
1800 CHECK_STRING (varname
, 0);
1802 delete_logical_name (XSTRING (varname
)->data
);
1805 CHECK_STRING (string
, 1);
1807 if (XSTRING (string
)->size
== 0)
1808 delete_logical_name (XSTRING (varname
)->data
);
1810 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
1819 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
1820 "Open a network connection to PATH using LOGIN as the login string.")
1822 Lisp_Object path
, login
;
1826 CHECK_STRING (path
, 0);
1827 CHECK_STRING (login
, 0);
1829 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
1831 if (netresult
== -1)
1836 #endif /* HPUX_NET */
1838 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
1840 "Return t if file FILENAME specifies an absolute path name.\n\
1841 On Unix, this is a name starting with a `/' or a `~'.")
1843 Lisp_Object filename
;
1847 CHECK_STRING (filename
, 0);
1848 ptr
= XSTRING (filename
)->data
;
1849 if (*ptr
== '/' || *ptr
== '~'
1851 /* ??? This criterion is probably wrong for '<'. */
1852 || index (ptr
, ':') || index (ptr
, '<')
1853 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
1862 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
1863 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1864 See also `file-readable-p' and `file-attributes'.")
1866 Lisp_Object filename
;
1868 Lisp_Object abspath
;
1869 Lisp_Object handler
;
1871 CHECK_STRING (filename
, 0);
1872 abspath
= Fexpand_file_name (filename
, Qnil
);
1874 /* If the file name has special constructs in it,
1875 call the corresponding file handler. */
1876 handler
= find_file_handler (abspath
);
1877 if (!NILP (handler
))
1878 return call2 (handler
, Qfile_exists_p
, abspath
);
1880 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
1883 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
1884 "Return t if FILENAME can be executed by you.\n\
1885 For directories this means you can change to that directory.")
1887 Lisp_Object filename
;
1890 Lisp_Object abspath
;
1891 Lisp_Object handler
;
1893 CHECK_STRING (filename
, 0);
1894 abspath
= Fexpand_file_name (filename
, Qnil
);
1896 /* If the file name has special constructs in it,
1897 call the corresponding file handler. */
1898 handler
= find_file_handler (abspath
);
1899 if (!NILP (handler
))
1900 return call2 (handler
, Qfile_executable_p
, abspath
);
1902 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
1905 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
1906 "Return t if file FILENAME exists and you can read it.\n\
1907 See also `file-exists-p' and `file-attributes'.")
1909 Lisp_Object filename
;
1911 Lisp_Object abspath
;
1912 Lisp_Object handler
;
1914 CHECK_STRING (filename
, 0);
1915 abspath
= Fexpand_file_name (filename
, Qnil
);
1917 /* If the file name has special constructs in it,
1918 call the corresponding file handler. */
1919 handler
= find_file_handler (abspath
);
1920 if (!NILP (handler
))
1921 return call2 (handler
, Qfile_readable_p
, abspath
);
1923 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
1926 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
1927 "If file FILENAME is the name of a symbolic link\n\
1928 returns the name of the file to which it is linked.\n\
1929 Otherwise returns NIL.")
1931 Lisp_Object filename
;
1938 Lisp_Object handler
;
1940 CHECK_STRING (filename
, 0);
1941 filename
= Fexpand_file_name (filename
, Qnil
);
1943 /* If the file name has special constructs in it,
1944 call the corresponding file handler. */
1945 handler
= find_file_handler (filename
);
1946 if (!NILP (handler
))
1947 return call2 (handler
, Qfile_symlink_p
, filename
);
1952 buf
= (char *) xmalloc (bufsize
);
1953 bzero (buf
, bufsize
);
1954 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
1955 if (valsize
< bufsize
) break;
1956 /* Buffer was not long enough */
1965 val
= make_string (buf
, valsize
);
1968 #else /* not S_IFLNK */
1970 #endif /* not S_IFLNK */
1973 /* Having this before file-symlink-p mysteriously caused it to be forgotten
1975 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
1976 "Return t if file FILENAME can be written or created by you.")
1978 Lisp_Object filename
;
1980 Lisp_Object abspath
, dir
;
1981 Lisp_Object handler
;
1983 CHECK_STRING (filename
, 0);
1984 abspath
= Fexpand_file_name (filename
, Qnil
);
1986 /* If the file name has special constructs in it,
1987 call the corresponding file handler. */
1988 handler
= find_file_handler (abspath
);
1989 if (!NILP (handler
))
1990 return call2 (handler
, Qfile_writable_p
, abspath
);
1992 if (access (XSTRING (abspath
)->data
, 0) >= 0)
1993 return (access (XSTRING (abspath
)->data
, 2) >= 0) ? Qt
: Qnil
;
1994 dir
= Ffile_name_directory (abspath
);
1997 dir
= Fdirectory_file_name (dir
);
1999 return (access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2003 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2004 "Return t if file FILENAME is the name of a directory as a file.\n\
2005 A directory name spec may be given instead; then the value is t\n\
2006 if the directory so specified exists and really is a directory.")
2008 Lisp_Object filename
;
2010 register Lisp_Object abspath
;
2012 Lisp_Object handler
;
2014 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2016 /* If the file name has special constructs in it,
2017 call the corresponding file handler. */
2018 handler
= find_file_handler (abspath
);
2019 if (!NILP (handler
))
2020 return call2 (handler
, Qfile_directory_p
, abspath
);
2022 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2024 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2027 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2028 "Return t if file FILENAME is the name of a directory as a file,\n\
2029 and files in that directory can be opened by you. In order to use a\n\
2030 directory as a buffer's current directory, this predicate must return true.\n\
2031 A directory name spec may be given instead; then the value is t\n\
2032 if the directory so specified exists and really is a readable and\n\
2033 searchable directory.")
2035 Lisp_Object filename
;
2037 Lisp_Object handler
;
2039 /* If the file name has special constructs in it,
2040 call the corresponding file handler. */
2041 handler
= find_file_handler (filename
);
2042 if (!NILP (handler
))
2043 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2045 if (NILP (Ffile_directory_p (filename
))
2046 || NILP (Ffile_executable_p (filename
)))
2052 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2053 "Return mode bits of FILE, as an integer.")
2055 Lisp_Object filename
;
2057 Lisp_Object abspath
;
2059 Lisp_Object handler
;
2061 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2063 /* If the file name has special constructs in it,
2064 call the corresponding file handler. */
2065 handler
= find_file_handler (abspath
);
2066 if (!NILP (handler
))
2067 return call2 (handler
, Qfile_modes
, abspath
);
2069 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2071 return make_number (st
.st_mode
& 07777);
2074 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2075 "Set mode bits of FILE to MODE (an integer).\n\
2076 Only the 12 low bits of MODE are used.")
2078 Lisp_Object filename
, mode
;
2080 Lisp_Object abspath
;
2081 Lisp_Object handler
;
2083 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2084 CHECK_NUMBER (mode
, 1);
2086 /* If the file name has special constructs in it,
2087 call the corresponding file handler. */
2088 handler
= find_file_handler (abspath
);
2089 if (!NILP (handler
))
2090 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2093 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2094 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2096 if (!egetenv ("USE_DOMAIN_ACLS"))
2099 struct timeval tvp
[2];
2101 /* chmod on apollo also change the file's modtime; need to save the
2102 modtime and then restore it. */
2103 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2105 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2109 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2110 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2112 /* reset the old accessed and modified times. */
2113 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2115 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2118 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2119 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2126 DEFUN ("set-umask", Fset_umask
, Sset_umask
, 1, 1, 0,
2127 "Select which permission bits to disable in newly created files.\n\
2128 MASK should be an integer; if a permission's bit in MASK is 1,\n\
2129 subsequently created files will not have that permission enabled.\n\
2130 Only the low 9 bits are used.\n\
2131 This setting is inherited by subprocesses.")
2135 CHECK_NUMBER (mask
, 0);
2137 umask (XINT (mask
) & 0777);
2142 DEFUN ("umask", Fumask
, Sumask
, 0, 0, 0,
2143 "Return the current umask value.\n\
2144 The umask value determines which permissions are enabled in newly\n\
2145 created files. If a permission's bit in the umask is 1, subsequently\n\
2146 created files will not have that permission enabled.")
2151 XSET (mask
, Lisp_Int
, umask (0));
2152 umask (XINT (mask
));
2159 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2160 "Tell Unix to finish all pending disk updates.")
2169 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2170 "Return t if file FILE1 is newer than file FILE2.\n\
2171 If FILE1 does not exist, the answer is nil;\n\
2172 otherwise, if FILE2 does not exist, the answer is t.")
2174 Lisp_Object file1
, file2
;
2176 Lisp_Object abspath1
, abspath2
;
2179 Lisp_Object handler
;
2180 struct gcpro gcpro1
, gcpro2
;
2182 CHECK_STRING (file1
, 0);
2183 CHECK_STRING (file2
, 0);
2186 GCPRO2 (abspath1
, file2
);
2187 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2188 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2191 /* If the file name has special constructs in it,
2192 call the corresponding file handler. */
2193 handler
= find_file_handler (abspath1
);
2194 if (!NILP (handler
))
2195 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2197 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2200 mtime1
= st
.st_mtime
;
2202 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2205 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2208 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2210 "Insert contents of file FILENAME after point.\n\
2211 Returns list of absolute pathname and length of data inserted.\n\
2212 If second argument VISIT is non-nil, the buffer's visited filename\n\
2213 and last save file modtime are set, and it is marked unmodified.\n\
2214 If visiting and the file does not exist, visiting is completed\n\
2215 before the error is signaled.")
2217 Lisp_Object filename
, visit
;
2221 register int inserted
= 0;
2222 register int how_much
;
2223 int count
= specpdl_ptr
- specpdl
;
2224 struct gcpro gcpro1
;
2225 Lisp_Object handler
, val
;
2230 if (!NILP (current_buffer
->read_only
))
2231 Fbarf_if_buffer_read_only();
2233 CHECK_STRING (filename
, 0);
2234 filename
= Fexpand_file_name (filename
, Qnil
);
2236 /* If the file name has special constructs in it,
2237 call the corresponding file handler. */
2238 handler
= find_file_handler (filename
);
2239 if (!NILP (handler
))
2241 val
= call3 (handler
, Qinsert_file_contents
, filename
, visit
);
2249 if (stat (XSTRING (filename
)->data
, &st
) < 0
2250 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2252 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2253 || fstat (fd
, &st
) < 0)
2254 #endif /* not APOLLO */
2256 if (fd
>= 0) close (fd
);
2258 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2264 record_unwind_protect (close_file_unwind
, make_number (fd
));
2267 /* This code will need to be changed in order to work on named
2268 pipes, and it's probably just not worth it. So we should at
2269 least signal an error. */
2270 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2271 Fsignal (Qfile_error
,
2272 Fcons (build_string ("reading from named pipe"),
2273 Fcons (filename
, Qnil
)));
2276 /* Supposedly happens on VMS. */
2278 error ("File size is negative");
2281 register Lisp_Object temp
;
2283 /* Make sure point-max won't overflow after this insertion. */
2284 XSET (temp
, Lisp_Int
, st
.st_size
+ Z
);
2285 if (st
.st_size
+ Z
!= XINT (temp
))
2286 error ("maximum buffer size exceeded");
2290 prepare_to_modify_buffer (point
, point
);
2293 if (GAP_SIZE
< st
.st_size
)
2294 make_gap (st
.st_size
- GAP_SIZE
);
2298 int try = min (st
.st_size
- inserted
, 64 << 10);
2301 /* Allow quitting out of the actual I/O. */
2304 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2322 record_insert (point
, inserted
);
2328 /* Discard the unwind protect */
2329 specpdl_ptr
= specpdl
+ count
;
2332 error ("IO error reading %s: %s",
2333 XSTRING (filename
)->data
, err_str (errno
));
2340 current_buffer
->undo_list
= Qnil
;
2342 stat (XSTRING (filename
)->data
, &st
);
2344 current_buffer
->modtime
= st
.st_mtime
;
2345 current_buffer
->save_modified
= MODIFF
;
2346 current_buffer
->auto_save_modified
= MODIFF
;
2347 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2348 #ifdef CLASH_DETECTION
2351 if (!NILP (current_buffer
->filename
))
2352 unlock_file (current_buffer
->filename
);
2353 unlock_file (filename
);
2355 #endif /* CLASH_DETECTION */
2356 current_buffer
->filename
= filename
;
2357 /* If visiting nonexistent file, return nil. */
2358 if (current_buffer
->modtime
== -1)
2359 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2362 signal_after_change (point
, 0, inserted
);
2365 RETURN_UNGCPRO (val
);
2366 RETURN_UNGCPRO (Fcons (filename
,
2367 Fcons (make_number (inserted
),
2371 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2372 "r\nFWrite region to file: ",
2373 "Write current region into specified file.\n\
2374 When called from a program, takes three arguments:\n\
2375 START, END and FILENAME. START and END are buffer positions.\n\
2376 Optional fourth argument APPEND if non-nil means\n\
2377 append to existing file contents (if any).\n\
2378 Optional fifth argument VISIT if t means\n\
2379 set the last-save-file-modtime of buffer to this file's modtime\n\
2380 and mark buffer not modified.\n\
2381 If VISIT is neither t nor nil, it means do not print\n\
2382 the \"Wrote file\" message.\n\
2383 Kludgy feature: if START is a string, then that string is written\n\
2384 to the file, instead of any buffer contents, and END is ignored.")
2385 (start
, end
, filename
, append
, visit
)
2386 Lisp_Object start
, end
, filename
, append
, visit
;
2394 int count
= specpdl_ptr
- specpdl
;
2396 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2398 Lisp_Object handler
;
2399 struct gcpro gcpro1
, gcpro2
;
2401 /* Special kludge to simplify auto-saving */
2404 XFASTINT (start
) = BEG
;
2407 else if (XTYPE (start
) != Lisp_String
)
2408 validate_region (&start
, &end
);
2410 GCPRO2 (start
, filename
);
2411 filename
= Fexpand_file_name (filename
, Qnil
);
2413 /* If the file name has special constructs in it,
2414 call the corresponding file handler. */
2415 handler
= find_file_handler (filename
);
2417 if (!NILP (handler
))
2419 Lisp_Object args
[7];
2422 args
[1] = Qwrite_region
;
2428 val
= Ffuncall (7, args
);
2430 /* Do this before reporting IO error
2431 to avoid a "file has changed on disk" warning on
2432 next attempt to save. */
2435 current_buffer
->modtime
= 0;
2436 current_buffer
->save_modified
= MODIFF
;
2437 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2438 current_buffer
->filename
= filename
;
2444 #ifdef CLASH_DETECTION
2446 lock_file (filename
);
2447 #endif /* CLASH_DETECTION */
2449 fn
= XSTRING (filename
)->data
;
2452 desc
= open (fn
, O_WRONLY
);
2456 if (auto_saving
) /* Overwrite any previous version of autosave file */
2458 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2459 desc
= open (fn
, O_RDWR
);
2461 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2462 ? XSTRING (current_buffer
->filename
)->data
: 0,
2465 else /* Write to temporary name and rename if no errors */
2467 Lisp_Object temp_name
;
2468 temp_name
= Ffile_name_directory (filename
);
2470 if (!NILP (temp_name
))
2472 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2473 build_string ("$$SAVE$$")));
2474 fname
= XSTRING (filename
)->data
;
2475 fn
= XSTRING (temp_name
)->data
;
2476 desc
= creat_copy_attrs (fname
, fn
);
2479 /* If we can't open the temporary file, try creating a new
2480 version of the original file. VMS "creat" creates a
2481 new version rather than truncating an existing file. */
2484 desc
= creat (fn
, 0666);
2485 #if 0 /* This can clobber an existing file and fail to replace it,
2486 if the user runs out of space. */
2489 /* We can't make a new version;
2490 try to truncate and rewrite existing version if any. */
2492 desc
= open (fn
, O_RDWR
);
2498 desc
= creat (fn
, 0666);
2501 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2502 #endif /* not VMS */
2508 #ifdef CLASH_DETECTION
2510 if (!auto_saving
) unlock_file (filename
);
2512 #endif /* CLASH_DETECTION */
2513 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2516 record_unwind_protect (close_file_unwind
, make_number (desc
));
2519 if (lseek (desc
, 0, 2) < 0)
2521 #ifdef CLASH_DETECTION
2522 if (!auto_saving
) unlock_file (filename
);
2523 #endif /* CLASH_DETECTION */
2524 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2529 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2530 * if we do writes that don't end with a carriage return. Furthermore
2531 * it cannot handle writes of more then 16K. The modified
2532 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2533 * this EXCEPT for the last record (iff it doesn't end with a carriage
2534 * return). This implies that if your buffer doesn't end with a carriage
2535 * return, you get one free... tough. However it also means that if
2536 * we make two calls to sys_write (a la the following code) you can
2537 * get one at the gap as well. The easiest way to fix this (honest)
2538 * is to move the gap to the next newline (or the end of the buffer).
2543 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2544 move_gap (find_next_newline (GPT
, 1));
2550 if (XTYPE (start
) == Lisp_String
)
2552 failure
= 0 > e_write (desc
, XSTRING (start
)->data
,
2553 XSTRING (start
)->size
);
2556 else if (XINT (start
) != XINT (end
))
2558 if (XINT (start
) < GPT
)
2560 register int end1
= XINT (end
);
2562 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
),
2563 min (GPT
, end1
) - tem
);
2567 if (XINT (end
) > GPT
&& !failure
)
2570 tem
= max (tem
, GPT
);
2571 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
);
2581 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2582 Disk full in NFS may be reported here. */
2583 if (fsync (desc
) < 0)
2584 failure
= 1, save_errno
= errno
;
2589 /* Spurious "file has changed on disk" warnings have been
2590 observed on Suns as well.
2591 It seems that `close' can change the modtime, under nfs.
2593 (This has supposedly been fixed in Sunos 4,
2594 but who knows about all the other machines with NFS?) */
2597 /* On VMS and APOLLO, must do the stat after the close
2598 since closing changes the modtime. */
2601 /* Recall that #if defined does not work on VMS. */
2608 /* NFS can report a write failure now. */
2609 if (close (desc
) < 0)
2610 failure
= 1, save_errno
= errno
;
2613 /* If we wrote to a temporary name and had no errors, rename to real name. */
2617 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2625 /* Discard the unwind protect */
2626 specpdl_ptr
= specpdl
+ count
;
2628 #ifdef CLASH_DETECTION
2630 unlock_file (filename
);
2631 #endif /* CLASH_DETECTION */
2633 /* Do this before reporting IO error
2634 to avoid a "file has changed on disk" warning on
2635 next attempt to save. */
2637 current_buffer
->modtime
= st
.st_mtime
;
2640 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2644 current_buffer
->save_modified
= MODIFF
;
2645 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2646 current_buffer
->filename
= filename
;
2648 else if (!NILP (visit
))
2652 message ("Wrote %s", fn
);
2658 e_write (desc
, addr
, len
)
2660 register char *addr
;
2663 char buf
[16 * 1024];
2664 register char *p
, *end
;
2666 if (!EQ (current_buffer
->selective_display
, Qt
))
2667 return write (desc
, addr
, len
) - len
;
2671 end
= p
+ sizeof buf
;
2676 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
2685 if (write (desc
, buf
, p
- buf
) != p
- buf
)
2691 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
2692 Sverify_visited_file_modtime
, 1, 1, 0,
2693 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2694 This means that the file has not been changed since it was visited or saved.")
2700 Lisp_Object handler
;
2702 CHECK_BUFFER (buf
, 0);
2705 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
2706 if (b
->modtime
== 0) return Qt
;
2708 /* If the file name has special constructs in it,
2709 call the corresponding file handler. */
2710 handler
= find_file_handler (b
->filename
);
2711 if (!NILP (handler
))
2712 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
2714 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
2716 /* If the file doesn't exist now and didn't exist before,
2717 we say that it isn't modified, provided the error is a tame one. */
2718 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
2723 if (st
.st_mtime
== b
->modtime
2724 /* If both are positive, accept them if they are off by one second. */
2725 || (st
.st_mtime
> 0 && b
->modtime
> 0
2726 && (st
.st_mtime
== b
->modtime
+ 1
2727 || st
.st_mtime
== b
->modtime
- 1)))
2732 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
2733 Sclear_visited_file_modtime
, 0, 0, 0,
2734 "Clear out records of last mod time of visited file.\n\
2735 Next attempt to save will certainly not complain of a discrepancy.")
2738 current_buffer
->modtime
= 0;
2742 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
2743 Sset_visited_file_modtime
, 0, 0, 0,
2744 "Update buffer's recorded modification time from the visited file's time.\n\
2745 Useful if the buffer was not read from the file normally\n\
2746 or if the file itself has been changed for some known benign reason.")
2749 register Lisp_Object filename
;
2751 Lisp_Object handler
;
2753 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
2755 /* If the file name has special constructs in it,
2756 call the corresponding file handler. */
2757 handler
= find_file_handler (filename
);
2758 if (!NILP (handler
))
2759 current_buffer
->modtime
= 0;
2761 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
2762 current_buffer
->modtime
= st
.st_mtime
;
2770 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
2773 message ("Autosaving...error for %s", name
);
2774 Fsleep_for (make_number (1), Qnil
);
2775 message ("Autosaving...error!for %s", name
);
2776 Fsleep_for (make_number (1), Qnil
);
2777 message ("Autosaving...error for %s", name
);
2778 Fsleep_for (make_number (1), Qnil
);
2788 /* Get visited file's mode to become the auto save file's mode. */
2789 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
2790 /* But make sure we can overwrite it later! */
2791 auto_save_mode_bits
= st
.st_mode
| 0600;
2793 auto_save_mode_bits
= 0666;
2796 Fwrite_region (Qnil
, Qnil
,
2797 current_buffer
->auto_save_file_name
,
2801 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
2802 "Auto-save all buffers that need it.\n\
2803 This is all buffers that have auto-saving enabled\n\
2804 and are changed since last auto-saved.\n\
2805 Auto-saving writes the buffer into a file\n\
2806 so that your editing is not lost if the system crashes.\n\
2807 This file is not the file you visited; that changes only when you save.\n\n\
2808 Non-nil first argument means do not print any message if successful.\n\
2809 Non-nil second argument means save only current buffer.")
2813 struct buffer
*old
= current_buffer
, *b
;
2814 Lisp_Object tail
, buf
;
2816 char *omessage
= echo_area_glyphs
;
2817 extern minibuf_level
;
2819 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2820 point to non-strings reached from Vbuffer_alist. */
2826 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2827 eventually call do-auto-save, so don't err here in that case. */
2828 if (!NILP (Vrun_hooks
))
2829 call1 (Vrun_hooks
, intern ("auto-save-hook"));
2831 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2832 tail
= XCONS (tail
)->cdr
)
2834 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
2836 /* Check for auto save enabled
2837 and file changed since last auto save
2838 and file changed since last real save. */
2839 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
2840 && b
->save_modified
< BUF_MODIFF (b
)
2841 && b
->auto_save_modified
< BUF_MODIFF (b
))
2843 if ((XFASTINT (b
->save_length
) * 10
2844 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
2845 /* A short file is likely to change a large fraction;
2846 spare the user annoying messages. */
2847 && XFASTINT (b
->save_length
) > 5000
2848 /* These messages are frequent and annoying for `*mail*'. */
2849 && !EQ (b
->filename
, Qnil
))
2851 /* It has shrunk too much; turn off auto-saving here. */
2852 message ("Buffer %s has shrunk a lot; auto save turned off there",
2853 XSTRING (b
->name
)->data
);
2854 /* User can reenable saving with M-x auto-save. */
2855 b
->auto_save_file_name
= Qnil
;
2856 /* Prevent warning from repeating if user does so. */
2857 XFASTINT (b
->save_length
) = 0;
2858 Fsleep_for (make_number (1), Qnil
);
2861 set_buffer_internal (b
);
2862 if (!auto_saved
&& NILP (nomsg
))
2863 message1 ("Auto-saving...");
2864 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
2866 b
->auto_save_modified
= BUF_MODIFF (b
);
2867 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2868 set_buffer_internal (old
);
2872 /* Prevent another auto save till enough input events come in. */
2873 record_auto_save ();
2875 if (auto_saved
&& NILP (nomsg
))
2876 message1 (omessage
? omessage
: "Auto-saving...done");
2882 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
2883 Sset_buffer_auto_saved
, 0, 0, 0,
2884 "Mark current buffer as auto-saved with its current text.\n\
2885 No auto-save file will be written until the buffer changes again.")
2888 current_buffer
->auto_save_modified
= MODIFF
;
2889 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2893 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
2895 "Return t if buffer has been auto-saved since last read in or saved.")
2898 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
2901 /* Reading and completing file names */
2902 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
2904 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
2906 "Internal subroutine for read-file-name. Do not call this.")
2907 (string
, dir
, action
)
2908 Lisp_Object string
, dir
, action
;
2909 /* action is nil for complete, t for return list of completions,
2910 lambda for verify final value */
2912 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
2914 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2921 /* No need to protect ACTION--we only compare it with t and nil. */
2922 GCPRO4 (string
, realdir
, name
, specdir
);
2924 if (XSTRING (string
)->size
== 0)
2926 if (EQ (action
, Qlambda
))
2934 orig_string
= string
;
2935 string
= Fsubstitute_in_file_name (string
);
2936 changed
= NILP (Fstring_equal (string
, orig_string
));
2937 name
= Ffile_name_nondirectory (string
);
2938 val
= Ffile_name_directory (string
);
2940 realdir
= Fexpand_file_name (val
, realdir
);
2945 specdir
= Ffile_name_directory (string
);
2946 val
= Ffile_name_completion (name
, realdir
);
2948 if (XTYPE (val
) != Lisp_String
)
2955 if (!NILP (specdir
))
2956 val
= concat2 (specdir
, val
);
2959 register unsigned char *old
, *new;
2963 osize
= XSTRING (val
)->size
;
2964 /* Quote "$" as "$$" to get it past substitute-in-file-name */
2965 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
2966 if (*old
++ == '$') count
++;
2969 old
= XSTRING (val
)->data
;
2970 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
2971 new = XSTRING (val
)->data
;
2972 for (n
= osize
; n
> 0; n
--)
2983 #endif /* Not VMS */
2988 if (EQ (action
, Qt
))
2989 return Ffile_name_all_completions (name
, realdir
);
2990 /* Only other case actually used is ACTION = lambda */
2992 /* Supposedly this helps commands such as `cd' that read directory names,
2993 but can someone explain how it helps them? -- RMS */
2994 if (XSTRING (name
)->size
== 0)
2997 return Ffile_exists_p (string
);
3000 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3001 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3002 Value is not expanded---you must call `expand-file-name' yourself.\n\
3003 Default name to DEFAULT if user enters a null string.\n\
3004 (If DEFAULT is omitted, the visited file name is used.)\n\
3005 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3006 Non-nil and non-t means also require confirmation after completion.\n\
3007 Fifth arg INITIAL specifies text to start with.\n\
3008 DIR defaults to current buffer's directory default.")
3009 (prompt
, dir
, defalt
, mustmatch
, initial
)
3010 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3012 Lisp_Object val
, insdef
, insdef1
, tem
;
3013 struct gcpro gcpro1
, gcpro2
;
3014 register char *homedir
;
3018 dir
= current_buffer
->directory
;
3020 defalt
= current_buffer
->filename
;
3022 /* If dir starts with user's homedir, change that to ~. */
3023 homedir
= (char *) egetenv ("HOME");
3025 && XTYPE (dir
) == Lisp_String
3026 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3027 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3029 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3030 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3031 XSTRING (dir
)->data
[0] = '~';
3034 if (insert_default_directory
)
3038 if (!NILP (initial
))
3040 Lisp_Object args
[2], pos
;
3044 insdef
= Fconcat (2, args
);
3045 pos
= make_number (XSTRING (dir
)->size
);
3046 insdef1
= Fcons (insdef
, pos
);
3050 insdef
= Qnil
, insdef1
= Qnil
;
3053 count
= specpdl_ptr
- specpdl
;
3054 specbind (intern ("completion-ignore-case"), Qt
);
3057 GCPRO2 (insdef
, defalt
);
3058 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3059 dir
, mustmatch
, insdef1
,
3060 Qfile_name_history
);
3063 unbind_to (count
, Qnil
);
3068 error ("No file name specified");
3069 tem
= Fstring_equal (val
, insdef
);
3070 if (!NILP (tem
) && !NILP (defalt
))
3072 return Fsubstitute_in_file_name (val
);
3075 #if 0 /* Old version */
3076 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3077 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3078 Value is not expanded---you must call `expand-file-name' yourself.\n\
3079 Default name to DEFAULT if user enters a null string.\n\
3080 (If DEFAULT is omitted, the visited file name is used.)\n\
3081 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3082 Non-nil and non-t means also require confirmation after completion.\n\
3083 Fifth arg INITIAL specifies text to start with.\n\
3084 DIR defaults to current buffer's directory default.")
3085 (prompt
, dir
, defalt
, mustmatch
, initial
)
3086 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3088 Lisp_Object val
, insdef
, tem
;
3089 struct gcpro gcpro1
, gcpro2
;
3090 register char *homedir
;
3094 dir
= current_buffer
->directory
;
3096 defalt
= current_buffer
->filename
;
3098 /* If dir starts with user's homedir, change that to ~. */
3099 homedir
= (char *) egetenv ("HOME");
3101 && XTYPE (dir
) == Lisp_String
3102 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3103 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3105 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3106 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3107 XSTRING (dir
)->data
[0] = '~';
3110 if (!NILP (initial
))
3112 else if (insert_default_directory
)
3115 insdef
= build_string ("");
3118 count
= specpdl_ptr
- specpdl
;
3119 specbind (intern ("completion-ignore-case"), Qt
);
3122 GCPRO2 (insdef
, defalt
);
3123 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3125 insert_default_directory
? insdef
: Qnil
,
3126 Qfile_name_history
);
3129 unbind_to (count
, Qnil
);
3134 error ("No file name specified");
3135 tem
= Fstring_equal (val
, insdef
);
3136 if (!NILP (tem
) && !NILP (defalt
))
3138 return Fsubstitute_in_file_name (val
);
3140 #endif /* Old version */
3144 Qexpand_file_name
= intern ("expand-file-name");
3145 Qdirectory_file_name
= intern ("directory-file-name");
3146 Qfile_name_directory
= intern ("file-name-directory");
3147 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3148 Qfile_name_as_directory
= intern ("file-name-as-directory");
3149 Qcopy_file
= intern ("copy-file");
3150 Qmake_directory
= intern ("make-directory");
3151 Qdelete_directory
= intern ("delete-directory");
3152 Qdelete_file
= intern ("delete-file");
3153 Qrename_file
= intern ("rename-file");
3154 Qadd_name_to_file
= intern ("add-name-to-file");
3155 Qmake_symbolic_link
= intern ("make-symbolic-link");
3156 Qfile_exists_p
= intern ("file-exists-p");
3157 Qfile_executable_p
= intern ("file-executable-p");
3158 Qfile_readable_p
= intern ("file-readable-p");
3159 Qfile_symlink_p
= intern ("file-symlink-p");
3160 Qfile_writable_p
= intern ("file-writable-p");
3161 Qfile_directory_p
= intern ("file-directory-p");
3162 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3163 Qfile_modes
= intern ("file-modes");
3164 Qset_file_modes
= intern ("set-file-modes");
3165 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3166 Qinsert_file_contents
= intern ("insert-file-contents");
3167 Qwrite_region
= intern ("write-region");
3168 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3170 Qfile_name_history
= intern ("file-name-history");
3171 Fset (Qfile_name_history
, Qnil
);
3173 staticpro (&Qcopy_file
);
3174 staticpro (&Qmake_directory
);
3175 staticpro (&Qdelete_directory
);
3176 staticpro (&Qdelete_file
);
3177 staticpro (&Qrename_file
);
3178 staticpro (&Qadd_name_to_file
);
3179 staticpro (&Qmake_symbolic_link
);
3180 staticpro (&Qfile_exists_p
);
3181 staticpro (&Qfile_executable_p
);
3182 staticpro (&Qfile_readable_p
);
3183 staticpro (&Qfile_symlink_p
);
3184 staticpro (&Qfile_writable_p
);
3185 staticpro (&Qfile_directory_p
);
3186 staticpro (&Qfile_accessible_directory_p
);
3187 staticpro (&Qfile_modes
);
3188 staticpro (&Qset_file_modes
);
3189 staticpro (&Qfile_newer_than_file_p
);
3190 staticpro (&Qinsert_file_contents
);
3191 staticpro (&Qwrite_region
);
3192 staticpro (&Qverify_visited_file_modtime
);
3193 staticpro (&Qfile_name_history
);
3195 Qfile_error
= intern ("file-error");
3196 staticpro (&Qfile_error
);
3197 Qfile_already_exists
= intern("file-already-exists");
3198 staticpro (&Qfile_already_exists
);
3200 Fput (Qfile_error
, Qerror_conditions
,
3201 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3202 Fput (Qfile_error
, Qerror_message
,
3203 build_string ("File error"));
3205 Fput (Qfile_already_exists
, Qerror_conditions
,
3206 Fcons (Qfile_already_exists
,
3207 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3208 Fput (Qfile_already_exists
, Qerror_message
,
3209 build_string ("File already exists"));
3211 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3212 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3213 insert_default_directory
= 1;
3215 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3216 "*Non-nil means write new files with record format `stmlf'.\n\
3217 nil means use format `var'. This variable is meaningful only on VMS.");
3218 vms_stmlf_recfm
= 0;
3220 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
3221 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3222 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3225 The first argument given to HANDLER is the name of the I/O primitive\n\
3226 to be handled; the remaining arguments are the arguments that were\n\
3227 passed to that primitive. For example, if you do\n\
3228 (file-exists-p FILENAME)\n\
3229 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
3230 (funcall HANDLER 'file-exists-p FILENAME)");
3231 Vfile_name_handler_alist
= Qnil
;
3233 defsubr (&Sfile_name_directory
);
3234 defsubr (&Sfile_name_nondirectory
);
3235 defsubr (&Sfile_name_as_directory
);
3236 defsubr (&Sdirectory_file_name
);
3237 defsubr (&Smake_temp_name
);
3238 defsubr (&Sexpand_file_name
);
3239 defsubr (&Ssubstitute_in_file_name
);
3240 defsubr (&Scopy_file
);
3241 defsubr (&Smake_directory
);
3242 defsubr (&Sdelete_directory
);
3243 defsubr (&Sdelete_file
);
3244 defsubr (&Srename_file
);
3245 defsubr (&Sadd_name_to_file
);
3247 defsubr (&Smake_symbolic_link
);
3248 #endif /* S_IFLNK */
3250 defsubr (&Sdefine_logical_name
);
3253 defsubr (&Ssysnetunam
);
3254 #endif /* HPUX_NET */
3255 defsubr (&Sfile_name_absolute_p
);
3256 defsubr (&Sfile_exists_p
);
3257 defsubr (&Sfile_executable_p
);
3258 defsubr (&Sfile_readable_p
);
3259 defsubr (&Sfile_writable_p
);
3260 defsubr (&Sfile_symlink_p
);
3261 defsubr (&Sfile_directory_p
);
3262 defsubr (&Sfile_accessible_directory_p
);
3263 defsubr (&Sfile_modes
);
3264 defsubr (&Sset_file_modes
);
3265 defsubr (&Sset_umask
);
3267 defsubr (&Sfile_newer_than_file_p
);
3268 defsubr (&Sinsert_file_contents
);
3269 defsubr (&Swrite_region
);
3270 defsubr (&Sverify_visited_file_modtime
);
3271 defsubr (&Sclear_visited_file_modtime
);
3272 defsubr (&Sset_visited_file_modtime
);
3273 defsubr (&Sdo_auto_save
);
3274 defsubr (&Sset_buffer_auto_saved
);
3275 defsubr (&Srecent_auto_save_p
);
3277 defsubr (&Sread_file_name_internal
);
3278 defsubr (&Sread_file_name
);
3281 defsubr (&Sunix_sync
);