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
, ok_if_already_exists
, Qt
);
1771 Fdelete_file (filename
);
1778 report_file_error ("Renaming", Flist (2, args
));
1781 report_file_error ("Renaming", Flist (2, &filename
));
1788 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1789 "fAdd name to file: \nFName to add to %s: \np",
1790 "Give FILE additional name NEWNAME. Both args strings.\n\
1791 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1792 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1793 A number as third arg means request confirmation if NEWNAME already exists.\n\
1794 This is what happens in interactive use with M-x.")
1795 (filename
, newname
, ok_if_already_exists
)
1796 Lisp_Object filename
, newname
, ok_if_already_exists
;
1799 Lisp_Object args
[2];
1801 Lisp_Object handler
;
1802 struct gcpro gcpro1
, gcpro2
;
1804 GCPRO2 (filename
, newname
);
1805 CHECK_STRING (filename
, 0);
1806 CHECK_STRING (newname
, 1);
1807 filename
= Fexpand_file_name (filename
, Qnil
);
1808 newname
= Fexpand_file_name (newname
, Qnil
);
1810 /* If the file name has special constructs in it,
1811 call the corresponding file handler. */
1812 handler
= Ffind_file_name_handler (filename
);
1813 if (!NILP (handler
))
1814 return call4 (handler
, Qadd_name_to_file
, filename
, newname
,
1815 ok_if_already_exists
);
1817 if (NILP (ok_if_already_exists
)
1818 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1819 barf_or_query_if_file_exists (newname
, "make it a new name",
1820 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1821 unlink (XSTRING (newname
)->data
);
1822 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1827 report_file_error ("Adding new name", Flist (2, args
));
1829 report_file_error ("Adding new name", Flist (2, &filename
));
1838 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1839 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1840 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1841 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1842 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1843 A number as third arg means request confirmation if NEWNAME already exists.\n\
1844 This happens for interactive use with M-x.")
1845 (filename
, linkname
, ok_if_already_exists
)
1846 Lisp_Object filename
, linkname
, ok_if_already_exists
;
1849 Lisp_Object args
[2];
1851 Lisp_Object handler
;
1852 struct gcpro gcpro1
, gcpro2
;
1854 GCPRO2 (filename
, linkname
);
1855 CHECK_STRING (filename
, 0);
1856 CHECK_STRING (linkname
, 1);
1857 #if 0 /* This made it impossible to make a link to a relative name. */
1858 filename
= Fexpand_file_name (filename
, Qnil
);
1860 linkname
= Fexpand_file_name (linkname
, Qnil
);
1862 /* If the file name has special constructs in it,
1863 call the corresponding file handler. */
1864 handler
= Ffind_file_name_handler (filename
);
1865 if (!NILP (handler
))
1866 return call4 (handler
, Qmake_symbolic_link
, filename
, linkname
,
1867 ok_if_already_exists
);
1869 if (NILP (ok_if_already_exists
)
1870 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1871 barf_or_query_if_file_exists (linkname
, "make it a link",
1872 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1873 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1875 /* If we didn't complain already, silently delete existing file. */
1876 if (errno
== EEXIST
)
1878 unlink (XSTRING (linkname
)->data
);
1879 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1886 report_file_error ("Making symbolic link", Flist (2, args
));
1888 report_file_error ("Making symbolic link", Flist (2, &filename
));
1894 #endif /* S_IFLNK */
1898 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
1899 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1900 "Define the job-wide logical name NAME to have the value STRING.\n\
1901 If STRING is nil or a null string, the logical name NAME is deleted.")
1903 Lisp_Object varname
;
1906 CHECK_STRING (varname
, 0);
1908 delete_logical_name (XSTRING (varname
)->data
);
1911 CHECK_STRING (string
, 1);
1913 if (XSTRING (string
)->size
== 0)
1914 delete_logical_name (XSTRING (varname
)->data
);
1916 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
1925 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
1926 "Open a network connection to PATH using LOGIN as the login string.")
1928 Lisp_Object path
, login
;
1932 CHECK_STRING (path
, 0);
1933 CHECK_STRING (login
, 0);
1935 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
1937 if (netresult
== -1)
1942 #endif /* HPUX_NET */
1944 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
1946 "Return t if file FILENAME specifies an absolute path name.\n\
1947 On Unix, this is a name starting with a `/' or a `~'.")
1949 Lisp_Object filename
;
1953 CHECK_STRING (filename
, 0);
1954 ptr
= XSTRING (filename
)->data
;
1955 if (*ptr
== '/' || *ptr
== '~'
1957 /* ??? This criterion is probably wrong for '<'. */
1958 || index (ptr
, ':') || index (ptr
, '<')
1959 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
1968 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
1969 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1970 See also `file-readable-p' and `file-attributes'.")
1972 Lisp_Object filename
;
1974 Lisp_Object abspath
;
1975 Lisp_Object handler
;
1977 CHECK_STRING (filename
, 0);
1978 abspath
= Fexpand_file_name (filename
, Qnil
);
1980 /* If the file name has special constructs in it,
1981 call the corresponding file handler. */
1982 handler
= Ffind_file_name_handler (abspath
);
1983 if (!NILP (handler
))
1984 return call2 (handler
, Qfile_exists_p
, abspath
);
1986 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
1989 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
1990 "Return t if FILENAME can be executed by you.\n\
1991 For a directory, this means you can access files in that directory.")
1993 Lisp_Object filename
;
1996 Lisp_Object abspath
;
1997 Lisp_Object handler
;
1999 CHECK_STRING (filename
, 0);
2000 abspath
= Fexpand_file_name (filename
, Qnil
);
2002 /* If the file name has special constructs in it,
2003 call the corresponding file handler. */
2004 handler
= Ffind_file_name_handler (abspath
);
2005 if (!NILP (handler
))
2006 return call2 (handler
, Qfile_executable_p
, abspath
);
2008 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
2011 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2012 "Return t if file FILENAME exists and you can read it.\n\
2013 See also `file-exists-p' and `file-attributes'.")
2015 Lisp_Object filename
;
2017 Lisp_Object abspath
;
2018 Lisp_Object handler
;
2020 CHECK_STRING (filename
, 0);
2021 abspath
= Fexpand_file_name (filename
, Qnil
);
2023 /* If the file name has special constructs in it,
2024 call the corresponding file handler. */
2025 handler
= Ffind_file_name_handler (abspath
);
2026 if (!NILP (handler
))
2027 return call2 (handler
, Qfile_readable_p
, abspath
);
2029 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
2032 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2033 "If file FILENAME is the name of a symbolic link\n\
2034 returns the name of the file to which it is linked.\n\
2035 Otherwise returns NIL.")
2037 Lisp_Object filename
;
2044 Lisp_Object handler
;
2046 CHECK_STRING (filename
, 0);
2047 filename
= Fexpand_file_name (filename
, Qnil
);
2049 /* If the file name has special constructs in it,
2050 call the corresponding file handler. */
2051 handler
= Ffind_file_name_handler (filename
);
2052 if (!NILP (handler
))
2053 return call2 (handler
, Qfile_symlink_p
, filename
);
2058 buf
= (char *) xmalloc (bufsize
);
2059 bzero (buf
, bufsize
);
2060 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2061 if (valsize
< bufsize
) break;
2062 /* Buffer was not long enough */
2071 val
= make_string (buf
, valsize
);
2074 #else /* not S_IFLNK */
2076 #endif /* not S_IFLNK */
2079 #ifdef SOLARIS_BROKEN_ACCESS
2080 /* In Solaris 2.1, the readonly-ness of the filesystem is not
2081 considered by the access system call. This is Sun's bug, but we
2082 still have to make Emacs work. */
2084 #include <sys/statvfs.h>
2090 struct statvfs statvfsb
;
2092 if (statvfs(path
, &statvfsb
))
2093 return 1; /* error from statvfs, be conservative and say not wrtable */
2095 /* Otherwise, fsys is ro if bit is set. */
2096 return statvfsb
.f_flag
& ST_RDONLY
;
2099 /* But on every other os, access has already done the right thing. */
2100 #define ro_fsys(path) 0
2103 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2105 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2106 "Return t if file FILENAME can be written or created by you.")
2108 Lisp_Object filename
;
2110 Lisp_Object abspath
, dir
;
2111 Lisp_Object handler
;
2113 CHECK_STRING (filename
, 0);
2114 abspath
= Fexpand_file_name (filename
, Qnil
);
2116 /* If the file name has special constructs in it,
2117 call the corresponding file handler. */
2118 handler
= Ffind_file_name_handler (abspath
);
2119 if (!NILP (handler
))
2120 return call2 (handler
, Qfile_writable_p
, abspath
);
2122 if (access (XSTRING (abspath
)->data
, 0) >= 0)
2123 return ((access (XSTRING (abspath
)->data
, 2) >= 0
2124 && ! ro_fsys ((char *) XSTRING (abspath
)->data
))
2126 dir
= Ffile_name_directory (abspath
);
2129 dir
= Fdirectory_file_name (dir
);
2131 return ((access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2132 && ! ro_fsys ((char *) XSTRING (dir
)->data
))
2136 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2137 "Return t if file FILENAME is the name of a directory as a file.\n\
2138 A directory name spec may be given instead; then the value is t\n\
2139 if the directory so specified exists and really is a directory.")
2141 Lisp_Object filename
;
2143 register Lisp_Object abspath
;
2145 Lisp_Object handler
;
2147 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
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_directory_p
, abspath
);
2155 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2157 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2160 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2161 "Return t if file FILENAME is the name of a directory as a file,\n\
2162 and files in that directory can be opened by you. In order to use a\n\
2163 directory as a buffer's current directory, this predicate must return true.\n\
2164 A directory name spec may be given instead; then the value is t\n\
2165 if the directory so specified exists and really is a readable and\n\
2166 searchable directory.")
2168 Lisp_Object filename
;
2170 Lisp_Object handler
;
2172 /* If the file name has special constructs in it,
2173 call the corresponding file handler. */
2174 handler
= Ffind_file_name_handler (filename
);
2175 if (!NILP (handler
))
2176 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2178 if (NILP (Ffile_directory_p (filename
))
2179 || NILP (Ffile_executable_p (filename
)))
2185 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2186 "Return mode bits of FILE, as an integer.")
2188 Lisp_Object filename
;
2190 Lisp_Object abspath
;
2192 Lisp_Object handler
;
2194 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2196 /* If the file name has special constructs in it,
2197 call the corresponding file handler. */
2198 handler
= Ffind_file_name_handler (abspath
);
2199 if (!NILP (handler
))
2200 return call2 (handler
, Qfile_modes
, abspath
);
2202 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2204 return make_number (st
.st_mode
& 07777);
2207 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2208 "Set mode bits of FILE to MODE (an integer).\n\
2209 Only the 12 low bits of MODE are used.")
2211 Lisp_Object filename
, mode
;
2213 Lisp_Object abspath
;
2214 Lisp_Object handler
;
2216 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2217 CHECK_NUMBER (mode
, 1);
2219 /* If the file name has special constructs in it,
2220 call the corresponding file handler. */
2221 handler
= Ffind_file_name_handler (abspath
);
2222 if (!NILP (handler
))
2223 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2226 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2227 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2229 if (!egetenv ("USE_DOMAIN_ACLS"))
2232 struct timeval tvp
[2];
2234 /* chmod on apollo also change the file's modtime; need to save the
2235 modtime and then restore it. */
2236 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2238 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2242 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2243 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2245 /* reset the old accessed and modified times. */
2246 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2248 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2251 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2252 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2259 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2260 "Set the file permission bits for newly created files.\n\
2261 The argument MODE should be an integer; only the low 9 bits are used.\n\
2262 This setting is inherited by subprocesses.")
2266 CHECK_NUMBER (mode
, 0);
2268 umask ((~ XINT (mode
)) & 0777);
2273 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2274 "Return the default file protection for created files.\n\
2275 The value is an integer.")
2281 realmask
= umask (0);
2284 XSET (value
, Lisp_Int
, (~ realmask
) & 0777);
2290 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2291 "Tell Unix to finish all pending disk updates.")
2300 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2301 "Return t if file FILE1 is newer than file FILE2.\n\
2302 If FILE1 does not exist, the answer is nil;\n\
2303 otherwise, if FILE2 does not exist, the answer is t.")
2305 Lisp_Object file1
, file2
;
2307 Lisp_Object abspath1
, abspath2
;
2310 Lisp_Object handler
;
2311 struct gcpro gcpro1
, gcpro2
;
2313 CHECK_STRING (file1
, 0);
2314 CHECK_STRING (file2
, 0);
2317 GCPRO2 (abspath1
, file2
);
2318 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2319 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2322 /* If the file name has special constructs in it,
2323 call the corresponding file handler. */
2324 handler
= Ffind_file_name_handler (abspath1
);
2326 handler
= Ffind_file_name_handler (abspath2
);
2327 if (!NILP (handler
))
2328 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2330 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2333 mtime1
= st
.st_mtime
;
2335 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2338 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2341 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2343 "Insert contents of file FILENAME after point.\n\
2344 Returns list of absolute pathname and length of data inserted.\n\
2345 If second argument VISIT is non-nil, the buffer's visited filename\n\
2346 and last save file modtime are set, and it is marked unmodified.\n\
2347 If visiting and the file does not exist, visiting is completed\n\
2348 before the error is signaled.")
2350 Lisp_Object filename
, visit
;
2354 register int inserted
= 0;
2355 register int how_much
;
2356 int count
= specpdl_ptr
- specpdl
;
2357 struct gcpro gcpro1
;
2358 Lisp_Object handler
, val
;
2363 if (!NILP (current_buffer
->read_only
))
2364 Fbarf_if_buffer_read_only();
2366 CHECK_STRING (filename
, 0);
2367 filename
= Fexpand_file_name (filename
, Qnil
);
2369 /* If the file name has special constructs in it,
2370 call the corresponding file handler. */
2371 handler
= Ffind_file_name_handler (filename
);
2372 if (!NILP (handler
))
2374 val
= call3 (handler
, Qinsert_file_contents
, filename
, visit
);
2382 if (stat (XSTRING (filename
)->data
, &st
) < 0
2383 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2385 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2386 || fstat (fd
, &st
) < 0)
2387 #endif /* not APOLLO */
2389 if (fd
>= 0) close (fd
);
2391 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2397 record_unwind_protect (close_file_unwind
, make_number (fd
));
2400 /* This code will need to be changed in order to work on named
2401 pipes, and it's probably just not worth it. So we should at
2402 least signal an error. */
2403 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2404 Fsignal (Qfile_error
,
2405 Fcons (build_string ("reading from named pipe"),
2406 Fcons (filename
, Qnil
)));
2409 /* Supposedly happens on VMS. */
2411 error ("File size is negative");
2414 register Lisp_Object temp
;
2416 /* Make sure point-max won't overflow after this insertion. */
2417 XSET (temp
, Lisp_Int
, st
.st_size
+ Z
);
2418 if (st
.st_size
+ Z
!= XINT (temp
))
2419 error ("maximum buffer size exceeded");
2423 prepare_to_modify_buffer (point
, point
);
2426 if (GAP_SIZE
< st
.st_size
)
2427 make_gap (st
.st_size
- GAP_SIZE
);
2431 int try = min (st
.st_size
- inserted
, 64 << 10);
2434 /* Allow quitting out of the actual I/O. */
2437 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2455 record_insert (point
, inserted
);
2457 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2458 offset_intervals (current_buffer
, point
, inserted
);
2464 /* Discard the unwind protect */
2465 specpdl_ptr
= specpdl
+ count
;
2468 error ("IO error reading %s: %s",
2469 XSTRING (filename
)->data
, err_str (errno
));
2476 current_buffer
->undo_list
= Qnil
;
2478 stat (XSTRING (filename
)->data
, &st
);
2480 current_buffer
->modtime
= st
.st_mtime
;
2481 current_buffer
->save_modified
= MODIFF
;
2482 current_buffer
->auto_save_modified
= MODIFF
;
2483 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2484 #ifdef CLASH_DETECTION
2487 if (!NILP (current_buffer
->filename
))
2488 unlock_file (current_buffer
->filename
);
2489 unlock_file (filename
);
2491 #endif /* CLASH_DETECTION */
2492 current_buffer
->filename
= filename
;
2493 /* If visiting nonexistent file, return nil. */
2494 if (current_buffer
->modtime
== -1)
2495 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2498 signal_after_change (point
, 0, inserted
);
2501 RETURN_UNGCPRO (val
);
2502 RETURN_UNGCPRO (Fcons (filename
,
2503 Fcons (make_number (inserted
),
2507 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2508 "r\nFWrite region to file: ",
2509 "Write current region into specified file.\n\
2510 When called from a program, takes three arguments:\n\
2511 START, END and FILENAME. START and END are buffer positions.\n\
2512 Optional fourth argument APPEND if non-nil means\n\
2513 append to existing file contents (if any).\n\
2514 Optional fifth argument VISIT if t means\n\
2515 set the last-save-file-modtime of buffer to this file's modtime\n\
2516 and mark buffer not modified.\n\
2517 If VISIT is a string, it is a second file name;\n\
2518 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2519 VISIT is also the file name to lock and unlock for clash detection.\n\
2520 If VISIT is neither t nor nil nor a string,\n\
2521 that means do not print the \"Wrote file\" message.\n\
2522 Kludgy feature: if START is a string, then that string is written\n\
2523 to the file, instead of any buffer contents, and END is ignored.")
2524 (start
, end
, filename
, append
, visit
)
2525 Lisp_Object start
, end
, filename
, append
, visit
;
2533 int count
= specpdl_ptr
- specpdl
;
2535 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2537 Lisp_Object handler
;
2538 Lisp_Object visit_file
;
2539 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2541 /* Special kludge to simplify auto-saving */
2544 XFASTINT (start
) = BEG
;
2547 else if (XTYPE (start
) != Lisp_String
)
2548 validate_region (&start
, &end
);
2550 filename
= Fexpand_file_name (filename
, Qnil
);
2551 if (XTYPE (visit
) == Lisp_String
)
2552 visit_file
= Fexpand_file_name (visit
, Qnil
);
2554 visit_file
= filename
;
2556 GCPRO4 (start
, filename
, visit
, visit_file
);
2558 /* If the file name has special constructs in it,
2559 call the corresponding file handler. */
2560 handler
= Ffind_file_name_handler (filename
);
2562 if (!NILP (handler
))
2565 val
= call6 (handler
, Qwrite_region
, start
, end
,
2566 filename
, append
, visit
);
2568 /* Do this before reporting IO error
2569 to avoid a "file has changed on disk" warning on
2570 next attempt to save. */
2571 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2573 current_buffer
->modtime
= 0;
2574 current_buffer
->save_modified
= MODIFF
;
2575 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2576 current_buffer
->filename
= visit_file
;
2582 #ifdef CLASH_DETECTION
2584 lock_file (visit_file
);
2585 #endif /* CLASH_DETECTION */
2587 fn
= XSTRING (filename
)->data
;
2590 desc
= open (fn
, O_WRONLY
);
2594 if (auto_saving
) /* Overwrite any previous version of autosave file */
2596 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2597 desc
= open (fn
, O_RDWR
);
2599 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2600 ? XSTRING (current_buffer
->filename
)->data
: 0,
2603 else /* Write to temporary name and rename if no errors */
2605 Lisp_Object temp_name
;
2606 temp_name
= Ffile_name_directory (filename
);
2608 if (!NILP (temp_name
))
2610 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2611 build_string ("$$SAVE$$")));
2612 fname
= XSTRING (filename
)->data
;
2613 fn
= XSTRING (temp_name
)->data
;
2614 desc
= creat_copy_attrs (fname
, fn
);
2617 /* If we can't open the temporary file, try creating a new
2618 version of the original file. VMS "creat" creates a
2619 new version rather than truncating an existing file. */
2622 desc
= creat (fn
, 0666);
2623 #if 0 /* This can clobber an existing file and fail to replace it,
2624 if the user runs out of space. */
2627 /* We can't make a new version;
2628 try to truncate and rewrite existing version if any. */
2630 desc
= open (fn
, O_RDWR
);
2636 desc
= creat (fn
, 0666);
2639 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2640 #endif /* not VMS */
2646 #ifdef CLASH_DETECTION
2648 if (!auto_saving
) unlock_file (visit_file
);
2650 #endif /* CLASH_DETECTION */
2651 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2654 record_unwind_protect (close_file_unwind
, make_number (desc
));
2657 if (lseek (desc
, 0, 2) < 0)
2659 #ifdef CLASH_DETECTION
2660 if (!auto_saving
) unlock_file (visit_file
);
2661 #endif /* CLASH_DETECTION */
2662 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2667 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2668 * if we do writes that don't end with a carriage return. Furthermore
2669 * it cannot handle writes of more then 16K. The modified
2670 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2671 * this EXCEPT for the last record (iff it doesn't end with a carriage
2672 * return). This implies that if your buffer doesn't end with a carriage
2673 * return, you get one free... tough. However it also means that if
2674 * we make two calls to sys_write (a la the following code) you can
2675 * get one at the gap as well. The easiest way to fix this (honest)
2676 * is to move the gap to the next newline (or the end of the buffer).
2681 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2682 move_gap (find_next_newline (GPT
, 1));
2688 if (XTYPE (start
) == Lisp_String
)
2690 failure
= 0 > e_write (desc
, XSTRING (start
)->data
,
2691 XSTRING (start
)->size
);
2694 else if (XINT (start
) != XINT (end
))
2696 if (XINT (start
) < GPT
)
2698 register int end1
= XINT (end
);
2700 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
),
2701 min (GPT
, end1
) - tem
);
2705 if (XINT (end
) > GPT
&& !failure
)
2708 tem
= max (tem
, GPT
);
2709 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
);
2717 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2718 Disk full in NFS may be reported here. */
2719 /* mib says that closing the file will try to write as fast as NFS can do
2720 it, and that means the fsync here is not crucial for autosave files. */
2721 if (!auto_saving
&& fsync (desc
) < 0)
2722 failure
= 1, save_errno
= errno
;
2725 /* Spurious "file has changed on disk" warnings have been
2726 observed on Suns as well.
2727 It seems that `close' can change the modtime, under nfs.
2729 (This has supposedly been fixed in Sunos 4,
2730 but who knows about all the other machines with NFS?) */
2733 /* On VMS and APOLLO, must do the stat after the close
2734 since closing changes the modtime. */
2737 /* Recall that #if defined does not work on VMS. */
2744 /* NFS can report a write failure now. */
2745 if (close (desc
) < 0)
2746 failure
= 1, save_errno
= errno
;
2749 /* If we wrote to a temporary name and had no errors, rename to real name. */
2753 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2761 /* Discard the unwind protect */
2762 specpdl_ptr
= specpdl
+ count
;
2764 #ifdef CLASH_DETECTION
2766 unlock_file (visit_file
);
2767 #endif /* CLASH_DETECTION */
2769 /* Do this before reporting IO error
2770 to avoid a "file has changed on disk" warning on
2771 next attempt to save. */
2772 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2773 current_buffer
->modtime
= st
.st_mtime
;
2776 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2778 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2780 current_buffer
->save_modified
= MODIFF
;
2781 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2782 current_buffer
->filename
= visit_file
;
2784 else if (!NILP (visit
))
2788 message ("Wrote %s", XSTRING (visit_file
)->data
);
2794 e_write (desc
, addr
, len
)
2796 register char *addr
;
2799 char buf
[16 * 1024];
2800 register char *p
, *end
;
2802 if (!EQ (current_buffer
->selective_display
, Qt
))
2803 return write (desc
, addr
, len
) - len
;
2807 end
= p
+ sizeof buf
;
2812 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
2821 if (write (desc
, buf
, p
- buf
) != p
- buf
)
2827 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
2828 Sverify_visited_file_modtime
, 1, 1, 0,
2829 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2830 This means that the file has not been changed since it was visited or saved.")
2836 Lisp_Object handler
;
2838 CHECK_BUFFER (buf
, 0);
2841 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
2842 if (b
->modtime
== 0) return Qt
;
2844 /* If the file name has special constructs in it,
2845 call the corresponding file handler. */
2846 handler
= Ffind_file_name_handler (b
->filename
);
2847 if (!NILP (handler
))
2848 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
2850 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
2852 /* If the file doesn't exist now and didn't exist before,
2853 we say that it isn't modified, provided the error is a tame one. */
2854 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
2859 if (st
.st_mtime
== b
->modtime
2860 /* If both are positive, accept them if they are off by one second. */
2861 || (st
.st_mtime
> 0 && b
->modtime
> 0
2862 && (st
.st_mtime
== b
->modtime
+ 1
2863 || st
.st_mtime
== b
->modtime
- 1)))
2868 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
2869 Sclear_visited_file_modtime
, 0, 0, 0,
2870 "Clear out records of last mod time of visited file.\n\
2871 Next attempt to save will certainly not complain of a discrepancy.")
2874 current_buffer
->modtime
= 0;
2878 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
2879 Svisited_file_modtime
, 0, 0, 0,
2880 "Return the current buffer's recorded visited file modification time.\n\
2881 The value is a list of the form (HIGH . LOW), like the time values\n\
2882 that `file-attributes' returns.")
2885 return long_to_cons (current_buffer
->modtime
);
2888 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
2889 Sset_visited_file_modtime
, 0, 1, 0,
2890 "Update buffer's recorded modification time from the visited file's time.\n\
2891 Useful if the buffer was not read from the file normally\n\
2892 or if the file itself has been changed for some known benign reason.\n\
2893 An argument specifies the modification time value to use\n\
2894 \(instead of that of the visited file), in the form of a list\n\
2895 \(HIGH . LOW) or (HIGH LOW).")
2897 Lisp_Object time_list
;
2899 if (!NILP (time_list
))
2900 current_buffer
->modtime
= cons_to_long (time_list
);
2903 register Lisp_Object filename
;
2905 Lisp_Object handler
;
2907 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
2909 /* If the file name has special constructs in it,
2910 call the corresponding file handler. */
2911 handler
= Ffind_file_name_handler (filename
);
2912 if (!NILP (handler
))
2913 return call3 (handler
, Qset_visited_file_modtime
, filename
, Qnil
);
2914 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
2915 current_buffer
->modtime
= st
.st_mtime
;
2924 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
2927 message ("Autosaving...error for %s", name
);
2928 Fsleep_for (make_number (1), Qnil
);
2929 message ("Autosaving...error!for %s", name
);
2930 Fsleep_for (make_number (1), Qnil
);
2931 message ("Autosaving...error for %s", name
);
2932 Fsleep_for (make_number (1), Qnil
);
2942 /* Get visited file's mode to become the auto save file's mode. */
2943 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
2944 /* But make sure we can overwrite it later! */
2945 auto_save_mode_bits
= st
.st_mode
| 0600;
2947 auto_save_mode_bits
= 0666;
2950 Fwrite_region (Qnil
, Qnil
,
2951 current_buffer
->auto_save_file_name
,
2955 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
2956 "Auto-save all buffers that need it.\n\
2957 This is all buffers that have auto-saving enabled\n\
2958 and are changed since last auto-saved.\n\
2959 Auto-saving writes the buffer into a file\n\
2960 so that your editing is not lost if the system crashes.\n\
2961 This file is not the file you visited; that changes only when you save.\n\n\
2962 Non-nil first argument means do not print any message if successful.\n\
2963 Non-nil second argument means save only current buffer.")
2964 (no_message
, current_only
)
2965 Lisp_Object no_message
, current_only
;
2967 struct buffer
*old
= current_buffer
, *b
;
2968 Lisp_Object tail
, buf
;
2970 char *omessage
= echo_area_glyphs
;
2971 extern int minibuf_level
;
2972 int do_handled_files
;
2974 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2975 point to non-strings reached from Vbuffer_alist. */
2981 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2982 eventually call do-auto-save, so don't err here in that case. */
2983 if (!NILP (Vrun_hooks
))
2984 call1 (Vrun_hooks
, intern ("auto-save-hook"));
2986 /* First, save all files which don't have handlers. If Emacs is
2987 crashing, the handlers may tweak what is causing Emacs to crash
2988 in the first place, and it would be a shame if Emacs failed to
2989 autosave perfectly ordinary files because it couldn't handle some
2991 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
2992 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2993 tail
= XCONS (tail
)->cdr
)
2995 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
2998 if (!NILP (current_only
)
2999 && b
!= current_buffer
)
3002 /* Check for auto save enabled
3003 and file changed since last auto save
3004 and file changed since last real save. */
3005 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3006 && b
->save_modified
< BUF_MODIFF (b
)
3007 && b
->auto_save_modified
< BUF_MODIFF (b
)
3008 && (do_handled_files
3009 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
))))
3011 if ((XFASTINT (b
->save_length
) * 10
3012 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3013 /* A short file is likely to change a large fraction;
3014 spare the user annoying messages. */
3015 && XFASTINT (b
->save_length
) > 5000
3016 /* These messages are frequent and annoying for `*mail*'. */
3017 && !EQ (b
->filename
, Qnil
)
3018 && NILP (no_message
))
3020 /* It has shrunk too much; turn off auto-saving here. */
3021 message ("Buffer %s has shrunk a lot; auto save turned off there",
3022 XSTRING (b
->name
)->data
);
3023 /* User can reenable saving with M-x auto-save. */
3024 b
->auto_save_file_name
= Qnil
;
3025 /* Prevent warning from repeating if user does so. */
3026 XFASTINT (b
->save_length
) = 0;
3027 Fsleep_for (make_number (1), Qnil
);
3030 set_buffer_internal (b
);
3031 if (!auto_saved
&& NILP (no_message
))
3032 message1 ("Auto-saving...");
3033 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3035 b
->auto_save_modified
= BUF_MODIFF (b
);
3036 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3037 set_buffer_internal (old
);
3041 /* Prevent another auto save till enough input events come in. */
3042 record_auto_save ();
3044 if (auto_saved
&& NILP (no_message
))
3045 message1 (omessage
? omessage
: "Auto-saving...done");
3051 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3052 Sset_buffer_auto_saved
, 0, 0, 0,
3053 "Mark current buffer as auto-saved with its current text.\n\
3054 No auto-save file will be written until the buffer changes again.")
3057 current_buffer
->auto_save_modified
= MODIFF
;
3058 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3062 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3064 "Return t if buffer has been auto-saved since last read in or saved.")
3067 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3070 /* Reading and completing file names */
3071 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3073 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3075 "Internal subroutine for read-file-name. Do not call this.")
3076 (string
, dir
, action
)
3077 Lisp_Object string
, dir
, action
;
3078 /* action is nil for complete, t for return list of completions,
3079 lambda for verify final value */
3081 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3083 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3090 /* No need to protect ACTION--we only compare it with t and nil. */
3091 GCPRO4 (string
, realdir
, name
, specdir
);
3093 if (XSTRING (string
)->size
== 0)
3095 if (EQ (action
, Qlambda
))
3103 orig_string
= string
;
3104 string
= Fsubstitute_in_file_name (string
);
3105 changed
= NILP (Fstring_equal (string
, orig_string
));
3106 name
= Ffile_name_nondirectory (string
);
3107 val
= Ffile_name_directory (string
);
3109 realdir
= Fexpand_file_name (val
, realdir
);
3114 specdir
= Ffile_name_directory (string
);
3115 val
= Ffile_name_completion (name
, realdir
);
3117 if (XTYPE (val
) != Lisp_String
)
3124 if (!NILP (specdir
))
3125 val
= concat2 (specdir
, val
);
3128 register unsigned char *old
, *new;
3132 osize
= XSTRING (val
)->size
;
3133 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3134 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3135 if (*old
++ == '$') count
++;
3138 old
= XSTRING (val
)->data
;
3139 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3140 new = XSTRING (val
)->data
;
3141 for (n
= osize
; n
> 0; n
--)
3152 #endif /* Not VMS */
3157 if (EQ (action
, Qt
))
3158 return Ffile_name_all_completions (name
, realdir
);
3159 /* Only other case actually used is ACTION = lambda */
3161 /* Supposedly this helps commands such as `cd' that read directory names,
3162 but can someone explain how it helps them? -- RMS */
3163 if (XSTRING (name
)->size
== 0)
3166 return Ffile_exists_p (string
);
3169 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3170 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3171 Value is not expanded---you must call `expand-file-name' yourself.\n\
3172 Default name to DEFAULT if user enters a null string.\n\
3173 (If DEFAULT is omitted, the visited file name is used.)\n\
3174 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3175 Non-nil and non-t means also require confirmation after completion.\n\
3176 Fifth arg INITIAL specifies text to start with.\n\
3177 DIR defaults to current buffer's directory default.")
3178 (prompt
, dir
, defalt
, mustmatch
, initial
)
3179 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3181 Lisp_Object val
, insdef
, insdef1
, tem
;
3182 struct gcpro gcpro1
, gcpro2
;
3183 register char *homedir
;
3187 dir
= current_buffer
->directory
;
3189 defalt
= current_buffer
->filename
;
3191 /* If dir starts with user's homedir, change that to ~. */
3192 homedir
= (char *) egetenv ("HOME");
3194 && XTYPE (dir
) == Lisp_String
3195 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3196 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3198 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3199 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3200 XSTRING (dir
)->data
[0] = '~';
3203 if (insert_default_directory
)
3207 if (!NILP (initial
))
3209 Lisp_Object args
[2], pos
;
3213 insdef
= Fconcat (2, args
);
3214 pos
= make_number (XSTRING (dir
)->size
);
3215 insdef1
= Fcons (insdef
, pos
);
3219 insdef
= Qnil
, insdef1
= Qnil
;
3222 count
= specpdl_ptr
- specpdl
;
3223 specbind (intern ("completion-ignore-case"), Qt
);
3226 GCPRO2 (insdef
, defalt
);
3227 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3228 dir
, mustmatch
, insdef1
,
3229 Qfile_name_history
);
3232 unbind_to (count
, Qnil
);
3237 error ("No file name specified");
3238 tem
= Fstring_equal (val
, insdef
);
3239 if (!NILP (tem
) && !NILP (defalt
))
3241 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3243 return Fsubstitute_in_file_name (val
);
3246 #if 0 /* Old version */
3247 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3248 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3249 Value is not expanded---you must call `expand-file-name' yourself.\n\
3250 Default name to DEFAULT if user enters a null string.\n\
3251 (If DEFAULT is omitted, the visited file name is used.)\n\
3252 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3253 Non-nil and non-t means also require confirmation after completion.\n\
3254 Fifth arg INITIAL specifies text to start with.\n\
3255 DIR defaults to current buffer's directory default.")
3256 (prompt
, dir
, defalt
, mustmatch
, initial
)
3257 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3259 Lisp_Object val
, insdef
, tem
;
3260 struct gcpro gcpro1
, gcpro2
;
3261 register char *homedir
;
3265 dir
= current_buffer
->directory
;
3267 defalt
= current_buffer
->filename
;
3269 /* If dir starts with user's homedir, change that to ~. */
3270 homedir
= (char *) egetenv ("HOME");
3272 && XTYPE (dir
) == Lisp_String
3273 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3274 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3276 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3277 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3278 XSTRING (dir
)->data
[0] = '~';
3281 if (!NILP (initial
))
3283 else if (insert_default_directory
)
3286 insdef
= build_string ("");
3289 count
= specpdl_ptr
- specpdl
;
3290 specbind (intern ("completion-ignore-case"), Qt
);
3293 GCPRO2 (insdef
, defalt
);
3294 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3296 insert_default_directory
? insdef
: Qnil
,
3297 Qfile_name_history
);
3300 unbind_to (count
, Qnil
);
3305 error ("No file name specified");
3306 tem
= Fstring_equal (val
, insdef
);
3307 if (!NILP (tem
) && !NILP (defalt
))
3309 return Fsubstitute_in_file_name (val
);
3311 #endif /* Old version */
3315 Qexpand_file_name
= intern ("expand-file-name");
3316 Qdirectory_file_name
= intern ("directory-file-name");
3317 Qfile_name_directory
= intern ("file-name-directory");
3318 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3319 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
3320 Qfile_name_as_directory
= intern ("file-name-as-directory");
3321 Qcopy_file
= intern ("copy-file");
3322 Qmake_directory
= intern ("make-directory");
3323 Qdelete_directory
= intern ("delete-directory");
3324 Qdelete_file
= intern ("delete-file");
3325 Qrename_file
= intern ("rename-file");
3326 Qadd_name_to_file
= intern ("add-name-to-file");
3327 Qmake_symbolic_link
= intern ("make-symbolic-link");
3328 Qfile_exists_p
= intern ("file-exists-p");
3329 Qfile_executable_p
= intern ("file-executable-p");
3330 Qfile_readable_p
= intern ("file-readable-p");
3331 Qfile_symlink_p
= intern ("file-symlink-p");
3332 Qfile_writable_p
= intern ("file-writable-p");
3333 Qfile_directory_p
= intern ("file-directory-p");
3334 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3335 Qfile_modes
= intern ("file-modes");
3336 Qset_file_modes
= intern ("set-file-modes");
3337 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3338 Qinsert_file_contents
= intern ("insert-file-contents");
3339 Qwrite_region
= intern ("write-region");
3340 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3341 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
3343 staticpro (&Qexpand_file_name
);
3344 staticpro (&Qdirectory_file_name
);
3345 staticpro (&Qfile_name_directory
);
3346 staticpro (&Qfile_name_nondirectory
);
3347 staticpro (&Qunhandled_file_name_directory
);
3348 staticpro (&Qfile_name_as_directory
);
3349 staticpro (&Qcopy_file
);
3350 staticpro (&Qmake_directory
);
3351 staticpro (&Qdelete_directory
);
3352 staticpro (&Qdelete_file
);
3353 staticpro (&Qrename_file
);
3354 staticpro (&Qadd_name_to_file
);
3355 staticpro (&Qmake_symbolic_link
);
3356 staticpro (&Qfile_exists_p
);
3357 staticpro (&Qfile_executable_p
);
3358 staticpro (&Qfile_readable_p
);
3359 staticpro (&Qfile_symlink_p
);
3360 staticpro (&Qfile_writable_p
);
3361 staticpro (&Qfile_directory_p
);
3362 staticpro (&Qfile_accessible_directory_p
);
3363 staticpro (&Qfile_modes
);
3364 staticpro (&Qset_file_modes
);
3365 staticpro (&Qfile_newer_than_file_p
);
3366 staticpro (&Qinsert_file_contents
);
3367 staticpro (&Qwrite_region
);
3368 staticpro (&Qverify_visited_file_modtime
);
3370 Qfile_name_history
= intern ("file-name-history");
3371 Fset (Qfile_name_history
, Qnil
);
3372 staticpro (&Qfile_name_history
);
3374 Qfile_error
= intern ("file-error");
3375 staticpro (&Qfile_error
);
3376 Qfile_already_exists
= intern("file-already-exists");
3377 staticpro (&Qfile_already_exists
);
3379 Fput (Qfile_error
, Qerror_conditions
,
3380 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3381 Fput (Qfile_error
, Qerror_message
,
3382 build_string ("File error"));
3384 Fput (Qfile_already_exists
, Qerror_conditions
,
3385 Fcons (Qfile_already_exists
,
3386 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3387 Fput (Qfile_already_exists
, Qerror_message
,
3388 build_string ("File already exists"));
3390 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3391 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3392 insert_default_directory
= 1;
3394 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3395 "*Non-nil means write new files with record format `stmlf'.\n\
3396 nil means use format `var'. This variable is meaningful only on VMS.");
3397 vms_stmlf_recfm
= 0;
3399 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
3400 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3401 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3404 The first argument given to HANDLER is the name of the I/O primitive\n\
3405 to be handled; the remaining arguments are the arguments that were\n\
3406 passed to that primitive. For example, if you do\n\
3407 (file-exists-p FILENAME)\n\
3408 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
3409 (funcall HANDLER 'file-exists-p FILENAME)\n\
3410 The function `find-file-name-handler' checks this list for a handler\n\
3411 for its argument.");
3412 Vfile_name_handler_alist
= Qnil
;
3414 defsubr (&Sfind_file_name_handler
);
3415 defsubr (&Sfile_name_directory
);
3416 defsubr (&Sfile_name_nondirectory
);
3417 defsubr (&Sunhandled_file_name_directory
);
3418 defsubr (&Sfile_name_as_directory
);
3419 defsubr (&Sdirectory_file_name
);
3420 defsubr (&Smake_temp_name
);
3421 defsubr (&Sexpand_file_name
);
3422 defsubr (&Ssubstitute_in_file_name
);
3423 defsubr (&Scopy_file
);
3424 defsubr (&Smake_directory_internal
);
3425 defsubr (&Sdelete_directory
);
3426 defsubr (&Sdelete_file
);
3427 defsubr (&Srename_file
);
3428 defsubr (&Sadd_name_to_file
);
3430 defsubr (&Smake_symbolic_link
);
3431 #endif /* S_IFLNK */
3433 defsubr (&Sdefine_logical_name
);
3436 defsubr (&Ssysnetunam
);
3437 #endif /* HPUX_NET */
3438 defsubr (&Sfile_name_absolute_p
);
3439 defsubr (&Sfile_exists_p
);
3440 defsubr (&Sfile_executable_p
);
3441 defsubr (&Sfile_readable_p
);
3442 defsubr (&Sfile_writable_p
);
3443 defsubr (&Sfile_symlink_p
);
3444 defsubr (&Sfile_directory_p
);
3445 defsubr (&Sfile_accessible_directory_p
);
3446 defsubr (&Sfile_modes
);
3447 defsubr (&Sset_file_modes
);
3448 defsubr (&Sset_default_file_modes
);
3449 defsubr (&Sdefault_file_modes
);
3450 defsubr (&Sfile_newer_than_file_p
);
3451 defsubr (&Sinsert_file_contents
);
3452 defsubr (&Swrite_region
);
3453 defsubr (&Sverify_visited_file_modtime
);
3454 defsubr (&Sclear_visited_file_modtime
);
3455 defsubr (&Svisited_file_modtime
);
3456 defsubr (&Sset_visited_file_modtime
);
3457 defsubr (&Sdo_auto_save
);
3458 defsubr (&Sset_buffer_auto_saved
);
3459 defsubr (&Srecent_auto_save_p
);
3461 defsubr (&Sread_file_name_internal
);
3462 defsubr (&Sread_file_name
);
3465 defsubr (&Sunix_sync
);