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 Lisp_Object Qfile_name_history
;
106 report_file_error (string
, data
)
110 Lisp_Object errstring
;
112 if (errno
>= 0 && errno
< sys_nerr
)
113 errstring
= build_string (sys_errlist
[errno
]);
115 errstring
= build_string ("undocumented error code");
117 /* System error messages are capitalized. Downcase the initial
118 unless it is followed by a slash. */
119 if (XSTRING (errstring
)->data
[1] != '/')
120 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
123 Fsignal (Qfile_error
,
124 Fcons (build_string (string
), Fcons (errstring
, data
)));
127 close_file_unwind (fd
)
130 close (XFASTINT (fd
));
133 Lisp_Object Qcopy_file
;
134 Lisp_Object Qmake_directory
;
135 Lisp_Object Qdelete_directory
;
136 Lisp_Object Qdelete_file
;
137 Lisp_Object Qrename_file
;
138 Lisp_Object Qadd_name_to_file
;
139 Lisp_Object Qmake_symbolic_link
;
140 Lisp_Object Qfile_exists_p
;
141 Lisp_Object Qfile_executable_p
;
142 Lisp_Object Qfile_readable_p
;
143 Lisp_Object Qfile_symlink_p
;
144 Lisp_Object Qfile_writable_p
;
145 Lisp_Object Qfile_directory_p
;
146 Lisp_Object Qfile_accessible_directory_p
;
147 Lisp_Object Qfile_modes
;
148 Lisp_Object Qset_file_modes
;
149 Lisp_Object Qfile_newer_than_file_p
;
150 Lisp_Object Qinsert_file_contents
;
151 Lisp_Object Qwrite_region
;
152 Lisp_Object Qverify_visited_file_modtime
;
154 /* If FILENAME is handled specially on account of its syntax,
155 return its handler function. Otherwise, return nil. */
158 find_file_handler (filename
)
159 Lisp_Object filename
;
162 for (chain
= Vfile_name_handler_alist
; XTYPE (chain
) == Lisp_Cons
;
163 chain
= XCONS (chain
)->cdr
)
166 elt
= XCONS (chain
)->car
;
167 if (XTYPE (elt
) == Lisp_Cons
)
170 string
= XCONS (elt
)->car
;
171 if (XTYPE (string
) == Lisp_String
172 && fast_string_match (string
, filename
))
173 return XCONS (elt
)->cdr
;
179 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
181 "Return the directory component in file name NAME.\n\
182 Return nil if NAME does not include a directory.\n\
183 Otherwise return a directory spec.\n\
184 Given a Unix syntax file name, returns a string ending in slash;\n\
185 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
189 register unsigned char *beg
;
190 register unsigned char *p
;
192 CHECK_STRING (file
, 0);
194 beg
= XSTRING (file
)->data
;
195 p
= beg
+ XSTRING (file
)->size
;
197 while (p
!= beg
&& p
[-1] != '/'
199 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
205 return make_string (beg
, p
- beg
);
208 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
210 "Return file name NAME sans its directory.\n\
211 For example, in a Unix-syntax file name,\n\
212 this is everything after the last slash,\n\
213 or the entire name if it contains no slash.")
217 register unsigned char *beg
, *p
, *end
;
219 CHECK_STRING (file
, 0);
221 beg
= XSTRING (file
)->data
;
222 end
= p
= beg
+ XSTRING (file
)->size
;
224 while (p
!= beg
&& p
[-1] != '/'
226 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
230 return make_string (p
, end
- p
);
234 file_name_as_directory (out
, in
)
237 int size
= strlen (in
) - 1;
242 /* Is it already a directory string? */
243 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
245 /* Is it a VMS directory file name? If so, hack VMS syntax. */
246 else if (! index (in
, '/')
247 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
248 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
249 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
250 || ! strncmp (&in
[size
- 5], ".dir", 4))
251 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
252 && in
[size
] == '1')))
254 register char *p
, *dot
;
258 dir:x.dir --> dir:[x]
259 dir:[x]y.dir --> dir:[x.y] */
261 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
264 strncpy (out
, in
, p
- in
);
283 dot
= index (p
, '.');
286 /* blindly remove any extension */
287 size
= strlen (out
) + (dot
- p
);
288 strncat (out
, p
, dot
- p
);
299 /* For Unix syntax, Append a slash if necessary */
300 if (out
[size
] != '/')
306 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
307 Sfile_name_as_directory
, 1, 1, 0,
308 "Return a string representing file FILENAME interpreted as a directory.\n\
309 This operation exists because a directory is also a file, but its name as\n\
310 a directory is different from its name as a file.\n\
311 The result can be used as the value of `default-directory'\n\
312 or passed as second argument to `expand-file-name'.\n\
313 For a Unix-syntax file name, just appends a slash.\n\
314 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
320 CHECK_STRING (file
, 0);
323 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
324 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
328 * Convert from directory name to filename.
330 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
331 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
332 * On UNIX, it's simple: just make sure there is a terminating /
334 * Value is nonzero if the string output is different from the input.
337 directory_file_name (src
, dst
)
345 struct FAB fab
= cc$rms_fab
;
346 struct NAM nam
= cc$rms_nam
;
347 char esa
[NAM$C_MAXRSS
];
352 if (! index (src
, '/')
353 && (src
[slen
- 1] == ']'
354 || src
[slen
- 1] == ':'
355 || src
[slen
- 1] == '>'))
357 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
359 fab
.fab$b_fns
= slen
;
360 fab
.fab$l_nam
= &nam
;
361 fab
.fab$l_fop
= FAB$M_NAM
;
364 nam
.nam$b_ess
= sizeof esa
;
365 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
367 /* We call SYS$PARSE to handle such things as [--] for us. */
368 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
370 slen
= nam
.nam$b_esl
;
371 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
376 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
378 /* what about when we have logical_name:???? */
379 if (src
[slen
- 1] == ':')
380 { /* Xlate logical name and see what we get */
381 ptr
= strcpy (dst
, src
); /* upper case for getenv */
384 if ('a' <= *ptr
&& *ptr
<= 'z')
388 dst
[slen
- 1] = 0; /* remove colon */
389 if (!(src
= egetenv (dst
)))
391 /* should we jump to the beginning of this procedure?
392 Good points: allows us to use logical names that xlate
394 Bad points: can be a problem if we just translated to a device
396 For now, I'll punt and always expect VMS names, and hope for
399 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
400 { /* no recursion here! */
406 { /* not a directory spec */
411 bracket
= src
[slen
- 1];
413 /* If bracket is ']' or '>', bracket - 2 is the corresponding
415 ptr
= index (src
, bracket
- 2);
417 { /* no opening bracket */
421 if (!(rptr
= rindex (src
, '.')))
424 strncpy (dst
, src
, slen
);
428 dst
[slen
++] = bracket
;
433 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
434 then translate the device and recurse. */
435 if (dst
[slen
- 1] == ':'
436 && dst
[slen
- 2] != ':' /* skip decnet nodes */
437 && strcmp(src
+ slen
, "[000000]") == 0)
439 dst
[slen
- 1] = '\0';
440 if ((ptr
= egetenv (dst
))
441 && (rlen
= strlen (ptr
) - 1) > 0
442 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
443 && ptr
[rlen
- 1] == '.')
447 return directory_file_name (ptr
, dst
);
452 strcat (dst
, "[000000]");
456 rlen
= strlen (rptr
) - 1;
457 strncat (dst
, rptr
, rlen
);
458 dst
[slen
+ rlen
] = '\0';
459 strcat (dst
, ".DIR.1");
463 /* Process as Unix format: just remove any final slash.
464 But leave "/" unchanged; do not change it to "". */
466 if (slen
> 1 && dst
[slen
- 1] == '/')
471 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
473 "Returns the file name of the directory named DIR.\n\
474 This is the name of the file that holds the data for the directory DIR.\n\
475 This operation exists because a directory is also a file, but its name as\n\
476 a directory is different from its name as a file.\n\
477 In Unix-syntax, this function just removes the final slash.\n\
478 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
479 it returns a file name such as \"[X]Y.DIR.1\".")
481 Lisp_Object directory
;
485 CHECK_STRING (directory
, 0);
487 if (NILP (directory
))
490 /* 20 extra chars is insufficient for VMS, since we might perform a
491 logical name translation. an equivalence string can be up to 255
492 chars long, so grab that much extra space... - sss */
493 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
495 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
497 directory_file_name (XSTRING (directory
)->data
, buf
);
498 return build_string (buf
);
501 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
502 "Generate temporary file name (string) starting with PREFIX (a string).\n\
503 The Emacs process number forms part of the result,\n\
504 so there is no danger of generating a name being used by another process.")
509 val
= concat2 (prefix
, build_string ("XXXXXX"));
510 mktemp (XSTRING (val
)->data
);
514 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
515 "Convert FILENAME to absolute, and canonicalize it.\n\
516 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
517 (does not start with slash); if DEFAULT is nil or missing,\n\
518 the current buffer's value of default-directory is used.\n\
519 Path components that are `.' are removed, and \n\
520 path components followed by `..' are removed, along with the `..' itself;\n\
521 note that these simplifications are done without checking the resulting\n\
522 paths in the file system.\n\
523 An initial `~/' expands to your home directory.\n\
524 An initial `~USER/' expands to USER's home directory.\n\
525 See also the function `substitute-in-file-name'.")
527 Lisp_Object name
, defalt
;
531 register unsigned char *newdir
, *p
, *o
;
533 unsigned char *target
;
537 unsigned char * colon
= 0;
538 unsigned char * close
= 0;
539 unsigned char * slash
= 0;
540 unsigned char * brack
= 0;
541 int lbrack
= 0, rbrack
= 0;
545 CHECK_STRING (name
, 0);
548 /* Filenames on VMS are always upper case. */
549 name
= Fupcase (name
);
552 nm
= XSTRING (name
)->data
;
554 /* If nm is absolute, flush ...// and detect /./ and /../.
555 If no /./ or /../ we can return right away. */
567 if (p
[0] == '/' && p
[1] == '/'
569 /* // at start of filename is meaningful on Apollo system */
574 if (p
[0] == '/' && p
[1] == '~')
575 nm
= p
+ 1, lose
= 1;
576 if (p
[0] == '/' && p
[1] == '.'
577 && (p
[2] == '/' || p
[2] == 0
578 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
584 /* if dev:[dir]/, move nm to / */
585 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
586 nm
= (brack
? brack
+ 1 : colon
+ 1);
595 /* VMS pre V4.4,convert '-'s in filenames. */
596 if (lbrack
== rbrack
)
598 if (dots
< 2) /* this is to allow negative version numbers */
603 if (lbrack
> rbrack
&&
604 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
605 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
611 /* count open brackets, reset close bracket pointer */
612 if (p
[0] == '[' || p
[0] == '<')
614 /* count close brackets, set close bracket pointer */
615 if (p
[0] == ']' || p
[0] == '>')
617 /* detect ][ or >< */
618 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
620 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
621 nm
= p
+ 1, lose
= 1;
622 if (p
[0] == ':' && (colon
|| slash
))
623 /* if dev1:[dir]dev2:, move nm to dev2: */
629 /* if /pathname/dev:, move nm to dev: */
632 /* if node::dev:, move colon following dev */
633 else if (colon
&& colon
[-1] == ':')
635 /* if dev1:dev2:, move nm to dev2: */
636 else if (colon
&& colon
[-1] != ':')
641 if (p
[0] == ':' && !colon
)
647 if (lbrack
== rbrack
)
650 else if (p
[0] == '.')
659 return build_string (sys_translate_unix (nm
));
661 if (nm
== XSTRING (name
)->data
)
663 return build_string (nm
);
667 /* Now determine directory to start with and put it in newdir */
671 if (nm
[0] == '~') /* prefix ~ */
676 || nm
[1] == 0)/* ~ by itself */
678 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
679 newdir
= (unsigned char *) "";
682 nm
++; /* Don't leave the slash in nm. */
685 else /* ~user/filename */
687 for (p
= nm
; *p
&& (*p
!= '/'
692 o
= (unsigned char *) alloca (p
- nm
+ 1);
693 bcopy ((char *) nm
, o
, p
- nm
);
696 pw
= (struct passwd
*) getpwnam (o
+ 1);
699 newdir
= (unsigned char *) pw
-> pw_dir
;
701 nm
= p
+ 1; /* skip the terminator */
707 /* If we don't find a user of that name, leave the name
708 unchanged; don't move nm forward to p. */
718 defalt
= current_buffer
->directory
;
719 CHECK_STRING (defalt
, 1);
720 newdir
= XSTRING (defalt
)->data
;
725 /* Get rid of any slash at the end of newdir. */
726 int length
= strlen (newdir
);
727 if (newdir
[length
- 1] == '/')
729 unsigned char *temp
= (unsigned char *) alloca (length
);
730 bcopy (newdir
, temp
, length
- 1);
731 temp
[length
- 1] = 0;
739 /* Now concatenate the directory and name to new space in the stack frame */
740 tlen
+= strlen (nm
) + 1;
741 target
= (unsigned char *) alloca (tlen
);
747 if (nm
[0] == 0 || nm
[0] == '/')
748 strcpy (target
, newdir
);
751 file_name_as_directory (target
, newdir
);
756 if (index (target
, '/'))
757 strcpy (target
, sys_translate_unix (target
));
760 /* Now canonicalize by removing /. and /foo/.. if they appear */
768 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
774 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
775 /* brackets are offset from each other by 2 */
778 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
779 /* convert [foo][bar] to [bar] */
780 while (o
[-1] != '[' && o
[-1] != '<')
782 else if (*p
== '-' && *o
!= '.')
785 else if (p
[0] == '-' && o
[-1] == '.' &&
786 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
787 /* flush .foo.- ; leave - if stopped by '[' or '<' */
791 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
792 if (p
[1] == '.') /* foo.-.bar ==> bar*/
794 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
796 /* else [foo.-] ==> [-] */
802 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
803 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
813 else if (!strncmp (p
, "//", 2)
815 /* // at start of filename is meaningful in Apollo system */
823 else if (p
[0] == '/' && p
[1] == '.' &&
824 (p
[2] == '/' || p
[2] == 0))
826 else if (!strncmp (p
, "/..", 3)
827 /* `/../' is the "superroot" on certain file systems. */
829 && (p
[3] == '/' || p
[3] == 0))
831 while (o
!= target
&& *--o
!= '/')
834 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
838 if (o
== target
&& *o
== '/')
849 return make_string (target
, o
- target
);
852 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
853 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
854 "Convert FILENAME to absolute, and canonicalize it.\n\
855 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
856 (does not start with slash); if DEFAULT is nil or missing,\n\
857 the current buffer's value of default-directory is used.\n\
858 Filenames containing `.' or `..' as components are simplified;\n\
859 initial `~/' expands to your home directory.\n\
860 See also the function `substitute-in-file-name'.")
862 Lisp_Object name, defalt;
866 register unsigned char *newdir, *p, *o;
868 unsigned char *target;
872 unsigned char * colon = 0;
873 unsigned char * close = 0;
874 unsigned char * slash = 0;
875 unsigned char * brack = 0;
876 int lbrack = 0, rbrack = 0;
880 CHECK_STRING (name
, 0);
883 /* Filenames on VMS are always upper case. */
884 name
= Fupcase (name
);
887 nm
= XSTRING (name
)->data
;
889 /* If nm is absolute, flush ...// and detect /./ and /../.
890 If no /./ or /../ we can return right away. */
902 if (p
[0] == '/' && p
[1] == '/'
904 /* // at start of filename is meaningful on Apollo system */
909 if (p
[0] == '/' && p
[1] == '~')
910 nm
= p
+ 1, lose
= 1;
911 if (p
[0] == '/' && p
[1] == '.'
912 && (p
[2] == '/' || p
[2] == 0
913 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
919 /* if dev:[dir]/, move nm to / */
920 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
921 nm
= (brack
? brack
+ 1 : colon
+ 1);
930 /* VMS pre V4.4,convert '-'s in filenames. */
931 if (lbrack
== rbrack
)
933 if (dots
< 2) /* this is to allow negative version numbers */
938 if (lbrack
> rbrack
&&
939 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
940 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
946 /* count open brackets, reset close bracket pointer */
947 if (p
[0] == '[' || p
[0] == '<')
949 /* count close brackets, set close bracket pointer */
950 if (p
[0] == ']' || p
[0] == '>')
952 /* detect ][ or >< */
953 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
955 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
956 nm
= p
+ 1, lose
= 1;
957 if (p
[0] == ':' && (colon
|| slash
))
958 /* if dev1:[dir]dev2:, move nm to dev2: */
964 /* if /pathname/dev:, move nm to dev: */
967 /* if node::dev:, move colon following dev */
968 else if (colon
&& colon
[-1] == ':')
970 /* if dev1:dev2:, move nm to dev2: */
971 else if (colon
&& colon
[-1] != ':')
976 if (p
[0] == ':' && !colon
)
982 if (lbrack
== rbrack
)
985 else if (p
[0] == '.')
994 return build_string (sys_translate_unix (nm
));
996 if (nm
== XSTRING (name
)->data
)
998 return build_string (nm
);
1002 /* Now determine directory to start with and put it in NEWDIR */
1006 if (nm
[0] == '~') /* prefix ~ */
1011 || nm
[1] == 0)/* ~/filename */
1013 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1014 newdir
= (unsigned char *) "";
1017 nm
++; /* Don't leave the slash in nm. */
1020 else /* ~user/filename */
1022 /* Get past ~ to user */
1023 unsigned char *user
= nm
+ 1;
1024 /* Find end of name. */
1025 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1026 int len
= ptr
? ptr
- user
: strlen (user
);
1028 unsigned char *ptr1
= index (user
, ':');
1029 if (ptr1
!= 0 && ptr1
- user
< len
)
1032 /* Copy the user name into temp storage. */
1033 o
= (unsigned char *) alloca (len
+ 1);
1034 bcopy ((char *) user
, o
, len
);
1037 /* Look up the user name. */
1038 pw
= (struct passwd
*) getpwnam (o
+ 1);
1040 error ("\"%s\" isn't a registered user", o
+ 1);
1042 newdir
= (unsigned char *) pw
->pw_dir
;
1044 /* Discard the user name from NM. */
1051 #endif /* not VMS */
1055 defalt
= current_buffer
->directory
;
1056 CHECK_STRING (defalt
, 1);
1057 newdir
= XSTRING (defalt
)->data
;
1060 /* Now concatenate the directory and name to new space in the stack frame */
1062 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1063 target
= (unsigned char *) alloca (tlen
);
1069 if (nm
[0] == 0 || nm
[0] == '/')
1070 strcpy (target
, newdir
);
1073 file_name_as_directory (target
, newdir
);
1076 strcat (target
, nm
);
1078 if (index (target
, '/'))
1079 strcpy (target
, sys_translate_unix (target
));
1082 /* Now canonicalize by removing /. and /foo/.. if they appear */
1090 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1096 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1097 /* brackets are offset from each other by 2 */
1100 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1101 /* convert [foo][bar] to [bar] */
1102 while (o
[-1] != '[' && o
[-1] != '<')
1104 else if (*p
== '-' && *o
!= '.')
1107 else if (p
[0] == '-' && o
[-1] == '.' &&
1108 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1109 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1113 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1114 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1116 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1118 /* else [foo.-] ==> [-] */
1124 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1125 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1135 else if (!strncmp (p
, "//", 2)
1137 /* // at start of filename is meaningful in Apollo system */
1145 else if (p
[0] == '/' && p
[1] == '.' &&
1146 (p
[2] == '/' || p
[2] == 0))
1148 else if (!strncmp (p
, "/..", 3)
1149 /* `/../' is the "superroot" on certain file systems. */
1151 && (p
[3] == '/' || p
[3] == 0))
1153 while (o
!= target
&& *--o
!= '/')
1156 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1160 if (o
== target
&& *o
== '/')
1168 #endif /* not VMS */
1171 return make_string (target
, o
- target
);
1175 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1176 Ssubstitute_in_file_name
, 1, 1, 0,
1177 "Substitute environment variables referred to in FILENAME.\n\
1178 `$FOO' where FOO is an environment variable name means to substitute\n\
1179 the value of that variable. The variable name should be terminated\n\
1180 with a character not a letter, digit or underscore; otherwise, enclose\n\
1181 the entire variable name in braces.\n\
1182 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1183 On VMS, `$' substitution is not done; this function does little and only\n\
1184 duplicates what `expand-file-name' does.")
1190 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1191 unsigned char *target
;
1193 int substituted
= 0;
1196 CHECK_STRING (string
, 0);
1198 nm
= XSTRING (string
)->data
;
1199 endp
= nm
+ XSTRING (string
)->size
;
1201 /* If /~ or // appears, discard everything through first slash. */
1203 for (p
= nm
; p
!= endp
; p
++)
1207 /* // at start of file name is meaningful in Apollo system */
1208 (p
[0] == '/' && p
- 1 != nm
)
1209 #else /* not APOLLO */
1211 #endif /* not APOLLO */
1215 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1228 return build_string (nm
);
1231 /* See if any variables are substituted into the string
1232 and find the total length of their values in `total' */
1234 for (p
= nm
; p
!= endp
;)
1244 /* "$$" means a single "$" */
1253 while (p
!= endp
&& *p
!= '}') p
++;
1254 if (*p
!= '}') goto missingclose
;
1260 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1264 /* Copy out the variable name */
1265 target
= (unsigned char *) alloca (s
- o
+ 1);
1266 strncpy (target
, o
, s
- o
);
1269 /* Get variable value */
1270 o
= (unsigned char *) egetenv (target
);
1271 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1274 if (!o
&& !strcmp (target
, "USER"))
1275 o
= egetenv ("LOGNAME");
1278 if (!o
) goto badvar
;
1279 total
+= strlen (o
);
1286 /* If substitution required, recopy the string and do it */
1287 /* Make space in stack frame for the new copy */
1288 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1291 /* Copy the rest of the name through, replacing $ constructs with values */
1308 while (p
!= endp
&& *p
!= '}') p
++;
1309 if (*p
!= '}') goto missingclose
;
1315 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1319 /* Copy out the variable name */
1320 target
= (unsigned char *) alloca (s
- o
+ 1);
1321 strncpy (target
, o
, s
- o
);
1324 /* Get variable value */
1325 o
= (unsigned char *) egetenv (target
);
1326 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1329 if (!o
&& !strcmp (target
, "USER"))
1330 o
= egetenv ("LOGNAME");
1342 /* If /~ or // appears, discard everything through first slash. */
1344 for (p
= xnm
; p
!= x
; p
++)
1347 /* // at start of file name is meaningful in Apollo system */
1348 (p
[0] == '/' && p
- 1 != xnm
)
1349 #else /* not APOLLO */
1351 #endif /* not APOLLO */
1353 && p
!= nm
&& p
[-1] == '/')
1356 return make_string (xnm
, x
- xnm
);
1359 error ("Bad format environment-variable substitution");
1361 error ("Missing \"}\" in environment-variable substitution");
1363 error ("Substituting nonexistent environment variable \"%s\"", target
);
1366 #endif /* not VMS */
1369 /* A slightly faster and more convenient way to get
1370 (directory-file-name (expand-file-name FOO)). The return value may
1371 have had its last character zapped with a '\0' character, meaning
1372 that it is acceptable to system calls, but not to other lisp
1373 functions. Callers should make sure that the return value doesn't
1377 expand_and_dir_to_file (filename
, defdir
)
1378 Lisp_Object filename
, defdir
;
1380 register Lisp_Object abspath
;
1382 abspath
= Fexpand_file_name (filename
, defdir
);
1385 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1386 if (c
== ':' || c
== ']' || c
== '>')
1387 abspath
= Fdirectory_file_name (abspath
);
1390 /* Remove final slash, if any (unless path is root).
1391 stat behaves differently depending! */
1392 if (XSTRING (abspath
)->size
> 1
1393 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1395 if (EQ (abspath
, filename
))
1396 abspath
= Fcopy_sequence (abspath
);
1397 XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] = 0;
1403 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1404 Lisp_Object absname
;
1405 unsigned char *querystring
;
1408 register Lisp_Object tem
;
1409 struct gcpro gcpro1
;
1411 if (access (XSTRING (absname
)->data
, 4) >= 0)
1414 Fsignal (Qfile_already_exists
,
1415 Fcons (build_string ("File already exists"),
1416 Fcons (absname
, Qnil
)));
1418 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1419 XSTRING (absname
)->data
, querystring
));
1422 Fsignal (Qfile_already_exists
,
1423 Fcons (build_string ("File already exists"),
1424 Fcons (absname
, Qnil
)));
1429 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1430 "fCopy file: \nFCopy %s to file: \np\nP",
1431 "Copy FILE to NEWNAME. Both args must be strings.\n\
1432 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1433 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1434 A number as third arg means request confirmation if NEWNAME already exists.\n\
1435 This is what happens in interactive use with M-x.\n\
1436 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1437 last-modified time as the old one. (This works on only some systems.)\n\
1438 A prefix arg makes KEEP-TIME non-nil.")
1439 (filename
, newname
, ok_if_already_exists
, keep_date
)
1440 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1443 char buf
[16 * 1024];
1445 Lisp_Object handler
;
1446 struct gcpro gcpro1
, gcpro2
;
1447 int count
= specpdl_ptr
- specpdl
;
1449 GCPRO2 (filename
, newname
);
1450 CHECK_STRING (filename
, 0);
1451 CHECK_STRING (newname
, 1);
1452 filename
= Fexpand_file_name (filename
, Qnil
);
1453 newname
= Fexpand_file_name (newname
, Qnil
);
1455 /* If the file name has special constructs in it,
1456 call the corresponding file handler. */
1457 handler
= find_file_handler (filename
);
1458 if (!NILP (handler
))
1459 return call3 (handler
, Qcopy_file
, filename
, newname
);
1461 if (NILP (ok_if_already_exists
)
1462 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1463 barf_or_query_if_file_exists (newname
, "copy to it",
1464 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1466 ifd
= open (XSTRING (filename
)->data
, 0);
1468 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1470 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1473 /* Create the copy file with the same record format as the input file */
1474 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1476 ofd
= creat (XSTRING (newname
)->data
, 0666);
1479 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1481 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1485 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1486 if (write (ofd
, buf
, n
) != n
)
1487 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1490 if (fstat (ifd
, &st
) >= 0)
1492 if (!NILP (keep_date
))
1494 EMACS_TIME atime
, mtime
;
1495 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1496 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1497 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1500 if (!egetenv ("USE_DOMAIN_ACLS"))
1502 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1505 /* Discard the unwind protects. */
1506 specpdl_ptr
= specpdl
+ count
;
1509 if (close (ofd
) < 0)
1510 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1516 DEFUN ("make-directory", Fmake_directory
, Smake_directory
, 1, 1, "FMake directory: ",
1517 "Create a directory. One argument, a file name string.")
1519 Lisp_Object dirname
;
1522 Lisp_Object handler
;
1524 CHECK_STRING (dirname
, 0);
1525 dirname
= Fexpand_file_name (dirname
, Qnil
);
1527 handler
= find_file_handler (dirname
);
1528 if (!NILP (handler
))
1529 return call2 (handler
, Qmake_directory
, dirname
);
1531 dir
= XSTRING (dirname
)->data
;
1533 if (mkdir (dir
, 0777) != 0)
1534 report_file_error ("Creating directory", Flist (1, &dirname
));
1539 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1540 "Delete a directory. One argument, a file name string.")
1542 Lisp_Object dirname
;
1545 Lisp_Object handler
;
1547 CHECK_STRING (dirname
, 0);
1548 dirname
= Fexpand_file_name (dirname
, Qnil
);
1549 dir
= XSTRING (dirname
)->data
;
1551 handler
= find_file_handler (dirname
);
1552 if (!NILP (handler
))
1553 return call2 (handler
, Qdelete_directory
, dirname
);
1555 if (rmdir (dir
) != 0)
1556 report_file_error ("Removing directory", Flist (1, &dirname
));
1561 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1562 "Delete specified file. One argument, a file name string.\n\
1563 If file has multiple names, it continues to exist with the other names.")
1565 Lisp_Object filename
;
1567 Lisp_Object handler
;
1568 CHECK_STRING (filename
, 0);
1569 filename
= Fexpand_file_name (filename
, Qnil
);
1571 handler
= find_file_handler (filename
);
1572 if (!NILP (handler
))
1573 return call2 (handler
, Qdelete_file
, filename
);
1575 if (0 > unlink (XSTRING (filename
)->data
))
1576 report_file_error ("Removing old name", Flist (1, &filename
));
1580 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1581 "fRename file: \nFRename %s to file: \np",
1582 "Rename FILE as NEWNAME. Both args strings.\n\
1583 If file has names other than FILE, it continues to have those names.\n\
1584 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1585 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1586 A number as third arg means request confirmation if NEWNAME already exists.\n\
1587 This is what happens in interactive use with M-x.")
1588 (filename
, newname
, ok_if_already_exists
)
1589 Lisp_Object filename
, newname
, ok_if_already_exists
;
1592 Lisp_Object args
[2];
1594 Lisp_Object handler
;
1595 struct gcpro gcpro1
, gcpro2
;
1597 GCPRO2 (filename
, newname
);
1598 CHECK_STRING (filename
, 0);
1599 CHECK_STRING (newname
, 1);
1600 filename
= Fexpand_file_name (filename
, Qnil
);
1601 newname
= Fexpand_file_name (newname
, Qnil
);
1603 /* If the file name has special constructs in it,
1604 call the corresponding file handler. */
1605 handler
= find_file_handler (filename
);
1606 if (!NILP (handler
))
1607 return call3 (handler
, Qrename_file
, filename
, newname
);
1609 if (NILP (ok_if_already_exists
)
1610 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1611 barf_or_query_if_file_exists (newname
, "rename to it",
1612 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1614 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1616 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1617 || 0 > unlink (XSTRING (filename
)->data
))
1622 Fcopy_file (filename
, newname
, ok_if_already_exists
, Qt
);
1623 Fdelete_file (filename
);
1630 report_file_error ("Renaming", Flist (2, args
));
1633 report_file_error ("Renaming", Flist (2, &filename
));
1640 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1641 "fAdd name to file: \nFName to add to %s: \np",
1642 "Give FILE additional name NEWNAME. Both args strings.\n\
1643 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1644 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1645 A number as third arg means request confirmation if NEWNAME already exists.\n\
1646 This is what happens in interactive use with M-x.")
1647 (filename
, newname
, ok_if_already_exists
)
1648 Lisp_Object filename
, newname
, ok_if_already_exists
;
1651 Lisp_Object args
[2];
1653 Lisp_Object handler
;
1654 struct gcpro gcpro1
, gcpro2
;
1656 GCPRO2 (filename
, newname
);
1657 CHECK_STRING (filename
, 0);
1658 CHECK_STRING (newname
, 1);
1659 filename
= Fexpand_file_name (filename
, Qnil
);
1660 newname
= Fexpand_file_name (newname
, Qnil
);
1662 /* If the file name has special constructs in it,
1663 call the corresponding file handler. */
1664 handler
= find_file_handler (filename
);
1665 if (!NILP (handler
))
1666 return call3 (handler
, Qadd_name_to_file
, filename
, newname
);
1668 if (NILP (ok_if_already_exists
)
1669 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1670 barf_or_query_if_file_exists (newname
, "make it a new name",
1671 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1672 unlink (XSTRING (newname
)->data
);
1673 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1678 report_file_error ("Adding new name", Flist (2, args
));
1680 report_file_error ("Adding new name", Flist (2, &filename
));
1689 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1690 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1691 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1692 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1693 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1694 A number as third arg means request confirmation if NEWNAME already exists.\n\
1695 This happens for interactive use with M-x.")
1696 (filename
, linkname
, ok_if_already_exists
)
1697 Lisp_Object filename
, linkname
, ok_if_already_exists
;
1700 Lisp_Object args
[2];
1702 Lisp_Object handler
;
1703 struct gcpro gcpro1
, gcpro2
;
1705 GCPRO2 (filename
, linkname
);
1706 CHECK_STRING (filename
, 0);
1707 CHECK_STRING (linkname
, 1);
1708 #if 0 /* This made it impossible to make a link to a relative name. */
1709 filename
= Fexpand_file_name (filename
, Qnil
);
1711 linkname
= Fexpand_file_name (linkname
, Qnil
);
1713 /* If the file name has special constructs in it,
1714 call the corresponding file handler. */
1715 handler
= find_file_handler (filename
);
1716 if (!NILP (handler
))
1717 return call3 (handler
, Qmake_symbolic_link
, filename
, linkname
);
1719 if (NILP (ok_if_already_exists
)
1720 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1721 barf_or_query_if_file_exists (linkname
, "make it a link",
1722 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1723 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1725 /* If we didn't complain already, silently delete existing file. */
1726 if (errno
== EEXIST
)
1728 unlink (XSTRING (filename
)->data
);
1729 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1736 report_file_error ("Making symbolic link", Flist (2, args
));
1738 report_file_error ("Making symbolic link", Flist (2, &filename
));
1744 #endif /* S_IFLNK */
1748 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
1749 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1750 "Define the job-wide logical name NAME to have the value STRING.\n\
1751 If STRING is nil or a null string, the logical name NAME is deleted.")
1753 Lisp_Object varname
;
1756 CHECK_STRING (varname
, 0);
1758 delete_logical_name (XSTRING (varname
)->data
);
1761 CHECK_STRING (string
, 1);
1763 if (XSTRING (string
)->size
== 0)
1764 delete_logical_name (XSTRING (varname
)->data
);
1766 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
1775 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
1776 "Open a network connection to PATH using LOGIN as the login string.")
1778 Lisp_Object path
, login
;
1782 CHECK_STRING (path
, 0);
1783 CHECK_STRING (login
, 0);
1785 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
1787 if (netresult
== -1)
1792 #endif /* HPUX_NET */
1794 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
1796 "Return t if file FILENAME specifies an absolute path name.\n\
1797 On Unix, this is a name starting with a `/' or a `~'.")
1799 Lisp_Object filename
;
1803 CHECK_STRING (filename
, 0);
1804 ptr
= XSTRING (filename
)->data
;
1805 if (*ptr
== '/' || *ptr
== '~'
1807 /* ??? This criterion is probably wrong for '<'. */
1808 || index (ptr
, ':') || index (ptr
, '<')
1809 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
1818 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
1819 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1820 See also `file-readable-p' and `file-attributes'.")
1822 Lisp_Object filename
;
1824 Lisp_Object abspath
;
1825 Lisp_Object handler
;
1827 CHECK_STRING (filename
, 0);
1828 abspath
= Fexpand_file_name (filename
, Qnil
);
1830 /* If the file name has special constructs in it,
1831 call the corresponding file handler. */
1832 handler
= find_file_handler (filename
);
1833 if (!NILP (handler
))
1834 return call2 (handler
, Qfile_exists_p
, filename
);
1836 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
1839 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
1840 "Return t if FILENAME can be executed by you.\n\
1841 For directories this means you can change to that directory.")
1843 Lisp_Object filename
;
1846 Lisp_Object abspath
;
1847 Lisp_Object handler
;
1849 CHECK_STRING (filename
, 0);
1850 abspath
= Fexpand_file_name (filename
, Qnil
);
1852 /* If the file name has special constructs in it,
1853 call the corresponding file handler. */
1854 handler
= find_file_handler (filename
);
1855 if (!NILP (handler
))
1856 return call2 (handler
, Qfile_executable_p
, filename
);
1858 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
1861 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
1862 "Return t if file FILENAME exists and you can read it.\n\
1863 See also `file-exists-p' and `file-attributes'.")
1865 Lisp_Object filename
;
1867 Lisp_Object abspath
;
1868 Lisp_Object handler
;
1870 CHECK_STRING (filename
, 0);
1871 abspath
= Fexpand_file_name (filename
, Qnil
);
1873 /* If the file name has special constructs in it,
1874 call the corresponding file handler. */
1875 handler
= find_file_handler (filename
);
1876 if (!NILP (handler
))
1877 return call2 (handler
, Qfile_readable_p
, filename
);
1879 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
1882 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
1883 "If file FILENAME is the name of a symbolic link\n\
1884 returns the name of the file to which it is linked.\n\
1885 Otherwise returns NIL.")
1887 Lisp_Object filename
;
1894 Lisp_Object handler
;
1896 CHECK_STRING (filename
, 0);
1897 filename
= Fexpand_file_name (filename
, Qnil
);
1899 /* If the file name has special constructs in it,
1900 call the corresponding file handler. */
1901 handler
= find_file_handler (filename
);
1902 if (!NILP (handler
))
1903 return call2 (handler
, Qfile_symlink_p
, filename
);
1908 buf
= (char *) xmalloc (bufsize
);
1909 bzero (buf
, bufsize
);
1910 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
1911 if (valsize
< bufsize
) break;
1912 /* Buffer was not long enough */
1921 val
= make_string (buf
, valsize
);
1924 #else /* not S_IFLNK */
1926 #endif /* not S_IFLNK */
1929 /* Having this before file-symlink-p mysteriously caused it to be forgotten
1931 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
1932 "Return t if file FILENAME can be written or created by you.")
1934 Lisp_Object filename
;
1936 Lisp_Object abspath
, dir
;
1937 Lisp_Object handler
;
1939 CHECK_STRING (filename
, 0);
1940 abspath
= Fexpand_file_name (filename
, Qnil
);
1942 /* If the file name has special constructs in it,
1943 call the corresponding file handler. */
1944 handler
= find_file_handler (filename
);
1945 if (!NILP (handler
))
1946 return call2 (handler
, Qfile_writable_p
, filename
);
1948 if (access (XSTRING (abspath
)->data
, 0) >= 0)
1949 return (access (XSTRING (abspath
)->data
, 2) >= 0) ? Qt
: Qnil
;
1950 dir
= Ffile_name_directory (abspath
);
1953 dir
= Fdirectory_file_name (dir
);
1955 return (access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
1959 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
1960 "Return t if file FILENAME is the name of a directory as a file.\n\
1961 A directory name spec may be given instead; then the value is t\n\
1962 if the directory so specified exists and really is a directory.")
1964 Lisp_Object filename
;
1966 register Lisp_Object abspath
;
1968 Lisp_Object handler
;
1970 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
1972 /* If the file name has special constructs in it,
1973 call the corresponding file handler. */
1974 handler
= find_file_handler (filename
);
1975 if (!NILP (handler
))
1976 return call2 (handler
, Qfile_directory_p
, filename
);
1978 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
1980 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
1983 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
1984 "Return t if file FILENAME is the name of a directory as a file,\n\
1985 and files in that directory can be opened by you. In order to use a\n\
1986 directory as a buffer's current directory, this predicate must return true.\n\
1987 A directory name spec may be given instead; then the value is t\n\
1988 if the directory so specified exists and really is a readable and\n\
1989 searchable directory.")
1991 Lisp_Object filename
;
1993 Lisp_Object handler
;
1995 /* If the file name has special constructs in it,
1996 call the corresponding file handler. */
1997 handler
= find_file_handler (filename
);
1998 if (!NILP (handler
))
1999 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2001 if (NILP (Ffile_directory_p (filename
))
2002 || NILP (Ffile_executable_p (filename
)))
2008 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2009 "Return mode bits of FILE, as an integer.")
2011 Lisp_Object filename
;
2013 Lisp_Object abspath
;
2015 Lisp_Object handler
;
2017 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2019 /* If the file name has special constructs in it,
2020 call the corresponding file handler. */
2021 handler
= find_file_handler (filename
);
2022 if (!NILP (handler
))
2023 return call2 (handler
, Qfile_modes
, filename
);
2025 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2027 return make_number (st
.st_mode
& 07777);
2030 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2031 "Set mode bits of FILE to MODE (an integer).\n\
2032 Only the 12 low bits of MODE are used.")
2034 Lisp_Object filename
, mode
;
2036 Lisp_Object abspath
;
2037 Lisp_Object handler
;
2039 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2040 CHECK_NUMBER (mode
, 1);
2042 /* If the file name has special constructs in it,
2043 call the corresponding file handler. */
2044 handler
= find_file_handler (filename
);
2045 if (!NILP (handler
))
2046 return call3 (handler
, Qset_file_modes
, filename
, mode
);
2049 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2050 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2052 if (!egetenv ("USE_DOMAIN_ACLS"))
2055 struct timeval tvp
[2];
2057 /* chmod on apollo also change the file's modtime; need to save the
2058 modtime and then restore it. */
2059 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2061 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2065 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2066 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2068 /* reset the old accessed and modified times. */
2069 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2071 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2074 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2075 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2082 DEFUN ("set-umask", Fset_umask
, Sset_umask
, 1, 1, 0,
2083 "Select which permission bits to disable in newly created files.\n\
2084 MASK should be an integer; if a permission's bit in MASK is 1,\n\
2085 subsequently created files will not have that permission enabled.\n\
2086 Only the low 9 bits are used.\n\
2087 This setting is inherited by subprocesses.")
2091 CHECK_NUMBER (mask
, 0);
2093 umask (XINT (mask
) & 0777);
2098 DEFUN ("umask", Fumask
, Sumask
, 0, 0, 0,
2099 "Return the current umask value.\n\
2100 The umask value determines which permissions are enabled in newly\n\
2101 created files. If a permission's bit in the umask is 1, subsequently\n\
2102 created files will not have that permission enabled.")
2107 XSET (mask
, Lisp_Int
, umask (0));
2108 umask (XINT (mask
));
2115 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2116 "Tell Unix to finish all pending disk updates.")
2125 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2126 "Return t if file FILE1 is newer than file FILE2.\n\
2127 If FILE1 does not exist, the answer is nil;\n\
2128 otherwise, if FILE2 does not exist, the answer is t.")
2130 Lisp_Object file1
, file2
;
2132 Lisp_Object abspath1
, abspath2
;
2135 Lisp_Object handler
;
2137 CHECK_STRING (file1
, 0);
2138 CHECK_STRING (file2
, 0);
2140 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2141 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2143 /* If the file name has special constructs in it,
2144 call the corresponding file handler. */
2145 handler
= find_file_handler (abspath1
);
2146 if (!NILP (handler
))
2147 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2149 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2152 mtime1
= st
.st_mtime
;
2154 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2157 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2160 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2162 "Insert contents of file FILENAME after point.\n\
2163 Returns list of absolute pathname and length of data inserted.\n\
2164 If second argument VISIT is non-nil, the buffer's visited filename\n\
2165 and last save file modtime are set, and it is marked unmodified.\n\
2166 If visiting and the file does not exist, visiting is completed\n\
2167 before the error is signaled.")
2169 Lisp_Object filename
, visit
;
2173 register int inserted
= 0;
2174 register int how_much
;
2175 int count
= specpdl_ptr
- specpdl
;
2176 struct gcpro gcpro1
;
2177 Lisp_Object handler
, val
;
2182 if (!NILP (current_buffer
->read_only
))
2183 Fbarf_if_buffer_read_only();
2185 CHECK_STRING (filename
, 0);
2186 filename
= Fexpand_file_name (filename
, Qnil
);
2188 /* If the file name has special constructs in it,
2189 call the corresponding file handler. */
2190 handler
= find_file_handler (filename
);
2191 if (!NILP (handler
))
2193 val
= call3 (handler
, Qinsert_file_contents
, filename
, visit
);
2201 if (stat (XSTRING (filename
)->data
, &st
) < 0
2202 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2204 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2205 || fstat (fd
, &st
) < 0)
2206 #endif /* not APOLLO */
2208 if (fd
>= 0) close (fd
);
2210 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2216 record_unwind_protect (close_file_unwind
, make_number (fd
));
2219 /* This code will need to be changed in order to work on named
2220 pipes, and it's probably just not worth it. So we should at
2221 least signal an error. */
2222 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2223 Fsignal (Qfile_error
,
2224 Fcons (build_string ("reading from named pipe"),
2225 Fcons (filename
, Qnil
)));
2228 /* Supposedly happens on VMS. */
2230 error ("File size is negative");
2233 register Lisp_Object temp
;
2235 /* Make sure point-max won't overflow after this insertion. */
2236 XSET (temp
, Lisp_Int
, st
.st_size
+ Z
);
2237 if (st
.st_size
+ Z
!= XINT (temp
))
2238 error ("maximum buffer size exceeded");
2242 prepare_to_modify_buffer (point
, point
);
2245 if (GAP_SIZE
< st
.st_size
)
2246 make_gap (st
.st_size
- GAP_SIZE
);
2250 int try = min (st
.st_size
- inserted
, 64 << 10);
2253 /* Allow quitting out of the actual I/O. */
2256 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2274 record_insert (point
, inserted
);
2278 /* Discard the unwind protect */
2279 specpdl_ptr
= specpdl
+ count
;
2282 error ("IO error reading %s: %s",
2283 XSTRING (filename
)->data
, err_str (errno
));
2290 current_buffer
->undo_list
= Qnil
;
2292 stat (XSTRING (filename
)->data
, &st
);
2294 current_buffer
->modtime
= st
.st_mtime
;
2295 current_buffer
->save_modified
= MODIFF
;
2296 current_buffer
->auto_save_modified
= MODIFF
;
2297 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2298 #ifdef CLASH_DETECTION
2301 if (!NILP (current_buffer
->filename
))
2302 unlock_file (current_buffer
->filename
);
2303 unlock_file (filename
);
2305 #endif /* CLASH_DETECTION */
2306 current_buffer
->filename
= filename
;
2307 /* If visiting nonexistent file, return nil. */
2308 if (current_buffer
->modtime
== -1)
2309 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2312 signal_after_change (point
, 0, inserted
);
2315 RETURN_UNGCPRO (val
);
2316 RETURN_UNGCPRO (Fcons (filename
,
2317 Fcons (make_number (inserted
),
2321 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2322 "r\nFWrite region to file: ",
2323 "Write current region into specified file.\n\
2324 When called from a program, takes three arguments:\n\
2325 START, END and FILENAME. START and END are buffer positions.\n\
2326 Optional fourth argument APPEND if non-nil means\n\
2327 append to existing file contents (if any).\n\
2328 Optional fifth argument VISIT if t means\n\
2329 set the last-save-file-modtime of buffer to this file's modtime\n\
2330 and mark buffer not modified.\n\
2331 If VISIT is neither t nor nil, it means do not print\n\
2332 the \"Wrote file\" message.\n\
2333 Kludgy feature: if START is a string, then that string is written\n\
2334 to the file, instead of any buffer contents, and END is ignored.")
2335 (start
, end
, filename
, append
, visit
)
2336 Lisp_Object start
, end
, filename
, append
, visit
;
2344 int count
= specpdl_ptr
- specpdl
;
2346 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2348 Lisp_Object handler
;
2350 /* Special kludge to simplify auto-saving */
2353 XFASTINT (start
) = BEG
;
2356 else if (XTYPE (start
) != Lisp_String
)
2357 validate_region (&start
, &end
);
2359 filename
= Fexpand_file_name (filename
, Qnil
);
2360 fn
= XSTRING (filename
)->data
;
2362 /* If the file name has special constructs in it,
2363 call the corresponding file handler. */
2364 handler
= find_file_handler (filename
);
2366 if (!NILP (handler
))
2368 Lisp_Object args
[7];
2371 args
[1] = Qwrite_region
;
2377 val
= Ffuncall (7, args
);
2379 /* Do this before reporting IO error
2380 to avoid a "file has changed on disk" warning on
2381 next attempt to save. */
2384 current_buffer
->modtime
= 0;
2385 current_buffer
->save_modified
= MODIFF
;
2386 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2387 current_buffer
->filename
= filename
;
2392 #ifdef CLASH_DETECTION
2394 lock_file (filename
);
2395 #endif /* CLASH_DETECTION */
2399 desc
= open (fn
, O_WRONLY
);
2403 if (auto_saving
) /* Overwrite any previous version of autosave file */
2405 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2406 desc
= open (fn
, O_RDWR
);
2408 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2409 ? XSTRING (current_buffer
->filename
)->data
: 0,
2412 else /* Write to temporary name and rename if no errors */
2414 Lisp_Object temp_name
;
2415 temp_name
= Ffile_name_directory (filename
);
2417 if (!NILP (temp_name
))
2419 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2420 build_string ("$$SAVE$$")));
2421 fname
= XSTRING (filename
)->data
;
2422 fn
= XSTRING (temp_name
)->data
;
2423 desc
= creat_copy_attrs (fname
, fn
);
2426 /* If we can't open the temporary file, try creating a new
2427 version of the original file. VMS "creat" creates a
2428 new version rather than truncating an existing file. */
2431 desc
= creat (fn
, 0666);
2432 #if 0 /* This can clobber an existing file and fail to replace it,
2433 if the user runs out of space. */
2436 /* We can't make a new version;
2437 try to truncate and rewrite existing version if any. */
2439 desc
= open (fn
, O_RDWR
);
2445 desc
= creat (fn
, 0666);
2448 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2449 #endif /* not VMS */
2453 #ifdef CLASH_DETECTION
2455 if (!auto_saving
) unlock_file (filename
);
2457 #endif /* CLASH_DETECTION */
2458 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2461 record_unwind_protect (close_file_unwind
, make_number (desc
));
2464 if (lseek (desc
, 0, 2) < 0)
2466 #ifdef CLASH_DETECTION
2467 if (!auto_saving
) unlock_file (filename
);
2468 #endif /* CLASH_DETECTION */
2469 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2474 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2475 * if we do writes that don't end with a carriage return. Furthermore
2476 * it cannot handle writes of more then 16K. The modified
2477 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2478 * this EXCEPT for the last record (iff it doesn't end with a carriage
2479 * return). This implies that if your buffer doesn't end with a carriage
2480 * return, you get one free... tough. However it also means that if
2481 * we make two calls to sys_write (a la the following code) you can
2482 * get one at the gap as well. The easiest way to fix this (honest)
2483 * is to move the gap to the next newline (or the end of the buffer).
2488 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2489 move_gap (find_next_newline (GPT
, 1));
2495 if (XTYPE (start
) == Lisp_String
)
2497 failure
= 0 > e_write (desc
, XSTRING (start
)->data
,
2498 XSTRING (start
)->size
);
2501 else if (XINT (start
) != XINT (end
))
2503 if (XINT (start
) < GPT
)
2505 register int end1
= XINT (end
);
2507 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
),
2508 min (GPT
, end1
) - tem
);
2512 if (XINT (end
) > GPT
&& !failure
)
2515 tem
= max (tem
, GPT
);
2516 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
);
2526 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2527 Disk full in NFS may be reported here. */
2528 if (fsync (desc
) < 0)
2529 failure
= 1, save_errno
= errno
;
2534 /* Spurious "file has changed on disk" warnings have been
2535 observed on Suns as well.
2536 It seems that `close' can change the modtime, under nfs.
2538 (This has supposedly been fixed in Sunos 4,
2539 but who knows about all the other machines with NFS?) */
2542 /* On VMS and APOLLO, must do the stat after the close
2543 since closing changes the modtime. */
2546 /* Recall that #if defined does not work on VMS. */
2553 /* NFS can report a write failure now. */
2554 if (close (desc
) < 0)
2555 failure
= 1, save_errno
= errno
;
2558 /* If we wrote to a temporary name and had no errors, rename to real name. */
2562 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2570 /* Discard the unwind protect */
2571 specpdl_ptr
= specpdl
+ count
;
2573 #ifdef CLASH_DETECTION
2575 unlock_file (filename
);
2576 #endif /* CLASH_DETECTION */
2578 /* Do this before reporting IO error
2579 to avoid a "file has changed on disk" warning on
2580 next attempt to save. */
2582 current_buffer
->modtime
= st
.st_mtime
;
2585 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2589 current_buffer
->save_modified
= MODIFF
;
2590 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2591 current_buffer
->filename
= filename
;
2593 else if (!NILP (visit
))
2597 message ("Wrote %s", fn
);
2603 e_write (desc
, addr
, len
)
2605 register char *addr
;
2608 char buf
[16 * 1024];
2609 register char *p
, *end
;
2611 if (!EQ (current_buffer
->selective_display
, Qt
))
2612 return write (desc
, addr
, len
) - len
;
2616 end
= p
+ sizeof buf
;
2621 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
2630 if (write (desc
, buf
, p
- buf
) != p
- buf
)
2636 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
2637 Sverify_visited_file_modtime
, 1, 1, 0,
2638 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2639 This means that the file has not been changed since it was visited or saved.")
2645 Lisp_Object handler
;
2647 CHECK_BUFFER (buf
, 0);
2650 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
2651 if (b
->modtime
== 0) return Qt
;
2653 /* If the file name has special constructs in it,
2654 call the corresponding file handler. */
2655 handler
= find_file_handler (b
->filename
);
2656 if (!NILP (handler
))
2657 return call2 (handler
, Qverify_visited_file_modtime
, b
->filename
);
2659 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
2661 /* If the file doesn't exist now and didn't exist before,
2662 we say that it isn't modified, provided the error is a tame one. */
2663 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
2668 if (st
.st_mtime
== b
->modtime
2669 /* If both are positive, accept them if they are off by one second. */
2670 || (st
.st_mtime
> 0 && b
->modtime
> 0
2671 && (st
.st_mtime
== b
->modtime
+ 1
2672 || st
.st_mtime
== b
->modtime
- 1)))
2677 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
2678 Sclear_visited_file_modtime
, 0, 0, 0,
2679 "Clear out records of last mod time of visited file.\n\
2680 Next attempt to save will certainly not complain of a discrepancy.")
2683 current_buffer
->modtime
= 0;
2687 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
2688 Sset_visited_file_modtime
, 0, 0, 0,
2689 "Update buffer's recorded modification time from the visited file's time.\n\
2690 Useful if the buffer was not read from the file normally\n\
2691 or if the file itself has been changed for some known benign reason.")
2694 register Lisp_Object filename
;
2696 Lisp_Object handler
;
2698 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
2700 /* If the file name has special constructs in it,
2701 call the corresponding file handler. */
2702 handler
= find_file_handler (filename
);
2703 if (!NILP (handler
))
2704 current_buffer
->modtime
= 0;
2706 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
2707 current_buffer
->modtime
= st
.st_mtime
;
2715 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
2718 message ("Autosaving...error for %s", name
);
2719 Fsleep_for (make_number (1), Qnil
);
2720 message ("Autosaving...error!for %s", name
);
2721 Fsleep_for (make_number (1), Qnil
);
2722 message ("Autosaving...error for %s", name
);
2723 Fsleep_for (make_number (1), Qnil
);
2733 /* Get visited file's mode to become the auto save file's mode. */
2734 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
2735 /* But make sure we can overwrite it later! */
2736 auto_save_mode_bits
= st
.st_mode
| 0600;
2738 auto_save_mode_bits
= 0666;
2741 Fwrite_region (Qnil
, Qnil
,
2742 current_buffer
->auto_save_file_name
,
2746 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
2747 "Auto-save all buffers that need it.\n\
2748 This is all buffers that have auto-saving enabled\n\
2749 and are changed since last auto-saved.\n\
2750 Auto-saving writes the buffer into a file\n\
2751 so that your editing is not lost if the system crashes.\n\
2752 This file is not the file you visited; that changes only when you save.\n\n\
2753 Non-nil first argument means do not print any message if successful.\n\
2754 Non-nil second argument means save only current buffer.")
2758 struct buffer
*old
= current_buffer
, *b
;
2759 Lisp_Object tail
, buf
;
2761 char *omessage
= echo_area_glyphs
;
2762 extern minibuf_level
;
2764 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2765 point to non-strings reached from Vbuffer_alist. */
2771 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2772 eventually call do-auto-save, so don't err here in that case. */
2773 if (!NILP (Vrun_hooks
))
2774 call1 (Vrun_hooks
, intern ("auto-save-hook"));
2776 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2777 tail
= XCONS (tail
)->cdr
)
2779 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
2781 /* Check for auto save enabled
2782 and file changed since last auto save
2783 and file changed since last real save. */
2784 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
2785 && b
->save_modified
< BUF_MODIFF (b
)
2786 && b
->auto_save_modified
< BUF_MODIFF (b
))
2788 if ((XFASTINT (b
->save_length
) * 10
2789 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
2790 /* A short file is likely to change a large fraction;
2791 spare the user annoying messages. */
2792 && XFASTINT (b
->save_length
) > 5000
2793 /* These messages are frequent and annoying for `*mail*'. */
2794 && !EQ (b
->filename
, Qnil
))
2796 /* It has shrunk too much; turn off auto-saving here. */
2797 message ("Buffer %s has shrunk a lot; auto save turned off there",
2798 XSTRING (b
->name
)->data
);
2799 /* User can reenable saving with M-x auto-save. */
2800 b
->auto_save_file_name
= Qnil
;
2801 /* Prevent warning from repeating if user does so. */
2802 XFASTINT (b
->save_length
) = 0;
2803 Fsleep_for (make_number (1));
2806 set_buffer_internal (b
);
2807 if (!auto_saved
&& NILP (nomsg
))
2808 message1 ("Auto-saving...");
2809 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
2811 b
->auto_save_modified
= BUF_MODIFF (b
);
2812 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2813 set_buffer_internal (old
);
2818 record_auto_save ();
2820 if (auto_saved
&& NILP (nomsg
))
2821 message1 (omessage
? omessage
: "Auto-saving...done");
2827 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
2828 Sset_buffer_auto_saved
, 0, 0, 0,
2829 "Mark current buffer as auto-saved with its current text.\n\
2830 No auto-save file will be written until the buffer changes again.")
2833 current_buffer
->auto_save_modified
= MODIFF
;
2834 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2838 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
2840 "Return t if buffer has been auto-saved since last read in or saved.")
2843 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
2846 /* Reading and completing file names */
2847 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
2849 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
2851 "Internal subroutine for read-file-name. Do not call this.")
2852 (string
, dir
, action
)
2853 Lisp_Object string
, dir
, action
;
2854 /* action is nil for complete, t for return list of completions,
2855 lambda for verify final value */
2857 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
2859 if (XSTRING (string
)->size
== 0)
2864 if (EQ (action
, Qlambda
))
2869 orig_string
= string
;
2870 string
= Fsubstitute_in_file_name (string
);
2871 name
= Ffile_name_nondirectory (string
);
2872 realdir
= Ffile_name_directory (string
);
2876 realdir
= Fexpand_file_name (realdir
, dir
);
2881 specdir
= Ffile_name_directory (string
);
2882 val
= Ffile_name_completion (name
, realdir
);
2883 if (XTYPE (val
) != Lisp_String
)
2885 if (NILP (Fstring_equal (string
, orig_string
)))
2890 if (!NILP (specdir
))
2891 val
= concat2 (specdir
, val
);
2894 register unsigned char *old
, *new;
2898 osize
= XSTRING (val
)->size
;
2899 /* Quote "$" as "$$" to get it past substitute-in-file-name */
2900 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
2901 if (*old
++ == '$') count
++;
2904 old
= XSTRING (val
)->data
;
2905 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
2906 new = XSTRING (val
)->data
;
2907 for (n
= osize
; n
> 0; n
--)
2918 #endif /* Not VMS */
2922 if (EQ (action
, Qt
))
2923 return Ffile_name_all_completions (name
, realdir
);
2924 /* Only other case actually used is ACTION = lambda */
2926 /* Supposedly this helps commands such as `cd' that read directory names,
2927 but can someone explain how it helps them? -- RMS */
2928 if (XSTRING (name
)->size
== 0)
2931 return Ffile_exists_p (string
);
2934 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
2935 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
2936 Value is not expanded---you must call `expand-file-name' yourself.\n\
2937 Default name to DEFAULT if user enters a null string.\n\
2938 (If DEFAULT is omitted, the visited file name is used.)\n\
2939 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
2940 Non-nil and non-t means also require confirmation after completion.\n\
2941 Fifth arg INITIAL specifies text to start with.\n\
2942 DIR defaults to current buffer's directory default.")
2943 (prompt
, dir
, defalt
, mustmatch
, initial
)
2944 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
2946 Lisp_Object val
, insdef
, insdef1
, tem
;
2947 struct gcpro gcpro1
, gcpro2
;
2948 register char *homedir
;
2952 dir
= current_buffer
->directory
;
2954 defalt
= current_buffer
->filename
;
2956 /* If dir starts with user's homedir, change that to ~. */
2957 homedir
= (char *) egetenv ("HOME");
2959 && XTYPE (dir
) == Lisp_String
2960 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
2961 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
2963 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
2964 XSTRING (dir
)->size
- strlen (homedir
) + 1);
2965 XSTRING (dir
)->data
[0] = '~';
2968 if (insert_default_directory
)
2972 if (!NILP (initial
))
2974 Lisp_Object args
[2], pos
;
2978 insdef
= Fconcat (2, args
);
2979 pos
= make_number (XSTRING (dir
)->size
);
2980 insdef1
= Fcons (insdef
, pos
);
2984 insdef
= Qnil
, insdef1
= Qnil
;
2987 count
= specpdl_ptr
- specpdl
;
2988 specbind (intern ("completion-ignore-case"), Qt
);
2991 GCPRO2 (insdef
, defalt
);
2992 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
2993 dir
, mustmatch
, insdef1
,
2994 Qfile_name_history
);
2997 unbind_to (count
, Qnil
);
3002 error ("No file name specified");
3003 tem
= Fstring_equal (val
, insdef
);
3004 if (!NILP (tem
) && !NILP (defalt
))
3006 return Fsubstitute_in_file_name (val
);
3009 #if 0 /* Old version */
3010 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3011 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3012 Value is not expanded---you must call `expand-file-name' yourself.\n\
3013 Default name to DEFAULT if user enters a null string.\n\
3014 (If DEFAULT is omitted, the visited file name is used.)\n\
3015 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3016 Non-nil and non-t means also require confirmation after completion.\n\
3017 Fifth arg INITIAL specifies text to start with.\n\
3018 DIR defaults to current buffer's directory default.")
3019 (prompt
, dir
, defalt
, mustmatch
, initial
)
3020 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3022 Lisp_Object val
, insdef
, tem
;
3023 struct gcpro gcpro1
, gcpro2
;
3024 register char *homedir
;
3028 dir
= current_buffer
->directory
;
3030 defalt
= current_buffer
->filename
;
3032 /* If dir starts with user's homedir, change that to ~. */
3033 homedir
= (char *) egetenv ("HOME");
3035 && XTYPE (dir
) == Lisp_String
3036 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3037 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3039 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3040 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3041 XSTRING (dir
)->data
[0] = '~';
3044 if (!NILP (initial
))
3046 else if (insert_default_directory
)
3049 insdef
= build_string ("");
3052 count
= specpdl_ptr
- specpdl
;
3053 specbind (intern ("completion-ignore-case"), Qt
);
3056 GCPRO2 (insdef
, defalt
);
3057 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3059 insert_default_directory
? insdef
: Qnil
,
3060 Qfile_name_history
);
3063 unbind_to (count
, Qnil
);
3068 error ("No file name specified");
3069 tem
= Fstring_equal (val
, insdef
);
3070 if (!NILP (tem
) && !NILP (defalt
))
3072 return Fsubstitute_in_file_name (val
);
3074 #endif /* Old version */
3078 Qcopy_file
= intern ("copy-file");
3079 Qmake_directory
= intern ("make-directory");
3080 Qdelete_directory
= intern ("delete-directory");
3081 Qdelete_file
= intern ("delete-file");
3082 Qrename_file
= intern ("rename-file");
3083 Qadd_name_to_file
= intern ("add-name-to-file");
3084 Qmake_symbolic_link
= intern ("make-symbolic-link");
3085 Qfile_exists_p
= intern ("file-exists-p");
3086 Qfile_executable_p
= intern ("file-executable-p");
3087 Qfile_readable_p
= intern ("file-readable-p");
3088 Qfile_symlink_p
= intern ("file-symlink-p");
3089 Qfile_writable_p
= intern ("file-writable-p");
3090 Qfile_directory_p
= intern ("file-directory-p");
3091 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3092 Qfile_modes
= intern ("file-modes");
3093 Qset_file_modes
= intern ("set-file-modes");
3094 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3095 Qinsert_file_contents
= intern ("insert-file-contents");
3096 Qwrite_region
= intern ("write-region");
3097 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3099 Qfile_name_history
= intern ("file-name-history");
3100 Fset (Qfile_name_history
, Qnil
);
3102 staticpro (&Qcopy_file
);
3103 staticpro (&Qmake_directory
);
3104 staticpro (&Qdelete_directory
);
3105 staticpro (&Qdelete_file
);
3106 staticpro (&Qrename_file
);
3107 staticpro (&Qadd_name_to_file
);
3108 staticpro (&Qmake_symbolic_link
);
3109 staticpro (&Qfile_exists_p
);
3110 staticpro (&Qfile_executable_p
);
3111 staticpro (&Qfile_readable_p
);
3112 staticpro (&Qfile_symlink_p
);
3113 staticpro (&Qfile_writable_p
);
3114 staticpro (&Qfile_directory_p
);
3115 staticpro (&Qfile_accessible_directory_p
);
3116 staticpro (&Qfile_modes
);
3117 staticpro (&Qset_file_modes
);
3118 staticpro (&Qfile_newer_than_file_p
);
3119 staticpro (&Qinsert_file_contents
);
3120 staticpro (&Qwrite_region
);
3121 staticpro (&Qverify_visited_file_modtime
);
3122 staticpro (&Qfile_name_history
);
3124 Qfile_error
= intern ("file-error");
3125 staticpro (&Qfile_error
);
3126 Qfile_already_exists
= intern("file-already-exists");
3127 staticpro (&Qfile_already_exists
);
3129 Fput (Qfile_error
, Qerror_conditions
,
3130 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3131 Fput (Qfile_error
, Qerror_message
,
3132 build_string ("File error"));
3134 Fput (Qfile_already_exists
, Qerror_conditions
,
3135 Fcons (Qfile_already_exists
,
3136 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3137 Fput (Qfile_already_exists
, Qerror_message
,
3138 build_string ("File already exists"));
3140 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3141 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3142 insert_default_directory
= 1;
3144 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3145 "*Non-nil means write new files with record format `stmlf'.\n\
3146 nil means use format `var'. This variable is meaningful only on VMS.");
3147 vms_stmlf_recfm
= 0;
3149 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
3150 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3151 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3154 The first argument given to HANDLER is the name of the I/O primitive\n\
3155 to be handled; the remaining arguments are the arguments that were\n\
3156 passed to that primitive. For example, if you do\n\
3157 (file-exists-p FILENAME)\n\
3158 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
3159 (funcall HANDLER FILENAME)");
3160 defsubr (&Sfile_name_directory
);
3161 defsubr (&Sfile_name_nondirectory
);
3162 defsubr (&Sfile_name_as_directory
);
3163 defsubr (&Sdirectory_file_name
);
3164 defsubr (&Smake_temp_name
);
3165 defsubr (&Sexpand_file_name
);
3166 defsubr (&Ssubstitute_in_file_name
);
3167 defsubr (&Scopy_file
);
3168 defsubr (&Smake_directory
);
3169 defsubr (&Sdelete_directory
);
3170 defsubr (&Sdelete_file
);
3171 defsubr (&Srename_file
);
3172 defsubr (&Sadd_name_to_file
);
3174 defsubr (&Smake_symbolic_link
);
3175 #endif /* S_IFLNK */
3177 defsubr (&Sdefine_logical_name
);
3180 defsubr (&Ssysnetunam
);
3181 #endif /* HPUX_NET */
3182 defsubr (&Sfile_name_absolute_p
);
3183 defsubr (&Sfile_exists_p
);
3184 defsubr (&Sfile_executable_p
);
3185 defsubr (&Sfile_readable_p
);
3186 defsubr (&Sfile_writable_p
);
3187 defsubr (&Sfile_symlink_p
);
3188 defsubr (&Sfile_directory_p
);
3189 defsubr (&Sfile_accessible_directory_p
);
3190 defsubr (&Sfile_modes
);
3191 defsubr (&Sset_file_modes
);
3192 defsubr (&Sset_umask
);
3194 defsubr (&Sfile_newer_than_file_p
);
3195 defsubr (&Sinsert_file_contents
);
3196 defsubr (&Swrite_region
);
3197 defsubr (&Sverify_visited_file_modtime
);
3198 defsubr (&Sclear_visited_file_modtime
);
3199 defsubr (&Sset_visited_file_modtime
);
3200 defsubr (&Sdo_auto_save
);
3201 defsubr (&Sset_buffer_auto_saved
);
3202 defsubr (&Srecent_auto_save_p
);
3204 defsubr (&Sread_file_name_internal
);
3205 defsubr (&Sread_file_name
);
3207 defsubr (&Sunix_sync
);