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;
942 CHECK_STRING (name
, 0);
944 /* If the file name has special constructs in it,
945 call the corresponding file handler. */
946 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
948 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
950 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
951 if (NILP (default_directory
))
952 default_directory
= current_buffer
->directory
;
953 if (! STRINGP (default_directory
))
954 default_directory
= build_string ("/");
956 if (!NILP (default_directory
))
958 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
960 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
963 o
= XSTRING (default_directory
)->data
;
965 /* Make sure DEFAULT_DIRECTORY is properly expanded.
966 It would be better to do this down below where we actually use
967 default_directory. Unfortunately, calling Fexpand_file_name recursively
968 could invoke GC, and the strings might be relocated. This would
969 be annoying because we have pointers into strings lying around
970 that would need adjusting, and people would add new pointers to
971 the code and forget to adjust them, resulting in intermittent bugs.
972 Putting this call here avoids all that crud.
974 The EQ test avoids infinite recursion. */
975 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
976 /* Save time in some common cases - as long as default_directory
977 is not relative, it can be canonicalized with name below (if it
978 is needed at all) without requiring it to be expanded now. */
980 /* Detect MSDOS file names with drive specifiers. */
981 && ! (IS_DRIVE (o
[0]) && (IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2])))
983 /* Detect Windows file names in UNC format. */
984 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
986 #else /* not DOS_NT */
987 /* Detect Unix absolute file names (/... alone is not absolute on
989 && ! (IS_DIRECTORY_SEP (o
[0]))
990 #endif /* not DOS_NT */
996 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1001 /* Filenames on VMS are always upper case. */
1002 name
= Fupcase (name
);
1004 #ifdef FILE_SYSTEM_CASE
1005 name
= FILE_SYSTEM_CASE (name
);
1008 nm
= XSTRING (name
)->data
;
1011 /* We will force directory separators to be either all \ or /, so make
1012 a local copy to modify, even if there ends up being no change. */
1013 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1015 /* Find and remove drive specifier if present; this makes nm absolute
1016 even if the rest of the name appears to be relative. */
1018 unsigned char *colon
= rindex (nm
, ':');
1021 /* Only recognize colon as part of drive specifier if there is a
1022 single alphabetic character preceeding the colon (and if the
1023 character before the drive letter, if present, is a directory
1024 separator); this is to support the remote system syntax used by
1025 ange-ftp, and the "po:username" syntax for POP mailboxes. */
1029 else if (IS_DRIVE (colon
[-1])
1030 && (colon
== nm
+ 1 || IS_DIRECTORY_SEP (colon
[-2])))
1037 while (--colon
>= nm
)
1038 if (colon
[0] == ':')
1044 /* If we see "c://somedir", we want to strip the first slash after the
1045 colon when stripping the drive letter. Otherwise, this expands to
1047 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1049 #endif /* WINDOWSNT */
1053 /* Discard any previous drive specifier if nm is now in UNC format. */
1054 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1060 /* If nm is absolute, look for /./ or /../ sequences; if none are
1061 found, we can probably return right away. We will avoid allocating
1062 a new string if name is already fully expanded. */
1064 IS_DIRECTORY_SEP (nm
[0])
1069 && (drive
|| IS_DIRECTORY_SEP (nm
[1]))
1076 /* If it turns out that the filename we want to return is just a
1077 suffix of FILENAME, we don't need to go through and edit
1078 things; we just need to construct a new string using data
1079 starting at the middle of FILENAME. If we set lose to a
1080 non-zero value, that means we've discovered that we can't do
1087 /* Since we know the name is absolute, we can assume that each
1088 element starts with a "/". */
1090 /* "." and ".." are hairy. */
1091 if (IS_DIRECTORY_SEP (p
[0])
1093 && (IS_DIRECTORY_SEP (p
[2])
1095 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1102 /* if dev:[dir]/, move nm to / */
1103 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1104 nm
= (brack
? brack
+ 1 : colon
+ 1);
1105 lbrack
= rbrack
= 0;
1113 /* VMS pre V4.4,convert '-'s in filenames. */
1114 if (lbrack
== rbrack
)
1116 if (dots
< 2) /* this is to allow negative version numbers */
1121 if (lbrack
> rbrack
&&
1122 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1123 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1129 /* count open brackets, reset close bracket pointer */
1130 if (p
[0] == '[' || p
[0] == '<')
1131 lbrack
++, brack
= 0;
1132 /* count close brackets, set close bracket pointer */
1133 if (p
[0] == ']' || p
[0] == '>')
1134 rbrack
++, brack
= p
;
1135 /* detect ][ or >< */
1136 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1138 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1139 nm
= p
+ 1, lose
= 1;
1140 if (p
[0] == ':' && (colon
|| slash
))
1141 /* if dev1:[dir]dev2:, move nm to dev2: */
1147 /* if /name/dev:, move nm to dev: */
1150 /* if node::dev:, move colon following dev */
1151 else if (colon
&& colon
[-1] == ':')
1153 /* if dev1:dev2:, move nm to dev2: */
1154 else if (colon
&& colon
[-1] != ':')
1159 if (p
[0] == ':' && !colon
)
1165 if (lbrack
== rbrack
)
1168 else if (p
[0] == '.')
1176 if (index (nm
, '/'))
1177 return build_string (sys_translate_unix (nm
));
1180 /* Make sure directories are all separated with / or \ as
1181 desired, but avoid allocation of a new string when not
1183 CORRECT_DIR_SEPS (nm
);
1185 if (IS_DIRECTORY_SEP (nm
[1]))
1187 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1188 name
= build_string (nm
);
1192 /* drive must be set, so this is okay */
1193 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1195 name
= make_string (nm
- 2, p
- nm
+ 2);
1196 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1197 XSTRING (name
)->data
[1] = ':';
1200 #else /* not DOS_NT */
1201 if (nm
== XSTRING (name
)->data
)
1203 return build_string (nm
);
1204 #endif /* not DOS_NT */
1208 /* At this point, nm might or might not be an absolute file name. We
1209 need to expand ~ or ~user if present, otherwise prefix nm with
1210 default_directory if nm is not absolute, and finally collapse /./
1211 and /foo/../ sequences.
1213 We set newdir to be the appropriate prefix if one is needed:
1214 - the relevant user directory if nm starts with ~ or ~user
1215 - the specified drive's working dir (DOS/NT only) if nm does not
1217 - the value of default_directory.
1219 Note that these prefixes are not guaranteed to be absolute (except
1220 for the working dir of a drive). Therefore, to ensure we always
1221 return an absolute name, if the final prefix is not absolute we
1222 append it to the current working directory. */
1226 if (nm
[0] == '~') /* prefix ~ */
1228 if (IS_DIRECTORY_SEP (nm
[1])
1232 || nm
[1] == 0) /* ~ by itself */
1234 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1235 newdir
= (unsigned char *) "";
1238 collapse_newdir
= 0;
1241 nm
++; /* Don't leave the slash in nm. */
1244 else /* ~user/filename */
1246 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1251 o
= (unsigned char *) alloca (p
- nm
+ 1);
1252 bcopy ((char *) nm
, o
, p
- nm
);
1255 pw
= (struct passwd
*) getpwnam (o
+ 1);
1258 newdir
= (unsigned char *) pw
-> pw_dir
;
1260 nm
= p
+ 1; /* skip the terminator */
1264 collapse_newdir
= 0;
1269 /* If we don't find a user of that name, leave the name
1270 unchanged; don't move nm forward to p. */
1275 /* On DOS and Windows, nm is absolute if a drive name was specified;
1276 use the drive's current directory as the prefix if needed. */
1277 if (!newdir
&& drive
)
1279 /* Get default directory if needed to make nm absolute. */
1280 if (!IS_DIRECTORY_SEP (nm
[0]))
1282 newdir
= alloca (MAXPATHLEN
+ 1);
1283 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1288 /* Either nm starts with /, or drive isn't mounted. */
1289 newdir
= alloca (4);
1290 newdir
[0] = DRIVE_LETTER (drive
);
1298 /* Finally, if no prefix has been specified and nm is not absolute,
1299 then it must be expanded relative to default_directory. */
1303 /* /... alone is not absolute on DOS and Windows. */
1304 && !IS_DIRECTORY_SEP (nm
[0])
1307 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1314 newdir
= XSTRING (default_directory
)->data
;
1320 /* First ensure newdir is an absolute name. */
1322 /* Detect MSDOS file names with drive specifiers. */
1323 ! (IS_DRIVE (newdir
[0])
1324 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1326 /* Detect Windows file names in UNC format. */
1327 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1331 /* Effectively, let newdir be (expand-file-name newdir cwd).
1332 Because of the admonition against calling expand-file-name
1333 when we have pointers into lisp strings, we accomplish this
1334 indirectly by prepending newdir to nm if necessary, and using
1335 cwd (or the wd of newdir's drive) as the new newdir. */
1337 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1342 if (!IS_DIRECTORY_SEP (nm
[0]))
1344 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1345 file_name_as_directory (tmp
, newdir
);
1349 newdir
= alloca (MAXPATHLEN
+ 1);
1352 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1359 /* Strip off drive name from prefix, if present. */
1360 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1366 /* Keep only a prefix from newdir if nm starts with slash
1367 (//server/share for UNC, nothing otherwise). */
1368 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1371 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1373 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1375 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1377 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1389 /* Get rid of any slash at the end of newdir, unless newdir is
1390 just // (an incomplete UNC name). */
1391 length
= strlen (newdir
);
1392 if (length
> 0 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1394 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1398 unsigned char *temp
= (unsigned char *) alloca (length
);
1399 bcopy (newdir
, temp
, length
- 1);
1400 temp
[length
- 1] = 0;
1408 /* Now concatenate the directory and name to new space in the stack frame */
1409 tlen
+= strlen (nm
) + 1;
1411 /* Add reserved space for drive name. (The Microsoft x86 compiler
1412 produces incorrect code if the following two lines are combined.) */
1413 target
= (unsigned char *) alloca (tlen
+ 2);
1415 #else /* not DOS_NT */
1416 target
= (unsigned char *) alloca (tlen
);
1417 #endif /* not DOS_NT */
1423 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1424 strcpy (target
, newdir
);
1427 file_name_as_directory (target
, newdir
);
1430 strcat (target
, nm
);
1432 if (index (target
, '/'))
1433 strcpy (target
, sys_translate_unix (target
));
1436 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1438 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1446 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1452 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1453 /* brackets are offset from each other by 2 */
1456 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1457 /* convert [foo][bar] to [bar] */
1458 while (o
[-1] != '[' && o
[-1] != '<')
1460 else if (*p
== '-' && *o
!= '.')
1463 else if (p
[0] == '-' && o
[-1] == '.' &&
1464 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1465 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1469 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1470 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1472 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1474 /* else [foo.-] ==> [-] */
1480 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1481 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1487 if (!IS_DIRECTORY_SEP (*p
))
1491 else if (IS_DIRECTORY_SEP (p
[0])
1493 && (IS_DIRECTORY_SEP (p
[2])
1496 /* If "/." is the entire filename, keep the "/". Otherwise,
1497 just delete the whole "/.". */
1498 if (o
== target
&& p
[2] == '\0')
1502 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1503 /* `/../' is the "superroot" on certain file systems. */
1505 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1507 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1509 /* Keep initial / only if this is the whole name. */
1510 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1518 #endif /* not VMS */
1522 /* At last, set drive name. */
1524 /* Except for network file name. */
1525 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1526 #endif /* WINDOWSNT */
1528 if (!drive
) abort ();
1530 target
[0] = DRIVE_LETTER (drive
);
1533 CORRECT_DIR_SEPS (target
);
1536 return make_string (target
, o
- target
);
1540 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1541 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1542 "Convert FILENAME to absolute, and canonicalize it.\n\
1543 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1544 (does not start with slash); if DEFAULT is nil or missing,\n\
1545 the current buffer's value of default-directory is used.\n\
1546 Filenames containing `.' or `..' as components are simplified;\n\
1547 initial `~/' expands to your home directory.\n\
1548 See also the function `substitute-in-file-name'.")
1550 Lisp_Object name
, defalt
;
1554 register unsigned char *newdir
, *p
, *o
;
1556 unsigned char *target
;
1560 unsigned char * colon
= 0;
1561 unsigned char * close
= 0;
1562 unsigned char * slash
= 0;
1563 unsigned char * brack
= 0;
1564 int lbrack
= 0, rbrack
= 0;
1568 CHECK_STRING (name
, 0);
1571 /* Filenames on VMS are always upper case. */
1572 name
= Fupcase (name
);
1575 nm
= XSTRING (name
)->data
;
1577 /* If nm is absolute, flush ...// and detect /./ and /../.
1578 If no /./ or /../ we can return right away. */
1590 if (p
[0] == '/' && p
[1] == '/'
1592 /* // at start of filename is meaningful on Apollo system. */
1597 if (p
[0] == '/' && p
[1] == '~')
1598 nm
= p
+ 1, lose
= 1;
1599 if (p
[0] == '/' && p
[1] == '.'
1600 && (p
[2] == '/' || p
[2] == 0
1601 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1607 /* if dev:[dir]/, move nm to / */
1608 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1609 nm
= (brack
? brack
+ 1 : colon
+ 1);
1610 lbrack
= rbrack
= 0;
1618 /* VMS pre V4.4,convert '-'s in filenames. */
1619 if (lbrack
== rbrack
)
1621 if (dots
< 2) /* this is to allow negative version numbers */
1626 if (lbrack
> rbrack
&&
1627 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1628 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1634 /* count open brackets, reset close bracket pointer */
1635 if (p
[0] == '[' || p
[0] == '<')
1636 lbrack
++, brack
= 0;
1637 /* count close brackets, set close bracket pointer */
1638 if (p
[0] == ']' || p
[0] == '>')
1639 rbrack
++, brack
= p
;
1640 /* detect ][ or >< */
1641 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1643 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1644 nm
= p
+ 1, lose
= 1;
1645 if (p
[0] == ':' && (colon
|| slash
))
1646 /* if dev1:[dir]dev2:, move nm to dev2: */
1652 /* If /name/dev:, move nm to dev: */
1655 /* If node::dev:, move colon following dev */
1656 else if (colon
&& colon
[-1] == ':')
1658 /* If dev1:dev2:, move nm to dev2: */
1659 else if (colon
&& colon
[-1] != ':')
1664 if (p
[0] == ':' && !colon
)
1670 if (lbrack
== rbrack
)
1673 else if (p
[0] == '.')
1681 if (index (nm
, '/'))
1682 return build_string (sys_translate_unix (nm
));
1684 if (nm
== XSTRING (name
)->data
)
1686 return build_string (nm
);
1690 /* Now determine directory to start with and put it in NEWDIR */
1694 if (nm
[0] == '~') /* prefix ~ */
1699 || nm
[1] == 0)/* ~/filename */
1701 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1702 newdir
= (unsigned char *) "";
1705 nm
++; /* Don't leave the slash in nm. */
1708 else /* ~user/filename */
1710 /* Get past ~ to user */
1711 unsigned char *user
= nm
+ 1;
1712 /* Find end of name. */
1713 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1714 int len
= ptr
? ptr
- user
: strlen (user
);
1716 unsigned char *ptr1
= index (user
, ':');
1717 if (ptr1
!= 0 && ptr1
- user
< len
)
1720 /* Copy the user name into temp storage. */
1721 o
= (unsigned char *) alloca (len
+ 1);
1722 bcopy ((char *) user
, o
, len
);
1725 /* Look up the user name. */
1726 pw
= (struct passwd
*) getpwnam (o
+ 1);
1728 error ("\"%s\" isn't a registered user", o
+ 1);
1730 newdir
= (unsigned char *) pw
->pw_dir
;
1732 /* Discard the user name from NM. */
1739 #endif /* not VMS */
1743 defalt
= current_buffer
->directory
;
1744 CHECK_STRING (defalt
, 1);
1745 newdir
= XSTRING (defalt
)->data
;
1748 /* Now concatenate the directory and name to new space in the stack frame */
1750 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1751 target
= (unsigned char *) alloca (tlen
);
1757 if (nm
[0] == 0 || nm
[0] == '/')
1758 strcpy (target
, newdir
);
1761 file_name_as_directory (target
, newdir
);
1764 strcat (target
, nm
);
1766 if (index (target
, '/'))
1767 strcpy (target
, sys_translate_unix (target
));
1770 /* Now canonicalize by removing /. and /foo/.. if they appear */
1778 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1784 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1785 /* brackets are offset from each other by 2 */
1788 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1789 /* convert [foo][bar] to [bar] */
1790 while (o
[-1] != '[' && o
[-1] != '<')
1792 else if (*p
== '-' && *o
!= '.')
1795 else if (p
[0] == '-' && o
[-1] == '.' &&
1796 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1797 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1801 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1802 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1804 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1806 /* else [foo.-] ==> [-] */
1812 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1813 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1823 else if (!strncmp (p
, "//", 2)
1825 /* // at start of filename is meaningful in Apollo system. */
1833 else if (p
[0] == '/' && p
[1] == '.' &&
1834 (p
[2] == '/' || p
[2] == 0))
1836 else if (!strncmp (p
, "/..", 3)
1837 /* `/../' is the "superroot" on certain file systems. */
1839 && (p
[3] == '/' || p
[3] == 0))
1841 while (o
!= target
&& *--o
!= '/')
1844 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1848 if (o
== target
&& *o
== '/')
1856 #endif /* not VMS */
1859 return make_string (target
, o
- target
);
1863 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1864 Ssubstitute_in_file_name
, 1, 1, 0,
1865 "Substitute environment variables referred to in FILENAME.\n\
1866 `$FOO' where FOO is an environment variable name means to substitute\n\
1867 the value of that variable. The variable name should be terminated\n\
1868 with a character not a letter, digit or underscore; otherwise, enclose\n\
1869 the entire variable name in braces.\n\
1870 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1871 On VMS, `$' substitution is not done; this function does little and only\n\
1872 duplicates what `expand-file-name' does.")
1874 Lisp_Object filename
;
1878 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1879 unsigned char *target
;
1881 int substituted
= 0;
1883 Lisp_Object handler
;
1885 CHECK_STRING (filename
, 0);
1887 /* If the file name has special constructs in it,
1888 call the corresponding file handler. */
1889 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1890 if (!NILP (handler
))
1891 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1893 nm
= XSTRING (filename
)->data
;
1895 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1896 CORRECT_DIR_SEPS (nm
);
1897 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1899 endp
= nm
+ STRING_BYTES (XSTRING (filename
));
1901 /* If /~ or // appears, discard everything through first slash. */
1903 for (p
= nm
; p
!= endp
; p
++)
1906 #if defined (APOLLO) || defined (WINDOWSNT)
1907 /* // at start of file name is meaningful in Apollo and
1908 WindowsNT systems. */
1909 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1910 #else /* not (APOLLO || WINDOWSNT) */
1911 || IS_DIRECTORY_SEP (p
[0])
1912 #endif /* not (APOLLO || WINDOWSNT) */
1917 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1919 || IS_DIRECTORY_SEP (p
[-1])))
1925 /* see comment in expand-file-name about drive specifiers */
1926 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1927 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1936 return build_string (nm
);
1939 /* See if any variables are substituted into the string
1940 and find the total length of their values in `total' */
1942 for (p
= nm
; p
!= endp
;)
1952 /* "$$" means a single "$" */
1961 while (p
!= endp
&& *p
!= '}') p
++;
1962 if (*p
!= '}') goto missingclose
;
1968 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1972 /* Copy out the variable name */
1973 target
= (unsigned char *) alloca (s
- o
+ 1);
1974 strncpy (target
, o
, s
- o
);
1977 strupr (target
); /* $home == $HOME etc. */
1980 /* Get variable value */
1981 o
= (unsigned char *) egetenv (target
);
1982 if (!o
) goto badvar
;
1983 total
+= strlen (o
);
1990 /* If substitution required, recopy the string and do it */
1991 /* Make space in stack frame for the new copy */
1992 xnm
= (unsigned char *) alloca (STRING_BYTES (XSTRING (filename
)) + total
+ 1);
1995 /* Copy the rest of the name through, replacing $ constructs with values */
2012 while (p
!= endp
&& *p
!= '}') p
++;
2013 if (*p
!= '}') goto missingclose
;
2019 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2023 /* Copy out the variable name */
2024 target
= (unsigned char *) alloca (s
- o
+ 1);
2025 strncpy (target
, o
, s
- o
);
2028 strupr (target
); /* $home == $HOME etc. */
2031 /* Get variable value */
2032 o
= (unsigned char *) egetenv (target
);
2036 if (STRING_MULTIBYTE (filename
))
2038 /* If the original string is multibyte,
2039 convert what we substitute into multibyte. */
2040 unsigned char workbuf
[4], *str
;
2046 c
= unibyte_char_to_multibyte (c
);
2047 if (! SINGLE_BYTE_CHAR_P (c
))
2049 len
= CHAR_STRING (c
, workbuf
, str
);
2050 bcopy (str
, x
, len
);
2066 /* If /~ or // appears, discard everything through first slash. */
2068 for (p
= xnm
; p
!= x
; p
++)
2070 #if defined (APOLLO) || defined (WINDOWSNT)
2071 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2072 #else /* not (APOLLO || WINDOWSNT) */
2073 || IS_DIRECTORY_SEP (p
[0])
2074 #endif /* not (APOLLO || WINDOWSNT) */
2076 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2079 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2080 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2084 if (STRING_MULTIBYTE (filename
))
2085 return make_string (xnm
, x
- xnm
);
2086 return make_unibyte_string (xnm
, x
- xnm
);
2089 error ("Bad format environment-variable substitution");
2091 error ("Missing \"}\" in environment-variable substitution");
2093 error ("Substituting nonexistent environment variable \"%s\"", target
);
2096 #endif /* not VMS */
2099 /* A slightly faster and more convenient way to get
2100 (directory-file-name (expand-file-name FOO)). */
2103 expand_and_dir_to_file (filename
, defdir
)
2104 Lisp_Object filename
, defdir
;
2106 register Lisp_Object absname
;
2108 absname
= Fexpand_file_name (filename
, defdir
);
2111 register int c
= XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1];
2112 if (c
== ':' || c
== ']' || c
== '>')
2113 absname
= Fdirectory_file_name (absname
);
2116 /* Remove final slash, if any (unless this is the root dir).
2117 stat behaves differently depending! */
2118 if (XSTRING (absname
)->size
> 1
2119 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1])
2120 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
))-2]))
2121 /* We cannot take shortcuts; they might be wrong for magic file names. */
2122 absname
= Fdirectory_file_name (absname
);
2127 /* Signal an error if the file ABSNAME already exists.
2128 If INTERACTIVE is nonzero, ask the user whether to proceed,
2129 and bypass the error if the user says to go ahead.
2130 QUERYSTRING is a name for the action that is being considered
2133 *STATPTR is used to store the stat information if the file exists.
2134 If the file does not exist, STATPTR->st_mode is set to 0.
2135 If STATPTR is null, we don't store into it.
2137 If QUICK is nonzero, we ask for y or n, not yes or no. */
2140 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2141 Lisp_Object absname
;
2142 unsigned char *querystring
;
2144 struct stat
*statptr
;
2147 register Lisp_Object tem
;
2148 struct stat statbuf
;
2149 struct gcpro gcpro1
;
2151 /* stat is a good way to tell whether the file exists,
2152 regardless of what access permissions it has. */
2153 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2156 Fsignal (Qfile_already_exists
,
2157 Fcons (build_string ("File already exists"),
2158 Fcons (absname
, Qnil
)));
2160 tem
= format1 ("File %s already exists; %s anyway? ",
2161 XSTRING (absname
)->data
, querystring
);
2163 tem
= Fy_or_n_p (tem
);
2165 tem
= do_yes_or_no_p (tem
);
2168 Fsignal (Qfile_already_exists
,
2169 Fcons (build_string ("File already exists"),
2170 Fcons (absname
, Qnil
)));
2177 statptr
->st_mode
= 0;
2182 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2183 "fCopy file: \nFCopy %s to file: \np\nP",
2184 "Copy FILE to NEWNAME. Both args must be strings.\n\
2185 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2186 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2187 A number as third arg means request confirmation if NEWNAME already exists.\n\
2188 This is what happens in interactive use with M-x.\n\
2189 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2190 last-modified time as the old one. (This works on only some systems.)\n\
2191 A prefix arg makes KEEP-TIME non-nil.")
2192 (file
, newname
, ok_if_already_exists
, keep_date
)
2193 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2196 char buf
[16 * 1024];
2197 struct stat st
, out_st
;
2198 Lisp_Object handler
;
2199 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2200 int count
= specpdl_ptr
- specpdl
;
2201 int input_file_statable_p
;
2202 Lisp_Object encoded_file
, encoded_newname
;
2204 encoded_file
= encoded_newname
= Qnil
;
2205 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2206 CHECK_STRING (file
, 0);
2207 CHECK_STRING (newname
, 1);
2209 file
= Fexpand_file_name (file
, Qnil
);
2210 newname
= Fexpand_file_name (newname
, Qnil
);
2212 /* If the input file name has special constructs in it,
2213 call the corresponding file handler. */
2214 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2215 /* Likewise for output file name. */
2217 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2218 if (!NILP (handler
))
2219 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2220 ok_if_already_exists
, keep_date
));
2222 encoded_file
= ENCODE_FILE (file
);
2223 encoded_newname
= ENCODE_FILE (newname
);
2225 if (NILP (ok_if_already_exists
)
2226 || INTEGERP (ok_if_already_exists
))
2227 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2228 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2229 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2232 ifd
= open (XSTRING (encoded_file
)->data
, O_RDONLY
);
2234 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2236 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2238 /* We can only copy regular files and symbolic links. Other files are not
2240 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2242 #if !defined (DOS_NT) || __DJGPP__ > 1
2243 if (out_st
.st_mode
!= 0
2244 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2247 report_file_error ("Input and output files are the same",
2248 Fcons (file
, Fcons (newname
, Qnil
)));
2252 #if defined (S_ISREG) && defined (S_ISLNK)
2253 if (input_file_statable_p
)
2255 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2257 #if defined (EISDIR)
2258 /* Get a better looking error message. */
2261 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2264 #endif /* S_ISREG && S_ISLNK */
2267 /* Create the copy file with the same record format as the input file */
2268 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2271 /* System's default file type was set to binary by _fmode in emacs.c. */
2272 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2273 #else /* not MSDOS */
2274 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2275 #endif /* not MSDOS */
2278 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2280 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2284 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2285 if (write (ofd
, buf
, n
) != n
)
2286 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2289 /* Closing the output clobbers the file times on some systems. */
2290 if (close (ofd
) < 0)
2291 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2293 if (input_file_statable_p
)
2295 if (!NILP (keep_date
))
2297 EMACS_TIME atime
, mtime
;
2298 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2299 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2300 if (set_file_times (XSTRING (encoded_newname
)->data
,
2302 Fsignal (Qfile_date_error
,
2303 Fcons (build_string ("Cannot set file date"),
2304 Fcons (newname
, Qnil
)));
2307 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2309 #if defined (__DJGPP__) && __DJGPP__ > 1
2310 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2311 and if it can't, it tells so. Otherwise, under MSDOS we usually
2312 get only the READ bit, which will make the copied file read-only,
2313 so it's better not to chmod at all. */
2314 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2315 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2316 #endif /* DJGPP version 2 or newer */
2322 /* Discard the unwind protects. */
2323 specpdl_ptr
= specpdl
+ count
;
2329 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2330 Smake_directory_internal
, 1, 1, 0,
2331 "Create a new directory named DIRECTORY.")
2333 Lisp_Object directory
;
2336 Lisp_Object handler
;
2337 Lisp_Object encoded_dir
;
2339 CHECK_STRING (directory
, 0);
2340 directory
= Fexpand_file_name (directory
, Qnil
);
2342 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2343 if (!NILP (handler
))
2344 return call2 (handler
, Qmake_directory_internal
, directory
);
2346 encoded_dir
= ENCODE_FILE (directory
);
2348 dir
= XSTRING (encoded_dir
)->data
;
2351 if (mkdir (dir
) != 0)
2353 if (mkdir (dir
, 0777) != 0)
2355 report_file_error ("Creating directory", Flist (1, &directory
));
2360 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2361 "Delete the directory named DIRECTORY.")
2363 Lisp_Object directory
;
2366 Lisp_Object handler
;
2367 Lisp_Object encoded_dir
;
2369 CHECK_STRING (directory
, 0);
2370 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2372 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2373 if (!NILP (handler
))
2374 return call2 (handler
, Qdelete_directory
, directory
);
2376 encoded_dir
= ENCODE_FILE (directory
);
2378 dir
= XSTRING (encoded_dir
)->data
;
2380 if (rmdir (dir
) != 0)
2381 report_file_error ("Removing directory", Flist (1, &directory
));
2386 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2387 "Delete file named FILENAME.\n\
2388 If file has multiple names, it continues to exist with the other names.")
2390 Lisp_Object filename
;
2392 Lisp_Object handler
;
2393 Lisp_Object encoded_file
;
2395 CHECK_STRING (filename
, 0);
2396 filename
= Fexpand_file_name (filename
, Qnil
);
2398 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2399 if (!NILP (handler
))
2400 return call2 (handler
, Qdelete_file
, filename
);
2402 encoded_file
= ENCODE_FILE (filename
);
2404 if (0 > unlink (XSTRING (encoded_file
)->data
))
2405 report_file_error ("Removing old name", Flist (1, &filename
));
2410 internal_delete_file_1 (ignore
)
2416 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2419 internal_delete_file (filename
)
2420 Lisp_Object filename
;
2422 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2423 Qt
, internal_delete_file_1
));
2426 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2427 "fRename file: \nFRename %s to file: \np",
2428 "Rename FILE as NEWNAME. Both args strings.\n\
2429 If file has names other than FILE, it continues to have those names.\n\
2430 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2431 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2432 A number as third arg means request confirmation if NEWNAME already exists.\n\
2433 This is what happens in interactive use with M-x.")
2434 (file
, newname
, ok_if_already_exists
)
2435 Lisp_Object file
, newname
, ok_if_already_exists
;
2438 Lisp_Object args
[2];
2440 Lisp_Object handler
;
2441 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2442 Lisp_Object encoded_file
, encoded_newname
;
2444 encoded_file
= encoded_newname
= Qnil
;
2445 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2446 CHECK_STRING (file
, 0);
2447 CHECK_STRING (newname
, 1);
2448 file
= Fexpand_file_name (file
, Qnil
);
2449 newname
= Fexpand_file_name (newname
, Qnil
);
2451 /* If the file name has special constructs in it,
2452 call the corresponding file handler. */
2453 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2455 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2456 if (!NILP (handler
))
2457 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2458 file
, newname
, ok_if_already_exists
));
2460 encoded_file
= ENCODE_FILE (file
);
2461 encoded_newname
= ENCODE_FILE (newname
);
2463 if (NILP (ok_if_already_exists
)
2464 || INTEGERP (ok_if_already_exists
))
2465 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2466 INTEGERP (ok_if_already_exists
), 0, 0);
2468 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2470 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2471 || 0 > unlink (XSTRING (encoded_file
)->data
))
2476 Fcopy_file (file
, newname
,
2477 /* We have already prompted if it was an integer,
2478 so don't have copy-file prompt again. */
2479 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2480 Fdelete_file (file
);
2487 report_file_error ("Renaming", Flist (2, args
));
2490 report_file_error ("Renaming", Flist (2, &file
));
2497 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2498 "fAdd name to file: \nFName to add to %s: \np",
2499 "Give FILE additional name NEWNAME. Both args strings.\n\
2500 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2501 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2502 A number as third arg means request confirmation if NEWNAME already exists.\n\
2503 This is what happens in interactive use with M-x.")
2504 (file
, newname
, ok_if_already_exists
)
2505 Lisp_Object file
, newname
, ok_if_already_exists
;
2508 Lisp_Object args
[2];
2510 Lisp_Object handler
;
2511 Lisp_Object encoded_file
, encoded_newname
;
2512 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2514 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2515 encoded_file
= encoded_newname
= Qnil
;
2516 CHECK_STRING (file
, 0);
2517 CHECK_STRING (newname
, 1);
2518 file
= Fexpand_file_name (file
, Qnil
);
2519 newname
= Fexpand_file_name (newname
, Qnil
);
2521 /* If the file name has special constructs in it,
2522 call the corresponding file handler. */
2523 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2524 if (!NILP (handler
))
2525 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2526 newname
, ok_if_already_exists
));
2528 /* If the new name has special constructs in it,
2529 call the corresponding file handler. */
2530 handler
= Ffind_file_name_handler (newname
, 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 encoded_file
= ENCODE_FILE (file
);
2536 encoded_newname
= ENCODE_FILE (newname
);
2538 if (NILP (ok_if_already_exists
)
2539 || INTEGERP (ok_if_already_exists
))
2540 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2541 INTEGERP (ok_if_already_exists
), 0, 0);
2543 unlink (XSTRING (newname
)->data
);
2544 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2549 report_file_error ("Adding new name", Flist (2, args
));
2551 report_file_error ("Adding new name", Flist (2, &file
));
2560 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2561 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2562 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2563 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2564 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2565 A number as third arg means request confirmation if LINKNAME already exists.\n\
2566 This happens for interactive use with M-x.")
2567 (filename
, linkname
, ok_if_already_exists
)
2568 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2571 Lisp_Object args
[2];
2573 Lisp_Object handler
;
2574 Lisp_Object encoded_filename
, encoded_linkname
;
2575 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2577 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2578 encoded_filename
= encoded_linkname
= Qnil
;
2579 CHECK_STRING (filename
, 0);
2580 CHECK_STRING (linkname
, 1);
2581 /* If the link target has a ~, we must expand it to get
2582 a truly valid file name. Otherwise, do not expand;
2583 we want to permit links to relative file names. */
2584 if (XSTRING (filename
)->data
[0] == '~')
2585 filename
= Fexpand_file_name (filename
, Qnil
);
2586 linkname
= Fexpand_file_name (linkname
, Qnil
);
2588 /* If the file name has special constructs in it,
2589 call the corresponding file handler. */
2590 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2591 if (!NILP (handler
))
2592 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2593 linkname
, ok_if_already_exists
));
2595 /* If the new link name has special constructs in it,
2596 call the corresponding file handler. */
2597 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2598 if (!NILP (handler
))
2599 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2600 linkname
, ok_if_already_exists
));
2602 encoded_filename
= ENCODE_FILE (filename
);
2603 encoded_linkname
= ENCODE_FILE (linkname
);
2605 if (NILP (ok_if_already_exists
)
2606 || INTEGERP (ok_if_already_exists
))
2607 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2608 INTEGERP (ok_if_already_exists
), 0, 0);
2609 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2610 XSTRING (encoded_linkname
)->data
))
2612 /* If we didn't complain already, silently delete existing file. */
2613 if (errno
== EEXIST
)
2615 unlink (XSTRING (encoded_linkname
)->data
);
2616 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2617 XSTRING (encoded_linkname
)->data
))
2627 report_file_error ("Making symbolic link", Flist (2, args
));
2629 report_file_error ("Making symbolic link", Flist (2, &filename
));
2635 #endif /* S_IFLNK */
2639 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2640 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2641 "Define the job-wide logical name NAME to have the value STRING.\n\
2642 If STRING is nil or a null string, the logical name NAME is deleted.")
2647 CHECK_STRING (name
, 0);
2649 delete_logical_name (XSTRING (name
)->data
);
2652 CHECK_STRING (string
, 1);
2654 if (XSTRING (string
)->size
== 0)
2655 delete_logical_name (XSTRING (name
)->data
);
2657 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2666 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2667 "Open a network connection to PATH using LOGIN as the login string.")
2669 Lisp_Object path
, login
;
2673 CHECK_STRING (path
, 0);
2674 CHECK_STRING (login
, 0);
2676 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2678 if (netresult
== -1)
2683 #endif /* HPUX_NET */
2685 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2687 "Return t if file FILENAME specifies an absolute file name.\n\
2688 On Unix, this is a name starting with a `/' or a `~'.")
2690 Lisp_Object filename
;
2694 CHECK_STRING (filename
, 0);
2695 ptr
= XSTRING (filename
)->data
;
2696 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2698 /* ??? This criterion is probably wrong for '<'. */
2699 || index (ptr
, ':') || index (ptr
, '<')
2700 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2704 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2712 /* Return nonzero if file FILENAME exists and can be executed. */
2715 check_executable (filename
)
2719 int len
= strlen (filename
);
2722 if (stat (filename
, &st
) < 0)
2724 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2725 return ((st
.st_mode
& S_IEXEC
) != 0);
2727 return (S_ISREG (st
.st_mode
)
2729 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2730 || stricmp (suffix
, ".exe") == 0
2731 || stricmp (suffix
, ".bat") == 0)
2732 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2733 #endif /* not WINDOWSNT */
2734 #else /* not DOS_NT */
2735 #ifdef HAVE_EUIDACCESS
2736 return (euidaccess (filename
, 1) >= 0);
2738 /* Access isn't quite right because it uses the real uid
2739 and we really want to test with the effective uid.
2740 But Unix doesn't give us a right way to do it. */
2741 return (access (filename
, 1) >= 0);
2743 #endif /* not DOS_NT */
2746 /* Return nonzero if file FILENAME exists and can be written. */
2749 check_writable (filename
)
2754 if (stat (filename
, &st
) < 0)
2756 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2757 #else /* not MSDOS */
2758 #ifdef HAVE_EUIDACCESS
2759 return (euidaccess (filename
, 2) >= 0);
2761 /* Access isn't quite right because it uses the real uid
2762 and we really want to test with the effective uid.
2763 But Unix doesn't give us a right way to do it.
2764 Opening with O_WRONLY could work for an ordinary file,
2765 but would lose for directories. */
2766 return (access (filename
, 2) >= 0);
2768 #endif /* not MSDOS */
2771 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2772 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2773 See also `file-readable-p' and `file-attributes'.")
2775 Lisp_Object filename
;
2777 Lisp_Object absname
;
2778 Lisp_Object handler
;
2779 struct stat statbuf
;
2781 CHECK_STRING (filename
, 0);
2782 absname
= Fexpand_file_name (filename
, Qnil
);
2784 /* If the file name has special constructs in it,
2785 call the corresponding file handler. */
2786 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2787 if (!NILP (handler
))
2788 return call2 (handler
, Qfile_exists_p
, absname
);
2790 absname
= ENCODE_FILE (absname
);
2792 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2795 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2796 "Return t if FILENAME can be executed by you.\n\
2797 For a directory, this means you can access files in that directory.")
2799 Lisp_Object filename
;
2802 Lisp_Object absname
;
2803 Lisp_Object handler
;
2805 CHECK_STRING (filename
, 0);
2806 absname
= Fexpand_file_name (filename
, Qnil
);
2808 /* If the file name has special constructs in it,
2809 call the corresponding file handler. */
2810 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2811 if (!NILP (handler
))
2812 return call2 (handler
, Qfile_executable_p
, absname
);
2814 absname
= ENCODE_FILE (absname
);
2816 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2819 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2820 "Return t if file FILENAME exists and you can read it.\n\
2821 See also `file-exists-p' and `file-attributes'.")
2823 Lisp_Object filename
;
2825 Lisp_Object absname
;
2826 Lisp_Object handler
;
2829 struct stat statbuf
;
2831 CHECK_STRING (filename
, 0);
2832 absname
= Fexpand_file_name (filename
, Qnil
);
2834 /* If the file name has special constructs in it,
2835 call the corresponding file handler. */
2836 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2837 if (!NILP (handler
))
2838 return call2 (handler
, Qfile_readable_p
, absname
);
2840 absname
= ENCODE_FILE (absname
);
2843 /* Under MS-DOS and Windows, open does not work for directories. */
2844 if (access (XSTRING (absname
)->data
, 0) == 0)
2847 #else /* not DOS_NT */
2849 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2850 /* Opening a fifo without O_NONBLOCK can wait.
2851 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2852 except in the case of a fifo, on a system which handles it. */
2853 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2856 if (S_ISFIFO (statbuf
.st_mode
))
2857 flags
|= O_NONBLOCK
;
2859 desc
= open (XSTRING (absname
)->data
, flags
);
2864 #endif /* not DOS_NT */
2867 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2869 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2870 "Return t if file FILENAME can be written or created by you.")
2872 Lisp_Object filename
;
2874 Lisp_Object absname
, dir
, encoded
;
2875 Lisp_Object handler
;
2876 struct stat statbuf
;
2878 CHECK_STRING (filename
, 0);
2879 absname
= Fexpand_file_name (filename
, Qnil
);
2881 /* If the file name has special constructs in it,
2882 call the corresponding file handler. */
2883 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2884 if (!NILP (handler
))
2885 return call2 (handler
, Qfile_writable_p
, absname
);
2887 encoded
= ENCODE_FILE (absname
);
2888 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
2889 return (check_writable (XSTRING (encoded
)->data
)
2892 dir
= Ffile_name_directory (absname
);
2895 dir
= Fdirectory_file_name (dir
);
2899 dir
= Fdirectory_file_name (dir
);
2902 dir
= ENCODE_FILE (dir
);
2903 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2907 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2908 "Access file FILENAME, and get an error if that does not work.\n\
2909 The second argument STRING is used in the error message.\n\
2910 If there is no error, we return nil.")
2912 Lisp_Object filename
, string
;
2914 Lisp_Object handler
, encoded_filename
;
2917 CHECK_STRING (filename
, 0);
2919 /* If the file name has special constructs in it,
2920 call the corresponding file handler. */
2921 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2922 if (!NILP (handler
))
2923 return call3 (handler
, Qaccess_file
, filename
, string
);
2925 encoded_filename
= ENCODE_FILE (filename
);
2927 fd
= open (XSTRING (encoded_filename
)->data
, O_RDONLY
);
2929 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2935 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2936 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2937 The value is the name of the file to which it is linked.\n\
2938 Otherwise returns nil.")
2940 Lisp_Object filename
;
2947 Lisp_Object handler
;
2949 CHECK_STRING (filename
, 0);
2950 filename
= Fexpand_file_name (filename
, Qnil
);
2952 /* If the file name has special constructs in it,
2953 call the corresponding file handler. */
2954 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2955 if (!NILP (handler
))
2956 return call2 (handler
, Qfile_symlink_p
, filename
);
2958 filename
= ENCODE_FILE (filename
);
2963 buf
= (char *) xmalloc (bufsize
);
2964 bzero (buf
, bufsize
);
2965 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2966 if (valsize
< bufsize
) break;
2967 /* Buffer was not long enough */
2976 val
= make_string (buf
, valsize
);
2978 val
= DECODE_FILE (val
);
2980 #else /* not S_IFLNK */
2982 #endif /* not S_IFLNK */
2985 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2986 "Return t if FILENAME names an existing directory.")
2988 Lisp_Object filename
;
2990 register Lisp_Object absname
;
2992 Lisp_Object handler
;
2994 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2996 /* If the file name has special constructs in it,
2997 call the corresponding file handler. */
2998 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2999 if (!NILP (handler
))
3000 return call2 (handler
, Qfile_directory_p
, absname
);
3002 absname
= ENCODE_FILE (absname
);
3004 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3006 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3009 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3010 "Return t if file FILENAME is the name of a directory as a file,\n\
3011 and files in that directory can be opened by you. In order to use a\n\
3012 directory as a buffer's current directory, this predicate must return true.\n\
3013 A directory name spec may be given instead; then the value is t\n\
3014 if the directory so specified exists and really is a readable and\n\
3015 searchable directory.")
3017 Lisp_Object filename
;
3019 Lisp_Object handler
;
3021 struct gcpro gcpro1
;
3023 /* If the file name has special constructs in it,
3024 call the corresponding file handler. */
3025 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3026 if (!NILP (handler
))
3027 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3029 /* It's an unlikely combination, but yes we really do need to gcpro:
3030 Suppose that file-accessible-directory-p has no handler, but
3031 file-directory-p does have a handler; this handler causes a GC which
3032 relocates the string in `filename'; and finally file-directory-p
3033 returns non-nil. Then we would end up passing a garbaged string
3034 to file-executable-p. */
3036 tem
= (NILP (Ffile_directory_p (filename
))
3037 || NILP (Ffile_executable_p (filename
)));
3039 return tem
? Qnil
: Qt
;
3042 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3043 "Return t if file FILENAME is the name of a regular file.\n\
3044 This is the sort of file that holds an ordinary stream of data bytes.")
3046 Lisp_Object filename
;
3048 register Lisp_Object absname
;
3050 Lisp_Object handler
;
3052 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3054 /* If the file name has special constructs in it,
3055 call the corresponding file handler. */
3056 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3057 if (!NILP (handler
))
3058 return call2 (handler
, Qfile_regular_p
, absname
);
3060 absname
= ENCODE_FILE (absname
);
3062 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3064 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3067 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3068 "Return mode bits of file named FILENAME, as an integer.")
3070 Lisp_Object filename
;
3072 Lisp_Object absname
;
3074 Lisp_Object handler
;
3076 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3078 /* If the file name has special constructs in it,
3079 call the corresponding file handler. */
3080 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3081 if (!NILP (handler
))
3082 return call2 (handler
, Qfile_modes
, absname
);
3084 absname
= ENCODE_FILE (absname
);
3086 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3088 #if defined (MSDOS) && __DJGPP__ < 2
3089 if (check_executable (XSTRING (absname
)->data
))
3090 st
.st_mode
|= S_IEXEC
;
3091 #endif /* MSDOS && __DJGPP__ < 2 */
3093 return make_number (st
.st_mode
& 07777);
3096 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3097 "Set mode bits of file named FILENAME to MODE (an integer).\n\
3098 Only the 12 low bits of MODE are used.")
3100 Lisp_Object filename
, mode
;
3102 Lisp_Object absname
, encoded_absname
;
3103 Lisp_Object handler
;
3105 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3106 CHECK_NUMBER (mode
, 1);
3108 /* If the file name has special constructs in it,
3109 call the corresponding file handler. */
3110 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3111 if (!NILP (handler
))
3112 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3114 encoded_absname
= ENCODE_FILE (absname
);
3116 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
3117 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3122 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3123 "Set the file permission bits for newly created files.\n\
3124 The argument MODE should be an integer; only the low 9 bits are used.\n\
3125 This setting is inherited by subprocesses.")
3129 CHECK_NUMBER (mode
, 0);
3131 umask ((~ XINT (mode
)) & 0777);
3136 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3137 "Return the default file protection for created files.\n\
3138 The value is an integer.")
3144 realmask
= umask (0);
3147 XSETINT (value
, (~ realmask
) & 0777);
3153 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3154 "Tell Unix to finish all pending disk updates.")
3163 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3164 "Return t if file FILE1 is newer than file FILE2.\n\
3165 If FILE1 does not exist, the answer is nil;\n\
3166 otherwise, if FILE2 does not exist, the answer is t.")
3168 Lisp_Object file1
, file2
;
3170 Lisp_Object absname1
, absname2
;
3173 Lisp_Object handler
;
3174 struct gcpro gcpro1
, gcpro2
;
3176 CHECK_STRING (file1
, 0);
3177 CHECK_STRING (file2
, 0);
3180 GCPRO2 (absname1
, file2
);
3181 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3182 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3185 /* If the file name has special constructs in it,
3186 call the corresponding file handler. */
3187 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3189 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3190 if (!NILP (handler
))
3191 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3193 GCPRO2 (absname1
, absname2
);
3194 absname1
= ENCODE_FILE (absname1
);
3195 absname2
= ENCODE_FILE (absname2
);
3198 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3201 mtime1
= st
.st_mtime
;
3203 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3206 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3210 Lisp_Object Qfind_buffer_file_type
;
3213 #ifndef READ_BUF_SIZE
3214 #define READ_BUF_SIZE (64 << 10)
3217 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3219 "Insert contents of file FILENAME after point.\n\
3220 Returns list of absolute file name and number of bytes inserted.\n\
3221 If second argument VISIT is non-nil, the buffer's visited filename\n\
3222 and last save file modtime are set, and it is marked unmodified.\n\
3223 If visiting and the file does not exist, visiting is completed\n\
3224 before the error is signaled.\n\
3225 The optional third and fourth arguments BEG and END\n\
3226 specify what portion of the file to insert.\n\
3227 These arguments count bytes in the file, not characters in the buffer.\n\
3228 If VISIT is non-nil, BEG and END must be nil.\n\
3230 If optional fifth argument REPLACE is non-nil,\n\
3231 it means replace the current buffer contents (in the accessible portion)\n\
3232 with the file contents. This is better than simply deleting and inserting\n\
3233 the whole thing because (1) it preserves some marker positions\n\
3234 and (2) it puts less data in the undo list.\n\
3235 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3236 which is often less than the number of characters to be read.\n\
3237 This does code conversion according to the value of\n\
3238 `coding-system-for-read' or `file-coding-system-alist',\n\
3239 and sets the variable `last-coding-system-used' to the coding system\n\
3241 (filename
, visit
, beg
, end
, replace
)
3242 Lisp_Object filename
, visit
, beg
, end
, replace
;
3247 register int how_much
;
3248 register int unprocessed
;
3249 int count
= specpdl_ptr
- specpdl
;
3250 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3251 Lisp_Object handler
, val
, insval
, orig_filename
;
3254 int not_regular
= 0;
3255 char read_buf
[READ_BUF_SIZE
];
3256 struct coding_system coding
;
3257 unsigned char buffer
[1 << 14];
3258 int replace_handled
= 0;
3259 int set_coding_system
= 0;
3261 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3262 error ("Cannot do file visiting in an indirect buffer");
3264 if (!NILP (current_buffer
->read_only
))
3265 Fbarf_if_buffer_read_only ();
3269 orig_filename
= Qnil
;
3271 GCPRO4 (filename
, val
, p
, orig_filename
);
3273 CHECK_STRING (filename
, 0);
3274 filename
= Fexpand_file_name (filename
, Qnil
);
3276 /* If the file name has special constructs in it,
3277 call the corresponding file handler. */
3278 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3279 if (!NILP (handler
))
3281 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3282 visit
, beg
, end
, replace
);
3286 orig_filename
= filename
;
3287 filename
= ENCODE_FILE (filename
);
3292 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3294 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3295 || fstat (fd
, &st
) < 0)
3296 #endif /* not APOLLO */
3298 if (fd
>= 0) close (fd
);
3301 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3304 if (!NILP (Vcoding_system_for_read
))
3305 current_buffer
->buffer_file_coding_system
= Vcoding_system_for_read
;
3310 /* This code will need to be changed in order to work on named
3311 pipes, and it's probably just not worth it. So we should at
3312 least signal an error. */
3313 if (!S_ISREG (st
.st_mode
))
3320 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3321 Fsignal (Qfile_error
,
3322 Fcons (build_string ("not a regular file"),
3323 Fcons (orig_filename
, Qnil
)));
3328 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3331 /* Replacement should preserve point as it preserves markers. */
3332 if (!NILP (replace
))
3333 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3335 record_unwind_protect (close_file_unwind
, make_number (fd
));
3337 /* Supposedly happens on VMS. */
3338 if (! not_regular
&& st
.st_size
< 0)
3339 error ("File size is negative");
3341 if (!NILP (beg
) || !NILP (end
))
3343 error ("Attempt to visit less than an entire file");
3346 CHECK_NUMBER (beg
, 0);
3348 XSETFASTINT (beg
, 0);
3351 CHECK_NUMBER (end
, 0);
3356 XSETINT (end
, st
.st_size
);
3357 if (XINT (end
) != st
.st_size
)
3358 error ("Maximum buffer size exceeded");
3362 /* Decide the coding-system of the file. */
3364 Lisp_Object val
= Qnil
;
3366 if (!NILP (Vcoding_system_for_read
))
3367 val
= Vcoding_system_for_read
;
3370 if (! NILP (Vset_auto_coding_function
))
3372 /* Find a coding system specified in the heading two lines
3373 or in the tailing several lines of the file. We assume
3374 that the 1K-byte and 3K-byte for heading and tailing
3375 respectively are sufficient fot this purpose. */
3376 int how_many
, nread
;
3378 if (st
.st_size
<= (1024 * 4))
3379 nread
= read (fd
, read_buf
, 1024 * 4);
3382 nread
= read (fd
, read_buf
, 1024);
3385 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3386 report_file_error ("Setting file position",
3387 Fcons (orig_filename
, Qnil
));
3388 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3393 error ("IO error reading %s: %s",
3394 XSTRING (orig_filename
)->data
, strerror (errno
));
3398 /* Always make this a unibyte string
3399 because we have not yet decoded it. */
3400 tem
= make_unibyte_string (read_buf
, nread
);
3401 val
= call1 (Vset_auto_coding_function
, tem
);
3402 /* Rewind the file for the actual read done later. */
3403 if (lseek (fd
, 0, 0) < 0)
3404 report_file_error ("Setting file position",
3405 Fcons (orig_filename
, Qnil
));
3410 Lisp_Object args
[6], coding_systems
;
3412 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
,
3413 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3414 coding_systems
= Ffind_operation_coding_system (6, args
);
3415 if (CONSP (coding_systems
)) val
= XCONS (coding_systems
)->car
;
3419 if (NILP (Vcoding_system_for_read
)
3420 && NILP (current_buffer
->enable_multibyte_characters
))
3422 /* We must suppress all text conversion except for end-of-line
3424 struct coding_system coding_temp
;
3426 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
3427 setup_coding_system (Qraw_text
, &coding
);
3428 coding
.eol_type
= coding_temp
.eol_type
;
3431 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3434 /* If requested, replace the accessible part of the buffer
3435 with the file contents. Avoid replacing text at the
3436 beginning or end of the buffer that matches the file contents;
3437 that preserves markers pointing to the unchanged parts.
3439 Here we implement this feature in an optimized way
3440 for the case where code conversion is NOT needed.
3441 The following if-statement handles the case of conversion
3442 in a less optimal way.
3444 If the code conversion is "automatic" then we try using this
3445 method and hope for the best.
3446 But if we discover the need for conversion, we give up on this method
3447 and let the following if-statement handle the replace job. */
3449 && ! CODING_REQUIRE_DECODING (&coding
))
3451 /* same_at_start and same_at_end count bytes,
3452 because file access counts bytes
3453 and BEG and END count bytes. */
3454 int same_at_start
= BEGV_BYTE
;
3455 int same_at_end
= ZV_BYTE
;
3457 /* There is still a possibility we will find the need to do code
3458 conversion. If that happens, we set this variable to 1 to
3459 give up on handling REPLACE in the optimized way. */
3460 int giveup_match_end
= 0;
3462 if (XINT (beg
) != 0)
3464 if (lseek (fd
, XINT (beg
), 0) < 0)
3465 report_file_error ("Setting file position",
3466 Fcons (orig_filename
, Qnil
));
3471 /* Count how many chars at the start of the file
3472 match the text at the beginning of the buffer. */
3477 nread
= read (fd
, buffer
, sizeof buffer
);
3479 error ("IO error reading %s: %s",
3480 XSTRING (orig_filename
)->data
, strerror (errno
));
3481 else if (nread
== 0)
3484 if (coding
.type
== coding_type_undecided
)
3485 detect_coding (&coding
, buffer
, nread
);
3486 if (CODING_REQUIRE_DECODING (&coding
))
3487 /* We found that the file should be decoded somehow.
3488 Let's give up here. */
3490 giveup_match_end
= 1;
3494 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3495 detect_eol (&coding
, buffer
, nread
);
3496 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3497 && coding
.eol_type
!= CODING_EOL_LF
)
3498 /* We found that the format of eol should be decoded.
3499 Let's give up here. */
3501 giveup_match_end
= 1;
3506 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3507 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3508 same_at_start
++, bufpos
++;
3509 /* If we found a discrepancy, stop the scan.
3510 Otherwise loop around and scan the next bufferful. */
3511 if (bufpos
!= nread
)
3515 /* If the file matches the buffer completely,
3516 there's no need to replace anything. */
3517 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3521 /* Truncate the buffer to the size of the file. */
3522 del_range_1 (same_at_start
, same_at_end
, 0);
3527 /* Count how many chars at the end of the file
3528 match the text at the end of the buffer. But, if we have
3529 already found that decoding is necessary, don't waste time. */
3530 while (!giveup_match_end
)
3532 int total_read
, nread
, bufpos
, curpos
, trial
;
3534 /* At what file position are we now scanning? */
3535 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3536 /* If the entire file matches the buffer tail, stop the scan. */
3539 /* How much can we scan in the next step? */
3540 trial
= min (curpos
, sizeof buffer
);
3541 if (lseek (fd
, curpos
- trial
, 0) < 0)
3542 report_file_error ("Setting file position",
3543 Fcons (orig_filename
, Qnil
));
3546 while (total_read
< trial
)
3548 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3550 error ("IO error reading %s: %s",
3551 XSTRING (orig_filename
)->data
, strerror (errno
));
3552 total_read
+= nread
;
3554 /* Scan this bufferful from the end, comparing with
3555 the Emacs buffer. */
3556 bufpos
= total_read
;
3557 /* Compare with same_at_start to avoid counting some buffer text
3558 as matching both at the file's beginning and at the end. */
3559 while (bufpos
> 0 && same_at_end
> same_at_start
3560 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3561 same_at_end
--, bufpos
--;
3563 /* If we found a discrepancy, stop the scan.
3564 Otherwise loop around and scan the preceding bufferful. */
3567 /* If this discrepancy is because of code conversion,
3568 we cannot use this method; giveup and try the other. */
3569 if (same_at_end
> same_at_start
3570 && FETCH_BYTE (same_at_end
- 1) >= 0200
3571 && ! NILP (current_buffer
->enable_multibyte_characters
)
3572 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3573 giveup_match_end
= 1;
3579 if (! giveup_match_end
)
3583 /* We win! We can handle REPLACE the optimized way. */
3585 /* Extends the end of non-matching text area to multibyte
3586 character boundary. */
3587 if (! NILP (current_buffer
->enable_multibyte_characters
))
3588 while (same_at_end
< ZV_BYTE
3589 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3592 /* Don't try to reuse the same piece of text twice. */
3593 overlap
= (same_at_start
- BEGV_BYTE
3594 - (same_at_end
+ st
.st_size
- ZV
));
3596 same_at_end
+= overlap
;
3598 /* Arrange to read only the nonmatching middle part of the file. */
3599 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3600 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3602 del_range_byte (same_at_start
, same_at_end
, 0);
3603 /* Insert from the file at the proper position. */
3604 temp
= BYTE_TO_CHAR (same_at_start
);
3605 SET_PT_BOTH (temp
, same_at_start
);
3607 /* If display currently starts at beginning of line,
3608 keep it that way. */
3609 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3610 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3612 replace_handled
= 1;
3616 /* If requested, replace the accessible part of the buffer
3617 with the file contents. Avoid replacing text at the
3618 beginning or end of the buffer that matches the file contents;
3619 that preserves markers pointing to the unchanged parts.
3621 Here we implement this feature for the case where code conversion
3622 is needed, in a simple way that needs a lot of memory.
3623 The preceding if-statement handles the case of no conversion
3624 in a more optimized way. */
3625 if (!NILP (replace
) && ! replace_handled
)
3627 int same_at_start
= BEGV_BYTE
;
3628 int same_at_end
= ZV_BYTE
;
3631 /* Make sure that the gap is large enough. */
3632 int bufsize
= 2 * st
.st_size
;
3633 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3636 /* First read the whole file, performing code conversion into
3637 CONVERSION_BUFFER. */
3639 if (lseek (fd
, XINT (beg
), 0) < 0)
3641 free (conversion_buffer
);
3642 report_file_error ("Setting file position",
3643 Fcons (orig_filename
, Qnil
));
3646 total
= st
.st_size
; /* Total bytes in the file. */
3647 how_much
= 0; /* Bytes read from file so far. */
3648 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3649 unprocessed
= 0; /* Bytes not processed in previous loop. */
3651 while (how_much
< total
)
3653 /* try is reserved in some compilers (Microsoft C) */
3654 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3655 char *destination
= read_buf
+ unprocessed
;
3658 /* Allow quitting out of the actual I/O. */
3661 this = read (fd
, destination
, trytry
);
3664 if (this < 0 || this + unprocessed
== 0)
3672 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3674 int require
, result
;
3676 this += unprocessed
;
3678 /* If we are using more space than estimated,
3679 make CONVERSION_BUFFER bigger. */
3680 require
= decoding_buffer_size (&coding
, this);
3681 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3683 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3684 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3687 /* Convert this batch with results in CONVERSION_BUFFER. */
3688 if (how_much
>= total
) /* This is the last block. */
3689 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3690 result
= decode_coding (&coding
, read_buf
,
3691 conversion_buffer
+ inserted
,
3692 this, bufsize
- inserted
);
3694 /* Save for next iteration whatever we didn't convert. */
3695 unprocessed
= this - coding
.consumed
;
3696 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
3697 this = coding
.produced
;
3703 /* At this point, INSERTED is how many characters (i.e. bytes)
3704 are present in CONVERSION_BUFFER.
3705 HOW_MUCH should equal TOTAL,
3706 or should be <= 0 if we couldn't read the file. */
3710 free (conversion_buffer
);
3713 error ("IO error reading %s: %s",
3714 XSTRING (orig_filename
)->data
, strerror (errno
));
3715 else if (how_much
== -2)
3716 error ("maximum buffer size exceeded");
3719 /* Compare the beginning of the converted file
3720 with the buffer text. */
3723 while (bufpos
< inserted
&& same_at_start
< same_at_end
3724 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3725 same_at_start
++, bufpos
++;
3727 /* If the file matches the buffer completely,
3728 there's no need to replace anything. */
3730 if (bufpos
== inserted
)
3732 free (conversion_buffer
);
3735 /* Truncate the buffer to the size of the file. */
3736 del_range_1 (same_at_start
, same_at_end
, 0);
3740 /* Scan this bufferful from the end, comparing with
3741 the Emacs buffer. */
3744 /* Compare with same_at_start to avoid counting some buffer text
3745 as matching both at the file's beginning and at the end. */
3746 while (bufpos
> 0 && same_at_end
> same_at_start
3747 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3748 same_at_end
--, bufpos
--;
3750 /* Don't try to reuse the same piece of text twice. */
3751 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3753 same_at_end
+= overlap
;
3755 /* If display currently starts at beginning of line,
3756 keep it that way. */
3757 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3758 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3760 /* Replace the chars that we need to replace,
3761 and update INSERTED to equal the number of bytes
3762 we are taking from the file. */
3763 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
3764 del_range_byte (same_at_start
, same_at_end
, 0);
3765 SET_PT_BOTH (GPT
, GPT_BYTE
);
3767 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
3770 free (conversion_buffer
);
3779 register Lisp_Object temp
;
3781 total
= XINT (end
) - XINT (beg
);
3783 /* Make sure point-max won't overflow after this insertion. */
3784 XSETINT (temp
, total
);
3785 if (total
!= XINT (temp
))
3786 error ("Maximum buffer size exceeded");
3789 /* For a special file, all we can do is guess. */
3790 total
= READ_BUF_SIZE
;
3792 if (NILP (visit
) && total
> 0)
3793 prepare_to_modify_buffer (PT
, PT
, NULL
);
3796 if (GAP_SIZE
< total
)
3797 make_gap (total
- GAP_SIZE
);
3799 if (XINT (beg
) != 0 || !NILP (replace
))
3801 if (lseek (fd
, XINT (beg
), 0) < 0)
3802 report_file_error ("Setting file position",
3803 Fcons (orig_filename
, Qnil
));
3806 /* In the following loop, HOW_MUCH contains the total bytes read so
3807 far for a regular file, and not changed for a special file. But,
3808 before exiting the loop, it is set to a negative value if I/O
3811 /* Total bytes inserted. */
3813 /* Here, we don't do code conversion in the loop. It is done by
3814 code_convert_region after all data are read into the buffer. */
3815 while (how_much
< total
)
3817 /* try is reserved in some compilers (Microsoft C) */
3818 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3821 /* For a special file, GAP_SIZE should be checked every time. */
3822 if (not_regular
&& GAP_SIZE
< trytry
)
3823 make_gap (total
- GAP_SIZE
);
3825 /* Allow quitting out of the actual I/O. */
3828 this = read (fd
, BYTE_POS_ADDR (PT_BYTE
+ inserted
- 1) + 1, trytry
);
3845 /* For a regular file, where TOTAL is the real size,
3846 count HOW_MUCH to compare with it.
3847 For a special file, where TOTAL is just a buffer size,
3848 so don't bother counting in HOW_MUCH.
3849 (INSERTED is where we count the number of characters inserted.) */
3856 /* Put an anchor to ensure multi-byte form ends at gap. */
3861 /* Discard the unwind protect for closing the file. */
3865 error ("IO error reading %s: %s",
3866 XSTRING (orig_filename
)->data
, strerror (errno
));
3870 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3872 /* Here, we don't have to consider byte combining (see the
3873 comment below) because code_convert_region takes care of
3875 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
3877 inserted
= (NILP (current_buffer
->enable_multibyte_characters
)
3878 ? coding
.produced
: coding
.produced_char
);
3880 else if (!NILP (current_buffer
->enable_multibyte_characters
))
3882 int inserted_byte
= inserted
;
3884 /* There's a possibility that we must combine bytes at the
3885 head (resp. the tail) of the just inserted text with the
3886 bytes before (resp. after) the gap to form a single
3888 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
3889 adjust_after_insert (PT
, PT_BYTE
,
3890 PT
+ inserted_byte
, PT_BYTE
+ inserted_byte
,
3894 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
3898 /* Use the conversion type to determine buffer-file-type
3899 (find-buffer-file-type is now used to help determine the
3901 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3902 && coding
.eol_type
!= CODING_EOL_LF
)
3903 current_buffer
->buffer_file_type
= Qnil
;
3905 current_buffer
->buffer_file_type
= Qt
;
3909 set_coding_system
= 1;
3916 if (!EQ (current_buffer
->undo_list
, Qt
))
3917 current_buffer
->undo_list
= Qnil
;
3919 stat (XSTRING (filename
)->data
, &st
);
3924 current_buffer
->modtime
= st
.st_mtime
;
3925 current_buffer
->filename
= orig_filename
;
3928 SAVE_MODIFF
= MODIFF
;
3929 current_buffer
->auto_save_modified
= MODIFF
;
3930 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3931 #ifdef CLASH_DETECTION
3934 if (!NILP (current_buffer
->file_truename
))
3935 unlock_file (current_buffer
->file_truename
);
3936 unlock_file (filename
);
3938 #endif /* CLASH_DETECTION */
3940 Fsignal (Qfile_error
,
3941 Fcons (build_string ("not a regular file"),
3942 Fcons (orig_filename
, Qnil
)));
3944 /* If visiting nonexistent file, return nil. */
3945 if (current_buffer
->modtime
== -1)
3946 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3949 /* Decode file format */
3952 insval
= call3 (Qformat_decode
,
3953 Qnil
, make_number (inserted
), visit
);
3954 CHECK_NUMBER (insval
, 0);
3955 inserted
= XFASTINT (insval
);
3958 /* Call after-change hooks for the inserted text, aside from the case
3959 of normal visiting (not with REPLACE), which is done in a new buffer
3960 "before" the buffer is changed. */
3961 if (inserted
> 0 && total
> 0
3962 && (NILP (visit
) || !NILP (replace
)))
3963 signal_after_change (PT
, 0, inserted
);
3965 if (set_coding_system
)
3966 Vlast_coding_system_used
= coding
.symbol
;
3970 p
= Vafter_insert_file_functions
;
3973 insval
= call1 (Fcar (p
), make_number (inserted
));
3976 CHECK_NUMBER (insval
, 0);
3977 inserted
= XFASTINT (insval
);
3984 /* ??? Retval needs to be dealt with in all cases consistently. */
3986 val
= Fcons (orig_filename
,
3987 Fcons (make_number (inserted
),
3990 RETURN_UNGCPRO (unbind_to (count
, val
));
3993 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
3996 /* If build_annotations switched buffers, switch back to BUF.
3997 Kill the temporary buffer that was selected in the meantime.
3999 Since this kill only the last temporary buffer, some buffers remain
4000 not killed if build_annotations switched buffers more than once.
4004 build_annotations_unwind (buf
)
4009 if (XBUFFER (buf
) == current_buffer
)
4011 tembuf
= Fcurrent_buffer ();
4013 Fkill_buffer (tembuf
);
4017 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4018 "r\nFWrite region to file: \ni\ni\ni\np",
4019 "Write current region into specified file.\n\
4020 When called from a program, takes three arguments:\n\
4021 START, END and FILENAME. START and END are buffer positions.\n\
4022 Optional fourth argument APPEND if non-nil means\n\
4023 append to existing file contents (if any).\n\
4024 Optional fifth argument VISIT if t means\n\
4025 set the last-save-file-modtime of buffer to this file's modtime\n\
4026 and mark buffer not modified.\n\
4027 If VISIT is a string, it is a second file name;\n\
4028 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
4029 VISIT is also the file name to lock and unlock for clash detection.\n\
4030 If VISIT is neither t nor nil nor a string,\n\
4031 that means do not print the \"Wrote file\" message.\n\
4032 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
4033 use for locking and unlocking, overriding FILENAME and VISIT.\n\
4034 The optional seventh arg CONFIRM, if non-nil, says ask for confirmation\n\
4035 before overwriting an existing file.\n\
4036 Kludgy feature: if START is a string, then that string is written\n\
4037 to the file, instead of any buffer contents, and END is ignored.")
4038 (start
, end
, filename
, append
, visit
, lockname
, confirm
)
4039 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, confirm
;
4047 int count
= specpdl_ptr
- specpdl
;
4050 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4052 Lisp_Object handler
;
4053 Lisp_Object visit_file
;
4054 Lisp_Object annotations
;
4055 Lisp_Object encoded_filename
;
4056 int visiting
, quietly
;
4057 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4058 struct buffer
*given_buffer
;
4060 int buffer_file_type
= O_BINARY
;
4062 struct coding_system coding
;
4064 if (current_buffer
->base_buffer
&& ! NILP (visit
))
4065 error ("Cannot do file visiting in an indirect buffer");
4067 if (!NILP (start
) && !STRINGP (start
))
4068 validate_region (&start
, &end
);
4070 GCPRO4 (start
, filename
, visit
, lockname
);
4072 /* Decide the coding-system to encode the data with. */
4078 else if (!NILP (Vcoding_system_for_write
))
4079 val
= Vcoding_system_for_write
;
4080 else if (NILP (current_buffer
->enable_multibyte_characters
))
4082 /* If the variable `buffer-file-coding-system' is set locally,
4083 it means that the file was read with some kind of code
4084 conversion or the varialbe is explicitely set by users. We
4085 had better write it out with the same coding system even if
4086 `enable-multibyte-characters' is nil.
4088 If it is not set locally, we anyway have to convert EOL
4089 format if the default value of `buffer-file-coding-system'
4090 tells that it is not Unix-like (LF only) format. */
4091 val
= current_buffer
->buffer_file_coding_system
;
4092 if (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4094 struct coding_system coding_temp
;
4096 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
4097 if (coding_temp
.eol_type
== CODING_EOL_CRLF
4098 || coding_temp
.eol_type
== CODING_EOL_CR
)
4100 setup_coding_system (Qraw_text
, &coding
);
4101 coding
.eol_type
= coding_temp
.eol_type
;
4102 goto done_setup_coding
;
4109 Lisp_Object args
[7], coding_systems
;
4111 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4112 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4114 coding_systems
= Ffind_operation_coding_system (7, args
);
4115 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
4116 ? XCONS (coding_systems
)->cdr
4117 : current_buffer
->buffer_file_coding_system
);
4118 /* Confirm that VAL can surely encode the current region. */
4119 if (!NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4120 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4122 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4125 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4126 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4129 Vlast_coding_system_used
= coding
.symbol
;
4131 filename
= Fexpand_file_name (filename
, Qnil
);
4133 if (! NILP (confirm
))
4134 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4136 if (STRINGP (visit
))
4137 visit_file
= Fexpand_file_name (visit
, Qnil
);
4139 visit_file
= filename
;
4142 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4143 quietly
= !NILP (visit
);
4147 if (NILP (lockname
))
4148 lockname
= visit_file
;
4150 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4152 /* If the file name has special constructs in it,
4153 call the corresponding file handler. */
4154 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4155 /* If FILENAME has no handler, see if VISIT has one. */
4156 if (NILP (handler
) && STRINGP (visit
))
4157 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4159 if (!NILP (handler
))
4162 val
= call6 (handler
, Qwrite_region
, start
, end
,
4163 filename
, append
, visit
);
4167 SAVE_MODIFF
= MODIFF
;
4168 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4169 current_buffer
->filename
= visit_file
;
4175 /* Special kludge to simplify auto-saving. */
4178 XSETFASTINT (start
, BEG
);
4179 XSETFASTINT (end
, Z
);
4182 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4183 count1
= specpdl_ptr
- specpdl
;
4185 given_buffer
= current_buffer
;
4186 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4187 if (current_buffer
!= given_buffer
)
4189 XSETFASTINT (start
, BEGV
);
4190 XSETFASTINT (end
, ZV
);
4193 #ifdef CLASH_DETECTION
4196 #if 0 /* This causes trouble for GNUS. */
4197 /* If we've locked this file for some other buffer,
4198 query before proceeding. */
4199 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4200 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4203 lock_file (lockname
);
4205 #endif /* CLASH_DETECTION */
4207 encoded_filename
= ENCODE_FILE (filename
);
4209 fn
= XSTRING (encoded_filename
)->data
;
4213 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4214 #else /* not DOS_NT */
4215 desc
= open (fn
, O_WRONLY
);
4216 #endif /* not DOS_NT */
4218 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4220 if (auto_saving
) /* Overwrite any previous version of autosave file */
4222 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4223 desc
= open (fn
, O_RDWR
);
4225 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4226 ? XSTRING (current_buffer
->filename
)->data
: 0,
4229 else /* Write to temporary name and rename if no errors */
4231 Lisp_Object temp_name
;
4232 temp_name
= Ffile_name_directory (filename
);
4234 if (!NILP (temp_name
))
4236 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4237 build_string ("$$SAVE$$")));
4238 fname
= XSTRING (filename
)->data
;
4239 fn
= XSTRING (temp_name
)->data
;
4240 desc
= creat_copy_attrs (fname
, fn
);
4243 /* If we can't open the temporary file, try creating a new
4244 version of the original file. VMS "creat" creates a
4245 new version rather than truncating an existing file. */
4248 desc
= creat (fn
, 0666);
4249 #if 0 /* This can clobber an existing file and fail to replace it,
4250 if the user runs out of space. */
4253 /* We can't make a new version;
4254 try to truncate and rewrite existing version if any. */
4256 desc
= open (fn
, O_RDWR
);
4262 desc
= creat (fn
, 0666);
4267 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4268 S_IREAD
| S_IWRITE
);
4269 #else /* not DOS_NT */
4270 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4271 #endif /* not DOS_NT */
4272 #endif /* not VMS */
4278 #ifdef CLASH_DETECTION
4280 if (!auto_saving
) unlock_file (lockname
);
4282 #endif /* CLASH_DETECTION */
4283 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4286 record_unwind_protect (close_file_unwind
, make_number (desc
));
4289 if (lseek (desc
, 0, 2) < 0)
4291 #ifdef CLASH_DETECTION
4292 if (!auto_saving
) unlock_file (lockname
);
4293 #endif /* CLASH_DETECTION */
4294 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4299 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4300 * if we do writes that don't end with a carriage return. Furthermore
4301 * it cannot handle writes of more then 16K. The modified
4302 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4303 * this EXCEPT for the last record (iff it doesn't end with a carriage
4304 * return). This implies that if your buffer doesn't end with a carriage
4305 * return, you get one free... tough. However it also means that if
4306 * we make two calls to sys_write (a la the following code) you can
4307 * get one at the gap as well. The easiest way to fix this (honest)
4308 * is to move the gap to the next newline (or the end of the buffer).
4313 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4314 move_gap (find_next_newline (GPT
, 1));
4316 /* Whether VMS or not, we must move the gap to the next of newline
4317 when we must put designation sequences at beginning of line. */
4318 if (INTEGERP (start
)
4319 && coding
.type
== coding_type_iso2022
4320 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4321 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4323 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4324 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4325 move_gap_both (PT
, PT_BYTE
);
4326 SET_PT_BOTH (opoint
, opoint_byte
);
4333 if (STRINGP (start
))
4335 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4336 STRING_BYTES (XSTRING (start
)), 0, &annotations
,
4340 else if (XINT (start
) != XINT (end
))
4342 register int end1
= CHAR_TO_BYTE (XINT (end
));
4344 tem
= CHAR_TO_BYTE (XINT (start
));
4346 if (XINT (start
) < GPT
)
4348 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
),
4349 min (GPT_BYTE
, end1
) - tem
, tem
, &annotations
,
4354 if (XINT (end
) > GPT
&& !failure
)
4356 tem
= max (tem
, GPT_BYTE
);
4357 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
), end1
- tem
,
4358 tem
, &annotations
, &coding
);
4364 /* If file was empty, still need to write the annotations */
4365 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4366 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4370 if (CODING_REQUIRE_FLUSHING (&coding
)
4371 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4374 /* We have to flush out a data. */
4375 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4376 failure
= 0 > e_write (desc
, "", 0, &coding
);
4383 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4384 Disk full in NFS may be reported here. */
4385 /* mib says that closing the file will try to write as fast as NFS can do
4386 it, and that means the fsync here is not crucial for autosave files. */
4387 if (!auto_saving
&& fsync (desc
) < 0)
4389 /* If fsync fails with EINTR, don't treat that as serious. */
4391 failure
= 1, save_errno
= errno
;
4395 /* Spurious "file has changed on disk" warnings have been
4396 observed on Suns as well.
4397 It seems that `close' can change the modtime, under nfs.
4399 (This has supposedly been fixed in Sunos 4,
4400 but who knows about all the other machines with NFS?) */
4403 /* On VMS and APOLLO, must do the stat after the close
4404 since closing changes the modtime. */
4407 /* Recall that #if defined does not work on VMS. */
4414 /* NFS can report a write failure now. */
4415 if (close (desc
) < 0)
4416 failure
= 1, save_errno
= errno
;
4419 /* If we wrote to a temporary name and had no errors, rename to real name. */
4423 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4431 /* Discard the unwind protect for close_file_unwind. */
4432 specpdl_ptr
= specpdl
+ count1
;
4433 /* Restore the original current buffer. */
4434 visit_file
= unbind_to (count
, visit_file
);
4436 #ifdef CLASH_DETECTION
4438 unlock_file (lockname
);
4439 #endif /* CLASH_DETECTION */
4441 /* Do this before reporting IO error
4442 to avoid a "file has changed on disk" warning on
4443 next attempt to save. */
4445 current_buffer
->modtime
= st
.st_mtime
;
4448 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4449 strerror (save_errno
));
4453 SAVE_MODIFF
= MODIFF
;
4454 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4455 current_buffer
->filename
= visit_file
;
4456 update_mode_lines
++;
4462 message_with_string ("Wrote %s", visit_file
, 1);
4467 Lisp_Object
merge ();
4469 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4470 "Return t if (car A) is numerically less than (car B).")
4474 return Flss (Fcar (a
), Fcar (b
));
4477 /* Build the complete list of annotations appropriate for writing out
4478 the text between START and END, by calling all the functions in
4479 write-region-annotate-functions and merging the lists they return.
4480 If one of these functions switches to a different buffer, we assume
4481 that buffer contains altered text. Therefore, the caller must
4482 make sure to restore the current buffer in all cases,
4483 as save-excursion would do. */
4486 build_annotations (start
, end
, pre_write_conversion
)
4487 Lisp_Object start
, end
, pre_write_conversion
;
4489 Lisp_Object annotations
;
4491 struct gcpro gcpro1
, gcpro2
;
4492 Lisp_Object original_buffer
;
4494 XSETBUFFER (original_buffer
, current_buffer
);
4497 p
= Vwrite_region_annotate_functions
;
4498 GCPRO2 (annotations
, p
);
4501 struct buffer
*given_buffer
= current_buffer
;
4502 Vwrite_region_annotations_so_far
= annotations
;
4503 res
= call2 (Fcar (p
), start
, end
);
4504 /* If the function makes a different buffer current,
4505 assume that means this buffer contains altered text to be output.
4506 Reset START and END from the buffer bounds
4507 and discard all previous annotations because they should have
4508 been dealt with by this function. */
4509 if (current_buffer
!= given_buffer
)
4511 XSETFASTINT (start
, BEGV
);
4512 XSETFASTINT (end
, ZV
);
4515 Flength (res
); /* Check basic validity of return value */
4516 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4520 /* Now do the same for annotation functions implied by the file-format */
4521 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4522 p
= Vauto_save_file_format
;
4524 p
= current_buffer
->file_format
;
4527 struct buffer
*given_buffer
= current_buffer
;
4528 Vwrite_region_annotations_so_far
= annotations
;
4529 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4531 if (current_buffer
!= given_buffer
)
4533 XSETFASTINT (start
, BEGV
);
4534 XSETFASTINT (end
, ZV
);
4538 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4542 /* At last, do the same for the function PRE_WRITE_CONVERSION
4543 implied by the current coding-system. */
4544 if (!NILP (pre_write_conversion
))
4546 struct buffer
*given_buffer
= current_buffer
;
4547 Vwrite_region_annotations_so_far
= annotations
;
4548 res
= call2 (pre_write_conversion
, start
, end
);
4550 annotations
= (current_buffer
!= given_buffer
4552 : merge (annotations
, res
, Qcar_less_than_car
));
4559 /* Write to descriptor DESC the NBYTES bytes starting at ADDR,
4560 assuming they start at byte position BYTEPOS in the buffer.
4561 Intersperse with them the annotations from *ANNOT
4562 which fall within the range of byte positions BYTEPOS to BYTEPOS + NBYTES,
4563 each at its appropriate position.
4565 We modify *ANNOT by discarding elements as we use them up.
4567 The return value is negative in case of system call failure. */
4570 a_write (desc
, addr
, nbytes
, bytepos
, annot
, coding
)
4572 register char *addr
;
4573 register int nbytes
;
4576 struct coding_system
*coding
;
4580 int lastpos
= bytepos
+ nbytes
;
4582 while (NILP (*annot
) || CONSP (*annot
))
4584 tem
= Fcar_safe (Fcar (*annot
));
4585 nextpos
= bytepos
- 1;
4587 nextpos
= CHAR_TO_BYTE (XFASTINT (tem
));
4589 /* If there are no more annotations in this range,
4590 output the rest of the range all at once. */
4591 if (! (nextpos
>= bytepos
&& nextpos
<= lastpos
))
4592 return e_write (desc
, addr
, lastpos
- bytepos
, coding
);
4594 /* Output buffer text up to the next annotation's position. */
4595 if (nextpos
> bytepos
)
4597 if (0 > e_write (desc
, addr
, nextpos
- bytepos
, coding
))
4599 addr
+= nextpos
- bytepos
;
4602 /* Output the annotation. */
4603 tem
= Fcdr (Fcar (*annot
));
4606 if (0 > e_write (desc
, XSTRING (tem
)->data
, STRING_BYTES (XSTRING (tem
)),
4610 *annot
= Fcdr (*annot
);
4615 #ifndef WRITE_BUF_SIZE
4616 #define WRITE_BUF_SIZE (16 * 1024)
4619 /* Write NBYTES bytes starting at ADDR into descriptor DESC,
4620 encoding them with coding system CODING. */
4623 e_write (desc
, addr
, nbytes
, coding
)
4625 register char *addr
;
4626 register int nbytes
;
4627 struct coding_system
*coding
;
4629 char buf
[WRITE_BUF_SIZE
];
4631 /* We used to have a code for handling selective display here. But,
4632 now it is handled within encode_coding. */
4635 encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
4636 nbytes
-= coding
->consumed
, addr
+= coding
->consumed
;
4637 if (coding
->produced
> 0)
4639 coding
->produced
-= write (desc
, buf
, coding
->produced
);
4640 if (coding
->produced
) return -1;
4648 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4649 Sverify_visited_file_modtime
, 1, 1, 0,
4650 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4651 This means that the file has not been changed since it was visited or saved.")
4657 Lisp_Object handler
;
4658 Lisp_Object filename
;
4660 CHECK_BUFFER (buf
, 0);
4663 if (!STRINGP (b
->filename
)) return Qt
;
4664 if (b
->modtime
== 0) return Qt
;
4666 /* If the file name has special constructs in it,
4667 call the corresponding file handler. */
4668 handler
= Ffind_file_name_handler (b
->filename
,
4669 Qverify_visited_file_modtime
);
4670 if (!NILP (handler
))
4671 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4673 filename
= ENCODE_FILE (b
->filename
);
4675 if (stat (XSTRING (filename
)->data
, &st
) < 0)
4677 /* If the file doesn't exist now and didn't exist before,
4678 we say that it isn't modified, provided the error is a tame one. */
4679 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4684 if (st
.st_mtime
== b
->modtime
4685 /* If both are positive, accept them if they are off by one second. */
4686 || (st
.st_mtime
> 0 && b
->modtime
> 0
4687 && (st
.st_mtime
== b
->modtime
+ 1
4688 || st
.st_mtime
== b
->modtime
- 1)))
4693 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4694 Sclear_visited_file_modtime
, 0, 0, 0,
4695 "Clear out records of last mod time of visited file.\n\
4696 Next attempt to save will certainly not complain of a discrepancy.")
4699 current_buffer
->modtime
= 0;
4703 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4704 Svisited_file_modtime
, 0, 0, 0,
4705 "Return the current buffer's recorded visited file modification time.\n\
4706 The value is a list of the form (HIGH . LOW), like the time values\n\
4707 that `file-attributes' returns.")
4710 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4713 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4714 Sset_visited_file_modtime
, 0, 1, 0,
4715 "Update buffer's recorded modification time from the visited file's time.\n\
4716 Useful if the buffer was not read from the file normally\n\
4717 or if the file itself has been changed for some known benign reason.\n\
4718 An argument specifies the modification time value to use\n\
4719 \(instead of that of the visited file), in the form of a list\n\
4720 \(HIGH . LOW) or (HIGH LOW).")
4722 Lisp_Object time_list
;
4724 if (!NILP (time_list
))
4725 current_buffer
->modtime
= cons_to_long (time_list
);
4728 register Lisp_Object filename
;
4730 Lisp_Object handler
;
4732 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4734 /* If the file name has special constructs in it,
4735 call the corresponding file handler. */
4736 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4737 if (!NILP (handler
))
4738 /* The handler can find the file name the same way we did. */
4739 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4741 filename
= ENCODE_FILE (filename
);
4743 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4744 current_buffer
->modtime
= st
.st_mtime
;
4754 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 1);
4755 Fsleep_for (make_number (1), Qnil
);
4756 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4757 Fsleep_for (make_number (1), Qnil
);
4758 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4759 Fsleep_for (make_number (1), Qnil
);
4769 /* Get visited file's mode to become the auto save file's mode. */
4770 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4771 /* But make sure we can overwrite it later! */
4772 auto_save_mode_bits
= st
.st_mode
| 0600;
4774 auto_save_mode_bits
= 0666;
4777 Fwrite_region (Qnil
, Qnil
,
4778 current_buffer
->auto_save_file_name
,
4779 Qnil
, Qlambda
, Qnil
, Qnil
);
4783 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4788 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4789 | XFASTINT (XCONS (stream
)->cdr
)));
4794 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4797 minibuffer_auto_raise
= XINT (value
);
4801 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4802 "Auto-save all buffers that need it.\n\
4803 This is all buffers that have auto-saving enabled\n\
4804 and are changed since last auto-saved.\n\
4805 Auto-saving writes the buffer into a file\n\
4806 so that your editing is not lost if the system crashes.\n\
4807 This file is not the file you visited; that changes only when you save.\n\
4808 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4809 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4810 A non-nil CURRENT-ONLY argument means save only current buffer.")
4811 (no_message
, current_only
)
4812 Lisp_Object no_message
, current_only
;
4814 struct buffer
*old
= current_buffer
, *b
;
4815 Lisp_Object tail
, buf
;
4817 char *omessage
= echo_area_glyphs
;
4818 int omessage_length
= echo_area_glyphs_length
;
4819 int oldmultibyte
= message_enable_multibyte
;
4820 int do_handled_files
;
4823 Lisp_Object lispstream
;
4824 int count
= specpdl_ptr
- specpdl
;
4826 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4828 /* Ordinarily don't quit within this function,
4829 but don't make it impossible to quit (in case we get hung in I/O). */
4833 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4834 point to non-strings reached from Vbuffer_alist. */
4839 if (!NILP (Vrun_hooks
))
4840 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4842 if (STRINGP (Vauto_save_list_file_name
))
4844 Lisp_Object listfile
;
4845 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4846 stream
= fopen (XSTRING (listfile
)->data
, "w");
4849 /* Arrange to close that file whether or not we get an error.
4850 Also reset auto_saving to 0. */
4851 lispstream
= Fcons (Qnil
, Qnil
);
4852 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
4853 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
4864 record_unwind_protect (do_auto_save_unwind
, lispstream
);
4865 record_unwind_protect (do_auto_save_unwind_1
,
4866 make_number (minibuffer_auto_raise
));
4867 minibuffer_auto_raise
= 0;
4870 /* First, save all files which don't have handlers. If Emacs is
4871 crashing, the handlers may tweak what is causing Emacs to crash
4872 in the first place, and it would be a shame if Emacs failed to
4873 autosave perfectly ordinary files because it couldn't handle some
4875 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4876 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4878 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4881 /* Record all the buffers that have auto save mode
4882 in the special file that lists them. For each of these buffers,
4883 Record visited name (if any) and auto save name. */
4884 if (STRINGP (b
->auto_save_file_name
)
4885 && stream
!= NULL
&& do_handled_files
== 0)
4887 if (!NILP (b
->filename
))
4889 fwrite (XSTRING (b
->filename
)->data
, 1,
4890 STRING_BYTES (XSTRING (b
->filename
)), stream
);
4892 putc ('\n', stream
);
4893 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
4894 STRING_BYTES (XSTRING (b
->auto_save_file_name
)), stream
);
4895 putc ('\n', stream
);
4898 if (!NILP (current_only
)
4899 && b
!= current_buffer
)
4902 /* Don't auto-save indirect buffers.
4903 The base buffer takes care of it. */
4907 /* Check for auto save enabled
4908 and file changed since last auto save
4909 and file changed since last real save. */
4910 if (STRINGP (b
->auto_save_file_name
)
4911 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4912 && b
->auto_save_modified
< BUF_MODIFF (b
)
4913 /* -1 means we've turned off autosaving for a while--see below. */
4914 && XINT (b
->save_length
) >= 0
4915 && (do_handled_files
4916 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4919 EMACS_TIME before_time
, after_time
;
4921 EMACS_GET_TIME (before_time
);
4923 /* If we had a failure, don't try again for 20 minutes. */
4924 if (b
->auto_save_failure_time
>= 0
4925 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4928 if ((XFASTINT (b
->save_length
) * 10
4929 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4930 /* A short file is likely to change a large fraction;
4931 spare the user annoying messages. */
4932 && XFASTINT (b
->save_length
) > 5000
4933 /* These messages are frequent and annoying for `*mail*'. */
4934 && !EQ (b
->filename
, Qnil
)
4935 && NILP (no_message
))
4937 /* It has shrunk too much; turn off auto-saving here. */
4938 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
4939 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
4941 minibuffer_auto_raise
= 0;
4942 /* Turn off auto-saving until there's a real save,
4943 and prevent any more warnings. */
4944 XSETINT (b
->save_length
, -1);
4945 Fsleep_for (make_number (1), Qnil
);
4948 set_buffer_internal (b
);
4949 if (!auto_saved
&& NILP (no_message
))
4950 message1 ("Auto-saving...");
4951 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4953 b
->auto_save_modified
= BUF_MODIFF (b
);
4954 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4955 set_buffer_internal (old
);
4957 EMACS_GET_TIME (after_time
);
4959 /* If auto-save took more than 60 seconds,
4960 assume it was an NFS failure that got a timeout. */
4961 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4962 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4966 /* Prevent another auto save till enough input events come in. */
4967 record_auto_save ();
4969 if (auto_saved
&& NILP (no_message
))
4973 sit_for (1, 0, 0, 0, 0);
4974 message2 (omessage
, omessage_length
, oldmultibyte
);
4977 message1 ("Auto-saving...done");
4982 unbind_to (count
, Qnil
);
4986 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4987 Sset_buffer_auto_saved
, 0, 0, 0,
4988 "Mark current buffer as auto-saved with its current text.\n\
4989 No auto-save file will be written until the buffer changes again.")
4992 current_buffer
->auto_save_modified
= MODIFF
;
4993 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4994 current_buffer
->auto_save_failure_time
= -1;
4998 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4999 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5000 "Clear any record of a recent auto-save failure in the current buffer.")
5003 current_buffer
->auto_save_failure_time
= -1;
5007 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5009 "Return t if buffer has been auto-saved since last read in or saved.")
5012 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5015 /* Reading and completing file names */
5016 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5018 /* In the string VAL, change each $ to $$ and return the result. */
5021 double_dollars (val
)
5024 register unsigned char *old
, *new;
5028 osize
= STRING_BYTES (XSTRING (val
));
5030 /* Count the number of $ characters. */
5031 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
5032 if (*old
++ == '$') count
++;
5035 old
= XSTRING (val
)->data
;
5036 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
5038 new = XSTRING (val
)->data
;
5039 for (n
= osize
; n
> 0; n
--)
5052 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5054 "Internal subroutine for read-file-name. Do not call this.")
5055 (string
, dir
, action
)
5056 Lisp_Object string
, dir
, action
;
5057 /* action is nil for complete, t for return list of completions,
5058 lambda for verify final value */
5060 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5062 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5064 CHECK_STRING (string
, 0);
5071 /* No need to protect ACTION--we only compare it with t and nil. */
5072 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5074 if (XSTRING (string
)->size
== 0)
5076 if (EQ (action
, Qlambda
))
5084 orig_string
= string
;
5085 string
= Fsubstitute_in_file_name (string
);
5086 changed
= NILP (Fstring_equal (string
, orig_string
));
5087 name
= Ffile_name_nondirectory (string
);
5088 val
= Ffile_name_directory (string
);
5090 realdir
= Fexpand_file_name (val
, realdir
);
5095 specdir
= Ffile_name_directory (string
);
5096 val
= Ffile_name_completion (name
, realdir
);
5101 return double_dollars (string
);
5105 if (!NILP (specdir
))
5106 val
= concat2 (specdir
, val
);
5108 return double_dollars (val
);
5111 #endif /* not VMS */
5115 if (EQ (action
, Qt
))
5116 return Ffile_name_all_completions (name
, realdir
);
5117 /* Only other case actually used is ACTION = lambda */
5119 /* Supposedly this helps commands such as `cd' that read directory names,
5120 but can someone explain how it helps them? -- RMS */
5121 if (XSTRING (name
)->size
== 0)
5124 return Ffile_exists_p (string
);
5127 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5128 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5129 Value is not expanded---you must call `expand-file-name' yourself.\n\
5130 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5131 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5132 except that if INITIAL is specified, that combined with DIR is used.)\n\
5133 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5134 Non-nil and non-t means also require confirmation after completion.\n\
5135 Fifth arg INITIAL specifies text to start with.\n\
5136 DIR defaults to current buffer's directory default.")
5137 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5138 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5140 Lisp_Object val
, insdef
, insdef1
, tem
;
5141 struct gcpro gcpro1
, gcpro2
;
5142 register char *homedir
;
5143 int replace_in_history
= 0;
5144 int add_to_history
= 0;
5148 dir
= current_buffer
->directory
;
5149 if (NILP (default_filename
))
5151 if (! NILP (initial
))
5152 default_filename
= Fexpand_file_name (initial
, dir
);
5154 default_filename
= current_buffer
->filename
;
5157 /* If dir starts with user's homedir, change that to ~. */
5158 homedir
= (char *) egetenv ("HOME");
5160 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5161 CORRECT_DIR_SEPS (homedir
);
5165 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5166 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5168 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5169 STRING_BYTES (XSTRING (dir
)) - strlen (homedir
) + 1);
5170 XSTRING (dir
)->data
[0] = '~';
5173 if (insert_default_directory
&& STRINGP (dir
))
5176 if (!NILP (initial
))
5178 Lisp_Object args
[2], pos
;
5182 insdef
= Fconcat (2, args
);
5183 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5184 insdef1
= Fcons (double_dollars (insdef
), pos
);
5187 insdef1
= double_dollars (insdef
);
5189 else if (STRINGP (initial
))
5192 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
5195 insdef
= Qnil
, insdef1
= Qnil
;
5198 count
= specpdl_ptr
- specpdl
;
5199 specbind (intern ("completion-ignore-case"), Qt
);
5202 GCPRO2 (insdef
, default_filename
);
5203 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5204 dir
, mustmatch
, insdef1
,
5205 Qfile_name_history
, default_filename
, Qnil
);
5207 tem
= Fsymbol_value (Qfile_name_history
);
5208 if (CONSP (tem
) && EQ (XCONS (tem
)->car
, val
))
5209 replace_in_history
= 1;
5211 /* If Fcompleting_read returned the inserted default string itself
5212 (rather than a new string with the same contents),
5213 it has to mean that the user typed RET with the minibuffer empty.
5214 In that case, we really want to return ""
5215 so that commands such as set-visited-file-name can distinguish. */
5216 if (EQ (val
, default_filename
))
5218 /* In this case, Fcompleting_read has not added an element
5219 to the history. Maybe we should. */
5220 if (! replace_in_history
)
5223 val
= build_string ("");
5227 unbind_to (count
, Qnil
);
5232 error ("No file name specified");
5234 tem
= Fstring_equal (val
, insdef
);
5236 if (!NILP (tem
) && !NILP (default_filename
))
5237 val
= default_filename
;
5238 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5240 if (!NILP (default_filename
))
5241 val
= default_filename
;
5243 error ("No default file name");
5245 val
= Fsubstitute_in_file_name (val
);
5247 if (replace_in_history
)
5248 /* Replace what Fcompleting_read added to the history
5249 with what we will actually return. */
5250 XCONS (Fsymbol_value (Qfile_name_history
))->car
= val
;
5251 else if (add_to_history
)
5253 /* Add the value to the history--but not if it matches
5254 the last value already there. */
5255 tem
= Fsymbol_value (Qfile_name_history
);
5256 if (! CONSP (tem
) || NILP (Fequal (XCONS (tem
)->car
, val
)))
5257 Fset (Qfile_name_history
,
5266 Qexpand_file_name
= intern ("expand-file-name");
5267 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5268 Qdirectory_file_name
= intern ("directory-file-name");
5269 Qfile_name_directory
= intern ("file-name-directory");
5270 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5271 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5272 Qfile_name_as_directory
= intern ("file-name-as-directory");
5273 Qcopy_file
= intern ("copy-file");
5274 Qmake_directory_internal
= intern ("make-directory-internal");
5275 Qdelete_directory
= intern ("delete-directory");
5276 Qdelete_file
= intern ("delete-file");
5277 Qrename_file
= intern ("rename-file");
5278 Qadd_name_to_file
= intern ("add-name-to-file");
5279 Qmake_symbolic_link
= intern ("make-symbolic-link");
5280 Qfile_exists_p
= intern ("file-exists-p");
5281 Qfile_executable_p
= intern ("file-executable-p");
5282 Qfile_readable_p
= intern ("file-readable-p");
5283 Qfile_writable_p
= intern ("file-writable-p");
5284 Qfile_symlink_p
= intern ("file-symlink-p");
5285 Qaccess_file
= intern ("access-file");
5286 Qfile_directory_p
= intern ("file-directory-p");
5287 Qfile_regular_p
= intern ("file-regular-p");
5288 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5289 Qfile_modes
= intern ("file-modes");
5290 Qset_file_modes
= intern ("set-file-modes");
5291 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5292 Qinsert_file_contents
= intern ("insert-file-contents");
5293 Qwrite_region
= intern ("write-region");
5294 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5295 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5297 staticpro (&Qexpand_file_name
);
5298 staticpro (&Qsubstitute_in_file_name
);
5299 staticpro (&Qdirectory_file_name
);
5300 staticpro (&Qfile_name_directory
);
5301 staticpro (&Qfile_name_nondirectory
);
5302 staticpro (&Qunhandled_file_name_directory
);
5303 staticpro (&Qfile_name_as_directory
);
5304 staticpro (&Qcopy_file
);
5305 staticpro (&Qmake_directory_internal
);
5306 staticpro (&Qdelete_directory
);
5307 staticpro (&Qdelete_file
);
5308 staticpro (&Qrename_file
);
5309 staticpro (&Qadd_name_to_file
);
5310 staticpro (&Qmake_symbolic_link
);
5311 staticpro (&Qfile_exists_p
);
5312 staticpro (&Qfile_executable_p
);
5313 staticpro (&Qfile_readable_p
);
5314 staticpro (&Qfile_writable_p
);
5315 staticpro (&Qaccess_file
);
5316 staticpro (&Qfile_symlink_p
);
5317 staticpro (&Qfile_directory_p
);
5318 staticpro (&Qfile_regular_p
);
5319 staticpro (&Qfile_accessible_directory_p
);
5320 staticpro (&Qfile_modes
);
5321 staticpro (&Qset_file_modes
);
5322 staticpro (&Qfile_newer_than_file_p
);
5323 staticpro (&Qinsert_file_contents
);
5324 staticpro (&Qwrite_region
);
5325 staticpro (&Qverify_visited_file_modtime
);
5326 staticpro (&Qset_visited_file_modtime
);
5328 Qfile_name_history
= intern ("file-name-history");
5329 Fset (Qfile_name_history
, Qnil
);
5330 staticpro (&Qfile_name_history
);
5332 Qfile_error
= intern ("file-error");
5333 staticpro (&Qfile_error
);
5334 Qfile_already_exists
= intern ("file-already-exists");
5335 staticpro (&Qfile_already_exists
);
5336 Qfile_date_error
= intern ("file-date-error");
5337 staticpro (&Qfile_date_error
);
5340 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5341 staticpro (&Qfind_buffer_file_type
);
5344 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5345 "*Coding system for encoding file names.\n\
5346 If it is nil, default-file-name-coding-system (which see) is used.");
5347 Vfile_name_coding_system
= Qnil
;
5349 DEFVAR_LISP ("default-file-name-coding-system",
5350 &Vdefault_file_name_coding_system
,
5351 "Default coding system for encoding file names.\n\
5352 This variable is used only when file-name-coding-system is nil.\n\
5354 This variable is set/changed by the command set-language-environment.\n\
5355 User should not set this variable manually,\n\
5356 instead use file-name-coding-system to get a constant encoding\n\
5357 of file names regardless of the current language environment.");
5358 Vdefault_file_name_coding_system
= Qnil
;
5360 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5361 "*Format in which to write auto-save files.\n\
5362 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5363 If it is t, which is the default, auto-save files are written in the\n\
5364 same format as a regular save would use.");
5365 Vauto_save_file_format
= Qt
;
5367 Qformat_decode
= intern ("format-decode");
5368 staticpro (&Qformat_decode
);
5369 Qformat_annotate_function
= intern ("format-annotate-function");
5370 staticpro (&Qformat_annotate_function
);
5372 Qcar_less_than_car
= intern ("car-less-than-car");
5373 staticpro (&Qcar_less_than_car
);
5375 Fput (Qfile_error
, Qerror_conditions
,
5376 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5377 Fput (Qfile_error
, Qerror_message
,
5378 build_string ("File error"));
5380 Fput (Qfile_already_exists
, Qerror_conditions
,
5381 Fcons (Qfile_already_exists
,
5382 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5383 Fput (Qfile_already_exists
, Qerror_message
,
5384 build_string ("File already exists"));
5386 Fput (Qfile_date_error
, Qerror_conditions
,
5387 Fcons (Qfile_date_error
,
5388 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5389 Fput (Qfile_date_error
, Qerror_message
,
5390 build_string ("Cannot set file date"));
5392 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5393 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5394 insert_default_directory
= 1;
5396 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5397 "*Non-nil means write new files with record format `stmlf'.\n\
5398 nil means use format `var'. This variable is meaningful only on VMS.");
5399 vms_stmlf_recfm
= 0;
5401 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5402 "Directory separator character for built-in functions that return file names.\n\
5403 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5404 This variable affects the built-in functions only on Windows,\n\
5405 on other platforms, it is initialized so that Lisp code can find out\n\
5406 what the normal separator is.");
5407 XSETFASTINT (Vdirectory_sep_char
, '/');
5409 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5410 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5411 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5414 The first argument given to HANDLER is the name of the I/O primitive\n\
5415 to be handled; the remaining arguments are the arguments that were\n\
5416 passed to that primitive. For example, if you do\n\
5417 (file-exists-p FILENAME)\n\
5418 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5419 (funcall HANDLER 'file-exists-p FILENAME)\n\
5420 The function `find-file-name-handler' checks this list for a handler\n\
5421 for its argument.");
5422 Vfile_name_handler_alist
= Qnil
;
5424 DEFVAR_LISP ("set-auto-coding-function",
5425 &Vset_auto_coding_function
,
5426 "If non-nil, a function to call to decide a coding system of file.\n\
5427 One argument is passed to this function: the string of concatination\n\
5428 or the heading 1K-byte and the tailing 3K-byte of a file to be read.\n\
5429 This function should return a coding system to decode the file contents\n\
5430 specified in the heading lines with the format:\n\
5431 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5432 or local variable spec of the tailing lines with `coding:' tag.");
5433 Vset_auto_coding_function
= Qnil
;
5435 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5436 "A list of functions to be called at the end of `insert-file-contents'.\n\
5437 Each is passed one argument, the number of bytes inserted. It should return\n\
5438 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5439 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5440 responsible for calling the after-insert-file-functions if appropriate.");
5441 Vafter_insert_file_functions
= Qnil
;
5443 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5444 "A list of functions to be called at the start of `write-region'.\n\
5445 Each is passed two arguments, START and END as for `write-region'.\n\
5446 These are usually two numbers but not always; see the documentation\n\
5447 for `write-region'. The function should return a list of pairs\n\
5448 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5449 inserted at the specified positions of the file being written (1 means to\n\
5450 insert before the first byte written). The POSITIONs must be sorted into\n\
5451 increasing order. If there are several functions in the list, the several\n\
5452 lists are merged destructively.");
5453 Vwrite_region_annotate_functions
= Qnil
;
5455 DEFVAR_LISP ("write-region-annotations-so-far",
5456 &Vwrite_region_annotations_so_far
,
5457 "When an annotation function is called, this holds the previous annotations.\n\
5458 These are the annotations made by other annotation functions\n\
5459 that were already called. See also `write-region-annotate-functions'.");
5460 Vwrite_region_annotations_so_far
= Qnil
;
5462 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5463 "A list of file name handlers that temporarily should not be used.\n\
5464 This applies only to the operation `inhibit-file-name-operation'.");
5465 Vinhibit_file_name_handlers
= Qnil
;
5467 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5468 "The operation for which `inhibit-file-name-handlers' is applicable.");
5469 Vinhibit_file_name_operation
= Qnil
;
5471 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5472 "File name in which we write a list of all auto save file names.\n\
5473 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5474 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5476 Vauto_save_list_file_name
= Qnil
;
5478 defsubr (&Sfind_file_name_handler
);
5479 defsubr (&Sfile_name_directory
);
5480 defsubr (&Sfile_name_nondirectory
);
5481 defsubr (&Sunhandled_file_name_directory
);
5482 defsubr (&Sfile_name_as_directory
);
5483 defsubr (&Sdirectory_file_name
);
5484 defsubr (&Smake_temp_name
);
5485 defsubr (&Sexpand_file_name
);
5486 defsubr (&Ssubstitute_in_file_name
);
5487 defsubr (&Scopy_file
);
5488 defsubr (&Smake_directory_internal
);
5489 defsubr (&Sdelete_directory
);
5490 defsubr (&Sdelete_file
);
5491 defsubr (&Srename_file
);
5492 defsubr (&Sadd_name_to_file
);
5494 defsubr (&Smake_symbolic_link
);
5495 #endif /* S_IFLNK */
5497 defsubr (&Sdefine_logical_name
);
5500 defsubr (&Ssysnetunam
);
5501 #endif /* HPUX_NET */
5502 defsubr (&Sfile_name_absolute_p
);
5503 defsubr (&Sfile_exists_p
);
5504 defsubr (&Sfile_executable_p
);
5505 defsubr (&Sfile_readable_p
);
5506 defsubr (&Sfile_writable_p
);
5507 defsubr (&Saccess_file
);
5508 defsubr (&Sfile_symlink_p
);
5509 defsubr (&Sfile_directory_p
);
5510 defsubr (&Sfile_accessible_directory_p
);
5511 defsubr (&Sfile_regular_p
);
5512 defsubr (&Sfile_modes
);
5513 defsubr (&Sset_file_modes
);
5514 defsubr (&Sset_default_file_modes
);
5515 defsubr (&Sdefault_file_modes
);
5516 defsubr (&Sfile_newer_than_file_p
);
5517 defsubr (&Sinsert_file_contents
);
5518 defsubr (&Swrite_region
);
5519 defsubr (&Scar_less_than_car
);
5520 defsubr (&Sverify_visited_file_modtime
);
5521 defsubr (&Sclear_visited_file_modtime
);
5522 defsubr (&Svisited_file_modtime
);
5523 defsubr (&Sset_visited_file_modtime
);
5524 defsubr (&Sdo_auto_save
);
5525 defsubr (&Sset_buffer_auto_saved
);
5526 defsubr (&Sclear_buffer_auto_save_failure
);
5527 defsubr (&Srecent_auto_save_p
);
5529 defsubr (&Sread_file_name_internal
);
5530 defsubr (&Sread_file_name
);
5533 defsubr (&Sunix_sync
);