1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 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>
29 #if !defined (S_ISLNK) && defined (S_IFLNK)
30 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
33 #if !defined (S_ISREG) && defined (S_IFREG)
34 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
45 #include <sys/param.h>
63 extern char *strerror ();
78 #include "intervals.h"
108 #define min(a, b) ((a) < (b) ? (a) : (b))
109 #define max(a, b) ((a) > (b) ? (a) : (b))
111 /* Nonzero during writing of auto-save files */
114 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
115 a new file with the same mode as the original */
116 int auto_save_mode_bits
;
118 /* Alist of elements (REGEXP . HANDLER) for file names
119 whose I/O is done with a special handler. */
120 Lisp_Object Vfile_name_handler_alist
;
122 /* Functions to be called to process text properties in inserted file. */
123 Lisp_Object Vafter_insert_file_functions
;
125 /* Functions to be called to create text property annotations for file. */
126 Lisp_Object Vwrite_region_annotate_functions
;
128 /* During build_annotations, each time an annotation function is called,
129 this holds the annotations made by the previous functions. */
130 Lisp_Object Vwrite_region_annotations_so_far
;
132 /* File name in which we write a list of all our auto save files. */
133 Lisp_Object Vauto_save_list_file_name
;
135 /* Nonzero means, when reading a filename in the minibuffer,
136 start out by inserting the default directory into the minibuffer. */
137 int insert_default_directory
;
139 /* On VMS, nonzero means write new files with record format stmlf.
140 Zero means use var format. */
143 /* These variables describe handlers that have "already" had a chance
144 to handle the current operation.
146 Vinhibit_file_name_handlers is a list of file name handlers.
147 Vinhibit_file_name_operation is the operation being handled.
148 If we try to handle that operation, we ignore those handlers. */
150 static Lisp_Object Vinhibit_file_name_handlers
;
151 static Lisp_Object Vinhibit_file_name_operation
;
153 Lisp_Object Qfile_error
, Qfile_already_exists
;
155 Lisp_Object Qfile_name_history
;
157 Lisp_Object Qcar_less_than_car
;
159 report_file_error (string
, data
)
163 Lisp_Object errstring
;
165 errstring
= build_string (strerror (errno
));
167 /* System error messages are capitalized. Downcase the initial
168 unless it is followed by a slash. */
169 if (XSTRING (errstring
)->data
[1] != '/')
170 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
173 Fsignal (Qfile_error
,
174 Fcons (build_string (string
), Fcons (errstring
, data
)));
177 close_file_unwind (fd
)
180 close (XFASTINT (fd
));
183 /* Restore point, having saved it as a marker. */
185 restore_point_unwind (location
)
186 Lisp_Object location
;
188 SET_PT (marker_position (location
));
189 Fset_marker (location
, Qnil
, Qnil
);
192 Lisp_Object Qexpand_file_name
;
193 Lisp_Object Qdirectory_file_name
;
194 Lisp_Object Qfile_name_directory
;
195 Lisp_Object Qfile_name_nondirectory
;
196 Lisp_Object Qunhandled_file_name_directory
;
197 Lisp_Object Qfile_name_as_directory
;
198 Lisp_Object Qcopy_file
;
199 Lisp_Object Qmake_directory_internal
;
200 Lisp_Object Qdelete_directory
;
201 Lisp_Object Qdelete_file
;
202 Lisp_Object Qrename_file
;
203 Lisp_Object Qadd_name_to_file
;
204 Lisp_Object Qmake_symbolic_link
;
205 Lisp_Object Qfile_exists_p
;
206 Lisp_Object Qfile_executable_p
;
207 Lisp_Object Qfile_readable_p
;
208 Lisp_Object Qfile_symlink_p
;
209 Lisp_Object Qfile_writable_p
;
210 Lisp_Object Qfile_directory_p
;
211 Lisp_Object Qfile_accessible_directory_p
;
212 Lisp_Object Qfile_modes
;
213 Lisp_Object Qset_file_modes
;
214 Lisp_Object Qfile_newer_than_file_p
;
215 Lisp_Object Qinsert_file_contents
;
216 Lisp_Object Qwrite_region
;
217 Lisp_Object Qverify_visited_file_modtime
;
218 Lisp_Object Qset_visited_file_modtime
;
220 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
221 "Return FILENAME's handler function for OPERATION, if it has one.\n\
222 Otherwise, return nil.\n\
223 A file name is handled if one of the regular expressions in\n\
224 `file-name-handler-alist' matches it.\n\n\
225 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
226 any handlers that are members of `inhibit-file-name-handlers',\n\
227 but we still do run any other handlers. This lets handlers\n\
228 use the standard functions without calling themselves recursively.")
229 (filename
, operation
)
230 Lisp_Object filename
, operation
;
232 /* This function must not munge the match data. */
233 Lisp_Object chain
, inhibited_handlers
;
235 CHECK_STRING (filename
, 0);
237 if (EQ (operation
, Vinhibit_file_name_operation
))
238 inhibited_handlers
= Vinhibit_file_name_handlers
;
240 inhibited_handlers
= Qnil
;
242 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
243 chain
= XCONS (chain
)->cdr
)
246 elt
= XCONS (chain
)->car
;
250 string
= XCONS (elt
)->car
;
251 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
253 Lisp_Object handler
, tem
;
255 handler
= XCONS (elt
)->cdr
;
256 tem
= Fmemq (handler
, inhibited_handlers
);
267 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
269 "Return the directory component in file name NAME.\n\
270 Return nil if NAME does not include a directory.\n\
271 Otherwise return a directory spec.\n\
272 Given a Unix syntax file name, returns a string ending in slash;\n\
273 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
277 register unsigned char *beg
;
278 register unsigned char *p
;
281 CHECK_STRING (file
, 0);
283 /* If the file name has special constructs in it,
284 call the corresponding file handler. */
285 handler
= Ffind_file_name_handler (file
, Qfile_name_directory
);
287 return call2 (handler
, Qfile_name_directory
, file
);
289 #ifdef FILE_SYSTEM_CASE
290 file
= FILE_SYSTEM_CASE (file
);
292 beg
= XSTRING (file
)->data
;
293 p
= beg
+ XSTRING (file
)->size
;
295 while (p
!= beg
&& p
[-1] != '/'
297 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
300 && p
[-1] != ':' && p
[-1] != '\\'
307 /* Expansion of "c:" to drive and default directory. */
308 if (p
== beg
+ 2 && beg
[1] == ':')
310 int drive
= (*beg
) - 'a';
311 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
312 unsigned char *res
= alloca (MAXPATHLEN
+ 5);
313 if (getdefdir (drive
+ 1, res
+ 2))
315 res
[0] = drive
+ 'a';
317 if (res
[strlen (res
) - 1] != '/')
320 p
= beg
+ strlen (beg
);
324 return make_string (beg
, p
- beg
);
327 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
329 "Return file name NAME sans its directory.\n\
330 For example, in a Unix-syntax file name,\n\
331 this is everything after the last slash,\n\
332 or the entire name if it contains no slash.")
336 register unsigned char *beg
, *p
, *end
;
339 CHECK_STRING (file
, 0);
341 /* If the file name has special constructs in it,
342 call the corresponding file handler. */
343 handler
= Ffind_file_name_handler (file
, Qfile_name_nondirectory
);
345 return call2 (handler
, Qfile_name_nondirectory
, file
);
347 beg
= XSTRING (file
)->data
;
348 end
= p
= beg
+ XSTRING (file
)->size
;
350 while (p
!= beg
&& p
[-1] != '/'
352 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
355 && p
[-1] != ':' && p
[-1] != '\\'
359 return make_string (p
, end
- p
);
362 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
363 "Return a directly usable directory name somehow associated with FILENAME.\n\
364 A `directly usable' directory name is one that may be used without the\n\
365 intervention of any file handler.\n\
366 If FILENAME is a directly usable file itself, return\n\
367 (file-name-directory FILENAME).\n\
368 The `call-process' and `start-process' functions use this function to\n\
369 get a current directory to run processes in.")
371 Lisp_Object filename
;
375 /* If the file name has special constructs in it,
376 call the corresponding file handler. */
377 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
379 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
381 return Ffile_name_directory (filename
);
386 file_name_as_directory (out
, in
)
389 int size
= strlen (in
) - 1;
394 /* Is it already a directory string? */
395 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
397 /* Is it a VMS directory file name? If so, hack VMS syntax. */
398 else if (! index (in
, '/')
399 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
400 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
401 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
402 || ! strncmp (&in
[size
- 5], ".dir", 4))
403 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
404 && in
[size
] == '1')))
406 register char *p
, *dot
;
410 dir:x.dir --> dir:[x]
411 dir:[x]y.dir --> dir:[x.y] */
413 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
416 strncpy (out
, in
, p
- in
);
435 dot
= index (p
, '.');
438 /* blindly remove any extension */
439 size
= strlen (out
) + (dot
- p
);
440 strncat (out
, p
, dot
- p
);
451 /* For Unix syntax, Append a slash if necessary */
453 if (out
[size
] != ':' && out
[size
] != '/' && out
[size
] != '\\')
455 if (out
[size
] != '/')
462 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
463 Sfile_name_as_directory
, 1, 1, 0,
464 "Return a string representing file FILENAME interpreted as a directory.\n\
465 This operation exists because a directory is also a file, but its name as\n\
466 a directory is different from its name as a file.\n\
467 The result can be used as the value of `default-directory'\n\
468 or passed as second argument to `expand-file-name'.\n\
469 For a Unix-syntax file name, just appends a slash.\n\
470 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
477 CHECK_STRING (file
, 0);
481 /* If the file name has special constructs in it,
482 call the corresponding file handler. */
483 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
485 return call2 (handler
, Qfile_name_as_directory
, file
);
487 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
488 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
492 * Convert from directory name to filename.
494 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
495 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
496 * On UNIX, it's simple: just make sure there is a terminating /
498 * Value is nonzero if the string output is different from the input.
501 directory_file_name (src
, dst
)
509 struct FAB fab
= cc$rms_fab
;
510 struct NAM nam
= cc$rms_nam
;
511 char esa
[NAM$C_MAXRSS
];
516 if (! index (src
, '/')
517 && (src
[slen
- 1] == ']'
518 || src
[slen
- 1] == ':'
519 || src
[slen
- 1] == '>'))
521 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
523 fab
.fab$b_fns
= slen
;
524 fab
.fab$l_nam
= &nam
;
525 fab
.fab$l_fop
= FAB$M_NAM
;
528 nam
.nam$b_ess
= sizeof esa
;
529 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
531 /* We call SYS$PARSE to handle such things as [--] for us. */
532 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
534 slen
= nam
.nam$b_esl
;
535 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
540 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
542 /* what about when we have logical_name:???? */
543 if (src
[slen
- 1] == ':')
544 { /* Xlate logical name and see what we get */
545 ptr
= strcpy (dst
, src
); /* upper case for getenv */
548 if ('a' <= *ptr
&& *ptr
<= 'z')
552 dst
[slen
- 1] = 0; /* remove colon */
553 if (!(src
= egetenv (dst
)))
555 /* should we jump to the beginning of this procedure?
556 Good points: allows us to use logical names that xlate
558 Bad points: can be a problem if we just translated to a device
560 For now, I'll punt and always expect VMS names, and hope for
563 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
564 { /* no recursion here! */
570 { /* not a directory spec */
575 bracket
= src
[slen
- 1];
577 /* If bracket is ']' or '>', bracket - 2 is the corresponding
579 ptr
= index (src
, bracket
- 2);
581 { /* no opening bracket */
585 if (!(rptr
= rindex (src
, '.')))
588 strncpy (dst
, src
, slen
);
592 dst
[slen
++] = bracket
;
597 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
598 then translate the device and recurse. */
599 if (dst
[slen
- 1] == ':'
600 && dst
[slen
- 2] != ':' /* skip decnet nodes */
601 && strcmp(src
+ slen
, "[000000]") == 0)
603 dst
[slen
- 1] = '\0';
604 if ((ptr
= egetenv (dst
))
605 && (rlen
= strlen (ptr
) - 1) > 0
606 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
607 && ptr
[rlen
- 1] == '.')
609 char * buf
= (char *) alloca (strlen (ptr
) + 1);
613 return directory_file_name (buf
, dst
);
618 strcat (dst
, "[000000]");
622 rlen
= strlen (rptr
) - 1;
623 strncat (dst
, rptr
, rlen
);
624 dst
[slen
+ rlen
] = '\0';
625 strcat (dst
, ".DIR.1");
629 /* Process as Unix format: just remove any final slash.
630 But leave "/" unchanged; do not change it to "". */
634 && (dst
[slen
- 1] == '/' || dst
[slen
- 1] == '/')
635 && dst
[slen
- 2] != ':'
637 && dst
[slen
- 1] == '/'
644 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
646 "Returns the file name of the directory named DIR.\n\
647 This is the name of the file that holds the data for the directory DIR.\n\
648 This operation exists because a directory is also a file, but its name as\n\
649 a directory is different from its name as a file.\n\
650 In Unix-syntax, this function just removes the final slash.\n\
651 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
652 it returns a file name such as \"[X]Y.DIR.1\".")
654 Lisp_Object directory
;
659 CHECK_STRING (directory
, 0);
661 if (NILP (directory
))
664 /* If the file name has special constructs in it,
665 call the corresponding file handler. */
666 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
668 return call2 (handler
, Qdirectory_file_name
, directory
);
671 /* 20 extra chars is insufficient for VMS, since we might perform a
672 logical name translation. an equivalence string can be up to 255
673 chars long, so grab that much extra space... - sss */
674 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
676 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
678 directory_file_name (XSTRING (directory
)->data
, buf
);
679 return build_string (buf
);
682 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
683 "Generate temporary file name (string) starting with PREFIX (a string).\n\
684 The Emacs process number forms part of the result,\n\
685 so there is no danger of generating a name being used by another process.")
690 val
= concat2 (prefix
, build_string ("XXXXXX"));
691 mktemp (XSTRING (val
)->data
);
695 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
696 "Convert FILENAME to absolute, and canonicalize it.\n\
697 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
698 (does not start with slash); if DEFAULT is nil or missing,\n\
699 the current buffer's value of default-directory is used.\n\
700 Path components that are `.' are removed, and \n\
701 path components followed by `..' are removed, along with the `..' itself;\n\
702 note that these simplifications are done without checking the resulting\n\
703 paths in the file system.\n\
704 An initial `~/' expands to your home directory.\n\
705 An initial `~USER/' expands to USER's home directory.\n\
706 See also the function `substitute-in-file-name'.")
708 Lisp_Object name
, defalt
;
712 register unsigned char *newdir
, *p
, *o
;
714 unsigned char *target
;
717 unsigned char * colon
= 0;
718 unsigned char * close
= 0;
719 unsigned char * slash
= 0;
720 unsigned char * brack
= 0;
721 int lbrack
= 0, rbrack
= 0;
724 #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */
727 unsigned char *tmp
, *defdir
;
731 CHECK_STRING (name
, 0);
733 /* If the file name has special constructs in it,
734 call the corresponding file handler. */
735 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
737 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
739 /* Use the buffer's default-directory if DEFALT is omitted. */
741 defalt
= current_buffer
->directory
;
742 CHECK_STRING (defalt
, 1);
744 /* Make sure DEFALT is properly expanded.
745 It would be better to do this down below where we actually use
746 defalt. Unfortunately, calling Fexpand_file_name recursively
747 could invoke GC, and the strings might be relocated. This would
748 be annoying because we have pointers into strings lying around
749 that would need adjusting, and people would add new pointers to
750 the code and forget to adjust them, resulting in intermittent bugs.
751 Putting this call here avoids all that crud.
753 The EQ test avoids infinite recursion. */
754 if (! NILP (defalt
) && !EQ (defalt
, name
)
755 /* This saves time in a common case. */
756 && XSTRING (defalt
)->data
[0] != '/')
761 defalt
= Fexpand_file_name (defalt
, Qnil
);
766 /* Filenames on VMS are always upper case. */
767 name
= Fupcase (name
);
769 #ifdef FILE_SYSTEM_CASE
770 name
= FILE_SYSTEM_CASE (name
);
773 nm
= XSTRING (name
)->data
;
776 /* First map all backslashes to slashes. */
777 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
779 /* Now strip drive name. */
781 unsigned char *colon
= rindex (nm
, ':');
787 drive
= tolower (colon
[-1]) - 'a';
791 defdir
= alloca (MAXPATHLEN
+ 1);
792 relpath
= getdefdir (drive
+ 1, defdir
);
798 /* If nm is absolute, flush ...// and detect /./ and /../.
799 If no /./ or /../ we can return right away. */
807 /* If it turns out that the filename we want to return is just a
808 suffix of FILENAME, we don't need to go through and edit
809 things; we just need to construct a new string using data
810 starting at the middle of FILENAME. If we set lose to a
811 non-zero value, that means we've discovered that we can't do
818 /* Since we know the path is absolute, we can assume that each
819 element starts with a "/". */
821 /* "//" anywhere isn't necessarily hairy; we just start afresh
822 with the second slash. */
823 if (p
[0] == '/' && p
[1] == '/'
825 /* // at start of filename is meaningful on Apollo system */
831 /* "~" is hairy as the start of any path element. */
832 if (p
[0] == '/' && p
[1] == '~')
833 nm
= p
+ 1, lose
= 1;
835 /* "." and ".." are hairy. */
840 || (p
[2] == '.' && (p
[3] == '/'
847 /* if dev:[dir]/, move nm to / */
848 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
849 nm
= (brack
? brack
+ 1 : colon
+ 1);
858 /* VMS pre V4.4,convert '-'s in filenames. */
859 if (lbrack
== rbrack
)
861 if (dots
< 2) /* this is to allow negative version numbers */
866 if (lbrack
> rbrack
&&
867 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
868 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
874 /* count open brackets, reset close bracket pointer */
875 if (p
[0] == '[' || p
[0] == '<')
877 /* count close brackets, set close bracket pointer */
878 if (p
[0] == ']' || p
[0] == '>')
880 /* detect ][ or >< */
881 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
883 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
884 nm
= p
+ 1, lose
= 1;
885 if (p
[0] == ':' && (colon
|| slash
))
886 /* if dev1:[dir]dev2:, move nm to dev2: */
892 /* if /pathname/dev:, move nm to dev: */
895 /* if node::dev:, move colon following dev */
896 else if (colon
&& colon
[-1] == ':')
898 /* if dev1:dev2:, move nm to dev2: */
899 else if (colon
&& colon
[-1] != ':')
904 if (p
[0] == ':' && !colon
)
910 if (lbrack
== rbrack
)
913 else if (p
[0] == '.')
922 return build_string (sys_translate_unix (nm
));
925 if (nm
== XSTRING (name
)->data
)
927 return build_string (nm
);
932 /* Now determine directory to start with and put it in newdir */
936 if (nm
[0] == '~') /* prefix ~ */
942 || nm
[1] == 0) /* ~ by itself */
944 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
945 newdir
= (unsigned char *) "";
947 dostounix_filename (newdir
);
951 nm
++; /* Don't leave the slash in nm. */
954 else /* ~user/filename */
956 for (p
= nm
; *p
&& (*p
!= '/'
961 o
= (unsigned char *) alloca (p
- nm
+ 1);
962 bcopy ((char *) nm
, o
, p
- nm
);
965 pw
= (struct passwd
*) getpwnam (o
+ 1);
968 newdir
= (unsigned char *) pw
-> pw_dir
;
970 nm
= p
+ 1; /* skip the terminator */
976 /* If we don't find a user of that name, leave the name
977 unchanged; don't move nm forward to p. */
990 newdir
= XSTRING (defalt
)->data
;
994 if (newdir
== 0 && relpath
)
999 /* Get rid of any slash at the end of newdir. */
1000 int length
= strlen (newdir
);
1001 /* Adding `length > 1 &&' makes ~ expand into / when homedir
1002 is the root dir. People disagree about whether that is right.
1003 Anyway, we can't take the risk of this change now. */
1005 if (newdir
[1] != ':' && length
> 1)
1007 if (newdir
[length
- 1] == '/')
1009 unsigned char *temp
= (unsigned char *) alloca (length
);
1010 bcopy (newdir
, temp
, length
- 1);
1011 temp
[length
- 1] = 0;
1019 /* Now concatenate the directory and name to new space in the stack frame */
1020 tlen
+= strlen (nm
) + 1;
1022 /* Add reserved space for drive name. */
1023 target
= (unsigned char *) alloca (tlen
+ 2) + 2;
1025 target
= (unsigned char *) alloca (tlen
);
1032 if (nm
[0] == 0 || nm
[0] == '/')
1033 strcpy (target
, newdir
);
1036 file_name_as_directory (target
, newdir
);
1039 strcat (target
, nm
);
1041 if (index (target
, '/'))
1042 strcpy (target
, sys_translate_unix (target
));
1045 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1053 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1059 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1060 /* brackets are offset from each other by 2 */
1063 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1064 /* convert [foo][bar] to [bar] */
1065 while (o
[-1] != '[' && o
[-1] != '<')
1067 else if (*p
== '-' && *o
!= '.')
1070 else if (p
[0] == '-' && o
[-1] == '.' &&
1071 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1072 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1076 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1077 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1079 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1081 /* else [foo.-] ==> [-] */
1087 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1088 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1098 else if (!strncmp (p
, "//", 2)
1100 /* // at start of filename is meaningful in Apollo system */
1108 else if (p
[0] == '/'
1113 /* If "/." is the entire filename, keep the "/". Otherwise,
1114 just delete the whole "/.". */
1115 if (o
== target
&& p
[2] == '\0')
1119 else if (!strncmp (p
, "/..", 3)
1120 /* `/../' is the "superroot" on certain file systems. */
1122 && (p
[3] == '/' || p
[3] == 0))
1124 while (o
!= target
&& *--o
!= '/')
1127 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1131 if (o
== target
&& *o
== '/')
1139 #endif /* not VMS */
1143 /* at last, set drive name. */
1144 if (target
[1] != ':')
1147 target
[0] = (drive
< 0 ? getdisk () : drive
) + 'a';
1152 return make_string (target
, o
- target
);
1155 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
1156 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
1157 "Convert FILENAME to absolute, and canonicalize it.\n\
1158 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1159 (does not start with slash); if DEFAULT is nil or missing,\n\
1160 the current buffer's value of default-directory is used.\n\
1161 Filenames containing `.' or `..' as components are simplified;\n\
1162 initial `~/' expands to your home directory.\n\
1163 See also the function `substitute-in-file-name'.")
1165 Lisp_Object name, defalt;
1169 register unsigned char *newdir, *p, *o;
1171 unsigned char *target;
1175 unsigned char * colon = 0;
1176 unsigned char * close = 0;
1177 unsigned char * slash = 0;
1178 unsigned char * brack = 0;
1179 int lbrack = 0, rbrack = 0;
1183 CHECK_STRING (name
, 0);
1186 /* Filenames on VMS are always upper case. */
1187 name
= Fupcase (name
);
1190 nm
= XSTRING (name
)->data
;
1192 /* If nm is absolute, flush ...// and detect /./ and /../.
1193 If no /./ or /../ we can return right away. */
1205 if (p
[0] == '/' && p
[1] == '/'
1207 /* // at start of filename is meaningful on Apollo system */
1212 if (p
[0] == '/' && p
[1] == '~')
1213 nm
= p
+ 1, lose
= 1;
1214 if (p
[0] == '/' && p
[1] == '.'
1215 && (p
[2] == '/' || p
[2] == 0
1216 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1222 /* if dev:[dir]/, move nm to / */
1223 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1224 nm
= (brack
? brack
+ 1 : colon
+ 1);
1225 lbrack
= rbrack
= 0;
1233 /* VMS pre V4.4,convert '-'s in filenames. */
1234 if (lbrack
== rbrack
)
1236 if (dots
< 2) /* this is to allow negative version numbers */
1241 if (lbrack
> rbrack
&&
1242 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1243 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1249 /* count open brackets, reset close bracket pointer */
1250 if (p
[0] == '[' || p
[0] == '<')
1251 lbrack
++, brack
= 0;
1252 /* count close brackets, set close bracket pointer */
1253 if (p
[0] == ']' || p
[0] == '>')
1254 rbrack
++, brack
= p
;
1255 /* detect ][ or >< */
1256 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1258 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1259 nm
= p
+ 1, lose
= 1;
1260 if (p
[0] == ':' && (colon
|| slash
))
1261 /* if dev1:[dir]dev2:, move nm to dev2: */
1267 /* if /pathname/dev:, move nm to dev: */
1270 /* if node::dev:, move colon following dev */
1271 else if (colon
&& colon
[-1] == ':')
1273 /* if dev1:dev2:, move nm to dev2: */
1274 else if (colon
&& colon
[-1] != ':')
1279 if (p
[0] == ':' && !colon
)
1285 if (lbrack
== rbrack
)
1288 else if (p
[0] == '.')
1296 if (index (nm
, '/'))
1297 return build_string (sys_translate_unix (nm
));
1299 if (nm
== XSTRING (name
)->data
)
1301 return build_string (nm
);
1305 /* Now determine directory to start with and put it in NEWDIR */
1309 if (nm
[0] == '~') /* prefix ~ */
1314 || nm
[1] == 0)/* ~/filename */
1316 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1317 newdir
= (unsigned char *) "";
1320 nm
++; /* Don't leave the slash in nm. */
1323 else /* ~user/filename */
1325 /* Get past ~ to user */
1326 unsigned char *user
= nm
+ 1;
1327 /* Find end of name. */
1328 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1329 int len
= ptr
? ptr
- user
: strlen (user
);
1331 unsigned char *ptr1
= index (user
, ':');
1332 if (ptr1
!= 0 && ptr1
- user
< len
)
1335 /* Copy the user name into temp storage. */
1336 o
= (unsigned char *) alloca (len
+ 1);
1337 bcopy ((char *) user
, o
, len
);
1340 /* Look up the user name. */
1341 pw
= (struct passwd
*) getpwnam (o
+ 1);
1343 error ("\"%s\" isn't a registered user", o
+ 1);
1345 newdir
= (unsigned char *) pw
->pw_dir
;
1347 /* Discard the user name from NM. */
1354 #endif /* not VMS */
1358 defalt
= current_buffer
->directory
;
1359 CHECK_STRING (defalt
, 1);
1360 newdir
= XSTRING (defalt
)->data
;
1363 /* Now concatenate the directory and name to new space in the stack frame */
1365 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1366 target
= (unsigned char *) alloca (tlen
);
1372 if (nm
[0] == 0 || nm
[0] == '/')
1373 strcpy (target
, newdir
);
1376 file_name_as_directory (target
, newdir
);
1379 strcat (target
, nm
);
1381 if (index (target
, '/'))
1382 strcpy (target
, sys_translate_unix (target
));
1385 /* Now canonicalize by removing /. and /foo/.. if they appear */
1393 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1399 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1400 /* brackets are offset from each other by 2 */
1403 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1404 /* convert [foo][bar] to [bar] */
1405 while (o
[-1] != '[' && o
[-1] != '<')
1407 else if (*p
== '-' && *o
!= '.')
1410 else if (p
[0] == '-' && o
[-1] == '.' &&
1411 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1412 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1416 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1417 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1419 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1421 /* else [foo.-] ==> [-] */
1427 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1428 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1438 else if (!strncmp (p
, "//", 2)
1440 /* // at start of filename is meaningful in Apollo system */
1448 else if (p
[0] == '/' && p
[1] == '.' &&
1449 (p
[2] == '/' || p
[2] == 0))
1451 else if (!strncmp (p
, "/..", 3)
1452 /* `/../' is the "superroot" on certain file systems. */
1454 && (p
[3] == '/' || p
[3] == 0))
1456 while (o
!= target
&& *--o
!= '/')
1459 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1463 if (o
== target
&& *o
== '/')
1471 #endif /* not VMS */
1474 return make_string (target
, o
- target
);
1478 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1479 Ssubstitute_in_file_name
, 1, 1, 0,
1480 "Substitute environment variables referred to in FILENAME.\n\
1481 `$FOO' where FOO is an environment variable name means to substitute\n\
1482 the value of that variable. The variable name should be terminated\n\
1483 with a character not a letter, digit or underscore; otherwise, enclose\n\
1484 the entire variable name in braces.\n\
1485 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1486 On VMS, `$' substitution is not done; this function does little and only\n\
1487 duplicates what `expand-file-name' does.")
1493 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1494 unsigned char *target
;
1496 int substituted
= 0;
1499 CHECK_STRING (string
, 0);
1501 nm
= XSTRING (string
)->data
;
1503 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
1504 substituted
= !strcmp (nm
, XSTRING (string
)->data
);
1506 endp
= nm
+ XSTRING (string
)->size
;
1508 /* If /~ or // appears, discard everything through first slash. */
1510 for (p
= nm
; p
!= endp
; p
++)
1514 /* // at start of file name is meaningful in Apollo system */
1515 (p
[0] == '/' && p
- 1 != nm
)
1516 #else /* not APOLLO */
1518 #endif /* not APOLLO */
1522 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1533 if (p
[0] && p
[1] == ':')
1542 return build_string (nm
);
1545 /* See if any variables are substituted into the string
1546 and find the total length of their values in `total' */
1548 for (p
= nm
; p
!= endp
;)
1558 /* "$$" means a single "$" */
1567 while (p
!= endp
&& *p
!= '}') p
++;
1568 if (*p
!= '}') goto missingclose
;
1574 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1578 /* Copy out the variable name */
1579 target
= (unsigned char *) alloca (s
- o
+ 1);
1580 strncpy (target
, o
, s
- o
);
1583 strupr (target
); /* $home == $HOME etc. */
1586 /* Get variable value */
1587 o
= (unsigned char *) egetenv (target
);
1588 if (!o
) goto badvar
;
1589 total
+= strlen (o
);
1596 /* If substitution required, recopy the string and do it */
1597 /* Make space in stack frame for the new copy */
1598 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1601 /* Copy the rest of the name through, replacing $ constructs with values */
1618 while (p
!= endp
&& *p
!= '}') p
++;
1619 if (*p
!= '}') goto missingclose
;
1625 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1629 /* Copy out the variable name */
1630 target
= (unsigned char *) alloca (s
- o
+ 1);
1631 strncpy (target
, o
, s
- o
);
1634 strupr (target
); /* $home == $HOME etc. */
1637 /* Get variable value */
1638 o
= (unsigned char *) egetenv (target
);
1648 /* If /~ or // appears, discard everything through first slash. */
1650 for (p
= xnm
; p
!= x
; p
++)
1653 /* // at start of file name is meaningful in Apollo system */
1654 (p
[0] == '/' && p
- 1 != xnm
)
1655 #else /* not APOLLO */
1657 #endif /* not APOLLO */
1659 && p
!= nm
&& p
[-1] == '/')
1662 else if (p
[0] && p
[1] == ':')
1666 return make_string (xnm
, x
- xnm
);
1669 error ("Bad format environment-variable substitution");
1671 error ("Missing \"}\" in environment-variable substitution");
1673 error ("Substituting nonexistent environment variable \"%s\"", target
);
1676 #endif /* not VMS */
1679 /* A slightly faster and more convenient way to get
1680 (directory-file-name (expand-file-name FOO)). */
1683 expand_and_dir_to_file (filename
, defdir
)
1684 Lisp_Object filename
, defdir
;
1686 register Lisp_Object abspath
;
1688 abspath
= Fexpand_file_name (filename
, defdir
);
1691 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1692 if (c
== ':' || c
== ']' || c
== '>')
1693 abspath
= Fdirectory_file_name (abspath
);
1696 /* Remove final slash, if any (unless path is root).
1697 stat behaves differently depending! */
1698 if (XSTRING (abspath
)->size
> 1
1699 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1700 /* We cannot take shortcuts; they might be wrong for magic file names. */
1701 abspath
= Fdirectory_file_name (abspath
);
1707 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1708 Lisp_Object absname
;
1709 unsigned char *querystring
;
1712 register Lisp_Object tem
;
1713 struct stat statbuf
;
1714 struct gcpro gcpro1
;
1716 /* stat is a good way to tell whether the file exists,
1717 regardless of what access permissions it has. */
1718 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1721 Fsignal (Qfile_already_exists
,
1722 Fcons (build_string ("File already exists"),
1723 Fcons (absname
, Qnil
)));
1725 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1726 XSTRING (absname
)->data
, querystring
));
1729 Fsignal (Qfile_already_exists
,
1730 Fcons (build_string ("File already exists"),
1731 Fcons (absname
, Qnil
)));
1736 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1737 "fCopy file: \nFCopy %s to file: \np\nP",
1738 "Copy FILE to NEWNAME. Both args must be strings.\n\
1739 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1740 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1741 A number as third arg means request confirmation if NEWNAME already exists.\n\
1742 This is what happens in interactive use with M-x.\n\
1743 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1744 last-modified time as the old one. (This works on only some systems.)\n\
1745 A prefix arg makes KEEP-TIME non-nil.")
1746 (filename
, newname
, ok_if_already_exists
, keep_date
)
1747 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1750 char buf
[16 * 1024];
1752 Lisp_Object handler
;
1753 struct gcpro gcpro1
, gcpro2
;
1754 int count
= specpdl_ptr
- specpdl
;
1755 int input_file_statable_p
;
1757 GCPRO2 (filename
, newname
);
1758 CHECK_STRING (filename
, 0);
1759 CHECK_STRING (newname
, 1);
1760 filename
= Fexpand_file_name (filename
, Qnil
);
1761 newname
= Fexpand_file_name (newname
, Qnil
);
1763 /* If the input file name has special constructs in it,
1764 call the corresponding file handler. */
1765 handler
= Ffind_file_name_handler (filename
, Qcopy_file
);
1766 /* Likewise for output file name. */
1768 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1769 if (!NILP (handler
))
1770 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, filename
, newname
,
1771 ok_if_already_exists
, keep_date
));
1773 if (NILP (ok_if_already_exists
)
1774 || INTEGERP (ok_if_already_exists
))
1775 barf_or_query_if_file_exists (newname
, "copy to it",
1776 INTEGERP (ok_if_already_exists
));
1778 ifd
= open (XSTRING (filename
)->data
, O_RDONLY
);
1780 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1782 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1784 /* We can only copy regular files and symbolic links. Other files are not
1786 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1788 #if defined (S_ISREG) && defined (S_ISLNK)
1789 if (input_file_statable_p
)
1791 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1793 #if defined (EISDIR)
1794 /* Get a better looking error message. */
1797 report_file_error ("Non-regular file", Fcons (filename
, Qnil
));
1800 #endif /* S_ISREG && S_ISLNK */
1803 /* Create the copy file with the same record format as the input file */
1804 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1807 /* System's default file type was set to binary by _fmode in emacs.c. */
1808 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1809 #else /* not MSDOS */
1810 ofd
= creat (XSTRING (newname
)->data
, 0666);
1811 #endif /* not MSDOS */
1814 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1816 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1820 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1821 if (write (ofd
, buf
, n
) != n
)
1822 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1825 /* Closing the output clobbers the file times on some systems. */
1826 if (close (ofd
) < 0)
1827 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1829 if (input_file_statable_p
)
1831 if (!NILP (keep_date
))
1833 EMACS_TIME atime
, mtime
;
1834 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1835 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1836 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
1837 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1840 if (!egetenv ("USE_DOMAIN_ACLS"))
1842 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1847 /* Discard the unwind protects. */
1848 specpdl_ptr
= specpdl
+ count
;
1854 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1855 Smake_directory_internal
, 1, 1, 0,
1856 "Create a directory. One argument, a file name string.")
1858 Lisp_Object dirname
;
1861 Lisp_Object handler
;
1863 CHECK_STRING (dirname
, 0);
1864 dirname
= Fexpand_file_name (dirname
, Qnil
);
1866 handler
= Ffind_file_name_handler (dirname
, Qmake_directory_internal
);
1867 if (!NILP (handler
))
1868 return call2 (handler
, Qmake_directory_internal
, dirname
);
1870 dir
= XSTRING (dirname
)->data
;
1872 if (mkdir (dir
, 0777) != 0)
1873 report_file_error ("Creating directory", Flist (1, &dirname
));
1878 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1879 "Delete a directory. One argument, a file name or directory name string.")
1881 Lisp_Object dirname
;
1884 Lisp_Object handler
;
1886 CHECK_STRING (dirname
, 0);
1887 dirname
= Fdirectory_file_name (Fexpand_file_name (dirname
, Qnil
));
1888 dir
= XSTRING (dirname
)->data
;
1890 handler
= Ffind_file_name_handler (dirname
, Qdelete_directory
);
1891 if (!NILP (handler
))
1892 return call2 (handler
, Qdelete_directory
, dirname
);
1894 if (rmdir (dir
) != 0)
1895 report_file_error ("Removing directory", Flist (1, &dirname
));
1900 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1901 "Delete specified file. One argument, a file name string.\n\
1902 If file has multiple names, it continues to exist with the other names.")
1904 Lisp_Object filename
;
1906 Lisp_Object handler
;
1907 CHECK_STRING (filename
, 0);
1908 filename
= Fexpand_file_name (filename
, Qnil
);
1910 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
1911 if (!NILP (handler
))
1912 return call2 (handler
, Qdelete_file
, filename
);
1914 if (0 > unlink (XSTRING (filename
)->data
))
1915 report_file_error ("Removing old name", Flist (1, &filename
));
1919 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1920 "fRename file: \nFRename %s to file: \np",
1921 "Rename FILE as NEWNAME. Both args strings.\n\
1922 If file has names other than FILE, it continues to have those names.\n\
1923 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1924 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1925 A number as third arg means request confirmation if NEWNAME already exists.\n\
1926 This is what happens in interactive use with M-x.")
1927 (filename
, newname
, ok_if_already_exists
)
1928 Lisp_Object filename
, newname
, ok_if_already_exists
;
1931 Lisp_Object args
[2];
1933 Lisp_Object handler
;
1934 struct gcpro gcpro1
, gcpro2
;
1936 GCPRO2 (filename
, newname
);
1937 CHECK_STRING (filename
, 0);
1938 CHECK_STRING (newname
, 1);
1939 filename
= Fexpand_file_name (filename
, Qnil
);
1940 newname
= Fexpand_file_name (newname
, Qnil
);
1942 /* If the file name has special constructs in it,
1943 call the corresponding file handler. */
1944 handler
= Ffind_file_name_handler (filename
, Qrename_file
);
1946 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
1947 if (!NILP (handler
))
1948 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
1949 filename
, newname
, ok_if_already_exists
));
1951 if (NILP (ok_if_already_exists
)
1952 || INTEGERP (ok_if_already_exists
))
1953 barf_or_query_if_file_exists (newname
, "rename to it",
1954 INTEGERP (ok_if_already_exists
));
1956 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1958 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1959 || 0 > unlink (XSTRING (filename
)->data
))
1964 Fcopy_file (filename
, newname
,
1965 /* We have already prompted if it was an integer,
1966 so don't have copy-file prompt again. */
1967 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
1968 Fdelete_file (filename
);
1975 report_file_error ("Renaming", Flist (2, args
));
1978 report_file_error ("Renaming", Flist (2, &filename
));
1985 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1986 "fAdd name to file: \nFName to add to %s: \np",
1987 "Give FILE additional name NEWNAME. Both args strings.\n\
1988 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1989 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1990 A number as third arg means request confirmation if NEWNAME already exists.\n\
1991 This is what happens in interactive use with M-x.")
1992 (filename
, newname
, ok_if_already_exists
)
1993 Lisp_Object filename
, newname
, ok_if_already_exists
;
1996 Lisp_Object args
[2];
1998 Lisp_Object handler
;
1999 struct gcpro gcpro1
, gcpro2
;
2001 GCPRO2 (filename
, newname
);
2002 CHECK_STRING (filename
, 0);
2003 CHECK_STRING (newname
, 1);
2004 filename
= Fexpand_file_name (filename
, Qnil
);
2005 newname
= Fexpand_file_name (newname
, Qnil
);
2007 /* If the file name has special constructs in it,
2008 call the corresponding file handler. */
2009 handler
= Ffind_file_name_handler (filename
, Qadd_name_to_file
);
2010 if (!NILP (handler
))
2011 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
2012 newname
, ok_if_already_exists
));
2014 if (NILP (ok_if_already_exists
)
2015 || INTEGERP (ok_if_already_exists
))
2016 barf_or_query_if_file_exists (newname
, "make it a new name",
2017 INTEGERP (ok_if_already_exists
));
2018 unlink (XSTRING (newname
)->data
);
2019 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2024 report_file_error ("Adding new name", Flist (2, args
));
2026 report_file_error ("Adding new name", Flist (2, &filename
));
2035 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2036 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2037 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2038 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2039 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2040 A number as third arg means request confirmation if LINKNAME already exists.\n\
2041 This happens for interactive use with M-x.")
2042 (filename
, linkname
, ok_if_already_exists
)
2043 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2046 Lisp_Object args
[2];
2048 Lisp_Object handler
;
2049 struct gcpro gcpro1
, gcpro2
;
2051 GCPRO2 (filename
, linkname
);
2052 CHECK_STRING (filename
, 0);
2053 CHECK_STRING (linkname
, 1);
2054 /* If the link target has a ~, we must expand it to get
2055 a truly valid file name. Otherwise, do not expand;
2056 we want to permit links to relative file names. */
2057 if (XSTRING (filename
)->data
[0] == '~')
2058 filename
= Fexpand_file_name (filename
, Qnil
);
2059 linkname
= Fexpand_file_name (linkname
, Qnil
);
2061 /* If the file name has special constructs in it,
2062 call the corresponding file handler. */
2063 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2064 if (!NILP (handler
))
2065 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2066 linkname
, ok_if_already_exists
));
2068 if (NILP (ok_if_already_exists
)
2069 || INTEGERP (ok_if_already_exists
))
2070 barf_or_query_if_file_exists (linkname
, "make it a link",
2071 INTEGERP (ok_if_already_exists
));
2072 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2074 /* If we didn't complain already, silently delete existing file. */
2075 if (errno
== EEXIST
)
2077 unlink (XSTRING (linkname
)->data
);
2078 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2088 report_file_error ("Making symbolic link", Flist (2, args
));
2090 report_file_error ("Making symbolic link", Flist (2, &filename
));
2096 #endif /* S_IFLNK */
2100 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2101 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2102 "Define the job-wide logical name NAME to have the value STRING.\n\
2103 If STRING is nil or a null string, the logical name NAME is deleted.")
2105 Lisp_Object varname
;
2108 CHECK_STRING (varname
, 0);
2110 delete_logical_name (XSTRING (varname
)->data
);
2113 CHECK_STRING (string
, 1);
2115 if (XSTRING (string
)->size
== 0)
2116 delete_logical_name (XSTRING (varname
)->data
);
2118 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2127 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2128 "Open a network connection to PATH using LOGIN as the login string.")
2130 Lisp_Object path
, login
;
2134 CHECK_STRING (path
, 0);
2135 CHECK_STRING (login
, 0);
2137 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2139 if (netresult
== -1)
2144 #endif /* HPUX_NET */
2146 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2148 "Return t if file FILENAME specifies an absolute path name.\n\
2149 On Unix, this is a name starting with a `/' or a `~'.")
2151 Lisp_Object filename
;
2155 CHECK_STRING (filename
, 0);
2156 ptr
= XSTRING (filename
)->data
;
2157 if (*ptr
== '/' || *ptr
== '~'
2159 /* ??? This criterion is probably wrong for '<'. */
2160 || index (ptr
, ':') || index (ptr
, '<')
2161 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2165 || (*ptr
!= 0 && ptr
[1] == ':' && (ptr
[2] == '/' || ptr
[2] == '\\'))
2173 /* Return nonzero if file FILENAME exists and can be executed. */
2176 check_executable (filename
)
2180 return (eaccess (filename
, 1) >= 0);
2182 /* Access isn't quite right because it uses the real uid
2183 and we really want to test with the effective uid.
2184 But Unix doesn't give us a right way to do it. */
2185 return (access (filename
, 1) >= 0);
2189 /* Return nonzero if file FILENAME exists and can be written. */
2192 check_writable (filename
)
2196 return (eaccess (filename
, 2) >= 0);
2198 /* Access isn't quite right because it uses the real uid
2199 and we really want to test with the effective uid.
2200 But Unix doesn't give us a right way to do it.
2201 Opening with O_WRONLY could work for an ordinary file,
2202 but would lose for directories. */
2203 return (access (filename
, 2) >= 0);
2207 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2208 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2209 See also `file-readable-p' and `file-attributes'.")
2211 Lisp_Object filename
;
2213 Lisp_Object abspath
;
2214 Lisp_Object handler
;
2215 struct stat statbuf
;
2217 CHECK_STRING (filename
, 0);
2218 abspath
= Fexpand_file_name (filename
, Qnil
);
2220 /* If the file name has special constructs in it,
2221 call the corresponding file handler. */
2222 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2223 if (!NILP (handler
))
2224 return call2 (handler
, Qfile_exists_p
, abspath
);
2226 return (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2229 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2230 "Return t if FILENAME can be executed by you.\n\
2231 For a directory, this means you can access files in that directory.")
2233 Lisp_Object filename
;
2236 Lisp_Object abspath
;
2237 Lisp_Object handler
;
2239 CHECK_STRING (filename
, 0);
2240 abspath
= Fexpand_file_name (filename
, Qnil
);
2242 /* If the file name has special constructs in it,
2243 call the corresponding file handler. */
2244 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2245 if (!NILP (handler
))
2246 return call2 (handler
, Qfile_executable_p
, abspath
);
2248 return (check_executable (XSTRING (abspath
)->data
) ? Qt
: Qnil
);
2251 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2252 "Return t if file FILENAME exists and you can read it.\n\
2253 See also `file-exists-p' and `file-attributes'.")
2255 Lisp_Object filename
;
2257 Lisp_Object abspath
;
2258 Lisp_Object handler
;
2261 CHECK_STRING (filename
, 0);
2262 abspath
= Fexpand_file_name (filename
, Qnil
);
2264 /* If the file name has special constructs in it,
2265 call the corresponding file handler. */
2266 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2267 if (!NILP (handler
))
2268 return call2 (handler
, Qfile_readable_p
, abspath
);
2270 desc
= open (XSTRING (abspath
)->data
, O_RDONLY
);
2277 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2279 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2280 "Return t if file FILENAME can be written or created by you.")
2282 Lisp_Object filename
;
2284 Lisp_Object abspath
, dir
;
2285 Lisp_Object handler
;
2286 struct stat statbuf
;
2288 CHECK_STRING (filename
, 0);
2289 abspath
= Fexpand_file_name (filename
, Qnil
);
2291 /* If the file name has special constructs in it,
2292 call the corresponding file handler. */
2293 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2294 if (!NILP (handler
))
2295 return call2 (handler
, Qfile_writable_p
, abspath
);
2297 if (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0)
2298 return (check_writable (XSTRING (abspath
)->data
)
2300 dir
= Ffile_name_directory (abspath
);
2303 dir
= Fdirectory_file_name (dir
);
2307 dir
= Fdirectory_file_name (dir
);
2309 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2313 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2314 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2315 The value is the name of the file to which it is linked.\n\
2316 Otherwise returns nil.")
2318 Lisp_Object filename
;
2325 Lisp_Object handler
;
2327 CHECK_STRING (filename
, 0);
2328 filename
= Fexpand_file_name (filename
, Qnil
);
2330 /* If the file name has special constructs in it,
2331 call the corresponding file handler. */
2332 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2333 if (!NILP (handler
))
2334 return call2 (handler
, Qfile_symlink_p
, filename
);
2339 buf
= (char *) xmalloc (bufsize
);
2340 bzero (buf
, bufsize
);
2341 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2342 if (valsize
< bufsize
) break;
2343 /* Buffer was not long enough */
2352 val
= make_string (buf
, valsize
);
2355 #else /* not S_IFLNK */
2357 #endif /* not S_IFLNK */
2360 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2361 "Return t if file FILENAME is the name of a directory as a file.\n\
2362 A directory name spec may be given instead; then the value is t\n\
2363 if the directory so specified exists and really is a directory.")
2365 Lisp_Object filename
;
2367 register Lisp_Object abspath
;
2369 Lisp_Object handler
;
2371 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2373 /* If the file name has special constructs in it,
2374 call the corresponding file handler. */
2375 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2376 if (!NILP (handler
))
2377 return call2 (handler
, Qfile_directory_p
, abspath
);
2379 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2381 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2384 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2385 "Return t if file FILENAME is the name of a directory as a file,\n\
2386 and files in that directory can be opened by you. In order to use a\n\
2387 directory as a buffer's current directory, this predicate must return true.\n\
2388 A directory name spec may be given instead; then the value is t\n\
2389 if the directory so specified exists and really is a readable and\n\
2390 searchable directory.")
2392 Lisp_Object filename
;
2394 Lisp_Object handler
;
2396 struct gcpro gcpro1
;
2398 /* If the file name has special constructs in it,
2399 call the corresponding file handler. */
2400 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2401 if (!NILP (handler
))
2402 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2404 /* It's an unlikely combination, but yes we really do need to gcpro:
2405 Suppose that file-accessible-directory-p has no handler, but
2406 file-directory-p does have a handler; this handler causes a GC which
2407 relocates the string in `filename'; and finally file-directory-p
2408 returns non-nil. Then we would end up passing a garbaged string
2409 to file-executable-p. */
2411 tem
= (NILP (Ffile_directory_p (filename
))
2412 || NILP (Ffile_executable_p (filename
)));
2414 return tem
? Qnil
: Qt
;
2417 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2418 "Return t if file FILENAME is the name of a regular file.\n\
2419 This is the sort of file that holds an ordinary stream of data bytes.")
2421 Lisp_Object filename
;
2423 register Lisp_Object abspath
;
2425 Lisp_Object handler
;
2427 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2429 /* If the file name has special constructs in it,
2430 call the corresponding file handler. */
2431 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2432 if (!NILP (handler
))
2433 return call2 (handler
, Qfile_directory_p
, abspath
);
2435 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2437 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2440 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2441 "Return mode bits of FILE, as an integer.")
2443 Lisp_Object filename
;
2445 Lisp_Object abspath
;
2447 Lisp_Object handler
;
2449 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2451 /* If the file name has special constructs in it,
2452 call the corresponding file handler. */
2453 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2454 if (!NILP (handler
))
2455 return call2 (handler
, Qfile_modes
, abspath
);
2457 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2463 if (S_ISREG (st
.st_mode
)
2464 && (len
= XSTRING (abspath
)->size
) >= 5
2465 && (stricmp ((suffix
= XSTRING (abspath
)->data
+ len
-4), ".com") == 0
2466 || stricmp (suffix
, ".exe") == 0
2467 || stricmp (suffix
, ".bat") == 0))
2468 st
.st_mode
|= S_IEXEC
;
2472 return make_number (st
.st_mode
& 07777);
2475 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2476 "Set mode bits of FILE to MODE (an integer).\n\
2477 Only the 12 low bits of MODE are used.")
2479 Lisp_Object filename
, mode
;
2481 Lisp_Object abspath
;
2482 Lisp_Object handler
;
2484 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2485 CHECK_NUMBER (mode
, 1);
2487 /* If the file name has special constructs in it,
2488 call the corresponding file handler. */
2489 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2490 if (!NILP (handler
))
2491 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2494 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2495 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2497 if (!egetenv ("USE_DOMAIN_ACLS"))
2500 struct timeval tvp
[2];
2502 /* chmod on apollo also change the file's modtime; need to save the
2503 modtime and then restore it. */
2504 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2506 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2510 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2511 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2513 /* reset the old accessed and modified times. */
2514 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2516 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2519 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2520 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2527 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2528 "Set the file permission bits for newly created files.\n\
2529 The argument MODE should be an integer; only the low 9 bits are used.\n\
2530 This setting is inherited by subprocesses.")
2534 CHECK_NUMBER (mode
, 0);
2536 umask ((~ XINT (mode
)) & 0777);
2541 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2542 "Return the default file protection for created files.\n\
2543 The value is an integer.")
2549 realmask
= umask (0);
2552 XSETINT (value
, (~ realmask
) & 0777);
2558 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2559 "Tell Unix to finish all pending disk updates.")
2568 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2569 "Return t if file FILE1 is newer than file FILE2.\n\
2570 If FILE1 does not exist, the answer is nil;\n\
2571 otherwise, if FILE2 does not exist, the answer is t.")
2573 Lisp_Object file1
, file2
;
2575 Lisp_Object abspath1
, abspath2
;
2578 Lisp_Object handler
;
2579 struct gcpro gcpro1
, gcpro2
;
2581 CHECK_STRING (file1
, 0);
2582 CHECK_STRING (file2
, 0);
2585 GCPRO2 (abspath1
, file2
);
2586 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2587 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2590 /* If the file name has special constructs in it,
2591 call the corresponding file handler. */
2592 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2594 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2595 if (!NILP (handler
))
2596 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2598 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2601 mtime1
= st
.st_mtime
;
2603 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2606 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2610 Lisp_Object Qfind_buffer_file_type
;
2613 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2615 "Insert contents of file FILENAME after point.\n\
2616 Returns list of absolute file name and length of data inserted.\n\
2617 If second argument VISIT is non-nil, the buffer's visited filename\n\
2618 and last save file modtime are set, and it is marked unmodified.\n\
2619 If visiting and the file does not exist, visiting is completed\n\
2620 before the error is signaled.\n\n\
2621 The optional third and fourth arguments BEG and END\n\
2622 specify what portion of the file to insert.\n\
2623 If VISIT is non-nil, BEG and END must be nil.\n\
2624 If optional fifth argument REPLACE is non-nil,\n\
2625 it means replace the current buffer contents (in the accessible portion)\n\
2626 with the file contents. This is better than simply deleting and inserting\n\
2627 the whole thing because (1) it preserves some marker positions\n\
2628 and (2) it puts less data in the undo list.")
2629 (filename
, visit
, beg
, end
, replace
)
2630 Lisp_Object filename
, visit
, beg
, end
, replace
;
2634 register int inserted
= 0;
2635 register int how_much
;
2636 int count
= specpdl_ptr
- specpdl
;
2637 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2638 Lisp_Object handler
, val
, insval
;
2645 GCPRO3 (filename
, val
, p
);
2646 if (!NILP (current_buffer
->read_only
))
2647 Fbarf_if_buffer_read_only();
2649 CHECK_STRING (filename
, 0);
2650 filename
= Fexpand_file_name (filename
, Qnil
);
2652 /* If the file name has special constructs in it,
2653 call the corresponding file handler. */
2654 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2655 if (!NILP (handler
))
2657 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2658 visit
, beg
, end
, replace
);
2665 if (stat (XSTRING (filename
)->data
, &st
) < 0)
2667 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
2668 || fstat (fd
, &st
) < 0)
2669 #endif /* not APOLLO */
2671 if (fd
>= 0) close (fd
);
2674 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2681 /* This code will need to be changed in order to work on named
2682 pipes, and it's probably just not worth it. So we should at
2683 least signal an error. */
2684 if (!S_ISREG (st
.st_mode
))
2685 Fsignal (Qfile_error
,
2686 Fcons (build_string ("not a regular file"),
2687 Fcons (filename
, Qnil
)));
2691 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
2694 /* Replacement should preserve point as it preserves markers. */
2695 if (!NILP (replace
))
2696 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2698 record_unwind_protect (close_file_unwind
, make_number (fd
));
2700 /* Supposedly happens on VMS. */
2702 error ("File size is negative");
2704 if (!NILP (beg
) || !NILP (end
))
2706 error ("Attempt to visit less than an entire file");
2709 CHECK_NUMBER (beg
, 0);
2711 XSETFASTINT (beg
, 0);
2714 CHECK_NUMBER (end
, 0);
2717 XSETINT (end
, st
.st_size
);
2718 if (XINT (end
) != st
.st_size
)
2719 error ("maximum buffer size exceeded");
2722 /* If requested, replace the accessible part of the buffer
2723 with the file contents. Avoid replacing text at the
2724 beginning or end of the buffer that matches the file contents;
2725 that preserves markers pointing to the unchanged parts. */
2727 /* On MSDOS, replace mode doesn't really work, except for binary files,
2728 and it's not worth supporting just for them. */
2729 if (!NILP (replace
))
2732 XSETFASTINT (beg
, 0);
2733 XSETFASTINT (end
, st
.st_size
);
2734 del_range_1 (BEGV
, ZV
, 0);
2737 if (!NILP (replace
))
2739 unsigned char buffer
[1 << 14];
2740 int same_at_start
= BEGV
;
2741 int same_at_end
= ZV
;
2746 /* Count how many chars at the start of the file
2747 match the text at the beginning of the buffer. */
2752 nread
= read (fd
, buffer
, sizeof buffer
);
2754 error ("IO error reading %s: %s",
2755 XSTRING (filename
)->data
, strerror (errno
));
2756 else if (nread
== 0)
2759 while (bufpos
< nread
&& same_at_start
< ZV
2760 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2761 same_at_start
++, bufpos
++;
2762 /* If we found a discrepancy, stop the scan.
2763 Otherwise loop around and scan the next bufferfull. */
2764 if (bufpos
!= nread
)
2768 /* If the file matches the buffer completely,
2769 there's no need to replace anything. */
2770 if (same_at_start
- BEGV
== st
.st_size
)
2774 /* Truncate the buffer to the size of the file. */
2775 del_range_1 (same_at_start
, same_at_end
, 0);
2780 /* Count how many chars at the end of the file
2781 match the text at the end of the buffer. */
2784 int total_read
, nread
, bufpos
, curpos
, trial
;
2786 /* At what file position are we now scanning? */
2787 curpos
= st
.st_size
- (ZV
- same_at_end
);
2788 /* If the entire file matches the buffer tail, stop the scan. */
2791 /* How much can we scan in the next step? */
2792 trial
= min (curpos
, sizeof buffer
);
2793 if (lseek (fd
, curpos
- trial
, 0) < 0)
2794 report_file_error ("Setting file position",
2795 Fcons (filename
, Qnil
));
2798 while (total_read
< trial
)
2800 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2802 error ("IO error reading %s: %s",
2803 XSTRING (filename
)->data
, strerror (errno
));
2804 total_read
+= nread
;
2806 /* Scan this bufferfull from the end, comparing with
2807 the Emacs buffer. */
2808 bufpos
= total_read
;
2809 /* Compare with same_at_start to avoid counting some buffer text
2810 as matching both at the file's beginning and at the end. */
2811 while (bufpos
> 0 && same_at_end
> same_at_start
2812 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2813 same_at_end
--, bufpos
--;
2814 /* If we found a discrepancy, stop the scan.
2815 Otherwise loop around and scan the preceding bufferfull. */
2821 /* Don't try to reuse the same piece of text twice. */
2822 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2824 same_at_end
+= overlap
;
2826 /* Arrange to read only the nonmatching middle part of the file. */
2827 XSETFASTINT (beg
, same_at_start
- BEGV
);
2828 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
2830 del_range_1 (same_at_start
, same_at_end
, 0);
2831 /* Insert from the file at the proper position. */
2832 SET_PT (same_at_start
);
2836 total
= XINT (end
) - XINT (beg
);
2839 register Lisp_Object temp
;
2841 /* Make sure point-max won't overflow after this insertion. */
2842 XSETINT (temp
, total
);
2843 if (total
!= XINT (temp
))
2844 error ("maximum buffer size exceeded");
2847 if (NILP (visit
) && total
> 0)
2848 prepare_to_modify_buffer (point
, point
);
2851 if (GAP_SIZE
< total
)
2852 make_gap (total
- GAP_SIZE
);
2854 if (XINT (beg
) != 0 || !NILP (replace
))
2856 if (lseek (fd
, XINT (beg
), 0) < 0)
2857 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2861 while (inserted
< total
)
2863 int try = min (total
- inserted
, 64 << 10);
2866 /* Allow quitting out of the actual I/O. */
2869 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2886 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
2887 /* Determine file type from name and remove LFs from CR-LFs if the file
2888 is deemed to be a text file. */
2890 current_buffer
->buffer_file_type
2891 = call1 (Qfind_buffer_file_type
, filename
);
2892 if (NILP (current_buffer
->buffer_file_type
))
2895 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
2898 GPT
-= reduced_size
;
2899 GAP_SIZE
+= reduced_size
;
2900 inserted
-= reduced_size
;
2907 record_insert (point
, inserted
);
2909 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2910 offset_intervals (current_buffer
, point
, inserted
);
2916 /* Discard the unwind protect for closing the file. */
2920 error ("IO error reading %s: %s",
2921 XSTRING (filename
)->data
, strerror (errno
));
2928 if (!EQ (current_buffer
->undo_list
, Qt
))
2929 current_buffer
->undo_list
= Qnil
;
2931 stat (XSTRING (filename
)->data
, &st
);
2936 current_buffer
->modtime
= st
.st_mtime
;
2937 current_buffer
->filename
= filename
;
2940 current_buffer
->save_modified
= MODIFF
;
2941 current_buffer
->auto_save_modified
= MODIFF
;
2942 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
2943 #ifdef CLASH_DETECTION
2946 if (!NILP (current_buffer
->filename
))
2947 unlock_file (current_buffer
->filename
);
2948 unlock_file (filename
);
2950 #endif /* CLASH_DETECTION */
2951 /* If visiting nonexistent file, return nil. */
2952 if (current_buffer
->modtime
== -1)
2953 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2956 if (inserted
> 0 && NILP (visit
) && total
> 0)
2957 signal_after_change (point
, 0, inserted
);
2961 p
= Vafter_insert_file_functions
;
2964 insval
= call1 (Fcar (p
), make_number (inserted
));
2967 CHECK_NUMBER (insval
, 0);
2968 inserted
= XFASTINT (insval
);
2976 val
= Fcons (filename
,
2977 Fcons (make_number (inserted
),
2980 RETURN_UNGCPRO (unbind_to (count
, val
));
2983 static Lisp_Object
build_annotations ();
2985 /* If build_annotations switched buffers, switch back to BUF.
2986 Kill the temporary buffer that was selected in the meantime. */
2989 build_annotations_unwind (buf
)
2994 if (XBUFFER (buf
) == current_buffer
)
2996 tembuf
= Fcurrent_buffer ();
2998 Fkill_buffer (tembuf
);
3002 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
3003 "r\nFWrite region to file: ",
3004 "Write current region into specified file.\n\
3005 When called from a program, takes three arguments:\n\
3006 START, END and FILENAME. START and END are buffer positions.\n\
3007 Optional fourth argument APPEND if non-nil means\n\
3008 append to existing file contents (if any).\n\
3009 Optional fifth argument VISIT if t means\n\
3010 set the last-save-file-modtime of buffer to this file's modtime\n\
3011 and mark buffer not modified.\n\
3012 If VISIT is a string, it is a second file name;\n\
3013 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3014 VISIT is also the file name to lock and unlock for clash detection.\n\
3015 If VISIT is neither t nor nil nor a string,\n\
3016 that means do not print the \"Wrote file\" message.\n\
3017 Kludgy feature: if START is a string, then that string is written\n\
3018 to the file, instead of any buffer contents, and END is ignored.")
3019 (start
, end
, filename
, append
, visit
)
3020 Lisp_Object start
, end
, filename
, append
, visit
;
3028 int count
= specpdl_ptr
- specpdl
;
3031 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3033 Lisp_Object handler
;
3034 Lisp_Object visit_file
;
3035 Lisp_Object annotations
;
3036 int visiting
, quietly
;
3037 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3038 struct buffer
*given_buffer
;
3040 int buffer_file_type
3041 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3044 if (!NILP (start
) && !STRINGP (start
))
3045 validate_region (&start
, &end
);
3047 GCPRO2 (filename
, visit
);
3048 filename
= Fexpand_file_name (filename
, Qnil
);
3049 if (STRINGP (visit
))
3050 visit_file
= Fexpand_file_name (visit
, Qnil
);
3052 visit_file
= filename
;
3055 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3056 quietly
= !NILP (visit
);
3060 GCPRO4 (start
, filename
, annotations
, visit_file
);
3062 /* If the file name has special constructs in it,
3063 call the corresponding file handler. */
3064 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3065 /* If FILENAME has no handler, see if VISIT has one. */
3066 if (NILP (handler
) && STRINGP (visit
))
3067 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3069 if (!NILP (handler
))
3072 val
= call6 (handler
, Qwrite_region
, start
, end
,
3073 filename
, append
, visit
);
3077 current_buffer
->save_modified
= MODIFF
;
3078 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3079 current_buffer
->filename
= visit_file
;
3085 /* Special kludge to simplify auto-saving. */
3088 XSETFASTINT (start
, BEG
);
3089 XSETFASTINT (end
, Z
);
3092 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3093 count1
= specpdl_ptr
- specpdl
;
3095 given_buffer
= current_buffer
;
3096 annotations
= build_annotations (start
, end
);
3097 if (current_buffer
!= given_buffer
)
3103 #ifdef CLASH_DETECTION
3105 lock_file (visit_file
);
3106 #endif /* CLASH_DETECTION */
3108 fn
= XSTRING (filename
)->data
;
3112 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3114 desc
= open (fn
, O_WRONLY
);
3119 if (auto_saving
) /* Overwrite any previous version of autosave file */
3121 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3122 desc
= open (fn
, O_RDWR
);
3124 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3125 ? XSTRING (current_buffer
->filename
)->data
: 0,
3128 else /* Write to temporary name and rename if no errors */
3130 Lisp_Object temp_name
;
3131 temp_name
= Ffile_name_directory (filename
);
3133 if (!NILP (temp_name
))
3135 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3136 build_string ("$$SAVE$$")));
3137 fname
= XSTRING (filename
)->data
;
3138 fn
= XSTRING (temp_name
)->data
;
3139 desc
= creat_copy_attrs (fname
, fn
);
3142 /* If we can't open the temporary file, try creating a new
3143 version of the original file. VMS "creat" creates a
3144 new version rather than truncating an existing file. */
3147 desc
= creat (fn
, 0666);
3148 #if 0 /* This can clobber an existing file and fail to replace it,
3149 if the user runs out of space. */
3152 /* We can't make a new version;
3153 try to truncate and rewrite existing version if any. */
3155 desc
= open (fn
, O_RDWR
);
3161 desc
= creat (fn
, 0666);
3166 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3167 S_IREAD
| S_IWRITE
);
3168 #else /* not MSDOS */
3169 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3170 #endif /* not MSDOS */
3171 #endif /* not VMS */
3177 #ifdef CLASH_DETECTION
3179 if (!auto_saving
) unlock_file (visit_file
);
3181 #endif /* CLASH_DETECTION */
3182 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3185 record_unwind_protect (close_file_unwind
, make_number (desc
));
3188 if (lseek (desc
, 0, 2) < 0)
3190 #ifdef CLASH_DETECTION
3191 if (!auto_saving
) unlock_file (visit_file
);
3192 #endif /* CLASH_DETECTION */
3193 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3198 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3199 * if we do writes that don't end with a carriage return. Furthermore
3200 * it cannot handle writes of more then 16K. The modified
3201 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3202 * this EXCEPT for the last record (iff it doesn't end with a carriage
3203 * return). This implies that if your buffer doesn't end with a carriage
3204 * return, you get one free... tough. However it also means that if
3205 * we make two calls to sys_write (a la the following code) you can
3206 * get one at the gap as well. The easiest way to fix this (honest)
3207 * is to move the gap to the next newline (or the end of the buffer).
3212 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3213 move_gap (find_next_newline (GPT
, 1));
3219 if (STRINGP (start
))
3221 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3222 XSTRING (start
)->size
, 0, &annotations
);
3225 else if (XINT (start
) != XINT (end
))
3228 if (XINT (start
) < GPT
)
3230 register int end1
= XINT (end
);
3232 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3233 min (GPT
, end1
) - tem
, tem
, &annotations
);
3234 nwritten
+= min (GPT
, end1
) - tem
;
3238 if (XINT (end
) > GPT
&& !failure
)
3241 tem
= max (tem
, GPT
);
3242 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3244 nwritten
+= XINT (end
) - tem
;
3250 /* If file was empty, still need to write the annotations */
3251 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3259 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3260 Disk full in NFS may be reported here. */
3261 /* mib says that closing the file will try to write as fast as NFS can do
3262 it, and that means the fsync here is not crucial for autosave files. */
3263 if (!auto_saving
&& fsync (desc
) < 0)
3264 failure
= 1, save_errno
= errno
;
3267 /* Spurious "file has changed on disk" warnings have been
3268 observed on Suns as well.
3269 It seems that `close' can change the modtime, under nfs.
3271 (This has supposedly been fixed in Sunos 4,
3272 but who knows about all the other machines with NFS?) */
3275 /* On VMS and APOLLO, must do the stat after the close
3276 since closing changes the modtime. */
3279 /* Recall that #if defined does not work on VMS. */
3286 /* NFS can report a write failure now. */
3287 if (close (desc
) < 0)
3288 failure
= 1, save_errno
= errno
;
3291 /* If we wrote to a temporary name and had no errors, rename to real name. */
3295 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3303 /* Discard the unwind protect for close_file_unwind. */
3304 specpdl_ptr
= specpdl
+ count1
;
3305 /* Restore the original current buffer. */
3306 visit_file
= unbind_to (count
, visit_file
);
3308 #ifdef CLASH_DETECTION
3310 unlock_file (visit_file
);
3311 #endif /* CLASH_DETECTION */
3313 /* Do this before reporting IO error
3314 to avoid a "file has changed on disk" warning on
3315 next attempt to save. */
3317 current_buffer
->modtime
= st
.st_mtime
;
3320 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3324 current_buffer
->save_modified
= MODIFF
;
3325 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3326 current_buffer
->filename
= visit_file
;
3327 update_mode_lines
++;
3333 message ("Wrote %s", XSTRING (visit_file
)->data
);
3338 Lisp_Object
merge ();
3340 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3341 "Return t if (car A) is numerically less than (car B).")
3345 return Flss (Fcar (a
), Fcar (b
));
3348 /* Build the complete list of annotations appropriate for writing out
3349 the text between START and END, by calling all the functions in
3350 write-region-annotate-functions and merging the lists they return.
3351 If one of these functions switches to a different buffer, we assume
3352 that buffer contains altered text. Therefore, the caller must
3353 make sure to restore the current buffer in all cases,
3354 as save-excursion would do. */
3357 build_annotations (start
, end
)
3358 Lisp_Object start
, end
;
3360 Lisp_Object annotations
;
3362 struct gcpro gcpro1
, gcpro2
;
3365 p
= Vwrite_region_annotate_functions
;
3366 GCPRO2 (annotations
, p
);
3369 struct buffer
*given_buffer
= current_buffer
;
3370 Vwrite_region_annotations_so_far
= annotations
;
3371 res
= call2 (Fcar (p
), start
, end
);
3372 /* If the function makes a different buffer current,
3373 assume that means this buffer contains altered text to be output.
3374 Reset START and END from the buffer bounds
3375 and discard all previous annotations because they should have
3376 been dealt with by this function. */
3377 if (current_buffer
!= given_buffer
)
3383 Flength (res
); /* Check basic validity of return value */
3384 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3391 /* Write to descriptor DESC the LEN characters starting at ADDR,
3392 assuming they start at position POS in the buffer.
3393 Intersperse with them the annotations from *ANNOT
3394 (those which fall within the range of positions POS to POS + LEN),
3395 each at its appropriate position.
3397 Modify *ANNOT by discarding elements as we output them.
3398 The return value is negative in case of system call failure. */
3401 a_write (desc
, addr
, len
, pos
, annot
)
3403 register char *addr
;
3410 int lastpos
= pos
+ len
;
3412 while (NILP (*annot
) || CONSP (*annot
))
3414 tem
= Fcar_safe (Fcar (*annot
));
3415 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3416 nextpos
= XFASTINT (tem
);
3418 return e_write (desc
, addr
, lastpos
- pos
);
3421 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3423 addr
+= nextpos
- pos
;
3426 tem
= Fcdr (Fcar (*annot
));
3429 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3432 *annot
= Fcdr (*annot
);
3437 e_write (desc
, addr
, len
)
3439 register char *addr
;
3442 char buf
[16 * 1024];
3443 register char *p
, *end
;
3445 if (!EQ (current_buffer
->selective_display
, Qt
))
3446 return write (desc
, addr
, len
) - len
;
3450 end
= p
+ sizeof buf
;
3455 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3464 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3470 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3471 Sverify_visited_file_modtime
, 1, 1, 0,
3472 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3473 This means that the file has not been changed since it was visited or saved.")
3479 Lisp_Object handler
;
3481 CHECK_BUFFER (buf
, 0);
3484 if (!STRINGP (b
->filename
)) return Qt
;
3485 if (b
->modtime
== 0) return Qt
;
3487 /* If the file name has special constructs in it,
3488 call the corresponding file handler. */
3489 handler
= Ffind_file_name_handler (b
->filename
,
3490 Qverify_visited_file_modtime
);
3491 if (!NILP (handler
))
3492 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3494 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3496 /* If the file doesn't exist now and didn't exist before,
3497 we say that it isn't modified, provided the error is a tame one. */
3498 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3503 if (st
.st_mtime
== b
->modtime
3504 /* If both are positive, accept them if they are off by one second. */
3505 || (st
.st_mtime
> 0 && b
->modtime
> 0
3506 && (st
.st_mtime
== b
->modtime
+ 1
3507 || st
.st_mtime
== b
->modtime
- 1)))
3512 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3513 Sclear_visited_file_modtime
, 0, 0, 0,
3514 "Clear out records of last mod time of visited file.\n\
3515 Next attempt to save will certainly not complain of a discrepancy.")
3518 current_buffer
->modtime
= 0;
3522 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3523 Svisited_file_modtime
, 0, 0, 0,
3524 "Return the current buffer's recorded visited file modification time.\n\
3525 The value is a list of the form (HIGH . LOW), like the time values\n\
3526 that `file-attributes' returns.")
3529 return long_to_cons (current_buffer
->modtime
);
3532 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3533 Sset_visited_file_modtime
, 0, 1, 0,
3534 "Update buffer's recorded modification time from the visited file's time.\n\
3535 Useful if the buffer was not read from the file normally\n\
3536 or if the file itself has been changed for some known benign reason.\n\
3537 An argument specifies the modification time value to use\n\
3538 \(instead of that of the visited file), in the form of a list\n\
3539 \(HIGH . LOW) or (HIGH LOW).")
3541 Lisp_Object time_list
;
3543 if (!NILP (time_list
))
3544 current_buffer
->modtime
= cons_to_long (time_list
);
3547 register Lisp_Object filename
;
3549 Lisp_Object handler
;
3551 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3553 /* If the file name has special constructs in it,
3554 call the corresponding file handler. */
3555 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3556 if (!NILP (handler
))
3557 /* The handler can find the file name the same way we did. */
3558 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3559 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3560 current_buffer
->modtime
= st
.st_mtime
;
3570 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3571 Fsleep_for (make_number (1), Qnil
);
3572 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3573 Fsleep_for (make_number (1), Qnil
);
3574 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3575 Fsleep_for (make_number (1), Qnil
);
3585 /* Get visited file's mode to become the auto save file's mode. */
3586 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3587 /* But make sure we can overwrite it later! */
3588 auto_save_mode_bits
= st
.st_mode
| 0600;
3590 auto_save_mode_bits
= 0666;
3593 Fwrite_region (Qnil
, Qnil
,
3594 current_buffer
->auto_save_file_name
,
3599 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3602 close (XINT (desc
));
3606 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3607 "Auto-save all buffers that need it.\n\
3608 This is all buffers that have auto-saving enabled\n\
3609 and are changed since last auto-saved.\n\
3610 Auto-saving writes the buffer into a file\n\
3611 so that your editing is not lost if the system crashes.\n\
3612 This file is not the file you visited; that changes only when you save.\n\
3613 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3614 Non-nil first argument means do not print any message if successful.\n\
3615 Non-nil second argument means save only current buffer.")
3616 (no_message
, current_only
)
3617 Lisp_Object no_message
, current_only
;
3619 struct buffer
*old
= current_buffer
, *b
;
3620 Lisp_Object tail
, buf
;
3622 char *omessage
= echo_area_glyphs
;
3623 int omessage_length
= echo_area_glyphs_length
;
3624 extern int minibuf_level
;
3625 int do_handled_files
;
3628 int count
= specpdl_ptr
- specpdl
;
3631 /* Ordinarily don't quit within this function,
3632 but don't make it impossible to quit (in case we get hung in I/O). */
3636 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3637 point to non-strings reached from Vbuffer_alist. */
3643 if (!NILP (Vrun_hooks
))
3644 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3646 if (STRINGP (Vauto_save_list_file_name
))
3649 listdesc
= open (XSTRING (Vauto_save_list_file_name
)->data
,
3650 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3651 S_IREAD
| S_IWRITE
);
3652 #else /* not MSDOS */
3653 listdesc
= creat (XSTRING (Vauto_save_list_file_name
)->data
, 0666);
3654 #endif /* not MSDOS */
3659 /* Arrange to close that file whether or not we get an error. */
3661 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3663 /* First, save all files which don't have handlers. If Emacs is
3664 crashing, the handlers may tweak what is causing Emacs to crash
3665 in the first place, and it would be a shame if Emacs failed to
3666 autosave perfectly ordinary files because it couldn't handle some
3668 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3669 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
3670 tail
= XCONS (tail
)->cdr
)
3672 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3675 /* Record all the buffers that have auto save mode
3676 in the special file that lists them. */
3677 if (STRINGP (b
->auto_save_file_name
)
3678 && listdesc
>= 0 && do_handled_files
== 0)
3680 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3681 XSTRING (b
->auto_save_file_name
)->size
);
3682 write (listdesc
, "\n", 1);
3685 if (!NILP (current_only
)
3686 && b
!= current_buffer
)
3689 /* Check for auto save enabled
3690 and file changed since last auto save
3691 and file changed since last real save. */
3692 if (STRINGP (b
->auto_save_file_name
)
3693 && b
->save_modified
< BUF_MODIFF (b
)
3694 && b
->auto_save_modified
< BUF_MODIFF (b
)
3695 /* -1 means we've turned off autosaving for a while--see below. */
3696 && XINT (b
->save_length
) >= 0
3697 && (do_handled_files
3698 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3701 EMACS_TIME before_time
, after_time
;
3703 EMACS_GET_TIME (before_time
);
3705 /* If we had a failure, don't try again for 20 minutes. */
3706 if (b
->auto_save_failure_time
>= 0
3707 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3710 if ((XFASTINT (b
->save_length
) * 10
3711 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3712 /* A short file is likely to change a large fraction;
3713 spare the user annoying messages. */
3714 && XFASTINT (b
->save_length
) > 5000
3715 /* These messages are frequent and annoying for `*mail*'. */
3716 && !EQ (b
->filename
, Qnil
)
3717 && NILP (no_message
))
3719 /* It has shrunk too much; turn off auto-saving here. */
3720 message ("Buffer %s has shrunk a lot; auto save turned off there",
3721 XSTRING (b
->name
)->data
);
3722 /* Turn off auto-saving until there's a real save,
3723 and prevent any more warnings. */
3724 XSETINT (b
->save_length
, -1);
3725 Fsleep_for (make_number (1), Qnil
);
3728 set_buffer_internal (b
);
3729 if (!auto_saved
&& NILP (no_message
))
3730 message1 ("Auto-saving...");
3731 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3733 b
->auto_save_modified
= BUF_MODIFF (b
);
3734 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3735 set_buffer_internal (old
);
3737 EMACS_GET_TIME (after_time
);
3739 /* If auto-save took more than 60 seconds,
3740 assume it was an NFS failure that got a timeout. */
3741 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3742 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3746 /* Prevent another auto save till enough input events come in. */
3747 record_auto_save ();
3749 if (auto_saved
&& NILP (no_message
))
3752 message2 (omessage
, omessage_length
);
3754 message1 ("Auto-saving...done");
3760 unbind_to (count
, Qnil
);
3764 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3765 Sset_buffer_auto_saved
, 0, 0, 0,
3766 "Mark current buffer as auto-saved with its current text.\n\
3767 No auto-save file will be written until the buffer changes again.")
3770 current_buffer
->auto_save_modified
= MODIFF
;
3771 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3772 current_buffer
->auto_save_failure_time
= -1;
3776 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3777 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3778 "Clear any record of a recent auto-save failure in the current buffer.")
3781 current_buffer
->auto_save_failure_time
= -1;
3785 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3787 "Return t if buffer has been auto-saved since last read in or saved.")
3790 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3793 /* Reading and completing file names */
3794 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3796 /* In the string VAL, change each $ to $$ and return the result. */
3799 double_dollars (val
)
3802 register unsigned char *old
, *new;
3806 osize
= XSTRING (val
)->size
;
3807 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3808 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3809 if (*old
++ == '$') count
++;
3812 old
= XSTRING (val
)->data
;
3813 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3814 new = XSTRING (val
)->data
;
3815 for (n
= osize
; n
> 0; n
--)
3828 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3830 "Internal subroutine for read-file-name. Do not call this.")
3831 (string
, dir
, action
)
3832 Lisp_Object string
, dir
, action
;
3833 /* action is nil for complete, t for return list of completions,
3834 lambda for verify final value */
3836 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3838 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3845 /* No need to protect ACTION--we only compare it with t and nil. */
3846 GCPRO4 (string
, realdir
, name
, specdir
);
3848 if (XSTRING (string
)->size
== 0)
3850 if (EQ (action
, Qlambda
))
3858 orig_string
= string
;
3859 string
= Fsubstitute_in_file_name (string
);
3860 changed
= NILP (Fstring_equal (string
, orig_string
));
3861 name
= Ffile_name_nondirectory (string
);
3862 val
= Ffile_name_directory (string
);
3864 realdir
= Fexpand_file_name (val
, realdir
);
3869 specdir
= Ffile_name_directory (string
);
3870 val
= Ffile_name_completion (name
, realdir
);
3875 return double_dollars (string
);
3879 if (!NILP (specdir
))
3880 val
= concat2 (specdir
, val
);
3882 return double_dollars (val
);
3885 #endif /* not VMS */
3889 if (EQ (action
, Qt
))
3890 return Ffile_name_all_completions (name
, realdir
);
3891 /* Only other case actually used is ACTION = lambda */
3893 /* Supposedly this helps commands such as `cd' that read directory names,
3894 but can someone explain how it helps them? -- RMS */
3895 if (XSTRING (name
)->size
== 0)
3898 return Ffile_exists_p (string
);
3901 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3902 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3903 Value is not expanded---you must call `expand-file-name' yourself.\n\
3904 Default name to DEFAULT if user enters a null string.\n\
3905 (If DEFAULT is omitted, the visited file name is used,\n\
3906 except that if INITIAL is specified, that combined with DIR is used.)\n\
3907 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3908 Non-nil and non-t means also require confirmation after completion.\n\
3909 Fifth arg INITIAL specifies text to start with.\n\
3910 DIR defaults to current buffer's directory default.")
3911 (prompt
, dir
, defalt
, mustmatch
, initial
)
3912 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3914 Lisp_Object val
, insdef
, insdef1
, tem
;
3915 struct gcpro gcpro1
, gcpro2
;
3916 register char *homedir
;
3920 dir
= current_buffer
->directory
;
3923 if (! NILP (initial
))
3924 defalt
= Fexpand_file_name (initial
, dir
);
3926 defalt
= current_buffer
->filename
;
3929 /* If dir starts with user's homedir, change that to ~. */
3930 homedir
= (char *) egetenv ("HOME");
3933 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3934 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3936 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3937 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3938 XSTRING (dir
)->data
[0] = '~';
3941 if (insert_default_directory
)
3944 if (!NILP (initial
))
3946 Lisp_Object args
[2], pos
;
3950 insdef
= Fconcat (2, args
);
3951 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
3952 insdef1
= Fcons (double_dollars (insdef
), pos
);
3955 insdef1
= double_dollars (insdef
);
3957 else if (!NILP (initial
))
3960 insdef1
= Fcons (double_dollars (insdef
), 0);
3963 insdef
= Qnil
, insdef1
= Qnil
;
3966 count
= specpdl_ptr
- specpdl
;
3967 specbind (intern ("completion-ignore-case"), Qt
);
3970 GCPRO2 (insdef
, defalt
);
3971 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3972 dir
, mustmatch
, insdef1
,
3973 Qfile_name_history
);
3976 unbind_to (count
, Qnil
);
3981 error ("No file name specified");
3982 tem
= Fstring_equal (val
, insdef
);
3983 if (!NILP (tem
) && !NILP (defalt
))
3985 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3990 error ("No default file name");
3992 return Fsubstitute_in_file_name (val
);
3995 #if 0 /* Old version */
3996 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3997 /* Don't confuse make-docfile by having two doc strings for this function.
3998 make-docfile does not pay attention to #if, for good reason! */
4000 (prompt
, dir
, defalt
, mustmatch
, initial
)
4001 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4003 Lisp_Object val
, insdef
, tem
;
4004 struct gcpro gcpro1
, gcpro2
;
4005 register char *homedir
;
4009 dir
= current_buffer
->directory
;
4011 defalt
= current_buffer
->filename
;
4013 /* If dir starts with user's homedir, change that to ~. */
4014 homedir
= (char *) egetenv ("HOME");
4017 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4018 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4020 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4021 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4022 XSTRING (dir
)->data
[0] = '~';
4025 if (!NILP (initial
))
4027 else if (insert_default_directory
)
4030 insdef
= build_string ("");
4033 count
= specpdl_ptr
- specpdl
;
4034 specbind (intern ("completion-ignore-case"), Qt
);
4037 GCPRO2 (insdef
, defalt
);
4038 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4040 insert_default_directory
? insdef
: Qnil
,
4041 Qfile_name_history
);
4044 unbind_to (count
, Qnil
);
4049 error ("No file name specified");
4050 tem
= Fstring_equal (val
, insdef
);
4051 if (!NILP (tem
) && !NILP (defalt
))
4053 return Fsubstitute_in_file_name (val
);
4055 #endif /* Old version */
4059 Qexpand_file_name
= intern ("expand-file-name");
4060 Qdirectory_file_name
= intern ("directory-file-name");
4061 Qfile_name_directory
= intern ("file-name-directory");
4062 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4063 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4064 Qfile_name_as_directory
= intern ("file-name-as-directory");
4065 Qcopy_file
= intern ("copy-file");
4066 Qmake_directory_internal
= intern ("make-directory-internal");
4067 Qdelete_directory
= intern ("delete-directory");
4068 Qdelete_file
= intern ("delete-file");
4069 Qrename_file
= intern ("rename-file");
4070 Qadd_name_to_file
= intern ("add-name-to-file");
4071 Qmake_symbolic_link
= intern ("make-symbolic-link");
4072 Qfile_exists_p
= intern ("file-exists-p");
4073 Qfile_executable_p
= intern ("file-executable-p");
4074 Qfile_readable_p
= intern ("file-readable-p");
4075 Qfile_symlink_p
= intern ("file-symlink-p");
4076 Qfile_writable_p
= intern ("file-writable-p");
4077 Qfile_directory_p
= intern ("file-directory-p");
4078 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4079 Qfile_modes
= intern ("file-modes");
4080 Qset_file_modes
= intern ("set-file-modes");
4081 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4082 Qinsert_file_contents
= intern ("insert-file-contents");
4083 Qwrite_region
= intern ("write-region");
4084 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4085 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4087 staticpro (&Qexpand_file_name
);
4088 staticpro (&Qdirectory_file_name
);
4089 staticpro (&Qfile_name_directory
);
4090 staticpro (&Qfile_name_nondirectory
);
4091 staticpro (&Qunhandled_file_name_directory
);
4092 staticpro (&Qfile_name_as_directory
);
4093 staticpro (&Qcopy_file
);
4094 staticpro (&Qmake_directory_internal
);
4095 staticpro (&Qdelete_directory
);
4096 staticpro (&Qdelete_file
);
4097 staticpro (&Qrename_file
);
4098 staticpro (&Qadd_name_to_file
);
4099 staticpro (&Qmake_symbolic_link
);
4100 staticpro (&Qfile_exists_p
);
4101 staticpro (&Qfile_executable_p
);
4102 staticpro (&Qfile_readable_p
);
4103 staticpro (&Qfile_symlink_p
);
4104 staticpro (&Qfile_writable_p
);
4105 staticpro (&Qfile_directory_p
);
4106 staticpro (&Qfile_accessible_directory_p
);
4107 staticpro (&Qfile_modes
);
4108 staticpro (&Qset_file_modes
);
4109 staticpro (&Qfile_newer_than_file_p
);
4110 staticpro (&Qinsert_file_contents
);
4111 staticpro (&Qwrite_region
);
4112 staticpro (&Qverify_visited_file_modtime
);
4114 Qfile_name_history
= intern ("file-name-history");
4115 Fset (Qfile_name_history
, Qnil
);
4116 staticpro (&Qfile_name_history
);
4118 Qfile_error
= intern ("file-error");
4119 staticpro (&Qfile_error
);
4120 Qfile_already_exists
= intern("file-already-exists");
4121 staticpro (&Qfile_already_exists
);
4124 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4125 staticpro (&Qfind_buffer_file_type
);
4128 Qcar_less_than_car
= intern ("car-less-than-car");
4129 staticpro (&Qcar_less_than_car
);
4131 Fput (Qfile_error
, Qerror_conditions
,
4132 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4133 Fput (Qfile_error
, Qerror_message
,
4134 build_string ("File error"));
4136 Fput (Qfile_already_exists
, Qerror_conditions
,
4137 Fcons (Qfile_already_exists
,
4138 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4139 Fput (Qfile_already_exists
, Qerror_message
,
4140 build_string ("File already exists"));
4142 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4143 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4144 insert_default_directory
= 1;
4146 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4147 "*Non-nil means write new files with record format `stmlf'.\n\
4148 nil means use format `var'. This variable is meaningful only on VMS.");
4149 vms_stmlf_recfm
= 0;
4151 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4152 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4153 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4156 The first argument given to HANDLER is the name of the I/O primitive\n\
4157 to be handled; the remaining arguments are the arguments that were\n\
4158 passed to that primitive. For example, if you do\n\
4159 (file-exists-p FILENAME)\n\
4160 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4161 (funcall HANDLER 'file-exists-p FILENAME)\n\
4162 The function `find-file-name-handler' checks this list for a handler\n\
4163 for its argument.");
4164 Vfile_name_handler_alist
= Qnil
;
4166 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4167 "A list of functions to be called at the end of `insert-file-contents'.\n\
4168 Each is passed one argument, the number of bytes inserted. It should return\n\
4169 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4170 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4171 responsible for calling the after-insert-file-functions if appropriate.");
4172 Vafter_insert_file_functions
= Qnil
;
4174 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4175 "A list of functions to be called at the start of `write-region'.\n\
4176 Each is passed two arguments, START and END as for `write-region'. It should\n\
4177 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4178 inserted at the specified positions of the file being written (1 means to\n\
4179 insert before the first byte written). The POSITIONs must be sorted into\n\
4180 increasing order. If there are several functions in the list, the several\n\
4181 lists are merged destructively.");
4182 Vwrite_region_annotate_functions
= Qnil
;
4184 DEFVAR_LISP ("write-region-annotations-so-far",
4185 &Vwrite_region_annotations_so_far
,
4186 "When an annotation function is called, this holds the previous annotations.\n\
4187 These are the annotations made by other annotation functions\n\
4188 that were already called. See also `write-region-annotate-functions'.");
4189 Vwrite_region_annotations_so_far
= Qnil
;
4191 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4192 "A list of file name handlers that temporarily should not be used.\n\
4193 This applies only to the operation `inhibit-file-name-operation'.");
4194 Vinhibit_file_name_handlers
= Qnil
;
4196 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4197 "The operation for which `inhibit-file-name-handlers' is applicable.");
4198 Vinhibit_file_name_operation
= Qnil
;
4200 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4201 "File name in which we write a list of all auto save file names.");
4202 Vauto_save_list_file_name
= Qnil
;
4204 defsubr (&Sfind_file_name_handler
);
4205 defsubr (&Sfile_name_directory
);
4206 defsubr (&Sfile_name_nondirectory
);
4207 defsubr (&Sunhandled_file_name_directory
);
4208 defsubr (&Sfile_name_as_directory
);
4209 defsubr (&Sdirectory_file_name
);
4210 defsubr (&Smake_temp_name
);
4211 defsubr (&Sexpand_file_name
);
4212 defsubr (&Ssubstitute_in_file_name
);
4213 defsubr (&Scopy_file
);
4214 defsubr (&Smake_directory_internal
);
4215 defsubr (&Sdelete_directory
);
4216 defsubr (&Sdelete_file
);
4217 defsubr (&Srename_file
);
4218 defsubr (&Sadd_name_to_file
);
4220 defsubr (&Smake_symbolic_link
);
4221 #endif /* S_IFLNK */
4223 defsubr (&Sdefine_logical_name
);
4226 defsubr (&Ssysnetunam
);
4227 #endif /* HPUX_NET */
4228 defsubr (&Sfile_name_absolute_p
);
4229 defsubr (&Sfile_exists_p
);
4230 defsubr (&Sfile_executable_p
);
4231 defsubr (&Sfile_readable_p
);
4232 defsubr (&Sfile_writable_p
);
4233 defsubr (&Sfile_symlink_p
);
4234 defsubr (&Sfile_directory_p
);
4235 defsubr (&Sfile_accessible_directory_p
);
4236 defsubr (&Sfile_regular_p
);
4237 defsubr (&Sfile_modes
);
4238 defsubr (&Sset_file_modes
);
4239 defsubr (&Sset_default_file_modes
);
4240 defsubr (&Sdefault_file_modes
);
4241 defsubr (&Sfile_newer_than_file_p
);
4242 defsubr (&Sinsert_file_contents
);
4243 defsubr (&Swrite_region
);
4244 defsubr (&Scar_less_than_car
);
4245 defsubr (&Sverify_visited_file_modtime
);
4246 defsubr (&Sclear_visited_file_modtime
);
4247 defsubr (&Svisited_file_modtime
);
4248 defsubr (&Sset_visited_file_modtime
);
4249 defsubr (&Sdo_auto_save
);
4250 defsubr (&Sset_buffer_auto_saved
);
4251 defsubr (&Sclear_buffer_auto_save_failure
);
4252 defsubr (&Srecent_auto_save_p
);
4254 defsubr (&Sread_file_name_internal
);
4255 defsubr (&Sread_file_name
);
4258 defsubr (&Sunix_sync
);