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 call3 (handler
, Qrename_file
, filename
, newname
);
1753 if (NILP (ok_if_already_exists
)
1754 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1755 barf_or_query_if_file_exists (newname
, "rename to it",
1756 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1758 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1760 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1761 || 0 > unlink (XSTRING (filename
)->data
))
1766 Fcopy_file (filename
, newname
, ok_if_already_exists
, Qt
);
1767 Fdelete_file (filename
);
1774 report_file_error ("Renaming", Flist (2, args
));
1777 report_file_error ("Renaming", Flist (2, &filename
));
1784 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1785 "fAdd name to file: \nFName to add to %s: \np",
1786 "Give FILE additional name NEWNAME. Both args strings.\n\
1787 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1788 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1789 A number as third arg means request confirmation if NEWNAME already exists.\n\
1790 This is what happens in interactive use with M-x.")
1791 (filename
, newname
, ok_if_already_exists
)
1792 Lisp_Object filename
, newname
, ok_if_already_exists
;
1795 Lisp_Object args
[2];
1797 Lisp_Object handler
;
1798 struct gcpro gcpro1
, gcpro2
;
1800 GCPRO2 (filename
, newname
);
1801 CHECK_STRING (filename
, 0);
1802 CHECK_STRING (newname
, 1);
1803 filename
= Fexpand_file_name (filename
, Qnil
);
1804 newname
= Fexpand_file_name (newname
, Qnil
);
1806 /* If the file name has special constructs in it,
1807 call the corresponding file handler. */
1808 handler
= Ffind_file_name_handler (filename
);
1809 if (!NILP (handler
))
1810 return call3 (handler
, Qadd_name_to_file
, filename
, newname
);
1812 if (NILP (ok_if_already_exists
)
1813 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1814 barf_or_query_if_file_exists (newname
, "make it a new name",
1815 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1816 unlink (XSTRING (newname
)->data
);
1817 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1822 report_file_error ("Adding new name", Flist (2, args
));
1824 report_file_error ("Adding new name", Flist (2, &filename
));
1833 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1834 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1835 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1836 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1837 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1838 A number as third arg means request confirmation if NEWNAME already exists.\n\
1839 This happens for interactive use with M-x.")
1840 (filename
, linkname
, ok_if_already_exists
)
1841 Lisp_Object filename
, linkname
, ok_if_already_exists
;
1844 Lisp_Object args
[2];
1846 Lisp_Object handler
;
1847 struct gcpro gcpro1
, gcpro2
;
1849 GCPRO2 (filename
, linkname
);
1850 CHECK_STRING (filename
, 0);
1851 CHECK_STRING (linkname
, 1);
1852 #if 0 /* This made it impossible to make a link to a relative name. */
1853 filename
= Fexpand_file_name (filename
, Qnil
);
1855 linkname
= Fexpand_file_name (linkname
, Qnil
);
1857 /* If the file name has special constructs in it,
1858 call the corresponding file handler. */
1859 handler
= Ffind_file_name_handler (filename
);
1860 if (!NILP (handler
))
1861 return call3 (handler
, Qmake_symbolic_link
, filename
, linkname
);
1863 if (NILP (ok_if_already_exists
)
1864 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1865 barf_or_query_if_file_exists (linkname
, "make it a link",
1866 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1867 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1869 /* If we didn't complain already, silently delete existing file. */
1870 if (errno
== EEXIST
)
1872 unlink (XSTRING (linkname
)->data
);
1873 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1880 report_file_error ("Making symbolic link", Flist (2, args
));
1882 report_file_error ("Making symbolic link", Flist (2, &filename
));
1888 #endif /* S_IFLNK */
1892 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
1893 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1894 "Define the job-wide logical name NAME to have the value STRING.\n\
1895 If STRING is nil or a null string, the logical name NAME is deleted.")
1897 Lisp_Object varname
;
1900 CHECK_STRING (varname
, 0);
1902 delete_logical_name (XSTRING (varname
)->data
);
1905 CHECK_STRING (string
, 1);
1907 if (XSTRING (string
)->size
== 0)
1908 delete_logical_name (XSTRING (varname
)->data
);
1910 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
1919 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
1920 "Open a network connection to PATH using LOGIN as the login string.")
1922 Lisp_Object path
, login
;
1926 CHECK_STRING (path
, 0);
1927 CHECK_STRING (login
, 0);
1929 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
1931 if (netresult
== -1)
1936 #endif /* HPUX_NET */
1938 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
1940 "Return t if file FILENAME specifies an absolute path name.\n\
1941 On Unix, this is a name starting with a `/' or a `~'.")
1943 Lisp_Object filename
;
1947 CHECK_STRING (filename
, 0);
1948 ptr
= XSTRING (filename
)->data
;
1949 if (*ptr
== '/' || *ptr
== '~'
1951 /* ??? This criterion is probably wrong for '<'. */
1952 || index (ptr
, ':') || index (ptr
, '<')
1953 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
1962 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
1963 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1964 See also `file-readable-p' and `file-attributes'.")
1966 Lisp_Object filename
;
1968 Lisp_Object abspath
;
1969 Lisp_Object handler
;
1971 CHECK_STRING (filename
, 0);
1972 abspath
= Fexpand_file_name (filename
, Qnil
);
1974 /* If the file name has special constructs in it,
1975 call the corresponding file handler. */
1976 handler
= Ffind_file_name_handler (abspath
);
1977 if (!NILP (handler
))
1978 return call2 (handler
, Qfile_exists_p
, abspath
);
1980 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
1983 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
1984 "Return t if FILENAME can be executed by you.\n\
1985 For a directory, this means you can access files in that directory.")
1987 Lisp_Object filename
;
1990 Lisp_Object abspath
;
1991 Lisp_Object handler
;
1993 CHECK_STRING (filename
, 0);
1994 abspath
= Fexpand_file_name (filename
, Qnil
);
1996 /* If the file name has special constructs in it,
1997 call the corresponding file handler. */
1998 handler
= Ffind_file_name_handler (abspath
);
1999 if (!NILP (handler
))
2000 return call2 (handler
, Qfile_executable_p
, abspath
);
2002 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
2005 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2006 "Return t if file FILENAME exists and you can read it.\n\
2007 See also `file-exists-p' and `file-attributes'.")
2009 Lisp_Object filename
;
2011 Lisp_Object abspath
;
2012 Lisp_Object handler
;
2014 CHECK_STRING (filename
, 0);
2015 abspath
= Fexpand_file_name (filename
, Qnil
);
2017 /* If the file name has special constructs in it,
2018 call the corresponding file handler. */
2019 handler
= Ffind_file_name_handler (abspath
);
2020 if (!NILP (handler
))
2021 return call2 (handler
, Qfile_readable_p
, abspath
);
2023 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
2026 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2027 "If file FILENAME is the name of a symbolic link\n\
2028 returns the name of the file to which it is linked.\n\
2029 Otherwise returns NIL.")
2031 Lisp_Object filename
;
2038 Lisp_Object handler
;
2040 CHECK_STRING (filename
, 0);
2041 filename
= Fexpand_file_name (filename
, Qnil
);
2043 /* If the file name has special constructs in it,
2044 call the corresponding file handler. */
2045 handler
= Ffind_file_name_handler (filename
);
2046 if (!NILP (handler
))
2047 return call2 (handler
, Qfile_symlink_p
, filename
);
2052 buf
= (char *) xmalloc (bufsize
);
2053 bzero (buf
, bufsize
);
2054 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2055 if (valsize
< bufsize
) break;
2056 /* Buffer was not long enough */
2065 val
= make_string (buf
, valsize
);
2068 #else /* not S_IFLNK */
2070 #endif /* not S_IFLNK */
2073 #ifdef SOLARIS_BROKEN_ACCESS
2074 /* In Solaris 2.1, the readonly-ness of the filesystem is not
2075 considered by the access system call. This is Sun's bug, but we
2076 still have to make Emacs work. */
2078 #include <sys/statvfs.h>
2084 struct statvfs statvfsb
;
2086 if (statvfs(path
, &statvfsb
))
2087 return 1; /* error from statvfs, be conservative and say not wrtable */
2089 /* Otherwise, fsys is ro if bit is set. */
2090 return statvfsb
.f_flag
& ST_RDONLY
;
2093 /* But on every other os, access has already done the right thing. */
2094 #define ro_fsys(path) 0
2097 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2099 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2100 "Return t if file FILENAME can be written or created by you.")
2102 Lisp_Object filename
;
2104 Lisp_Object abspath
, dir
;
2105 Lisp_Object handler
;
2107 CHECK_STRING (filename
, 0);
2108 abspath
= Fexpand_file_name (filename
, Qnil
);
2110 /* If the file name has special constructs in it,
2111 call the corresponding file handler. */
2112 handler
= Ffind_file_name_handler (abspath
);
2113 if (!NILP (handler
))
2114 return call2 (handler
, Qfile_writable_p
, abspath
);
2116 if (access (XSTRING (abspath
)->data
, 0) >= 0)
2117 return ((access (XSTRING (abspath
)->data
, 2) >= 0
2118 && ! ro_fsys ((char *) XSTRING (abspath
)->data
))
2120 dir
= Ffile_name_directory (abspath
);
2123 dir
= Fdirectory_file_name (dir
);
2125 return ((access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2126 && ! ro_fsys ((char *) XSTRING (dir
)->data
))
2130 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2131 "Return t if file FILENAME is the name of a directory as a file.\n\
2132 A directory name spec may be given instead; then the value is t\n\
2133 if the directory so specified exists and really is a directory.")
2135 Lisp_Object filename
;
2137 register Lisp_Object abspath
;
2139 Lisp_Object handler
;
2141 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2143 /* If the file name has special constructs in it,
2144 call the corresponding file handler. */
2145 handler
= Ffind_file_name_handler (abspath
);
2146 if (!NILP (handler
))
2147 return call2 (handler
, Qfile_directory_p
, abspath
);
2149 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2151 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2154 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2155 "Return t if file FILENAME is the name of a directory as a file,\n\
2156 and files in that directory can be opened by you. In order to use a\n\
2157 directory as a buffer's current directory, this predicate must return true.\n\
2158 A directory name spec may be given instead; then the value is t\n\
2159 if the directory so specified exists and really is a readable and\n\
2160 searchable directory.")
2162 Lisp_Object filename
;
2164 Lisp_Object handler
;
2166 /* If the file name has special constructs in it,
2167 call the corresponding file handler. */
2168 handler
= Ffind_file_name_handler (filename
);
2169 if (!NILP (handler
))
2170 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2172 if (NILP (Ffile_directory_p (filename
))
2173 || NILP (Ffile_executable_p (filename
)))
2179 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2180 "Return mode bits of FILE, as an integer.")
2182 Lisp_Object filename
;
2184 Lisp_Object abspath
;
2186 Lisp_Object handler
;
2188 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2190 /* If the file name has special constructs in it,
2191 call the corresponding file handler. */
2192 handler
= Ffind_file_name_handler (abspath
);
2193 if (!NILP (handler
))
2194 return call2 (handler
, Qfile_modes
, abspath
);
2196 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2198 return make_number (st
.st_mode
& 07777);
2201 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2202 "Set mode bits of FILE to MODE (an integer).\n\
2203 Only the 12 low bits of MODE are used.")
2205 Lisp_Object filename
, mode
;
2207 Lisp_Object abspath
;
2208 Lisp_Object handler
;
2210 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2211 CHECK_NUMBER (mode
, 1);
2213 /* If the file name has special constructs in it,
2214 call the corresponding file handler. */
2215 handler
= Ffind_file_name_handler (abspath
);
2216 if (!NILP (handler
))
2217 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2220 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2221 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2223 if (!egetenv ("USE_DOMAIN_ACLS"))
2226 struct timeval tvp
[2];
2228 /* chmod on apollo also change the file's modtime; need to save the
2229 modtime and then restore it. */
2230 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2232 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2236 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2237 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2239 /* reset the old accessed and modified times. */
2240 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2242 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2245 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2246 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2253 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2254 "Set the file permission bits for newly created files.\n\
2255 The argument MODE should be an integer; only the low 9 bits are used.\n\
2256 This setting is inherited by subprocesses.")
2260 CHECK_NUMBER (mode
, 0);
2262 umask ((~ XINT (mode
)) & 0777);
2267 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2268 "Return the default file protection for created files.\n\
2269 The value is an integer.")
2275 realmask
= umask (0);
2278 XSET (value
, Lisp_Int
, (~ realmask
) & 0777);
2284 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2285 "Tell Unix to finish all pending disk updates.")
2294 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2295 "Return t if file FILE1 is newer than file FILE2.\n\
2296 If FILE1 does not exist, the answer is nil;\n\
2297 otherwise, if FILE2 does not exist, the answer is t.")
2299 Lisp_Object file1
, file2
;
2301 Lisp_Object abspath1
, abspath2
;
2304 Lisp_Object handler
;
2305 struct gcpro gcpro1
, gcpro2
;
2307 CHECK_STRING (file1
, 0);
2308 CHECK_STRING (file2
, 0);
2311 GCPRO2 (abspath1
, file2
);
2312 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2313 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2316 /* If the file name has special constructs in it,
2317 call the corresponding file handler. */
2318 handler
= Ffind_file_name_handler (abspath1
);
2319 if (!NILP (handler
))
2320 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2322 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2325 mtime1
= st
.st_mtime
;
2327 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2330 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2333 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2335 "Insert contents of file FILENAME after point.\n\
2336 Returns list of absolute pathname and length of data inserted.\n\
2337 If second argument VISIT is non-nil, the buffer's visited filename\n\
2338 and last save file modtime are set, and it is marked unmodified.\n\
2339 If visiting and the file does not exist, visiting is completed\n\
2340 before the error is signaled.")
2342 Lisp_Object filename
, visit
;
2346 register int inserted
= 0;
2347 register int how_much
;
2348 int count
= specpdl_ptr
- specpdl
;
2349 struct gcpro gcpro1
;
2350 Lisp_Object handler
, val
;
2355 if (!NILP (current_buffer
->read_only
))
2356 Fbarf_if_buffer_read_only();
2358 CHECK_STRING (filename
, 0);
2359 filename
= Fexpand_file_name (filename
, Qnil
);
2361 /* If the file name has special constructs in it,
2362 call the corresponding file handler. */
2363 handler
= Ffind_file_name_handler (filename
);
2364 if (!NILP (handler
))
2366 val
= call3 (handler
, Qinsert_file_contents
, filename
, visit
);
2374 if (stat (XSTRING (filename
)->data
, &st
) < 0
2375 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2377 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2378 || fstat (fd
, &st
) < 0)
2379 #endif /* not APOLLO */
2381 if (fd
>= 0) close (fd
);
2383 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2389 record_unwind_protect (close_file_unwind
, make_number (fd
));
2392 /* This code will need to be changed in order to work on named
2393 pipes, and it's probably just not worth it. So we should at
2394 least signal an error. */
2395 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2396 Fsignal (Qfile_error
,
2397 Fcons (build_string ("reading from named pipe"),
2398 Fcons (filename
, Qnil
)));
2401 /* Supposedly happens on VMS. */
2403 error ("File size is negative");
2406 register Lisp_Object temp
;
2408 /* Make sure point-max won't overflow after this insertion. */
2409 XSET (temp
, Lisp_Int
, st
.st_size
+ Z
);
2410 if (st
.st_size
+ Z
!= XINT (temp
))
2411 error ("maximum buffer size exceeded");
2415 prepare_to_modify_buffer (point
, point
);
2418 if (GAP_SIZE
< st
.st_size
)
2419 make_gap (st
.st_size
- GAP_SIZE
);
2423 int try = min (st
.st_size
- inserted
, 64 << 10);
2426 /* Allow quitting out of the actual I/O. */
2429 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2447 record_insert (point
, inserted
);
2449 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2450 offset_intervals (current_buffer
, point
, inserted
);
2456 /* Discard the unwind protect */
2457 specpdl_ptr
= specpdl
+ count
;
2460 error ("IO error reading %s: %s",
2461 XSTRING (filename
)->data
, err_str (errno
));
2468 current_buffer
->undo_list
= Qnil
;
2470 stat (XSTRING (filename
)->data
, &st
);
2472 current_buffer
->modtime
= st
.st_mtime
;
2473 current_buffer
->save_modified
= MODIFF
;
2474 current_buffer
->auto_save_modified
= MODIFF
;
2475 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2476 #ifdef CLASH_DETECTION
2479 if (!NILP (current_buffer
->filename
))
2480 unlock_file (current_buffer
->filename
);
2481 unlock_file (filename
);
2483 #endif /* CLASH_DETECTION */
2484 current_buffer
->filename
= filename
;
2485 /* If visiting nonexistent file, return nil. */
2486 if (current_buffer
->modtime
== -1)
2487 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2490 signal_after_change (point
, 0, inserted
);
2493 RETURN_UNGCPRO (val
);
2494 RETURN_UNGCPRO (Fcons (filename
,
2495 Fcons (make_number (inserted
),
2499 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2500 "r\nFWrite region to file: ",
2501 "Write current region into specified file.\n\
2502 When called from a program, takes three arguments:\n\
2503 START, END and FILENAME. START and END are buffer positions.\n\
2504 Optional fourth argument APPEND if non-nil means\n\
2505 append to existing file contents (if any).\n\
2506 Optional fifth argument VISIT if t means\n\
2507 set the last-save-file-modtime of buffer to this file's modtime\n\
2508 and mark buffer not modified.\n\
2509 If VISIT is a string, it is a second file name;\n\
2510 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2511 VISIT is also the file name to lock and unlock for clash detection.\n\
2512 If VISIT is neither t nor nil nor a string,\n\
2513 that means do not print the \"Wrote file\" message.\n\
2514 Kludgy feature: if START is a string, then that string is written\n\
2515 to the file, instead of any buffer contents, and END is ignored.")
2516 (start
, end
, filename
, append
, visit
)
2517 Lisp_Object start
, end
, filename
, append
, visit
;
2525 int count
= specpdl_ptr
- specpdl
;
2527 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2529 Lisp_Object handler
;
2530 Lisp_Object visit_file
;
2531 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2533 /* Special kludge to simplify auto-saving */
2536 XFASTINT (start
) = BEG
;
2539 else if (XTYPE (start
) != Lisp_String
)
2540 validate_region (&start
, &end
);
2542 filename
= Fexpand_file_name (filename
, Qnil
);
2543 if (XTYPE (visit
) == Lisp_String
)
2544 visit_file
= Fexpand_file_name (visit
, Qnil
);
2546 visit_file
= filename
;
2548 GCPRO4 (start
, filename
, visit
, visit_file
);
2550 /* If the file name has special constructs in it,
2551 call the corresponding file handler. */
2552 handler
= Ffind_file_name_handler (filename
);
2554 if (!NILP (handler
))
2556 Lisp_Object args
[7];
2559 args
[1] = Qwrite_region
;
2565 val
= Ffuncall (7, args
);
2567 /* Do this before reporting IO error
2568 to avoid a "file has changed on disk" warning on
2569 next attempt to save. */
2570 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2572 current_buffer
->modtime
= 0;
2573 current_buffer
->save_modified
= MODIFF
;
2574 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2575 current_buffer
->filename
= visit_file
;
2581 #ifdef CLASH_DETECTION
2583 lock_file (visit_file
);
2584 #endif /* CLASH_DETECTION */
2586 fn
= XSTRING (filename
)->data
;
2589 desc
= open (fn
, O_WRONLY
);
2593 if (auto_saving
) /* Overwrite any previous version of autosave file */
2595 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2596 desc
= open (fn
, O_RDWR
);
2598 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2599 ? XSTRING (current_buffer
->filename
)->data
: 0,
2602 else /* Write to temporary name and rename if no errors */
2604 Lisp_Object temp_name
;
2605 temp_name
= Ffile_name_directory (filename
);
2607 if (!NILP (temp_name
))
2609 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2610 build_string ("$$SAVE$$")));
2611 fname
= XSTRING (filename
)->data
;
2612 fn
= XSTRING (temp_name
)->data
;
2613 desc
= creat_copy_attrs (fname
, fn
);
2616 /* If we can't open the temporary file, try creating a new
2617 version of the original file. VMS "creat" creates a
2618 new version rather than truncating an existing file. */
2621 desc
= creat (fn
, 0666);
2622 #if 0 /* This can clobber an existing file and fail to replace it,
2623 if the user runs out of space. */
2626 /* We can't make a new version;
2627 try to truncate and rewrite existing version if any. */
2629 desc
= open (fn
, O_RDWR
);
2635 desc
= creat (fn
, 0666);
2638 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2639 #endif /* not VMS */
2645 #ifdef CLASH_DETECTION
2647 if (!auto_saving
) unlock_file (visit_file
);
2649 #endif /* CLASH_DETECTION */
2650 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2653 record_unwind_protect (close_file_unwind
, make_number (desc
));
2656 if (lseek (desc
, 0, 2) < 0)
2658 #ifdef CLASH_DETECTION
2659 if (!auto_saving
) unlock_file (visit_file
);
2660 #endif /* CLASH_DETECTION */
2661 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2666 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2667 * if we do writes that don't end with a carriage return. Furthermore
2668 * it cannot handle writes of more then 16K. The modified
2669 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2670 * this EXCEPT for the last record (iff it doesn't end with a carriage
2671 * return). This implies that if your buffer doesn't end with a carriage
2672 * return, you get one free... tough. However it also means that if
2673 * we make two calls to sys_write (a la the following code) you can
2674 * get one at the gap as well. The easiest way to fix this (honest)
2675 * is to move the gap to the next newline (or the end of the buffer).
2680 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2681 move_gap (find_next_newline (GPT
, 1));
2687 if (XTYPE (start
) == Lisp_String
)
2689 failure
= 0 > e_write (desc
, XSTRING (start
)->data
,
2690 XSTRING (start
)->size
);
2693 else if (XINT (start
) != XINT (end
))
2695 if (XINT (start
) < GPT
)
2697 register int end1
= XINT (end
);
2699 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
),
2700 min (GPT
, end1
) - tem
);
2704 if (XINT (end
) > GPT
&& !failure
)
2707 tem
= max (tem
, GPT
);
2708 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
);
2716 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2717 Disk full in NFS may be reported here. */
2718 /* mib says that closing the file will try to write as fast as NFS can do
2719 it, and that means the fsync here is not crucial for autosave files. */
2720 if (!auto_saving
&& fsync (desc
) < 0)
2721 failure
= 1, save_errno
= errno
;
2724 /* Spurious "file has changed on disk" warnings have been
2725 observed on Suns as well.
2726 It seems that `close' can change the modtime, under nfs.
2728 (This has supposedly been fixed in Sunos 4,
2729 but who knows about all the other machines with NFS?) */
2732 /* On VMS and APOLLO, must do the stat after the close
2733 since closing changes the modtime. */
2736 /* Recall that #if defined does not work on VMS. */
2743 /* NFS can report a write failure now. */
2744 if (close (desc
) < 0)
2745 failure
= 1, save_errno
= errno
;
2748 /* If we wrote to a temporary name and had no errors, rename to real name. */
2752 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2760 /* Discard the unwind protect */
2761 specpdl_ptr
= specpdl
+ count
;
2763 #ifdef CLASH_DETECTION
2765 unlock_file (visit_file
);
2766 #endif /* CLASH_DETECTION */
2768 /* Do this before reporting IO error
2769 to avoid a "file has changed on disk" warning on
2770 next attempt to save. */
2771 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2772 current_buffer
->modtime
= st
.st_mtime
;
2775 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2777 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2779 current_buffer
->save_modified
= MODIFF
;
2780 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2781 current_buffer
->filename
= visit_file
;
2783 else if (!NILP (visit
))
2787 message ("Wrote %s", XSTRING (visit_file
)->data
);
2793 e_write (desc
, addr
, len
)
2795 register char *addr
;
2798 char buf
[16 * 1024];
2799 register char *p
, *end
;
2801 if (!EQ (current_buffer
->selective_display
, Qt
))
2802 return write (desc
, addr
, len
) - len
;
2806 end
= p
+ sizeof buf
;
2811 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
2820 if (write (desc
, buf
, p
- buf
) != p
- buf
)
2826 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
2827 Sverify_visited_file_modtime
, 1, 1, 0,
2828 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2829 This means that the file has not been changed since it was visited or saved.")
2835 Lisp_Object handler
;
2837 CHECK_BUFFER (buf
, 0);
2840 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
2841 if (b
->modtime
== 0) return Qt
;
2843 /* If the file name has special constructs in it,
2844 call the corresponding file handler. */
2845 handler
= Ffind_file_name_handler (b
->filename
);
2846 if (!NILP (handler
))
2847 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
2849 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
2851 /* If the file doesn't exist now and didn't exist before,
2852 we say that it isn't modified, provided the error is a tame one. */
2853 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
2858 if (st
.st_mtime
== b
->modtime
2859 /* If both are positive, accept them if they are off by one second. */
2860 || (st
.st_mtime
> 0 && b
->modtime
> 0
2861 && (st
.st_mtime
== b
->modtime
+ 1
2862 || st
.st_mtime
== b
->modtime
- 1)))
2867 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
2868 Sclear_visited_file_modtime
, 0, 0, 0,
2869 "Clear out records of last mod time of visited file.\n\
2870 Next attempt to save will certainly not complain of a discrepancy.")
2873 current_buffer
->modtime
= 0;
2877 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
2878 Svisited_file_modtime
, 0, 0, 0,
2879 "Return the current buffer's recorded visited file modification time.\n\
2880 The value is a list of the form (HIGH . LOW), like the time values\n\
2881 that `file-attributes' returns.")
2884 return long_to_cons (current_buffer
->modtime
);
2887 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
2888 Sset_visited_file_modtime
, 0, 1, 0,
2889 "Update buffer's recorded modification time from the visited file's time.\n\
2890 Useful if the buffer was not read from the file normally\n\
2891 or if the file itself has been changed for some known benign reason.\n\
2892 An argument specifies the modification time value to use\n\
2893 \(instead of that of the visited file), in the form of a list\n\
2894 \(HIGH . LOW) or (HIGH LOW).")
2896 Lisp_Object time_list
;
2898 if (!NILP (time_list
))
2899 current_buffer
->modtime
= cons_to_long (time_list
);
2902 register Lisp_Object filename
;
2904 Lisp_Object handler
;
2906 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
2908 /* If the file name has special constructs in it,
2909 call the corresponding file handler. */
2910 handler
= Ffind_file_name_handler (filename
);
2911 if (!NILP (handler
))
2912 return call3 (handler
, Qset_visited_file_modtime
, filename
, Qnil
);
2913 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
2914 current_buffer
->modtime
= st
.st_mtime
;
2923 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
2926 message ("Autosaving...error for %s", name
);
2927 Fsleep_for (make_number (1), Qnil
);
2928 message ("Autosaving...error!for %s", name
);
2929 Fsleep_for (make_number (1), Qnil
);
2930 message ("Autosaving...error for %s", name
);
2931 Fsleep_for (make_number (1), Qnil
);
2941 /* Get visited file's mode to become the auto save file's mode. */
2942 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
2943 /* But make sure we can overwrite it later! */
2944 auto_save_mode_bits
= st
.st_mode
| 0600;
2946 auto_save_mode_bits
= 0666;
2949 Fwrite_region (Qnil
, Qnil
,
2950 current_buffer
->auto_save_file_name
,
2954 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
2955 "Auto-save all buffers that need it.\n\
2956 This is all buffers that have auto-saving enabled\n\
2957 and are changed since last auto-saved.\n\
2958 Auto-saving writes the buffer into a file\n\
2959 so that your editing is not lost if the system crashes.\n\
2960 This file is not the file you visited; that changes only when you save.\n\n\
2961 Non-nil first argument means do not print any message if successful.\n\
2962 Non-nil second argument means save only current buffer.")
2963 (no_message
, current_only
)
2964 Lisp_Object no_message
, current_only
;
2966 struct buffer
*old
= current_buffer
, *b
;
2967 Lisp_Object tail
, buf
;
2969 char *omessage
= echo_area_glyphs
;
2970 extern int minibuf_level
;
2971 int do_handled_files
;
2973 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2974 point to non-strings reached from Vbuffer_alist. */
2980 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2981 eventually call do-auto-save, so don't err here in that case. */
2982 if (!NILP (Vrun_hooks
))
2983 call1 (Vrun_hooks
, intern ("auto-save-hook"));
2985 /* First, save all files which don't have handlers. If Emacs is
2986 crashing, the handlers may tweak what is causing Emacs to crash
2987 in the first place, and it would be a shame if Emacs failed to
2988 autosave perfectly ordinary files because it couldn't handle some
2990 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
2991 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2992 tail
= XCONS (tail
)->cdr
)
2994 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
2997 if (!NILP (current_only
)
2998 && b
!= current_buffer
)
3001 /* Check for auto save enabled
3002 and file changed since last auto save
3003 and file changed since last real save. */
3004 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3005 && b
->save_modified
< BUF_MODIFF (b
)
3006 && b
->auto_save_modified
< BUF_MODIFF (b
)
3007 && (do_handled_files
3008 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
))))
3010 if ((XFASTINT (b
->save_length
) * 10
3011 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3012 /* A short file is likely to change a large fraction;
3013 spare the user annoying messages. */
3014 && XFASTINT (b
->save_length
) > 5000
3015 /* These messages are frequent and annoying for `*mail*'. */
3016 && !EQ (b
->filename
, Qnil
)
3017 && NILP (no_message
))
3019 /* It has shrunk too much; turn off auto-saving here. */
3020 message ("Buffer %s has shrunk a lot; auto save turned off there",
3021 XSTRING (b
->name
)->data
);
3022 /* User can reenable saving with M-x auto-save. */
3023 b
->auto_save_file_name
= Qnil
;
3024 /* Prevent warning from repeating if user does so. */
3025 XFASTINT (b
->save_length
) = 0;
3026 Fsleep_for (make_number (1), Qnil
);
3029 set_buffer_internal (b
);
3030 if (!auto_saved
&& NILP (no_message
))
3031 message1 ("Auto-saving...");
3032 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3034 b
->auto_save_modified
= BUF_MODIFF (b
);
3035 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3036 set_buffer_internal (old
);
3040 /* Prevent another auto save till enough input events come in. */
3041 record_auto_save ();
3043 if (auto_saved
&& NILP (no_message
))
3044 message1 (omessage
? omessage
: "Auto-saving...done");
3050 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3051 Sset_buffer_auto_saved
, 0, 0, 0,
3052 "Mark current buffer as auto-saved with its current text.\n\
3053 No auto-save file will be written until the buffer changes again.")
3056 current_buffer
->auto_save_modified
= MODIFF
;
3057 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3061 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3063 "Return t if buffer has been auto-saved since last read in or saved.")
3066 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3069 /* Reading and completing file names */
3070 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3072 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3074 "Internal subroutine for read-file-name. Do not call this.")
3075 (string
, dir
, action
)
3076 Lisp_Object string
, dir
, action
;
3077 /* action is nil for complete, t for return list of completions,
3078 lambda for verify final value */
3080 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3082 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3089 /* No need to protect ACTION--we only compare it with t and nil. */
3090 GCPRO4 (string
, realdir
, name
, specdir
);
3092 if (XSTRING (string
)->size
== 0)
3094 if (EQ (action
, Qlambda
))
3102 orig_string
= string
;
3103 string
= Fsubstitute_in_file_name (string
);
3104 changed
= NILP (Fstring_equal (string
, orig_string
));
3105 name
= Ffile_name_nondirectory (string
);
3106 val
= Ffile_name_directory (string
);
3108 realdir
= Fexpand_file_name (val
, realdir
);
3113 specdir
= Ffile_name_directory (string
);
3114 val
= Ffile_name_completion (name
, realdir
);
3116 if (XTYPE (val
) != Lisp_String
)
3123 if (!NILP (specdir
))
3124 val
= concat2 (specdir
, val
);
3127 register unsigned char *old
, *new;
3131 osize
= XSTRING (val
)->size
;
3132 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3133 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3134 if (*old
++ == '$') count
++;
3137 old
= XSTRING (val
)->data
;
3138 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3139 new = XSTRING (val
)->data
;
3140 for (n
= osize
; n
> 0; n
--)
3151 #endif /* Not VMS */
3156 if (EQ (action
, Qt
))
3157 return Ffile_name_all_completions (name
, realdir
);
3158 /* Only other case actually used is ACTION = lambda */
3160 /* Supposedly this helps commands such as `cd' that read directory names,
3161 but can someone explain how it helps them? -- RMS */
3162 if (XSTRING (name
)->size
== 0)
3165 return Ffile_exists_p (string
);
3168 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3169 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3170 Value is not expanded---you must call `expand-file-name' yourself.\n\
3171 Default name to DEFAULT if user enters a null string.\n\
3172 (If DEFAULT is omitted, the visited file name is used.)\n\
3173 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3174 Non-nil and non-t means also require confirmation after completion.\n\
3175 Fifth arg INITIAL specifies text to start with.\n\
3176 DIR defaults to current buffer's directory default.")
3177 (prompt
, dir
, defalt
, mustmatch
, initial
)
3178 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3180 Lisp_Object val
, insdef
, insdef1
, tem
;
3181 struct gcpro gcpro1
, gcpro2
;
3182 register char *homedir
;
3186 dir
= current_buffer
->directory
;
3188 defalt
= current_buffer
->filename
;
3190 /* If dir starts with user's homedir, change that to ~. */
3191 homedir
= (char *) egetenv ("HOME");
3193 && XTYPE (dir
) == Lisp_String
3194 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3195 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3197 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3198 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3199 XSTRING (dir
)->data
[0] = '~';
3202 if (insert_default_directory
)
3206 if (!NILP (initial
))
3208 Lisp_Object args
[2], pos
;
3212 insdef
= Fconcat (2, args
);
3213 pos
= make_number (XSTRING (dir
)->size
);
3214 insdef1
= Fcons (insdef
, pos
);
3218 insdef
= Qnil
, insdef1
= Qnil
;
3221 count
= specpdl_ptr
- specpdl
;
3222 specbind (intern ("completion-ignore-case"), Qt
);
3225 GCPRO2 (insdef
, defalt
);
3226 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3227 dir
, mustmatch
, insdef1
,
3228 Qfile_name_history
);
3231 unbind_to (count
, Qnil
);
3236 error ("No file name specified");
3237 tem
= Fstring_equal (val
, insdef
);
3238 if (!NILP (tem
) && !NILP (defalt
))
3240 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3242 return Fsubstitute_in_file_name (val
);
3245 #if 0 /* Old version */
3246 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3247 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3248 Value is not expanded---you must call `expand-file-name' yourself.\n\
3249 Default name to DEFAULT if user enters a null string.\n\
3250 (If DEFAULT is omitted, the visited file name is used.)\n\
3251 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3252 Non-nil and non-t means also require confirmation after completion.\n\
3253 Fifth arg INITIAL specifies text to start with.\n\
3254 DIR defaults to current buffer's directory default.")
3255 (prompt
, dir
, defalt
, mustmatch
, initial
)
3256 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3258 Lisp_Object val
, insdef
, tem
;
3259 struct gcpro gcpro1
, gcpro2
;
3260 register char *homedir
;
3264 dir
= current_buffer
->directory
;
3266 defalt
= current_buffer
->filename
;
3268 /* If dir starts with user's homedir, change that to ~. */
3269 homedir
= (char *) egetenv ("HOME");
3271 && XTYPE (dir
) == Lisp_String
3272 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3273 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3275 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3276 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3277 XSTRING (dir
)->data
[0] = '~';
3280 if (!NILP (initial
))
3282 else if (insert_default_directory
)
3285 insdef
= build_string ("");
3288 count
= specpdl_ptr
- specpdl
;
3289 specbind (intern ("completion-ignore-case"), Qt
);
3292 GCPRO2 (insdef
, defalt
);
3293 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3295 insert_default_directory
? insdef
: Qnil
,
3296 Qfile_name_history
);
3299 unbind_to (count
, Qnil
);
3304 error ("No file name specified");
3305 tem
= Fstring_equal (val
, insdef
);
3306 if (!NILP (tem
) && !NILP (defalt
))
3308 return Fsubstitute_in_file_name (val
);
3310 #endif /* Old version */
3314 Qexpand_file_name
= intern ("expand-file-name");
3315 Qdirectory_file_name
= intern ("directory-file-name");
3316 Qfile_name_directory
= intern ("file-name-directory");
3317 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3318 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
3319 Qfile_name_as_directory
= intern ("file-name-as-directory");
3320 Qcopy_file
= intern ("copy-file");
3321 Qmake_directory
= intern ("make-directory");
3322 Qdelete_directory
= intern ("delete-directory");
3323 Qdelete_file
= intern ("delete-file");
3324 Qrename_file
= intern ("rename-file");
3325 Qadd_name_to_file
= intern ("add-name-to-file");
3326 Qmake_symbolic_link
= intern ("make-symbolic-link");
3327 Qfile_exists_p
= intern ("file-exists-p");
3328 Qfile_executable_p
= intern ("file-executable-p");
3329 Qfile_readable_p
= intern ("file-readable-p");
3330 Qfile_symlink_p
= intern ("file-symlink-p");
3331 Qfile_writable_p
= intern ("file-writable-p");
3332 Qfile_directory_p
= intern ("file-directory-p");
3333 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3334 Qfile_modes
= intern ("file-modes");
3335 Qset_file_modes
= intern ("set-file-modes");
3336 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3337 Qinsert_file_contents
= intern ("insert-file-contents");
3338 Qwrite_region
= intern ("write-region");
3339 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3340 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
3342 staticpro (&Qexpand_file_name
);
3343 staticpro (&Qdirectory_file_name
);
3344 staticpro (&Qfile_name_directory
);
3345 staticpro (&Qfile_name_nondirectory
);
3346 staticpro (&Qunhandled_file_name_directory
);
3347 staticpro (&Qfile_name_as_directory
);
3348 staticpro (&Qcopy_file
);
3349 staticpro (&Qmake_directory
);
3350 staticpro (&Qdelete_directory
);
3351 staticpro (&Qdelete_file
);
3352 staticpro (&Qrename_file
);
3353 staticpro (&Qadd_name_to_file
);
3354 staticpro (&Qmake_symbolic_link
);
3355 staticpro (&Qfile_exists_p
);
3356 staticpro (&Qfile_executable_p
);
3357 staticpro (&Qfile_readable_p
);
3358 staticpro (&Qfile_symlink_p
);
3359 staticpro (&Qfile_writable_p
);
3360 staticpro (&Qfile_directory_p
);
3361 staticpro (&Qfile_accessible_directory_p
);
3362 staticpro (&Qfile_modes
);
3363 staticpro (&Qset_file_modes
);
3364 staticpro (&Qfile_newer_than_file_p
);
3365 staticpro (&Qinsert_file_contents
);
3366 staticpro (&Qwrite_region
);
3367 staticpro (&Qverify_visited_file_modtime
);
3369 Qfile_name_history
= intern ("file-name-history");
3370 Fset (Qfile_name_history
, Qnil
);
3371 staticpro (&Qfile_name_history
);
3373 Qfile_error
= intern ("file-error");
3374 staticpro (&Qfile_error
);
3375 Qfile_already_exists
= intern("file-already-exists");
3376 staticpro (&Qfile_already_exists
);
3378 Fput (Qfile_error
, Qerror_conditions
,
3379 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3380 Fput (Qfile_error
, Qerror_message
,
3381 build_string ("File error"));
3383 Fput (Qfile_already_exists
, Qerror_conditions
,
3384 Fcons (Qfile_already_exists
,
3385 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3386 Fput (Qfile_already_exists
, Qerror_message
,
3387 build_string ("File already exists"));
3389 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3390 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3391 insert_default_directory
= 1;
3393 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3394 "*Non-nil means write new files with record format `stmlf'.\n\
3395 nil means use format `var'. This variable is meaningful only on VMS.");
3396 vms_stmlf_recfm
= 0;
3398 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
3399 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3400 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3403 The first argument given to HANDLER is the name of the I/O primitive\n\
3404 to be handled; the remaining arguments are the arguments that were\n\
3405 passed to that primitive. For example, if you do\n\
3406 (file-exists-p FILENAME)\n\
3407 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
3408 (funcall HANDLER 'file-exists-p FILENAME)\n\
3409 The function `find-file-name-handler' checks this list for a handler\n\
3410 for its argument.");
3411 Vfile_name_handler_alist
= Qnil
;
3413 defsubr (&Sfind_file_name_handler
);
3414 defsubr (&Sfile_name_directory
);
3415 defsubr (&Sfile_name_nondirectory
);
3416 defsubr (&Sunhandled_file_name_directory
);
3417 defsubr (&Sfile_name_as_directory
);
3418 defsubr (&Sdirectory_file_name
);
3419 defsubr (&Smake_temp_name
);
3420 defsubr (&Sexpand_file_name
);
3421 defsubr (&Ssubstitute_in_file_name
);
3422 defsubr (&Scopy_file
);
3423 defsubr (&Smake_directory_internal
);
3424 defsubr (&Sdelete_directory
);
3425 defsubr (&Sdelete_file
);
3426 defsubr (&Srename_file
);
3427 defsubr (&Sadd_name_to_file
);
3429 defsubr (&Smake_symbolic_link
);
3430 #endif /* S_IFLNK */
3432 defsubr (&Sdefine_logical_name
);
3435 defsubr (&Ssysnetunam
);
3436 #endif /* HPUX_NET */
3437 defsubr (&Sfile_name_absolute_p
);
3438 defsubr (&Sfile_exists_p
);
3439 defsubr (&Sfile_executable_p
);
3440 defsubr (&Sfile_readable_p
);
3441 defsubr (&Sfile_writable_p
);
3442 defsubr (&Sfile_symlink_p
);
3443 defsubr (&Sfile_directory_p
);
3444 defsubr (&Sfile_accessible_directory_p
);
3445 defsubr (&Sfile_modes
);
3446 defsubr (&Sset_file_modes
);
3447 defsubr (&Sset_default_file_modes
);
3448 defsubr (&Sdefault_file_modes
);
3449 defsubr (&Sfile_newer_than_file_p
);
3450 defsubr (&Sinsert_file_contents
);
3451 defsubr (&Swrite_region
);
3452 defsubr (&Sverify_visited_file_modtime
);
3453 defsubr (&Sclear_visited_file_modtime
);
3454 defsubr (&Svisited_file_modtime
);
3455 defsubr (&Sset_visited_file_modtime
);
3456 defsubr (&Sdo_auto_save
);
3457 defsubr (&Sset_buffer_auto_saved
);
3458 defsubr (&Srecent_auto_save_p
);
3460 defsubr (&Sread_file_name_internal
);
3461 defsubr (&Sread_file_name
);
3464 defsubr (&Sunix_sync
);