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
;
1588 GCPRO2 (filename
, newname
);
1589 CHECK_STRING (filename
, 0);
1590 CHECK_STRING (newname
, 1);
1591 filename
= Fexpand_file_name (filename
, Qnil
);
1592 newname
= Fexpand_file_name (newname
, Qnil
);
1594 /* If the input file name has special constructs in it,
1595 call the corresponding file handler. */
1596 handler
= Ffind_file_name_handler (filename
);
1597 if (!NILP (handler
))
1598 return call3 (handler
, Qcopy_file
, filename
, newname
);
1599 /* Likewise for output file name. */
1600 handler
= Ffind_file_name_handler (newname
);
1601 if (!NILP (handler
))
1602 return call3 (handler
, Qcopy_file
, filename
, newname
);
1604 if (NILP (ok_if_already_exists
)
1605 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1606 barf_or_query_if_file_exists (newname
, "copy to it",
1607 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1609 ifd
= open (XSTRING (filename
)->data
, 0);
1611 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1613 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1616 /* Create the copy file with the same record format as the input file */
1617 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1619 ofd
= creat (XSTRING (newname
)->data
, 0666);
1622 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1624 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1628 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1629 if (write (ofd
, buf
, n
) != n
)
1630 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1633 if (fstat (ifd
, &st
) >= 0)
1635 if (!NILP (keep_date
))
1637 EMACS_TIME atime
, mtime
;
1638 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1639 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1640 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1643 if (!egetenv ("USE_DOMAIN_ACLS"))
1645 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1648 /* Discard the unwind protects. */
1649 specpdl_ptr
= specpdl
+ count
;
1652 if (close (ofd
) < 0)
1653 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1659 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1660 Smake_directory_internal
, 1, 1, 0,
1661 "Create a directory. One argument, a file name string.")
1663 Lisp_Object dirname
;
1666 Lisp_Object handler
;
1668 CHECK_STRING (dirname
, 0);
1669 dirname
= Fexpand_file_name (dirname
, Qnil
);
1671 handler
= Ffind_file_name_handler (dirname
);
1672 if (!NILP (handler
))
1673 return call3 (handler
, Qmake_directory
, dirname
, Qnil
);
1675 dir
= XSTRING (dirname
)->data
;
1677 if (mkdir (dir
, 0777) != 0)
1678 report_file_error ("Creating directory", Flist (1, &dirname
));
1683 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1684 "Delete a directory. One argument, a file name string.")
1686 Lisp_Object dirname
;
1689 Lisp_Object handler
;
1691 CHECK_STRING (dirname
, 0);
1692 dirname
= Fexpand_file_name (dirname
, Qnil
);
1693 dir
= XSTRING (dirname
)->data
;
1695 handler
= Ffind_file_name_handler (dirname
);
1696 if (!NILP (handler
))
1697 return call2 (handler
, Qdelete_directory
, dirname
);
1699 if (rmdir (dir
) != 0)
1700 report_file_error ("Removing directory", Flist (1, &dirname
));
1705 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1706 "Delete specified file. One argument, a file name string.\n\
1707 If file has multiple names, it continues to exist with the other names.")
1709 Lisp_Object filename
;
1711 Lisp_Object handler
;
1712 CHECK_STRING (filename
, 0);
1713 filename
= Fexpand_file_name (filename
, Qnil
);
1715 handler
= Ffind_file_name_handler (filename
);
1716 if (!NILP (handler
))
1717 return call2 (handler
, Qdelete_file
, filename
);
1719 if (0 > unlink (XSTRING (filename
)->data
))
1720 report_file_error ("Removing old name", Flist (1, &filename
));
1724 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1725 "fRename file: \nFRename %s to file: \np",
1726 "Rename FILE as NEWNAME. Both args strings.\n\
1727 If file has names other than FILE, it continues to have those names.\n\
1728 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1729 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1730 A number as third arg means request confirmation if NEWNAME already exists.\n\
1731 This is what happens in interactive use with M-x.")
1732 (filename
, newname
, ok_if_already_exists
)
1733 Lisp_Object filename
, newname
, ok_if_already_exists
;
1736 Lisp_Object args
[2];
1738 Lisp_Object handler
;
1739 struct gcpro gcpro1
, gcpro2
;
1741 GCPRO2 (filename
, newname
);
1742 CHECK_STRING (filename
, 0);
1743 CHECK_STRING (newname
, 1);
1744 filename
= Fexpand_file_name (filename
, Qnil
);
1745 newname
= Fexpand_file_name (newname
, Qnil
);
1747 /* If the file name has special constructs in it,
1748 call the corresponding file handler. */
1749 handler
= Ffind_file_name_handler (filename
);
1750 if (!NILP (handler
))
1751 return call4 (handler
, Qrename_file
,
1752 filename
, newname
, ok_if_already_exists
);
1754 if (NILP (ok_if_already_exists
)
1755 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1756 barf_or_query_if_file_exists (newname
, "rename to it",
1757 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1759 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1761 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1762 || 0 > unlink (XSTRING (filename
)->data
))
1767 Fcopy_file (filename
, newname
, ok_if_already_exists
, Qt
);
1768 Fdelete_file (filename
);
1775 report_file_error ("Renaming", Flist (2, args
));
1778 report_file_error ("Renaming", Flist (2, &filename
));
1785 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1786 "fAdd name to file: \nFName to add to %s: \np",
1787 "Give FILE additional name NEWNAME. Both args strings.\n\
1788 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1789 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1790 A number as third arg means request confirmation if NEWNAME already exists.\n\
1791 This is what happens in interactive use with M-x.")
1792 (filename
, newname
, ok_if_already_exists
)
1793 Lisp_Object filename
, newname
, ok_if_already_exists
;
1796 Lisp_Object args
[2];
1798 Lisp_Object handler
;
1799 struct gcpro gcpro1
, gcpro2
;
1801 GCPRO2 (filename
, newname
);
1802 CHECK_STRING (filename
, 0);
1803 CHECK_STRING (newname
, 1);
1804 filename
= Fexpand_file_name (filename
, Qnil
);
1805 newname
= Fexpand_file_name (newname
, Qnil
);
1807 /* If the file name has special constructs in it,
1808 call the corresponding file handler. */
1809 handler
= Ffind_file_name_handler (filename
);
1810 if (!NILP (handler
))
1811 return call3 (handler
, Qadd_name_to_file
, filename
, newname
);
1813 if (NILP (ok_if_already_exists
)
1814 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1815 barf_or_query_if_file_exists (newname
, "make it a new name",
1816 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1817 unlink (XSTRING (newname
)->data
);
1818 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1823 report_file_error ("Adding new name", Flist (2, args
));
1825 report_file_error ("Adding new name", Flist (2, &filename
));
1834 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1835 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1836 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1837 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1838 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1839 A number as third arg means request confirmation if NEWNAME already exists.\n\
1840 This happens for interactive use with M-x.")
1841 (filename
, linkname
, ok_if_already_exists
)
1842 Lisp_Object filename
, linkname
, ok_if_already_exists
;
1845 Lisp_Object args
[2];
1847 Lisp_Object handler
;
1848 struct gcpro gcpro1
, gcpro2
;
1850 GCPRO2 (filename
, linkname
);
1851 CHECK_STRING (filename
, 0);
1852 CHECK_STRING (linkname
, 1);
1853 #if 0 /* This made it impossible to make a link to a relative name. */
1854 filename
= Fexpand_file_name (filename
, Qnil
);
1856 linkname
= Fexpand_file_name (linkname
, Qnil
);
1858 /* If the file name has special constructs in it,
1859 call the corresponding file handler. */
1860 handler
= Ffind_file_name_handler (filename
);
1861 if (!NILP (handler
))
1862 return call3 (handler
, Qmake_symbolic_link
, filename
, linkname
);
1864 if (NILP (ok_if_already_exists
)
1865 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1866 barf_or_query_if_file_exists (linkname
, "make it a link",
1867 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1868 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1870 /* If we didn't complain already, silently delete existing file. */
1871 if (errno
== EEXIST
)
1873 unlink (XSTRING (linkname
)->data
);
1874 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1881 report_file_error ("Making symbolic link", Flist (2, args
));
1883 report_file_error ("Making symbolic link", Flist (2, &filename
));
1889 #endif /* S_IFLNK */
1893 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
1894 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1895 "Define the job-wide logical name NAME to have the value STRING.\n\
1896 If STRING is nil or a null string, the logical name NAME is deleted.")
1898 Lisp_Object varname
;
1901 CHECK_STRING (varname
, 0);
1903 delete_logical_name (XSTRING (varname
)->data
);
1906 CHECK_STRING (string
, 1);
1908 if (XSTRING (string
)->size
== 0)
1909 delete_logical_name (XSTRING (varname
)->data
);
1911 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
1920 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
1921 "Open a network connection to PATH using LOGIN as the login string.")
1923 Lisp_Object path
, login
;
1927 CHECK_STRING (path
, 0);
1928 CHECK_STRING (login
, 0);
1930 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
1932 if (netresult
== -1)
1937 #endif /* HPUX_NET */
1939 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
1941 "Return t if file FILENAME specifies an absolute path name.\n\
1942 On Unix, this is a name starting with a `/' or a `~'.")
1944 Lisp_Object filename
;
1948 CHECK_STRING (filename
, 0);
1949 ptr
= XSTRING (filename
)->data
;
1950 if (*ptr
== '/' || *ptr
== '~'
1952 /* ??? This criterion is probably wrong for '<'. */
1953 || index (ptr
, ':') || index (ptr
, '<')
1954 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
1963 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
1964 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1965 See also `file-readable-p' and `file-attributes'.")
1967 Lisp_Object filename
;
1969 Lisp_Object abspath
;
1970 Lisp_Object handler
;
1972 CHECK_STRING (filename
, 0);
1973 abspath
= Fexpand_file_name (filename
, Qnil
);
1975 /* If the file name has special constructs in it,
1976 call the corresponding file handler. */
1977 handler
= Ffind_file_name_handler (abspath
);
1978 if (!NILP (handler
))
1979 return call2 (handler
, Qfile_exists_p
, abspath
);
1981 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
1984 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
1985 "Return t if FILENAME can be executed by you.\n\
1986 For a directory, this means you can access files in that directory.")
1988 Lisp_Object filename
;
1991 Lisp_Object abspath
;
1992 Lisp_Object handler
;
1994 CHECK_STRING (filename
, 0);
1995 abspath
= Fexpand_file_name (filename
, Qnil
);
1997 /* If the file name has special constructs in it,
1998 call the corresponding file handler. */
1999 handler
= Ffind_file_name_handler (abspath
);
2000 if (!NILP (handler
))
2001 return call2 (handler
, Qfile_executable_p
, abspath
);
2003 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
2006 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2007 "Return t if file FILENAME exists and you can read it.\n\
2008 See also `file-exists-p' and `file-attributes'.")
2010 Lisp_Object filename
;
2012 Lisp_Object abspath
;
2013 Lisp_Object handler
;
2015 CHECK_STRING (filename
, 0);
2016 abspath
= Fexpand_file_name (filename
, Qnil
);
2018 /* If the file name has special constructs in it,
2019 call the corresponding file handler. */
2020 handler
= Ffind_file_name_handler (abspath
);
2021 if (!NILP (handler
))
2022 return call2 (handler
, Qfile_readable_p
, abspath
);
2024 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
2027 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2028 "If file FILENAME is the name of a symbolic link\n\
2029 returns the name of the file to which it is linked.\n\
2030 Otherwise returns NIL.")
2032 Lisp_Object filename
;
2039 Lisp_Object handler
;
2041 CHECK_STRING (filename
, 0);
2042 filename
= Fexpand_file_name (filename
, Qnil
);
2044 /* If the file name has special constructs in it,
2045 call the corresponding file handler. */
2046 handler
= Ffind_file_name_handler (filename
);
2047 if (!NILP (handler
))
2048 return call2 (handler
, Qfile_symlink_p
, filename
);
2053 buf
= (char *) xmalloc (bufsize
);
2054 bzero (buf
, bufsize
);
2055 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2056 if (valsize
< bufsize
) break;
2057 /* Buffer was not long enough */
2066 val
= make_string (buf
, valsize
);
2069 #else /* not S_IFLNK */
2071 #endif /* not S_IFLNK */
2074 #ifdef SOLARIS_BROKEN_ACCESS
2075 /* In Solaris 2.1, the readonly-ness of the filesystem is not
2076 considered by the access system call. This is Sun's bug, but we
2077 still have to make Emacs work. */
2079 #include <sys/statvfs.h>
2085 struct statvfs statvfsb
;
2087 if (statvfs(path
, &statvfsb
))
2088 return 1; /* error from statvfs, be conservative and say not wrtable */
2090 /* Otherwise, fsys is ro if bit is set. */
2091 return statvfsb
.f_flag
& ST_RDONLY
;
2094 /* But on every other os, access has already done the right thing. */
2095 #define ro_fsys(path) 0
2098 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2100 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2101 "Return t if file FILENAME can be written or created by you.")
2103 Lisp_Object filename
;
2105 Lisp_Object abspath
, dir
;
2106 Lisp_Object handler
;
2108 CHECK_STRING (filename
, 0);
2109 abspath
= Fexpand_file_name (filename
, Qnil
);
2111 /* If the file name has special constructs in it,
2112 call the corresponding file handler. */
2113 handler
= Ffind_file_name_handler (abspath
);
2114 if (!NILP (handler
))
2115 return call2 (handler
, Qfile_writable_p
, abspath
);
2117 if (access (XSTRING (abspath
)->data
, 0) >= 0)
2118 return ((access (XSTRING (abspath
)->data
, 2) >= 0
2119 && ! ro_fsys ((char *) XSTRING (abspath
)->data
))
2121 dir
= Ffile_name_directory (abspath
);
2124 dir
= Fdirectory_file_name (dir
);
2126 return ((access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2127 && ! ro_fsys ((char *) XSTRING (dir
)->data
))
2131 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2132 "Return t if file FILENAME is the name of a directory as a file.\n\
2133 A directory name spec may be given instead; then the value is t\n\
2134 if the directory so specified exists and really is a directory.")
2136 Lisp_Object filename
;
2138 register Lisp_Object abspath
;
2140 Lisp_Object handler
;
2142 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2144 /* If the file name has special constructs in it,
2145 call the corresponding file handler. */
2146 handler
= Ffind_file_name_handler (abspath
);
2147 if (!NILP (handler
))
2148 return call2 (handler
, Qfile_directory_p
, abspath
);
2150 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2152 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2155 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2156 "Return t if file FILENAME is the name of a directory as a file,\n\
2157 and files in that directory can be opened by you. In order to use a\n\
2158 directory as a buffer's current directory, this predicate must return true.\n\
2159 A directory name spec may be given instead; then the value is t\n\
2160 if the directory so specified exists and really is a readable and\n\
2161 searchable directory.")
2163 Lisp_Object filename
;
2165 Lisp_Object handler
;
2167 /* If the file name has special constructs in it,
2168 call the corresponding file handler. */
2169 handler
= Ffind_file_name_handler (filename
);
2170 if (!NILP (handler
))
2171 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2173 if (NILP (Ffile_directory_p (filename
))
2174 || NILP (Ffile_executable_p (filename
)))
2180 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2181 "Return mode bits of FILE, as an integer.")
2183 Lisp_Object filename
;
2185 Lisp_Object abspath
;
2187 Lisp_Object handler
;
2189 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2191 /* If the file name has special constructs in it,
2192 call the corresponding file handler. */
2193 handler
= Ffind_file_name_handler (abspath
);
2194 if (!NILP (handler
))
2195 return call2 (handler
, Qfile_modes
, abspath
);
2197 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2199 return make_number (st
.st_mode
& 07777);
2202 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2203 "Set mode bits of FILE to MODE (an integer).\n\
2204 Only the 12 low bits of MODE are used.")
2206 Lisp_Object filename
, mode
;
2208 Lisp_Object abspath
;
2209 Lisp_Object handler
;
2211 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2212 CHECK_NUMBER (mode
, 1);
2214 /* If the file name has special constructs in it,
2215 call the corresponding file handler. */
2216 handler
= Ffind_file_name_handler (abspath
);
2217 if (!NILP (handler
))
2218 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2221 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2222 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2224 if (!egetenv ("USE_DOMAIN_ACLS"))
2227 struct timeval tvp
[2];
2229 /* chmod on apollo also change the file's modtime; need to save the
2230 modtime and then restore it. */
2231 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2233 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2237 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2238 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2240 /* reset the old accessed and modified times. */
2241 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2243 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2246 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2247 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2254 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2255 "Set the file permission bits for newly created files.\n\
2256 The argument MODE should be an integer; only the low 9 bits are used.\n\
2257 This setting is inherited by subprocesses.")
2261 CHECK_NUMBER (mode
, 0);
2263 umask ((~ XINT (mode
)) & 0777);
2268 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2269 "Return the default file protection for created files.\n\
2270 The value is an integer.")
2276 realmask
= umask (0);
2279 XSET (value
, Lisp_Int
, (~ realmask
) & 0777);
2285 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2286 "Tell Unix to finish all pending disk updates.")
2295 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2296 "Return t if file FILE1 is newer than file FILE2.\n\
2297 If FILE1 does not exist, the answer is nil;\n\
2298 otherwise, if FILE2 does not exist, the answer is t.")
2300 Lisp_Object file1
, file2
;
2302 Lisp_Object abspath1
, abspath2
;
2305 Lisp_Object handler
;
2306 struct gcpro gcpro1
, gcpro2
;
2308 CHECK_STRING (file1
, 0);
2309 CHECK_STRING (file2
, 0);
2312 GCPRO2 (abspath1
, file2
);
2313 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2314 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2317 /* If the file name has special constructs in it,
2318 call the corresponding file handler. */
2319 handler
= Ffind_file_name_handler (abspath1
);
2320 if (!NILP (handler
))
2321 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2323 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2326 mtime1
= st
.st_mtime
;
2328 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2331 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2334 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2336 "Insert contents of file FILENAME after point.\n\
2337 Returns list of absolute pathname and length of data inserted.\n\
2338 If second argument VISIT is non-nil, the buffer's visited filename\n\
2339 and last save file modtime are set, and it is marked unmodified.\n\
2340 If visiting and the file does not exist, visiting is completed\n\
2341 before the error is signaled.")
2343 Lisp_Object filename
, visit
;
2347 register int inserted
= 0;
2348 register int how_much
;
2349 int count
= specpdl_ptr
- specpdl
;
2350 struct gcpro gcpro1
;
2351 Lisp_Object handler
, val
;
2356 if (!NILP (current_buffer
->read_only
))
2357 Fbarf_if_buffer_read_only();
2359 CHECK_STRING (filename
, 0);
2360 filename
= Fexpand_file_name (filename
, Qnil
);
2362 /* If the file name has special constructs in it,
2363 call the corresponding file handler. */
2364 handler
= Ffind_file_name_handler (filename
);
2365 if (!NILP (handler
))
2367 val
= call3 (handler
, Qinsert_file_contents
, filename
, visit
);
2375 if (stat (XSTRING (filename
)->data
, &st
) < 0
2376 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2378 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2379 || fstat (fd
, &st
) < 0)
2380 #endif /* not APOLLO */
2382 if (fd
>= 0) close (fd
);
2384 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2390 record_unwind_protect (close_file_unwind
, make_number (fd
));
2393 /* This code will need to be changed in order to work on named
2394 pipes, and it's probably just not worth it. So we should at
2395 least signal an error. */
2396 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2397 Fsignal (Qfile_error
,
2398 Fcons (build_string ("reading from named pipe"),
2399 Fcons (filename
, Qnil
)));
2402 /* Supposedly happens on VMS. */
2404 error ("File size is negative");
2407 register Lisp_Object temp
;
2409 /* Make sure point-max won't overflow after this insertion. */
2410 XSET (temp
, Lisp_Int
, st
.st_size
+ Z
);
2411 if (st
.st_size
+ Z
!= XINT (temp
))
2412 error ("maximum buffer size exceeded");
2416 prepare_to_modify_buffer (point
, point
);
2419 if (GAP_SIZE
< st
.st_size
)
2420 make_gap (st
.st_size
- GAP_SIZE
);
2424 int try = min (st
.st_size
- inserted
, 64 << 10);
2427 /* Allow quitting out of the actual I/O. */
2430 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2448 record_insert (point
, inserted
);
2450 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2451 offset_intervals (current_buffer
, point
, inserted
);
2457 /* Discard the unwind protect */
2458 specpdl_ptr
= specpdl
+ count
;
2461 error ("IO error reading %s: %s",
2462 XSTRING (filename
)->data
, err_str (errno
));
2469 current_buffer
->undo_list
= Qnil
;
2471 stat (XSTRING (filename
)->data
, &st
);
2473 current_buffer
->modtime
= st
.st_mtime
;
2474 current_buffer
->save_modified
= MODIFF
;
2475 current_buffer
->auto_save_modified
= MODIFF
;
2476 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2477 #ifdef CLASH_DETECTION
2480 if (!NILP (current_buffer
->filename
))
2481 unlock_file (current_buffer
->filename
);
2482 unlock_file (filename
);
2484 #endif /* CLASH_DETECTION */
2485 current_buffer
->filename
= filename
;
2486 /* If visiting nonexistent file, return nil. */
2487 if (current_buffer
->modtime
== -1)
2488 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2491 signal_after_change (point
, 0, inserted
);
2494 RETURN_UNGCPRO (val
);
2495 RETURN_UNGCPRO (Fcons (filename
,
2496 Fcons (make_number (inserted
),
2500 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2501 "r\nFWrite region to file: ",
2502 "Write current region into specified file.\n\
2503 When called from a program, takes three arguments:\n\
2504 START, END and FILENAME. START and END are buffer positions.\n\
2505 Optional fourth argument APPEND if non-nil means\n\
2506 append to existing file contents (if any).\n\
2507 Optional fifth argument VISIT if t means\n\
2508 set the last-save-file-modtime of buffer to this file's modtime\n\
2509 and mark buffer not modified.\n\
2510 If VISIT is a string, it is a second file name;\n\
2511 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2512 VISIT is also the file name to lock and unlock for clash detection.\n\
2513 If VISIT is neither t nor nil nor a string,\n\
2514 that means do not print the \"Wrote file\" message.\n\
2515 Kludgy feature: if START is a string, then that string is written\n\
2516 to the file, instead of any buffer contents, and END is ignored.")
2517 (start
, end
, filename
, append
, visit
)
2518 Lisp_Object start
, end
, filename
, append
, visit
;
2526 int count
= specpdl_ptr
- specpdl
;
2528 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2530 Lisp_Object handler
;
2531 Lisp_Object visit_file
;
2532 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2534 /* Special kludge to simplify auto-saving */
2537 XFASTINT (start
) = BEG
;
2540 else if (XTYPE (start
) != Lisp_String
)
2541 validate_region (&start
, &end
);
2543 filename
= Fexpand_file_name (filename
, Qnil
);
2544 if (XTYPE (visit
) == Lisp_String
)
2545 visit_file
= Fexpand_file_name (visit
, Qnil
);
2547 visit_file
= filename
;
2549 GCPRO4 (start
, filename
, visit
, visit_file
);
2551 /* If the file name has special constructs in it,
2552 call the corresponding file handler. */
2553 handler
= Ffind_file_name_handler (filename
);
2555 if (!NILP (handler
))
2557 Lisp_Object args
[7];
2560 args
[1] = Qwrite_region
;
2566 val
= Ffuncall (7, args
);
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
);