1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,97,1998 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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
23 #if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX)
28 #include <sys/types.h>
35 #if !defined (S_ISLNK) && defined (S_IFLNK)
36 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
39 #if !defined (S_ISFIFO) && defined (S_IFIFO)
40 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
43 #if !defined (S_ISREG) && defined (S_IFREG)
44 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
68 extern char *strerror ();
85 #include "intervals.h"
96 #endif /* not WINDOWSNT */
100 #include <sys/param.h>
108 #define CORRECT_DIR_SEPS(s) \
109 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
110 else unixtodos_filename (s); \
112 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
113 redirector allows the six letters between 'Z' and 'a' as well. */
115 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
118 #define IS_DRIVE(x) isalpha (x)
120 /* Need to lower-case the drive letter, or else expanded
121 filenames will sometimes compare inequal, because
122 `expand-file-name' doesn't always down-case the drive letter. */
123 #define DRIVE_LETTER(x) (tolower (x))
152 #define min(a, b) ((a) < (b) ? (a) : (b))
153 #define max(a, b) ((a) > (b) ? (a) : (b))
155 /* Nonzero during writing of auto-save files */
158 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
159 a new file with the same mode as the original */
160 int auto_save_mode_bits
;
162 /* Coding system for file names, or nil if none. */
163 Lisp_Object Vfile_name_coding_system
;
165 /* Coding system for file names used only when
166 Vfile_name_coding_system is nil. */
167 Lisp_Object Vdefault_file_name_coding_system
;
169 /* Alist of elements (REGEXP . HANDLER) for file names
170 whose I/O is done with a special handler. */
171 Lisp_Object Vfile_name_handler_alist
;
173 /* Format for auto-save files */
174 Lisp_Object Vauto_save_file_format
;
176 /* Lisp functions for translating file formats */
177 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
179 /* Function to be called to decide a coding system of a reading file. */
180 Lisp_Object Vset_auto_coding_function
;
182 /* Functions to be called to process text properties in inserted file. */
183 Lisp_Object Vafter_insert_file_functions
;
185 /* Functions to be called to create text property annotations for file. */
186 Lisp_Object Vwrite_region_annotate_functions
;
188 /* During build_annotations, each time an annotation function is called,
189 this holds the annotations made by the previous functions. */
190 Lisp_Object Vwrite_region_annotations_so_far
;
192 /* File name in which we write a list of all our auto save files. */
193 Lisp_Object Vauto_save_list_file_name
;
195 /* Nonzero means, when reading a filename in the minibuffer,
196 start out by inserting the default directory into the minibuffer. */
197 int insert_default_directory
;
199 /* On VMS, nonzero means write new files with record format stmlf.
200 Zero means use var format. */
203 /* On NT, specifies the directory separator character, used (eg.) when
204 expanding file names. This can be bound to / or \. */
205 Lisp_Object Vdirectory_sep_char
;
207 extern Lisp_Object Vuser_login_name
;
209 extern int minibuf_level
;
211 extern int minibuffer_auto_raise
;
213 /* These variables describe handlers that have "already" had a chance
214 to handle the current operation.
216 Vinhibit_file_name_handlers is a list of file name handlers.
217 Vinhibit_file_name_operation is the operation being handled.
218 If we try to handle that operation, we ignore those handlers. */
220 static Lisp_Object Vinhibit_file_name_handlers
;
221 static Lisp_Object Vinhibit_file_name_operation
;
223 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
225 Lisp_Object Qfile_name_history
;
227 Lisp_Object Qcar_less_than_car
;
229 static int a_write
P_ ((int, char *, int, int,
230 Lisp_Object
*, struct coding_system
*));
231 static int e_write
P_ ((int, char *, int, struct coding_system
*));
234 report_file_error (string
, data
)
238 Lisp_Object errstring
;
240 errstring
= build_string (strerror (errno
));
242 /* System error messages are capitalized. Downcase the initial
243 unless it is followed by a slash. */
244 if (XSTRING (errstring
)->data
[1] != '/')
245 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
248 Fsignal (Qfile_error
,
249 Fcons (build_string (string
), Fcons (errstring
, data
)));
253 close_file_unwind (fd
)
256 close (XFASTINT (fd
));
260 /* Restore point, having saved it as a marker. */
263 restore_point_unwind (location
)
264 Lisp_Object location
;
266 Fgoto_char (location
);
267 Fset_marker (location
, Qnil
, Qnil
);
271 Lisp_Object Qexpand_file_name
;
272 Lisp_Object Qsubstitute_in_file_name
;
273 Lisp_Object Qdirectory_file_name
;
274 Lisp_Object Qfile_name_directory
;
275 Lisp_Object Qfile_name_nondirectory
;
276 Lisp_Object Qunhandled_file_name_directory
;
277 Lisp_Object Qfile_name_as_directory
;
278 Lisp_Object Qcopy_file
;
279 Lisp_Object Qmake_directory_internal
;
280 Lisp_Object Qdelete_directory
;
281 Lisp_Object Qdelete_file
;
282 Lisp_Object Qrename_file
;
283 Lisp_Object Qadd_name_to_file
;
284 Lisp_Object Qmake_symbolic_link
;
285 Lisp_Object Qfile_exists_p
;
286 Lisp_Object Qfile_executable_p
;
287 Lisp_Object Qfile_readable_p
;
288 Lisp_Object Qfile_writable_p
;
289 Lisp_Object Qfile_symlink_p
;
290 Lisp_Object Qaccess_file
;
291 Lisp_Object Qfile_directory_p
;
292 Lisp_Object Qfile_regular_p
;
293 Lisp_Object Qfile_accessible_directory_p
;
294 Lisp_Object Qfile_modes
;
295 Lisp_Object Qset_file_modes
;
296 Lisp_Object Qfile_newer_than_file_p
;
297 Lisp_Object Qinsert_file_contents
;
298 Lisp_Object Qwrite_region
;
299 Lisp_Object Qverify_visited_file_modtime
;
300 Lisp_Object Qset_visited_file_modtime
;
302 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
303 "Return FILENAME's handler function for OPERATION, if it has one.\n\
304 Otherwise, return nil.\n\
305 A file name is handled if one of the regular expressions in\n\
306 `file-name-handler-alist' matches it.\n\n\
307 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
308 any handlers that are members of `inhibit-file-name-handlers',\n\
309 but we still do run any other handlers. This lets handlers\n\
310 use the standard functions without calling themselves recursively.")
311 (filename
, operation
)
312 Lisp_Object filename
, operation
;
314 /* This function must not munge the match data. */
315 Lisp_Object chain
, inhibited_handlers
;
317 CHECK_STRING (filename
, 0);
319 if (EQ (operation
, Vinhibit_file_name_operation
))
320 inhibited_handlers
= Vinhibit_file_name_handlers
;
322 inhibited_handlers
= Qnil
;
324 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
325 chain
= XCONS (chain
)->cdr
)
328 elt
= XCONS (chain
)->car
;
332 string
= XCONS (elt
)->car
;
333 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
335 Lisp_Object handler
, tem
;
337 handler
= XCONS (elt
)->cdr
;
338 tem
= Fmemq (handler
, inhibited_handlers
);
349 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
351 "Return the directory component in file name FILENAME.\n\
352 Return nil if FILENAME does not include a directory.\n\
353 Otherwise return a directory spec.\n\
354 Given a Unix syntax file name, returns a string ending in slash;\n\
355 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
357 Lisp_Object filename
;
359 register unsigned char *beg
;
360 register unsigned char *p
;
363 CHECK_STRING (filename
, 0);
365 /* If the file name has special constructs in it,
366 call the corresponding file handler. */
367 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
369 return call2 (handler
, Qfile_name_directory
, filename
);
371 #ifdef FILE_SYSTEM_CASE
372 filename
= FILE_SYSTEM_CASE (filename
);
374 beg
= XSTRING (filename
)->data
;
376 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
378 p
= beg
+ STRING_BYTES (XSTRING (filename
));
380 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
382 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
385 /* only recognise drive specifier at beginning */
386 && !(p
[-1] == ':' && p
== beg
+ 2)
393 /* Expansion of "c:" to drive and default directory. */
394 if (p
== beg
+ 2 && beg
[1] == ':')
396 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
397 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
398 if (getdefdir (toupper (*beg
) - 'A' + 1, res
))
400 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
403 p
= beg
+ strlen (beg
);
406 CORRECT_DIR_SEPS (beg
);
409 if (STRING_MULTIBYTE (filename
))
410 return make_string (beg
, p
- beg
);
411 return make_unibyte_string (beg
, p
- beg
);
414 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
415 Sfile_name_nondirectory
, 1, 1, 0,
416 "Return file name FILENAME sans its directory.\n\
417 For example, in a Unix-syntax file name,\n\
418 this is everything after the last slash,\n\
419 or the entire name if it contains no slash.")
421 Lisp_Object filename
;
423 register unsigned char *beg
, *p
, *end
;
426 CHECK_STRING (filename
, 0);
428 /* If the file name has special constructs in it,
429 call the corresponding file handler. */
430 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
432 return call2 (handler
, Qfile_name_nondirectory
, filename
);
434 beg
= XSTRING (filename
)->data
;
435 end
= p
= beg
+ STRING_BYTES (XSTRING (filename
));
437 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
439 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
442 /* only recognise drive specifier at beginning */
443 && !(p
[-1] == ':' && p
== beg
+ 2)
448 if (STRING_MULTIBYTE (filename
))
449 return make_string (p
, end
- p
);
450 return make_unibyte_string (p
, end
- p
);
453 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
454 Sunhandled_file_name_directory
, 1, 1, 0,
455 "Return a directly usable directory name somehow associated with FILENAME.\n\
456 A `directly usable' directory name is one that may be used without the\n\
457 intervention of any file handler.\n\
458 If FILENAME is a directly usable file itself, return\n\
459 \(file-name-directory FILENAME).\n\
460 The `call-process' and `start-process' functions use this function to\n\
461 get a current directory to run processes in.")
463 Lisp_Object filename
;
467 /* If the file name has special constructs in it,
468 call the corresponding file handler. */
469 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
471 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
473 return Ffile_name_directory (filename
);
478 file_name_as_directory (out
, in
)
481 int size
= strlen (in
) - 1;
494 /* Is it already a directory string? */
495 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
497 /* Is it a VMS directory file name? If so, hack VMS syntax. */
498 else if (! index (in
, '/')
499 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
500 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
501 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
502 || ! strncmp (&in
[size
- 5], ".dir", 4))
503 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
504 && in
[size
] == '1')))
506 register char *p
, *dot
;
510 dir:x.dir --> dir:[x]
511 dir:[x]y.dir --> dir:[x.y] */
513 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
516 strncpy (out
, in
, p
- in
);
535 dot
= index (p
, '.');
538 /* blindly remove any extension */
539 size
= strlen (out
) + (dot
- p
);
540 strncat (out
, p
, dot
- p
);
551 /* For Unix syntax, Append a slash if necessary */
552 if (!IS_DIRECTORY_SEP (out
[size
]))
554 out
[size
+ 1] = DIRECTORY_SEP
;
555 out
[size
+ 2] = '\0';
558 CORRECT_DIR_SEPS (out
);
564 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
565 Sfile_name_as_directory
, 1, 1, 0,
566 "Return a string representing file FILENAME interpreted as a directory.\n\
567 This operation exists because a directory is also a file, but its name as\n\
568 a directory is different from its name as a file.\n\
569 The result can be used as the value of `default-directory'\n\
570 or passed as second argument to `expand-file-name'.\n\
571 For a Unix-syntax file name, just appends a slash.\n\
572 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
579 CHECK_STRING (file
, 0);
583 /* If the file name has special constructs in it,
584 call the corresponding file handler. */
585 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
587 return call2 (handler
, Qfile_name_as_directory
, file
);
589 buf
= (char *) alloca (STRING_BYTES (XSTRING (file
)) + 10);
590 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
594 * Convert from directory name to filename.
596 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
597 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
598 * On UNIX, it's simple: just make sure there isn't a terminating /
600 * Value is nonzero if the string output is different from the input.
604 directory_file_name (src
, dst
)
612 struct FAB fab
= cc$rms_fab
;
613 struct NAM nam
= cc$rms_nam
;
614 char esa
[NAM$C_MAXRSS
];
619 if (! index (src
, '/')
620 && (src
[slen
- 1] == ']'
621 || src
[slen
- 1] == ':'
622 || src
[slen
- 1] == '>'))
624 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
626 fab
.fab$b_fns
= slen
;
627 fab
.fab$l_nam
= &nam
;
628 fab
.fab$l_fop
= FAB$M_NAM
;
631 nam
.nam$b_ess
= sizeof esa
;
632 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
634 /* We call SYS$PARSE to handle such things as [--] for us. */
635 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
637 slen
= nam
.nam$b_esl
;
638 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
643 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
645 /* what about when we have logical_name:???? */
646 if (src
[slen
- 1] == ':')
647 { /* Xlate logical name and see what we get */
648 ptr
= strcpy (dst
, src
); /* upper case for getenv */
651 if ('a' <= *ptr
&& *ptr
<= 'z')
655 dst
[slen
- 1] = 0; /* remove colon */
656 if (!(src
= egetenv (dst
)))
658 /* should we jump to the beginning of this procedure?
659 Good points: allows us to use logical names that xlate
661 Bad points: can be a problem if we just translated to a device
663 For now, I'll punt and always expect VMS names, and hope for
666 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
667 { /* no recursion here! */
673 { /* not a directory spec */
678 bracket
= src
[slen
- 1];
680 /* If bracket is ']' or '>', bracket - 2 is the corresponding
682 ptr
= index (src
, bracket
- 2);
684 { /* no opening bracket */
688 if (!(rptr
= rindex (src
, '.')))
691 strncpy (dst
, src
, slen
);
695 dst
[slen
++] = bracket
;
700 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
701 then translate the device and recurse. */
702 if (dst
[slen
- 1] == ':'
703 && dst
[slen
- 2] != ':' /* skip decnet nodes */
704 && strcmp (src
+ slen
, "[000000]") == 0)
706 dst
[slen
- 1] = '\0';
707 if ((ptr
= egetenv (dst
))
708 && (rlen
= strlen (ptr
) - 1) > 0
709 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
710 && ptr
[rlen
- 1] == '.')
712 char * buf
= (char *) alloca (strlen (ptr
) + 1);
716 return directory_file_name (buf
, dst
);
721 strcat (dst
, "[000000]");
725 rlen
= strlen (rptr
) - 1;
726 strncat (dst
, rptr
, rlen
);
727 dst
[slen
+ rlen
] = '\0';
728 strcat (dst
, ".DIR.1");
732 /* Process as Unix format: just remove any final slash.
733 But leave "/" unchanged; do not change it to "". */
736 /* Handle // as root for apollo's. */
737 if ((slen
> 2 && dst
[slen
- 1] == '/')
738 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
742 && IS_DIRECTORY_SEP (dst
[slen
- 1])
744 && !IS_ANY_SEP (dst
[slen
- 2])
750 CORRECT_DIR_SEPS (dst
);
755 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
757 "Returns the file name of the directory named DIRECTORY.\n\
758 This is the name of the file that holds the data for the directory DIRECTORY.\n\
759 This operation exists because a directory is also a file, but its name as\n\
760 a directory is different from its name as a file.\n\
761 In Unix-syntax, this function just removes the final slash.\n\
762 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
763 it returns a file name such as \"[X]Y.DIR.1\".")
765 Lisp_Object directory
;
770 CHECK_STRING (directory
, 0);
772 if (NILP (directory
))
775 /* If the file name has special constructs in it,
776 call the corresponding file handler. */
777 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
779 return call2 (handler
, Qdirectory_file_name
, directory
);
782 /* 20 extra chars is insufficient for VMS, since we might perform a
783 logical name translation. an equivalence string can be up to 255
784 chars long, so grab that much extra space... - sss */
785 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20 + 255);
787 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20);
789 directory_file_name (XSTRING (directory
)->data
, buf
);
790 return build_string (buf
);
793 static char make_temp_name_tbl
[64] =
795 'A','B','C','D','E','F','G','H',
796 'I','J','K','L','M','N','O','P',
797 'Q','R','S','T','U','V','W','X',
798 'Y','Z','a','b','c','d','e','f',
799 'g','h','i','j','k','l','m','n',
800 'o','p','q','r','s','t','u','v',
801 'w','x','y','z','0','1','2','3',
802 '4','5','6','7','8','9','-','_'
804 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
806 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
807 "Generate temporary file name (string) starting with PREFIX (a string).\n\
808 The Emacs process number forms part of the result,\n\
809 so there is no danger of generating a name being used by another process.\n\
811 In addition, this function makes an attempt to choose a name\n\
812 which has no existing file. To make this work,\n\
813 PREFIX should be an absolute file name.")
820 unsigned char *p
, *data
;
824 CHECK_STRING (prefix
, 0);
826 /* VAL is created by adding 6 characters to PREFIX. The first
827 three are the PID of this process, in base 64, and the second
828 three are incremented if the file already exists. This ensures
829 262144 unique file names per PID per PREFIX. */
831 pid
= (int) getpid ();
833 #ifdef HAVE_LONG_FILE_NAMES
834 sprintf (pidbuf
, "%d", pid
);
835 pidlen
= strlen (pidbuf
);
837 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
838 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
839 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
843 len
= XSTRING (prefix
)->size
;
844 val
= make_uninit_string (len
+ 3 + pidlen
);
845 data
= XSTRING (val
)->data
;
846 bcopy(XSTRING (prefix
)->data
, data
, len
);
849 bcopy (pidbuf
, p
, pidlen
);
852 /* Here we try to minimize useless stat'ing when this function is
853 invoked many times successively with the same PREFIX. We achieve
854 this by initializing count to a random value, and incrementing it
857 We don't want make-temp-name to be called while dumping,
858 because then make_temp_name_count_initialized_p would get set
859 and then make_temp_name_count would not be set when Emacs starts. */
861 if (!make_temp_name_count_initialized_p
)
863 make_temp_name_count
= (unsigned) time (NULL
);
864 make_temp_name_count_initialized_p
= 1;
870 unsigned num
= make_temp_name_count
;
872 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
873 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
874 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
876 /* Poor man's congruential RN generator. Replace with
877 ++make_temp_name_count for debugging. */
878 make_temp_name_count
+= 25229;
879 make_temp_name_count
%= 225307;
881 if (stat (data
, &ignored
) < 0)
883 /* We want to return only if errno is ENOENT. */
887 /* The error here is dubious, but there is little else we
888 can do. The alternatives are to return nil, which is
889 as bad as (and in many cases worse than) throwing the
890 error, or to ignore the error, which will likely result
891 in looping through 225307 stat's, which is not only
892 dog-slow, but also useless since it will fallback to
893 the errow below, anyway. */
894 report_file_error ("Cannot create temporary name for prefix `%s'",
895 Fcons (prefix
, Qnil
));
900 error ("Cannot create temporary name for prefix `%s'",
901 XSTRING (prefix
)->data
);
906 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
907 "Convert filename NAME to absolute, and canonicalize it.\n\
908 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
909 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
910 the current buffer's value of default-directory is used.\n\
911 File name components that are `.' are removed, and \n\
912 so are file name components followed by `..', along with the `..' itself;\n\
913 note that these simplifications are done without checking the resulting\n\
914 file names in the file system.\n\
915 An initial `~/' expands to your home directory.\n\
916 An initial `~USER/' expands to USER's home directory.\n\
917 See also the function `substitute-in-file-name'.")
918 (name
, default_directory
)
919 Lisp_Object name
, default_directory
;
923 register unsigned char *newdir
, *p
, *o
;
925 unsigned char *target
;
928 unsigned char * colon
= 0;
929 unsigned char * close
= 0;
930 unsigned char * slash
= 0;
931 unsigned char * brack
= 0;
932 int lbrack
= 0, rbrack
= 0;
937 int collapse_newdir
= 1;
943 CHECK_STRING (name
, 0);
945 /* If the file name has special constructs in it,
946 call the corresponding file handler. */
947 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
949 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
951 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
952 if (NILP (default_directory
))
953 default_directory
= current_buffer
->directory
;
954 if (! STRINGP (default_directory
))
955 default_directory
= build_string ("/");
957 if (!NILP (default_directory
))
959 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
961 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
964 o
= XSTRING (default_directory
)->data
;
966 /* Make sure DEFAULT_DIRECTORY is properly expanded.
967 It would be better to do this down below where we actually use
968 default_directory. Unfortunately, calling Fexpand_file_name recursively
969 could invoke GC, and the strings might be relocated. This would
970 be annoying because we have pointers into strings lying around
971 that would need adjusting, and people would add new pointers to
972 the code and forget to adjust them, resulting in intermittent bugs.
973 Putting this call here avoids all that crud.
975 The EQ test avoids infinite recursion. */
976 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
977 /* Save time in some common cases - as long as default_directory
978 is not relative, it can be canonicalized with name below (if it
979 is needed at all) without requiring it to be expanded now. */
981 /* Detect MSDOS file names with drive specifiers. */
982 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
984 /* Detect Windows file names in UNC format. */
985 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
987 #else /* not DOS_NT */
988 /* Detect Unix absolute file names (/... alone is not absolute on
990 && ! (IS_DIRECTORY_SEP (o
[0]))
991 #endif /* not DOS_NT */
997 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1002 /* Filenames on VMS are always upper case. */
1003 name
= Fupcase (name
);
1005 #ifdef FILE_SYSTEM_CASE
1006 name
= FILE_SYSTEM_CASE (name
);
1009 nm
= XSTRING (name
)->data
;
1012 /* We will force directory separators to be either all \ or /, so make
1013 a local copy to modify, even if there ends up being no change. */
1014 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1016 /* Note if special escape prefix is present, but remove for now. */
1017 if (nm
[0] == '/' && nm
[1] == ':')
1023 /* Find and remove drive specifier if present; this makes nm absolute
1024 even if the rest of the name appears to be relative. Only look for
1025 drive specifier at the beginning. */
1026 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1033 /* If we see "c://somedir", we want to strip the first slash after the
1034 colon when stripping the drive letter. Otherwise, this expands to
1036 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1038 #endif /* WINDOWSNT */
1042 /* Discard any previous drive specifier if nm is now in UNC format. */
1043 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1049 /* If nm is absolute, look for /./ or /../ sequences; if none are
1050 found, we can probably return right away. We will avoid allocating
1051 a new string if name is already fully expanded. */
1053 IS_DIRECTORY_SEP (nm
[0])
1055 && drive
&& !is_escaped
1058 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1065 /* If it turns out that the filename we want to return is just a
1066 suffix of FILENAME, we don't need to go through and edit
1067 things; we just need to construct a new string using data
1068 starting at the middle of FILENAME. If we set lose to a
1069 non-zero value, that means we've discovered that we can't do
1076 /* Since we know the name is absolute, we can assume that each
1077 element starts with a "/". */
1079 /* "." and ".." are hairy. */
1080 if (IS_DIRECTORY_SEP (p
[0])
1082 && (IS_DIRECTORY_SEP (p
[2])
1084 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1091 /* if dev:[dir]/, move nm to / */
1092 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1093 nm
= (brack
? brack
+ 1 : colon
+ 1);
1094 lbrack
= rbrack
= 0;
1102 /* VMS pre V4.4,convert '-'s in filenames. */
1103 if (lbrack
== rbrack
)
1105 if (dots
< 2) /* this is to allow negative version numbers */
1110 if (lbrack
> rbrack
&&
1111 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1112 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1118 /* count open brackets, reset close bracket pointer */
1119 if (p
[0] == '[' || p
[0] == '<')
1120 lbrack
++, brack
= 0;
1121 /* count close brackets, set close bracket pointer */
1122 if (p
[0] == ']' || p
[0] == '>')
1123 rbrack
++, brack
= p
;
1124 /* detect ][ or >< */
1125 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1127 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1128 nm
= p
+ 1, lose
= 1;
1129 if (p
[0] == ':' && (colon
|| slash
))
1130 /* if dev1:[dir]dev2:, move nm to dev2: */
1136 /* if /name/dev:, move nm to dev: */
1139 /* if node::dev:, move colon following dev */
1140 else if (colon
&& colon
[-1] == ':')
1142 /* if dev1:dev2:, move nm to dev2: */
1143 else if (colon
&& colon
[-1] != ':')
1148 if (p
[0] == ':' && !colon
)
1154 if (lbrack
== rbrack
)
1157 else if (p
[0] == '.')
1165 if (index (nm
, '/'))
1166 return build_string (sys_translate_unix (nm
));
1169 /* Make sure directories are all separated with / or \ as
1170 desired, but avoid allocation of a new string when not
1172 CORRECT_DIR_SEPS (nm
);
1174 if (IS_DIRECTORY_SEP (nm
[1]))
1176 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1177 name
= build_string (nm
);
1181 /* drive must be set, so this is okay */
1182 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1184 name
= make_string (nm
- 2, p
- nm
+ 2);
1185 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1186 XSTRING (name
)->data
[1] = ':';
1189 #else /* not DOS_NT */
1190 if (nm
== XSTRING (name
)->data
)
1192 return build_string (nm
);
1193 #endif /* not DOS_NT */
1197 /* At this point, nm might or might not be an absolute file name. We
1198 need to expand ~ or ~user if present, otherwise prefix nm with
1199 default_directory if nm is not absolute, and finally collapse /./
1200 and /foo/../ sequences.
1202 We set newdir to be the appropriate prefix if one is needed:
1203 - the relevant user directory if nm starts with ~ or ~user
1204 - the specified drive's working dir (DOS/NT only) if nm does not
1206 - the value of default_directory.
1208 Note that these prefixes are not guaranteed to be absolute (except
1209 for the working dir of a drive). Therefore, to ensure we always
1210 return an absolute name, if the final prefix is not absolute we
1211 append it to the current working directory. */
1215 if (nm
[0] == '~') /* prefix ~ */
1217 if (IS_DIRECTORY_SEP (nm
[1])
1221 || nm
[1] == 0) /* ~ by itself */
1223 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1224 newdir
= (unsigned char *) "";
1227 collapse_newdir
= 0;
1230 nm
++; /* Don't leave the slash in nm. */
1233 else /* ~user/filename */
1235 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1240 o
= (unsigned char *) alloca (p
- nm
+ 1);
1241 bcopy ((char *) nm
, o
, p
- nm
);
1244 pw
= (struct passwd
*) getpwnam (o
+ 1);
1247 newdir
= (unsigned char *) pw
-> pw_dir
;
1249 nm
= p
+ 1; /* skip the terminator */
1253 collapse_newdir
= 0;
1258 /* If we don't find a user of that name, leave the name
1259 unchanged; don't move nm forward to p. */
1264 /* On DOS and Windows, nm is absolute if a drive name was specified;
1265 use the drive's current directory as the prefix if needed. */
1266 if (!newdir
&& drive
)
1268 /* Get default directory if needed to make nm absolute. */
1269 if (!IS_DIRECTORY_SEP (nm
[0]))
1271 newdir
= alloca (MAXPATHLEN
+ 1);
1272 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1277 /* Either nm starts with /, or drive isn't mounted. */
1278 newdir
= alloca (4);
1279 newdir
[0] = DRIVE_LETTER (drive
);
1287 /* Finally, if no prefix has been specified and nm is not absolute,
1288 then it must be expanded relative to default_directory. */
1292 /* /... alone is not absolute on DOS and Windows. */
1293 && !IS_DIRECTORY_SEP (nm
[0])
1296 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1303 newdir
= XSTRING (default_directory
)->data
;
1305 /* Note if special escape prefix is present, but remove for now. */
1306 if (newdir
[0] == '/' && newdir
[1] == ':')
1317 /* First ensure newdir is an absolute name. */
1319 /* Detect MSDOS file names with drive specifiers. */
1320 ! (IS_DRIVE (newdir
[0])
1321 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1323 /* Detect Windows file names in UNC format. */
1324 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1328 /* Effectively, let newdir be (expand-file-name newdir cwd).
1329 Because of the admonition against calling expand-file-name
1330 when we have pointers into lisp strings, we accomplish this
1331 indirectly by prepending newdir to nm if necessary, and using
1332 cwd (or the wd of newdir's drive) as the new newdir. */
1334 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1339 if (!IS_DIRECTORY_SEP (nm
[0]))
1341 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1342 file_name_as_directory (tmp
, newdir
);
1346 newdir
= alloca (MAXPATHLEN
+ 1);
1349 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1356 /* Strip off drive name from prefix, if present. */
1357 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1363 /* Keep only a prefix from newdir if nm starts with slash
1364 (//server/share for UNC, nothing otherwise). */
1365 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1368 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1370 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1372 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1374 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1386 /* Get rid of any slash at the end of newdir, unless newdir is
1387 just / or // (an incomplete UNC name). */
1388 length
= strlen (newdir
);
1389 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1391 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1395 unsigned char *temp
= (unsigned char *) alloca (length
);
1396 bcopy (newdir
, temp
, length
- 1);
1397 temp
[length
- 1] = 0;
1405 /* Now concatenate the directory and name to new space in the stack frame */
1406 tlen
+= strlen (nm
) + 1;
1408 /* Reserve space for drive specifier and escape prefix, since either
1409 or both may need to be inserted. (The Microsoft x86 compiler
1410 produces incorrect code if the following two lines are combined.) */
1411 target
= (unsigned char *) alloca (tlen
+ 4);
1413 #else /* not DOS_NT */
1414 target
= (unsigned char *) alloca (tlen
);
1415 #endif /* not DOS_NT */
1421 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1422 strcpy (target
, newdir
);
1425 file_name_as_directory (target
, newdir
);
1428 strcat (target
, nm
);
1430 if (index (target
, '/'))
1431 strcpy (target
, sys_translate_unix (target
));
1434 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1436 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1444 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1450 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1451 /* brackets are offset from each other by 2 */
1454 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1455 /* convert [foo][bar] to [bar] */
1456 while (o
[-1] != '[' && o
[-1] != '<')
1458 else if (*p
== '-' && *o
!= '.')
1461 else if (p
[0] == '-' && o
[-1] == '.' &&
1462 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1463 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1467 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1468 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1470 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1472 /* else [foo.-] ==> [-] */
1478 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1479 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1485 if (!IS_DIRECTORY_SEP (*p
))
1489 else if (IS_DIRECTORY_SEP (p
[0])
1491 && (IS_DIRECTORY_SEP (p
[2])
1494 /* If "/." is the entire filename, keep the "/". Otherwise,
1495 just delete the whole "/.". */
1496 if (o
== target
&& p
[2] == '\0')
1500 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1501 /* `/../' is the "superroot" on certain file systems. */
1503 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1505 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1507 /* Keep initial / only if this is the whole name. */
1508 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1516 #endif /* not VMS */
1520 /* At last, set drive name. */
1522 /* Except for network file name. */
1523 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1524 #endif /* WINDOWSNT */
1526 if (!drive
) abort ();
1528 target
[0] = DRIVE_LETTER (drive
);
1531 /* Reinsert the escape prefix if required. */
1538 CORRECT_DIR_SEPS (target
);
1541 return make_string (target
, o
- target
);
1545 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1546 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1547 "Convert FILENAME to absolute, and canonicalize it.\n\
1548 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1549 (does not start with slash); if DEFAULT is nil or missing,\n\
1550 the current buffer's value of default-directory is used.\n\
1551 Filenames containing `.' or `..' as components are simplified;\n\
1552 initial `~/' expands to your home directory.\n\
1553 See also the function `substitute-in-file-name'.")
1555 Lisp_Object name
, defalt
;
1559 register unsigned char *newdir
, *p
, *o
;
1561 unsigned char *target
;
1565 unsigned char * colon
= 0;
1566 unsigned char * close
= 0;
1567 unsigned char * slash
= 0;
1568 unsigned char * brack
= 0;
1569 int lbrack
= 0, rbrack
= 0;
1573 CHECK_STRING (name
, 0);
1576 /* Filenames on VMS are always upper case. */
1577 name
= Fupcase (name
);
1580 nm
= XSTRING (name
)->data
;
1582 /* If nm is absolute, flush ...// and detect /./ and /../.
1583 If no /./ or /../ we can return right away. */
1595 if (p
[0] == '/' && p
[1] == '/'
1597 /* // at start of filename is meaningful on Apollo system. */
1602 if (p
[0] == '/' && p
[1] == '~')
1603 nm
= p
+ 1, lose
= 1;
1604 if (p
[0] == '/' && p
[1] == '.'
1605 && (p
[2] == '/' || p
[2] == 0
1606 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1612 /* if dev:[dir]/, move nm to / */
1613 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1614 nm
= (brack
? brack
+ 1 : colon
+ 1);
1615 lbrack
= rbrack
= 0;
1623 /* VMS pre V4.4,convert '-'s in filenames. */
1624 if (lbrack
== rbrack
)
1626 if (dots
< 2) /* this is to allow negative version numbers */
1631 if (lbrack
> rbrack
&&
1632 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1633 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1639 /* count open brackets, reset close bracket pointer */
1640 if (p
[0] == '[' || p
[0] == '<')
1641 lbrack
++, brack
= 0;
1642 /* count close brackets, set close bracket pointer */
1643 if (p
[0] == ']' || p
[0] == '>')
1644 rbrack
++, brack
= p
;
1645 /* detect ][ or >< */
1646 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1648 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1649 nm
= p
+ 1, lose
= 1;
1650 if (p
[0] == ':' && (colon
|| slash
))
1651 /* if dev1:[dir]dev2:, move nm to dev2: */
1657 /* If /name/dev:, move nm to dev: */
1660 /* If node::dev:, move colon following dev */
1661 else if (colon
&& colon
[-1] == ':')
1663 /* If dev1:dev2:, move nm to dev2: */
1664 else if (colon
&& colon
[-1] != ':')
1669 if (p
[0] == ':' && !colon
)
1675 if (lbrack
== rbrack
)
1678 else if (p
[0] == '.')
1686 if (index (nm
, '/'))
1687 return build_string (sys_translate_unix (nm
));
1689 if (nm
== XSTRING (name
)->data
)
1691 return build_string (nm
);
1695 /* Now determine directory to start with and put it in NEWDIR */
1699 if (nm
[0] == '~') /* prefix ~ */
1704 || nm
[1] == 0)/* ~/filename */
1706 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1707 newdir
= (unsigned char *) "";
1710 nm
++; /* Don't leave the slash in nm. */
1713 else /* ~user/filename */
1715 /* Get past ~ to user */
1716 unsigned char *user
= nm
+ 1;
1717 /* Find end of name. */
1718 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1719 int len
= ptr
? ptr
- user
: strlen (user
);
1721 unsigned char *ptr1
= index (user
, ':');
1722 if (ptr1
!= 0 && ptr1
- user
< len
)
1725 /* Copy the user name into temp storage. */
1726 o
= (unsigned char *) alloca (len
+ 1);
1727 bcopy ((char *) user
, o
, len
);
1730 /* Look up the user name. */
1731 pw
= (struct passwd
*) getpwnam (o
+ 1);
1733 error ("\"%s\" isn't a registered user", o
+ 1);
1735 newdir
= (unsigned char *) pw
->pw_dir
;
1737 /* Discard the user name from NM. */
1744 #endif /* not VMS */
1748 defalt
= current_buffer
->directory
;
1749 CHECK_STRING (defalt
, 1);
1750 newdir
= XSTRING (defalt
)->data
;
1753 /* Now concatenate the directory and name to new space in the stack frame */
1755 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1756 target
= (unsigned char *) alloca (tlen
);
1762 if (nm
[0] == 0 || nm
[0] == '/')
1763 strcpy (target
, newdir
);
1766 file_name_as_directory (target
, newdir
);
1769 strcat (target
, nm
);
1771 if (index (target
, '/'))
1772 strcpy (target
, sys_translate_unix (target
));
1775 /* Now canonicalize by removing /. and /foo/.. if they appear */
1783 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1789 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1790 /* brackets are offset from each other by 2 */
1793 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1794 /* convert [foo][bar] to [bar] */
1795 while (o
[-1] != '[' && o
[-1] != '<')
1797 else if (*p
== '-' && *o
!= '.')
1800 else if (p
[0] == '-' && o
[-1] == '.' &&
1801 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1802 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1806 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1807 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1809 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1811 /* else [foo.-] ==> [-] */
1817 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1818 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1828 else if (!strncmp (p
, "//", 2)
1830 /* // at start of filename is meaningful in Apollo system. */
1838 else if (p
[0] == '/' && p
[1] == '.' &&
1839 (p
[2] == '/' || p
[2] == 0))
1841 else if (!strncmp (p
, "/..", 3)
1842 /* `/../' is the "superroot" on certain file systems. */
1844 && (p
[3] == '/' || p
[3] == 0))
1846 while (o
!= target
&& *--o
!= '/')
1849 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1853 if (o
== target
&& *o
== '/')
1861 #endif /* not VMS */
1864 return make_string (target
, o
- target
);
1868 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1869 Ssubstitute_in_file_name
, 1, 1, 0,
1870 "Substitute environment variables referred to in FILENAME.\n\
1871 `$FOO' where FOO is an environment variable name means to substitute\n\
1872 the value of that variable. The variable name should be terminated\n\
1873 with a character not a letter, digit or underscore; otherwise, enclose\n\
1874 the entire variable name in braces.\n\
1875 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1876 On VMS, `$' substitution is not done; this function does little and only\n\
1877 duplicates what `expand-file-name' does.")
1879 Lisp_Object filename
;
1883 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1884 unsigned char *target
;
1886 int substituted
= 0;
1888 Lisp_Object handler
;
1890 CHECK_STRING (filename
, 0);
1892 /* If the file name has special constructs in it,
1893 call the corresponding file handler. */
1894 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1895 if (!NILP (handler
))
1896 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1898 nm
= XSTRING (filename
)->data
;
1900 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1901 CORRECT_DIR_SEPS (nm
);
1902 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1904 endp
= nm
+ STRING_BYTES (XSTRING (filename
));
1906 /* If /~ or // appears, discard everything through first slash. */
1908 for (p
= nm
; p
!= endp
; p
++)
1911 #if defined (APOLLO) || defined (WINDOWSNT)
1912 /* // at start of file name is meaningful in Apollo and
1913 WindowsNT systems. */
1914 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1915 #else /* not (APOLLO || WINDOWSNT) */
1916 || IS_DIRECTORY_SEP (p
[0])
1917 #endif /* not (APOLLO || WINDOWSNT) */
1922 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1924 || IS_DIRECTORY_SEP (p
[-1])))
1930 /* see comment in expand-file-name about drive specifiers */
1931 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1932 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1941 return build_string (nm
);
1944 /* See if any variables are substituted into the string
1945 and find the total length of their values in `total' */
1947 for (p
= nm
; p
!= endp
;)
1957 /* "$$" means a single "$" */
1966 while (p
!= endp
&& *p
!= '}') p
++;
1967 if (*p
!= '}') goto missingclose
;
1973 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1977 /* Copy out the variable name */
1978 target
= (unsigned char *) alloca (s
- o
+ 1);
1979 strncpy (target
, o
, s
- o
);
1982 strupr (target
); /* $home == $HOME etc. */
1985 /* Get variable value */
1986 o
= (unsigned char *) egetenv (target
);
1987 if (!o
) goto badvar
;
1988 total
+= strlen (o
);
1995 /* If substitution required, recopy the string and do it */
1996 /* Make space in stack frame for the new copy */
1997 xnm
= (unsigned char *) alloca (STRING_BYTES (XSTRING (filename
)) + total
+ 1);
2000 /* Copy the rest of the name through, replacing $ constructs with values */
2017 while (p
!= endp
&& *p
!= '}') p
++;
2018 if (*p
!= '}') goto missingclose
;
2024 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2028 /* Copy out the variable name */
2029 target
= (unsigned char *) alloca (s
- o
+ 1);
2030 strncpy (target
, o
, s
- o
);
2033 strupr (target
); /* $home == $HOME etc. */
2036 /* Get variable value */
2037 o
= (unsigned char *) egetenv (target
);
2041 if (STRING_MULTIBYTE (filename
))
2043 /* If the original string is multibyte,
2044 convert what we substitute into multibyte. */
2045 unsigned char workbuf
[4], *str
;
2051 c
= unibyte_char_to_multibyte (c
);
2052 if (! SINGLE_BYTE_CHAR_P (c
))
2054 len
= CHAR_STRING (c
, workbuf
, str
);
2055 bcopy (str
, x
, len
);
2071 /* If /~ or // appears, discard everything through first slash. */
2073 for (p
= xnm
; p
!= x
; p
++)
2075 #if defined (APOLLO) || defined (WINDOWSNT)
2076 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2077 #else /* not (APOLLO || WINDOWSNT) */
2078 || IS_DIRECTORY_SEP (p
[0])
2079 #endif /* not (APOLLO || WINDOWSNT) */
2081 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2084 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2085 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2089 if (STRING_MULTIBYTE (filename
))
2090 return make_string (xnm
, x
- xnm
);
2091 return make_unibyte_string (xnm
, x
- xnm
);
2094 error ("Bad format environment-variable substitution");
2096 error ("Missing \"}\" in environment-variable substitution");
2098 error ("Substituting nonexistent environment variable \"%s\"", target
);
2101 #endif /* not VMS */
2104 /* A slightly faster and more convenient way to get
2105 (directory-file-name (expand-file-name FOO)). */
2108 expand_and_dir_to_file (filename
, defdir
)
2109 Lisp_Object filename
, defdir
;
2111 register Lisp_Object absname
;
2113 absname
= Fexpand_file_name (filename
, defdir
);
2116 register int c
= XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1];
2117 if (c
== ':' || c
== ']' || c
== '>')
2118 absname
= Fdirectory_file_name (absname
);
2121 /* Remove final slash, if any (unless this is the root dir).
2122 stat behaves differently depending! */
2123 if (XSTRING (absname
)->size
> 1
2124 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1])
2125 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
))-2]))
2126 /* We cannot take shortcuts; they might be wrong for magic file names. */
2127 absname
= Fdirectory_file_name (absname
);
2132 /* Signal an error if the file ABSNAME already exists.
2133 If INTERACTIVE is nonzero, ask the user whether to proceed,
2134 and bypass the error if the user says to go ahead.
2135 QUERYSTRING is a name for the action that is being considered
2138 *STATPTR is used to store the stat information if the file exists.
2139 If the file does not exist, STATPTR->st_mode is set to 0.
2140 If STATPTR is null, we don't store into it.
2142 If QUICK is nonzero, we ask for y or n, not yes or no. */
2145 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2146 Lisp_Object absname
;
2147 unsigned char *querystring
;
2149 struct stat
*statptr
;
2152 register Lisp_Object tem
, encoded_filename
;
2153 struct stat statbuf
;
2154 struct gcpro gcpro1
;
2156 encoded_filename
= ENCODE_FILE (absname
);
2158 /* stat is a good way to tell whether the file exists,
2159 regardless of what access permissions it has. */
2160 if (stat (XSTRING (encoded_filename
)->data
, &statbuf
) >= 0)
2163 Fsignal (Qfile_already_exists
,
2164 Fcons (build_string ("File already exists"),
2165 Fcons (absname
, Qnil
)));
2167 tem
= format1 ("File %s already exists; %s anyway? ",
2168 XSTRING (absname
)->data
, querystring
);
2170 tem
= Fy_or_n_p (tem
);
2172 tem
= do_yes_or_no_p (tem
);
2175 Fsignal (Qfile_already_exists
,
2176 Fcons (build_string ("File already exists"),
2177 Fcons (absname
, Qnil
)));
2184 statptr
->st_mode
= 0;
2189 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2190 "fCopy file: \nFCopy %s to file: \np\nP",
2191 "Copy FILE to NEWNAME. Both args must be strings.\n\
2192 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2193 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2194 A number as third arg means request confirmation if NEWNAME already exists.\n\
2195 This is what happens in interactive use with M-x.\n\
2196 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2197 last-modified time as the old one. (This works on only some systems.)\n\
2198 A prefix arg makes KEEP-TIME non-nil.")
2199 (file
, newname
, ok_if_already_exists
, keep_date
)
2200 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2203 char buf
[16 * 1024];
2204 struct stat st
, out_st
;
2205 Lisp_Object handler
;
2206 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2207 int count
= specpdl_ptr
- specpdl
;
2208 int input_file_statable_p
;
2209 Lisp_Object encoded_file
, encoded_newname
;
2211 encoded_file
= encoded_newname
= Qnil
;
2212 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2213 CHECK_STRING (file
, 0);
2214 CHECK_STRING (newname
, 1);
2216 file
= Fexpand_file_name (file
, Qnil
);
2217 newname
= Fexpand_file_name (newname
, Qnil
);
2219 /* If the input file name has special constructs in it,
2220 call the corresponding file handler. */
2221 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2222 /* Likewise for output file name. */
2224 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2225 if (!NILP (handler
))
2226 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2227 ok_if_already_exists
, keep_date
));
2229 encoded_file
= ENCODE_FILE (file
);
2230 encoded_newname
= ENCODE_FILE (newname
);
2232 if (NILP (ok_if_already_exists
)
2233 || INTEGERP (ok_if_already_exists
))
2234 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2235 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2236 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2239 ifd
= open (XSTRING (encoded_file
)->data
, O_RDONLY
);
2241 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2243 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2245 /* We can only copy regular files and symbolic links. Other files are not
2247 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2249 #if !defined (DOS_NT) || __DJGPP__ > 1
2250 if (out_st
.st_mode
!= 0
2251 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2254 report_file_error ("Input and output files are the same",
2255 Fcons (file
, Fcons (newname
, Qnil
)));
2259 #if defined (S_ISREG) && defined (S_ISLNK)
2260 if (input_file_statable_p
)
2262 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2264 #if defined (EISDIR)
2265 /* Get a better looking error message. */
2268 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2271 #endif /* S_ISREG && S_ISLNK */
2274 /* Create the copy file with the same record format as the input file */
2275 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2278 /* System's default file type was set to binary by _fmode in emacs.c. */
2279 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2280 #else /* not MSDOS */
2281 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2282 #endif /* not MSDOS */
2285 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2287 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2291 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2292 if (write (ofd
, buf
, n
) != n
)
2293 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2296 /* Closing the output clobbers the file times on some systems. */
2297 if (close (ofd
) < 0)
2298 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2300 if (input_file_statable_p
)
2302 if (!NILP (keep_date
))
2304 EMACS_TIME atime
, mtime
;
2305 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2306 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2307 if (set_file_times (XSTRING (encoded_newname
)->data
,
2309 Fsignal (Qfile_date_error
,
2310 Fcons (build_string ("Cannot set file date"),
2311 Fcons (newname
, Qnil
)));
2314 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2316 #if defined (__DJGPP__) && __DJGPP__ > 1
2317 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2318 and if it can't, it tells so. Otherwise, under MSDOS we usually
2319 get only the READ bit, which will make the copied file read-only,
2320 so it's better not to chmod at all. */
2321 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2322 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2323 #endif /* DJGPP version 2 or newer */
2329 /* Discard the unwind protects. */
2330 specpdl_ptr
= specpdl
+ count
;
2336 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2337 Smake_directory_internal
, 1, 1, 0,
2338 "Create a new directory named DIRECTORY.")
2340 Lisp_Object directory
;
2343 Lisp_Object handler
;
2344 Lisp_Object encoded_dir
;
2346 CHECK_STRING (directory
, 0);
2347 directory
= Fexpand_file_name (directory
, Qnil
);
2349 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2350 if (!NILP (handler
))
2351 return call2 (handler
, Qmake_directory_internal
, directory
);
2353 encoded_dir
= ENCODE_FILE (directory
);
2355 dir
= XSTRING (encoded_dir
)->data
;
2358 if (mkdir (dir
) != 0)
2360 if (mkdir (dir
, 0777) != 0)
2362 report_file_error ("Creating directory", Flist (1, &directory
));
2367 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2368 "Delete the directory named DIRECTORY.")
2370 Lisp_Object directory
;
2373 Lisp_Object handler
;
2374 Lisp_Object encoded_dir
;
2376 CHECK_STRING (directory
, 0);
2377 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2379 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2380 if (!NILP (handler
))
2381 return call2 (handler
, Qdelete_directory
, directory
);
2383 encoded_dir
= ENCODE_FILE (directory
);
2385 dir
= XSTRING (encoded_dir
)->data
;
2387 if (rmdir (dir
) != 0)
2388 report_file_error ("Removing directory", Flist (1, &directory
));
2393 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2394 "Delete file named FILENAME.\n\
2395 If file has multiple names, it continues to exist with the other names.")
2397 Lisp_Object filename
;
2399 Lisp_Object handler
;
2400 Lisp_Object encoded_file
;
2402 CHECK_STRING (filename
, 0);
2403 filename
= Fexpand_file_name (filename
, Qnil
);
2405 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2406 if (!NILP (handler
))
2407 return call2 (handler
, Qdelete_file
, filename
);
2409 encoded_file
= ENCODE_FILE (filename
);
2411 if (0 > unlink (XSTRING (encoded_file
)->data
))
2412 report_file_error ("Removing old name", Flist (1, &filename
));
2417 internal_delete_file_1 (ignore
)
2423 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2426 internal_delete_file (filename
)
2427 Lisp_Object filename
;
2429 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2430 Qt
, internal_delete_file_1
));
2433 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2434 "fRename file: \nFRename %s to file: \np",
2435 "Rename FILE as NEWNAME. Both args strings.\n\
2436 If file has names other than FILE, it continues to have those names.\n\
2437 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2438 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2439 A number as third arg means request confirmation if NEWNAME already exists.\n\
2440 This is what happens in interactive use with M-x.")
2441 (file
, newname
, ok_if_already_exists
)
2442 Lisp_Object file
, newname
, ok_if_already_exists
;
2445 Lisp_Object args
[2];
2447 Lisp_Object handler
;
2448 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2449 Lisp_Object encoded_file
, encoded_newname
;
2451 encoded_file
= encoded_newname
= Qnil
;
2452 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2453 CHECK_STRING (file
, 0);
2454 CHECK_STRING (newname
, 1);
2455 file
= Fexpand_file_name (file
, Qnil
);
2456 newname
= Fexpand_file_name (newname
, Qnil
);
2458 /* If the file name has special constructs in it,
2459 call the corresponding file handler. */
2460 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2462 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2463 if (!NILP (handler
))
2464 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2465 file
, newname
, ok_if_already_exists
));
2467 encoded_file
= ENCODE_FILE (file
);
2468 encoded_newname
= ENCODE_FILE (newname
);
2470 if (NILP (ok_if_already_exists
)
2471 || INTEGERP (ok_if_already_exists
))
2472 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2473 INTEGERP (ok_if_already_exists
), 0, 0);
2475 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2477 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2478 || 0 > unlink (XSTRING (encoded_file
)->data
))
2483 Fcopy_file (file
, newname
,
2484 /* We have already prompted if it was an integer,
2485 so don't have copy-file prompt again. */
2486 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2487 Fdelete_file (file
);
2494 report_file_error ("Renaming", Flist (2, args
));
2497 report_file_error ("Renaming", Flist (2, &file
));
2504 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2505 "fAdd name to file: \nFName to add to %s: \np",
2506 "Give FILE additional name NEWNAME. Both args strings.\n\
2507 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2508 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2509 A number as third arg means request confirmation if NEWNAME already exists.\n\
2510 This is what happens in interactive use with M-x.")
2511 (file
, newname
, ok_if_already_exists
)
2512 Lisp_Object file
, newname
, ok_if_already_exists
;
2515 Lisp_Object args
[2];
2517 Lisp_Object handler
;
2518 Lisp_Object encoded_file
, encoded_newname
;
2519 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2521 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2522 encoded_file
= encoded_newname
= Qnil
;
2523 CHECK_STRING (file
, 0);
2524 CHECK_STRING (newname
, 1);
2525 file
= Fexpand_file_name (file
, Qnil
);
2526 newname
= Fexpand_file_name (newname
, Qnil
);
2528 /* If the file name has special constructs in it,
2529 call the corresponding file handler. */
2530 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2531 if (!NILP (handler
))
2532 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2533 newname
, ok_if_already_exists
));
2535 /* If the new name has special constructs in it,
2536 call the corresponding file handler. */
2537 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2538 if (!NILP (handler
))
2539 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2540 newname
, ok_if_already_exists
));
2542 encoded_file
= ENCODE_FILE (file
);
2543 encoded_newname
= ENCODE_FILE (newname
);
2545 if (NILP (ok_if_already_exists
)
2546 || INTEGERP (ok_if_already_exists
))
2547 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2548 INTEGERP (ok_if_already_exists
), 0, 0);
2550 unlink (XSTRING (newname
)->data
);
2551 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2556 report_file_error ("Adding new name", Flist (2, args
));
2558 report_file_error ("Adding new name", Flist (2, &file
));
2567 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2568 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2569 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2570 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2571 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2572 A number as third arg means request confirmation if LINKNAME already exists.\n\
2573 This happens for interactive use with M-x.")
2574 (filename
, linkname
, ok_if_already_exists
)
2575 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2578 Lisp_Object args
[2];
2580 Lisp_Object handler
;
2581 Lisp_Object encoded_filename
, encoded_linkname
;
2582 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2584 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2585 encoded_filename
= encoded_linkname
= Qnil
;
2586 CHECK_STRING (filename
, 0);
2587 CHECK_STRING (linkname
, 1);
2588 /* If the link target has a ~, we must expand it to get
2589 a truly valid file name. Otherwise, do not expand;
2590 we want to permit links to relative file names. */
2591 if (XSTRING (filename
)->data
[0] == '~')
2592 filename
= Fexpand_file_name (filename
, Qnil
);
2593 linkname
= Fexpand_file_name (linkname
, Qnil
);
2595 /* If the file name has special constructs in it,
2596 call the corresponding file handler. */
2597 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2598 if (!NILP (handler
))
2599 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2600 linkname
, ok_if_already_exists
));
2602 /* If the new link name has special constructs in it,
2603 call the corresponding file handler. */
2604 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2605 if (!NILP (handler
))
2606 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2607 linkname
, ok_if_already_exists
));
2609 encoded_filename
= ENCODE_FILE (filename
);
2610 encoded_linkname
= ENCODE_FILE (linkname
);
2612 if (NILP (ok_if_already_exists
)
2613 || INTEGERP (ok_if_already_exists
))
2614 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2615 INTEGERP (ok_if_already_exists
), 0, 0);
2616 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2617 XSTRING (encoded_linkname
)->data
))
2619 /* If we didn't complain already, silently delete existing file. */
2620 if (errno
== EEXIST
)
2622 unlink (XSTRING (encoded_linkname
)->data
);
2623 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2624 XSTRING (encoded_linkname
)->data
))
2634 report_file_error ("Making symbolic link", Flist (2, args
));
2636 report_file_error ("Making symbolic link", Flist (2, &filename
));
2642 #endif /* S_IFLNK */
2646 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2647 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2648 "Define the job-wide logical name NAME to have the value STRING.\n\
2649 If STRING is nil or a null string, the logical name NAME is deleted.")
2654 CHECK_STRING (name
, 0);
2656 delete_logical_name (XSTRING (name
)->data
);
2659 CHECK_STRING (string
, 1);
2661 if (XSTRING (string
)->size
== 0)
2662 delete_logical_name (XSTRING (name
)->data
);
2664 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2673 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2674 "Open a network connection to PATH using LOGIN as the login string.")
2676 Lisp_Object path
, login
;
2680 CHECK_STRING (path
, 0);
2681 CHECK_STRING (login
, 0);
2683 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2685 if (netresult
== -1)
2690 #endif /* HPUX_NET */
2692 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2694 "Return t if file FILENAME specifies an absolute file name.\n\
2695 On Unix, this is a name starting with a `/' or a `~'.")
2697 Lisp_Object filename
;
2701 CHECK_STRING (filename
, 0);
2702 ptr
= XSTRING (filename
)->data
;
2703 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2705 /* ??? This criterion is probably wrong for '<'. */
2706 || index (ptr
, ':') || index (ptr
, '<')
2707 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2711 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2719 /* Return nonzero if file FILENAME exists and can be executed. */
2722 check_executable (filename
)
2726 int len
= strlen (filename
);
2729 if (stat (filename
, &st
) < 0)
2731 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2732 return ((st
.st_mode
& S_IEXEC
) != 0);
2734 return (S_ISREG (st
.st_mode
)
2736 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2737 || stricmp (suffix
, ".exe") == 0
2738 || stricmp (suffix
, ".bat") == 0)
2739 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2740 #endif /* not WINDOWSNT */
2741 #else /* not DOS_NT */
2742 #ifdef HAVE_EUIDACCESS
2743 return (euidaccess (filename
, 1) >= 0);
2745 /* Access isn't quite right because it uses the real uid
2746 and we really want to test with the effective uid.
2747 But Unix doesn't give us a right way to do it. */
2748 return (access (filename
, 1) >= 0);
2750 #endif /* not DOS_NT */
2753 /* Return nonzero if file FILENAME exists and can be written. */
2756 check_writable (filename
)
2761 if (stat (filename
, &st
) < 0)
2763 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2764 #else /* not MSDOS */
2765 #ifdef HAVE_EUIDACCESS
2766 return (euidaccess (filename
, 2) >= 0);
2768 /* Access isn't quite right because it uses the real uid
2769 and we really want to test with the effective uid.
2770 But Unix doesn't give us a right way to do it.
2771 Opening with O_WRONLY could work for an ordinary file,
2772 but would lose for directories. */
2773 return (access (filename
, 2) >= 0);
2775 #endif /* not MSDOS */
2778 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2779 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2780 See also `file-readable-p' and `file-attributes'.")
2782 Lisp_Object filename
;
2784 Lisp_Object absname
;
2785 Lisp_Object handler
;
2786 struct stat statbuf
;
2788 CHECK_STRING (filename
, 0);
2789 absname
= Fexpand_file_name (filename
, Qnil
);
2791 /* If the file name has special constructs in it,
2792 call the corresponding file handler. */
2793 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2794 if (!NILP (handler
))
2795 return call2 (handler
, Qfile_exists_p
, absname
);
2797 absname
= ENCODE_FILE (absname
);
2799 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2802 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2803 "Return t if FILENAME can be executed by you.\n\
2804 For a directory, this means you can access files in that directory.")
2806 Lisp_Object filename
;
2809 Lisp_Object absname
;
2810 Lisp_Object handler
;
2812 CHECK_STRING (filename
, 0);
2813 absname
= Fexpand_file_name (filename
, Qnil
);
2815 /* If the file name has special constructs in it,
2816 call the corresponding file handler. */
2817 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2818 if (!NILP (handler
))
2819 return call2 (handler
, Qfile_executable_p
, absname
);
2821 absname
= ENCODE_FILE (absname
);
2823 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2826 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2827 "Return t if file FILENAME exists and you can read it.\n\
2828 See also `file-exists-p' and `file-attributes'.")
2830 Lisp_Object filename
;
2832 Lisp_Object absname
;
2833 Lisp_Object handler
;
2836 struct stat statbuf
;
2838 CHECK_STRING (filename
, 0);
2839 absname
= Fexpand_file_name (filename
, Qnil
);
2841 /* If the file name has special constructs in it,
2842 call the corresponding file handler. */
2843 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2844 if (!NILP (handler
))
2845 return call2 (handler
, Qfile_readable_p
, absname
);
2847 absname
= ENCODE_FILE (absname
);
2850 /* Under MS-DOS and Windows, open does not work for directories. */
2851 if (access (XSTRING (absname
)->data
, 0) == 0)
2854 #else /* not DOS_NT */
2856 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2857 /* Opening a fifo without O_NONBLOCK can wait.
2858 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2859 except in the case of a fifo, on a system which handles it. */
2860 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2863 if (S_ISFIFO (statbuf
.st_mode
))
2864 flags
|= O_NONBLOCK
;
2866 desc
= open (XSTRING (absname
)->data
, flags
);
2871 #endif /* not DOS_NT */
2874 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2876 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2877 "Return t if file FILENAME can be written or created by you.")
2879 Lisp_Object filename
;
2881 Lisp_Object absname
, dir
, encoded
;
2882 Lisp_Object handler
;
2883 struct stat statbuf
;
2885 CHECK_STRING (filename
, 0);
2886 absname
= Fexpand_file_name (filename
, Qnil
);
2888 /* If the file name has special constructs in it,
2889 call the corresponding file handler. */
2890 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2891 if (!NILP (handler
))
2892 return call2 (handler
, Qfile_writable_p
, absname
);
2894 encoded
= ENCODE_FILE (absname
);
2895 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
2896 return (check_writable (XSTRING (encoded
)->data
)
2899 dir
= Ffile_name_directory (absname
);
2902 dir
= Fdirectory_file_name (dir
);
2906 dir
= Fdirectory_file_name (dir
);
2909 dir
= ENCODE_FILE (dir
);
2910 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2914 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2915 "Access file FILENAME, and get an error if that does not work.\n\
2916 The second argument STRING is used in the error message.\n\
2917 If there is no error, we return nil.")
2919 Lisp_Object filename
, string
;
2921 Lisp_Object handler
, encoded_filename
;
2924 CHECK_STRING (filename
, 0);
2926 /* If the file name has special constructs in it,
2927 call the corresponding file handler. */
2928 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2929 if (!NILP (handler
))
2930 return call3 (handler
, Qaccess_file
, filename
, string
);
2932 encoded_filename
= ENCODE_FILE (filename
);
2934 fd
= open (XSTRING (encoded_filename
)->data
, O_RDONLY
);
2936 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2942 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2943 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2944 The value is the name of the file to which it is linked.\n\
2945 Otherwise returns nil.")
2947 Lisp_Object filename
;
2954 Lisp_Object handler
;
2956 CHECK_STRING (filename
, 0);
2957 filename
= Fexpand_file_name (filename
, Qnil
);
2959 /* If the file name has special constructs in it,
2960 call the corresponding file handler. */
2961 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2962 if (!NILP (handler
))
2963 return call2 (handler
, Qfile_symlink_p
, filename
);
2965 filename
= ENCODE_FILE (filename
);
2970 buf
= (char *) xmalloc (bufsize
);
2971 bzero (buf
, bufsize
);
2972 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2973 if (valsize
< bufsize
) break;
2974 /* Buffer was not long enough */
2983 val
= make_string (buf
, valsize
);
2985 val
= DECODE_FILE (val
);
2987 #else /* not S_IFLNK */
2989 #endif /* not S_IFLNK */
2992 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2993 "Return t if FILENAME names an existing directory.")
2995 Lisp_Object filename
;
2997 register Lisp_Object absname
;
2999 Lisp_Object handler
;
3001 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3003 /* If the file name has special constructs in it,
3004 call the corresponding file handler. */
3005 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3006 if (!NILP (handler
))
3007 return call2 (handler
, Qfile_directory_p
, absname
);
3009 absname
= ENCODE_FILE (absname
);
3011 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3013 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3016 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3017 "Return t if file FILENAME is the name of a directory as a file,\n\
3018 and files in that directory can be opened by you. In order to use a\n\
3019 directory as a buffer's current directory, this predicate must return true.\n\
3020 A directory name spec may be given instead; then the value is t\n\
3021 if the directory so specified exists and really is a readable and\n\
3022 searchable directory.")
3024 Lisp_Object filename
;
3026 Lisp_Object handler
;
3028 struct gcpro gcpro1
;
3030 /* If the file name has special constructs in it,
3031 call the corresponding file handler. */
3032 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3033 if (!NILP (handler
))
3034 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3036 /* It's an unlikely combination, but yes we really do need to gcpro:
3037 Suppose that file-accessible-directory-p has no handler, but
3038 file-directory-p does have a handler; this handler causes a GC which
3039 relocates the string in `filename'; and finally file-directory-p
3040 returns non-nil. Then we would end up passing a garbaged string
3041 to file-executable-p. */
3043 tem
= (NILP (Ffile_directory_p (filename
))
3044 || NILP (Ffile_executable_p (filename
)));
3046 return tem
? Qnil
: Qt
;
3049 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3050 "Return t if file FILENAME is the name of a regular file.\n\
3051 This is the sort of file that holds an ordinary stream of data bytes.")
3053 Lisp_Object filename
;
3055 register Lisp_Object absname
;
3057 Lisp_Object handler
;
3059 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3061 /* If the file name has special constructs in it,
3062 call the corresponding file handler. */
3063 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3064 if (!NILP (handler
))
3065 return call2 (handler
, Qfile_regular_p
, absname
);
3067 absname
= ENCODE_FILE (absname
);
3069 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3071 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3074 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3075 "Return mode bits of file named FILENAME, as an integer.")
3077 Lisp_Object filename
;
3079 Lisp_Object absname
;
3081 Lisp_Object handler
;
3083 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3085 /* If the file name has special constructs in it,
3086 call the corresponding file handler. */
3087 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3088 if (!NILP (handler
))
3089 return call2 (handler
, Qfile_modes
, absname
);
3091 absname
= ENCODE_FILE (absname
);
3093 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3095 #if defined (MSDOS) && __DJGPP__ < 2
3096 if (check_executable (XSTRING (absname
)->data
))
3097 st
.st_mode
|= S_IEXEC
;
3098 #endif /* MSDOS && __DJGPP__ < 2 */
3100 return make_number (st
.st_mode
& 07777);
3103 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3104 "Set mode bits of file named FILENAME to MODE (an integer).\n\
3105 Only the 12 low bits of MODE are used.")
3107 Lisp_Object filename
, mode
;
3109 Lisp_Object absname
, encoded_absname
;
3110 Lisp_Object handler
;
3112 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3113 CHECK_NUMBER (mode
, 1);
3115 /* If the file name has special constructs in it,
3116 call the corresponding file handler. */
3117 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3118 if (!NILP (handler
))
3119 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3121 encoded_absname
= ENCODE_FILE (absname
);
3123 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
3124 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3129 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3130 "Set the file permission bits for newly created files.\n\
3131 The argument MODE should be an integer; only the low 9 bits are used.\n\
3132 This setting is inherited by subprocesses.")
3136 CHECK_NUMBER (mode
, 0);
3138 umask ((~ XINT (mode
)) & 0777);
3143 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3144 "Return the default file protection for created files.\n\
3145 The value is an integer.")
3151 realmask
= umask (0);
3154 XSETINT (value
, (~ realmask
) & 0777);
3160 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3161 "Tell Unix to finish all pending disk updates.")
3170 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3171 "Return t if file FILE1 is newer than file FILE2.\n\
3172 If FILE1 does not exist, the answer is nil;\n\
3173 otherwise, if FILE2 does not exist, the answer is t.")
3175 Lisp_Object file1
, file2
;
3177 Lisp_Object absname1
, absname2
;
3180 Lisp_Object handler
;
3181 struct gcpro gcpro1
, gcpro2
;
3183 CHECK_STRING (file1
, 0);
3184 CHECK_STRING (file2
, 0);
3187 GCPRO2 (absname1
, file2
);
3188 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3189 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3192 /* If the file name has special constructs in it,
3193 call the corresponding file handler. */
3194 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3196 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3197 if (!NILP (handler
))
3198 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3200 GCPRO2 (absname1
, absname2
);
3201 absname1
= ENCODE_FILE (absname1
);
3202 absname2
= ENCODE_FILE (absname2
);
3205 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3208 mtime1
= st
.st_mtime
;
3210 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3213 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3217 Lisp_Object Qfind_buffer_file_type
;
3220 #ifndef READ_BUF_SIZE
3221 #define READ_BUF_SIZE (64 << 10)
3224 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3226 "Insert contents of file FILENAME after point.\n\
3227 Returns list of absolute file name and number of bytes inserted.\n\
3228 If second argument VISIT is non-nil, the buffer's visited filename\n\
3229 and last save file modtime are set, and it is marked unmodified.\n\
3230 If visiting and the file does not exist, visiting is completed\n\
3231 before the error is signaled.\n\
3232 The optional third and fourth arguments BEG and END\n\
3233 specify what portion of the file to insert.\n\
3234 These arguments count bytes in the file, not characters in the buffer.\n\
3235 If VISIT is non-nil, BEG and END must be nil.\n\
3237 If optional fifth argument REPLACE is non-nil,\n\
3238 it means replace the current buffer contents (in the accessible portion)\n\
3239 with the file contents. This is better than simply deleting and inserting\n\
3240 the whole thing because (1) it preserves some marker positions\n\
3241 and (2) it puts less data in the undo list.\n\
3242 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3243 which is often less than the number of characters to be read.\n\
3244 This does code conversion according to the value of\n\
3245 `coding-system-for-read' or `file-coding-system-alist',\n\
3246 and sets the variable `last-coding-system-used' to the coding system\n\
3248 (filename
, visit
, beg
, end
, replace
)
3249 Lisp_Object filename
, visit
, beg
, end
, replace
;
3254 register int how_much
;
3255 register int unprocessed
;
3256 int count
= specpdl_ptr
- specpdl
;
3257 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3258 Lisp_Object handler
, val
, insval
, orig_filename
;
3261 int not_regular
= 0;
3262 char read_buf
[READ_BUF_SIZE
];
3263 struct coding_system coding
;
3264 unsigned char buffer
[1 << 14];
3265 int replace_handled
= 0;
3266 int set_coding_system
= 0;
3268 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3269 error ("Cannot do file visiting in an indirect buffer");
3271 if (!NILP (current_buffer
->read_only
))
3272 Fbarf_if_buffer_read_only ();
3276 orig_filename
= Qnil
;
3278 GCPRO4 (filename
, val
, p
, orig_filename
);
3280 CHECK_STRING (filename
, 0);
3281 filename
= Fexpand_file_name (filename
, Qnil
);
3283 /* If the file name has special constructs in it,
3284 call the corresponding file handler. */
3285 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3286 if (!NILP (handler
))
3288 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3289 visit
, beg
, end
, replace
);
3293 orig_filename
= filename
;
3294 filename
= ENCODE_FILE (filename
);
3299 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3301 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3302 || fstat (fd
, &st
) < 0)
3303 #endif /* not APOLLO */
3305 if (fd
>= 0) close (fd
);
3308 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3311 if (!NILP (Vcoding_system_for_read
))
3312 current_buffer
->buffer_file_coding_system
= Vcoding_system_for_read
;
3317 /* This code will need to be changed in order to work on named
3318 pipes, and it's probably just not worth it. So we should at
3319 least signal an error. */
3320 if (!S_ISREG (st
.st_mode
))
3327 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3328 Fsignal (Qfile_error
,
3329 Fcons (build_string ("not a regular file"),
3330 Fcons (orig_filename
, Qnil
)));
3335 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3338 /* Replacement should preserve point as it preserves markers. */
3339 if (!NILP (replace
))
3340 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3342 record_unwind_protect (close_file_unwind
, make_number (fd
));
3344 /* Supposedly happens on VMS. */
3345 if (! not_regular
&& st
.st_size
< 0)
3346 error ("File size is negative");
3348 if (!NILP (beg
) || !NILP (end
))
3350 error ("Attempt to visit less than an entire file");
3353 CHECK_NUMBER (beg
, 0);
3355 XSETFASTINT (beg
, 0);
3358 CHECK_NUMBER (end
, 0);
3363 XSETINT (end
, st
.st_size
);
3364 if (XINT (end
) != st
.st_size
)
3365 error ("Maximum buffer size exceeded");
3369 /* Decide the coding-system of the file. */
3371 Lisp_Object val
= Qnil
;
3373 if (!NILP (Vcoding_system_for_read
))
3374 val
= Vcoding_system_for_read
;
3377 if (! NILP (Vset_auto_coding_function
))
3379 /* Find a coding system specified in the heading two lines
3380 or in the tailing several lines of the file. We assume
3381 that the 1K-byte and 3K-byte for heading and tailing
3382 respectively are sufficient fot this purpose. */
3383 int how_many
, nread
;
3385 if (st
.st_size
<= (1024 * 4))
3386 nread
= read (fd
, read_buf
, 1024 * 4);
3389 nread
= read (fd
, read_buf
, 1024);
3392 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3393 report_file_error ("Setting file position",
3394 Fcons (orig_filename
, Qnil
));
3395 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3400 error ("IO error reading %s: %s",
3401 XSTRING (orig_filename
)->data
, strerror (errno
));
3405 /* Always make this a unibyte string
3406 because we have not yet decoded it. */
3407 tem
= make_unibyte_string (read_buf
, nread
);
3408 val
= call1 (Vset_auto_coding_function
, tem
);
3409 /* Rewind the file for the actual read done later. */
3410 if (lseek (fd
, 0, 0) < 0)
3411 report_file_error ("Setting file position",
3412 Fcons (orig_filename
, Qnil
));
3417 Lisp_Object args
[6], coding_systems
;
3419 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
,
3420 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3421 coding_systems
= Ffind_operation_coding_system (6, args
);
3422 if (CONSP (coding_systems
)) val
= XCONS (coding_systems
)->car
;
3426 if (NILP (Vcoding_system_for_read
)
3427 && NILP (current_buffer
->enable_multibyte_characters
))
3429 /* We must suppress all text conversion except for end-of-line
3431 struct coding_system coding_temp
;
3433 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
3434 setup_coding_system (Qraw_text
, &coding
);
3435 coding
.eol_type
= coding_temp
.eol_type
;
3438 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3441 /* If requested, replace the accessible part of the buffer
3442 with the file contents. Avoid replacing text at the
3443 beginning or end of the buffer that matches the file contents;
3444 that preserves markers pointing to the unchanged parts.
3446 Here we implement this feature in an optimized way
3447 for the case where code conversion is NOT needed.
3448 The following if-statement handles the case of conversion
3449 in a less optimal way.
3451 If the code conversion is "automatic" then we try using this
3452 method and hope for the best.
3453 But if we discover the need for conversion, we give up on this method
3454 and let the following if-statement handle the replace job. */
3456 && ! CODING_REQUIRE_DECODING (&coding
))
3458 /* same_at_start and same_at_end count bytes,
3459 because file access counts bytes
3460 and BEG and END count bytes. */
3461 int same_at_start
= BEGV_BYTE
;
3462 int same_at_end
= ZV_BYTE
;
3464 /* There is still a possibility we will find the need to do code
3465 conversion. If that happens, we set this variable to 1 to
3466 give up on handling REPLACE in the optimized way. */
3467 int giveup_match_end
= 0;
3469 if (XINT (beg
) != 0)
3471 if (lseek (fd
, XINT (beg
), 0) < 0)
3472 report_file_error ("Setting file position",
3473 Fcons (orig_filename
, Qnil
));
3478 /* Count how many chars at the start of the file
3479 match the text at the beginning of the buffer. */
3484 nread
= read (fd
, buffer
, sizeof buffer
);
3486 error ("IO error reading %s: %s",
3487 XSTRING (orig_filename
)->data
, strerror (errno
));
3488 else if (nread
== 0)
3491 if (coding
.type
== coding_type_undecided
)
3492 detect_coding (&coding
, buffer
, nread
);
3493 if (CODING_REQUIRE_DECODING (&coding
))
3494 /* We found that the file should be decoded somehow.
3495 Let's give up here. */
3497 giveup_match_end
= 1;
3501 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3502 detect_eol (&coding
, buffer
, nread
);
3503 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3504 && coding
.eol_type
!= CODING_EOL_LF
)
3505 /* We found that the format of eol should be decoded.
3506 Let's give up here. */
3508 giveup_match_end
= 1;
3513 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3514 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3515 same_at_start
++, bufpos
++;
3516 /* If we found a discrepancy, stop the scan.
3517 Otherwise loop around and scan the next bufferful. */
3518 if (bufpos
!= nread
)
3522 /* If the file matches the buffer completely,
3523 there's no need to replace anything. */
3524 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3528 /* Truncate the buffer to the size of the file. */
3529 del_range_1 (same_at_start
, same_at_end
, 0);
3534 /* Count how many chars at the end of the file
3535 match the text at the end of the buffer. But, if we have
3536 already found that decoding is necessary, don't waste time. */
3537 while (!giveup_match_end
)
3539 int total_read
, nread
, bufpos
, curpos
, trial
;
3541 /* At what file position are we now scanning? */
3542 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3543 /* If the entire file matches the buffer tail, stop the scan. */
3546 /* How much can we scan in the next step? */
3547 trial
= min (curpos
, sizeof buffer
);
3548 if (lseek (fd
, curpos
- trial
, 0) < 0)
3549 report_file_error ("Setting file position",
3550 Fcons (orig_filename
, Qnil
));
3553 while (total_read
< trial
)
3555 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3557 error ("IO error reading %s: %s",
3558 XSTRING (orig_filename
)->data
, strerror (errno
));
3559 total_read
+= nread
;
3561 /* Scan this bufferful from the end, comparing with
3562 the Emacs buffer. */
3563 bufpos
= total_read
;
3564 /* Compare with same_at_start to avoid counting some buffer text
3565 as matching both at the file's beginning and at the end. */
3566 while (bufpos
> 0 && same_at_end
> same_at_start
3567 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3568 same_at_end
--, bufpos
--;
3570 /* If we found a discrepancy, stop the scan.
3571 Otherwise loop around and scan the preceding bufferful. */
3574 /* If this discrepancy is because of code conversion,
3575 we cannot use this method; giveup and try the other. */
3576 if (same_at_end
> same_at_start
3577 && FETCH_BYTE (same_at_end
- 1) >= 0200
3578 && ! NILP (current_buffer
->enable_multibyte_characters
)
3579 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3580 giveup_match_end
= 1;
3586 if (! giveup_match_end
)
3590 /* We win! We can handle REPLACE the optimized way. */
3592 /* Extends the end of non-matching text area to multibyte
3593 character boundary. */
3594 if (! NILP (current_buffer
->enable_multibyte_characters
))
3595 while (same_at_end
< ZV_BYTE
3596 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3599 /* Don't try to reuse the same piece of text twice. */
3600 overlap
= (same_at_start
- BEGV_BYTE
3601 - (same_at_end
+ st
.st_size
- ZV
));
3603 same_at_end
+= overlap
;
3605 /* Arrange to read only the nonmatching middle part of the file. */
3606 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3607 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3609 del_range_byte (same_at_start
, same_at_end
, 0);
3610 /* Insert from the file at the proper position. */
3611 temp
= BYTE_TO_CHAR (same_at_start
);
3612 SET_PT_BOTH (temp
, same_at_start
);
3614 /* If display currently starts at beginning of line,
3615 keep it that way. */
3616 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3617 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3619 replace_handled
= 1;
3623 /* If requested, replace the accessible part of the buffer
3624 with the file contents. Avoid replacing text at the
3625 beginning or end of the buffer that matches the file contents;
3626 that preserves markers pointing to the unchanged parts.
3628 Here we implement this feature for the case where code conversion
3629 is needed, in a simple way that needs a lot of memory.
3630 The preceding if-statement handles the case of no conversion
3631 in a more optimized way. */
3632 if (!NILP (replace
) && ! replace_handled
)
3634 int same_at_start
= BEGV_BYTE
;
3635 int same_at_end
= ZV_BYTE
;
3638 /* Make sure that the gap is large enough. */
3639 int bufsize
= 2 * st
.st_size
;
3640 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3643 /* First read the whole file, performing code conversion into
3644 CONVERSION_BUFFER. */
3646 if (lseek (fd
, XINT (beg
), 0) < 0)
3648 free (conversion_buffer
);
3649 report_file_error ("Setting file position",
3650 Fcons (orig_filename
, Qnil
));
3653 total
= st
.st_size
; /* Total bytes in the file. */
3654 how_much
= 0; /* Bytes read from file so far. */
3655 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3656 unprocessed
= 0; /* Bytes not processed in previous loop. */
3658 while (how_much
< total
)
3660 /* try is reserved in some compilers (Microsoft C) */
3661 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3662 char *destination
= read_buf
+ unprocessed
;
3665 /* Allow quitting out of the actual I/O. */
3668 this = read (fd
, destination
, trytry
);
3671 if (this < 0 || this + unprocessed
== 0)
3679 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3681 int require
, result
;
3683 this += unprocessed
;
3685 /* If we are using more space than estimated,
3686 make CONVERSION_BUFFER bigger. */
3687 require
= decoding_buffer_size (&coding
, this);
3688 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3690 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3691 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3694 /* Convert this batch with results in CONVERSION_BUFFER. */
3695 if (how_much
>= total
) /* This is the last block. */
3696 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3697 result
= decode_coding (&coding
, read_buf
,
3698 conversion_buffer
+ inserted
,
3699 this, bufsize
- inserted
);
3701 /* Save for next iteration whatever we didn't convert. */
3702 unprocessed
= this - coding
.consumed
;
3703 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
3704 this = coding
.produced
;
3710 /* At this point, INSERTED is how many characters (i.e. bytes)
3711 are present in CONVERSION_BUFFER.
3712 HOW_MUCH should equal TOTAL,
3713 or should be <= 0 if we couldn't read the file. */
3717 free (conversion_buffer
);
3720 error ("IO error reading %s: %s",
3721 XSTRING (orig_filename
)->data
, strerror (errno
));
3722 else if (how_much
== -2)
3723 error ("maximum buffer size exceeded");
3726 /* Compare the beginning of the converted file
3727 with the buffer text. */
3730 while (bufpos
< inserted
&& same_at_start
< same_at_end
3731 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3732 same_at_start
++, bufpos
++;
3734 /* If the file matches the buffer completely,
3735 there's no need to replace anything. */
3737 if (bufpos
== inserted
)
3739 free (conversion_buffer
);
3742 /* Truncate the buffer to the size of the file. */
3743 del_range_1 (same_at_start
, same_at_end
, 0);
3747 /* Scan this bufferful from the end, comparing with
3748 the Emacs buffer. */
3751 /* Compare with same_at_start to avoid counting some buffer text
3752 as matching both at the file's beginning and at the end. */
3753 while (bufpos
> 0 && same_at_end
> same_at_start
3754 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3755 same_at_end
--, bufpos
--;
3757 /* Don't try to reuse the same piece of text twice. */
3758 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3760 same_at_end
+= overlap
;
3762 /* If display currently starts at beginning of line,
3763 keep it that way. */
3764 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3765 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3767 /* Replace the chars that we need to replace,
3768 and update INSERTED to equal the number of bytes
3769 we are taking from the file. */
3770 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
3771 del_range_byte (same_at_start
, same_at_end
, 0);
3772 if (same_at_end
!= same_at_start
)
3773 SET_PT_BOTH (GPT
, GPT_BYTE
);
3776 /* Insert from the file at the proper position. */
3777 temp
= BYTE_TO_CHAR (same_at_start
);
3778 SET_PT_BOTH (temp
, same_at_start
);
3781 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
3784 free (conversion_buffer
);
3793 register Lisp_Object temp
;
3795 total
= XINT (end
) - XINT (beg
);
3797 /* Make sure point-max won't overflow after this insertion. */
3798 XSETINT (temp
, total
);
3799 if (total
!= XINT (temp
))
3800 error ("Maximum buffer size exceeded");
3803 /* For a special file, all we can do is guess. */
3804 total
= READ_BUF_SIZE
;
3806 if (NILP (visit
) && total
> 0)
3807 prepare_to_modify_buffer (PT
, PT
, NULL
);
3810 if (GAP_SIZE
< total
)
3811 make_gap (total
- GAP_SIZE
);
3813 if (XINT (beg
) != 0 || !NILP (replace
))
3815 if (lseek (fd
, XINT (beg
), 0) < 0)
3816 report_file_error ("Setting file position",
3817 Fcons (orig_filename
, Qnil
));
3820 /* In the following loop, HOW_MUCH contains the total bytes read so
3821 far for a regular file, and not changed for a special file. But,
3822 before exiting the loop, it is set to a negative value if I/O
3825 /* Total bytes inserted. */
3827 /* Here, we don't do code conversion in the loop. It is done by
3828 code_convert_region after all data are read into the buffer. */
3829 while (how_much
< total
)
3831 /* try is reserved in some compilers (Microsoft C) */
3832 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3835 /* For a special file, GAP_SIZE should be checked every time. */
3836 if (not_regular
&& GAP_SIZE
< trytry
)
3837 make_gap (total
- GAP_SIZE
);
3839 /* Allow quitting out of the actual I/O. */
3842 this = read (fd
, BYTE_POS_ADDR (PT_BYTE
+ inserted
- 1) + 1, trytry
);
3859 /* For a regular file, where TOTAL is the real size,
3860 count HOW_MUCH to compare with it.
3861 For a special file, where TOTAL is just a buffer size,
3862 so don't bother counting in HOW_MUCH.
3863 (INSERTED is where we count the number of characters inserted.) */
3870 /* Put an anchor to ensure multi-byte form ends at gap. */
3875 /* Discard the unwind protect for closing the file. */
3879 error ("IO error reading %s: %s",
3880 XSTRING (orig_filename
)->data
, strerror (errno
));
3884 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3886 /* Here, we don't have to consider byte combining (see the
3887 comment below) because code_convert_region takes care of
3889 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
3891 inserted
= (NILP (current_buffer
->enable_multibyte_characters
)
3892 ? coding
.produced
: coding
.produced_char
);
3894 else if (!NILP (current_buffer
->enable_multibyte_characters
))
3896 int inserted_byte
= inserted
;
3898 /* There's a possibility that we must combine bytes at the
3899 head (resp. the tail) of the just inserted text with the
3900 bytes before (resp. after) the gap to form a single
3902 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
3903 adjust_after_insert (PT
, PT_BYTE
,
3904 PT
+ inserted_byte
, PT_BYTE
+ inserted_byte
,
3908 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
3912 /* Use the conversion type to determine buffer-file-type
3913 (find-buffer-file-type is now used to help determine the
3915 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3916 && coding
.eol_type
!= CODING_EOL_LF
)
3917 current_buffer
->buffer_file_type
= Qnil
;
3919 current_buffer
->buffer_file_type
= Qt
;
3923 set_coding_system
= 1;
3930 if (!EQ (current_buffer
->undo_list
, Qt
))
3931 current_buffer
->undo_list
= Qnil
;
3933 stat (XSTRING (filename
)->data
, &st
);
3938 current_buffer
->modtime
= st
.st_mtime
;
3939 current_buffer
->filename
= orig_filename
;
3942 SAVE_MODIFF
= MODIFF
;
3943 current_buffer
->auto_save_modified
= MODIFF
;
3944 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3945 #ifdef CLASH_DETECTION
3948 if (!NILP (current_buffer
->file_truename
))
3949 unlock_file (current_buffer
->file_truename
);
3950 unlock_file (filename
);
3952 #endif /* CLASH_DETECTION */
3954 Fsignal (Qfile_error
,
3955 Fcons (build_string ("not a regular file"),
3956 Fcons (orig_filename
, Qnil
)));
3958 /* If visiting nonexistent file, return nil. */
3959 if (current_buffer
->modtime
== -1)
3960 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3963 /* Decode file format */
3966 insval
= call3 (Qformat_decode
,
3967 Qnil
, make_number (inserted
), visit
);
3968 CHECK_NUMBER (insval
, 0);
3969 inserted
= XFASTINT (insval
);
3972 /* Call after-change hooks for the inserted text, aside from the case
3973 of normal visiting (not with REPLACE), which is done in a new buffer
3974 "before" the buffer is changed. */
3975 if (inserted
> 0 && total
> 0
3976 && (NILP (visit
) || !NILP (replace
)))
3977 signal_after_change (PT
, 0, inserted
);
3979 if (set_coding_system
)
3980 Vlast_coding_system_used
= coding
.symbol
;
3984 p
= Vafter_insert_file_functions
;
3987 insval
= call1 (Fcar (p
), make_number (inserted
));
3990 CHECK_NUMBER (insval
, 0);
3991 inserted
= XFASTINT (insval
);
3998 /* ??? Retval needs to be dealt with in all cases consistently. */
4000 val
= Fcons (orig_filename
,
4001 Fcons (make_number (inserted
),
4004 RETURN_UNGCPRO (unbind_to (count
, val
));
4007 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
4010 /* If build_annotations switched buffers, switch back to BUF.
4011 Kill the temporary buffer that was selected in the meantime.
4013 Since this kill only the last temporary buffer, some buffers remain
4014 not killed if build_annotations switched buffers more than once.
4018 build_annotations_unwind (buf
)
4023 if (XBUFFER (buf
) == current_buffer
)
4025 tembuf
= Fcurrent_buffer ();
4027 Fkill_buffer (tembuf
);
4031 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4032 "r\nFWrite region to file: \ni\ni\ni\np",
4033 "Write current region into specified file.\n\
4034 When called from a program, takes three arguments:\n\
4035 START, END and FILENAME. START and END are buffer positions.\n\
4036 Optional fourth argument APPEND if non-nil means\n\
4037 append to existing file contents (if any).\n\
4038 Optional fifth argument VISIT if t means\n\
4039 set the last-save-file-modtime of buffer to this file's modtime\n\
4040 and mark buffer not modified.\n\
4041 If VISIT is a string, it is a second file name;\n\
4042 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
4043 VISIT is also the file name to lock and unlock for clash detection.\n\
4044 If VISIT is neither t nor nil nor a string,\n\
4045 that means do not print the \"Wrote file\" message.\n\
4046 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
4047 use for locking and unlocking, overriding FILENAME and VISIT.\n\
4048 The optional seventh arg CONFIRM, if non-nil, says ask for confirmation\n\
4049 before overwriting an existing file.\n\
4050 Kludgy feature: if START is a string, then that string is written\n\
4051 to the file, instead of any buffer contents, and END is ignored.")
4052 (start
, end
, filename
, append
, visit
, lockname
, confirm
)
4053 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, confirm
;
4061 int count
= specpdl_ptr
- specpdl
;
4064 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4066 Lisp_Object handler
;
4067 Lisp_Object visit_file
;
4068 Lisp_Object annotations
;
4069 Lisp_Object encoded_filename
;
4070 int visiting
, quietly
;
4071 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4072 struct buffer
*given_buffer
;
4074 int buffer_file_type
= O_BINARY
;
4076 struct coding_system coding
;
4078 if (current_buffer
->base_buffer
&& ! NILP (visit
))
4079 error ("Cannot do file visiting in an indirect buffer");
4081 if (!NILP (start
) && !STRINGP (start
))
4082 validate_region (&start
, &end
);
4084 GCPRO4 (start
, filename
, visit
, lockname
);
4086 /* Decide the coding-system to encode the data with. */
4092 else if (!NILP (Vcoding_system_for_write
))
4093 val
= Vcoding_system_for_write
;
4094 else if (NILP (current_buffer
->enable_multibyte_characters
))
4096 /* If the variable `buffer-file-coding-system' is set locally,
4097 it means that the file was read with some kind of code
4098 conversion or the varialbe is explicitely set by users. We
4099 had better write it out with the same coding system even if
4100 `enable-multibyte-characters' is nil.
4102 If it is not set locally, we anyway have to convert EOL
4103 format if the default value of `buffer-file-coding-system'
4104 tells that it is not Unix-like (LF only) format. */
4105 val
= current_buffer
->buffer_file_coding_system
;
4106 if (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4108 struct coding_system coding_temp
;
4110 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
4111 if (coding_temp
.eol_type
== CODING_EOL_CRLF
4112 || coding_temp
.eol_type
== CODING_EOL_CR
)
4114 setup_coding_system (Qraw_text
, &coding
);
4115 coding
.eol_type
= coding_temp
.eol_type
;
4116 goto done_setup_coding
;
4123 Lisp_Object args
[7], coding_systems
;
4125 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4126 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4128 coding_systems
= Ffind_operation_coding_system (7, args
);
4129 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
4130 ? XCONS (coding_systems
)->cdr
4131 : current_buffer
->buffer_file_coding_system
);
4132 /* Confirm that VAL can surely encode the current region. */
4133 if (!NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4134 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4136 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4139 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4140 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4143 Vlast_coding_system_used
= coding
.symbol
;
4145 filename
= Fexpand_file_name (filename
, Qnil
);
4147 if (! NILP (confirm
))
4148 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4150 if (STRINGP (visit
))
4151 visit_file
= Fexpand_file_name (visit
, Qnil
);
4153 visit_file
= filename
;
4156 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4157 quietly
= !NILP (visit
);
4161 if (NILP (lockname
))
4162 lockname
= visit_file
;
4164 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4166 /* If the file name has special constructs in it,
4167 call the corresponding file handler. */
4168 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4169 /* If FILENAME has no handler, see if VISIT has one. */
4170 if (NILP (handler
) && STRINGP (visit
))
4171 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4173 if (!NILP (handler
))
4176 val
= call6 (handler
, Qwrite_region
, start
, end
,
4177 filename
, append
, visit
);
4181 SAVE_MODIFF
= MODIFF
;
4182 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4183 current_buffer
->filename
= visit_file
;
4189 /* Special kludge to simplify auto-saving. */
4192 XSETFASTINT (start
, BEG
);
4193 XSETFASTINT (end
, Z
);
4196 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4197 count1
= specpdl_ptr
- specpdl
;
4199 given_buffer
= current_buffer
;
4200 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4201 if (current_buffer
!= given_buffer
)
4203 XSETFASTINT (start
, BEGV
);
4204 XSETFASTINT (end
, ZV
);
4207 #ifdef CLASH_DETECTION
4210 #if 0 /* This causes trouble for GNUS. */
4211 /* If we've locked this file for some other buffer,
4212 query before proceeding. */
4213 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4214 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4217 lock_file (lockname
);
4219 #endif /* CLASH_DETECTION */
4221 encoded_filename
= ENCODE_FILE (filename
);
4223 fn
= XSTRING (encoded_filename
)->data
;
4227 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4228 #else /* not DOS_NT */
4229 desc
= open (fn
, O_WRONLY
);
4230 #endif /* not DOS_NT */
4232 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4234 if (auto_saving
) /* Overwrite any previous version of autosave file */
4236 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4237 desc
= open (fn
, O_RDWR
);
4239 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4240 ? XSTRING (current_buffer
->filename
)->data
: 0,
4243 else /* Write to temporary name and rename if no errors */
4245 Lisp_Object temp_name
;
4246 temp_name
= Ffile_name_directory (filename
);
4248 if (!NILP (temp_name
))
4250 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4251 build_string ("$$SAVE$$")));
4252 fname
= XSTRING (filename
)->data
;
4253 fn
= XSTRING (temp_name
)->data
;
4254 desc
= creat_copy_attrs (fname
, fn
);
4257 /* If we can't open the temporary file, try creating a new
4258 version of the original file. VMS "creat" creates a
4259 new version rather than truncating an existing file. */
4262 desc
= creat (fn
, 0666);
4263 #if 0 /* This can clobber an existing file and fail to replace it,
4264 if the user runs out of space. */
4267 /* We can't make a new version;
4268 try to truncate and rewrite existing version if any. */
4270 desc
= open (fn
, O_RDWR
);
4276 desc
= creat (fn
, 0666);
4281 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4282 S_IREAD
| S_IWRITE
);
4283 #else /* not DOS_NT */
4284 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4285 #endif /* not DOS_NT */
4286 #endif /* not VMS */
4292 #ifdef CLASH_DETECTION
4294 if (!auto_saving
) unlock_file (lockname
);
4296 #endif /* CLASH_DETECTION */
4297 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4300 record_unwind_protect (close_file_unwind
, make_number (desc
));
4303 if (lseek (desc
, 0, 2) < 0)
4305 #ifdef CLASH_DETECTION
4306 if (!auto_saving
) unlock_file (lockname
);
4307 #endif /* CLASH_DETECTION */
4308 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4313 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4314 * if we do writes that don't end with a carriage return. Furthermore
4315 * it cannot handle writes of more then 16K. The modified
4316 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4317 * this EXCEPT for the last record (iff it doesn't end with a carriage
4318 * return). This implies that if your buffer doesn't end with a carriage
4319 * return, you get one free... tough. However it also means that if
4320 * we make two calls to sys_write (a la the following code) you can
4321 * get one at the gap as well. The easiest way to fix this (honest)
4322 * is to move the gap to the next newline (or the end of the buffer).
4327 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4328 move_gap (find_next_newline (GPT
, 1));
4330 /* Whether VMS or not, we must move the gap to the next of newline
4331 when we must put designation sequences at beginning of line. */
4332 if (INTEGERP (start
)
4333 && coding
.type
== coding_type_iso2022
4334 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4335 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4337 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4338 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4339 move_gap_both (PT
, PT_BYTE
);
4340 SET_PT_BOTH (opoint
, opoint_byte
);
4347 if (STRINGP (start
))
4349 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4350 STRING_BYTES (XSTRING (start
)), 0, &annotations
,
4354 else if (XINT (start
) != XINT (end
))
4356 register int end1
= CHAR_TO_BYTE (XINT (end
));
4358 tem
= CHAR_TO_BYTE (XINT (start
));
4360 if (XINT (start
) < GPT
)
4362 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
),
4363 min (GPT_BYTE
, end1
) - tem
, tem
, &annotations
,
4368 if (XINT (end
) > GPT
&& !failure
)
4370 tem
= max (tem
, GPT_BYTE
);
4371 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
), end1
- tem
,
4372 tem
, &annotations
, &coding
);
4378 /* If file was empty, still need to write the annotations */
4379 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4380 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4384 if (CODING_REQUIRE_FLUSHING (&coding
)
4385 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4388 /* We have to flush out a data. */
4389 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4390 failure
= 0 > e_write (desc
, "", 0, &coding
);
4397 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4398 Disk full in NFS may be reported here. */
4399 /* mib says that closing the file will try to write as fast as NFS can do
4400 it, and that means the fsync here is not crucial for autosave files. */
4401 if (!auto_saving
&& fsync (desc
) < 0)
4403 /* If fsync fails with EINTR, don't treat that as serious. */
4405 failure
= 1, save_errno
= errno
;
4409 /* Spurious "file has changed on disk" warnings have been
4410 observed on Suns as well.
4411 It seems that `close' can change the modtime, under nfs.
4413 (This has supposedly been fixed in Sunos 4,
4414 but who knows about all the other machines with NFS?) */
4417 /* On VMS and APOLLO, must do the stat after the close
4418 since closing changes the modtime. */
4421 /* Recall that #if defined does not work on VMS. */
4428 /* NFS can report a write failure now. */
4429 if (close (desc
) < 0)
4430 failure
= 1, save_errno
= errno
;
4433 /* If we wrote to a temporary name and had no errors, rename to real name. */
4437 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4445 /* Discard the unwind protect for close_file_unwind. */
4446 specpdl_ptr
= specpdl
+ count1
;
4447 /* Restore the original current buffer. */
4448 visit_file
= unbind_to (count
, visit_file
);
4450 #ifdef CLASH_DETECTION
4452 unlock_file (lockname
);
4453 #endif /* CLASH_DETECTION */
4455 /* Do this before reporting IO error
4456 to avoid a "file has changed on disk" warning on
4457 next attempt to save. */
4459 current_buffer
->modtime
= st
.st_mtime
;
4462 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4463 strerror (save_errno
));
4467 SAVE_MODIFF
= MODIFF
;
4468 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4469 current_buffer
->filename
= visit_file
;
4470 update_mode_lines
++;
4476 message_with_string ("Wrote %s", visit_file
, 1);
4481 Lisp_Object
merge ();
4483 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4484 "Return t if (car A) is numerically less than (car B).")
4488 return Flss (Fcar (a
), Fcar (b
));
4491 /* Build the complete list of annotations appropriate for writing out
4492 the text between START and END, by calling all the functions in
4493 write-region-annotate-functions and merging the lists they return.
4494 If one of these functions switches to a different buffer, we assume
4495 that buffer contains altered text. Therefore, the caller must
4496 make sure to restore the current buffer in all cases,
4497 as save-excursion would do. */
4500 build_annotations (start
, end
, pre_write_conversion
)
4501 Lisp_Object start
, end
, pre_write_conversion
;
4503 Lisp_Object annotations
;
4505 struct gcpro gcpro1
, gcpro2
;
4506 Lisp_Object original_buffer
;
4508 XSETBUFFER (original_buffer
, current_buffer
);
4511 p
= Vwrite_region_annotate_functions
;
4512 GCPRO2 (annotations
, p
);
4515 struct buffer
*given_buffer
= current_buffer
;
4516 Vwrite_region_annotations_so_far
= annotations
;
4517 res
= call2 (Fcar (p
), start
, end
);
4518 /* If the function makes a different buffer current,
4519 assume that means this buffer contains altered text to be output.
4520 Reset START and END from the buffer bounds
4521 and discard all previous annotations because they should have
4522 been dealt with by this function. */
4523 if (current_buffer
!= given_buffer
)
4525 XSETFASTINT (start
, BEGV
);
4526 XSETFASTINT (end
, ZV
);
4529 Flength (res
); /* Check basic validity of return value */
4530 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4534 /* Now do the same for annotation functions implied by the file-format */
4535 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4536 p
= Vauto_save_file_format
;
4538 p
= current_buffer
->file_format
;
4541 struct buffer
*given_buffer
= current_buffer
;
4542 Vwrite_region_annotations_so_far
= annotations
;
4543 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4545 if (current_buffer
!= given_buffer
)
4547 XSETFASTINT (start
, BEGV
);
4548 XSETFASTINT (end
, ZV
);
4552 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4556 /* At last, do the same for the function PRE_WRITE_CONVERSION
4557 implied by the current coding-system. */
4558 if (!NILP (pre_write_conversion
))
4560 struct buffer
*given_buffer
= current_buffer
;
4561 Vwrite_region_annotations_so_far
= annotations
;
4562 res
= call2 (pre_write_conversion
, start
, end
);
4564 annotations
= (current_buffer
!= given_buffer
4566 : merge (annotations
, res
, Qcar_less_than_car
));
4573 /* Write to descriptor DESC the NBYTES bytes starting at ADDR,
4574 assuming they start at byte position BYTEPOS in the buffer.
4575 Intersperse with them the annotations from *ANNOT
4576 which fall within the range of byte positions BYTEPOS to BYTEPOS + NBYTES,
4577 each at its appropriate position.
4579 We modify *ANNOT by discarding elements as we use them up.
4581 The return value is negative in case of system call failure. */
4584 a_write (desc
, addr
, nbytes
, bytepos
, annot
, coding
)
4586 register char *addr
;
4587 register int nbytes
;
4590 struct coding_system
*coding
;
4594 int lastpos
= bytepos
+ nbytes
;
4596 while (NILP (*annot
) || CONSP (*annot
))
4598 tem
= Fcar_safe (Fcar (*annot
));
4599 nextpos
= bytepos
- 1;
4601 nextpos
= CHAR_TO_BYTE (XFASTINT (tem
));
4603 /* If there are no more annotations in this range,
4604 output the rest of the range all at once. */
4605 if (! (nextpos
>= bytepos
&& nextpos
<= lastpos
))
4606 return e_write (desc
, addr
, lastpos
- bytepos
, coding
);
4608 /* Output buffer text up to the next annotation's position. */
4609 if (nextpos
> bytepos
)
4611 if (0 > e_write (desc
, addr
, nextpos
- bytepos
, coding
))
4613 addr
+= nextpos
- bytepos
;
4616 /* Output the annotation. */
4617 tem
= Fcdr (Fcar (*annot
));
4620 if (0 > e_write (desc
, XSTRING (tem
)->data
, STRING_BYTES (XSTRING (tem
)),
4624 *annot
= Fcdr (*annot
);
4629 #ifndef WRITE_BUF_SIZE
4630 #define WRITE_BUF_SIZE (16 * 1024)
4633 /* Write NBYTES bytes starting at ADDR into descriptor DESC,
4634 encoding them with coding system CODING. */
4637 e_write (desc
, addr
, nbytes
, coding
)
4639 register char *addr
;
4640 register int nbytes
;
4641 struct coding_system
*coding
;
4643 char buf
[WRITE_BUF_SIZE
];
4645 /* We used to have a code for handling selective display here. But,
4646 now it is handled within encode_coding. */
4649 encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
4650 nbytes
-= coding
->consumed
, addr
+= coding
->consumed
;
4651 if (coding
->produced
> 0)
4653 coding
->produced
-= write (desc
, buf
, coding
->produced
);
4654 if (coding
->produced
) return -1;
4662 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4663 Sverify_visited_file_modtime
, 1, 1, 0,
4664 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4665 This means that the file has not been changed since it was visited or saved.")
4671 Lisp_Object handler
;
4672 Lisp_Object filename
;
4674 CHECK_BUFFER (buf
, 0);
4677 if (!STRINGP (b
->filename
)) return Qt
;
4678 if (b
->modtime
== 0) return Qt
;
4680 /* If the file name has special constructs in it,
4681 call the corresponding file handler. */
4682 handler
= Ffind_file_name_handler (b
->filename
,
4683 Qverify_visited_file_modtime
);
4684 if (!NILP (handler
))
4685 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4687 filename
= ENCODE_FILE (b
->filename
);
4689 if (stat (XSTRING (filename
)->data
, &st
) < 0)
4691 /* If the file doesn't exist now and didn't exist before,
4692 we say that it isn't modified, provided the error is a tame one. */
4693 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4698 if (st
.st_mtime
== b
->modtime
4699 /* If both are positive, accept them if they are off by one second. */
4700 || (st
.st_mtime
> 0 && b
->modtime
> 0
4701 && (st
.st_mtime
== b
->modtime
+ 1
4702 || st
.st_mtime
== b
->modtime
- 1)))
4707 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4708 Sclear_visited_file_modtime
, 0, 0, 0,
4709 "Clear out records of last mod time of visited file.\n\
4710 Next attempt to save will certainly not complain of a discrepancy.")
4713 current_buffer
->modtime
= 0;
4717 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4718 Svisited_file_modtime
, 0, 0, 0,
4719 "Return the current buffer's recorded visited file modification time.\n\
4720 The value is a list of the form (HIGH . LOW), like the time values\n\
4721 that `file-attributes' returns.")
4724 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4727 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4728 Sset_visited_file_modtime
, 0, 1, 0,
4729 "Update buffer's recorded modification time from the visited file's time.\n\
4730 Useful if the buffer was not read from the file normally\n\
4731 or if the file itself has been changed for some known benign reason.\n\
4732 An argument specifies the modification time value to use\n\
4733 \(instead of that of the visited file), in the form of a list\n\
4734 \(HIGH . LOW) or (HIGH LOW).")
4736 Lisp_Object time_list
;
4738 if (!NILP (time_list
))
4739 current_buffer
->modtime
= cons_to_long (time_list
);
4742 register Lisp_Object filename
;
4744 Lisp_Object handler
;
4746 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4748 /* If the file name has special constructs in it,
4749 call the corresponding file handler. */
4750 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4751 if (!NILP (handler
))
4752 /* The handler can find the file name the same way we did. */
4753 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4755 filename
= ENCODE_FILE (filename
);
4757 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4758 current_buffer
->modtime
= st
.st_mtime
;
4768 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 1);
4769 Fsleep_for (make_number (1), Qnil
);
4770 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4771 Fsleep_for (make_number (1), Qnil
);
4772 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4773 Fsleep_for (make_number (1), Qnil
);
4783 /* Get visited file's mode to become the auto save file's mode. */
4784 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4785 /* But make sure we can overwrite it later! */
4786 auto_save_mode_bits
= st
.st_mode
| 0600;
4788 auto_save_mode_bits
= 0666;
4791 Fwrite_region (Qnil
, Qnil
,
4792 current_buffer
->auto_save_file_name
,
4793 Qnil
, Qlambda
, Qnil
, Qnil
);
4797 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4802 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4803 | XFASTINT (XCONS (stream
)->cdr
)));
4808 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4811 minibuffer_auto_raise
= XINT (value
);
4815 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4816 "Auto-save all buffers that need it.\n\
4817 This is all buffers that have auto-saving enabled\n\
4818 and are changed since last auto-saved.\n\
4819 Auto-saving writes the buffer into a file\n\
4820 so that your editing is not lost if the system crashes.\n\
4821 This file is not the file you visited; that changes only when you save.\n\
4822 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4823 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4824 A non-nil CURRENT-ONLY argument means save only current buffer.")
4825 (no_message
, current_only
)
4826 Lisp_Object no_message
, current_only
;
4828 struct buffer
*old
= current_buffer
, *b
;
4829 Lisp_Object tail
, buf
;
4831 char *omessage
= echo_area_glyphs
;
4832 int omessage_length
= echo_area_glyphs_length
;
4833 int oldmultibyte
= message_enable_multibyte
;
4834 int do_handled_files
;
4837 Lisp_Object lispstream
;
4838 int count
= specpdl_ptr
- specpdl
;
4840 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4842 /* Ordinarily don't quit within this function,
4843 but don't make it impossible to quit (in case we get hung in I/O). */
4847 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4848 point to non-strings reached from Vbuffer_alist. */
4853 if (!NILP (Vrun_hooks
))
4854 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4856 if (STRINGP (Vauto_save_list_file_name
))
4858 Lisp_Object listfile
;
4859 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4860 stream
= fopen (XSTRING (listfile
)->data
, "w");
4863 /* Arrange to close that file whether or not we get an error.
4864 Also reset auto_saving to 0. */
4865 lispstream
= Fcons (Qnil
, Qnil
);
4866 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
4867 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
4878 record_unwind_protect (do_auto_save_unwind
, lispstream
);
4879 record_unwind_protect (do_auto_save_unwind_1
,
4880 make_number (minibuffer_auto_raise
));
4881 minibuffer_auto_raise
= 0;
4884 /* First, save all files which don't have handlers. If Emacs is
4885 crashing, the handlers may tweak what is causing Emacs to crash
4886 in the first place, and it would be a shame if Emacs failed to
4887 autosave perfectly ordinary files because it couldn't handle some
4889 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4890 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4892 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4895 /* Record all the buffers that have auto save mode
4896 in the special file that lists them. For each of these buffers,
4897 Record visited name (if any) and auto save name. */
4898 if (STRINGP (b
->auto_save_file_name
)
4899 && stream
!= NULL
&& do_handled_files
== 0)
4901 if (!NILP (b
->filename
))
4903 fwrite (XSTRING (b
->filename
)->data
, 1,
4904 STRING_BYTES (XSTRING (b
->filename
)), stream
);
4906 putc ('\n', stream
);
4907 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
4908 STRING_BYTES (XSTRING (b
->auto_save_file_name
)), stream
);
4909 putc ('\n', stream
);
4912 if (!NILP (current_only
)
4913 && b
!= current_buffer
)
4916 /* Don't auto-save indirect buffers.
4917 The base buffer takes care of it. */
4921 /* Check for auto save enabled
4922 and file changed since last auto save
4923 and file changed since last real save. */
4924 if (STRINGP (b
->auto_save_file_name
)
4925 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4926 && b
->auto_save_modified
< BUF_MODIFF (b
)
4927 /* -1 means we've turned off autosaving for a while--see below. */
4928 && XINT (b
->save_length
) >= 0
4929 && (do_handled_files
4930 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4933 EMACS_TIME before_time
, after_time
;
4935 EMACS_GET_TIME (before_time
);
4937 /* If we had a failure, don't try again for 20 minutes. */
4938 if (b
->auto_save_failure_time
>= 0
4939 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4942 if ((XFASTINT (b
->save_length
) * 10
4943 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4944 /* A short file is likely to change a large fraction;
4945 spare the user annoying messages. */
4946 && XFASTINT (b
->save_length
) > 5000
4947 /* These messages are frequent and annoying for `*mail*'. */
4948 && !EQ (b
->filename
, Qnil
)
4949 && NILP (no_message
))
4951 /* It has shrunk too much; turn off auto-saving here. */
4952 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
4953 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
4955 minibuffer_auto_raise
= 0;
4956 /* Turn off auto-saving until there's a real save,
4957 and prevent any more warnings. */
4958 XSETINT (b
->save_length
, -1);
4959 Fsleep_for (make_number (1), Qnil
);
4962 set_buffer_internal (b
);
4963 if (!auto_saved
&& NILP (no_message
))
4964 message1 ("Auto-saving...");
4965 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4967 b
->auto_save_modified
= BUF_MODIFF (b
);
4968 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4969 set_buffer_internal (old
);
4971 EMACS_GET_TIME (after_time
);
4973 /* If auto-save took more than 60 seconds,
4974 assume it was an NFS failure that got a timeout. */
4975 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4976 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4980 /* Prevent another auto save till enough input events come in. */
4981 record_auto_save ();
4983 if (auto_saved
&& NILP (no_message
))
4987 sit_for (1, 0, 0, 0, 0);
4988 message2 (omessage
, omessage_length
, oldmultibyte
);
4991 message1 ("Auto-saving...done");
4996 unbind_to (count
, Qnil
);
5000 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5001 Sset_buffer_auto_saved
, 0, 0, 0,
5002 "Mark current buffer as auto-saved with its current text.\n\
5003 No auto-save file will be written until the buffer changes again.")
5006 current_buffer
->auto_save_modified
= MODIFF
;
5007 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5008 current_buffer
->auto_save_failure_time
= -1;
5012 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5013 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5014 "Clear any record of a recent auto-save failure in the current buffer.")
5017 current_buffer
->auto_save_failure_time
= -1;
5021 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5023 "Return t if buffer has been auto-saved since last read in or saved.")
5026 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5029 /* Reading and completing file names */
5030 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5032 /* In the string VAL, change each $ to $$ and return the result. */
5035 double_dollars (val
)
5038 register unsigned char *old
, *new;
5042 osize
= STRING_BYTES (XSTRING (val
));
5044 /* Count the number of $ characters. */
5045 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
5046 if (*old
++ == '$') count
++;
5049 old
= XSTRING (val
)->data
;
5050 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
5052 new = XSTRING (val
)->data
;
5053 for (n
= osize
; n
> 0; n
--)
5066 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5068 "Internal subroutine for read-file-name. Do not call this.")
5069 (string
, dir
, action
)
5070 Lisp_Object string
, dir
, action
;
5071 /* action is nil for complete, t for return list of completions,
5072 lambda for verify final value */
5074 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5076 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5078 CHECK_STRING (string
, 0);
5085 /* No need to protect ACTION--we only compare it with t and nil. */
5086 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5088 if (XSTRING (string
)->size
== 0)
5090 if (EQ (action
, Qlambda
))
5098 orig_string
= string
;
5099 string
= Fsubstitute_in_file_name (string
);
5100 changed
= NILP (Fstring_equal (string
, orig_string
));
5101 name
= Ffile_name_nondirectory (string
);
5102 val
= Ffile_name_directory (string
);
5104 realdir
= Fexpand_file_name (val
, realdir
);
5109 specdir
= Ffile_name_directory (string
);
5110 val
= Ffile_name_completion (name
, realdir
);
5115 return double_dollars (string
);
5119 if (!NILP (specdir
))
5120 val
= concat2 (specdir
, val
);
5122 return double_dollars (val
);
5125 #endif /* not VMS */
5129 if (EQ (action
, Qt
))
5130 return Ffile_name_all_completions (name
, realdir
);
5131 /* Only other case actually used is ACTION = lambda */
5133 /* Supposedly this helps commands such as `cd' that read directory names,
5134 but can someone explain how it helps them? -- RMS */
5135 if (XSTRING (name
)->size
== 0)
5138 return Ffile_exists_p (string
);
5141 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5142 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5143 Value is not expanded---you must call `expand-file-name' yourself.\n\
5144 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5145 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5146 except that if INITIAL is specified, that combined with DIR is used.)\n\
5147 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5148 Non-nil and non-t means also require confirmation after completion.\n\
5149 Fifth arg INITIAL specifies text to start with.\n\
5150 DIR defaults to current buffer's directory default.")
5151 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5152 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5154 Lisp_Object val
, insdef
, insdef1
, tem
;
5155 struct gcpro gcpro1
, gcpro2
;
5156 register char *homedir
;
5157 int replace_in_history
= 0;
5158 int add_to_history
= 0;
5162 dir
= current_buffer
->directory
;
5163 if (NILP (default_filename
))
5165 if (! NILP (initial
))
5166 default_filename
= Fexpand_file_name (initial
, dir
);
5168 default_filename
= current_buffer
->filename
;
5171 /* If dir starts with user's homedir, change that to ~. */
5172 homedir
= (char *) egetenv ("HOME");
5174 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5175 CORRECT_DIR_SEPS (homedir
);
5179 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5180 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5182 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5183 STRING_BYTES (XSTRING (dir
)) - strlen (homedir
) + 1);
5184 XSTRING (dir
)->data
[0] = '~';
5187 if (insert_default_directory
&& STRINGP (dir
))
5190 if (!NILP (initial
))
5192 Lisp_Object args
[2], pos
;
5196 insdef
= Fconcat (2, args
);
5197 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5198 insdef1
= Fcons (double_dollars (insdef
), pos
);
5201 insdef1
= double_dollars (insdef
);
5203 else if (STRINGP (initial
))
5206 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
5209 insdef
= Qnil
, insdef1
= Qnil
;
5212 count
= specpdl_ptr
- specpdl
;
5213 specbind (intern ("completion-ignore-case"), Qt
);
5216 GCPRO2 (insdef
, default_filename
);
5217 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5218 dir
, mustmatch
, insdef1
,
5219 Qfile_name_history
, default_filename
, Qnil
);
5221 tem
= Fsymbol_value (Qfile_name_history
);
5222 if (CONSP (tem
) && EQ (XCONS (tem
)->car
, val
))
5223 replace_in_history
= 1;
5225 /* If Fcompleting_read returned the inserted default string itself
5226 (rather than a new string with the same contents),
5227 it has to mean that the user typed RET with the minibuffer empty.
5228 In that case, we really want to return ""
5229 so that commands such as set-visited-file-name can distinguish. */
5230 if (EQ (val
, default_filename
))
5232 /* In this case, Fcompleting_read has not added an element
5233 to the history. Maybe we should. */
5234 if (! replace_in_history
)
5237 val
= build_string ("");
5241 unbind_to (count
, Qnil
);
5246 error ("No file name specified");
5248 tem
= Fstring_equal (val
, insdef
);
5250 if (!NILP (tem
) && !NILP (default_filename
))
5251 val
= default_filename
;
5252 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5254 if (!NILP (default_filename
))
5255 val
= default_filename
;
5257 error ("No default file name");
5259 val
= Fsubstitute_in_file_name (val
);
5261 if (replace_in_history
)
5262 /* Replace what Fcompleting_read added to the history
5263 with what we will actually return. */
5264 XCONS (Fsymbol_value (Qfile_name_history
))->car
= val
;
5265 else if (add_to_history
)
5267 /* Add the value to the history--but not if it matches
5268 the last value already there. */
5269 tem
= Fsymbol_value (Qfile_name_history
);
5270 if (! CONSP (tem
) || NILP (Fequal (XCONS (tem
)->car
, val
)))
5271 Fset (Qfile_name_history
,
5280 Qexpand_file_name
= intern ("expand-file-name");
5281 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5282 Qdirectory_file_name
= intern ("directory-file-name");
5283 Qfile_name_directory
= intern ("file-name-directory");
5284 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5285 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5286 Qfile_name_as_directory
= intern ("file-name-as-directory");
5287 Qcopy_file
= intern ("copy-file");
5288 Qmake_directory_internal
= intern ("make-directory-internal");
5289 Qdelete_directory
= intern ("delete-directory");
5290 Qdelete_file
= intern ("delete-file");
5291 Qrename_file
= intern ("rename-file");
5292 Qadd_name_to_file
= intern ("add-name-to-file");
5293 Qmake_symbolic_link
= intern ("make-symbolic-link");
5294 Qfile_exists_p
= intern ("file-exists-p");
5295 Qfile_executable_p
= intern ("file-executable-p");
5296 Qfile_readable_p
= intern ("file-readable-p");
5297 Qfile_writable_p
= intern ("file-writable-p");
5298 Qfile_symlink_p
= intern ("file-symlink-p");
5299 Qaccess_file
= intern ("access-file");
5300 Qfile_directory_p
= intern ("file-directory-p");
5301 Qfile_regular_p
= intern ("file-regular-p");
5302 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5303 Qfile_modes
= intern ("file-modes");
5304 Qset_file_modes
= intern ("set-file-modes");
5305 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5306 Qinsert_file_contents
= intern ("insert-file-contents");
5307 Qwrite_region
= intern ("write-region");
5308 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5309 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5311 staticpro (&Qexpand_file_name
);
5312 staticpro (&Qsubstitute_in_file_name
);
5313 staticpro (&Qdirectory_file_name
);
5314 staticpro (&Qfile_name_directory
);
5315 staticpro (&Qfile_name_nondirectory
);
5316 staticpro (&Qunhandled_file_name_directory
);
5317 staticpro (&Qfile_name_as_directory
);
5318 staticpro (&Qcopy_file
);
5319 staticpro (&Qmake_directory_internal
);
5320 staticpro (&Qdelete_directory
);
5321 staticpro (&Qdelete_file
);
5322 staticpro (&Qrename_file
);
5323 staticpro (&Qadd_name_to_file
);
5324 staticpro (&Qmake_symbolic_link
);
5325 staticpro (&Qfile_exists_p
);
5326 staticpro (&Qfile_executable_p
);
5327 staticpro (&Qfile_readable_p
);
5328 staticpro (&Qfile_writable_p
);
5329 staticpro (&Qaccess_file
);
5330 staticpro (&Qfile_symlink_p
);
5331 staticpro (&Qfile_directory_p
);
5332 staticpro (&Qfile_regular_p
);
5333 staticpro (&Qfile_accessible_directory_p
);
5334 staticpro (&Qfile_modes
);
5335 staticpro (&Qset_file_modes
);
5336 staticpro (&Qfile_newer_than_file_p
);
5337 staticpro (&Qinsert_file_contents
);
5338 staticpro (&Qwrite_region
);
5339 staticpro (&Qverify_visited_file_modtime
);
5340 staticpro (&Qset_visited_file_modtime
);
5342 Qfile_name_history
= intern ("file-name-history");
5343 Fset (Qfile_name_history
, Qnil
);
5344 staticpro (&Qfile_name_history
);
5346 Qfile_error
= intern ("file-error");
5347 staticpro (&Qfile_error
);
5348 Qfile_already_exists
= intern ("file-already-exists");
5349 staticpro (&Qfile_already_exists
);
5350 Qfile_date_error
= intern ("file-date-error");
5351 staticpro (&Qfile_date_error
);
5354 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5355 staticpro (&Qfind_buffer_file_type
);
5358 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5359 "*Coding system for encoding file names.\n\
5360 If it is nil, default-file-name-coding-system (which see) is used.");
5361 Vfile_name_coding_system
= Qnil
;
5363 DEFVAR_LISP ("default-file-name-coding-system",
5364 &Vdefault_file_name_coding_system
,
5365 "Default coding system for encoding file names.\n\
5366 This variable is used only when file-name-coding-system is nil.\n\
5368 This variable is set/changed by the command set-language-environment.\n\
5369 User should not set this variable manually,\n\
5370 instead use file-name-coding-system to get a constant encoding\n\
5371 of file names regardless of the current language environment.");
5372 Vdefault_file_name_coding_system
= Qnil
;
5374 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5375 "*Format in which to write auto-save files.\n\
5376 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5377 If it is t, which is the default, auto-save files are written in the\n\
5378 same format as a regular save would use.");
5379 Vauto_save_file_format
= Qt
;
5381 Qformat_decode
= intern ("format-decode");
5382 staticpro (&Qformat_decode
);
5383 Qformat_annotate_function
= intern ("format-annotate-function");
5384 staticpro (&Qformat_annotate_function
);
5386 Qcar_less_than_car
= intern ("car-less-than-car");
5387 staticpro (&Qcar_less_than_car
);
5389 Fput (Qfile_error
, Qerror_conditions
,
5390 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5391 Fput (Qfile_error
, Qerror_message
,
5392 build_string ("File error"));
5394 Fput (Qfile_already_exists
, Qerror_conditions
,
5395 Fcons (Qfile_already_exists
,
5396 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5397 Fput (Qfile_already_exists
, Qerror_message
,
5398 build_string ("File already exists"));
5400 Fput (Qfile_date_error
, Qerror_conditions
,
5401 Fcons (Qfile_date_error
,
5402 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5403 Fput (Qfile_date_error
, Qerror_message
,
5404 build_string ("Cannot set file date"));
5406 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5407 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5408 insert_default_directory
= 1;
5410 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5411 "*Non-nil means write new files with record format `stmlf'.\n\
5412 nil means use format `var'. This variable is meaningful only on VMS.");
5413 vms_stmlf_recfm
= 0;
5415 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5416 "Directory separator character for built-in functions that return file names.\n\
5417 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5418 This variable affects the built-in functions only on Windows,\n\
5419 on other platforms, it is initialized so that Lisp code can find out\n\
5420 what the normal separator is.");
5421 XSETFASTINT (Vdirectory_sep_char
, '/');
5423 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5424 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5425 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5428 The first argument given to HANDLER is the name of the I/O primitive\n\
5429 to be handled; the remaining arguments are the arguments that were\n\
5430 passed to that primitive. For example, if you do\n\
5431 (file-exists-p FILENAME)\n\
5432 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5433 (funcall HANDLER 'file-exists-p FILENAME)\n\
5434 The function `find-file-name-handler' checks this list for a handler\n\
5435 for its argument.");
5436 Vfile_name_handler_alist
= Qnil
;
5438 DEFVAR_LISP ("set-auto-coding-function",
5439 &Vset_auto_coding_function
,
5440 "If non-nil, a function to call to decide a coding system of file.\n\
5441 One argument is passed to this function: the string of concatination\n\
5442 or the heading 1K-byte and the tailing 3K-byte of a file to be read.\n\
5443 This function should return a coding system to decode the file contents\n\
5444 specified in the heading lines with the format:\n\
5445 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5446 or local variable spec of the tailing lines with `coding:' tag.");
5447 Vset_auto_coding_function
= Qnil
;
5449 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5450 "A list of functions to be called at the end of `insert-file-contents'.\n\
5451 Each is passed one argument, the number of bytes inserted. It should return\n\
5452 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5453 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5454 responsible for calling the after-insert-file-functions if appropriate.");
5455 Vafter_insert_file_functions
= Qnil
;
5457 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5458 "A list of functions to be called at the start of `write-region'.\n\
5459 Each is passed two arguments, START and END as for `write-region'.\n\
5460 These are usually two numbers but not always; see the documentation\n\
5461 for `write-region'. The function should return a list of pairs\n\
5462 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5463 inserted at the specified positions of the file being written (1 means to\n\
5464 insert before the first byte written). The POSITIONs must be sorted into\n\
5465 increasing order. If there are several functions in the list, the several\n\
5466 lists are merged destructively.");
5467 Vwrite_region_annotate_functions
= Qnil
;
5469 DEFVAR_LISP ("write-region-annotations-so-far",
5470 &Vwrite_region_annotations_so_far
,
5471 "When an annotation function is called, this holds the previous annotations.\n\
5472 These are the annotations made by other annotation functions\n\
5473 that were already called. See also `write-region-annotate-functions'.");
5474 Vwrite_region_annotations_so_far
= Qnil
;
5476 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5477 "A list of file name handlers that temporarily should not be used.\n\
5478 This applies only to the operation `inhibit-file-name-operation'.");
5479 Vinhibit_file_name_handlers
= Qnil
;
5481 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5482 "The operation for which `inhibit-file-name-handlers' is applicable.");
5483 Vinhibit_file_name_operation
= Qnil
;
5485 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5486 "File name in which we write a list of all auto save file names.\n\
5487 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5488 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5490 Vauto_save_list_file_name
= Qnil
;
5492 defsubr (&Sfind_file_name_handler
);
5493 defsubr (&Sfile_name_directory
);
5494 defsubr (&Sfile_name_nondirectory
);
5495 defsubr (&Sunhandled_file_name_directory
);
5496 defsubr (&Sfile_name_as_directory
);
5497 defsubr (&Sdirectory_file_name
);
5498 defsubr (&Smake_temp_name
);
5499 defsubr (&Sexpand_file_name
);
5500 defsubr (&Ssubstitute_in_file_name
);
5501 defsubr (&Scopy_file
);
5502 defsubr (&Smake_directory_internal
);
5503 defsubr (&Sdelete_directory
);
5504 defsubr (&Sdelete_file
);
5505 defsubr (&Srename_file
);
5506 defsubr (&Sadd_name_to_file
);
5508 defsubr (&Smake_symbolic_link
);
5509 #endif /* S_IFLNK */
5511 defsubr (&Sdefine_logical_name
);
5514 defsubr (&Ssysnetunam
);
5515 #endif /* HPUX_NET */
5516 defsubr (&Sfile_name_absolute_p
);
5517 defsubr (&Sfile_exists_p
);
5518 defsubr (&Sfile_executable_p
);
5519 defsubr (&Sfile_readable_p
);
5520 defsubr (&Sfile_writable_p
);
5521 defsubr (&Saccess_file
);
5522 defsubr (&Sfile_symlink_p
);
5523 defsubr (&Sfile_directory_p
);
5524 defsubr (&Sfile_accessible_directory_p
);
5525 defsubr (&Sfile_regular_p
);
5526 defsubr (&Sfile_modes
);
5527 defsubr (&Sset_file_modes
);
5528 defsubr (&Sset_default_file_modes
);
5529 defsubr (&Sdefault_file_modes
);
5530 defsubr (&Sfile_newer_than_file_p
);
5531 defsubr (&Sinsert_file_contents
);
5532 defsubr (&Swrite_region
);
5533 defsubr (&Scar_less_than_car
);
5534 defsubr (&Sverify_visited_file_modtime
);
5535 defsubr (&Sclear_visited_file_modtime
);
5536 defsubr (&Svisited_file_modtime
);
5537 defsubr (&Sset_visited_file_modtime
);
5538 defsubr (&Sdo_auto_save
);
5539 defsubr (&Sset_buffer_auto_saved
);
5540 defsubr (&Sclear_buffer_auto_save_failure
);
5541 defsubr (&Srecent_auto_save_p
);
5543 defsubr (&Sread_file_name_internal
);
5544 defsubr (&Sread_file_name
);
5547 defsubr (&Sunix_sync
);