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>
44 extern char *sys_errlist
[];
48 #define err_str(a) ((a) < sys_nerr ? sys_errlist[a] : "unknown error")
63 #include "intervals.h"
89 #define min(a, b) ((a) < (b) ? (a) : (b))
90 #define max(a, b) ((a) > (b) ? (a) : (b))
92 /* Nonzero during writing of auto-save files */
95 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
96 a new file with the same mode as the original */
97 int auto_save_mode_bits
;
99 /* Alist of elements (REGEXP . HANDLER) for file names
100 whose I/O is done with a special handler. */
101 Lisp_Object Vfile_name_handler_alist
;
103 /* Nonzero means, when reading a filename in the minibuffer,
104 start out by inserting the default directory into the minibuffer. */
105 int insert_default_directory
;
107 /* On VMS, nonzero means write new files with record format stmlf.
108 Zero means use var format. */
111 Lisp_Object Qfile_error
, Qfile_already_exists
;
113 Lisp_Object Qfile_name_history
;
115 report_file_error (string
, data
)
119 Lisp_Object errstring
;
121 if (errno
>= 0 && errno
< sys_nerr
)
122 errstring
= build_string (sys_errlist
[errno
]);
124 errstring
= build_string ("undocumented error code");
126 /* System error messages are capitalized. Downcase the initial
127 unless it is followed by a slash. */
128 if (XSTRING (errstring
)->data
[1] != '/')
129 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
132 Fsignal (Qfile_error
,
133 Fcons (build_string (string
), Fcons (errstring
, data
)));
136 close_file_unwind (fd
)
139 close (XFASTINT (fd
));
142 Lisp_Object Qexpand_file_name
;
143 Lisp_Object Qdirectory_file_name
;
144 Lisp_Object Qfile_name_directory
;
145 Lisp_Object Qfile_name_nondirectory
;
146 Lisp_Object Qunhandled_file_name_directory
;
147 Lisp_Object Qfile_name_as_directory
;
148 Lisp_Object Qcopy_file
;
149 Lisp_Object Qmake_directory
;
150 Lisp_Object Qdelete_directory
;
151 Lisp_Object Qdelete_file
;
152 Lisp_Object Qrename_file
;
153 Lisp_Object Qadd_name_to_file
;
154 Lisp_Object Qmake_symbolic_link
;
155 Lisp_Object Qfile_exists_p
;
156 Lisp_Object Qfile_executable_p
;
157 Lisp_Object Qfile_readable_p
;
158 Lisp_Object Qfile_symlink_p
;
159 Lisp_Object Qfile_writable_p
;
160 Lisp_Object Qfile_directory_p
;
161 Lisp_Object Qfile_accessible_directory_p
;
162 Lisp_Object Qfile_modes
;
163 Lisp_Object Qset_file_modes
;
164 Lisp_Object Qfile_newer_than_file_p
;
165 Lisp_Object Qinsert_file_contents
;
166 Lisp_Object Qwrite_region
;
167 Lisp_Object Qverify_visited_file_modtime
;
168 Lisp_Object Qset_visited_file_modtime
;
170 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 1, 1, 0,
171 "Return FILENAME's handler function, if its syntax is handled specially.\n\
172 Otherwise, return nil.\n\
173 A file name is handled if one of the regular expressions in\n\
174 `file-name-handler-alist' matches it.")
176 Lisp_Object filename
;
178 /* This function must not munge the match data. */
181 CHECK_STRING (filename
, 0);
183 for (chain
= Vfile_name_handler_alist
; XTYPE (chain
) == Lisp_Cons
;
184 chain
= XCONS (chain
)->cdr
)
187 elt
= XCONS (chain
)->car
;
188 if (XTYPE (elt
) == Lisp_Cons
)
191 string
= XCONS (elt
)->car
;
192 if (XTYPE (string
) == Lisp_String
193 && fast_string_match (string
, filename
) >= 0)
194 return XCONS (elt
)->cdr
;
202 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
204 "Return the directory component in file name NAME.\n\
205 Return nil if NAME does not include a directory.\n\
206 Otherwise return a directory spec.\n\
207 Given a Unix syntax file name, returns a string ending in slash;\n\
208 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
212 register unsigned char *beg
;
213 register unsigned char *p
;
216 CHECK_STRING (file
, 0);
218 /* If the file name has special constructs in it,
219 call the corresponding file handler. */
220 handler
= Ffind_file_name_handler (file
);
222 return call2 (handler
, Qfile_name_directory
, file
);
224 beg
= XSTRING (file
)->data
;
225 p
= beg
+ XSTRING (file
)->size
;
227 while (p
!= beg
&& p
[-1] != '/'
229 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
235 return make_string (beg
, p
- beg
);
238 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
240 "Return file name NAME sans its directory.\n\
241 For example, in a Unix-syntax file name,\n\
242 this is everything after the last slash,\n\
243 or the entire name if it contains no slash.")
247 register unsigned char *beg
, *p
, *end
;
250 CHECK_STRING (file
, 0);
252 /* If the file name has special constructs in it,
253 call the corresponding file handler. */
254 handler
= Ffind_file_name_handler (file
);
256 return call2 (handler
, Qfile_name_nondirectory
, file
);
258 beg
= XSTRING (file
)->data
;
259 end
= p
= beg
+ XSTRING (file
)->size
;
261 while (p
!= beg
&& p
[-1] != '/'
263 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
267 return make_string (p
, end
- p
);
270 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
271 "Return a directly usable directory name somehow associated with FILENAME.\n\
272 A `directly usable' directory name is one that may be used without the\n\
273 intervention of any file handler.\n\
274 If FILENAME is a directly usable file itself, return\n\
275 (file-name-directory FILENAME).\n\
276 The `call-process' and `start-process' functions use this function to\n\
277 get a current directory to run processes in.")
279 Lisp_Object filename
;
283 /* If the file name has special constructs in it,
284 call the corresponding file handler. */
285 handler
= Ffind_file_name_handler (filename
);
287 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
289 return Ffile_name_directory (filename
);
294 file_name_as_directory (out
, in
)
297 int size
= strlen (in
) - 1;
302 /* Is it already a directory string? */
303 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
305 /* Is it a VMS directory file name? If so, hack VMS syntax. */
306 else if (! index (in
, '/')
307 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
308 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
309 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
310 || ! strncmp (&in
[size
- 5], ".dir", 4))
311 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
312 && in
[size
] == '1')))
314 register char *p
, *dot
;
318 dir:x.dir --> dir:[x]
319 dir:[x]y.dir --> dir:[x.y] */
321 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
324 strncpy (out
, in
, p
- in
);
343 dot
= index (p
, '.');
346 /* blindly remove any extension */
347 size
= strlen (out
) + (dot
- p
);
348 strncat (out
, p
, dot
- p
);
359 /* For Unix syntax, Append a slash if necessary */
360 if (out
[size
] != '/')
366 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
367 Sfile_name_as_directory
, 1, 1, 0,
368 "Return a string representing file FILENAME interpreted as a directory.\n\
369 This operation exists because a directory is also a file, but its name as\n\
370 a directory is different from its name as a file.\n\
371 The result can be used as the value of `default-directory'\n\
372 or passed as second argument to `expand-file-name'.\n\
373 For a Unix-syntax file name, just appends a slash.\n\
374 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
381 CHECK_STRING (file
, 0);
385 /* If the file name has special constructs in it,
386 call the corresponding file handler. */
387 handler
= Ffind_file_name_handler (file
);
389 return call2 (handler
, Qfile_name_as_directory
, file
);
391 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
392 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
396 * Convert from directory name to filename.
398 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
399 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
400 * On UNIX, it's simple: just make sure there is a terminating /
402 * Value is nonzero if the string output is different from the input.
405 directory_file_name (src
, dst
)
413 struct FAB fab
= cc$rms_fab
;
414 struct NAM nam
= cc$rms_nam
;
415 char esa
[NAM$C_MAXRSS
];
420 if (! index (src
, '/')
421 && (src
[slen
- 1] == ']'
422 || src
[slen
- 1] == ':'
423 || src
[slen
- 1] == '>'))
425 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
427 fab
.fab$b_fns
= slen
;
428 fab
.fab$l_nam
= &nam
;
429 fab
.fab$l_fop
= FAB$M_NAM
;
432 nam
.nam$b_ess
= sizeof esa
;
433 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
435 /* We call SYS$PARSE to handle such things as [--] for us. */
436 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
438 slen
= nam
.nam$b_esl
;
439 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
444 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
446 /* what about when we have logical_name:???? */
447 if (src
[slen
- 1] == ':')
448 { /* Xlate logical name and see what we get */
449 ptr
= strcpy (dst
, src
); /* upper case for getenv */
452 if ('a' <= *ptr
&& *ptr
<= 'z')
456 dst
[slen
- 1] = 0; /* remove colon */
457 if (!(src
= egetenv (dst
)))
459 /* should we jump to the beginning of this procedure?
460 Good points: allows us to use logical names that xlate
462 Bad points: can be a problem if we just translated to a device
464 For now, I'll punt and always expect VMS names, and hope for
467 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
468 { /* no recursion here! */
474 { /* not a directory spec */
479 bracket
= src
[slen
- 1];
481 /* If bracket is ']' or '>', bracket - 2 is the corresponding
483 ptr
= index (src
, bracket
- 2);
485 { /* no opening bracket */
489 if (!(rptr
= rindex (src
, '.')))
492 strncpy (dst
, src
, slen
);
496 dst
[slen
++] = bracket
;
501 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
502 then translate the device and recurse. */
503 if (dst
[slen
- 1] == ':'
504 && dst
[slen
- 2] != ':' /* skip decnet nodes */
505 && strcmp(src
+ slen
, "[000000]") == 0)
507 dst
[slen
- 1] = '\0';
508 if ((ptr
= egetenv (dst
))
509 && (rlen
= strlen (ptr
) - 1) > 0
510 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
511 && ptr
[rlen
- 1] == '.')
513 char * buf
= (char *) alloca (strlen (ptr
) + 1);
517 return directory_file_name (buf
, dst
);
522 strcat (dst
, "[000000]");
526 rlen
= strlen (rptr
) - 1;
527 strncat (dst
, rptr
, rlen
);
528 dst
[slen
+ rlen
] = '\0';
529 strcat (dst
, ".DIR.1");
533 /* Process as Unix format: just remove any final slash.
534 But leave "/" unchanged; do not change it to "". */
536 if (slen
> 1 && dst
[slen
- 1] == '/')
541 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
543 "Returns the file name of the directory named DIR.\n\
544 This is the name of the file that holds the data for the directory DIR.\n\
545 This operation exists because a directory is also a file, but its name as\n\
546 a directory is different from its name as a file.\n\
547 In Unix-syntax, this function just removes the final slash.\n\
548 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
549 it returns a file name such as \"[X]Y.DIR.1\".")
551 Lisp_Object directory
;
556 CHECK_STRING (directory
, 0);
558 if (NILP (directory
))
561 /* If the file name has special constructs in it,
562 call the corresponding file handler. */
563 handler
= Ffind_file_name_handler (directory
);
565 return call2 (handler
, Qdirectory_file_name
, directory
);
568 /* 20 extra chars is insufficient for VMS, since we might perform a
569 logical name translation. an equivalence string can be up to 255
570 chars long, so grab that much extra space... - sss */
571 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
573 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
575 directory_file_name (XSTRING (directory
)->data
, buf
);
576 return build_string (buf
);
579 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
580 "Generate temporary file name (string) starting with PREFIX (a string).\n\
581 The Emacs process number forms part of the result,\n\
582 so there is no danger of generating a name being used by another process.")
587 val
= concat2 (prefix
, build_string ("XXXXXX"));
588 mktemp (XSTRING (val
)->data
);
592 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
593 "Convert FILENAME to absolute, and canonicalize it.\n\
594 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
595 (does not start with slash); if DEFAULT is nil or missing,\n\
596 the current buffer's value of default-directory is used.\n\
597 Path components that are `.' are removed, and \n\
598 path components followed by `..' are removed, along with the `..' itself;\n\
599 note that these simplifications are done without checking the resulting\n\
600 paths in the file system.\n\
601 An initial `~/' expands to your home directory.\n\
602 An initial `~USER/' expands to USER's home directory.\n\
603 See also the function `substitute-in-file-name'.")
605 Lisp_Object name
, defalt
;
609 register unsigned char *newdir
, *p
, *o
;
611 unsigned char *target
;
614 unsigned char * colon
= 0;
615 unsigned char * close
= 0;
616 unsigned char * slash
= 0;
617 unsigned char * brack
= 0;
618 int lbrack
= 0, rbrack
= 0;
623 CHECK_STRING (name
, 0);
625 /* If the file name has special constructs in it,
626 call the corresponding file handler. */
627 handler
= Ffind_file_name_handler (name
);
629 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
631 /* Use the buffer's default-directory if DEFALT is omitted. */
633 defalt
= current_buffer
->directory
;
634 CHECK_STRING (defalt
, 1);
636 /* Make sure DEFALT is properly expanded.
637 It would be better to do this down below where we actually use
638 defalt. Unfortunately, calling Fexpand_file_name recursively
639 could invoke GC, and the strings might be relocated. This would
640 be annoying because we have pointers into strings lying around
641 that would need adjusting, and people would add new pointers to
642 the code and forget to adjust them, resulting in intermittent bugs.
643 Putting this call here avoids all that crud.
645 The EQ test avoids infinite recursion. */
646 if (! NILP (defalt
) && !EQ (defalt
, name
)
647 /* This saves time in a common case. */
648 && XSTRING (defalt
)->data
[0] != '/')
653 defalt
= Fexpand_file_name (defalt
, Qnil
);
658 /* Filenames on VMS are always upper case. */
659 name
= Fupcase (name
);
662 nm
= XSTRING (name
)->data
;
664 /* If nm is absolute, flush ...// and detect /./ and /../.
665 If no /./ or /../ we can return right away. */
673 /* If it turns out that the filename we want to return is just a
674 suffix of FILENAME, we don't need to go through and edit
675 things; we just need to construct a new string using data
676 starting at the middle of FILENAME. If we set lose to a
677 non-zero value, that means we've discovered that we can't do
684 /* Since we know the path is absolute, we can assume that each
685 element starts with a "/". */
687 /* "//" anywhere isn't necessarily hairy; we just start afresh
688 with the second slash. */
689 if (p
[0] == '/' && p
[1] == '/'
691 /* // at start of filename is meaningful on Apollo system */
697 /* "~" is hairy as the start of any path element. */
698 if (p
[0] == '/' && p
[1] == '~')
699 nm
= p
+ 1, lose
= 1;
701 /* "." and ".." are hairy. */
706 || (p
[2] == '.' && (p
[3] == '/'
713 /* if dev:[dir]/, move nm to / */
714 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
715 nm
= (brack
? brack
+ 1 : colon
+ 1);
724 /* VMS pre V4.4,convert '-'s in filenames. */
725 if (lbrack
== rbrack
)
727 if (dots
< 2) /* this is to allow negative version numbers */
732 if (lbrack
> rbrack
&&
733 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
734 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
740 /* count open brackets, reset close bracket pointer */
741 if (p
[0] == '[' || p
[0] == '<')
743 /* count close brackets, set close bracket pointer */
744 if (p
[0] == ']' || p
[0] == '>')
746 /* detect ][ or >< */
747 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
749 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
750 nm
= p
+ 1, lose
= 1;
751 if (p
[0] == ':' && (colon
|| slash
))
752 /* if dev1:[dir]dev2:, move nm to dev2: */
758 /* if /pathname/dev:, move nm to dev: */
761 /* if node::dev:, move colon following dev */
762 else if (colon
&& colon
[-1] == ':')
764 /* if dev1:dev2:, move nm to dev2: */
765 else if (colon
&& colon
[-1] != ':')
770 if (p
[0] == ':' && !colon
)
776 if (lbrack
== rbrack
)
779 else if (p
[0] == '.')
788 return build_string (sys_translate_unix (nm
));
790 if (nm
== XSTRING (name
)->data
)
792 return build_string (nm
);
796 /* Now determine directory to start with and put it in newdir */
800 if (nm
[0] == '~') /* prefix ~ */
806 || nm
[1] == 0) /* ~ by itself */
808 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
809 newdir
= (unsigned char *) "";
812 nm
++; /* Don't leave the slash in nm. */
815 else /* ~user/filename */
817 for (p
= nm
; *p
&& (*p
!= '/'
822 o
= (unsigned char *) alloca (p
- nm
+ 1);
823 bcopy ((char *) nm
, o
, p
- nm
);
826 pw
= (struct passwd
*) getpwnam (o
+ 1);
829 newdir
= (unsigned char *) pw
-> pw_dir
;
831 nm
= p
+ 1; /* skip the terminator */
837 /* If we don't find a user of that name, leave the name
838 unchanged; don't move nm forward to p. */
848 newdir
= XSTRING (defalt
)->data
;
853 /* Get rid of any slash at the end of newdir. */
854 int length
= strlen (newdir
);
855 /* Adding `length > 1 &&' makes ~ expand into / when homedir
856 is the root dir. People disagree about whether that is right.
857 Anyway, we can't take the risk of this change now. */
858 if (newdir
[length
- 1] == '/')
860 unsigned char *temp
= (unsigned char *) alloca (length
);
861 bcopy (newdir
, temp
, length
- 1);
862 temp
[length
- 1] = 0;
870 /* Now concatenate the directory and name to new space in the stack frame */
871 tlen
+= strlen (nm
) + 1;
872 target
= (unsigned char *) alloca (tlen
);
878 if (nm
[0] == 0 || nm
[0] == '/')
879 strcpy (target
, newdir
);
882 file_name_as_directory (target
, newdir
);
887 if (index (target
, '/'))
888 strcpy (target
, sys_translate_unix (target
));
891 /* Now canonicalize by removing /. and /foo/.. if they appear. */
899 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
905 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
906 /* brackets are offset from each other by 2 */
909 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
910 /* convert [foo][bar] to [bar] */
911 while (o
[-1] != '[' && o
[-1] != '<')
913 else if (*p
== '-' && *o
!= '.')
916 else if (p
[0] == '-' && o
[-1] == '.' &&
917 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
918 /* flush .foo.- ; leave - if stopped by '[' or '<' */
922 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
923 if (p
[1] == '.') /* foo.-.bar ==> bar*/
925 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
927 /* else [foo.-] ==> [-] */
933 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
934 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
944 else if (!strncmp (p
, "//", 2)
946 /* // at start of filename is meaningful in Apollo system */
959 /* If "/." is the entire filename, keep the "/". Otherwise,
960 just delete the whole "/.". */
961 if (o
== target
&& p
[2] == '\0')
965 else if (!strncmp (p
, "/..", 3)
966 /* `/../' is the "superroot" on certain file systems. */
968 && (p
[3] == '/' || p
[3] == 0))
970 while (o
!= target
&& *--o
!= '/')
973 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
977 if (o
== target
&& *o
== '/')
988 return make_string (target
, o
- target
);
991 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
992 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
993 "Convert FILENAME to absolute, and canonicalize it.\n\
994 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
995 (does not start with slash); if DEFAULT is nil or missing,\n\
996 the current buffer's value of default-directory is used.\n\
997 Filenames containing `.' or `..' as components are simplified;\n\
998 initial `~/' expands to your home directory.\n\
999 See also the function `substitute-in-file-name'.")
1001 Lisp_Object name, defalt;
1005 register unsigned char *newdir, *p, *o;
1007 unsigned char *target;
1011 unsigned char * colon = 0;
1012 unsigned char * close = 0;
1013 unsigned char * slash = 0;
1014 unsigned char * brack = 0;
1015 int lbrack = 0, rbrack = 0;
1019 CHECK_STRING (name
, 0);
1022 /* Filenames on VMS are always upper case. */
1023 name
= Fupcase (name
);
1026 nm
= XSTRING (name
)->data
;
1028 /* If nm is absolute, flush ...// and detect /./ and /../.
1029 If no /./ or /../ we can return right away. */
1041 if (p
[0] == '/' && p
[1] == '/'
1043 /* // at start of filename is meaningful on Apollo system */
1048 if (p
[0] == '/' && p
[1] == '~')
1049 nm
= p
+ 1, lose
= 1;
1050 if (p
[0] == '/' && p
[1] == '.'
1051 && (p
[2] == '/' || p
[2] == 0
1052 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1058 /* if dev:[dir]/, move nm to / */
1059 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1060 nm
= (brack
? brack
+ 1 : colon
+ 1);
1061 lbrack
= rbrack
= 0;
1069 /* VMS pre V4.4,convert '-'s in filenames. */
1070 if (lbrack
== rbrack
)
1072 if (dots
< 2) /* this is to allow negative version numbers */
1077 if (lbrack
> rbrack
&&
1078 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1079 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1085 /* count open brackets, reset close bracket pointer */
1086 if (p
[0] == '[' || p
[0] == '<')
1087 lbrack
++, brack
= 0;
1088 /* count close brackets, set close bracket pointer */
1089 if (p
[0] == ']' || p
[0] == '>')
1090 rbrack
++, brack
= p
;
1091 /* detect ][ or >< */
1092 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1094 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1095 nm
= p
+ 1, lose
= 1;
1096 if (p
[0] == ':' && (colon
|| slash
))
1097 /* if dev1:[dir]dev2:, move nm to dev2: */
1103 /* if /pathname/dev:, move nm to dev: */
1106 /* if node::dev:, move colon following dev */
1107 else if (colon
&& colon
[-1] == ':')
1109 /* if dev1:dev2:, move nm to dev2: */
1110 else if (colon
&& colon
[-1] != ':')
1115 if (p
[0] == ':' && !colon
)
1121 if (lbrack
== rbrack
)
1124 else if (p
[0] == '.')
1132 if (index (nm
, '/'))
1133 return build_string (sys_translate_unix (nm
));
1135 if (nm
== XSTRING (name
)->data
)
1137 return build_string (nm
);
1141 /* Now determine directory to start with and put it in NEWDIR */
1145 if (nm
[0] == '~') /* prefix ~ */
1150 || nm
[1] == 0)/* ~/filename */
1152 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1153 newdir
= (unsigned char *) "";
1156 nm
++; /* Don't leave the slash in nm. */
1159 else /* ~user/filename */
1161 /* Get past ~ to user */
1162 unsigned char *user
= nm
+ 1;
1163 /* Find end of name. */
1164 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1165 int len
= ptr
? ptr
- user
: strlen (user
);
1167 unsigned char *ptr1
= index (user
, ':');
1168 if (ptr1
!= 0 && ptr1
- user
< len
)
1171 /* Copy the user name into temp storage. */
1172 o
= (unsigned char *) alloca (len
+ 1);
1173 bcopy ((char *) user
, o
, len
);
1176 /* Look up the user name. */
1177 pw
= (struct passwd
*) getpwnam (o
+ 1);
1179 error ("\"%s\" isn't a registered user", o
+ 1);
1181 newdir
= (unsigned char *) pw
->pw_dir
;
1183 /* Discard the user name from NM. */
1190 #endif /* not VMS */
1194 defalt
= current_buffer
->directory
;
1195 CHECK_STRING (defalt
, 1);
1196 newdir
= XSTRING (defalt
)->data
;
1199 /* Now concatenate the directory and name to new space in the stack frame */
1201 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1202 target
= (unsigned char *) alloca (tlen
);
1208 if (nm
[0] == 0 || nm
[0] == '/')
1209 strcpy (target
, newdir
);
1212 file_name_as_directory (target
, newdir
);
1215 strcat (target
, nm
);
1217 if (index (target
, '/'))
1218 strcpy (target
, sys_translate_unix (target
));
1221 /* Now canonicalize by removing /. and /foo/.. if they appear */
1229 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1235 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1236 /* brackets are offset from each other by 2 */
1239 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1240 /* convert [foo][bar] to [bar] */
1241 while (o
[-1] != '[' && o
[-1] != '<')
1243 else if (*p
== '-' && *o
!= '.')
1246 else if (p
[0] == '-' && o
[-1] == '.' &&
1247 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1248 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1252 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1253 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1255 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1257 /* else [foo.-] ==> [-] */
1263 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1264 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1274 else if (!strncmp (p
, "//", 2)
1276 /* // at start of filename is meaningful in Apollo system */
1284 else if (p
[0] == '/' && p
[1] == '.' &&
1285 (p
[2] == '/' || p
[2] == 0))
1287 else if (!strncmp (p
, "/..", 3)
1288 /* `/../' is the "superroot" on certain file systems. */
1290 && (p
[3] == '/' || p
[3] == 0))
1292 while (o
!= target
&& *--o
!= '/')
1295 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1299 if (o
== target
&& *o
== '/')
1307 #endif /* not VMS */
1310 return make_string (target
, o
- target
);
1314 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1315 Ssubstitute_in_file_name
, 1, 1, 0,
1316 "Substitute environment variables referred to in FILENAME.\n\
1317 `$FOO' where FOO is an environment variable name means to substitute\n\
1318 the value of that variable. The variable name should be terminated\n\
1319 with a character not a letter, digit or underscore; otherwise, enclose\n\
1320 the entire variable name in braces.\n\
1321 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1322 On VMS, `$' substitution is not done; this function does little and only\n\
1323 duplicates what `expand-file-name' does.")
1329 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1330 unsigned char *target
;
1332 int substituted
= 0;
1335 CHECK_STRING (string
, 0);
1337 nm
= XSTRING (string
)->data
;
1338 endp
= nm
+ XSTRING (string
)->size
;
1340 /* If /~ or // appears, discard everything through first slash. */
1342 for (p
= nm
; p
!= endp
; p
++)
1346 /* // at start of file name is meaningful in Apollo system */
1347 (p
[0] == '/' && p
- 1 != nm
)
1348 #else /* not APOLLO */
1350 #endif /* not APOLLO */
1354 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1367 return build_string (nm
);
1370 /* See if any variables are substituted into the string
1371 and find the total length of their values in `total' */
1373 for (p
= nm
; p
!= endp
;)
1383 /* "$$" means a single "$" */
1392 while (p
!= endp
&& *p
!= '}') p
++;
1393 if (*p
!= '}') goto missingclose
;
1399 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1403 /* Copy out the variable name */
1404 target
= (unsigned char *) alloca (s
- o
+ 1);
1405 strncpy (target
, o
, s
- o
);
1408 /* Get variable value */
1409 o
= (unsigned char *) egetenv (target
);
1410 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1413 if (!o
&& !strcmp (target
, "USER"))
1414 o
= egetenv ("LOGNAME");
1417 if (!o
) goto badvar
;
1418 total
+= strlen (o
);
1425 /* If substitution required, recopy the string and do it */
1426 /* Make space in stack frame for the new copy */
1427 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1430 /* Copy the rest of the name through, replacing $ constructs with values */
1447 while (p
!= endp
&& *p
!= '}') p
++;
1448 if (*p
!= '}') goto missingclose
;
1454 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1458 /* Copy out the variable name */
1459 target
= (unsigned char *) alloca (s
- o
+ 1);
1460 strncpy (target
, o
, s
- o
);
1463 /* Get variable value */
1464 o
= (unsigned char *) egetenv (target
);
1465 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1468 if (!o
&& !strcmp (target
, "USER"))
1469 o
= egetenv ("LOGNAME");
1481 /* If /~ or // appears, discard everything through first slash. */
1483 for (p
= xnm
; p
!= x
; p
++)
1486 /* // at start of file name is meaningful in Apollo system */
1487 (p
[0] == '/' && p
- 1 != xnm
)
1488 #else /* not APOLLO */
1490 #endif /* not APOLLO */
1492 && p
!= nm
&& p
[-1] == '/')
1495 return make_string (xnm
, x
- xnm
);
1498 error ("Bad format environment-variable substitution");
1500 error ("Missing \"}\" in environment-variable substitution");
1502 error ("Substituting nonexistent environment variable \"%s\"", target
);
1505 #endif /* not VMS */
1508 /* A slightly faster and more convenient way to get
1509 (directory-file-name (expand-file-name FOO)). The return value may
1510 have had its last character zapped with a '\0' character, meaning
1511 that it is acceptable to system calls, but not to other lisp
1512 functions. Callers should make sure that the return value doesn't
1516 expand_and_dir_to_file (filename
, defdir
)
1517 Lisp_Object filename
, defdir
;
1519 register Lisp_Object abspath
;
1521 abspath
= Fexpand_file_name (filename
, defdir
);
1524 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1525 if (c
== ':' || c
== ']' || c
== '>')
1526 abspath
= Fdirectory_file_name (abspath
);
1529 /* Remove final slash, if any (unless path is root).
1530 stat behaves differently depending! */
1531 if (XSTRING (abspath
)->size
> 1
1532 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1534 if (EQ (abspath
, filename
))
1535 abspath
= Fcopy_sequence (abspath
);
1536 XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] = 0;
1542 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1543 Lisp_Object absname
;
1544 unsigned char *querystring
;
1547 register Lisp_Object tem
;
1548 struct gcpro gcpro1
;
1550 if (access (XSTRING (absname
)->data
, 4) >= 0)
1553 Fsignal (Qfile_already_exists
,
1554 Fcons (build_string ("File already exists"),
1555 Fcons (absname
, Qnil
)));
1557 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1558 XSTRING (absname
)->data
, querystring
));
1561 Fsignal (Qfile_already_exists
,
1562 Fcons (build_string ("File already exists"),
1563 Fcons (absname
, Qnil
)));
1568 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1569 "fCopy file: \nFCopy %s to file: \np\nP",
1570 "Copy FILE to NEWNAME. Both args must be strings.\n\
1571 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1572 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1573 A number as third arg means request confirmation if NEWNAME already exists.\n\
1574 This is what happens in interactive use with M-x.\n\
1575 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1576 last-modified time as the old one. (This works on only some systems.)\n\
1577 A prefix arg makes KEEP-TIME non-nil.")
1578 (filename
, newname
, ok_if_already_exists
, keep_date
)
1579 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1582 char buf
[16 * 1024];
1584 Lisp_Object handler
;
1585 struct gcpro gcpro1
, gcpro2
;
1586 int count
= specpdl_ptr
- specpdl
;
1587 Lisp_Object args
[6];
1589 GCPRO2 (filename
, newname
);
1590 CHECK_STRING (filename
, 0);
1591 CHECK_STRING (newname
, 1);
1592 filename
= Fexpand_file_name (filename
, Qnil
);
1593 newname
= Fexpand_file_name (newname
, Qnil
);
1595 /* If the input file name has special constructs in it,
1596 call the corresponding file handler. */
1597 handler
= Ffind_file_name_handler (filename
);
1598 /* Likewise for output file name. */
1600 handler
= Ffind_file_name_handler (newname
);
1601 if (!NILP (handler
))
1602 return call5 (handler
, Qcopy_file
, filename
, newname
,
1603 ok_if_already_exists
, keep_date
);
1605 if (NILP (ok_if_already_exists
)
1606 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1607 barf_or_query_if_file_exists (newname
, "copy to it",
1608 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1610 ifd
= open (XSTRING (filename
)->data
, 0);
1612 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1614 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1617 /* Create the copy file with the same record format as the input file */
1618 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1620 ofd
= creat (XSTRING (newname
)->data
, 0666);
1623 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1625 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1629 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1630 if (write (ofd
, buf
, n
) != n
)
1631 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1634 if (fstat (ifd
, &st
) >= 0)
1636 if (!NILP (keep_date
))
1638 EMACS_TIME atime
, mtime
;
1639 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1640 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1641 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1644 if (!egetenv ("USE_DOMAIN_ACLS"))
1646 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1649 /* Discard the unwind protects. */
1650 specpdl_ptr
= specpdl
+ count
;
1653 if (close (ofd
) < 0)
1654 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1660 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1661 Smake_directory_internal
, 1, 1, 0,
1662 "Create a directory. One argument, a file name string.")
1664 Lisp_Object dirname
;
1667 Lisp_Object handler
;
1669 CHECK_STRING (dirname
, 0);
1670 dirname
= Fexpand_file_name (dirname
, Qnil
);
1672 handler
= Ffind_file_name_handler (dirname
);
1673 if (!NILP (handler
))
1674 return call3 (handler
, Qmake_directory
, dirname
, Qnil
);
1676 dir
= XSTRING (dirname
)->data
;
1678 if (mkdir (dir
, 0777) != 0)
1679 report_file_error ("Creating directory", Flist (1, &dirname
));
1684 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1685 "Delete a directory. One argument, a file name string.")
1687 Lisp_Object dirname
;
1690 Lisp_Object handler
;
1692 CHECK_STRING (dirname
, 0);
1693 dirname
= Fexpand_file_name (dirname
, Qnil
);
1694 dir
= XSTRING (dirname
)->data
;
1696 handler
= Ffind_file_name_handler (dirname
);
1697 if (!NILP (handler
))
1698 return call2 (handler
, Qdelete_directory
, dirname
);
1700 if (rmdir (dir
) != 0)
1701 report_file_error ("Removing directory", Flist (1, &dirname
));
1706 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1707 "Delete specified file. One argument, a file name string.\n\
1708 If file has multiple names, it continues to exist with the other names.")
1710 Lisp_Object filename
;
1712 Lisp_Object handler
;
1713 CHECK_STRING (filename
, 0);
1714 filename
= Fexpand_file_name (filename
, Qnil
);
1716 handler
= Ffind_file_name_handler (filename
);
1717 if (!NILP (handler
))
1718 return call2 (handler
, Qdelete_file
, filename
);
1720 if (0 > unlink (XSTRING (filename
)->data
))
1721 report_file_error ("Removing old name", Flist (1, &filename
));
1725 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1726 "fRename file: \nFRename %s to file: \np",
1727 "Rename FILE as NEWNAME. Both args strings.\n\
1728 If file has names other than FILE, it continues to have those names.\n\
1729 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1730 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1731 A number as third arg means request confirmation if NEWNAME already exists.\n\
1732 This is what happens in interactive use with M-x.")
1733 (filename
, newname
, ok_if_already_exists
)
1734 Lisp_Object filename
, newname
, ok_if_already_exists
;
1737 Lisp_Object args
[2];
1739 Lisp_Object handler
;
1740 struct gcpro gcpro1
, gcpro2
;
1742 GCPRO2 (filename
, newname
);
1743 CHECK_STRING (filename
, 0);
1744 CHECK_STRING (newname
, 1);
1745 filename
= Fexpand_file_name (filename
, Qnil
);
1746 newname
= Fexpand_file_name (newname
, Qnil
);
1748 /* If the file name has special constructs in it,
1749 call the corresponding file handler. */
1750 handler
= Ffind_file_name_handler (filename
);
1752 handler
= Ffind_file_name_handler (newname
);
1753 if (!NILP (handler
))
1754 return call4 (handler
, Qrename_file
,
1755 filename
, newname
, ok_if_already_exists
);
1757 if (NILP (ok_if_already_exists
)
1758 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1759 barf_or_query_if_file_exists (newname
, "rename to it",
1760 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1762 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1764 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1765 || 0 > unlink (XSTRING (filename
)->data
))
1770 Fcopy_file (filename
, newname
,
1771 /* We have already prompted if it was an integer,
1772 so don't have copy-file prompt again. */
1773 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
1774 Fdelete_file (filename
);
1781 report_file_error ("Renaming", Flist (2, args
));
1784 report_file_error ("Renaming", Flist (2, &filename
));
1791 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1792 "fAdd name to file: \nFName to add to %s: \np",
1793 "Give FILE additional name NEWNAME. Both args strings.\n\
1794 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1795 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1796 A number as third arg means request confirmation if NEWNAME already exists.\n\
1797 This is what happens in interactive use with M-x.")
1798 (filename
, newname
, ok_if_already_exists
)
1799 Lisp_Object filename
, newname
, ok_if_already_exists
;
1802 Lisp_Object args
[2];
1804 Lisp_Object handler
;
1805 struct gcpro gcpro1
, gcpro2
;
1807 GCPRO2 (filename
, newname
);
1808 CHECK_STRING (filename
, 0);
1809 CHECK_STRING (newname
, 1);
1810 filename
= Fexpand_file_name (filename
, Qnil
);
1811 newname
= Fexpand_file_name (newname
, Qnil
);
1813 /* If the file name has special constructs in it,
1814 call the corresponding file handler. */
1815 handler
= Ffind_file_name_handler (filename
);
1816 if (!NILP (handler
))
1817 return call4 (handler
, Qadd_name_to_file
, filename
, newname
,
1818 ok_if_already_exists
);
1820 if (NILP (ok_if_already_exists
)
1821 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1822 barf_or_query_if_file_exists (newname
, "make it a new name",
1823 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1824 unlink (XSTRING (newname
)->data
);
1825 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1830 report_file_error ("Adding new name", Flist (2, args
));
1832 report_file_error ("Adding new name", Flist (2, &filename
));
1841 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1842 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1843 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1844 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1845 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1846 A number as third arg means request confirmation if NEWNAME already exists.\n\
1847 This happens for interactive use with M-x.")
1848 (filename
, linkname
, ok_if_already_exists
)
1849 Lisp_Object filename
, linkname
, ok_if_already_exists
;
1852 Lisp_Object args
[2];
1854 Lisp_Object handler
;
1855 struct gcpro gcpro1
, gcpro2
;
1857 GCPRO2 (filename
, linkname
);
1858 CHECK_STRING (filename
, 0);
1859 CHECK_STRING (linkname
, 1);
1860 #if 0 /* This made it impossible to make a link to a relative name. */
1861 filename
= Fexpand_file_name (filename
, Qnil
);
1863 linkname
= Fexpand_file_name (linkname
, Qnil
);
1865 /* If the file name has special constructs in it,
1866 call the corresponding file handler. */
1867 handler
= Ffind_file_name_handler (filename
);
1868 if (!NILP (handler
))
1869 return call4 (handler
, Qmake_symbolic_link
, filename
, linkname
,
1870 ok_if_already_exists
);
1872 if (NILP (ok_if_already_exists
)
1873 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1874 barf_or_query_if_file_exists (linkname
, "make it a link",
1875 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1876 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1878 /* If we didn't complain already, silently delete existing file. */
1879 if (errno
== EEXIST
)
1881 unlink (XSTRING (linkname
)->data
);
1882 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1889 report_file_error ("Making symbolic link", Flist (2, args
));
1891 report_file_error ("Making symbolic link", Flist (2, &filename
));
1897 #endif /* S_IFLNK */
1901 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
1902 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1903 "Define the job-wide logical name NAME to have the value STRING.\n\
1904 If STRING is nil or a null string, the logical name NAME is deleted.")
1906 Lisp_Object varname
;
1909 CHECK_STRING (varname
, 0);
1911 delete_logical_name (XSTRING (varname
)->data
);
1914 CHECK_STRING (string
, 1);
1916 if (XSTRING (string
)->size
== 0)
1917 delete_logical_name (XSTRING (varname
)->data
);
1919 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
1928 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
1929 "Open a network connection to PATH using LOGIN as the login string.")
1931 Lisp_Object path
, login
;
1935 CHECK_STRING (path
, 0);
1936 CHECK_STRING (login
, 0);
1938 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
1940 if (netresult
== -1)
1945 #endif /* HPUX_NET */
1947 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
1949 "Return t if file FILENAME specifies an absolute path name.\n\
1950 On Unix, this is a name starting with a `/' or a `~'.")
1952 Lisp_Object filename
;
1956 CHECK_STRING (filename
, 0);
1957 ptr
= XSTRING (filename
)->data
;
1958 if (*ptr
== '/' || *ptr
== '~'
1960 /* ??? This criterion is probably wrong for '<'. */
1961 || index (ptr
, ':') || index (ptr
, '<')
1962 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
1971 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
1972 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1973 See also `file-readable-p' and `file-attributes'.")
1975 Lisp_Object filename
;
1977 Lisp_Object abspath
;
1978 Lisp_Object handler
;
1980 CHECK_STRING (filename
, 0);
1981 abspath
= Fexpand_file_name (filename
, Qnil
);
1983 /* If the file name has special constructs in it,
1984 call the corresponding file handler. */
1985 handler
= Ffind_file_name_handler (abspath
);
1986 if (!NILP (handler
))
1987 return call2 (handler
, Qfile_exists_p
, abspath
);
1989 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
1992 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
1993 "Return t if FILENAME can be executed by you.\n\
1994 For a directory, this means you can access files in that directory.")
1996 Lisp_Object filename
;
1999 Lisp_Object abspath
;
2000 Lisp_Object handler
;
2002 CHECK_STRING (filename
, 0);
2003 abspath
= Fexpand_file_name (filename
, Qnil
);
2005 /* If the file name has special constructs in it,
2006 call the corresponding file handler. */
2007 handler
= Ffind_file_name_handler (abspath
);
2008 if (!NILP (handler
))
2009 return call2 (handler
, Qfile_executable_p
, abspath
);
2011 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
2014 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2015 "Return t if file FILENAME exists and you can read it.\n\
2016 See also `file-exists-p' and `file-attributes'.")
2018 Lisp_Object filename
;
2020 Lisp_Object abspath
;
2021 Lisp_Object handler
;
2023 CHECK_STRING (filename
, 0);
2024 abspath
= Fexpand_file_name (filename
, Qnil
);
2026 /* If the file name has special constructs in it,
2027 call the corresponding file handler. */
2028 handler
= Ffind_file_name_handler (abspath
);
2029 if (!NILP (handler
))
2030 return call2 (handler
, Qfile_readable_p
, abspath
);
2032 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
2035 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2036 "If file FILENAME is the name of a symbolic link\n\
2037 returns the name of the file to which it is linked.\n\
2038 Otherwise returns NIL.")
2040 Lisp_Object filename
;
2047 Lisp_Object handler
;
2049 CHECK_STRING (filename
, 0);
2050 filename
= Fexpand_file_name (filename
, Qnil
);
2052 /* If the file name has special constructs in it,
2053 call the corresponding file handler. */
2054 handler
= Ffind_file_name_handler (filename
);
2055 if (!NILP (handler
))
2056 return call2 (handler
, Qfile_symlink_p
, filename
);
2061 buf
= (char *) xmalloc (bufsize
);
2062 bzero (buf
, bufsize
);
2063 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2064 if (valsize
< bufsize
) break;
2065 /* Buffer was not long enough */
2074 val
= make_string (buf
, valsize
);
2077 #else /* not S_IFLNK */
2079 #endif /* not S_IFLNK */
2082 #ifdef SOLARIS_BROKEN_ACCESS
2083 /* In Solaris 2.1, the readonly-ness of the filesystem is not
2084 considered by the access system call. This is Sun's bug, but we
2085 still have to make Emacs work. */
2087 #include <sys/statvfs.h>
2093 struct statvfs statvfsb
;
2095 if (statvfs(path
, &statvfsb
))
2096 return 1; /* error from statvfs, be conservative and say not wrtable */
2098 /* Otherwise, fsys is ro if bit is set. */
2099 return statvfsb
.f_flag
& ST_RDONLY
;
2102 /* But on every other os, access has already done the right thing. */
2103 #define ro_fsys(path) 0
2106 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2108 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2109 "Return t if file FILENAME can be written or created by you.")
2111 Lisp_Object filename
;
2113 Lisp_Object abspath
, dir
;
2114 Lisp_Object handler
;
2116 CHECK_STRING (filename
, 0);
2117 abspath
= Fexpand_file_name (filename
, Qnil
);
2119 /* If the file name has special constructs in it,
2120 call the corresponding file handler. */
2121 handler
= Ffind_file_name_handler (abspath
);
2122 if (!NILP (handler
))
2123 return call2 (handler
, Qfile_writable_p
, abspath
);
2125 if (access (XSTRING (abspath
)->data
, 0) >= 0)
2126 return ((access (XSTRING (abspath
)->data
, 2) >= 0
2127 && ! ro_fsys ((char *) XSTRING (abspath
)->data
))
2129 dir
= Ffile_name_directory (abspath
);
2132 dir
= Fdirectory_file_name (dir
);
2134 return ((access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2135 && ! ro_fsys ((char *) XSTRING (dir
)->data
))
2139 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2140 "Return t if file FILENAME is the name of a directory as a file.\n\
2141 A directory name spec may be given instead; then the value is t\n\
2142 if the directory so specified exists and really is a directory.")
2144 Lisp_Object filename
;
2146 register Lisp_Object abspath
;
2148 Lisp_Object handler
;
2150 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2152 /* If the file name has special constructs in it,
2153 call the corresponding file handler. */
2154 handler
= Ffind_file_name_handler (abspath
);
2155 if (!NILP (handler
))
2156 return call2 (handler
, Qfile_directory_p
, abspath
);
2158 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2160 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2163 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2164 "Return t if file FILENAME is the name of a directory as a file,\n\
2165 and files in that directory can be opened by you. In order to use a\n\
2166 directory as a buffer's current directory, this predicate must return true.\n\
2167 A directory name spec may be given instead; then the value is t\n\
2168 if the directory so specified exists and really is a readable and\n\
2169 searchable directory.")
2171 Lisp_Object filename
;
2173 Lisp_Object handler
;
2175 /* If the file name has special constructs in it,
2176 call the corresponding file handler. */
2177 handler
= Ffind_file_name_handler (filename
);
2178 if (!NILP (handler
))
2179 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2181 if (NILP (Ffile_directory_p (filename
))
2182 || NILP (Ffile_executable_p (filename
)))
2188 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2189 "Return mode bits of FILE, as an integer.")
2191 Lisp_Object filename
;
2193 Lisp_Object abspath
;
2195 Lisp_Object handler
;
2197 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2199 /* If the file name has special constructs in it,
2200 call the corresponding file handler. */
2201 handler
= Ffind_file_name_handler (abspath
);
2202 if (!NILP (handler
))
2203 return call2 (handler
, Qfile_modes
, abspath
);
2205 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2207 return make_number (st
.st_mode
& 07777);
2210 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2211 "Set mode bits of FILE to MODE (an integer).\n\
2212 Only the 12 low bits of MODE are used.")
2214 Lisp_Object filename
, mode
;
2216 Lisp_Object abspath
;
2217 Lisp_Object handler
;
2219 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2220 CHECK_NUMBER (mode
, 1);
2222 /* If the file name has special constructs in it,
2223 call the corresponding file handler. */
2224 handler
= Ffind_file_name_handler (abspath
);
2225 if (!NILP (handler
))
2226 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2229 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2230 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2232 if (!egetenv ("USE_DOMAIN_ACLS"))
2235 struct timeval tvp
[2];
2237 /* chmod on apollo also change the file's modtime; need to save the
2238 modtime and then restore it. */
2239 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2241 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2245 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2246 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2248 /* reset the old accessed and modified times. */
2249 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2251 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2254 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2255 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2262 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2263 "Set the file permission bits for newly created files.\n\
2264 The argument MODE should be an integer; only the low 9 bits are used.\n\
2265 This setting is inherited by subprocesses.")
2269 CHECK_NUMBER (mode
, 0);
2271 umask ((~ XINT (mode
)) & 0777);
2276 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2277 "Return the default file protection for created files.\n\
2278 The value is an integer.")
2284 realmask
= umask (0);
2287 XSET (value
, Lisp_Int
, (~ realmask
) & 0777);
2293 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2294 "Tell Unix to finish all pending disk updates.")
2303 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2304 "Return t if file FILE1 is newer than file FILE2.\n\
2305 If FILE1 does not exist, the answer is nil;\n\
2306 otherwise, if FILE2 does not exist, the answer is t.")
2308 Lisp_Object file1
, file2
;
2310 Lisp_Object abspath1
, abspath2
;
2313 Lisp_Object handler
;
2314 struct gcpro gcpro1
, gcpro2
;
2316 CHECK_STRING (file1
, 0);
2317 CHECK_STRING (file2
, 0);
2320 GCPRO2 (abspath1
, file2
);
2321 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2322 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2325 /* If the file name has special constructs in it,
2326 call the corresponding file handler. */
2327 handler
= Ffind_file_name_handler (abspath1
);
2329 handler
= Ffind_file_name_handler (abspath2
);
2330 if (!NILP (handler
))
2331 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2333 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2336 mtime1
= st
.st_mtime
;
2338 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2341 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2344 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2346 "Insert contents of file FILENAME after point.\n\
2347 Returns list of absolute file name and length of data inserted.\n\
2348 If second argument VISIT is non-nil, the buffer's visited filename\n\
2349 and last save file modtime are set, and it is marked unmodified.\n\
2350 If visiting and the file does not exist, visiting is completed\n\
2351 before the error is signaled.\n\n\
2352 The optional third and fourth arguments BEG and END\n\
2353 specify what portion of the file to insert.\n\
2354 If VISIT is non-nil, BEG and END must be nil.")
2355 (filename
, visit
, beg
, end
)
2356 Lisp_Object filename
, visit
, beg
, end
;
2360 register int inserted
= 0;
2361 register int how_much
;
2362 int count
= specpdl_ptr
- specpdl
;
2363 struct gcpro gcpro1
;
2364 Lisp_Object handler
, val
;
2370 if (!NILP (current_buffer
->read_only
))
2371 Fbarf_if_buffer_read_only();
2373 CHECK_STRING (filename
, 0);
2374 filename
= Fexpand_file_name (filename
, Qnil
);
2376 /* If the file name has special constructs in it,
2377 call the corresponding file handler. */
2378 handler
= Ffind_file_name_handler (filename
);
2379 if (!NILP (handler
))
2381 val
= call5 (handler
, Qinsert_file_contents
, filename
, visit
, beg
, end
);
2389 if (stat (XSTRING (filename
)->data
, &st
) < 0
2390 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2392 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2393 || fstat (fd
, &st
) < 0)
2394 #endif /* not APOLLO */
2396 if (fd
>= 0) close (fd
);
2398 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2404 record_unwind_protect (close_file_unwind
, make_number (fd
));
2407 /* This code will need to be changed in order to work on named
2408 pipes, and it's probably just not worth it. So we should at
2409 least signal an error. */
2410 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2411 Fsignal (Qfile_error
,
2412 Fcons (build_string ("reading from named pipe"),
2413 Fcons (filename
, Qnil
)));
2416 /* Supposedly happens on VMS. */
2418 error ("File size is negative");
2420 if (!NILP (beg
) || !NILP (end
))
2422 error ("Attempt to visit less than an entire file");
2425 CHECK_NUMBER (beg
, 0);
2430 CHECK_NUMBER (end
, 0);
2433 XSETINT (end
, st
.st_size
);
2434 if (XINT (end
) != st
.st_size
)
2435 error ("maximum buffer size exceeded");
2438 total
= XINT (end
) - XINT (beg
);
2441 register Lisp_Object temp
;
2443 /* Make sure point-max won't overflow after this insertion. */
2444 XSET (temp
, Lisp_Int
, total
);
2445 if (total
!= XINT (temp
))
2446 error ("maximum buffer size exceeded");
2450 prepare_to_modify_buffer (point
, point
);
2453 if (GAP_SIZE
< total
)
2454 make_gap (total
- GAP_SIZE
);
2456 if (XINT (beg
) != 0)
2458 if (lseek (fd
, XINT (beg
), 0) < 0)
2459 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2464 int try = min (total
- inserted
, 64 << 10);
2467 /* Allow quitting out of the actual I/O. */
2470 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2488 record_insert (point
, inserted
);
2490 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2491 offset_intervals (current_buffer
, point
, inserted
);
2497 /* Discard the unwind protect */
2498 specpdl_ptr
= specpdl
+ count
;
2501 error ("IO error reading %s: %s",
2502 XSTRING (filename
)->data
, err_str (errno
));
2509 current_buffer
->undo_list
= Qnil
;
2511 stat (XSTRING (filename
)->data
, &st
);
2513 current_buffer
->modtime
= st
.st_mtime
;
2514 current_buffer
->save_modified
= MODIFF
;
2515 current_buffer
->auto_save_modified
= MODIFF
;
2516 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2517 #ifdef CLASH_DETECTION
2520 if (!NILP (current_buffer
->filename
))
2521 unlock_file (current_buffer
->filename
);
2522 unlock_file (filename
);
2524 #endif /* CLASH_DETECTION */
2525 current_buffer
->filename
= filename
;
2526 /* If visiting nonexistent file, return nil. */
2527 if (current_buffer
->modtime
== -1)
2528 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2531 signal_after_change (point
, 0, inserted
);
2534 RETURN_UNGCPRO (val
);
2535 RETURN_UNGCPRO (Fcons (filename
,
2536 Fcons (make_number (inserted
),
2540 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2541 "r\nFWrite region to file: ",
2542 "Write current region into specified file.\n\
2543 When called from a program, takes three arguments:\n\
2544 START, END and FILENAME. START and END are buffer positions.\n\
2545 Optional fourth argument APPEND if non-nil means\n\
2546 append to existing file contents (if any).\n\
2547 Optional fifth argument VISIT if t means\n\
2548 set the last-save-file-modtime of buffer to this file's modtime\n\
2549 and mark buffer not modified.\n\
2550 If VISIT is a string, it is a second file name;\n\
2551 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2552 VISIT is also the file name to lock and unlock for clash detection.\n\
2553 If VISIT is neither t nor nil nor a string,\n\
2554 that means do not print the \"Wrote file\" message.\n\
2555 Kludgy feature: if START is a string, then that string is written\n\
2556 to the file, instead of any buffer contents, and END is ignored.")
2557 (start
, end
, filename
, append
, visit
)
2558 Lisp_Object start
, end
, filename
, append
, visit
;
2566 int count
= specpdl_ptr
- specpdl
;
2568 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2570 Lisp_Object handler
;
2571 Lisp_Object visit_file
;
2572 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2574 /* Special kludge to simplify auto-saving */
2577 XFASTINT (start
) = BEG
;
2580 else if (XTYPE (start
) != Lisp_String
)
2581 validate_region (&start
, &end
);
2583 filename
= Fexpand_file_name (filename
, Qnil
);
2584 if (XTYPE (visit
) == Lisp_String
)
2585 visit_file
= Fexpand_file_name (visit
, Qnil
);
2587 visit_file
= filename
;
2589 GCPRO4 (start
, filename
, visit
, visit_file
);
2591 /* If the file name has special constructs in it,
2592 call the corresponding file handler. */
2593 handler
= Ffind_file_name_handler (filename
);
2595 if (!NILP (handler
))
2598 val
= call6 (handler
, Qwrite_region
, start
, end
,
2599 filename
, append
, visit
);
2601 /* Do this before reporting IO error
2602 to avoid a "file has changed on disk" warning on
2603 next attempt to save. */
2604 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2606 current_buffer
->modtime
= 0;
2607 current_buffer
->save_modified
= MODIFF
;
2608 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2609 current_buffer
->filename
= visit_file
;
2615 #ifdef CLASH_DETECTION
2617 lock_file (visit_file
);
2618 #endif /* CLASH_DETECTION */
2620 fn
= XSTRING (filename
)->data
;
2623 desc
= open (fn
, O_WRONLY
);
2627 if (auto_saving
) /* Overwrite any previous version of autosave file */
2629 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2630 desc
= open (fn
, O_RDWR
);
2632 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2633 ? XSTRING (current_buffer
->filename
)->data
: 0,
2636 else /* Write to temporary name and rename if no errors */
2638 Lisp_Object temp_name
;
2639 temp_name
= Ffile_name_directory (filename
);
2641 if (!NILP (temp_name
))
2643 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2644 build_string ("$$SAVE$$")));
2645 fname
= XSTRING (filename
)->data
;
2646 fn
= XSTRING (temp_name
)->data
;
2647 desc
= creat_copy_attrs (fname
, fn
);
2650 /* If we can't open the temporary file, try creating a new
2651 version of the original file. VMS "creat" creates a
2652 new version rather than truncating an existing file. */
2655 desc
= creat (fn
, 0666);
2656 #if 0 /* This can clobber an existing file and fail to replace it,
2657 if the user runs out of space. */
2660 /* We can't make a new version;
2661 try to truncate and rewrite existing version if any. */
2663 desc
= open (fn
, O_RDWR
);
2669 desc
= creat (fn
, 0666);
2672 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2673 #endif /* not VMS */
2679 #ifdef CLASH_DETECTION
2681 if (!auto_saving
) unlock_file (visit_file
);
2683 #endif /* CLASH_DETECTION */
2684 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2687 record_unwind_protect (close_file_unwind
, make_number (desc
));
2690 if (lseek (desc
, 0, 2) < 0)
2692 #ifdef CLASH_DETECTION
2693 if (!auto_saving
) unlock_file (visit_file
);
2694 #endif /* CLASH_DETECTION */
2695 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2700 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2701 * if we do writes that don't end with a carriage return. Furthermore
2702 * it cannot handle writes of more then 16K. The modified
2703 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2704 * this EXCEPT for the last record (iff it doesn't end with a carriage
2705 * return). This implies that if your buffer doesn't end with a carriage
2706 * return, you get one free... tough. However it also means that if
2707 * we make two calls to sys_write (a la the following code) you can
2708 * get one at the gap as well. The easiest way to fix this (honest)
2709 * is to move the gap to the next newline (or the end of the buffer).
2714 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2715 move_gap (find_next_newline (GPT
, 1));
2721 if (XTYPE (start
) == Lisp_String
)
2723 failure
= 0 > e_write (desc
, XSTRING (start
)->data
,
2724 XSTRING (start
)->size
);
2727 else if (XINT (start
) != XINT (end
))
2729 if (XINT (start
) < GPT
)
2731 register int end1
= XINT (end
);
2733 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
),
2734 min (GPT
, end1
) - tem
);
2738 if (XINT (end
) > GPT
&& !failure
)
2741 tem
= max (tem
, GPT
);
2742 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
);
2750 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2751 Disk full in NFS may be reported here. */
2752 /* mib says that closing the file will try to write as fast as NFS can do
2753 it, and that means the fsync here is not crucial for autosave files. */
2754 if (!auto_saving
&& fsync (desc
) < 0)
2755 failure
= 1, save_errno
= errno
;
2758 /* Spurious "file has changed on disk" warnings have been
2759 observed on Suns as well.
2760 It seems that `close' can change the modtime, under nfs.
2762 (This has supposedly been fixed in Sunos 4,
2763 but who knows about all the other machines with NFS?) */
2766 /* On VMS and APOLLO, must do the stat after the close
2767 since closing changes the modtime. */
2770 /* Recall that #if defined does not work on VMS. */
2777 /* NFS can report a write failure now. */
2778 if (close (desc
) < 0)
2779 failure
= 1, save_errno
= errno
;
2782 /* If we wrote to a temporary name and had no errors, rename to real name. */
2786 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2794 /* Discard the unwind protect */
2795 specpdl_ptr
= specpdl
+ count
;
2797 #ifdef CLASH_DETECTION
2799 unlock_file (visit_file
);
2800 #endif /* CLASH_DETECTION */
2802 /* Do this before reporting IO error
2803 to avoid a "file has changed on disk" warning on
2804 next attempt to save. */
2805 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2806 current_buffer
->modtime
= st
.st_mtime
;
2809 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2811 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2813 current_buffer
->save_modified
= MODIFF
;
2814 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2815 current_buffer
->filename
= visit_file
;
2817 else if (!NILP (visit
))
2821 message ("Wrote %s", XSTRING (visit_file
)->data
);
2827 e_write (desc
, addr
, len
)
2829 register char *addr
;
2832 char buf
[16 * 1024];
2833 register char *p
, *end
;
2835 if (!EQ (current_buffer
->selective_display
, Qt
))
2836 return write (desc
, addr
, len
) - len
;
2840 end
= p
+ sizeof buf
;
2845 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
2854 if (write (desc
, buf
, p
- buf
) != p
- buf
)
2860 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
2861 Sverify_visited_file_modtime
, 1, 1, 0,
2862 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2863 This means that the file has not been changed since it was visited or saved.")
2869 Lisp_Object handler
;
2871 CHECK_BUFFER (buf
, 0);
2874 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
2875 if (b
->modtime
== 0) return Qt
;
2877 /* If the file name has special constructs in it,
2878 call the corresponding file handler. */
2879 handler
= Ffind_file_name_handler (b
->filename
);
2880 if (!NILP (handler
))
2881 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
2883 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
2885 /* If the file doesn't exist now and didn't exist before,
2886 we say that it isn't modified, provided the error is a tame one. */
2887 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
2892 if (st
.st_mtime
== b
->modtime
2893 /* If both are positive, accept them if they are off by one second. */
2894 || (st
.st_mtime
> 0 && b
->modtime
> 0
2895 && (st
.st_mtime
== b
->modtime
+ 1
2896 || st
.st_mtime
== b
->modtime
- 1)))
2901 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
2902 Sclear_visited_file_modtime
, 0, 0, 0,
2903 "Clear out records of last mod time of visited file.\n\
2904 Next attempt to save will certainly not complain of a discrepancy.")
2907 current_buffer
->modtime
= 0;
2911 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
2912 Svisited_file_modtime
, 0, 0, 0,
2913 "Return the current buffer's recorded visited file modification time.\n\
2914 The value is a list of the form (HIGH . LOW), like the time values\n\
2915 that `file-attributes' returns.")
2918 return long_to_cons (current_buffer
->modtime
);
2921 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
2922 Sset_visited_file_modtime
, 0, 1, 0,
2923 "Update buffer's recorded modification time from the visited file's time.\n\
2924 Useful if the buffer was not read from the file normally\n\
2925 or if the file itself has been changed for some known benign reason.\n\
2926 An argument specifies the modification time value to use\n\
2927 \(instead of that of the visited file), in the form of a list\n\
2928 \(HIGH . LOW) or (HIGH LOW).")
2930 Lisp_Object time_list
;
2932 if (!NILP (time_list
))
2933 current_buffer
->modtime
= cons_to_long (time_list
);
2936 register Lisp_Object filename
;
2938 Lisp_Object handler
;
2940 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
2942 /* If the file name has special constructs in it,
2943 call the corresponding file handler. */
2944 handler
= Ffind_file_name_handler (filename
);
2945 if (!NILP (handler
))
2946 /* The handler can find the file name the same way we did. */
2947 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
2948 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
2949 current_buffer
->modtime
= st
.st_mtime
;
2958 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
2961 message ("Autosaving...error for %s", name
);
2962 Fsleep_for (make_number (1), Qnil
);
2963 message ("Autosaving...error!for %s", name
);
2964 Fsleep_for (make_number (1), Qnil
);
2965 message ("Autosaving...error for %s", name
);
2966 Fsleep_for (make_number (1), Qnil
);
2976 /* Get visited file's mode to become the auto save file's mode. */
2977 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
2978 /* But make sure we can overwrite it later! */
2979 auto_save_mode_bits
= st
.st_mode
| 0600;
2981 auto_save_mode_bits
= 0666;
2984 Fwrite_region (Qnil
, Qnil
,
2985 current_buffer
->auto_save_file_name
,
2989 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
2990 "Auto-save all buffers that need it.\n\
2991 This is all buffers that have auto-saving enabled\n\
2992 and are changed since last auto-saved.\n\
2993 Auto-saving writes the buffer into a file\n\
2994 so that your editing is not lost if the system crashes.\n\
2995 This file is not the file you visited; that changes only when you save.\n\n\
2996 Non-nil first argument means do not print any message if successful.\n\
2997 Non-nil second argument means save only current buffer.")
2998 (no_message
, current_only
)
2999 Lisp_Object no_message
, current_only
;
3001 struct buffer
*old
= current_buffer
, *b
;
3002 Lisp_Object tail
, buf
;
3004 char *omessage
= echo_area_glyphs
;
3005 extern int minibuf_level
;
3006 int do_handled_files
;
3009 /* Ordinarily don't quit within this function,
3010 but don't make it impossible to quit (in case we get hung in I/O). */
3014 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3015 point to non-strings reached from Vbuffer_alist. */
3021 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
3022 eventually call do-auto-save, so don't err here in that case. */
3023 if (!NILP (Vrun_hooks
))
3024 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3026 /* First, save all files which don't have handlers. If Emacs is
3027 crashing, the handlers may tweak what is causing Emacs to crash
3028 in the first place, and it would be a shame if Emacs failed to
3029 autosave perfectly ordinary files because it couldn't handle some
3031 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3032 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
3033 tail
= XCONS (tail
)->cdr
)
3035 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3038 if (!NILP (current_only
)
3039 && b
!= current_buffer
)
3042 /* Check for auto save enabled
3043 and file changed since last auto save
3044 and file changed since last real save. */
3045 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3046 && b
->save_modified
< BUF_MODIFF (b
)
3047 && b
->auto_save_modified
< BUF_MODIFF (b
)
3048 && (do_handled_files
3049 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
))))
3051 if ((XFASTINT (b
->save_length
) * 10
3052 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3053 /* A short file is likely to change a large fraction;
3054 spare the user annoying messages. */
3055 && XFASTINT (b
->save_length
) > 5000
3056 /* These messages are frequent and annoying for `*mail*'. */
3057 && !EQ (b
->filename
, Qnil
)
3058 && NILP (no_message
))
3060 /* It has shrunk too much; turn off auto-saving here. */
3061 message ("Buffer %s has shrunk a lot; auto save turned off there",
3062 XSTRING (b
->name
)->data
);
3063 /* User can reenable saving with M-x auto-save. */
3064 b
->auto_save_file_name
= Qnil
;
3065 /* Prevent warning from repeating if user does so. */
3066 XFASTINT (b
->save_length
) = 0;
3067 Fsleep_for (make_number (1), Qnil
);
3070 set_buffer_internal (b
);
3071 if (!auto_saved
&& NILP (no_message
))
3072 message1 ("Auto-saving...");
3073 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3075 b
->auto_save_modified
= BUF_MODIFF (b
);
3076 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3077 set_buffer_internal (old
);
3081 /* Prevent another auto save till enough input events come in. */
3082 record_auto_save ();
3084 if (auto_saved
&& NILP (no_message
))
3085 message1 (omessage
? omessage
: "Auto-saving...done");
3093 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3094 Sset_buffer_auto_saved
, 0, 0, 0,
3095 "Mark current buffer as auto-saved with its current text.\n\
3096 No auto-save file will be written until the buffer changes again.")
3099 current_buffer
->auto_save_modified
= MODIFF
;
3100 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3104 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3106 "Return t if buffer has been auto-saved since last read in or saved.")
3109 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3112 /* Reading and completing file names */
3113 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3115 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3117 "Internal subroutine for read-file-name. Do not call this.")
3118 (string
, dir
, action
)
3119 Lisp_Object string
, dir
, action
;
3120 /* action is nil for complete, t for return list of completions,
3121 lambda for verify final value */
3123 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3125 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3132 /* No need to protect ACTION--we only compare it with t and nil. */
3133 GCPRO4 (string
, realdir
, name
, specdir
);
3135 if (XSTRING (string
)->size
== 0)
3137 if (EQ (action
, Qlambda
))
3145 orig_string
= string
;
3146 string
= Fsubstitute_in_file_name (string
);
3147 changed
= NILP (Fstring_equal (string
, orig_string
));
3148 name
= Ffile_name_nondirectory (string
);
3149 val
= Ffile_name_directory (string
);
3151 realdir
= Fexpand_file_name (val
, realdir
);
3156 specdir
= Ffile_name_directory (string
);
3157 val
= Ffile_name_completion (name
, realdir
);
3159 if (XTYPE (val
) != Lisp_String
)
3166 if (!NILP (specdir
))
3167 val
= concat2 (specdir
, val
);
3170 register unsigned char *old
, *new;
3174 osize
= XSTRING (val
)->size
;
3175 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3176 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3177 if (*old
++ == '$') count
++;
3180 old
= XSTRING (val
)->data
;
3181 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3182 new = XSTRING (val
)->data
;
3183 for (n
= osize
; n
> 0; n
--)
3194 #endif /* Not VMS */
3199 if (EQ (action
, Qt
))
3200 return Ffile_name_all_completions (name
, realdir
);
3201 /* Only other case actually used is ACTION = lambda */
3203 /* Supposedly this helps commands such as `cd' that read directory names,
3204 but can someone explain how it helps them? -- RMS */
3205 if (XSTRING (name
)->size
== 0)
3208 return Ffile_exists_p (string
);
3211 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3212 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3213 Value is not expanded---you must call `expand-file-name' yourself.\n\
3214 Default name to DEFAULT if user enters a null string.\n\
3215 (If DEFAULT is omitted, the visited file name is used.)\n\
3216 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3217 Non-nil and non-t means also require confirmation after completion.\n\
3218 Fifth arg INITIAL specifies text to start with.\n\
3219 DIR defaults to current buffer's directory default.")
3220 (prompt
, dir
, defalt
, mustmatch
, initial
)
3221 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3223 Lisp_Object val
, insdef
, insdef1
, tem
;
3224 struct gcpro gcpro1
, gcpro2
;
3225 register char *homedir
;
3229 dir
= current_buffer
->directory
;
3231 defalt
= current_buffer
->filename
;
3233 /* If dir starts with user's homedir, change that to ~. */
3234 homedir
= (char *) egetenv ("HOME");
3236 && XTYPE (dir
) == Lisp_String
3237 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3238 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3240 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3241 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3242 XSTRING (dir
)->data
[0] = '~';
3245 if (insert_default_directory
)
3249 if (!NILP (initial
))
3251 Lisp_Object args
[2], pos
;
3255 insdef
= Fconcat (2, args
);
3256 pos
= make_number (XSTRING (dir
)->size
);
3257 insdef1
= Fcons (insdef
, pos
);
3261 insdef
= Qnil
, insdef1
= Qnil
;
3264 count
= specpdl_ptr
- specpdl
;
3265 specbind (intern ("completion-ignore-case"), Qt
);
3268 GCPRO2 (insdef
, defalt
);
3269 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3270 dir
, mustmatch
, insdef1
,
3271 Qfile_name_history
);
3274 unbind_to (count
, Qnil
);
3279 error ("No file name specified");
3280 tem
= Fstring_equal (val
, insdef
);
3281 if (!NILP (tem
) && !NILP (defalt
))
3283 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3285 return Fsubstitute_in_file_name (val
);
3288 #if 0 /* Old version */
3289 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3290 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3291 Value is not expanded---you must call `expand-file-name' yourself.\n\
3292 Default name to DEFAULT if user enters a null string.\n\
3293 (If DEFAULT is omitted, the visited file name is used.)\n\
3294 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3295 Non-nil and non-t means also require confirmation after completion.\n\
3296 Fifth arg INITIAL specifies text to start with.\n\
3297 DIR defaults to current buffer's directory default.")
3298 (prompt
, dir
, defalt
, mustmatch
, initial
)
3299 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3301 Lisp_Object val
, insdef
, tem
;
3302 struct gcpro gcpro1
, gcpro2
;
3303 register char *homedir
;
3307 dir
= current_buffer
->directory
;
3309 defalt
= current_buffer
->filename
;
3311 /* If dir starts with user's homedir, change that to ~. */
3312 homedir
= (char *) egetenv ("HOME");
3314 && XTYPE (dir
) == Lisp_String
3315 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3316 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3318 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3319 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3320 XSTRING (dir
)->data
[0] = '~';
3323 if (!NILP (initial
))
3325 else if (insert_default_directory
)
3328 insdef
= build_string ("");
3331 count
= specpdl_ptr
- specpdl
;
3332 specbind (intern ("completion-ignore-case"), Qt
);
3335 GCPRO2 (insdef
, defalt
);
3336 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3338 insert_default_directory
? insdef
: Qnil
,
3339 Qfile_name_history
);
3342 unbind_to (count
, Qnil
);
3347 error ("No file name specified");
3348 tem
= Fstring_equal (val
, insdef
);
3349 if (!NILP (tem
) && !NILP (defalt
))
3351 return Fsubstitute_in_file_name (val
);
3353 #endif /* Old version */
3357 Qexpand_file_name
= intern ("expand-file-name");
3358 Qdirectory_file_name
= intern ("directory-file-name");
3359 Qfile_name_directory
= intern ("file-name-directory");
3360 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3361 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
3362 Qfile_name_as_directory
= intern ("file-name-as-directory");
3363 Qcopy_file
= intern ("copy-file");
3364 Qmake_directory
= intern ("make-directory");
3365 Qdelete_directory
= intern ("delete-directory");
3366 Qdelete_file
= intern ("delete-file");
3367 Qrename_file
= intern ("rename-file");
3368 Qadd_name_to_file
= intern ("add-name-to-file");
3369 Qmake_symbolic_link
= intern ("make-symbolic-link");
3370 Qfile_exists_p
= intern ("file-exists-p");
3371 Qfile_executable_p
= intern ("file-executable-p");
3372 Qfile_readable_p
= intern ("file-readable-p");
3373 Qfile_symlink_p
= intern ("file-symlink-p");
3374 Qfile_writable_p
= intern ("file-writable-p");
3375 Qfile_directory_p
= intern ("file-directory-p");
3376 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3377 Qfile_modes
= intern ("file-modes");
3378 Qset_file_modes
= intern ("set-file-modes");
3379 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3380 Qinsert_file_contents
= intern ("insert-file-contents");
3381 Qwrite_region
= intern ("write-region");
3382 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3383 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
3385 staticpro (&Qexpand_file_name
);
3386 staticpro (&Qdirectory_file_name
);
3387 staticpro (&Qfile_name_directory
);
3388 staticpro (&Qfile_name_nondirectory
);
3389 staticpro (&Qunhandled_file_name_directory
);
3390 staticpro (&Qfile_name_as_directory
);
3391 staticpro (&Qcopy_file
);
3392 staticpro (&Qmake_directory
);
3393 staticpro (&Qdelete_directory
);
3394 staticpro (&Qdelete_file
);
3395 staticpro (&Qrename_file
);
3396 staticpro (&Qadd_name_to_file
);
3397 staticpro (&Qmake_symbolic_link
);
3398 staticpro (&Qfile_exists_p
);
3399 staticpro (&Qfile_executable_p
);
3400 staticpro (&Qfile_readable_p
);
3401 staticpro (&Qfile_symlink_p
);
3402 staticpro (&Qfile_writable_p
);
3403 staticpro (&Qfile_directory_p
);
3404 staticpro (&Qfile_accessible_directory_p
);
3405 staticpro (&Qfile_modes
);
3406 staticpro (&Qset_file_modes
);
3407 staticpro (&Qfile_newer_than_file_p
);
3408 staticpro (&Qinsert_file_contents
);
3409 staticpro (&Qwrite_region
);
3410 staticpro (&Qverify_visited_file_modtime
);
3412 Qfile_name_history
= intern ("file-name-history");
3413 Fset (Qfile_name_history
, Qnil
);
3414 staticpro (&Qfile_name_history
);
3416 Qfile_error
= intern ("file-error");
3417 staticpro (&Qfile_error
);
3418 Qfile_already_exists
= intern("file-already-exists");
3419 staticpro (&Qfile_already_exists
);
3421 Fput (Qfile_error
, Qerror_conditions
,
3422 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3423 Fput (Qfile_error
, Qerror_message
,
3424 build_string ("File error"));
3426 Fput (Qfile_already_exists
, Qerror_conditions
,
3427 Fcons (Qfile_already_exists
,
3428 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3429 Fput (Qfile_already_exists
, Qerror_message
,
3430 build_string ("File already exists"));
3432 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3433 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3434 insert_default_directory
= 1;
3436 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3437 "*Non-nil means write new files with record format `stmlf'.\n\
3438 nil means use format `var'. This variable is meaningful only on VMS.");
3439 vms_stmlf_recfm
= 0;
3441 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
3442 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3443 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3446 The first argument given to HANDLER is the name of the I/O primitive\n\
3447 to be handled; the remaining arguments are the arguments that were\n\
3448 passed to that primitive. For example, if you do\n\
3449 (file-exists-p FILENAME)\n\
3450 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
3451 (funcall HANDLER 'file-exists-p FILENAME)\n\
3452 The function `find-file-name-handler' checks this list for a handler\n\
3453 for its argument.");
3454 Vfile_name_handler_alist
= Qnil
;
3456 defsubr (&Sfind_file_name_handler
);
3457 defsubr (&Sfile_name_directory
);
3458 defsubr (&Sfile_name_nondirectory
);
3459 defsubr (&Sunhandled_file_name_directory
);
3460 defsubr (&Sfile_name_as_directory
);
3461 defsubr (&Sdirectory_file_name
);
3462 defsubr (&Smake_temp_name
);
3463 defsubr (&Sexpand_file_name
);
3464 defsubr (&Ssubstitute_in_file_name
);
3465 defsubr (&Scopy_file
);
3466 defsubr (&Smake_directory_internal
);
3467 defsubr (&Sdelete_directory
);
3468 defsubr (&Sdelete_file
);
3469 defsubr (&Srename_file
);
3470 defsubr (&Sadd_name_to_file
);
3472 defsubr (&Smake_symbolic_link
);
3473 #endif /* S_IFLNK */
3475 defsubr (&Sdefine_logical_name
);
3478 defsubr (&Ssysnetunam
);
3479 #endif /* HPUX_NET */
3480 defsubr (&Sfile_name_absolute_p
);
3481 defsubr (&Sfile_exists_p
);
3482 defsubr (&Sfile_executable_p
);
3483 defsubr (&Sfile_readable_p
);
3484 defsubr (&Sfile_writable_p
);
3485 defsubr (&Sfile_symlink_p
);
3486 defsubr (&Sfile_directory_p
);
3487 defsubr (&Sfile_accessible_directory_p
);
3488 defsubr (&Sfile_modes
);
3489 defsubr (&Sset_file_modes
);
3490 defsubr (&Sset_default_file_modes
);
3491 defsubr (&Sdefault_file_modes
);
3492 defsubr (&Sfile_newer_than_file_p
);
3493 defsubr (&Sinsert_file_contents
);
3494 defsubr (&Swrite_region
);
3495 defsubr (&Sverify_visited_file_modtime
);
3496 defsubr (&Sclear_visited_file_modtime
);
3497 defsubr (&Svisited_file_modtime
);
3498 defsubr (&Sset_visited_file_modtime
);
3499 defsubr (&Sdo_auto_save
);
3500 defsubr (&Sset_buffer_auto_saved
);
3501 defsubr (&Srecent_auto_save_p
);
3503 defsubr (&Sread_file_name_internal
);
3504 defsubr (&Sread_file_name
);
3507 defsubr (&Sunix_sync
);