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
);
2326 /* Discard the unwind protect */
2327 specpdl_ptr
= specpdl
+ count
;
2330 error ("IO error reading %s: %s",
2331 XSTRING (filename
)->data
, err_str (errno
));
2338 current_buffer
->undo_list
= Qnil
;
2340 stat (XSTRING (filename
)->data
, &st
);
2342 current_buffer
->modtime
= st
.st_mtime
;
2343 current_buffer
->save_modified
= MODIFF
;
2344 current_buffer
->auto_save_modified
= MODIFF
;
2345 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2346 #ifdef CLASH_DETECTION
2349 if (!NILP (current_buffer
->filename
))
2350 unlock_file (current_buffer
->filename
);
2351 unlock_file (filename
);
2353 #endif /* CLASH_DETECTION */
2354 current_buffer
->filename
= filename
;
2355 /* If visiting nonexistent file, return nil. */
2356 if (current_buffer
->modtime
== -1)
2357 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2360 signal_after_change (point
, 0, inserted
);
2363 RETURN_UNGCPRO (val
);
2364 RETURN_UNGCPRO (Fcons (filename
,
2365 Fcons (make_number (inserted
),
2369 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2370 "r\nFWrite region to file: ",
2371 "Write current region into specified file.\n\
2372 When called from a program, takes three arguments:\n\
2373 START, END and FILENAME. START and END are buffer positions.\n\
2374 Optional fourth argument APPEND if non-nil means\n\
2375 append to existing file contents (if any).\n\
2376 Optional fifth argument VISIT if t means\n\
2377 set the last-save-file-modtime of buffer to this file's modtime\n\
2378 and mark buffer not modified.\n\
2379 If VISIT is neither t nor nil, it means do not print\n\
2380 the \"Wrote file\" message.\n\
2381 Kludgy feature: if START is a string, then that string is written\n\
2382 to the file, instead of any buffer contents, and END is ignored.")
2383 (start
, end
, filename
, append
, visit
)
2384 Lisp_Object start
, end
, filename
, append
, visit
;
2392 int count
= specpdl_ptr
- specpdl
;
2394 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2396 Lisp_Object handler
;
2397 struct gcpro gcpro1
, gcpro2
;
2399 /* Special kludge to simplify auto-saving */
2402 XFASTINT (start
) = BEG
;
2405 else if (XTYPE (start
) != Lisp_String
)
2406 validate_region (&start
, &end
);
2408 GCPRO2 (start
, filename
);
2409 filename
= Fexpand_file_name (filename
, Qnil
);
2411 /* If the file name has special constructs in it,
2412 call the corresponding file handler. */
2413 handler
= find_file_handler (filename
);
2415 if (!NILP (handler
))
2417 Lisp_Object args
[7];
2420 args
[1] = Qwrite_region
;
2426 val
= Ffuncall (7, args
);
2428 /* Do this before reporting IO error
2429 to avoid a "file has changed on disk" warning on
2430 next attempt to save. */
2433 current_buffer
->modtime
= 0;
2434 current_buffer
->save_modified
= MODIFF
;
2435 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2436 current_buffer
->filename
= filename
;
2442 #ifdef CLASH_DETECTION
2444 lock_file (filename
);
2445 #endif /* CLASH_DETECTION */
2447 fn
= XSTRING (filename
)->data
;
2450 desc
= open (fn
, O_WRONLY
);
2454 if (auto_saving
) /* Overwrite any previous version of autosave file */
2456 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2457 desc
= open (fn
, O_RDWR
);
2459 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2460 ? XSTRING (current_buffer
->filename
)->data
: 0,
2463 else /* Write to temporary name and rename if no errors */
2465 Lisp_Object temp_name
;
2466 temp_name
= Ffile_name_directory (filename
);
2468 if (!NILP (temp_name
))
2470 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2471 build_string ("$$SAVE$$")));
2472 fname
= XSTRING (filename
)->data
;
2473 fn
= XSTRING (temp_name
)->data
;
2474 desc
= creat_copy_attrs (fname
, fn
);
2477 /* If we can't open the temporary file, try creating a new
2478 version of the original file. VMS "creat" creates a
2479 new version rather than truncating an existing file. */
2482 desc
= creat (fn
, 0666);
2483 #if 0 /* This can clobber an existing file and fail to replace it,
2484 if the user runs out of space. */
2487 /* We can't make a new version;
2488 try to truncate and rewrite existing version if any. */
2490 desc
= open (fn
, O_RDWR
);
2496 desc
= creat (fn
, 0666);
2499 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2500 #endif /* not VMS */
2506 #ifdef CLASH_DETECTION
2508 if (!auto_saving
) unlock_file (filename
);
2510 #endif /* CLASH_DETECTION */
2511 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2514 record_unwind_protect (close_file_unwind
, make_number (desc
));
2517 if (lseek (desc
, 0, 2) < 0)
2519 #ifdef CLASH_DETECTION
2520 if (!auto_saving
) unlock_file (filename
);
2521 #endif /* CLASH_DETECTION */
2522 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2527 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2528 * if we do writes that don't end with a carriage return. Furthermore
2529 * it cannot handle writes of more then 16K. The modified
2530 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2531 * this EXCEPT for the last record (iff it doesn't end with a carriage
2532 * return). This implies that if your buffer doesn't end with a carriage
2533 * return, you get one free... tough. However it also means that if
2534 * we make two calls to sys_write (a la the following code) you can
2535 * get one at the gap as well. The easiest way to fix this (honest)
2536 * is to move the gap to the next newline (or the end of the buffer).
2541 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2542 move_gap (find_next_newline (GPT
, 1));
2548 if (XTYPE (start
) == Lisp_String
)
2550 failure
= 0 > e_write (desc
, XSTRING (start
)->data
,
2551 XSTRING (start
)->size
);
2554 else if (XINT (start
) != XINT (end
))
2556 if (XINT (start
) < GPT
)
2558 register int end1
= XINT (end
);
2560 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
),
2561 min (GPT
, end1
) - tem
);
2565 if (XINT (end
) > GPT
&& !failure
)
2568 tem
= max (tem
, GPT
);
2569 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
);
2579 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2580 Disk full in NFS may be reported here. */
2581 if (fsync (desc
) < 0)
2582 failure
= 1, save_errno
= errno
;
2587 /* Spurious "file has changed on disk" warnings have been
2588 observed on Suns as well.
2589 It seems that `close' can change the modtime, under nfs.
2591 (This has supposedly been fixed in Sunos 4,
2592 but who knows about all the other machines with NFS?) */
2595 /* On VMS and APOLLO, must do the stat after the close
2596 since closing changes the modtime. */
2599 /* Recall that #if defined does not work on VMS. */
2606 /* NFS can report a write failure now. */
2607 if (close (desc
) < 0)
2608 failure
= 1, save_errno
= errno
;
2611 /* If we wrote to a temporary name and had no errors, rename to real name. */
2615 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2623 /* Discard the unwind protect */
2624 specpdl_ptr
= specpdl
+ count
;
2626 #ifdef CLASH_DETECTION
2628 unlock_file (filename
);
2629 #endif /* CLASH_DETECTION */
2631 /* Do this before reporting IO error
2632 to avoid a "file has changed on disk" warning on
2633 next attempt to save. */
2635 current_buffer
->modtime
= st
.st_mtime
;
2638 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2642 current_buffer
->save_modified
= MODIFF
;
2643 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2644 current_buffer
->filename
= filename
;
2646 else if (!NILP (visit
))
2650 message ("Wrote %s", fn
);
2656 e_write (desc
, addr
, len
)
2658 register char *addr
;
2661 char buf
[16 * 1024];
2662 register char *p
, *end
;
2664 if (!EQ (current_buffer
->selective_display
, Qt
))
2665 return write (desc
, addr
, len
) - len
;
2669 end
= p
+ sizeof buf
;
2674 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
2683 if (write (desc
, buf
, p
- buf
) != p
- buf
)
2689 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
2690 Sverify_visited_file_modtime
, 1, 1, 0,
2691 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2692 This means that the file has not been changed since it was visited or saved.")
2698 Lisp_Object handler
;
2700 CHECK_BUFFER (buf
, 0);
2703 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
2704 if (b
->modtime
== 0) return Qt
;
2706 /* If the file name has special constructs in it,
2707 call the corresponding file handler. */
2708 handler
= find_file_handler (b
->filename
);
2709 if (!NILP (handler
))
2710 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
2712 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
2714 /* If the file doesn't exist now and didn't exist before,
2715 we say that it isn't modified, provided the error is a tame one. */
2716 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
2721 if (st
.st_mtime
== b
->modtime
2722 /* If both are positive, accept them if they are off by one second. */
2723 || (st
.st_mtime
> 0 && b
->modtime
> 0
2724 && (st
.st_mtime
== b
->modtime
+ 1
2725 || st
.st_mtime
== b
->modtime
- 1)))
2730 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
2731 Sclear_visited_file_modtime
, 0, 0, 0,
2732 "Clear out records of last mod time of visited file.\n\
2733 Next attempt to save will certainly not complain of a discrepancy.")
2736 current_buffer
->modtime
= 0;
2740 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
2741 Sset_visited_file_modtime
, 0, 0, 0,
2742 "Update buffer's recorded modification time from the visited file's time.\n\
2743 Useful if the buffer was not read from the file normally\n\
2744 or if the file itself has been changed for some known benign reason.")
2747 register Lisp_Object filename
;
2749 Lisp_Object handler
;
2751 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
2753 /* If the file name has special constructs in it,
2754 call the corresponding file handler. */
2755 handler
= find_file_handler (filename
);
2756 if (!NILP (handler
))
2757 current_buffer
->modtime
= 0;
2759 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
2760 current_buffer
->modtime
= st
.st_mtime
;
2768 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
2771 message ("Autosaving...error for %s", name
);
2772 Fsleep_for (make_number (1), Qnil
);
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
);
2786 /* Get visited file's mode to become the auto save file's mode. */
2787 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
2788 /* But make sure we can overwrite it later! */
2789 auto_save_mode_bits
= st
.st_mode
| 0600;
2791 auto_save_mode_bits
= 0666;
2794 Fwrite_region (Qnil
, Qnil
,
2795 current_buffer
->auto_save_file_name
,
2799 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
2800 "Auto-save all buffers that need it.\n\
2801 This is all buffers that have auto-saving enabled\n\
2802 and are changed since last auto-saved.\n\
2803 Auto-saving writes the buffer into a file\n\
2804 so that your editing is not lost if the system crashes.\n\
2805 This file is not the file you visited; that changes only when you save.\n\n\
2806 Non-nil first argument means do not print any message if successful.\n\
2807 Non-nil second argument means save only current buffer.")
2811 struct buffer
*old
= current_buffer
, *b
;
2812 Lisp_Object tail
, buf
;
2814 char *omessage
= echo_area_glyphs
;
2815 extern minibuf_level
;
2817 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2818 point to non-strings reached from Vbuffer_alist. */
2824 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2825 eventually call do-auto-save, so don't err here in that case. */
2826 if (!NILP (Vrun_hooks
))
2827 call1 (Vrun_hooks
, intern ("auto-save-hook"));
2829 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2830 tail
= XCONS (tail
)->cdr
)
2832 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
2834 /* Check for auto save enabled
2835 and file changed since last auto save
2836 and file changed since last real save. */
2837 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
2838 && b
->save_modified
< BUF_MODIFF (b
)
2839 && b
->auto_save_modified
< BUF_MODIFF (b
))
2841 if ((XFASTINT (b
->save_length
) * 10
2842 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
2843 /* A short file is likely to change a large fraction;
2844 spare the user annoying messages. */
2845 && XFASTINT (b
->save_length
) > 5000
2846 /* These messages are frequent and annoying for `*mail*'. */
2847 && !EQ (b
->filename
, Qnil
))
2849 /* It has shrunk too much; turn off auto-saving here. */
2850 message ("Buffer %s has shrunk a lot; auto save turned off there",
2851 XSTRING (b
->name
)->data
);
2852 /* User can reenable saving with M-x auto-save. */
2853 b
->auto_save_file_name
= Qnil
;
2854 /* Prevent warning from repeating if user does so. */
2855 XFASTINT (b
->save_length
) = 0;
2856 Fsleep_for (make_number (1), Qnil
);
2859 set_buffer_internal (b
);
2860 if (!auto_saved
&& NILP (nomsg
))
2861 message1 ("Auto-saving...");
2862 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
2864 b
->auto_save_modified
= BUF_MODIFF (b
);
2865 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2866 set_buffer_internal (old
);
2870 /* Prevent another auto save till enough input events come in. */
2871 record_auto_save ();
2873 if (auto_saved
&& NILP (nomsg
))
2874 message1 (omessage
? omessage
: "Auto-saving...done");
2880 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
2881 Sset_buffer_auto_saved
, 0, 0, 0,
2882 "Mark current buffer as auto-saved with its current text.\n\
2883 No auto-save file will be written until the buffer changes again.")
2886 current_buffer
->auto_save_modified
= MODIFF
;
2887 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2891 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
2893 "Return t if buffer has been auto-saved since last read in or saved.")
2896 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
2899 /* Reading and completing file names */
2900 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
2902 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
2904 "Internal subroutine for read-file-name. Do not call this.")
2905 (string
, dir
, action
)
2906 Lisp_Object string
, dir
, action
;
2907 /* action is nil for complete, t for return list of completions,
2908 lambda for verify final value */
2910 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
2912 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2919 /* No need to protect ACTION--we only compare it with t and nil. */
2920 GCPRO4 (string
, realdir
, name
, specdir
);
2922 if (XSTRING (string
)->size
== 0)
2924 if (EQ (action
, Qlambda
))
2932 orig_string
= string
;
2933 string
= Fsubstitute_in_file_name (string
);
2934 changed
= NILP (Fstring_equal (string
, orig_string
));
2935 name
= Ffile_name_nondirectory (string
);
2936 val
= Ffile_name_directory (string
);
2938 realdir
= Fexpand_file_name (val
, realdir
);
2943 specdir
= Ffile_name_directory (string
);
2944 val
= Ffile_name_completion (name
, realdir
);
2946 if (XTYPE (val
) != Lisp_String
)
2953 if (!NILP (specdir
))
2954 val
= concat2 (specdir
, val
);
2957 register unsigned char *old
, *new;
2961 osize
= XSTRING (val
)->size
;
2962 /* Quote "$" as "$$" to get it past substitute-in-file-name */
2963 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
2964 if (*old
++ == '$') count
++;
2967 old
= XSTRING (val
)->data
;
2968 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
2969 new = XSTRING (val
)->data
;
2970 for (n
= osize
; n
> 0; n
--)
2981 #endif /* Not VMS */
2986 if (EQ (action
, Qt
))
2987 return Ffile_name_all_completions (name
, realdir
);
2988 /* Only other case actually used is ACTION = lambda */
2990 /* Supposedly this helps commands such as `cd' that read directory names,
2991 but can someone explain how it helps them? -- RMS */
2992 if (XSTRING (name
)->size
== 0)
2995 return Ffile_exists_p (string
);
2998 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
2999 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3000 Value is not expanded---you must call `expand-file-name' yourself.\n\
3001 Default name to DEFAULT if user enters a null string.\n\
3002 (If DEFAULT is omitted, the visited file name is used.)\n\
3003 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3004 Non-nil and non-t means also require confirmation after completion.\n\
3005 Fifth arg INITIAL specifies text to start with.\n\
3006 DIR defaults to current buffer's directory default.")
3007 (prompt
, dir
, defalt
, mustmatch
, initial
)
3008 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3010 Lisp_Object val
, insdef
, insdef1
, tem
;
3011 struct gcpro gcpro1
, gcpro2
;
3012 register char *homedir
;
3016 dir
= current_buffer
->directory
;
3018 defalt
= current_buffer
->filename
;
3020 /* If dir starts with user's homedir, change that to ~. */
3021 homedir
= (char *) egetenv ("HOME");
3023 && XTYPE (dir
) == Lisp_String
3024 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3025 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3027 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3028 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3029 XSTRING (dir
)->data
[0] = '~';
3032 if (insert_default_directory
)
3036 if (!NILP (initial
))
3038 Lisp_Object args
[2], pos
;
3042 insdef
= Fconcat (2, args
);
3043 pos
= make_number (XSTRING (dir
)->size
);
3044 insdef1
= Fcons (insdef
, pos
);
3048 insdef
= Qnil
, insdef1
= Qnil
;
3051 count
= specpdl_ptr
- specpdl
;
3052 specbind (intern ("completion-ignore-case"), Qt
);
3055 GCPRO2 (insdef
, defalt
);
3056 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3057 dir
, mustmatch
, insdef1
,
3058 Qfile_name_history
);
3061 unbind_to (count
, Qnil
);
3066 error ("No file name specified");
3067 tem
= Fstring_equal (val
, insdef
);
3068 if (!NILP (tem
) && !NILP (defalt
))
3070 return Fsubstitute_in_file_name (val
);
3073 #if 0 /* Old version */
3074 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3075 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3076 Value is not expanded---you must call `expand-file-name' yourself.\n\
3077 Default name to DEFAULT if user enters a null string.\n\
3078 (If DEFAULT is omitted, the visited file name is used.)\n\
3079 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3080 Non-nil and non-t means also require confirmation after completion.\n\
3081 Fifth arg INITIAL specifies text to start with.\n\
3082 DIR defaults to current buffer's directory default.")
3083 (prompt
, dir
, defalt
, mustmatch
, initial
)
3084 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3086 Lisp_Object val
, insdef
, tem
;
3087 struct gcpro gcpro1
, gcpro2
;
3088 register char *homedir
;
3092 dir
= current_buffer
->directory
;
3094 defalt
= current_buffer
->filename
;
3096 /* If dir starts with user's homedir, change that to ~. */
3097 homedir
= (char *) egetenv ("HOME");
3099 && XTYPE (dir
) == Lisp_String
3100 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3101 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3103 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3104 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3105 XSTRING (dir
)->data
[0] = '~';
3108 if (!NILP (initial
))
3110 else if (insert_default_directory
)
3113 insdef
= build_string ("");
3116 count
= specpdl_ptr
- specpdl
;
3117 specbind (intern ("completion-ignore-case"), Qt
);
3120 GCPRO2 (insdef
, defalt
);
3121 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3123 insert_default_directory
? insdef
: Qnil
,
3124 Qfile_name_history
);
3127 unbind_to (count
, Qnil
);
3132 error ("No file name specified");
3133 tem
= Fstring_equal (val
, insdef
);
3134 if (!NILP (tem
) && !NILP (defalt
))
3136 return Fsubstitute_in_file_name (val
);
3138 #endif /* Old version */
3142 Qexpand_file_name
= intern ("expand-file-name");
3143 Qdirectory_file_name
= intern ("directory-file-name");
3144 Qfile_name_directory
= intern ("file-name-directory");
3145 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3146 Qfile_name_as_directory
= intern ("file-name-as-directory");
3147 Qcopy_file
= intern ("copy-file");
3148 Qmake_directory
= intern ("make-directory");
3149 Qdelete_directory
= intern ("delete-directory");
3150 Qdelete_file
= intern ("delete-file");
3151 Qrename_file
= intern ("rename-file");
3152 Qadd_name_to_file
= intern ("add-name-to-file");
3153 Qmake_symbolic_link
= intern ("make-symbolic-link");
3154 Qfile_exists_p
= intern ("file-exists-p");
3155 Qfile_executable_p
= intern ("file-executable-p");
3156 Qfile_readable_p
= intern ("file-readable-p");
3157 Qfile_symlink_p
= intern ("file-symlink-p");
3158 Qfile_writable_p
= intern ("file-writable-p");
3159 Qfile_directory_p
= intern ("file-directory-p");
3160 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3161 Qfile_modes
= intern ("file-modes");
3162 Qset_file_modes
= intern ("set-file-modes");
3163 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3164 Qinsert_file_contents
= intern ("insert-file-contents");
3165 Qwrite_region
= intern ("write-region");
3166 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3168 Qfile_name_history
= intern ("file-name-history");
3169 Fset (Qfile_name_history
, Qnil
);
3171 staticpro (&Qcopy_file
);
3172 staticpro (&Qmake_directory
);
3173 staticpro (&Qdelete_directory
);
3174 staticpro (&Qdelete_file
);
3175 staticpro (&Qrename_file
);
3176 staticpro (&Qadd_name_to_file
);
3177 staticpro (&Qmake_symbolic_link
);
3178 staticpro (&Qfile_exists_p
);
3179 staticpro (&Qfile_executable_p
);
3180 staticpro (&Qfile_readable_p
);
3181 staticpro (&Qfile_symlink_p
);
3182 staticpro (&Qfile_writable_p
);
3183 staticpro (&Qfile_directory_p
);
3184 staticpro (&Qfile_accessible_directory_p
);
3185 staticpro (&Qfile_modes
);
3186 staticpro (&Qset_file_modes
);
3187 staticpro (&Qfile_newer_than_file_p
);
3188 staticpro (&Qinsert_file_contents
);
3189 staticpro (&Qwrite_region
);
3190 staticpro (&Qverify_visited_file_modtime
);
3191 staticpro (&Qfile_name_history
);
3193 Qfile_error
= intern ("file-error");
3194 staticpro (&Qfile_error
);
3195 Qfile_already_exists
= intern("file-already-exists");
3196 staticpro (&Qfile_already_exists
);
3198 Fput (Qfile_error
, Qerror_conditions
,
3199 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3200 Fput (Qfile_error
, Qerror_message
,
3201 build_string ("File error"));
3203 Fput (Qfile_already_exists
, Qerror_conditions
,
3204 Fcons (Qfile_already_exists
,
3205 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3206 Fput (Qfile_already_exists
, Qerror_message
,
3207 build_string ("File already exists"));
3209 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3210 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3211 insert_default_directory
= 1;
3213 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3214 "*Non-nil means write new files with record format `stmlf'.\n\
3215 nil means use format `var'. This variable is meaningful only on VMS.");
3216 vms_stmlf_recfm
= 0;
3218 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
3219 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3220 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3223 The first argument given to HANDLER is the name of the I/O primitive\n\
3224 to be handled; the remaining arguments are the arguments that were\n\
3225 passed to that primitive. For example, if you do\n\
3226 (file-exists-p FILENAME)\n\
3227 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
3228 (funcall HANDLER 'file-exists-p FILENAME)");
3229 Vfile_name_handler_alist
= Qnil
;
3231 defsubr (&Sfile_name_directory
);
3232 defsubr (&Sfile_name_nondirectory
);
3233 defsubr (&Sfile_name_as_directory
);
3234 defsubr (&Sdirectory_file_name
);
3235 defsubr (&Smake_temp_name
);
3236 defsubr (&Sexpand_file_name
);
3237 defsubr (&Ssubstitute_in_file_name
);
3238 defsubr (&Scopy_file
);
3239 defsubr (&Smake_directory
);
3240 defsubr (&Sdelete_directory
);
3241 defsubr (&Sdelete_file
);
3242 defsubr (&Srename_file
);
3243 defsubr (&Sadd_name_to_file
);
3245 defsubr (&Smake_symbolic_link
);
3246 #endif /* S_IFLNK */
3248 defsubr (&Sdefine_logical_name
);
3251 defsubr (&Ssysnetunam
);
3252 #endif /* HPUX_NET */
3253 defsubr (&Sfile_name_absolute_p
);
3254 defsubr (&Sfile_exists_p
);
3255 defsubr (&Sfile_executable_p
);
3256 defsubr (&Sfile_readable_p
);
3257 defsubr (&Sfile_writable_p
);
3258 defsubr (&Sfile_symlink_p
);
3259 defsubr (&Sfile_directory_p
);
3260 defsubr (&Sfile_accessible_directory_p
);
3261 defsubr (&Sfile_modes
);
3262 defsubr (&Sset_file_modes
);
3263 defsubr (&Sset_umask
);
3265 defsubr (&Sfile_newer_than_file_p
);
3266 defsubr (&Sinsert_file_contents
);
3267 defsubr (&Swrite_region
);
3268 defsubr (&Sverify_visited_file_modtime
);
3269 defsubr (&Sclear_visited_file_modtime
);
3270 defsubr (&Sset_visited_file_modtime
);
3271 defsubr (&Sdo_auto_save
);
3272 defsubr (&Sset_buffer_auto_saved
);
3273 defsubr (&Srecent_auto_save_p
);
3275 defsubr (&Sread_file_name_internal
);
3276 defsubr (&Sread_file_name
);
3279 defsubr (&Sunix_sync
);