1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993 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>
25 #if !defined (S_ISLNK) && defined (S_IFLNK)
26 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
29 #if !defined (S_ISREG) && defined (S_IFREG)
30 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
52 extern char *sys_errlist
[];
56 #define err_str(a) ((a) < sys_nerr ? sys_errlist[a] : "unknown error")
71 #include "intervals.h"
97 #define min(a, b) ((a) < (b) ? (a) : (b))
98 #define max(a, b) ((a) > (b) ? (a) : (b))
100 /* Nonzero during writing of auto-save files */
103 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
104 a new file with the same mode as the original */
105 int auto_save_mode_bits
;
107 /* Alist of elements (REGEXP . HANDLER) for file names
108 whose I/O is done with a special handler. */
109 Lisp_Object Vfile_name_handler_alist
;
111 /* Functions to be called to process text properties in inserted file. */
112 Lisp_Object Vafter_insert_file_functions
;
114 /* Functions to be called to create text property annotations for file. */
115 Lisp_Object Vwrite_region_annotate_functions
;
117 /* Nonzero means, when reading a filename in the minibuffer,
118 start out by inserting the default directory into the minibuffer. */
119 int insert_default_directory
;
121 /* On VMS, nonzero means write new files with record format stmlf.
122 Zero means use var format. */
125 Lisp_Object Qfile_error
, Qfile_already_exists
;
127 Lisp_Object Qfile_name_history
;
129 Lisp_Object Qcar_less_than_car
;
131 report_file_error (string
, data
)
135 Lisp_Object errstring
;
137 if (errno
>= 0 && errno
< sys_nerr
)
138 errstring
= build_string (sys_errlist
[errno
]);
140 errstring
= build_string ("undocumented error code");
142 /* System error messages are capitalized. Downcase the initial
143 unless it is followed by a slash. */
144 if (XSTRING (errstring
)->data
[1] != '/')
145 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
148 Fsignal (Qfile_error
,
149 Fcons (build_string (string
), Fcons (errstring
, data
)));
152 close_file_unwind (fd
)
155 close (XFASTINT (fd
));
158 Lisp_Object Qexpand_file_name
;
159 Lisp_Object Qdirectory_file_name
;
160 Lisp_Object Qfile_name_directory
;
161 Lisp_Object Qfile_name_nondirectory
;
162 Lisp_Object Qunhandled_file_name_directory
;
163 Lisp_Object Qfile_name_as_directory
;
164 Lisp_Object Qcopy_file
;
165 Lisp_Object Qmake_directory
;
166 Lisp_Object Qdelete_directory
;
167 Lisp_Object Qdelete_file
;
168 Lisp_Object Qrename_file
;
169 Lisp_Object Qadd_name_to_file
;
170 Lisp_Object Qmake_symbolic_link
;
171 Lisp_Object Qfile_exists_p
;
172 Lisp_Object Qfile_executable_p
;
173 Lisp_Object Qfile_readable_p
;
174 Lisp_Object Qfile_symlink_p
;
175 Lisp_Object Qfile_writable_p
;
176 Lisp_Object Qfile_directory_p
;
177 Lisp_Object Qfile_accessible_directory_p
;
178 Lisp_Object Qfile_modes
;
179 Lisp_Object Qset_file_modes
;
180 Lisp_Object Qfile_newer_than_file_p
;
181 Lisp_Object Qinsert_file_contents
;
182 Lisp_Object Qwrite_region
;
183 Lisp_Object Qverify_visited_file_modtime
;
184 Lisp_Object Qset_visited_file_modtime
;
186 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 1, 1, 0,
187 "Return FILENAME's handler function, if its syntax is handled specially.\n\
188 Otherwise, return nil.\n\
189 A file name is handled if one of the regular expressions in\n\
190 `file-name-handler-alist' matches it.")
192 Lisp_Object filename
;
194 /* This function must not munge the match data. */
197 CHECK_STRING (filename
, 0);
199 for (chain
= Vfile_name_handler_alist
; XTYPE (chain
) == Lisp_Cons
;
200 chain
= XCONS (chain
)->cdr
)
203 elt
= XCONS (chain
)->car
;
204 if (XTYPE (elt
) == Lisp_Cons
)
207 string
= XCONS (elt
)->car
;
208 if (XTYPE (string
) == Lisp_String
209 && fast_string_match (string
, filename
) >= 0)
210 return XCONS (elt
)->cdr
;
218 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
220 "Return the directory component in file name NAME.\n\
221 Return nil if NAME does not include a directory.\n\
222 Otherwise return a directory spec.\n\
223 Given a Unix syntax file name, returns a string ending in slash;\n\
224 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
228 register unsigned char *beg
;
229 register unsigned char *p
;
232 CHECK_STRING (file
, 0);
234 /* If the file name has special constructs in it,
235 call the corresponding file handler. */
236 handler
= Ffind_file_name_handler (file
);
238 return call2 (handler
, Qfile_name_directory
, file
);
240 beg
= XSTRING (file
)->data
;
241 p
= beg
+ XSTRING (file
)->size
;
243 while (p
!= beg
&& p
[-1] != '/'
245 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
251 return make_string (beg
, p
- beg
);
254 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
256 "Return file name NAME sans its directory.\n\
257 For example, in a Unix-syntax file name,\n\
258 this is everything after the last slash,\n\
259 or the entire name if it contains no slash.")
263 register unsigned char *beg
, *p
, *end
;
266 CHECK_STRING (file
, 0);
268 /* If the file name has special constructs in it,
269 call the corresponding file handler. */
270 handler
= Ffind_file_name_handler (file
);
272 return call2 (handler
, Qfile_name_nondirectory
, file
);
274 beg
= XSTRING (file
)->data
;
275 end
= p
= beg
+ XSTRING (file
)->size
;
277 while (p
!= beg
&& p
[-1] != '/'
279 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
283 return make_string (p
, end
- p
);
286 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
287 "Return a directly usable directory name somehow associated with FILENAME.\n\
288 A `directly usable' directory name is one that may be used without the\n\
289 intervention of any file handler.\n\
290 If FILENAME is a directly usable file itself, return\n\
291 (file-name-directory FILENAME).\n\
292 The `call-process' and `start-process' functions use this function to\n\
293 get a current directory to run processes in.")
295 Lisp_Object filename
;
299 /* If the file name has special constructs in it,
300 call the corresponding file handler. */
301 handler
= Ffind_file_name_handler (filename
);
303 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
305 return Ffile_name_directory (filename
);
310 file_name_as_directory (out
, in
)
313 int size
= strlen (in
) - 1;
318 /* Is it already a directory string? */
319 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
321 /* Is it a VMS directory file name? If so, hack VMS syntax. */
322 else if (! index (in
, '/')
323 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
324 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
325 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
326 || ! strncmp (&in
[size
- 5], ".dir", 4))
327 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
328 && in
[size
] == '1')))
330 register char *p
, *dot
;
334 dir:x.dir --> dir:[x]
335 dir:[x]y.dir --> dir:[x.y] */
337 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
340 strncpy (out
, in
, p
- in
);
359 dot
= index (p
, '.');
362 /* blindly remove any extension */
363 size
= strlen (out
) + (dot
- p
);
364 strncat (out
, p
, dot
- p
);
375 /* For Unix syntax, Append a slash if necessary */
376 if (out
[size
] != '/')
382 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
383 Sfile_name_as_directory
, 1, 1, 0,
384 "Return a string representing file FILENAME interpreted as a directory.\n\
385 This operation exists because a directory is also a file, but its name as\n\
386 a directory is different from its name as a file.\n\
387 The result can be used as the value of `default-directory'\n\
388 or passed as second argument to `expand-file-name'.\n\
389 For a Unix-syntax file name, just appends a slash.\n\
390 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
397 CHECK_STRING (file
, 0);
401 /* If the file name has special constructs in it,
402 call the corresponding file handler. */
403 handler
= Ffind_file_name_handler (file
);
405 return call2 (handler
, Qfile_name_as_directory
, file
);
407 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
408 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
412 * Convert from directory name to filename.
414 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
415 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
416 * On UNIX, it's simple: just make sure there is a terminating /
418 * Value is nonzero if the string output is different from the input.
421 directory_file_name (src
, dst
)
429 struct FAB fab
= cc$rms_fab
;
430 struct NAM nam
= cc$rms_nam
;
431 char esa
[NAM$C_MAXRSS
];
436 if (! index (src
, '/')
437 && (src
[slen
- 1] == ']'
438 || src
[slen
- 1] == ':'
439 || src
[slen
- 1] == '>'))
441 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
443 fab
.fab$b_fns
= slen
;
444 fab
.fab$l_nam
= &nam
;
445 fab
.fab$l_fop
= FAB$M_NAM
;
448 nam
.nam$b_ess
= sizeof esa
;
449 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
451 /* We call SYS$PARSE to handle such things as [--] for us. */
452 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
454 slen
= nam
.nam$b_esl
;
455 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
460 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
462 /* what about when we have logical_name:???? */
463 if (src
[slen
- 1] == ':')
464 { /* Xlate logical name and see what we get */
465 ptr
= strcpy (dst
, src
); /* upper case for getenv */
468 if ('a' <= *ptr
&& *ptr
<= 'z')
472 dst
[slen
- 1] = 0; /* remove colon */
473 if (!(src
= egetenv (dst
)))
475 /* should we jump to the beginning of this procedure?
476 Good points: allows us to use logical names that xlate
478 Bad points: can be a problem if we just translated to a device
480 For now, I'll punt and always expect VMS names, and hope for
483 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
484 { /* no recursion here! */
490 { /* not a directory spec */
495 bracket
= src
[slen
- 1];
497 /* If bracket is ']' or '>', bracket - 2 is the corresponding
499 ptr
= index (src
, bracket
- 2);
501 { /* no opening bracket */
505 if (!(rptr
= rindex (src
, '.')))
508 strncpy (dst
, src
, slen
);
512 dst
[slen
++] = bracket
;
517 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
518 then translate the device and recurse. */
519 if (dst
[slen
- 1] == ':'
520 && dst
[slen
- 2] != ':' /* skip decnet nodes */
521 && strcmp(src
+ slen
, "[000000]") == 0)
523 dst
[slen
- 1] = '\0';
524 if ((ptr
= egetenv (dst
))
525 && (rlen
= strlen (ptr
) - 1) > 0
526 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
527 && ptr
[rlen
- 1] == '.')
529 char * buf
= (char *) alloca (strlen (ptr
) + 1);
533 return directory_file_name (buf
, dst
);
538 strcat (dst
, "[000000]");
542 rlen
= strlen (rptr
) - 1;
543 strncat (dst
, rptr
, rlen
);
544 dst
[slen
+ rlen
] = '\0';
545 strcat (dst
, ".DIR.1");
549 /* Process as Unix format: just remove any final slash.
550 But leave "/" unchanged; do not change it to "". */
552 if (slen
> 1 && dst
[slen
- 1] == '/')
557 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
559 "Returns the file name of the directory named DIR.\n\
560 This is the name of the file that holds the data for the directory DIR.\n\
561 This operation exists because a directory is also a file, but its name as\n\
562 a directory is different from its name as a file.\n\
563 In Unix-syntax, this function just removes the final slash.\n\
564 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
565 it returns a file name such as \"[X]Y.DIR.1\".")
567 Lisp_Object directory
;
572 CHECK_STRING (directory
, 0);
574 if (NILP (directory
))
577 /* If the file name has special constructs in it,
578 call the corresponding file handler. */
579 handler
= Ffind_file_name_handler (directory
);
581 return call2 (handler
, Qdirectory_file_name
, directory
);
584 /* 20 extra chars is insufficient for VMS, since we might perform a
585 logical name translation. an equivalence string can be up to 255
586 chars long, so grab that much extra space... - sss */
587 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
589 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
591 directory_file_name (XSTRING (directory
)->data
, buf
);
592 return build_string (buf
);
595 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
596 "Generate temporary file name (string) starting with PREFIX (a string).\n\
597 The Emacs process number forms part of the result,\n\
598 so there is no danger of generating a name being used by another process.")
603 val
= concat2 (prefix
, build_string ("XXXXXX"));
604 mktemp (XSTRING (val
)->data
);
608 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
609 "Convert FILENAME to absolute, and canonicalize it.\n\
610 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
611 (does not start with slash); if DEFAULT is nil or missing,\n\
612 the current buffer's value of default-directory is used.\n\
613 Path components that are `.' are removed, and \n\
614 path components followed by `..' are removed, along with the `..' itself;\n\
615 note that these simplifications are done without checking the resulting\n\
616 paths in the file system.\n\
617 An initial `~/' expands to your home directory.\n\
618 An initial `~USER/' expands to USER's home directory.\n\
619 See also the function `substitute-in-file-name'.")
621 Lisp_Object name
, defalt
;
625 register unsigned char *newdir
, *p
, *o
;
627 unsigned char *target
;
630 unsigned char * colon
= 0;
631 unsigned char * close
= 0;
632 unsigned char * slash
= 0;
633 unsigned char * brack
= 0;
634 int lbrack
= 0, rbrack
= 0;
639 CHECK_STRING (name
, 0);
641 /* If the file name has special constructs in it,
642 call the corresponding file handler. */
643 handler
= Ffind_file_name_handler (name
);
645 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
647 /* Use the buffer's default-directory if DEFALT is omitted. */
649 defalt
= current_buffer
->directory
;
650 CHECK_STRING (defalt
, 1);
652 /* Make sure DEFALT is properly expanded.
653 It would be better to do this down below where we actually use
654 defalt. Unfortunately, calling Fexpand_file_name recursively
655 could invoke GC, and the strings might be relocated. This would
656 be annoying because we have pointers into strings lying around
657 that would need adjusting, and people would add new pointers to
658 the code and forget to adjust them, resulting in intermittent bugs.
659 Putting this call here avoids all that crud.
661 The EQ test avoids infinite recursion. */
662 if (! NILP (defalt
) && !EQ (defalt
, name
)
663 /* This saves time in a common case. */
664 && XSTRING (defalt
)->data
[0] != '/')
669 defalt
= Fexpand_file_name (defalt
, Qnil
);
674 /* Filenames on VMS are always upper case. */
675 name
= Fupcase (name
);
678 nm
= XSTRING (name
)->data
;
680 /* If nm is absolute, flush ...// and detect /./ and /../.
681 If no /./ or /../ we can return right away. */
689 /* If it turns out that the filename we want to return is just a
690 suffix of FILENAME, we don't need to go through and edit
691 things; we just need to construct a new string using data
692 starting at the middle of FILENAME. If we set lose to a
693 non-zero value, that means we've discovered that we can't do
700 /* Since we know the path is absolute, we can assume that each
701 element starts with a "/". */
703 /* "//" anywhere isn't necessarily hairy; we just start afresh
704 with the second slash. */
705 if (p
[0] == '/' && p
[1] == '/'
707 /* // at start of filename is meaningful on Apollo system */
713 /* "~" is hairy as the start of any path element. */
714 if (p
[0] == '/' && p
[1] == '~')
715 nm
= p
+ 1, lose
= 1;
717 /* "." and ".." are hairy. */
722 || (p
[2] == '.' && (p
[3] == '/'
729 /* if dev:[dir]/, move nm to / */
730 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
731 nm
= (brack
? brack
+ 1 : colon
+ 1);
740 /* VMS pre V4.4,convert '-'s in filenames. */
741 if (lbrack
== rbrack
)
743 if (dots
< 2) /* this is to allow negative version numbers */
748 if (lbrack
> rbrack
&&
749 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
750 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
756 /* count open brackets, reset close bracket pointer */
757 if (p
[0] == '[' || p
[0] == '<')
759 /* count close brackets, set close bracket pointer */
760 if (p
[0] == ']' || p
[0] == '>')
762 /* detect ][ or >< */
763 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
765 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
766 nm
= p
+ 1, lose
= 1;
767 if (p
[0] == ':' && (colon
|| slash
))
768 /* if dev1:[dir]dev2:, move nm to dev2: */
774 /* if /pathname/dev:, move nm to dev: */
777 /* if node::dev:, move colon following dev */
778 else if (colon
&& colon
[-1] == ':')
780 /* if dev1:dev2:, move nm to dev2: */
781 else if (colon
&& colon
[-1] != ':')
786 if (p
[0] == ':' && !colon
)
792 if (lbrack
== rbrack
)
795 else if (p
[0] == '.')
804 return build_string (sys_translate_unix (nm
));
806 if (nm
== XSTRING (name
)->data
)
808 return build_string (nm
);
812 /* Now determine directory to start with and put it in newdir */
816 if (nm
[0] == '~') /* prefix ~ */
822 || nm
[1] == 0) /* ~ by itself */
824 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
825 newdir
= (unsigned char *) "";
828 nm
++; /* Don't leave the slash in nm. */
831 else /* ~user/filename */
833 for (p
= nm
; *p
&& (*p
!= '/'
838 o
= (unsigned char *) alloca (p
- nm
+ 1);
839 bcopy ((char *) nm
, o
, p
- nm
);
842 pw
= (struct passwd
*) getpwnam (o
+ 1);
845 newdir
= (unsigned char *) pw
-> pw_dir
;
847 nm
= p
+ 1; /* skip the terminator */
853 /* If we don't find a user of that name, leave the name
854 unchanged; don't move nm forward to p. */
864 newdir
= XSTRING (defalt
)->data
;
869 /* Get rid of any slash at the end of newdir. */
870 int length
= strlen (newdir
);
871 /* Adding `length > 1 &&' makes ~ expand into / when homedir
872 is the root dir. People disagree about whether that is right.
873 Anyway, we can't take the risk of this change now. */
874 if (newdir
[length
- 1] == '/')
876 unsigned char *temp
= (unsigned char *) alloca (length
);
877 bcopy (newdir
, temp
, length
- 1);
878 temp
[length
- 1] = 0;
886 /* Now concatenate the directory and name to new space in the stack frame */
887 tlen
+= strlen (nm
) + 1;
888 target
= (unsigned char *) alloca (tlen
);
894 if (nm
[0] == 0 || nm
[0] == '/')
895 strcpy (target
, newdir
);
898 file_name_as_directory (target
, newdir
);
903 if (index (target
, '/'))
904 strcpy (target
, sys_translate_unix (target
));
907 /* Now canonicalize by removing /. and /foo/.. if they appear. */
915 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
921 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
922 /* brackets are offset from each other by 2 */
925 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
926 /* convert [foo][bar] to [bar] */
927 while (o
[-1] != '[' && o
[-1] != '<')
929 else if (*p
== '-' && *o
!= '.')
932 else if (p
[0] == '-' && o
[-1] == '.' &&
933 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
934 /* flush .foo.- ; leave - if stopped by '[' or '<' */
938 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
939 if (p
[1] == '.') /* foo.-.bar ==> bar*/
941 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
943 /* else [foo.-] ==> [-] */
949 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
950 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
960 else if (!strncmp (p
, "//", 2)
962 /* // at start of filename is meaningful in Apollo system */
975 /* If "/." is the entire filename, keep the "/". Otherwise,
976 just delete the whole "/.". */
977 if (o
== target
&& p
[2] == '\0')
981 else if (!strncmp (p
, "/..", 3)
982 /* `/../' is the "superroot" on certain file systems. */
984 && (p
[3] == '/' || p
[3] == 0))
986 while (o
!= target
&& *--o
!= '/')
989 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
993 if (o
== target
&& *o
== '/')
1001 #endif /* not VMS */
1004 return make_string (target
, o
- target
);
1007 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
1008 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
1009 "Convert FILENAME to absolute, and canonicalize it.\n\
1010 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1011 (does not start with slash); if DEFAULT is nil or missing,\n\
1012 the current buffer's value of default-directory is used.\n\
1013 Filenames containing `.' or `..' as components are simplified;\n\
1014 initial `~/' expands to your home directory.\n\
1015 See also the function `substitute-in-file-name'.")
1017 Lisp_Object name, defalt;
1021 register unsigned char *newdir, *p, *o;
1023 unsigned char *target;
1027 unsigned char * colon = 0;
1028 unsigned char * close = 0;
1029 unsigned char * slash = 0;
1030 unsigned char * brack = 0;
1031 int lbrack = 0, rbrack = 0;
1035 CHECK_STRING (name
, 0);
1038 /* Filenames on VMS are always upper case. */
1039 name
= Fupcase (name
);
1042 nm
= XSTRING (name
)->data
;
1044 /* If nm is absolute, flush ...// and detect /./ and /../.
1045 If no /./ or /../ we can return right away. */
1057 if (p
[0] == '/' && p
[1] == '/'
1059 /* // at start of filename is meaningful on Apollo system */
1064 if (p
[0] == '/' && p
[1] == '~')
1065 nm
= p
+ 1, lose
= 1;
1066 if (p
[0] == '/' && p
[1] == '.'
1067 && (p
[2] == '/' || p
[2] == 0
1068 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1074 /* if dev:[dir]/, move nm to / */
1075 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1076 nm
= (brack
? brack
+ 1 : colon
+ 1);
1077 lbrack
= rbrack
= 0;
1085 /* VMS pre V4.4,convert '-'s in filenames. */
1086 if (lbrack
== rbrack
)
1088 if (dots
< 2) /* this is to allow negative version numbers */
1093 if (lbrack
> rbrack
&&
1094 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1095 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1101 /* count open brackets, reset close bracket pointer */
1102 if (p
[0] == '[' || p
[0] == '<')
1103 lbrack
++, brack
= 0;
1104 /* count close brackets, set close bracket pointer */
1105 if (p
[0] == ']' || p
[0] == '>')
1106 rbrack
++, brack
= p
;
1107 /* detect ][ or >< */
1108 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1110 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1111 nm
= p
+ 1, lose
= 1;
1112 if (p
[0] == ':' && (colon
|| slash
))
1113 /* if dev1:[dir]dev2:, move nm to dev2: */
1119 /* if /pathname/dev:, move nm to dev: */
1122 /* if node::dev:, move colon following dev */
1123 else if (colon
&& colon
[-1] == ':')
1125 /* if dev1:dev2:, move nm to dev2: */
1126 else if (colon
&& colon
[-1] != ':')
1131 if (p
[0] == ':' && !colon
)
1137 if (lbrack
== rbrack
)
1140 else if (p
[0] == '.')
1148 if (index (nm
, '/'))
1149 return build_string (sys_translate_unix (nm
));
1151 if (nm
== XSTRING (name
)->data
)
1153 return build_string (nm
);
1157 /* Now determine directory to start with and put it in NEWDIR */
1161 if (nm
[0] == '~') /* prefix ~ */
1166 || nm
[1] == 0)/* ~/filename */
1168 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1169 newdir
= (unsigned char *) "";
1172 nm
++; /* Don't leave the slash in nm. */
1175 else /* ~user/filename */
1177 /* Get past ~ to user */
1178 unsigned char *user
= nm
+ 1;
1179 /* Find end of name. */
1180 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1181 int len
= ptr
? ptr
- user
: strlen (user
);
1183 unsigned char *ptr1
= index (user
, ':');
1184 if (ptr1
!= 0 && ptr1
- user
< len
)
1187 /* Copy the user name into temp storage. */
1188 o
= (unsigned char *) alloca (len
+ 1);
1189 bcopy ((char *) user
, o
, len
);
1192 /* Look up the user name. */
1193 pw
= (struct passwd
*) getpwnam (o
+ 1);
1195 error ("\"%s\" isn't a registered user", o
+ 1);
1197 newdir
= (unsigned char *) pw
->pw_dir
;
1199 /* Discard the user name from NM. */
1206 #endif /* not VMS */
1210 defalt
= current_buffer
->directory
;
1211 CHECK_STRING (defalt
, 1);
1212 newdir
= XSTRING (defalt
)->data
;
1215 /* Now concatenate the directory and name to new space in the stack frame */
1217 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1218 target
= (unsigned char *) alloca (tlen
);
1224 if (nm
[0] == 0 || nm
[0] == '/')
1225 strcpy (target
, newdir
);
1228 file_name_as_directory (target
, newdir
);
1231 strcat (target
, nm
);
1233 if (index (target
, '/'))
1234 strcpy (target
, sys_translate_unix (target
));
1237 /* Now canonicalize by removing /. and /foo/.. if they appear */
1245 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1251 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1252 /* brackets are offset from each other by 2 */
1255 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1256 /* convert [foo][bar] to [bar] */
1257 while (o
[-1] != '[' && o
[-1] != '<')
1259 else if (*p
== '-' && *o
!= '.')
1262 else if (p
[0] == '-' && o
[-1] == '.' &&
1263 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1264 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1268 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1269 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1271 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1273 /* else [foo.-] ==> [-] */
1279 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1280 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1290 else if (!strncmp (p
, "//", 2)
1292 /* // at start of filename is meaningful in Apollo system */
1300 else if (p
[0] == '/' && p
[1] == '.' &&
1301 (p
[2] == '/' || p
[2] == 0))
1303 else if (!strncmp (p
, "/..", 3)
1304 /* `/../' is the "superroot" on certain file systems. */
1306 && (p
[3] == '/' || p
[3] == 0))
1308 while (o
!= target
&& *--o
!= '/')
1311 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1315 if (o
== target
&& *o
== '/')
1323 #endif /* not VMS */
1326 return make_string (target
, o
- target
);
1330 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1331 Ssubstitute_in_file_name
, 1, 1, 0,
1332 "Substitute environment variables referred to in FILENAME.\n\
1333 `$FOO' where FOO is an environment variable name means to substitute\n\
1334 the value of that variable. The variable name should be terminated\n\
1335 with a character not a letter, digit or underscore; otherwise, enclose\n\
1336 the entire variable name in braces.\n\
1337 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1338 On VMS, `$' substitution is not done; this function does little and only\n\
1339 duplicates what `expand-file-name' does.")
1345 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1346 unsigned char *target
;
1348 int substituted
= 0;
1351 CHECK_STRING (string
, 0);
1353 nm
= XSTRING (string
)->data
;
1354 endp
= nm
+ XSTRING (string
)->size
;
1356 /* If /~ or // appears, discard everything through first slash. */
1358 for (p
= nm
; p
!= endp
; p
++)
1362 /* // at start of file name is meaningful in Apollo system */
1363 (p
[0] == '/' && p
- 1 != nm
)
1364 #else /* not APOLLO */
1366 #endif /* not APOLLO */
1370 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1383 return build_string (nm
);
1386 /* See if any variables are substituted into the string
1387 and find the total length of their values in `total' */
1389 for (p
= nm
; p
!= endp
;)
1399 /* "$$" means a single "$" */
1408 while (p
!= endp
&& *p
!= '}') p
++;
1409 if (*p
!= '}') goto missingclose
;
1415 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1419 /* Copy out the variable name */
1420 target
= (unsigned char *) alloca (s
- o
+ 1);
1421 strncpy (target
, o
, s
- o
);
1424 /* Get variable value */
1425 o
= (unsigned char *) egetenv (target
);
1426 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1429 if (!o
&& !strcmp (target
, "USER"))
1430 o
= egetenv ("LOGNAME");
1433 if (!o
) goto badvar
;
1434 total
+= strlen (o
);
1441 /* If substitution required, recopy the string and do it */
1442 /* Make space in stack frame for the new copy */
1443 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1446 /* Copy the rest of the name through, replacing $ constructs with values */
1463 while (p
!= endp
&& *p
!= '}') p
++;
1464 if (*p
!= '}') goto missingclose
;
1470 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1474 /* Copy out the variable name */
1475 target
= (unsigned char *) alloca (s
- o
+ 1);
1476 strncpy (target
, o
, s
- o
);
1479 /* Get variable value */
1480 o
= (unsigned char *) egetenv (target
);
1481 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1484 if (!o
&& !strcmp (target
, "USER"))
1485 o
= egetenv ("LOGNAME");
1497 /* If /~ or // appears, discard everything through first slash. */
1499 for (p
= xnm
; p
!= x
; p
++)
1502 /* // at start of file name is meaningful in Apollo system */
1503 (p
[0] == '/' && p
- 1 != xnm
)
1504 #else /* not APOLLO */
1506 #endif /* not APOLLO */
1508 && p
!= nm
&& p
[-1] == '/')
1511 return make_string (xnm
, x
- xnm
);
1514 error ("Bad format environment-variable substitution");
1516 error ("Missing \"}\" in environment-variable substitution");
1518 error ("Substituting nonexistent environment variable \"%s\"", target
);
1521 #endif /* not VMS */
1524 /* A slightly faster and more convenient way to get
1525 (directory-file-name (expand-file-name FOO)). */
1528 expand_and_dir_to_file (filename
, defdir
)
1529 Lisp_Object filename
, defdir
;
1531 register Lisp_Object abspath
;
1533 abspath
= Fexpand_file_name (filename
, defdir
);
1536 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1537 if (c
== ':' || c
== ']' || c
== '>')
1538 abspath
= Fdirectory_file_name (abspath
);
1541 /* Remove final slash, if any (unless path is root).
1542 stat behaves differently depending! */
1543 if (XSTRING (abspath
)->size
> 1
1544 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1545 /* We cannot take shortcuts; they might be wrong for magic file names. */
1546 abspath
= Fdirectory_file_name (abspath
);
1551 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1552 Lisp_Object absname
;
1553 unsigned char *querystring
;
1556 register Lisp_Object tem
;
1557 struct gcpro gcpro1
;
1559 if (access (XSTRING (absname
)->data
, 4) >= 0)
1562 Fsignal (Qfile_already_exists
,
1563 Fcons (build_string ("File already exists"),
1564 Fcons (absname
, Qnil
)));
1566 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1567 XSTRING (absname
)->data
, querystring
));
1570 Fsignal (Qfile_already_exists
,
1571 Fcons (build_string ("File already exists"),
1572 Fcons (absname
, Qnil
)));
1577 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1578 "fCopy file: \nFCopy %s to file: \np\nP",
1579 "Copy FILE to NEWNAME. Both args must be strings.\n\
1580 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1581 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1582 A number as third arg means request confirmation if NEWNAME already exists.\n\
1583 This is what happens in interactive use with M-x.\n\
1584 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1585 last-modified time as the old one. (This works on only some systems.)\n\
1586 A prefix arg makes KEEP-TIME non-nil.")
1587 (filename
, newname
, ok_if_already_exists
, keep_date
)
1588 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1591 char buf
[16 * 1024];
1593 Lisp_Object handler
;
1594 struct gcpro gcpro1
, gcpro2
;
1595 int count
= specpdl_ptr
- specpdl
;
1596 Lisp_Object args
[6];
1597 int input_file_statable_p
;
1599 GCPRO2 (filename
, newname
);
1600 CHECK_STRING (filename
, 0);
1601 CHECK_STRING (newname
, 1);
1602 filename
= Fexpand_file_name (filename
, Qnil
);
1603 newname
= Fexpand_file_name (newname
, Qnil
);
1605 /* If the input file name has special constructs in it,
1606 call the corresponding file handler. */
1607 handler
= Ffind_file_name_handler (filename
);
1608 /* Likewise for output file name. */
1610 handler
= Ffind_file_name_handler (newname
);
1611 if (!NILP (handler
))
1612 return call5 (handler
, Qcopy_file
, filename
, newname
,
1613 ok_if_already_exists
, keep_date
);
1615 if (NILP (ok_if_already_exists
)
1616 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1617 barf_or_query_if_file_exists (newname
, "copy to it",
1618 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1620 ifd
= open (XSTRING (filename
)->data
, 0);
1622 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1624 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1626 /* We can only copy regular files and symbolic links. Other files are not
1628 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1630 #if defined (S_ISREG) && defined (S_ISLNK)
1631 if (input_file_statable_p
)
1633 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1635 #if defined (EISDIR)
1636 /* Get a better looking error message. */
1639 report_file_error ("Non-regular file", Fcons (filename
, Qnil
));
1642 #endif /* S_ISREG && S_ISLNK */
1645 /* Create the copy file with the same record format as the input file */
1646 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1648 ofd
= creat (XSTRING (newname
)->data
, 0666);
1651 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1653 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1657 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1658 if (write (ofd
, buf
, n
) != n
)
1659 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1662 if (input_file_statable_p
)
1664 if (!NILP (keep_date
))
1666 EMACS_TIME atime
, mtime
;
1667 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1668 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1669 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1672 if (!egetenv ("USE_DOMAIN_ACLS"))
1674 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1677 /* Discard the unwind protects. */
1678 specpdl_ptr
= specpdl
+ count
;
1681 if (close (ofd
) < 0)
1682 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1688 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1689 Smake_directory_internal
, 1, 1, 0,
1690 "Create a directory. One argument, a file name string.")
1692 Lisp_Object dirname
;
1695 Lisp_Object handler
;
1697 CHECK_STRING (dirname
, 0);
1698 dirname
= Fexpand_file_name (dirname
, Qnil
);
1700 handler
= Ffind_file_name_handler (dirname
);
1701 if (!NILP (handler
))
1702 return call3 (handler
, Qmake_directory
, dirname
, Qnil
);
1704 dir
= XSTRING (dirname
)->data
;
1706 if (mkdir (dir
, 0777) != 0)
1707 report_file_error ("Creating directory", Flist (1, &dirname
));
1712 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1713 "Delete a directory. One argument, a file name string.")
1715 Lisp_Object dirname
;
1718 Lisp_Object handler
;
1720 CHECK_STRING (dirname
, 0);
1721 dirname
= Fexpand_file_name (dirname
, Qnil
);
1722 dir
= XSTRING (dirname
)->data
;
1724 handler
= Ffind_file_name_handler (dirname
);
1725 if (!NILP (handler
))
1726 return call2 (handler
, Qdelete_directory
, dirname
);
1728 if (rmdir (dir
) != 0)
1729 report_file_error ("Removing directory", Flist (1, &dirname
));
1734 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1735 "Delete specified file. One argument, a file name string.\n\
1736 If file has multiple names, it continues to exist with the other names.")
1738 Lisp_Object filename
;
1740 Lisp_Object handler
;
1741 CHECK_STRING (filename
, 0);
1742 filename
= Fexpand_file_name (filename
, Qnil
);
1744 handler
= Ffind_file_name_handler (filename
);
1745 if (!NILP (handler
))
1746 return call2 (handler
, Qdelete_file
, filename
);
1748 if (0 > unlink (XSTRING (filename
)->data
))
1749 report_file_error ("Removing old name", Flist (1, &filename
));
1753 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1754 "fRename file: \nFRename %s to file: \np",
1755 "Rename FILE as NEWNAME. Both args strings.\n\
1756 If file has names other than FILE, it continues to have those names.\n\
1757 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1758 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1759 A number as third arg means request confirmation if NEWNAME already exists.\n\
1760 This is what happens in interactive use with M-x.")
1761 (filename
, newname
, ok_if_already_exists
)
1762 Lisp_Object filename
, newname
, ok_if_already_exists
;
1765 Lisp_Object args
[2];
1767 Lisp_Object handler
;
1768 struct gcpro gcpro1
, gcpro2
;
1770 GCPRO2 (filename
, newname
);
1771 CHECK_STRING (filename
, 0);
1772 CHECK_STRING (newname
, 1);
1773 filename
= Fexpand_file_name (filename
, Qnil
);
1774 newname
= Fexpand_file_name (newname
, Qnil
);
1776 /* If the file name has special constructs in it,
1777 call the corresponding file handler. */
1778 handler
= Ffind_file_name_handler (filename
);
1780 handler
= Ffind_file_name_handler (newname
);
1781 if (!NILP (handler
))
1782 return call4 (handler
, Qrename_file
,
1783 filename
, newname
, ok_if_already_exists
);
1785 if (NILP (ok_if_already_exists
)
1786 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1787 barf_or_query_if_file_exists (newname
, "rename to it",
1788 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1790 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1792 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1793 || 0 > unlink (XSTRING (filename
)->data
))
1798 Fcopy_file (filename
, newname
,
1799 /* We have already prompted if it was an integer,
1800 so don't have copy-file prompt again. */
1801 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
1802 Fdelete_file (filename
);
1809 report_file_error ("Renaming", Flist (2, args
));
1812 report_file_error ("Renaming", Flist (2, &filename
));
1819 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1820 "fAdd name to file: \nFName to add to %s: \np",
1821 "Give FILE additional name NEWNAME. Both args strings.\n\
1822 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1823 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1824 A number as third arg means request confirmation if NEWNAME already exists.\n\
1825 This is what happens in interactive use with M-x.")
1826 (filename
, newname
, ok_if_already_exists
)
1827 Lisp_Object filename
, newname
, ok_if_already_exists
;
1830 Lisp_Object args
[2];
1832 Lisp_Object handler
;
1833 struct gcpro gcpro1
, gcpro2
;
1835 GCPRO2 (filename
, newname
);
1836 CHECK_STRING (filename
, 0);
1837 CHECK_STRING (newname
, 1);
1838 filename
= Fexpand_file_name (filename
, Qnil
);
1839 newname
= Fexpand_file_name (newname
, Qnil
);
1841 /* If the file name has special constructs in it,
1842 call the corresponding file handler. */
1843 handler
= Ffind_file_name_handler (filename
);
1844 if (!NILP (handler
))
1845 return call4 (handler
, Qadd_name_to_file
, filename
, newname
,
1846 ok_if_already_exists
);
1848 if (NILP (ok_if_already_exists
)
1849 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1850 barf_or_query_if_file_exists (newname
, "make it a new name",
1851 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1852 unlink (XSTRING (newname
)->data
);
1853 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1858 report_file_error ("Adding new name", Flist (2, args
));
1860 report_file_error ("Adding new name", Flist (2, &filename
));
1869 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1870 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1871 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1872 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1873 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1874 A number as third arg means request confirmation if NEWNAME already exists.\n\
1875 This happens for interactive use with M-x.")
1876 (filename
, linkname
, ok_if_already_exists
)
1877 Lisp_Object filename
, linkname
, ok_if_already_exists
;
1880 Lisp_Object args
[2];
1882 Lisp_Object handler
;
1883 struct gcpro gcpro1
, gcpro2
;
1885 GCPRO2 (filename
, linkname
);
1886 CHECK_STRING (filename
, 0);
1887 CHECK_STRING (linkname
, 1);
1888 /* If the link target has a ~, we must expand it to get
1889 a truly valid file name. Otherwise, do not expand;
1890 we want to permit links to relative file names. */
1891 if (XSTRING (filename
)->data
[0] == '~')
1892 filename
= Fexpand_file_name (filename
, Qnil
);
1893 linkname
= Fexpand_file_name (linkname
, Qnil
);
1895 /* If the file name has special constructs in it,
1896 call the corresponding file handler. */
1897 handler
= Ffind_file_name_handler (filename
);
1898 if (!NILP (handler
))
1899 return call4 (handler
, Qmake_symbolic_link
, filename
, linkname
,
1900 ok_if_already_exists
);
1902 if (NILP (ok_if_already_exists
)
1903 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1904 barf_or_query_if_file_exists (linkname
, "make it a link",
1905 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1906 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1908 /* If we didn't complain already, silently delete existing file. */
1909 if (errno
== EEXIST
)
1911 unlink (XSTRING (linkname
)->data
);
1912 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1919 report_file_error ("Making symbolic link", Flist (2, args
));
1921 report_file_error ("Making symbolic link", Flist (2, &filename
));
1927 #endif /* S_IFLNK */
1931 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
1932 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1933 "Define the job-wide logical name NAME to have the value STRING.\n\
1934 If STRING is nil or a null string, the logical name NAME is deleted.")
1936 Lisp_Object varname
;
1939 CHECK_STRING (varname
, 0);
1941 delete_logical_name (XSTRING (varname
)->data
);
1944 CHECK_STRING (string
, 1);
1946 if (XSTRING (string
)->size
== 0)
1947 delete_logical_name (XSTRING (varname
)->data
);
1949 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
1958 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
1959 "Open a network connection to PATH using LOGIN as the login string.")
1961 Lisp_Object path
, login
;
1965 CHECK_STRING (path
, 0);
1966 CHECK_STRING (login
, 0);
1968 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
1970 if (netresult
== -1)
1975 #endif /* HPUX_NET */
1977 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
1979 "Return t if file FILENAME specifies an absolute path name.\n\
1980 On Unix, this is a name starting with a `/' or a `~'.")
1982 Lisp_Object filename
;
1986 CHECK_STRING (filename
, 0);
1987 ptr
= XSTRING (filename
)->data
;
1988 if (*ptr
== '/' || *ptr
== '~'
1990 /* ??? This criterion is probably wrong for '<'. */
1991 || index (ptr
, ':') || index (ptr
, '<')
1992 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2001 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2002 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2003 See also `file-readable-p' and `file-attributes'.")
2005 Lisp_Object filename
;
2007 Lisp_Object abspath
;
2008 Lisp_Object handler
;
2010 CHECK_STRING (filename
, 0);
2011 abspath
= Fexpand_file_name (filename
, Qnil
);
2013 /* If the file name has special constructs in it,
2014 call the corresponding file handler. */
2015 handler
= Ffind_file_name_handler (abspath
);
2016 if (!NILP (handler
))
2017 return call2 (handler
, Qfile_exists_p
, abspath
);
2019 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
2022 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2023 "Return t if FILENAME can be executed by you.\n\
2024 For a directory, this means you can access files in that directory.")
2026 Lisp_Object filename
;
2029 Lisp_Object abspath
;
2030 Lisp_Object handler
;
2032 CHECK_STRING (filename
, 0);
2033 abspath
= Fexpand_file_name (filename
, Qnil
);
2035 /* If the file name has special constructs in it,
2036 call the corresponding file handler. */
2037 handler
= Ffind_file_name_handler (abspath
);
2038 if (!NILP (handler
))
2039 return call2 (handler
, Qfile_executable_p
, abspath
);
2041 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
2044 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2045 "Return t if file FILENAME exists and you can read it.\n\
2046 See also `file-exists-p' and `file-attributes'.")
2048 Lisp_Object filename
;
2050 Lisp_Object abspath
;
2051 Lisp_Object handler
;
2053 CHECK_STRING (filename
, 0);
2054 abspath
= Fexpand_file_name (filename
, Qnil
);
2056 /* If the file name has special constructs in it,
2057 call the corresponding file handler. */
2058 handler
= Ffind_file_name_handler (abspath
);
2059 if (!NILP (handler
))
2060 return call2 (handler
, Qfile_readable_p
, abspath
);
2062 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
2065 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2066 "If file FILENAME is the name of a symbolic link\n\
2067 returns the name of the file to which it is linked.\n\
2068 Otherwise returns NIL.")
2070 Lisp_Object filename
;
2077 Lisp_Object handler
;
2079 CHECK_STRING (filename
, 0);
2080 filename
= Fexpand_file_name (filename
, Qnil
);
2082 /* If the file name has special constructs in it,
2083 call the corresponding file handler. */
2084 handler
= Ffind_file_name_handler (filename
);
2085 if (!NILP (handler
))
2086 return call2 (handler
, Qfile_symlink_p
, filename
);
2091 buf
= (char *) xmalloc (bufsize
);
2092 bzero (buf
, bufsize
);
2093 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2094 if (valsize
< bufsize
) break;
2095 /* Buffer was not long enough */
2104 val
= make_string (buf
, valsize
);
2107 #else /* not S_IFLNK */
2109 #endif /* not S_IFLNK */
2112 #ifdef SOLARIS_BROKEN_ACCESS
2113 /* In Solaris 2.1, the readonly-ness of the filesystem is not
2114 considered by the access system call. This is Sun's bug, but we
2115 still have to make Emacs work. */
2117 #include <sys/statvfs.h>
2123 struct statvfs statvfsb
;
2125 if (statvfs(path
, &statvfsb
))
2126 return 1; /* error from statvfs, be conservative and say not wrtable */
2128 /* Otherwise, fsys is ro if bit is set. */
2129 return statvfsb
.f_flag
& ST_RDONLY
;
2132 /* But on every other os, access has already done the right thing. */
2133 #define ro_fsys(path) 0
2136 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2138 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2139 "Return t if file FILENAME can be written or created by you.")
2141 Lisp_Object filename
;
2143 Lisp_Object abspath
, dir
;
2144 Lisp_Object handler
;
2146 CHECK_STRING (filename
, 0);
2147 abspath
= Fexpand_file_name (filename
, Qnil
);
2149 /* If the file name has special constructs in it,
2150 call the corresponding file handler. */
2151 handler
= Ffind_file_name_handler (abspath
);
2152 if (!NILP (handler
))
2153 return call2 (handler
, Qfile_writable_p
, abspath
);
2155 if (access (XSTRING (abspath
)->data
, 0) >= 0)
2156 return ((access (XSTRING (abspath
)->data
, 2) >= 0
2157 && ! ro_fsys ((char *) XSTRING (abspath
)->data
))
2159 dir
= Ffile_name_directory (abspath
);
2162 dir
= Fdirectory_file_name (dir
);
2164 return ((access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2165 && ! ro_fsys ((char *) XSTRING (dir
)->data
))
2169 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2170 "Return t if file FILENAME is the name of a directory as a file.\n\
2171 A directory name spec may be given instead; then the value is t\n\
2172 if the directory so specified exists and really is a directory.")
2174 Lisp_Object filename
;
2176 register Lisp_Object abspath
;
2178 Lisp_Object handler
;
2180 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2182 /* If the file name has special constructs in it,
2183 call the corresponding file handler. */
2184 handler
= Ffind_file_name_handler (abspath
);
2185 if (!NILP (handler
))
2186 return call2 (handler
, Qfile_directory_p
, abspath
);
2188 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2190 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2193 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2194 "Return t if file FILENAME is the name of a directory as a file,\n\
2195 and files in that directory can be opened by you. In order to use a\n\
2196 directory as a buffer's current directory, this predicate must return true.\n\
2197 A directory name spec may be given instead; then the value is t\n\
2198 if the directory so specified exists and really is a readable and\n\
2199 searchable directory.")
2201 Lisp_Object filename
;
2203 Lisp_Object handler
;
2205 /* If the file name has special constructs in it,
2206 call the corresponding file handler. */
2207 handler
= Ffind_file_name_handler (filename
);
2208 if (!NILP (handler
))
2209 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2211 if (NILP (Ffile_directory_p (filename
))
2212 || NILP (Ffile_executable_p (filename
)))
2218 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2219 "Return mode bits of FILE, as an integer.")
2221 Lisp_Object filename
;
2223 Lisp_Object abspath
;
2225 Lisp_Object handler
;
2227 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2229 /* If the file name has special constructs in it,
2230 call the corresponding file handler. */
2231 handler
= Ffind_file_name_handler (abspath
);
2232 if (!NILP (handler
))
2233 return call2 (handler
, Qfile_modes
, abspath
);
2235 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2237 return make_number (st
.st_mode
& 07777);
2240 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2241 "Set mode bits of FILE to MODE (an integer).\n\
2242 Only the 12 low bits of MODE are used.")
2244 Lisp_Object filename
, mode
;
2246 Lisp_Object abspath
;
2247 Lisp_Object handler
;
2249 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2250 CHECK_NUMBER (mode
, 1);
2252 /* If the file name has special constructs in it,
2253 call the corresponding file handler. */
2254 handler
= Ffind_file_name_handler (abspath
);
2255 if (!NILP (handler
))
2256 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2259 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2260 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2262 if (!egetenv ("USE_DOMAIN_ACLS"))
2265 struct timeval tvp
[2];
2267 /* chmod on apollo also change the file's modtime; need to save the
2268 modtime and then restore it. */
2269 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2271 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2275 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2276 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2278 /* reset the old accessed and modified times. */
2279 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2281 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2284 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2285 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2292 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2293 "Set the file permission bits for newly created files.\n\
2294 The argument MODE should be an integer; only the low 9 bits are used.\n\
2295 This setting is inherited by subprocesses.")
2299 CHECK_NUMBER (mode
, 0);
2301 umask ((~ XINT (mode
)) & 0777);
2306 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2307 "Return the default file protection for created files.\n\
2308 The value is an integer.")
2314 realmask
= umask (0);
2317 XSET (value
, Lisp_Int
, (~ realmask
) & 0777);
2323 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2324 "Tell Unix to finish all pending disk updates.")
2333 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2334 "Return t if file FILE1 is newer than file FILE2.\n\
2335 If FILE1 does not exist, the answer is nil;\n\
2336 otherwise, if FILE2 does not exist, the answer is t.")
2338 Lisp_Object file1
, file2
;
2340 Lisp_Object abspath1
, abspath2
;
2343 Lisp_Object handler
;
2344 struct gcpro gcpro1
, gcpro2
;
2346 CHECK_STRING (file1
, 0);
2347 CHECK_STRING (file2
, 0);
2350 GCPRO2 (abspath1
, file2
);
2351 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2352 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2355 /* If the file name has special constructs in it,
2356 call the corresponding file handler. */
2357 handler
= Ffind_file_name_handler (abspath1
);
2359 handler
= Ffind_file_name_handler (abspath2
);
2360 if (!NILP (handler
))
2361 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2363 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2366 mtime1
= st
.st_mtime
;
2368 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2371 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2374 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2376 "Insert contents of file FILENAME after point.\n\
2377 Returns list of absolute file name and length of data inserted.\n\
2378 If second argument VISIT is non-nil, the buffer's visited filename\n\
2379 and last save file modtime are set, and it is marked unmodified.\n\
2380 If visiting and the file does not exist, visiting is completed\n\
2381 before the error is signaled.\n\n\
2382 The optional third and fourth arguments BEG and END\n\
2383 specify what portion of the file to insert.\n\
2384 If VISIT is non-nil, BEG and END must be nil.")
2385 (filename
, visit
, beg
, end
)
2386 Lisp_Object filename
, visit
, beg
, end
;
2390 register int inserted
= 0;
2391 register int how_much
;
2392 int count
= specpdl_ptr
- specpdl
;
2393 struct gcpro gcpro1
, gcpro2
;
2394 Lisp_Object handler
, val
, insval
;
2401 GCPRO2 (filename
, p
);
2402 if (!NILP (current_buffer
->read_only
))
2403 Fbarf_if_buffer_read_only();
2405 CHECK_STRING (filename
, 0);
2406 filename
= Fexpand_file_name (filename
, Qnil
);
2408 /* If the file name has special constructs in it,
2409 call the corresponding file handler. */
2410 handler
= Ffind_file_name_handler (filename
);
2411 if (!NILP (handler
))
2413 val
= call5 (handler
, Qinsert_file_contents
, filename
, visit
, beg
, end
);
2420 if (stat (XSTRING (filename
)->data
, &st
) < 0
2421 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2423 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2424 || fstat (fd
, &st
) < 0)
2425 #endif /* not APOLLO */
2427 if (fd
>= 0) close (fd
);
2429 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2435 record_unwind_protect (close_file_unwind
, make_number (fd
));
2438 /* This code will need to be changed in order to work on named
2439 pipes, and it's probably just not worth it. So we should at
2440 least signal an error. */
2441 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2442 Fsignal (Qfile_error
,
2443 Fcons (build_string ("reading from named pipe"),
2444 Fcons (filename
, Qnil
)));
2447 /* Supposedly happens on VMS. */
2449 error ("File size is negative");
2451 if (!NILP (beg
) || !NILP (end
))
2453 error ("Attempt to visit less than an entire file");
2456 CHECK_NUMBER (beg
, 0);
2461 CHECK_NUMBER (end
, 0);
2464 XSETINT (end
, st
.st_size
);
2465 if (XINT (end
) != st
.st_size
)
2466 error ("maximum buffer size exceeded");
2469 total
= XINT (end
) - XINT (beg
);
2472 register Lisp_Object temp
;
2474 /* Make sure point-max won't overflow after this insertion. */
2475 XSET (temp
, Lisp_Int
, total
);
2476 if (total
!= XINT (temp
))
2477 error ("maximum buffer size exceeded");
2480 if (NILP (visit
) && total
> 0)
2481 prepare_to_modify_buffer (point
, point
);
2484 if (GAP_SIZE
< total
)
2485 make_gap (total
- GAP_SIZE
);
2487 if (XINT (beg
) != 0)
2489 if (lseek (fd
, XINT (beg
), 0) < 0)
2490 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2495 int try = min (total
- inserted
, 64 << 10);
2498 /* Allow quitting out of the actual I/O. */
2501 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2519 record_insert (point
, inserted
);
2521 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2522 offset_intervals (current_buffer
, point
, inserted
);
2528 /* Discard the unwind protect */
2529 specpdl_ptr
= specpdl
+ count
;
2532 error ("IO error reading %s: %s",
2533 XSTRING (filename
)->data
, err_str (errno
));
2540 current_buffer
->undo_list
= Qnil
;
2542 stat (XSTRING (filename
)->data
, &st
);
2547 current_buffer
->modtime
= st
.st_mtime
;
2548 current_buffer
->filename
= filename
;
2551 current_buffer
->save_modified
= MODIFF
;
2552 current_buffer
->auto_save_modified
= MODIFF
;
2553 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2554 #ifdef CLASH_DETECTION
2557 if (!NILP (current_buffer
->filename
))
2558 unlock_file (current_buffer
->filename
);
2559 unlock_file (filename
);
2561 #endif /* CLASH_DETECTION */
2562 /* If visiting nonexistent file, return nil. */
2563 if (current_buffer
->modtime
== -1)
2564 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2567 if (inserted
> 0 && NILP (visit
) && total
> 0)
2568 signal_after_change (point
, 0, inserted
);
2572 p
= Vafter_insert_file_functions
;
2575 insval
= call1 (Fcar (p
), make_number (inserted
));
2578 CHECK_NUMBER (insval
, 0);
2579 inserted
= XFASTINT (insval
);
2587 RETURN_UNGCPRO (val
);
2588 RETURN_UNGCPRO (Fcons (filename
,
2589 Fcons (make_number (inserted
),
2593 static Lisp_Object
build_annotations ();
2595 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2596 "r\nFWrite region to file: ",
2597 "Write current region into specified file.\n\
2598 When called from a program, takes three arguments:\n\
2599 START, END and FILENAME. START and END are buffer positions.\n\
2600 Optional fourth argument APPEND if non-nil means\n\
2601 append to existing file contents (if any).\n\
2602 Optional fifth argument VISIT if t means\n\
2603 set the last-save-file-modtime of buffer to this file's modtime\n\
2604 and mark buffer not modified.\n\
2605 If VISIT is a string, it is a second file name;\n\
2606 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2607 VISIT is also the file name to lock and unlock for clash detection.\n\
2608 If VISIT is neither t nor nil nor a string,\n\
2609 that means do not print the \"Wrote file\" message.\n\
2610 Kludgy feature: if START is a string, then that string is written\n\
2611 to the file, instead of any buffer contents, and END is ignored.")
2612 (start
, end
, filename
, append
, visit
)
2613 Lisp_Object start
, end
, filename
, append
, visit
;
2621 int count
= specpdl_ptr
- specpdl
;
2623 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2625 Lisp_Object handler
;
2626 Lisp_Object visit_file
;
2627 Lisp_Object annotations
;
2628 int visiting
, quietly
;
2629 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2631 /* Special kludge to simplify auto-saving */
2634 XFASTINT (start
) = BEG
;
2637 else if (XTYPE (start
) != Lisp_String
)
2638 validate_region (&start
, &end
);
2640 filename
= Fexpand_file_name (filename
, Qnil
);
2641 if (XTYPE (visit
) == Lisp_String
)
2642 visit_file
= Fexpand_file_name (visit
, Qnil
);
2644 visit_file
= filename
;
2646 visiting
= (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
);
2647 quietly
= !NILP (visit
);
2651 GCPRO4 (start
, filename
, annotations
, visit_file
);
2653 /* If the file name has special constructs in it,
2654 call the corresponding file handler. */
2655 handler
= Ffind_file_name_handler (filename
);
2657 if (!NILP (handler
))
2660 val
= call6 (handler
, Qwrite_region
, start
, end
,
2661 filename
, append
, visit
);
2665 current_buffer
->save_modified
= MODIFF
;
2666 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2667 current_buffer
->filename
= visit_file
;
2673 annotations
= build_annotations (start
, end
);
2675 #ifdef CLASH_DETECTION
2677 lock_file (visit_file
);
2678 #endif /* CLASH_DETECTION */
2680 fn
= XSTRING (filename
)->data
;
2683 desc
= open (fn
, O_WRONLY
);
2687 if (auto_saving
) /* Overwrite any previous version of autosave file */
2689 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2690 desc
= open (fn
, O_RDWR
);
2692 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2693 ? XSTRING (current_buffer
->filename
)->data
: 0,
2696 else /* Write to temporary name and rename if no errors */
2698 Lisp_Object temp_name
;
2699 temp_name
= Ffile_name_directory (filename
);
2701 if (!NILP (temp_name
))
2703 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2704 build_string ("$$SAVE$$")));
2705 fname
= XSTRING (filename
)->data
;
2706 fn
= XSTRING (temp_name
)->data
;
2707 desc
= creat_copy_attrs (fname
, fn
);
2710 /* If we can't open the temporary file, try creating a new
2711 version of the original file. VMS "creat" creates a
2712 new version rather than truncating an existing file. */
2715 desc
= creat (fn
, 0666);
2716 #if 0 /* This can clobber an existing file and fail to replace it,
2717 if the user runs out of space. */
2720 /* We can't make a new version;
2721 try to truncate and rewrite existing version if any. */
2723 desc
= open (fn
, O_RDWR
);
2729 desc
= creat (fn
, 0666);
2732 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2733 #endif /* not VMS */
2739 #ifdef CLASH_DETECTION
2741 if (!auto_saving
) unlock_file (visit_file
);
2743 #endif /* CLASH_DETECTION */
2744 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2747 record_unwind_protect (close_file_unwind
, make_number (desc
));
2750 if (lseek (desc
, 0, 2) < 0)
2752 #ifdef CLASH_DETECTION
2753 if (!auto_saving
) unlock_file (visit_file
);
2754 #endif /* CLASH_DETECTION */
2755 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2760 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2761 * if we do writes that don't end with a carriage return. Furthermore
2762 * it cannot handle writes of more then 16K. The modified
2763 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2764 * this EXCEPT for the last record (iff it doesn't end with a carriage
2765 * return). This implies that if your buffer doesn't end with a carriage
2766 * return, you get one free... tough. However it also means that if
2767 * we make two calls to sys_write (a la the following code) you can
2768 * get one at the gap as well. The easiest way to fix this (honest)
2769 * is to move the gap to the next newline (or the end of the buffer).
2774 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2775 move_gap (find_next_newline (GPT
, 1));
2781 if (XTYPE (start
) == Lisp_String
)
2783 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
2784 XSTRING (start
)->size
, 0, &annotations
);
2787 else if (XINT (start
) != XINT (end
))
2790 if (XINT (start
) < GPT
)
2792 register int end1
= XINT (end
);
2794 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
2795 min (GPT
, end1
) - tem
, tem
, &annotations
);
2796 nwritten
+= min (GPT
, end1
) - tem
;
2800 if (XINT (end
) > GPT
&& !failure
)
2803 tem
= max (tem
, GPT
);
2804 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
2806 nwritten
+= XINT (end
) - tem
;
2812 /* If file was empty, still need to write the annotations */
2813 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
2821 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2822 Disk full in NFS may be reported here. */
2823 /* mib says that closing the file will try to write as fast as NFS can do
2824 it, and that means the fsync here is not crucial for autosave files. */
2825 if (!auto_saving
&& fsync (desc
) < 0)
2826 failure
= 1, save_errno
= errno
;
2829 /* Spurious "file has changed on disk" warnings have been
2830 observed on Suns as well.
2831 It seems that `close' can change the modtime, under nfs.
2833 (This has supposedly been fixed in Sunos 4,
2834 but who knows about all the other machines with NFS?) */
2837 /* On VMS and APOLLO, must do the stat after the close
2838 since closing changes the modtime. */
2841 /* Recall that #if defined does not work on VMS. */
2848 /* NFS can report a write failure now. */
2849 if (close (desc
) < 0)
2850 failure
= 1, save_errno
= errno
;
2853 /* If we wrote to a temporary name and had no errors, rename to real name. */
2857 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2865 /* Discard the unwind protect */
2866 specpdl_ptr
= specpdl
+ count
;
2868 #ifdef CLASH_DETECTION
2870 unlock_file (visit_file
);
2871 #endif /* CLASH_DETECTION */
2873 /* Do this before reporting IO error
2874 to avoid a "file has changed on disk" warning on
2875 next attempt to save. */
2877 current_buffer
->modtime
= st
.st_mtime
;
2880 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2884 current_buffer
->save_modified
= MODIFF
;
2885 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2886 current_buffer
->filename
= visit_file
;
2892 message ("Wrote %s", XSTRING (visit_file
)->data
);
2897 Lisp_Object
merge ();
2899 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
2900 "Return t if (car A) is numerically less than (car B).")
2904 return Flss (Fcar (a
), Fcar (b
));
2907 /* Build the complete list of annotations appropriate for writing out
2908 the text between START and END, by calling all the functions in
2909 write-region-annotate-functions and merging the lists they return. */
2912 build_annotations (start
, end
)
2913 Lisp_Object start
, end
;
2915 Lisp_Object annotations
;
2917 struct gcpro gcpro1
, gcpro2
;
2920 p
= Vwrite_region_annotate_functions
;
2921 GCPRO2 (annotations
, p
);
2924 res
= call2 (Fcar (p
), start
, end
);
2925 Flength (res
); /* Check basic validity of return value */
2926 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
2933 /* Write to descriptor DESC the LEN characters starting at ADDR,
2934 assuming they start at position POS in the buffer.
2935 Intersperse with them the annotations from *ANNOT
2936 (those which fall within the range of positions POS to POS + LEN),
2937 each at its appropriate position.
2939 Modify *ANNOT by discarding elements as we output them.
2940 The return value is negative in case of system call failure. */
2943 a_write (desc
, addr
, len
, pos
, annot
)
2945 register char *addr
;
2952 int lastpos
= pos
+ len
;
2956 tem
= Fcar_safe (Fcar (*annot
));
2957 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
2958 nextpos
= XFASTINT (tem
);
2960 return e_write (desc
, addr
, lastpos
- pos
);
2963 if (0 > e_write (desc
, addr
, nextpos
- pos
))
2965 addr
+= nextpos
- pos
;
2968 tem
= Fcdr (Fcar (*annot
));
2971 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
2974 *annot
= Fcdr (*annot
);
2979 e_write (desc
, addr
, len
)
2981 register char *addr
;
2984 char buf
[16 * 1024];
2985 register char *p
, *end
;
2987 if (!EQ (current_buffer
->selective_display
, Qt
))
2988 return write (desc
, addr
, len
) - len
;
2992 end
= p
+ sizeof buf
;
2997 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3006 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3012 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3013 Sverify_visited_file_modtime
, 1, 1, 0,
3014 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3015 This means that the file has not been changed since it was visited or saved.")
3021 Lisp_Object handler
;
3023 CHECK_BUFFER (buf
, 0);
3026 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
3027 if (b
->modtime
== 0) return Qt
;
3029 /* If the file name has special constructs in it,
3030 call the corresponding file handler. */
3031 handler
= Ffind_file_name_handler (b
->filename
);
3032 if (!NILP (handler
))
3033 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3035 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3037 /* If the file doesn't exist now and didn't exist before,
3038 we say that it isn't modified, provided the error is a tame one. */
3039 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3044 if (st
.st_mtime
== b
->modtime
3045 /* If both are positive, accept them if they are off by one second. */
3046 || (st
.st_mtime
> 0 && b
->modtime
> 0
3047 && (st
.st_mtime
== b
->modtime
+ 1
3048 || st
.st_mtime
== b
->modtime
- 1)))
3053 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3054 Sclear_visited_file_modtime
, 0, 0, 0,
3055 "Clear out records of last mod time of visited file.\n\
3056 Next attempt to save will certainly not complain of a discrepancy.")
3059 current_buffer
->modtime
= 0;
3063 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3064 Svisited_file_modtime
, 0, 0, 0,
3065 "Return the current buffer's recorded visited file modification time.\n\
3066 The value is a list of the form (HIGH . LOW), like the time values\n\
3067 that `file-attributes' returns.")
3070 return long_to_cons (current_buffer
->modtime
);
3073 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3074 Sset_visited_file_modtime
, 0, 1, 0,
3075 "Update buffer's recorded modification time from the visited file's time.\n\
3076 Useful if the buffer was not read from the file normally\n\
3077 or if the file itself has been changed for some known benign reason.\n\
3078 An argument specifies the modification time value to use\n\
3079 \(instead of that of the visited file), in the form of a list\n\
3080 \(HIGH . LOW) or (HIGH LOW).")
3082 Lisp_Object time_list
;
3084 if (!NILP (time_list
))
3085 current_buffer
->modtime
= cons_to_long (time_list
);
3088 register Lisp_Object filename
;
3090 Lisp_Object handler
;
3092 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3094 /* If the file name has special constructs in it,
3095 call the corresponding file handler. */
3096 handler
= Ffind_file_name_handler (filename
);
3097 if (!NILP (handler
))
3098 /* The handler can find the file name the same way we did. */
3099 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3100 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3101 current_buffer
->modtime
= st
.st_mtime
;
3110 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
3113 message ("Autosaving...error for %s", name
);
3114 Fsleep_for (make_number (1), Qnil
);
3115 message ("Autosaving...error!for %s", name
);
3116 Fsleep_for (make_number (1), Qnil
);
3117 message ("Autosaving...error for %s", name
);
3118 Fsleep_for (make_number (1), Qnil
);
3128 /* Get visited file's mode to become the auto save file's mode. */
3129 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3130 /* But make sure we can overwrite it later! */
3131 auto_save_mode_bits
= st
.st_mode
| 0600;
3133 auto_save_mode_bits
= 0666;
3136 Fwrite_region (Qnil
, Qnil
,
3137 current_buffer
->auto_save_file_name
,
3141 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3142 "Auto-save all buffers that need it.\n\
3143 This is all buffers that have auto-saving enabled\n\
3144 and are changed since last auto-saved.\n\
3145 Auto-saving writes the buffer into a file\n\
3146 so that your editing is not lost if the system crashes.\n\
3147 This file is not the file you visited; that changes only when you save.\n\n\
3148 Non-nil first argument means do not print any message if successful.\n\
3149 Non-nil second argument means save only current buffer.")
3150 (no_message
, current_only
)
3151 Lisp_Object no_message
, current_only
;
3153 struct buffer
*old
= current_buffer
, *b
;
3154 Lisp_Object tail
, buf
;
3156 char *omessage
= echo_area_glyphs
;
3157 extern int minibuf_level
;
3158 int do_handled_files
;
3161 /* Ordinarily don't quit within this function,
3162 but don't make it impossible to quit (in case we get hung in I/O). */
3166 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3167 point to non-strings reached from Vbuffer_alist. */
3173 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
3174 eventually call do-auto-save, so don't err here in that case. */
3175 if (!NILP (Vrun_hooks
))
3176 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3178 /* First, save all files which don't have handlers. If Emacs is
3179 crashing, the handlers may tweak what is causing Emacs to crash
3180 in the first place, and it would be a shame if Emacs failed to
3181 autosave perfectly ordinary files because it couldn't handle some
3183 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3184 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
3185 tail
= XCONS (tail
)->cdr
)
3187 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3190 if (!NILP (current_only
)
3191 && b
!= current_buffer
)
3194 /* Check for auto save enabled
3195 and file changed since last auto save
3196 and file changed since last real save. */
3197 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3198 && b
->save_modified
< BUF_MODIFF (b
)
3199 && b
->auto_save_modified
< BUF_MODIFF (b
)
3200 && (do_handled_files
3201 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
))))
3203 if ((XFASTINT (b
->save_length
) * 10
3204 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3205 /* A short file is likely to change a large fraction;
3206 spare the user annoying messages. */
3207 && XFASTINT (b
->save_length
) > 5000
3208 /* These messages are frequent and annoying for `*mail*'. */
3209 && !EQ (b
->filename
, Qnil
)
3210 && NILP (no_message
))
3212 /* It has shrunk too much; turn off auto-saving here. */
3213 message ("Buffer %s has shrunk a lot; auto save turned off there",
3214 XSTRING (b
->name
)->data
);
3215 /* User can reenable saving with M-x auto-save. */
3216 b
->auto_save_file_name
= Qnil
;
3217 /* Prevent warning from repeating if user does so. */
3218 XFASTINT (b
->save_length
) = 0;
3219 Fsleep_for (make_number (1), Qnil
);
3222 set_buffer_internal (b
);
3223 if (!auto_saved
&& NILP (no_message
))
3224 message1 ("Auto-saving...");
3225 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3227 b
->auto_save_modified
= BUF_MODIFF (b
);
3228 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3229 set_buffer_internal (old
);
3233 /* Prevent another auto save till enough input events come in. */
3234 record_auto_save ();
3236 if (auto_saved
&& NILP (no_message
))
3237 message1 (omessage
? omessage
: "Auto-saving...done");
3245 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3246 Sset_buffer_auto_saved
, 0, 0, 0,
3247 "Mark current buffer as auto-saved with its current text.\n\
3248 No auto-save file will be written until the buffer changes again.")
3251 current_buffer
->auto_save_modified
= MODIFF
;
3252 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3256 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3258 "Return t if buffer has been auto-saved since last read in or saved.")
3261 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3264 /* Reading and completing file names */
3265 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3267 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3269 "Internal subroutine for read-file-name. Do not call this.")
3270 (string
, dir
, action
)
3271 Lisp_Object string
, dir
, action
;
3272 /* action is nil for complete, t for return list of completions,
3273 lambda for verify final value */
3275 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3277 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3284 /* No need to protect ACTION--we only compare it with t and nil. */
3285 GCPRO4 (string
, realdir
, name
, specdir
);
3287 if (XSTRING (string
)->size
== 0)
3289 if (EQ (action
, Qlambda
))
3297 orig_string
= string
;
3298 string
= Fsubstitute_in_file_name (string
);
3299 changed
= NILP (Fstring_equal (string
, orig_string
));
3300 name
= Ffile_name_nondirectory (string
);
3301 val
= Ffile_name_directory (string
);
3303 realdir
= Fexpand_file_name (val
, realdir
);
3308 specdir
= Ffile_name_directory (string
);
3309 val
= Ffile_name_completion (name
, realdir
);
3311 if (XTYPE (val
) != Lisp_String
)
3318 if (!NILP (specdir
))
3319 val
= concat2 (specdir
, val
);
3322 register unsigned char *old
, *new;
3326 osize
= XSTRING (val
)->size
;
3327 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3328 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3329 if (*old
++ == '$') count
++;
3332 old
= XSTRING (val
)->data
;
3333 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3334 new = XSTRING (val
)->data
;
3335 for (n
= osize
; n
> 0; n
--)
3346 #endif /* Not VMS */
3351 if (EQ (action
, Qt
))
3352 return Ffile_name_all_completions (name
, realdir
);
3353 /* Only other case actually used is ACTION = lambda */
3355 /* Supposedly this helps commands such as `cd' that read directory names,
3356 but can someone explain how it helps them? -- RMS */
3357 if (XSTRING (name
)->size
== 0)
3360 return Ffile_exists_p (string
);
3363 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3364 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3365 Value is not expanded---you must call `expand-file-name' yourself.\n\
3366 Default name to DEFAULT if user enters a null string.\n\
3367 (If DEFAULT is omitted, the visited file name is used.)\n\
3368 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3369 Non-nil and non-t means also require confirmation after completion.\n\
3370 Fifth arg INITIAL specifies text to start with.\n\
3371 DIR defaults to current buffer's directory default.")
3372 (prompt
, dir
, defalt
, mustmatch
, initial
)
3373 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3375 Lisp_Object val
, insdef
, insdef1
, tem
;
3376 struct gcpro gcpro1
, gcpro2
;
3377 register char *homedir
;
3381 dir
= current_buffer
->directory
;
3383 defalt
= current_buffer
->filename
;
3385 /* If dir starts with user's homedir, change that to ~. */
3386 homedir
= (char *) egetenv ("HOME");
3388 && XTYPE (dir
) == Lisp_String
3389 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3390 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3392 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3393 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3394 XSTRING (dir
)->data
[0] = '~';
3397 if (insert_default_directory
)
3401 if (!NILP (initial
))
3403 Lisp_Object args
[2], pos
;
3407 insdef
= Fconcat (2, args
);
3408 pos
= make_number (XSTRING (dir
)->size
);
3409 insdef1
= Fcons (insdef
, pos
);
3413 insdef
= Qnil
, insdef1
= Qnil
;
3416 count
= specpdl_ptr
- specpdl
;
3417 specbind (intern ("completion-ignore-case"), Qt
);
3420 GCPRO2 (insdef
, defalt
);
3421 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3422 dir
, mustmatch
, insdef1
,
3423 Qfile_name_history
);
3426 unbind_to (count
, Qnil
);
3431 error ("No file name specified");
3432 tem
= Fstring_equal (val
, insdef
);
3433 if (!NILP (tem
) && !NILP (defalt
))
3435 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3440 error ("No default file name");
3442 return Fsubstitute_in_file_name (val
);
3445 #if 0 /* Old version */
3446 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3447 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3448 Value is not expanded---you must call `expand-file-name' yourself.\n\
3449 Default name to DEFAULT if user enters a null string.\n\
3450 (If DEFAULT is omitted, the visited file name is used.)\n\
3451 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3452 Non-nil and non-t means also require confirmation after completion.\n\
3453 Fifth arg INITIAL specifies text to start with.\n\
3454 DIR defaults to current buffer's directory default.")
3455 (prompt
, dir
, defalt
, mustmatch
, initial
)
3456 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3458 Lisp_Object val
, insdef
, tem
;
3459 struct gcpro gcpro1
, gcpro2
;
3460 register char *homedir
;
3464 dir
= current_buffer
->directory
;
3466 defalt
= current_buffer
->filename
;
3468 /* If dir starts with user's homedir, change that to ~. */
3469 homedir
= (char *) egetenv ("HOME");
3471 && XTYPE (dir
) == Lisp_String
3472 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3473 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3475 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3476 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3477 XSTRING (dir
)->data
[0] = '~';
3480 if (!NILP (initial
))
3482 else if (insert_default_directory
)
3485 insdef
= build_string ("");
3488 count
= specpdl_ptr
- specpdl
;
3489 specbind (intern ("completion-ignore-case"), Qt
);
3492 GCPRO2 (insdef
, defalt
);
3493 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3495 insert_default_directory
? insdef
: Qnil
,
3496 Qfile_name_history
);
3499 unbind_to (count
, Qnil
);
3504 error ("No file name specified");
3505 tem
= Fstring_equal (val
, insdef
);
3506 if (!NILP (tem
) && !NILP (defalt
))
3508 return Fsubstitute_in_file_name (val
);
3510 #endif /* Old version */
3514 Qexpand_file_name
= intern ("expand-file-name");
3515 Qdirectory_file_name
= intern ("directory-file-name");
3516 Qfile_name_directory
= intern ("file-name-directory");
3517 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3518 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
3519 Qfile_name_as_directory
= intern ("file-name-as-directory");
3520 Qcopy_file
= intern ("copy-file");
3521 Qmake_directory
= intern ("make-directory");
3522 Qdelete_directory
= intern ("delete-directory");
3523 Qdelete_file
= intern ("delete-file");
3524 Qrename_file
= intern ("rename-file");
3525 Qadd_name_to_file
= intern ("add-name-to-file");
3526 Qmake_symbolic_link
= intern ("make-symbolic-link");
3527 Qfile_exists_p
= intern ("file-exists-p");
3528 Qfile_executable_p
= intern ("file-executable-p");
3529 Qfile_readable_p
= intern ("file-readable-p");
3530 Qfile_symlink_p
= intern ("file-symlink-p");
3531 Qfile_writable_p
= intern ("file-writable-p");
3532 Qfile_directory_p
= intern ("file-directory-p");
3533 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3534 Qfile_modes
= intern ("file-modes");
3535 Qset_file_modes
= intern ("set-file-modes");
3536 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3537 Qinsert_file_contents
= intern ("insert-file-contents");
3538 Qwrite_region
= intern ("write-region");
3539 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3540 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
3542 staticpro (&Qexpand_file_name
);
3543 staticpro (&Qdirectory_file_name
);
3544 staticpro (&Qfile_name_directory
);
3545 staticpro (&Qfile_name_nondirectory
);
3546 staticpro (&Qunhandled_file_name_directory
);
3547 staticpro (&Qfile_name_as_directory
);
3548 staticpro (&Qcopy_file
);
3549 staticpro (&Qmake_directory
);
3550 staticpro (&Qdelete_directory
);
3551 staticpro (&Qdelete_file
);
3552 staticpro (&Qrename_file
);
3553 staticpro (&Qadd_name_to_file
);
3554 staticpro (&Qmake_symbolic_link
);
3555 staticpro (&Qfile_exists_p
);
3556 staticpro (&Qfile_executable_p
);
3557 staticpro (&Qfile_readable_p
);
3558 staticpro (&Qfile_symlink_p
);
3559 staticpro (&Qfile_writable_p
);
3560 staticpro (&Qfile_directory_p
);
3561 staticpro (&Qfile_accessible_directory_p
);
3562 staticpro (&Qfile_modes
);
3563 staticpro (&Qset_file_modes
);
3564 staticpro (&Qfile_newer_than_file_p
);
3565 staticpro (&Qinsert_file_contents
);
3566 staticpro (&Qwrite_region
);
3567 staticpro (&Qverify_visited_file_modtime
);
3569 Qfile_name_history
= intern ("file-name-history");
3570 Fset (Qfile_name_history
, Qnil
);
3571 staticpro (&Qfile_name_history
);
3573 Qfile_error
= intern ("file-error");
3574 staticpro (&Qfile_error
);
3575 Qfile_already_exists
= intern("file-already-exists");
3576 staticpro (&Qfile_already_exists
);
3578 Qcar_less_than_car
= intern ("car-less-than-car");
3579 staticpro (&Qcar_less_than_car
);
3581 Fput (Qfile_error
, Qerror_conditions
,
3582 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3583 Fput (Qfile_error
, Qerror_message
,
3584 build_string ("File error"));
3586 Fput (Qfile_already_exists
, Qerror_conditions
,
3587 Fcons (Qfile_already_exists
,
3588 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3589 Fput (Qfile_already_exists
, Qerror_message
,
3590 build_string ("File already exists"));
3592 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3593 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3594 insert_default_directory
= 1;
3596 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3597 "*Non-nil means write new files with record format `stmlf'.\n\
3598 nil means use format `var'. This variable is meaningful only on VMS.");
3599 vms_stmlf_recfm
= 0;
3601 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
3602 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3603 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3606 The first argument given to HANDLER is the name of the I/O primitive\n\
3607 to be handled; the remaining arguments are the arguments that were\n\
3608 passed to that primitive. For example, if you do\n\
3609 (file-exists-p FILENAME)\n\
3610 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
3611 (funcall HANDLER 'file-exists-p FILENAME)\n\
3612 The function `find-file-name-handler' checks this list for a handler\n\
3613 for its argument.");
3614 Vfile_name_handler_alist
= Qnil
;
3616 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
3617 "A list of functions to be called at the end of `insert-file-contents'.\n\
3618 Each is passed one argument, the number of bytes inserted. It should return\n\
3619 the new byte count, and leave point the same. If `insert-file-contents' is\n\
3620 intercepted by a handler from `file-name-handler-alist', that handler is\n\
3621 responsible for calling the after-insert-file-functions if appropriate.");
3622 Vafter_insert_file_functions
= Qnil
;
3624 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
3625 "A list of functions to be called at the start of `write-region'.\n\
3626 Each is passed two arguments, START and END as for `write-region'. It should\n\
3627 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
3628 inserted at the specified positions of the file being written (1 means to\n\
3629 insert before the first byte written). The POSITIONs must be sorted into\n\
3630 increasing order. If there are several functions in the list, the several\n\
3631 lists are merged destructively.");
3632 Vwrite_region_annotate_functions
= Qnil
;
3634 defsubr (&Sfind_file_name_handler
);
3635 defsubr (&Sfile_name_directory
);
3636 defsubr (&Sfile_name_nondirectory
);
3637 defsubr (&Sunhandled_file_name_directory
);
3638 defsubr (&Sfile_name_as_directory
);
3639 defsubr (&Sdirectory_file_name
);
3640 defsubr (&Smake_temp_name
);
3641 defsubr (&Sexpand_file_name
);
3642 defsubr (&Ssubstitute_in_file_name
);
3643 defsubr (&Scopy_file
);
3644 defsubr (&Smake_directory_internal
);
3645 defsubr (&Sdelete_directory
);
3646 defsubr (&Sdelete_file
);
3647 defsubr (&Srename_file
);
3648 defsubr (&Sadd_name_to_file
);
3650 defsubr (&Smake_symbolic_link
);
3651 #endif /* S_IFLNK */
3653 defsubr (&Sdefine_logical_name
);
3656 defsubr (&Ssysnetunam
);
3657 #endif /* HPUX_NET */
3658 defsubr (&Sfile_name_absolute_p
);
3659 defsubr (&Sfile_exists_p
);
3660 defsubr (&Sfile_executable_p
);
3661 defsubr (&Sfile_readable_p
);
3662 defsubr (&Sfile_writable_p
);
3663 defsubr (&Sfile_symlink_p
);
3664 defsubr (&Sfile_directory_p
);
3665 defsubr (&Sfile_accessible_directory_p
);
3666 defsubr (&Sfile_modes
);
3667 defsubr (&Sset_file_modes
);
3668 defsubr (&Sset_default_file_modes
);
3669 defsubr (&Sdefault_file_modes
);
3670 defsubr (&Sfile_newer_than_file_p
);
3671 defsubr (&Sinsert_file_contents
);
3672 defsubr (&Swrite_region
);
3673 defsubr (&Scar_less_than_car
);
3674 defsubr (&Sverify_visited_file_modtime
);
3675 defsubr (&Sclear_visited_file_modtime
);
3676 defsubr (&Svisited_file_modtime
);
3677 defsubr (&Sset_visited_file_modtime
);
3678 defsubr (&Sdo_auto_save
);
3679 defsubr (&Sset_buffer_auto_saved
);
3680 defsubr (&Srecent_auto_save_p
);
3682 defsubr (&Sread_file_name_internal
);
3683 defsubr (&Sread_file_name
);
3686 defsubr (&Sunix_sync
);