1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
22 #include <sys/types.h>
46 extern char *sys_errlist
[];
50 #define err_str(a) ((a) < sys_nerr ? sys_errlist[a] : "unknown error")
80 #define min(a, b) ((a) < (b) ? (a) : (b))
81 #define max(a, b) ((a) > (b) ? (a) : (b))
83 /* Nonzero during writing of auto-save files */
86 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
87 a new file with the same mode as the original */
88 int auto_save_mode_bits
;
90 /* Alist of elements (REGEXP . HANDLER) for file names
91 whose I/O is done with a special handler. */
92 Lisp_Object Vfile_name_handler_alist
;
94 /* Nonzero means, when reading a filename in the minibuffer,
95 start out by inserting the default directory into the minibuffer. */
96 int insert_default_directory
;
98 /* On VMS, nonzero means write new files with record format stmlf.
99 Zero means use var format. */
102 Lisp_Object Qfile_error
, Qfile_already_exists
;
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 Qcopy_file
;
132 Lisp_Object Qmake_directory
;
133 Lisp_Object Qdelete_directory
;
134 Lisp_Object Qdelete_file
;
135 Lisp_Object Qrename_file
;
136 Lisp_Object Qadd_name_to_file
;
137 Lisp_Object Qmake_symbolic_link
;
138 Lisp_Object Qfile_exists_p
;
139 Lisp_Object Qfile_executable_p
;
140 Lisp_Object Qfile_readable_p
;
141 Lisp_Object Qfile_symlink_p
;
142 Lisp_Object Qfile_writable_p
;
143 Lisp_Object Qfile_directory_p
;
144 Lisp_Object Qfile_accessible_directory_p
;
145 Lisp_Object Qfile_modes
;
146 Lisp_Object Qset_file_modes
;
147 Lisp_Object Qfile_newer_than_file_p
;
148 Lisp_Object Qinsert_file_contents
;
149 Lisp_Object Qwrite_region
;
150 Lisp_Object Qverify_visited_file_modtime
;
152 /* If FILENAME is handled specially on account of its syntax,
153 return its handler function. Otherwise, return nil. */
156 find_file_handler (filename
)
157 Lisp_Object filename
;
160 for (chain
= Vfile_name_handler_alist
; XTYPE (chain
) == Lisp_Cons
;
161 chain
= XCONS (chain
)->cdr
)
164 elt
= XCONS (chain
)->car
;
165 if (XTYPE (elt
) == Lisp_Cons
)
168 string
= XCONS (elt
)->car
;
169 if (XTYPE (string
) == Lisp_String
170 && fast_string_match (string
, filename
))
171 return XCONS (elt
)->cdr
;
177 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
179 "Return the directory component in file name NAME.\n\
180 Return nil if NAME does not include a directory.\n\
181 Otherwise return a directory spec.\n\
182 Given a Unix syntax file name, returns a string ending in slash;\n\
183 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
187 register unsigned char *beg
;
188 register unsigned char *p
;
190 CHECK_STRING (file
, 0);
192 beg
= XSTRING (file
)->data
;
193 p
= beg
+ XSTRING (file
)->size
;
195 while (p
!= beg
&& p
[-1] != '/'
197 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
203 return make_string (beg
, p
- beg
);
206 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
208 "Return file name NAME sans its directory.\n\
209 For example, in a Unix-syntax file name,\n\
210 this is everything after the last slash,\n\
211 or the entire name if it contains no slash.")
215 register unsigned char *beg
, *p
, *end
;
217 CHECK_STRING (file
, 0);
219 beg
= XSTRING (file
)->data
;
220 end
= p
= beg
+ XSTRING (file
)->size
;
222 while (p
!= beg
&& p
[-1] != '/'
224 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
228 return make_string (p
, end
- p
);
232 file_name_as_directory (out
, in
)
235 int size
= strlen (in
) - 1;
240 /* Is it already a directory string? */
241 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
243 /* Is it a VMS directory file name? If so, hack VMS syntax. */
244 else if (! index (in
, '/')
245 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
246 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
247 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
248 || ! strncmp (&in
[size
- 5], ".dir", 4))
249 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
250 && in
[size
] == '1')))
252 register char *p
, *dot
;
256 dir:x.dir --> dir:[x]
257 dir:[x]y.dir --> dir:[x.y] */
259 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
262 strncpy (out
, in
, p
- in
);
281 dot
= index (p
, '.');
284 /* blindly remove any extension */
285 size
= strlen (out
) + (dot
- p
);
286 strncat (out
, p
, dot
- p
);
297 /* For Unix syntax, Append a slash if necessary */
298 if (out
[size
] != '/')
304 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
305 Sfile_name_as_directory
, 1, 1, 0,
306 "Return a string representing file FILENAME interpreted as a directory.\n\
307 This operation exists because a directory is also a file, but its name as\n\
308 a directory is different from its name as a file.\n\
309 The result can be used as the value of `default-directory'\n\
310 or passed as second argument to `expand-file-name'.\n\
311 For a Unix-syntax file name, just appends a slash.\n\
312 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
318 CHECK_STRING (file
, 0);
321 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
322 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
326 * Convert from directory name to filename.
328 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
329 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
330 * On UNIX, it's simple: just make sure there is a terminating /
332 * Value is nonzero if the string output is different from the input.
335 directory_file_name (src
, dst
)
343 struct FAB fab
= cc$rms_fab
;
344 struct NAM nam
= cc$rms_nam
;
345 char esa
[NAM$C_MAXRSS
];
350 if (! index (src
, '/')
351 && (src
[slen
- 1] == ']'
352 || src
[slen
- 1] == ':'
353 || src
[slen
- 1] == '>'))
355 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
357 fab
.fab$b_fns
= slen
;
358 fab
.fab$l_nam
= &nam
;
359 fab
.fab$l_fop
= FAB$M_NAM
;
362 nam
.nam$b_ess
= sizeof esa
;
363 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
365 /* We call SYS$PARSE to handle such things as [--] for us. */
366 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
368 slen
= nam
.nam$b_esl
;
369 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
374 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
376 /* what about when we have logical_name:???? */
377 if (src
[slen
- 1] == ':')
378 { /* Xlate logical name and see what we get */
379 ptr
= strcpy (dst
, src
); /* upper case for getenv */
382 if ('a' <= *ptr
&& *ptr
<= 'z')
386 dst
[slen
- 1] = 0; /* remove colon */
387 if (!(src
= egetenv (dst
)))
389 /* should we jump to the beginning of this procedure?
390 Good points: allows us to use logical names that xlate
392 Bad points: can be a problem if we just translated to a device
394 For now, I'll punt and always expect VMS names, and hope for
397 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
398 { /* no recursion here! */
404 { /* not a directory spec */
409 bracket
= src
[slen
- 1];
411 /* If bracket is ']' or '>', bracket - 2 is the corresponding
413 ptr
= index (src
, bracket
- 2);
415 { /* no opening bracket */
419 if (!(rptr
= rindex (src
, '.')))
422 strncpy (dst
, src
, slen
);
426 dst
[slen
++] = bracket
;
431 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
432 then translate the device and recurse. */
433 if (dst
[slen
- 1] == ':'
434 && dst
[slen
- 2] != ':' /* skip decnet nodes */
435 && strcmp(src
+ slen
, "[000000]") == 0)
437 dst
[slen
- 1] = '\0';
438 if ((ptr
= egetenv (dst
))
439 && (rlen
= strlen (ptr
) - 1) > 0
440 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
441 && ptr
[rlen
- 1] == '.')
445 return directory_file_name (ptr
, dst
);
450 strcat (dst
, "[000000]");
454 rlen
= strlen (rptr
) - 1;
455 strncat (dst
, rptr
, rlen
);
456 dst
[slen
+ rlen
] = '\0';
457 strcat (dst
, ".DIR.1");
461 /* Process as Unix format: just remove any final slash.
462 But leave "/" unchanged; do not change it to "". */
464 if (slen
> 1 && dst
[slen
- 1] == '/')
469 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
471 "Returns the file name of the directory named DIR.\n\
472 This is the name of the file that holds the data for the directory DIR.\n\
473 This operation exists because a directory is also a file, but its name as\n\
474 a directory is different from its name as a file.\n\
475 In Unix-syntax, this function just removes the final slash.\n\
476 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
477 it returns a file name such as \"[X]Y.DIR.1\".")
479 Lisp_Object directory
;
483 CHECK_STRING (directory
, 0);
485 if (NILP (directory
))
488 /* 20 extra chars is insufficient for VMS, since we might perform a
489 logical name translation. an equivalence string can be up to 255
490 chars long, so grab that much extra space... - sss */
491 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
493 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
495 directory_file_name (XSTRING (directory
)->data
, buf
);
496 return build_string (buf
);
499 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
500 "Generate temporary file name (string) starting with PREFIX (a string).\n\
501 The Emacs process number forms part of the result,\n\
502 so there is no danger of generating a name being used by another process.")
507 val
= concat2 (prefix
, build_string ("XXXXXX"));
508 mktemp (XSTRING (val
)->data
);
512 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
513 "Convert FILENAME to absolute, and canonicalize it.\n\
514 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
515 (does not start with slash); if DEFAULT is nil or missing,\n\
516 the current buffer's value of default-directory is used.\n\
517 Path components that are `.' are removed, and \n\
518 path components followed by `..' are removed, along with the `..' itself;\n\
519 note that these simplifications are done without checking the resulting\n\
520 paths in the file system.\n\
521 An initial `~/' expands to your home directory.\n\
522 An initial `~USER/' expands to USER's home directory.\n\
523 See also the function `substitute-in-file-name'.")
525 Lisp_Object name
, defalt
;
529 register unsigned char *newdir
, *p
, *o
;
531 unsigned char *target
;
535 unsigned char * colon
= 0;
536 unsigned char * close
= 0;
537 unsigned char * slash
= 0;
538 unsigned char * brack
= 0;
539 int lbrack
= 0, rbrack
= 0;
543 CHECK_STRING (name
, 0);
546 /* Filenames on VMS are always upper case. */
547 name
= Fupcase (name
);
550 nm
= XSTRING (name
)->data
;
552 /* If nm is absolute, flush ...// and detect /./ and /../.
553 If no /./ or /../ we can return right away. */
565 if (p
[0] == '/' && p
[1] == '/'
567 /* // at start of filename is meaningful on Apollo system */
572 if (p
[0] == '/' && p
[1] == '~')
573 nm
= p
+ 1, lose
= 1;
574 if (p
[0] == '/' && p
[1] == '.'
575 && (p
[2] == '/' || p
[2] == 0
576 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
582 /* if dev:[dir]/, move nm to / */
583 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
584 nm
= (brack
? brack
+ 1 : colon
+ 1);
593 /* VMS pre V4.4,convert '-'s in filenames. */
594 if (lbrack
== rbrack
)
596 if (dots
< 2) /* this is to allow negative version numbers */
601 if (lbrack
> rbrack
&&
602 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
603 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
609 /* count open brackets, reset close bracket pointer */
610 if (p
[0] == '[' || p
[0] == '<')
612 /* count close brackets, set close bracket pointer */
613 if (p
[0] == ']' || p
[0] == '>')
615 /* detect ][ or >< */
616 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
618 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
619 nm
= p
+ 1, lose
= 1;
620 if (p
[0] == ':' && (colon
|| slash
))
621 /* if dev1:[dir]dev2:, move nm to dev2: */
627 /* if /pathname/dev:, move nm to dev: */
630 /* if node::dev:, move colon following dev */
631 else if (colon
&& colon
[-1] == ':')
633 /* if dev1:dev2:, move nm to dev2: */
634 else if (colon
&& colon
[-1] != ':')
639 if (p
[0] == ':' && !colon
)
645 if (lbrack
== rbrack
)
648 else if (p
[0] == '.')
657 return build_string (sys_translate_unix (nm
));
659 if (nm
== XSTRING (name
)->data
)
661 return build_string (nm
);
665 /* Now determine directory to start with and put it in newdir */
669 if (nm
[0] == '~') /* prefix ~ */
674 || nm
[1] == 0)/* ~ by itself */
676 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
677 newdir
= (unsigned char *) "";
680 nm
++; /* Don't leave the slash in nm. */
683 else /* ~user/filename */
685 for (p
= nm
; *p
&& (*p
!= '/'
690 o
= (unsigned char *) alloca (p
- nm
+ 1);
691 bcopy ((char *) nm
, o
, p
- nm
);
694 pw
= (struct passwd
*) getpwnam (o
+ 1);
697 newdir
= (unsigned char *) pw
-> pw_dir
;
699 nm
= p
+ 1; /* skip the terminator */
705 /* If we don't find a user of that name, leave the name
706 unchanged; don't move nm forward to p. */
716 defalt
= current_buffer
->directory
;
717 CHECK_STRING (defalt
, 1);
718 newdir
= XSTRING (defalt
)->data
;
723 /* Get rid of any slash at the end of newdir. */
724 int length
= strlen (newdir
);
725 if (newdir
[length
- 1] == '/')
727 unsigned char *temp
= (unsigned char *) alloca (length
);
728 bcopy (newdir
, temp
, length
- 1);
729 temp
[length
- 1] = 0;
737 /* Now concatenate the directory and name to new space in the stack frame */
738 tlen
+= strlen (nm
) + 1;
739 target
= (unsigned char *) alloca (tlen
);
745 if (nm
[0] == 0 || nm
[0] == '/')
746 strcpy (target
, newdir
);
749 file_name_as_directory (target
, newdir
);
754 if (index (target
, '/'))
755 strcpy (target
, sys_translate_unix (target
));
758 /* Now canonicalize by removing /. and /foo/.. if they appear */
766 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
772 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
773 /* brackets are offset from each other by 2 */
776 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
777 /* convert [foo][bar] to [bar] */
778 while (o
[-1] != '[' && o
[-1] != '<')
780 else if (*p
== '-' && *o
!= '.')
783 else if (p
[0] == '-' && o
[-1] == '.' &&
784 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
785 /* flush .foo.- ; leave - if stopped by '[' or '<' */
789 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
790 if (p
[1] == '.') /* foo.-.bar ==> bar*/
792 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
794 /* else [foo.-] ==> [-] */
800 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
801 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
811 else if (!strncmp (p
, "//", 2)
813 /* // at start of filename is meaningful in Apollo system */
821 else if (p
[0] == '/' && p
[1] == '.' &&
822 (p
[2] == '/' || p
[2] == 0))
824 else if (!strncmp (p
, "/..", 3)
825 /* `/../' is the "superroot" on certain file systems. */
827 && (p
[3] == '/' || p
[3] == 0))
829 while (o
!= target
&& *--o
!= '/')
832 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
836 if (o
== target
&& *o
== '/')
847 return make_string (target
, o
- target
);
850 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
851 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
852 "Convert FILENAME to absolute, and canonicalize it.\n\
853 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
854 (does not start with slash); if DEFAULT is nil or missing,\n\
855 the current buffer's value of default-directory is used.\n\
856 Filenames containing `.' or `..' as components are simplified;\n\
857 initial `~/' expands to your home directory.\n\
858 See also the function `substitute-in-file-name'.")
860 Lisp_Object name, defalt;
864 register unsigned char *newdir, *p, *o;
866 unsigned char *target;
870 unsigned char * colon = 0;
871 unsigned char * close = 0;
872 unsigned char * slash = 0;
873 unsigned char * brack = 0;
874 int lbrack = 0, rbrack = 0;
878 CHECK_STRING (name
, 0);
881 /* Filenames on VMS are always upper case. */
882 name
= Fupcase (name
);
885 nm
= XSTRING (name
)->data
;
887 /* If nm is absolute, flush ...// and detect /./ and /../.
888 If no /./ or /../ we can return right away. */
900 if (p
[0] == '/' && p
[1] == '/'
902 /* // at start of filename is meaningful on Apollo system */
907 if (p
[0] == '/' && p
[1] == '~')
908 nm
= p
+ 1, lose
= 1;
909 if (p
[0] == '/' && p
[1] == '.'
910 && (p
[2] == '/' || p
[2] == 0
911 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
917 /* if dev:[dir]/, move nm to / */
918 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
919 nm
= (brack
? brack
+ 1 : colon
+ 1);
928 /* VMS pre V4.4,convert '-'s in filenames. */
929 if (lbrack
== rbrack
)
931 if (dots
< 2) /* this is to allow negative version numbers */
936 if (lbrack
> rbrack
&&
937 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
938 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
944 /* count open brackets, reset close bracket pointer */
945 if (p
[0] == '[' || p
[0] == '<')
947 /* count close brackets, set close bracket pointer */
948 if (p
[0] == ']' || p
[0] == '>')
950 /* detect ][ or >< */
951 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
953 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
954 nm
= p
+ 1, lose
= 1;
955 if (p
[0] == ':' && (colon
|| slash
))
956 /* if dev1:[dir]dev2:, move nm to dev2: */
962 /* if /pathname/dev:, move nm to dev: */
965 /* if node::dev:, move colon following dev */
966 else if (colon
&& colon
[-1] == ':')
968 /* if dev1:dev2:, move nm to dev2: */
969 else if (colon
&& colon
[-1] != ':')
974 if (p
[0] == ':' && !colon
)
980 if (lbrack
== rbrack
)
983 else if (p
[0] == '.')
992 return build_string (sys_translate_unix (nm
));
994 if (nm
== XSTRING (name
)->data
)
996 return build_string (nm
);
1000 /* Now determine directory to start with and put it in NEWDIR */
1004 if (nm
[0] == '~') /* prefix ~ */
1009 || nm
[1] == 0)/* ~/filename */
1011 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1012 newdir
= (unsigned char *) "";
1015 nm
++; /* Don't leave the slash in nm. */
1018 else /* ~user/filename */
1020 /* Get past ~ to user */
1021 unsigned char *user
= nm
+ 1;
1022 /* Find end of name. */
1023 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1024 int len
= ptr
? ptr
- user
: strlen (user
);
1026 unsigned char *ptr1
= index (user
, ':');
1027 if (ptr1
!= 0 && ptr1
- user
< len
)
1030 /* Copy the user name into temp storage. */
1031 o
= (unsigned char *) alloca (len
+ 1);
1032 bcopy ((char *) user
, o
, len
);
1035 /* Look up the user name. */
1036 pw
= (struct passwd
*) getpwnam (o
+ 1);
1038 error ("\"%s\" isn't a registered user", o
+ 1);
1040 newdir
= (unsigned char *) pw
->pw_dir
;
1042 /* Discard the user name from NM. */
1049 #endif /* not VMS */
1053 defalt
= current_buffer
->directory
;
1054 CHECK_STRING (defalt
, 1);
1055 newdir
= XSTRING (defalt
)->data
;
1058 /* Now concatenate the directory and name to new space in the stack frame */
1060 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1061 target
= (unsigned char *) alloca (tlen
);
1067 if (nm
[0] == 0 || nm
[0] == '/')
1068 strcpy (target
, newdir
);
1071 file_name_as_directory (target
, newdir
);
1074 strcat (target
, nm
);
1076 if (index (target
, '/'))
1077 strcpy (target
, sys_translate_unix (target
));
1080 /* Now canonicalize by removing /. and /foo/.. if they appear */
1088 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1094 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1095 /* brackets are offset from each other by 2 */
1098 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1099 /* convert [foo][bar] to [bar] */
1100 while (o
[-1] != '[' && o
[-1] != '<')
1102 else if (*p
== '-' && *o
!= '.')
1105 else if (p
[0] == '-' && o
[-1] == '.' &&
1106 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1107 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1111 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1112 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1114 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1116 /* else [foo.-] ==> [-] */
1122 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1123 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1133 else if (!strncmp (p
, "//", 2)
1135 /* // at start of filename is meaningful in Apollo system */
1143 else if (p
[0] == '/' && p
[1] == '.' &&
1144 (p
[2] == '/' || p
[2] == 0))
1146 else if (!strncmp (p
, "/..", 3)
1147 /* `/../' is the "superroot" on certain file systems. */
1149 && (p
[3] == '/' || p
[3] == 0))
1151 while (o
!= target
&& *--o
!= '/')
1154 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1158 if (o
== target
&& *o
== '/')
1166 #endif /* not VMS */
1169 return make_string (target
, o
- target
);
1173 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1174 Ssubstitute_in_file_name
, 1, 1, 0,
1175 "Substitute environment variables referred to in FILENAME.\n\
1176 `$FOO' where FOO is an environment variable name means to substitute\n\
1177 the value of that variable. The variable name should be terminated\n\
1178 with a character not a letter, digit or underscore; otherwise, enclose\n\
1179 the entire variable name in braces.\n\
1180 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1181 On VMS, `$' substitution is not done; this function does little and only\n\
1182 duplicates what `expand-file-name' does.")
1188 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1189 unsigned char *target
;
1191 int substituted
= 0;
1194 CHECK_STRING (string
, 0);
1196 nm
= XSTRING (string
)->data
;
1197 endp
= nm
+ XSTRING (string
)->size
;
1199 /* If /~ or // appears, discard everything through first slash. */
1201 for (p
= nm
; p
!= endp
; p
++)
1205 /* // at start of file name is meaningful in Apollo system */
1206 (p
[0] == '/' && p
- 1 != nm
)
1207 #else /* not APOLLO */
1209 #endif /* not APOLLO */
1213 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1226 return build_string (nm
);
1229 /* See if any variables are substituted into the string
1230 and find the total length of their values in `total' */
1232 for (p
= nm
; p
!= endp
;)
1242 /* "$$" means a single "$" */
1251 while (p
!= endp
&& *p
!= '}') p
++;
1252 if (*p
!= '}') goto missingclose
;
1258 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1262 /* Copy out the variable name */
1263 target
= (unsigned char *) alloca (s
- o
+ 1);
1264 strncpy (target
, o
, s
- o
);
1267 /* Get variable value */
1268 o
= (unsigned char *) egetenv (target
);
1269 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1272 if (!o
&& !strcmp (target
, "USER"))
1273 o
= egetenv ("LOGNAME");
1276 if (!o
) goto badvar
;
1277 total
+= strlen (o
);
1284 /* If substitution required, recopy the string and do it */
1285 /* Make space in stack frame for the new copy */
1286 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1289 /* Copy the rest of the name through, replacing $ constructs with values */
1306 while (p
!= endp
&& *p
!= '}') p
++;
1307 if (*p
!= '}') goto missingclose
;
1313 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1317 /* Copy out the variable name */
1318 target
= (unsigned char *) alloca (s
- o
+ 1);
1319 strncpy (target
, o
, s
- o
);
1322 /* Get variable value */
1323 o
= (unsigned char *) egetenv (target
);
1324 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1327 if (!o
&& !strcmp (target
, "USER"))
1328 o
= egetenv ("LOGNAME");
1340 /* If /~ or // appears, discard everything through first slash. */
1342 for (p
= xnm
; p
!= x
; p
++)
1345 /* // at start of file name is meaningful in Apollo system */
1346 (p
[0] == '/' && p
- 1 != xnm
)
1347 #else /* not APOLLO */
1349 #endif /* not APOLLO */
1351 && p
!= nm
&& p
[-1] == '/')
1354 return make_string (xnm
, x
- xnm
);
1357 error ("Bad format environment-variable substitution");
1359 error ("Missing \"}\" in environment-variable substitution");
1361 error ("Substituting nonexistent environment variable \"%s\"", target
);
1364 #endif /* not VMS */
1368 expand_and_dir_to_file (filename
, defdir
)
1369 Lisp_Object filename
, defdir
;
1371 register Lisp_Object abspath
;
1373 abspath
= Fexpand_file_name (filename
, defdir
);
1376 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1377 if (c
== ':' || c
== ']' || c
== '>')
1378 abspath
= Fdirectory_file_name (abspath
);
1381 /* Remove final slash, if any (unless path is root).
1382 stat behaves differently depending! */
1383 if (XSTRING (abspath
)->size
> 1
1384 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1386 if (EQ (abspath
, filename
))
1387 abspath
= Fcopy_sequence (abspath
);
1388 XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] = 0;
1394 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1395 Lisp_Object absname
;
1396 unsigned char *querystring
;
1399 register Lisp_Object tem
;
1400 struct gcpro gcpro1
;
1402 if (access (XSTRING (absname
)->data
, 4) >= 0)
1405 Fsignal (Qfile_already_exists
,
1406 Fcons (build_string ("File already exists"),
1407 Fcons (absname
, Qnil
)));
1409 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1410 XSTRING (absname
)->data
, querystring
));
1413 Fsignal (Qfile_already_exists
,
1414 Fcons (build_string ("File already exists"),
1415 Fcons (absname
, Qnil
)));
1420 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1421 "fCopy file: \nFCopy %s to file: \np\nP",
1422 "Copy FILE to NEWNAME. Both args must be strings.\n\
1423 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1424 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1425 A number as third arg means request confirmation if NEWNAME already exists.\n\
1426 This is what happens in interactive use with M-x.\n\
1427 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1428 last-modified time as the old one. (This works on only some systems.)\n\
1429 A prefix arg makes KEEP-TIME non-nil.")
1430 (filename
, newname
, ok_if_already_exists
, keep_date
)
1431 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1434 char buf
[16 * 1024];
1436 Lisp_Object handler
;
1437 struct gcpro gcpro1
, gcpro2
;
1438 int count
= specpdl_ptr
- specpdl
;
1440 GCPRO2 (filename
, newname
);
1441 CHECK_STRING (filename
, 0);
1442 CHECK_STRING (newname
, 1);
1443 filename
= Fexpand_file_name (filename
, Qnil
);
1444 newname
= Fexpand_file_name (newname
, Qnil
);
1446 /* If the file name has special constructs in it,
1447 call the corresponding file handler. */
1448 handler
= find_file_handler (filename
);
1449 if (!NILP (handler
))
1450 return call3 (handler
, Qcopy_file
, filename
, newname
);
1452 if (NILP (ok_if_already_exists
)
1453 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1454 barf_or_query_if_file_exists (newname
, "copy to it",
1455 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1457 ifd
= open (XSTRING (filename
)->data
, 0);
1459 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1461 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1464 /* Create the copy file with the same record format as the input file */
1465 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1467 ofd
= creat (XSTRING (newname
)->data
, 0666);
1470 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1472 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1476 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1477 if (write (ofd
, buf
, n
) != n
)
1478 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1481 if (fstat (ifd
, &st
) >= 0)
1483 if (!NILP (keep_date
))
1485 EMACS_TIME atime
, mtime
;
1486 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1487 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1488 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1491 if (!egetenv ("USE_DOMAIN_ACLS"))
1493 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1496 /* Discard the unwind protects. */
1497 specpdl_ptr
= specpdl
+ count
;
1500 if (close (ofd
) < 0)
1501 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1507 DEFUN ("make-directory", Fmake_directory
, Smake_directory
, 1, 1, "FMake directory: ",
1508 "Create a directory. One argument, a file name string.")
1510 Lisp_Object dirname
;
1513 Lisp_Object handler
;
1515 CHECK_STRING (dirname
, 0);
1516 dirname
= Fexpand_file_name (dirname
, Qnil
);
1518 handler
= find_file_handler (dirname
);
1519 if (!NILP (handler
))
1520 return call2 (handler
, Qmake_directory
, dirname
);
1522 dir
= XSTRING (dirname
)->data
;
1524 if (mkdir (dir
, 0777) != 0)
1525 report_file_error ("Creating directory", Flist (1, &dirname
));
1530 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1531 "Delete a directory. One argument, a file name string.")
1533 Lisp_Object dirname
;
1536 Lisp_Object handler
;
1538 CHECK_STRING (dirname
, 0);
1539 dirname
= Fexpand_file_name (dirname
, Qnil
);
1540 dir
= XSTRING (dirname
)->data
;
1542 handler
= find_file_handler (dirname
);
1543 if (!NILP (handler
))
1544 return call2 (handler
, Qdelete_directory
, dirname
);
1546 if (rmdir (dir
) != 0)
1547 report_file_error ("Removing directory", Flist (1, &dirname
));
1552 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1553 "Delete specified file. One argument, a file name string.\n\
1554 If file has multiple names, it continues to exist with the other names.")
1556 Lisp_Object filename
;
1558 Lisp_Object handler
;
1559 CHECK_STRING (filename
, 0);
1560 filename
= Fexpand_file_name (filename
, Qnil
);
1562 handler
= find_file_handler (filename
);
1563 if (!NILP (handler
))
1564 return call2 (handler
, Qdelete_file
, filename
);
1566 if (0 > unlink (XSTRING (filename
)->data
))
1567 report_file_error ("Removing old name", Flist (1, &filename
));
1571 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1572 "fRename file: \nFRename %s to file: \np",
1573 "Rename FILE as NEWNAME. Both args strings.\n\
1574 If file has names other than FILE, it continues to have those names.\n\
1575 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1576 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1577 A number as third arg means request confirmation if NEWNAME already exists.\n\
1578 This is what happens in interactive use with M-x.")
1579 (filename
, newname
, ok_if_already_exists
)
1580 Lisp_Object filename
, newname
, ok_if_already_exists
;
1583 Lisp_Object args
[2];
1585 Lisp_Object handler
;
1586 struct gcpro gcpro1
, gcpro2
;
1588 GCPRO2 (filename
, newname
);
1589 CHECK_STRING (filename
, 0);
1590 CHECK_STRING (newname
, 1);
1591 filename
= Fexpand_file_name (filename
, Qnil
);
1592 newname
= Fexpand_file_name (newname
, Qnil
);
1594 /* If the file name has special constructs in it,
1595 call the corresponding file handler. */
1596 handler
= find_file_handler (filename
);
1597 if (!NILP (handler
))
1598 return call3 (handler
, Qrename_file
, filename
, newname
);
1600 if (NILP (ok_if_already_exists
)
1601 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1602 barf_or_query_if_file_exists (newname
, "rename to it",
1603 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1605 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1607 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1608 || 0 > unlink (XSTRING (filename
)->data
))
1613 Fcopy_file (filename
, newname
, ok_if_already_exists
, Qt
);
1614 Fdelete_file (filename
);
1621 report_file_error ("Renaming", Flist (2, args
));
1624 report_file_error ("Renaming", Flist (2, &filename
));
1631 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1632 "fAdd name to file: \nFName to add to %s: \np",
1633 "Give FILE additional name NEWNAME. Both args strings.\n\
1634 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1635 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1636 A number as third arg means request confirmation if NEWNAME already exists.\n\
1637 This is what happens in interactive use with M-x.")
1638 (filename
, newname
, ok_if_already_exists
)
1639 Lisp_Object filename
, newname
, ok_if_already_exists
;
1642 Lisp_Object args
[2];
1644 Lisp_Object handler
;
1645 struct gcpro gcpro1
, gcpro2
;
1647 GCPRO2 (filename
, newname
);
1648 CHECK_STRING (filename
, 0);
1649 CHECK_STRING (newname
, 1);
1650 filename
= Fexpand_file_name (filename
, Qnil
);
1651 newname
= Fexpand_file_name (newname
, Qnil
);
1653 /* If the file name has special constructs in it,
1654 call the corresponding file handler. */
1655 handler
= find_file_handler (filename
);
1656 if (!NILP (handler
))
1657 return call3 (handler
, Qadd_name_to_file
, filename
, newname
);
1659 if (NILP (ok_if_already_exists
)
1660 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1661 barf_or_query_if_file_exists (newname
, "make it a new name",
1662 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1663 unlink (XSTRING (newname
)->data
);
1664 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1669 report_file_error ("Adding new name", Flist (2, args
));
1671 report_file_error ("Adding new name", Flist (2, &filename
));
1680 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1681 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1682 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1683 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1684 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1685 A number as third arg means request confirmation if NEWNAME already exists.\n\
1686 This happens for interactive use with M-x.")
1687 (filename
, linkname
, ok_if_already_exists
)
1688 Lisp_Object filename
, linkname
, ok_if_already_exists
;
1691 Lisp_Object args
[2];
1693 Lisp_Object handler
;
1694 struct gcpro gcpro1
, gcpro2
;
1696 GCPRO2 (filename
, linkname
);
1697 CHECK_STRING (filename
, 0);
1698 CHECK_STRING (linkname
, 1);
1699 #if 0 /* This made it impossible to make a link to a relative name. */
1700 filename
= Fexpand_file_name (filename
, Qnil
);
1702 linkname
= Fexpand_file_name (linkname
, Qnil
);
1704 /* If the file name has special constructs in it,
1705 call the corresponding file handler. */
1706 handler
= find_file_handler (filename
);
1707 if (!NILP (handler
))
1708 return call3 (handler
, Qmake_symbolic_link
, filename
, linkname
);
1710 if (NILP (ok_if_already_exists
)
1711 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1712 barf_or_query_if_file_exists (linkname
, "make it a link",
1713 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1714 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1716 /* If we didn't complain already, silently delete existing file. */
1717 if (errno
== EEXIST
)
1719 unlink (XSTRING (filename
)->data
);
1720 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1727 report_file_error ("Making symbolic link", Flist (2, args
));
1729 report_file_error ("Making symbolic link", Flist (2, &filename
));
1735 #endif /* S_IFLNK */
1739 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
1740 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1741 "Define the job-wide logical name NAME to have the value STRING.\n\
1742 If STRING is nil or a null string, the logical name NAME is deleted.")
1744 Lisp_Object varname
;
1747 CHECK_STRING (varname
, 0);
1749 delete_logical_name (XSTRING (varname
)->data
);
1752 CHECK_STRING (string
, 1);
1754 if (XSTRING (string
)->size
== 0)
1755 delete_logical_name (XSTRING (varname
)->data
);
1757 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
1766 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
1767 "Open a network connection to PATH using LOGIN as the login string.")
1769 Lisp_Object path
, login
;
1773 CHECK_STRING (path
, 0);
1774 CHECK_STRING (login
, 0);
1776 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
1778 if (netresult
== -1)
1783 #endif /* HPUX_NET */
1785 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
1787 "Return t if file FILENAME specifies an absolute path name.\n\
1788 On Unix, this is a name starting with a `/' or a `~'.")
1790 Lisp_Object filename
;
1794 CHECK_STRING (filename
, 0);
1795 ptr
= XSTRING (filename
)->data
;
1796 if (*ptr
== '/' || *ptr
== '~'
1798 /* ??? This criterion is probably wrong for '<'. */
1799 || index (ptr
, ':') || index (ptr
, '<')
1800 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
1809 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
1810 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1811 See also `file-readable-p' and `file-attributes'.")
1813 Lisp_Object filename
;
1815 Lisp_Object abspath
;
1816 Lisp_Object handler
;
1818 CHECK_STRING (filename
, 0);
1819 abspath
= Fexpand_file_name (filename
, Qnil
);
1821 /* If the file name has special constructs in it,
1822 call the corresponding file handler. */
1823 handler
= find_file_handler (filename
);
1824 if (!NILP (handler
))
1825 return call2 (handler
, Qfile_exists_p
, filename
);
1827 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
1830 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
1831 "Return t if FILENAME can be executed by you.\n\
1832 For directories this means you can change to that directory.")
1834 Lisp_Object filename
;
1837 Lisp_Object abspath
;
1838 Lisp_Object handler
;
1840 CHECK_STRING (filename
, 0);
1841 abspath
= Fexpand_file_name (filename
, Qnil
);
1843 /* If the file name has special constructs in it,
1844 call the corresponding file handler. */
1845 handler
= find_file_handler (filename
);
1846 if (!NILP (handler
))
1847 return call2 (handler
, Qfile_executable_p
, filename
);
1849 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
1852 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
1853 "Return t if file FILENAME exists and you can read it.\n\
1854 See also `file-exists-p' and `file-attributes'.")
1856 Lisp_Object filename
;
1858 Lisp_Object abspath
;
1859 Lisp_Object handler
;
1861 CHECK_STRING (filename
, 0);
1862 abspath
= Fexpand_file_name (filename
, Qnil
);
1864 /* If the file name has special constructs in it,
1865 call the corresponding file handler. */
1866 handler
= find_file_handler (filename
);
1867 if (!NILP (handler
))
1868 return call2 (handler
, Qfile_readable_p
, filename
);
1870 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
1873 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
1874 "If file FILENAME is the name of a symbolic link\n\
1875 returns the name of the file to which it is linked.\n\
1876 Otherwise returns NIL.")
1878 Lisp_Object filename
;
1885 Lisp_Object handler
;
1887 CHECK_STRING (filename
, 0);
1888 filename
= Fexpand_file_name (filename
, Qnil
);
1890 /* If the file name has special constructs in it,
1891 call the corresponding file handler. */
1892 handler
= find_file_handler (filename
);
1893 if (!NILP (handler
))
1894 return call2 (handler
, Qfile_symlink_p
, filename
);
1899 buf
= (char *) xmalloc (bufsize
);
1900 bzero (buf
, bufsize
);
1901 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
1902 if (valsize
< bufsize
) break;
1903 /* Buffer was not long enough */
1912 val
= make_string (buf
, valsize
);
1915 #else /* not S_IFLNK */
1917 #endif /* not S_IFLNK */
1920 /* Having this before file-symlink-p mysteriously caused it to be forgotten
1922 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
1923 "Return t if file FILENAME can be written or created by you.")
1925 Lisp_Object filename
;
1927 Lisp_Object abspath
, dir
;
1928 Lisp_Object handler
;
1930 CHECK_STRING (filename
, 0);
1931 abspath
= Fexpand_file_name (filename
, Qnil
);
1933 /* If the file name has special constructs in it,
1934 call the corresponding file handler. */
1935 handler
= find_file_handler (filename
);
1936 if (!NILP (handler
))
1937 return call2 (handler
, Qfile_writable_p
, filename
);
1939 if (access (XSTRING (abspath
)->data
, 0) >= 0)
1940 return (access (XSTRING (abspath
)->data
, 2) >= 0) ? Qt
: Qnil
;
1941 dir
= Ffile_name_directory (abspath
);
1944 dir
= Fdirectory_file_name (dir
);
1946 return (access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
1950 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
1951 "Return t if file FILENAME is the name of a directory as a file.\n\
1952 A directory name spec may be given instead; then the value is t\n\
1953 if the directory so specified exists and really is a directory.")
1955 Lisp_Object filename
;
1957 register Lisp_Object abspath
;
1959 Lisp_Object handler
;
1961 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
1963 /* If the file name has special constructs in it,
1964 call the corresponding file handler. */
1965 handler
= find_file_handler (filename
);
1966 if (!NILP (handler
))
1967 return call2 (handler
, Qfile_directory_p
, filename
);
1969 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1971 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
1974 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
1975 "Return t if file FILENAME is the name of a directory as a file,\n\
1976 and files in that directory can be opened by you. In order to use a\n\
1977 directory as a buffer's current directory, this predicate must return true.\n\
1978 A directory name spec may be given instead; then the value is t\n\
1979 if the directory so specified exists and really is a readable and\n\
1980 searchable directory.")
1982 Lisp_Object filename
;
1984 Lisp_Object handler
;
1986 /* If the file name has special constructs in it,
1987 call the corresponding file handler. */
1988 handler
= find_file_handler (filename
);
1989 if (!NILP (handler
))
1990 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
1992 if (NILP (Ffile_directory_p (filename
))
1993 || NILP (Ffile_executable_p (filename
)))
1999 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2000 "Return mode bits of FILE, as an integer.")
2002 Lisp_Object filename
;
2004 Lisp_Object abspath
;
2006 Lisp_Object handler
;
2008 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2010 /* If the file name has special constructs in it,
2011 call the corresponding file handler. */
2012 handler
= find_file_handler (filename
);
2013 if (!NILP (handler
))
2014 return call2 (handler
, Qfile_modes
, filename
);
2016 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2018 return make_number (st
.st_mode
& 07777);
2021 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2022 "Set mode bits of FILE to MODE (an integer).\n\
2023 Only the 12 low bits of MODE are used.")
2025 Lisp_Object filename
, mode
;
2027 Lisp_Object abspath
;
2028 Lisp_Object handler
;
2030 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2031 CHECK_NUMBER (mode
, 1);
2033 /* If the file name has special constructs in it,
2034 call the corresponding file handler. */
2035 handler
= find_file_handler (filename
);
2036 if (!NILP (handler
))
2037 return call3 (handler
, Qset_file_modes
, filename
, mode
);
2040 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2041 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2043 if (!egetenv ("USE_DOMAIN_ACLS"))
2046 struct timeval tvp
[2];
2048 /* chmod on apollo also change the file's modtime; need to save the
2049 modtime and then restore it. */
2050 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2052 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2056 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2057 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2059 /* reset the old accessed and modified times. */
2060 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2062 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2065 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2066 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2073 DEFUN ("set-umask", Fset_umask
, Sset_umask
, 1, 1, 0,
2074 "Select which permission bits to disable in newly created files.\n\
2075 MASK should be an integer; if a permission's bit in MASK is 1,\n\
2076 subsequently created files will not have that permission enabled.\n\
2077 Only the low 9 bits are used.\n\
2078 This setting is inherited by subprocesses.")
2082 CHECK_NUMBER (mask
, 0);
2084 umask (XINT (mask
) & 0777);
2089 DEFUN ("umask", Fumask
, Sumask
, 0, 0, 0,
2090 "Return the current umask value.\n\
2091 The umask value determines which permissions are enabled in newly\n\
2092 created files. If a permission's bit in the umask is 1, subsequently\n\
2093 created files will not have that permission enabled.")
2098 XSET (mask
, Lisp_Int
, umask (0));
2099 umask (XINT (mask
));
2106 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2107 "Tell Unix to finish all pending disk updates.")
2116 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2117 "Return t if file FILE1 is newer than file FILE2.\n\
2118 If FILE1 does not exist, the answer is nil;\n\
2119 otherwise, if FILE2 does not exist, the answer is t.")
2121 Lisp_Object file1
, file2
;
2123 Lisp_Object abspath1
, abspath2
;
2126 Lisp_Object handler
;
2128 CHECK_STRING (file1
, 0);
2129 CHECK_STRING (file2
, 0);
2131 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2132 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2134 /* If the file name has special constructs in it,
2135 call the corresponding file handler. */
2136 handler
= find_file_handler (abspath1
);
2137 if (!NILP (handler
))
2138 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2140 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2143 mtime1
= st
.st_mtime
;
2145 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2148 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2151 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2153 "Insert contents of file FILENAME after point.\n\
2154 Returns list of absolute pathname and length of data inserted.\n\
2155 If second argument VISIT is non-nil, the buffer's visited filename\n\
2156 and last save file modtime are set, and it is marked unmodified.\n\
2157 If visiting and the file does not exist, visiting is completed\n\
2158 before the error is signaled.")
2160 Lisp_Object filename
, visit
;
2164 register int inserted
= 0;
2165 register int how_much
;
2166 int count
= specpdl_ptr
- specpdl
;
2167 struct gcpro gcpro1
;
2168 Lisp_Object handler
, val
;
2173 if (!NILP (current_buffer
->read_only
))
2174 Fbarf_if_buffer_read_only();
2176 CHECK_STRING (filename
, 0);
2177 filename
= Fexpand_file_name (filename
, Qnil
);
2179 /* If the file name has special constructs in it,
2180 call the corresponding file handler. */
2181 handler
= find_file_handler (filename
);
2182 if (!NILP (handler
))
2184 val
= call3 (handler
, Qinsert_file_contents
, filename
, visit
);
2192 if (stat (XSTRING (filename
)->data
, &st
) < 0
2193 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2195 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2196 || fstat (fd
, &st
) < 0)
2197 #endif /* not APOLLO */
2199 if (fd
>= 0) close (fd
);
2201 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2207 record_unwind_protect (close_file_unwind
, make_number (fd
));
2210 /* This code will need to be changed in order to work on named
2211 pipes, and it's probably just not worth it. So we should at
2212 least signal an error. */
2213 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2214 Fsignal (Qfile_error
,
2215 Fcons (build_string ("reading from named pipe"),
2216 Fcons (filename
, Qnil
)));
2219 /* Supposedly happens on VMS. */
2221 error ("File size is negative");
2224 register Lisp_Object temp
;
2226 /* Make sure point-max won't overflow after this insertion. */
2227 XSET (temp
, Lisp_Int
, st
.st_size
+ Z
);
2228 if (st
.st_size
+ Z
!= XINT (temp
))
2229 error ("maximum buffer size exceeded");
2233 prepare_to_modify_buffer (point
, point
);
2236 if (GAP_SIZE
< st
.st_size
)
2237 make_gap (st
.st_size
- GAP_SIZE
);
2241 int try = min (st
.st_size
- inserted
, 64 << 10);
2244 /* Allow quitting out of the actual I/O. */
2247 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2265 record_insert (point
, inserted
);
2269 /* Discard the unwind protect */
2270 specpdl_ptr
= specpdl
+ count
;
2273 error ("IO error reading %s: %s",
2274 XSTRING (filename
)->data
, err_str (errno
));
2281 current_buffer
->undo_list
= Qnil
;
2283 stat (XSTRING (filename
)->data
, &st
);
2285 current_buffer
->modtime
= st
.st_mtime
;
2286 current_buffer
->save_modified
= MODIFF
;
2287 current_buffer
->auto_save_modified
= MODIFF
;
2288 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2289 #ifdef CLASH_DETECTION
2292 if (!NILP (current_buffer
->filename
))
2293 unlock_file (current_buffer
->filename
);
2294 unlock_file (filename
);
2296 #endif /* CLASH_DETECTION */
2297 current_buffer
->filename
= filename
;
2298 /* If visiting nonexistent file, return nil. */
2299 if (current_buffer
->modtime
== -1)
2300 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2303 signal_after_change (point
, 0, inserted
);
2306 RETURN_UNGCPRO (val
);
2307 RETURN_UNGCPRO (Fcons (filename
,
2308 Fcons (make_number (inserted
),
2312 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2313 "r\nFWrite region to file: ",
2314 "Write current region into specified file.\n\
2315 When called from a program, takes three arguments:\n\
2316 START, END and FILENAME. START and END are buffer positions.\n\
2317 Optional fourth argument APPEND if non-nil means\n\
2318 append to existing file contents (if any).\n\
2319 Optional fifth argument VISIT if t means\n\
2320 set the last-save-file-modtime of buffer to this file's modtime\n\
2321 and mark buffer not modified.\n\
2322 If VISIT is neither t nor nil, it means do not print\n\
2323 the \"Wrote file\" message.\n\
2324 Kludgy feature: if START is a string, then that string is written\n\
2325 to the file, instead of any buffer contents, and END is ignored.")
2326 (start
, end
, filename
, append
, visit
)
2327 Lisp_Object start
, end
, filename
, append
, visit
;
2335 int count
= specpdl_ptr
- specpdl
;
2337 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2339 Lisp_Object handler
;
2341 /* Special kludge to simplify auto-saving */
2344 XFASTINT (start
) = BEG
;
2347 else if (XTYPE (start
) != Lisp_String
)
2348 validate_region (&start
, &end
);
2350 filename
= Fexpand_file_name (filename
, Qnil
);
2351 fn
= XSTRING (filename
)->data
;
2353 /* If the file name has special constructs in it,
2354 call the corresponding file handler. */
2355 handler
= find_file_handler (filename
);
2357 if (!NILP (handler
))
2359 Lisp_Object args
[7];
2362 args
[1] = Qwrite_region
;
2368 val
= Ffuncall (7, args
);
2370 /* Do this before reporting IO error
2371 to avoid a "file has changed on disk" warning on
2372 next attempt to save. */
2375 current_buffer
->modtime
= 0;
2376 current_buffer
->save_modified
= MODIFF
;
2377 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2378 current_buffer
->filename
= filename
;
2383 #ifdef CLASH_DETECTION
2385 lock_file (filename
);
2386 #endif /* CLASH_DETECTION */
2390 desc
= open (fn
, O_WRONLY
);
2394 if (auto_saving
) /* Overwrite any previous version of autosave file */
2396 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2397 desc
= open (fn
, O_RDWR
);
2399 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2400 ? XSTRING (current_buffer
->filename
)->data
: 0,
2403 else /* Write to temporary name and rename if no errors */
2405 Lisp_Object temp_name
;
2406 temp_name
= Ffile_name_directory (filename
);
2408 if (!NILP (temp_name
))
2410 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2411 build_string ("$$SAVE$$")));
2412 fname
= XSTRING (filename
)->data
;
2413 fn
= XSTRING (temp_name
)->data
;
2414 desc
= creat_copy_attrs (fname
, fn
);
2417 /* If we can't open the temporary file, try creating a new
2418 version of the original file. VMS "creat" creates a
2419 new version rather than truncating an existing file. */
2422 desc
= creat (fn
, 0666);
2423 #if 0 /* This can clobber an existing file and fail to replace it,
2424 if the user runs out of space. */
2427 /* We can't make a new version;
2428 try to truncate and rewrite existing version if any. */
2430 desc
= open (fn
, O_RDWR
);
2436 desc
= creat (fn
, 0666);
2439 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2440 #endif /* not VMS */
2444 #ifdef CLASH_DETECTION
2446 if (!auto_saving
) unlock_file (filename
);
2448 #endif /* CLASH_DETECTION */
2449 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2452 record_unwind_protect (close_file_unwind
, make_number (desc
));
2455 if (lseek (desc
, 0, 2) < 0)
2457 #ifdef CLASH_DETECTION
2458 if (!auto_saving
) unlock_file (filename
);
2459 #endif /* CLASH_DETECTION */
2460 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2465 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2466 * if we do writes that don't end with a carriage return. Furthermore
2467 * it cannot handle writes of more then 16K. The modified
2468 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2469 * this EXCEPT for the last record (iff it doesn't end with a carriage
2470 * return). This implies that if your buffer doesn't end with a carriage
2471 * return, you get one free... tough. However it also means that if
2472 * we make two calls to sys_write (a la the following code) you can
2473 * get one at the gap as well. The easiest way to fix this (honest)
2474 * is to move the gap to the next newline (or the end of the buffer).
2479 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2480 move_gap (find_next_newline (GPT
, 1));
2486 if (XTYPE (start
) == Lisp_String
)
2488 failure
= 0 > e_write (desc
, XSTRING (start
)->data
,
2489 XSTRING (start
)->size
);
2492 else if (XINT (start
) != XINT (end
))
2494 if (XINT (start
) < GPT
)
2496 register int end1
= XINT (end
);
2498 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
),
2499 min (GPT
, end1
) - tem
);
2503 if (XINT (end
) > GPT
&& !failure
)
2506 tem
= max (tem
, GPT
);
2507 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
);
2517 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2518 Disk full in NFS may be reported here. */
2519 if (fsync (desc
) < 0)
2520 failure
= 1, save_errno
= errno
;
2525 /* Spurious "file has changed on disk" warnings have been
2526 observed on Suns as well.
2527 It seems that `close' can change the modtime, under nfs.
2529 (This has supposedly been fixed in Sunos 4,
2530 but who knows about all the other machines with NFS?) */
2533 /* On VMS and APOLLO, must do the stat after the close
2534 since closing changes the modtime. */
2537 /* Recall that #if defined does not work on VMS. */
2544 /* NFS can report a write failure now. */
2545 if (close (desc
) < 0)
2546 failure
= 1, save_errno
= errno
;
2549 /* If we wrote to a temporary name and had no errors, rename to real name. */
2553 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2561 /* Discard the unwind protect */
2562 specpdl_ptr
= specpdl
+ count
;
2564 #ifdef CLASH_DETECTION
2566 unlock_file (filename
);
2567 #endif /* CLASH_DETECTION */
2569 /* Do this before reporting IO error
2570 to avoid a "file has changed on disk" warning on
2571 next attempt to save. */
2573 current_buffer
->modtime
= st
.st_mtime
;
2576 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2580 current_buffer
->save_modified
= MODIFF
;
2581 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2582 current_buffer
->filename
= filename
;
2584 else if (!NILP (visit
))
2588 message ("Wrote %s", fn
);
2594 e_write (desc
, addr
, len
)
2596 register char *addr
;
2599 char buf
[16 * 1024];
2600 register char *p
, *end
;
2602 if (!EQ (current_buffer
->selective_display
, Qt
))
2603 return write (desc
, addr
, len
) - len
;
2607 end
= p
+ sizeof buf
;
2612 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
2621 if (write (desc
, buf
, p
- buf
) != p
- buf
)
2627 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
2628 Sverify_visited_file_modtime
, 1, 1, 0,
2629 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2630 This means that the file has not been changed since it was visited or saved.")
2636 Lisp_Object handler
;
2638 CHECK_BUFFER (buf
, 0);
2641 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
2642 if (b
->modtime
== 0) return Qt
;
2644 /* If the file name has special constructs in it,
2645 call the corresponding file handler. */
2646 handler
= find_file_handler (b
->filename
);
2647 if (!NILP (handler
))
2648 return call2 (handler
, Qverify_visited_file_modtime
, b
->filename
);
2650 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
2652 /* If the file doesn't exist now and didn't exist before,
2653 we say that it isn't modified, provided the error is a tame one. */
2654 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
2659 if (st
.st_mtime
== b
->modtime
2660 /* If both are positive, accept them if they are off by one second. */
2661 || (st
.st_mtime
> 0 && b
->modtime
> 0
2662 && (st
.st_mtime
== b
->modtime
+ 1
2663 || st
.st_mtime
== b
->modtime
- 1)))
2668 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
2669 Sclear_visited_file_modtime
, 0, 0, 0,
2670 "Clear out records of last mod time of visited file.\n\
2671 Next attempt to save will certainly not complain of a discrepancy.")
2674 current_buffer
->modtime
= 0;
2678 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
2679 Sset_visited_file_modtime
, 0, 0, 0,
2680 "Update buffer's recorded modification time from the visited file's time.\n\
2681 Useful if the buffer was not read from the file normally\n\
2682 or if the file itself has been changed for some known benign reason.")
2685 register Lisp_Object filename
;
2687 Lisp_Object handler
;
2689 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
2691 /* If the file name has special constructs in it,
2692 call the corresponding file handler. */
2693 handler
= find_file_handler (filename
);
2694 if (!NILP (handler
))
2695 current_buffer
->modtime
= 0;
2697 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
2698 current_buffer
->modtime
= st
.st_mtime
;
2706 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
2709 message ("Autosaving...error for %s", name
);
2710 Fsleep_for (make_number (1), Qnil
);
2711 message ("Autosaving...error!for %s", name
);
2712 Fsleep_for (make_number (1), Qnil
);
2713 message ("Autosaving...error for %s", name
);
2714 Fsleep_for (make_number (1), Qnil
);
2724 /* Get visited file's mode to become the auto save file's mode. */
2725 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
2726 /* But make sure we can overwrite it later! */
2727 auto_save_mode_bits
= st
.st_mode
| 0600;
2729 auto_save_mode_bits
= 0666;
2732 Fwrite_region (Qnil
, Qnil
,
2733 current_buffer
->auto_save_file_name
,
2737 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
2738 "Auto-save all buffers that need it.\n\
2739 This is all buffers that have auto-saving enabled\n\
2740 and are changed since last auto-saved.\n\
2741 Auto-saving writes the buffer into a file\n\
2742 so that your editing is not lost if the system crashes.\n\
2743 This file is not the file you visited; that changes only when you save.\n\n\
2744 Non-nil first argument means do not print any message if successful.\n\
2745 Non-nil second argument means save only current buffer.")
2749 struct buffer
*old
= current_buffer
, *b
;
2750 Lisp_Object tail
, buf
;
2752 char *omessage
= echo_area_glyphs
;
2753 extern minibuf_level
;
2755 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2756 point to non-strings reached from Vbuffer_alist. */
2762 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2763 eventually call do-auto-save, so don't err here in that case. */
2764 if (!NILP (Vrun_hooks
))
2765 call1 (Vrun_hooks
, intern ("auto-save-hook"));
2767 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2768 tail
= XCONS (tail
)->cdr
)
2770 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
2772 /* Check for auto save enabled
2773 and file changed since last auto save
2774 and file changed since last real save. */
2775 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
2776 && b
->save_modified
< BUF_MODIFF (b
)
2777 && b
->auto_save_modified
< BUF_MODIFF (b
))
2779 if ((XFASTINT (b
->save_length
) * 10
2780 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
2781 /* A short file is likely to change a large fraction;
2782 spare the user annoying messages. */
2783 && XFASTINT (b
->save_length
) > 5000
2784 /* These messages are frequent and annoying for `*mail*'. */
2785 && !EQ (b
->filename
, Qnil
))
2787 /* It has shrunk too much; turn off auto-saving here. */
2788 message ("Buffer %s has shrunk a lot; auto save turned off there",
2789 XSTRING (b
->name
)->data
);
2790 /* User can reenable saving with M-x auto-save. */
2791 b
->auto_save_file_name
= Qnil
;
2792 /* Prevent warning from repeating if user does so. */
2793 XFASTINT (b
->save_length
) = 0;
2794 Fsleep_for (make_number (1));
2797 set_buffer_internal (b
);
2798 if (!auto_saved
&& NILP (nomsg
))
2799 message1 ("Auto-saving...");
2800 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
2802 b
->auto_save_modified
= BUF_MODIFF (b
);
2803 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2804 set_buffer_internal (old
);
2809 record_auto_save ();
2811 if (auto_saved
&& NILP (nomsg
))
2812 message1 (omessage
? omessage
: "Auto-saving...done");
2818 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
2819 Sset_buffer_auto_saved
, 0, 0, 0,
2820 "Mark current buffer as auto-saved with its current text.\n\
2821 No auto-save file will be written until the buffer changes again.")
2824 current_buffer
->auto_save_modified
= MODIFF
;
2825 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2829 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
2831 "Return t if buffer has been auto-saved since last read in or saved.")
2834 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
2837 /* Reading and completing file names */
2838 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
2840 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
2842 "Internal subroutine for read-file-name. Do not call this.")
2843 (string
, dir
, action
)
2844 Lisp_Object string
, dir
, action
;
2845 /* action is nil for complete, t for return list of completions,
2846 lambda for verify final value */
2848 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
2850 if (XSTRING (string
)->size
== 0)
2855 if (EQ (action
, Qlambda
))
2860 orig_string
= string
;
2861 string
= Fsubstitute_in_file_name (string
);
2862 name
= Ffile_name_nondirectory (string
);
2863 realdir
= Ffile_name_directory (string
);
2867 realdir
= Fexpand_file_name (realdir
, dir
);
2872 specdir
= Ffile_name_directory (string
);
2873 val
= Ffile_name_completion (name
, realdir
);
2874 if (XTYPE (val
) != Lisp_String
)
2876 if (NILP (Fstring_equal (string
, orig_string
)))
2881 if (!NILP (specdir
))
2882 val
= concat2 (specdir
, val
);
2885 register unsigned char *old
, *new;
2889 osize
= XSTRING (val
)->size
;
2890 /* Quote "$" as "$$" to get it past substitute-in-file-name */
2891 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
2892 if (*old
++ == '$') count
++;
2895 old
= XSTRING (val
)->data
;
2896 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
2897 new = XSTRING (val
)->data
;
2898 for (n
= osize
; n
> 0; n
--)
2909 #endif /* Not VMS */
2913 if (EQ (action
, Qt
))
2914 return Ffile_name_all_completions (name
, realdir
);
2915 /* Only other case actually used is ACTION = lambda */
2917 /* Supposedly this helps commands such as `cd' that read directory names,
2918 but can someone explain how it helps them? -- RMS */
2919 if (XSTRING (name
)->size
== 0)
2922 return Ffile_exists_p (string
);
2925 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
2926 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
2927 Value is not expanded---you must call `expand-file-name' yourself.\n\
2928 Default name to DEFAULT if user enters a null string.\n\
2929 (If DEFAULT is omitted, the visited file name is used.)\n\
2930 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
2931 Non-nil and non-t means also require confirmation after completion.\n\
2932 Fifth arg INITIAL specifies text to start with.\n\
2933 DIR defaults to current buffer's directory default.")
2934 (prompt
, dir
, defalt
, mustmatch
, initial
)
2935 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
2937 Lisp_Object val
, insdef
, tem
, backup_n
;
2938 struct gcpro gcpro1
, gcpro2
;
2939 register char *homedir
;
2943 dir
= current_buffer
->directory
;
2945 defalt
= current_buffer
->filename
;
2947 /* If dir starts with user's homedir, change that to ~. */
2948 homedir
= (char *) egetenv ("HOME");
2950 && XTYPE (dir
) == Lisp_String
2951 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
2952 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
2954 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
2955 XSTRING (dir
)->size
- strlen (homedir
) + 1);
2956 XSTRING (dir
)->data
[0] = '~';
2959 if (insert_default_directory
)
2962 if (!NILP (initial
))
2964 Lisp_Object args
[2];
2968 insdef
= Fconcat (2, args
);
2969 backup_n
= make_number (- (XSTRING (initial
)->size
));
2976 insdef
= build_string ("");
2981 count
= specpdl_ptr
- specpdl
;
2982 specbind (intern ("completion-ignore-case"), Qt
);
2985 GCPRO2 (insdef
, defalt
);
2986 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
2988 insert_default_directory
? insdef
: Qnil
, backup_n
);
2991 unbind_to (count
, Qnil
);
2996 error ("No file name specified");
2997 tem
= Fstring_equal (val
, insdef
);
2998 if (!NILP (tem
) && !NILP (defalt
))
3000 return Fsubstitute_in_file_name (val
);
3003 #if 0 /* Old version */
3004 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3005 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3006 Value is not expanded---you must call `expand-file-name' yourself.\n\
3007 Default name to DEFAULT if user enters a null string.\n\
3008 (If DEFAULT is omitted, the visited file name is used.)\n\
3009 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3010 Non-nil and non-t means also require confirmation after completion.\n\
3011 Fifth arg INITIAL specifies text to start with.\n\
3012 DIR defaults to current buffer's directory default.")
3013 (prompt
, dir
, defalt
, mustmatch
, initial
)
3014 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3016 Lisp_Object val
, insdef
, tem
;
3017 struct gcpro gcpro1
, gcpro2
;
3018 register char *homedir
;
3022 dir
= current_buffer
->directory
;
3024 defalt
= current_buffer
->filename
;
3026 /* If dir starts with user's homedir, change that to ~. */
3027 homedir
= (char *) egetenv ("HOME");
3029 && XTYPE (dir
) == Lisp_String
3030 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3031 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3033 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3034 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3035 XSTRING (dir
)->data
[0] = '~';
3038 if (!NILP (initial
))
3040 else if (insert_default_directory
)
3043 insdef
= build_string ("");
3046 count
= specpdl_ptr
- specpdl
;
3047 specbind (intern ("completion-ignore-case"), Qt
);
3050 GCPRO2 (insdef
, defalt
);
3051 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3053 insert_default_directory
? insdef
: Qnil
, Qnil
);
3056 unbind_to (count
, Qnil
);
3061 error ("No file name specified");
3062 tem
= Fstring_equal (val
, insdef
);
3063 if (!NILP (tem
) && !NILP (defalt
))
3065 return Fsubstitute_in_file_name (val
);
3067 #endif /* Old version */
3071 Qcopy_file
= intern ("copy-file");
3072 Qmake_directory
= intern ("make-directory");
3073 Qdelete_directory
= intern ("delete-directory");
3074 Qdelete_file
= intern ("delete-file");
3075 Qrename_file
= intern ("rename-file");
3076 Qadd_name_to_file
= intern ("add-name-to-file");
3077 Qmake_symbolic_link
= intern ("make-symbolic-link");
3078 Qfile_exists_p
= intern ("file-exists-p");
3079 Qfile_executable_p
= intern ("file-executable-p");
3080 Qfile_readable_p
= intern ("file-readable-p");
3081 Qfile_symlink_p
= intern ("file-symlink-p");
3082 Qfile_writable_p
= intern ("file-writable-p");
3083 Qfile_directory_p
= intern ("file-directory-p");
3084 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3085 Qfile_modes
= intern ("file-modes");
3086 Qset_file_modes
= intern ("set-file-modes");
3087 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3088 Qinsert_file_contents
= intern ("insert-file-contents");
3089 Qwrite_region
= intern ("write-region");
3090 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3092 Qfile_error
= intern ("file-error");
3093 staticpro (&Qfile_error
);
3094 Qfile_already_exists
= intern("file-already-exists");
3095 staticpro (&Qfile_already_exists
);
3097 Fput (Qfile_error
, Qerror_conditions
,
3098 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3099 Fput (Qfile_error
, Qerror_message
,
3100 build_string ("File error"));
3102 Fput (Qfile_already_exists
, Qerror_conditions
,
3103 Fcons (Qfile_already_exists
,
3104 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3105 Fput (Qfile_already_exists
, Qerror_message
,
3106 build_string ("File already exists"));
3108 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3109 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3110 insert_default_directory
= 1;
3112 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3113 "*Non-nil means write new files with record format `stmlf'.\n\
3114 nil means use format `var'. This variable is meaningful only on VMS.");
3115 vms_stmlf_recfm
= 0;
3117 defsubr (&Sfile_name_directory
);
3118 defsubr (&Sfile_name_nondirectory
);
3119 defsubr (&Sfile_name_as_directory
);
3120 defsubr (&Sdirectory_file_name
);
3121 defsubr (&Smake_temp_name
);
3122 defsubr (&Sexpand_file_name
);
3123 defsubr (&Ssubstitute_in_file_name
);
3124 defsubr (&Scopy_file
);
3125 defsubr (&Smake_directory
);
3126 defsubr (&Sdelete_directory
);
3127 defsubr (&Sdelete_file
);
3128 defsubr (&Srename_file
);
3129 defsubr (&Sadd_name_to_file
);
3131 defsubr (&Smake_symbolic_link
);
3132 #endif /* S_IFLNK */
3134 defsubr (&Sdefine_logical_name
);
3137 defsubr (&Ssysnetunam
);
3138 #endif /* HPUX_NET */
3139 defsubr (&Sfile_name_absolute_p
);
3140 defsubr (&Sfile_exists_p
);
3141 defsubr (&Sfile_executable_p
);
3142 defsubr (&Sfile_readable_p
);
3143 defsubr (&Sfile_writable_p
);
3144 defsubr (&Sfile_symlink_p
);
3145 defsubr (&Sfile_directory_p
);
3146 defsubr (&Sfile_accessible_directory_p
);
3147 defsubr (&Sfile_modes
);
3148 defsubr (&Sset_file_modes
);
3149 defsubr (&Sset_umask
);
3151 defsubr (&Sfile_newer_than_file_p
);
3152 defsubr (&Sinsert_file_contents
);
3153 defsubr (&Swrite_region
);
3154 defsubr (&Sverify_visited_file_modtime
);
3155 defsubr (&Sclear_visited_file_modtime
);
3156 defsubr (&Sset_visited_file_modtime
);
3157 defsubr (&Sdo_auto_save
);
3158 defsubr (&Sset_buffer_auto_saved
);
3159 defsubr (&Srecent_auto_save_p
);
3161 defsubr (&Sread_file_name_internal
);
3162 defsubr (&Sread_file_name
);
3164 defsubr (&Sunix_sync
);