1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
29 #include <sys/types.h>
36 #if !defined (S_ISLNK) && defined (S_IFLNK)
37 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
40 #if !defined (S_ISFIFO) && defined (S_IFIFO)
41 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
44 #if !defined (S_ISREG) && defined (S_IFREG)
45 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
76 #include "intervals.h"
87 #endif /* not WINDOWSNT */
91 #include <sys/param.h>
99 #define CORRECT_DIR_SEPS(s) \
100 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
101 else unixtodos_filename (s); \
103 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
104 redirector allows the six letters between 'Z' and 'a' as well. */
106 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
109 #define IS_DRIVE(x) isalpha (x)
111 /* Need to lower-case the drive letter, or else expanded
112 filenames will sometimes compare inequal, because
113 `expand-file-name' doesn't always down-case the drive letter. */
114 #define DRIVE_LETTER(x) (tolower (x))
135 #include "commands.h"
136 extern int use_dialog_box
;
150 /* Nonzero during writing of auto-save files */
153 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
154 a new file with the same mode as the original */
155 int auto_save_mode_bits
;
157 /* Coding system for file names, or nil if none. */
158 Lisp_Object Vfile_name_coding_system
;
160 /* Coding system for file names used only when
161 Vfile_name_coding_system is nil. */
162 Lisp_Object Vdefault_file_name_coding_system
;
164 /* Alist of elements (REGEXP . HANDLER) for file names
165 whose I/O is done with a special handler. */
166 Lisp_Object Vfile_name_handler_alist
;
168 /* Format for auto-save files */
169 Lisp_Object Vauto_save_file_format
;
171 /* Lisp functions for translating file formats */
172 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
174 /* Function to be called to decide a coding system of a reading file. */
175 Lisp_Object Vset_auto_coding_function
;
177 /* Functions to be called to process text properties in inserted file. */
178 Lisp_Object Vafter_insert_file_functions
;
180 /* Functions to be called to create text property annotations for file. */
181 Lisp_Object Vwrite_region_annotate_functions
;
183 /* During build_annotations, each time an annotation function is called,
184 this holds the annotations made by the previous functions. */
185 Lisp_Object Vwrite_region_annotations_so_far
;
187 /* File name in which we write a list of all our auto save files. */
188 Lisp_Object Vauto_save_list_file_name
;
190 /* Function to call to read a file name. */
191 Lisp_Object Vread_file_name_function
;
193 /* Current predicate used by read_file_name_internal. */
194 Lisp_Object Vread_file_name_predicate
;
196 /* Nonzero means, when reading a filename in the minibuffer,
197 start out by inserting the default directory into the minibuffer. */
198 int insert_default_directory
;
200 /* On VMS, nonzero means write new files with record format stmlf.
201 Zero means use var format. */
204 /* On NT, specifies the directory separator character, used (eg.) when
205 expanding file names. This can be bound to / or \. */
206 Lisp_Object Vdirectory_sep_char
;
208 extern Lisp_Object Vuser_login_name
;
211 extern Lisp_Object Vw32_get_true_file_attributes
;
214 extern int minibuf_level
;
216 extern int minibuffer_auto_raise
;
218 /* These variables describe handlers that have "already" had a chance
219 to handle the current operation.
221 Vinhibit_file_name_handlers is a list of file name handlers.
222 Vinhibit_file_name_operation is the operation being handled.
223 If we try to handle that operation, we ignore those handlers. */
225 static Lisp_Object Vinhibit_file_name_handlers
;
226 static Lisp_Object Vinhibit_file_name_operation
;
228 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
230 Lisp_Object Qfile_name_history
;
232 Lisp_Object Qcar_less_than_car
;
234 static int a_write
P_ ((int, Lisp_Object
, int, int,
235 Lisp_Object
*, struct coding_system
*));
236 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
240 report_file_error (string
, data
)
244 Lisp_Object errstring
;
247 synchronize_system_messages_locale ();
248 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
249 Vlocale_coding_system
, 0);
255 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
258 /* System error messages are capitalized. Downcase the initial
259 unless it is followed by a slash. */
260 if (SREF (errstring
, 1) != '/')
261 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
263 Fsignal (Qfile_error
,
264 Fcons (build_string (string
), Fcons (errstring
, data
)));
269 close_file_unwind (fd
)
272 emacs_close (XFASTINT (fd
));
276 /* Restore point, having saved it as a marker. */
279 restore_point_unwind (location
)
280 Lisp_Object location
;
282 Fgoto_char (location
);
283 Fset_marker (location
, Qnil
, Qnil
);
287 Lisp_Object Qexpand_file_name
;
288 Lisp_Object Qsubstitute_in_file_name
;
289 Lisp_Object Qdirectory_file_name
;
290 Lisp_Object Qfile_name_directory
;
291 Lisp_Object Qfile_name_nondirectory
;
292 Lisp_Object Qunhandled_file_name_directory
;
293 Lisp_Object Qfile_name_as_directory
;
294 Lisp_Object Qcopy_file
;
295 Lisp_Object Qmake_directory_internal
;
296 Lisp_Object Qmake_directory
;
297 Lisp_Object Qdelete_directory
;
298 Lisp_Object Qdelete_file
;
299 Lisp_Object Qrename_file
;
300 Lisp_Object Qadd_name_to_file
;
301 Lisp_Object Qmake_symbolic_link
;
302 Lisp_Object Qfile_exists_p
;
303 Lisp_Object Qfile_executable_p
;
304 Lisp_Object Qfile_readable_p
;
305 Lisp_Object Qfile_writable_p
;
306 Lisp_Object Qfile_symlink_p
;
307 Lisp_Object Qaccess_file
;
308 Lisp_Object Qfile_directory_p
;
309 Lisp_Object Qfile_regular_p
;
310 Lisp_Object Qfile_accessible_directory_p
;
311 Lisp_Object Qfile_modes
;
312 Lisp_Object Qset_file_modes
;
313 Lisp_Object Qfile_newer_than_file_p
;
314 Lisp_Object Qinsert_file_contents
;
315 Lisp_Object Qwrite_region
;
316 Lisp_Object Qverify_visited_file_modtime
;
317 Lisp_Object Qset_visited_file_modtime
;
319 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
320 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
321 Otherwise, return nil.
322 A file name is handled if one of the regular expressions in
323 `file-name-handler-alist' matches it.
325 If OPERATION equals `inhibit-file-name-operation', then we ignore
326 any handlers that are members of `inhibit-file-name-handlers',
327 but we still do run any other handlers. This lets handlers
328 use the standard functions without calling themselves recursively. */)
329 (filename
, operation
)
330 Lisp_Object filename
, operation
;
332 /* This function must not munge the match data. */
333 Lisp_Object chain
, inhibited_handlers
, result
;
337 CHECK_STRING (filename
);
339 if (EQ (operation
, Vinhibit_file_name_operation
))
340 inhibited_handlers
= Vinhibit_file_name_handlers
;
342 inhibited_handlers
= Qnil
;
344 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
345 chain
= XCDR (chain
))
355 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
357 Lisp_Object handler
, tem
;
359 handler
= XCDR (elt
);
360 tem
= Fmemq (handler
, inhibited_handlers
);
374 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
376 doc
: /* Return the directory component in file name FILENAME.
377 Return nil if FILENAME does not include a directory.
378 Otherwise return a directory spec.
379 Given a Unix syntax file name, returns a string ending in slash;
380 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
382 Lisp_Object filename
;
385 register const unsigned char *beg
;
387 register unsigned char *beg
;
389 register const unsigned char *p
;
392 CHECK_STRING (filename
);
394 /* If the file name has special constructs in it,
395 call the corresponding file handler. */
396 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
398 return call2 (handler
, Qfile_name_directory
, filename
);
400 #ifdef FILE_SYSTEM_CASE
401 filename
= FILE_SYSTEM_CASE (filename
);
403 beg
= SDATA (filename
);
405 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
407 p
= beg
+ SBYTES (filename
);
409 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
411 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
414 /* only recognise drive specifier at the beginning */
416 /* handle the "/:d:foo" and "/:foo" cases correctly */
417 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
418 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
425 /* Expansion of "c:" to drive and default directory. */
428 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
429 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
430 unsigned char *r
= res
;
432 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
434 strncpy (res
, beg
, 2);
439 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
441 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
444 p
= beg
+ strlen (beg
);
447 CORRECT_DIR_SEPS (beg
);
450 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
453 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
454 Sfile_name_nondirectory
, 1, 1, 0,
455 doc
: /* Return file name FILENAME sans its directory.
456 For example, in a Unix-syntax file name,
457 this is everything after the last slash,
458 or the entire name if it contains no slash. */)
460 Lisp_Object filename
;
462 register const unsigned char *beg
, *p
, *end
;
465 CHECK_STRING (filename
);
467 /* If the file name has special constructs in it,
468 call the corresponding file handler. */
469 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
471 return call2 (handler
, Qfile_name_nondirectory
, filename
);
473 beg
= SDATA (filename
);
474 end
= p
= beg
+ SBYTES (filename
);
476 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
478 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
481 /* only recognise drive specifier at beginning */
483 /* handle the "/:d:foo" case correctly */
484 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
489 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
492 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
493 Sunhandled_file_name_directory
, 1, 1, 0,
494 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
495 A `directly usable' directory name is one that may be used without the
496 intervention of any file handler.
497 If FILENAME is a directly usable file itself, return
498 \(file-name-directory FILENAME).
499 The `call-process' and `start-process' functions use this function to
500 get a current directory to run processes in. */)
502 Lisp_Object filename
;
506 /* If the file name has special constructs in it,
507 call the corresponding file handler. */
508 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
510 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
512 return Ffile_name_directory (filename
);
517 file_name_as_directory (out
, in
)
520 int size
= strlen (in
) - 1;
533 /* Is it already a directory string? */
534 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
536 /* Is it a VMS directory file name? If so, hack VMS syntax. */
537 else if (! index (in
, '/')
538 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
539 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
540 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
541 || ! strncmp (&in
[size
- 5], ".dir", 4))
542 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
543 && in
[size
] == '1')))
545 register char *p
, *dot
;
549 dir:x.dir --> dir:[x]
550 dir:[x]y.dir --> dir:[x.y] */
552 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
555 strncpy (out
, in
, p
- in
);
574 dot
= index (p
, '.');
577 /* blindly remove any extension */
578 size
= strlen (out
) + (dot
- p
);
579 strncat (out
, p
, dot
- p
);
590 /* For Unix syntax, Append a slash if necessary */
591 if (!IS_DIRECTORY_SEP (out
[size
]))
593 /* Cannot use DIRECTORY_SEP, which could have any value */
595 out
[size
+ 2] = '\0';
598 CORRECT_DIR_SEPS (out
);
604 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
605 Sfile_name_as_directory
, 1, 1, 0,
606 doc
: /* Return a string representing the file name FILE interpreted as a directory.
607 This operation exists because a directory is also a file, but its name as
608 a directory is different from its name as a file.
609 The result can be used as the value of `default-directory'
610 or passed as second argument to `expand-file-name'.
611 For a Unix-syntax file name, just appends a slash.
612 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
623 /* If the file name has special constructs in it,
624 call the corresponding file handler. */
625 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
627 return call2 (handler
, Qfile_name_as_directory
, file
);
629 buf
= (char *) alloca (SBYTES (file
) + 10);
630 file_name_as_directory (buf
, SDATA (file
));
631 return make_specified_string (buf
, -1, strlen (buf
),
632 STRING_MULTIBYTE (file
));
636 * Convert from directory name to filename.
638 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
639 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
640 * On UNIX, it's simple: just make sure there isn't a terminating /
642 * Value is nonzero if the string output is different from the input.
646 directory_file_name (src
, dst
)
654 struct FAB fab
= cc$rms_fab
;
655 struct NAM nam
= cc$rms_nam
;
656 char esa
[NAM$C_MAXRSS
];
661 if (! index (src
, '/')
662 && (src
[slen
- 1] == ']'
663 || src
[slen
- 1] == ':'
664 || src
[slen
- 1] == '>'))
666 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
668 fab
.fab$b_fns
= slen
;
669 fab
.fab$l_nam
= &nam
;
670 fab
.fab$l_fop
= FAB$M_NAM
;
673 nam
.nam$b_ess
= sizeof esa
;
674 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
676 /* We call SYS$PARSE to handle such things as [--] for us. */
677 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
679 slen
= nam
.nam$b_esl
;
680 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
685 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
687 /* what about when we have logical_name:???? */
688 if (src
[slen
- 1] == ':')
689 { /* Xlate logical name and see what we get */
690 ptr
= strcpy (dst
, src
); /* upper case for getenv */
693 if ('a' <= *ptr
&& *ptr
<= 'z')
697 dst
[slen
- 1] = 0; /* remove colon */
698 if (!(src
= egetenv (dst
)))
700 /* should we jump to the beginning of this procedure?
701 Good points: allows us to use logical names that xlate
703 Bad points: can be a problem if we just translated to a device
705 For now, I'll punt and always expect VMS names, and hope for
708 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
709 { /* no recursion here! */
715 { /* not a directory spec */
720 bracket
= src
[slen
- 1];
722 /* If bracket is ']' or '>', bracket - 2 is the corresponding
724 ptr
= index (src
, bracket
- 2);
726 { /* no opening bracket */
730 if (!(rptr
= rindex (src
, '.')))
733 strncpy (dst
, src
, slen
);
737 dst
[slen
++] = bracket
;
742 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
743 then translate the device and recurse. */
744 if (dst
[slen
- 1] == ':'
745 && dst
[slen
- 2] != ':' /* skip decnet nodes */
746 && strcmp (src
+ slen
, "[000000]") == 0)
748 dst
[slen
- 1] = '\0';
749 if ((ptr
= egetenv (dst
))
750 && (rlen
= strlen (ptr
) - 1) > 0
751 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
752 && ptr
[rlen
- 1] == '.')
754 char * buf
= (char *) alloca (strlen (ptr
) + 1);
758 return directory_file_name (buf
, dst
);
763 strcat (dst
, "[000000]");
767 rlen
= strlen (rptr
) - 1;
768 strncat (dst
, rptr
, rlen
);
769 dst
[slen
+ rlen
] = '\0';
770 strcat (dst
, ".DIR.1");
774 /* Process as Unix format: just remove any final slash.
775 But leave "/" unchanged; do not change it to "". */
778 /* Handle // as root for apollo's. */
779 if ((slen
> 2 && dst
[slen
- 1] == '/')
780 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
784 && IS_DIRECTORY_SEP (dst
[slen
- 1])
786 && !IS_ANY_SEP (dst
[slen
- 2])
792 CORRECT_DIR_SEPS (dst
);
797 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
799 doc
: /* Returns the file name of the directory named DIRECTORY.
800 This is the name of the file that holds the data for the directory DIRECTORY.
801 This operation exists because a directory is also a file, but its name as
802 a directory is different from its name as a file.
803 In Unix-syntax, this function just removes the final slash.
804 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
805 it returns a file name such as \"[X]Y.DIR.1\". */)
807 Lisp_Object directory
;
812 CHECK_STRING (directory
);
814 if (NILP (directory
))
817 /* If the file name has special constructs in it,
818 call the corresponding file handler. */
819 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
821 return call2 (handler
, Qdirectory_file_name
, directory
);
824 /* 20 extra chars is insufficient for VMS, since we might perform a
825 logical name translation. an equivalence string can be up to 255
826 chars long, so grab that much extra space... - sss */
827 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
829 buf
= (char *) alloca (SBYTES (directory
) + 20);
831 directory_file_name (SDATA (directory
), buf
);
832 return make_specified_string (buf
, -1, strlen (buf
),
833 STRING_MULTIBYTE (directory
));
836 static char make_temp_name_tbl
[64] =
838 'A','B','C','D','E','F','G','H',
839 'I','J','K','L','M','N','O','P',
840 'Q','R','S','T','U','V','W','X',
841 'Y','Z','a','b','c','d','e','f',
842 'g','h','i','j','k','l','m','n',
843 'o','p','q','r','s','t','u','v',
844 'w','x','y','z','0','1','2','3',
845 '4','5','6','7','8','9','-','_'
848 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
850 /* Value is a temporary file name starting with PREFIX, a string.
852 The Emacs process number forms part of the result, so there is
853 no danger of generating a name being used by another process.
854 In addition, this function makes an attempt to choose a name
855 which has no existing file. To make this work, PREFIX should be
856 an absolute file name.
858 BASE64_P non-zero means add the pid as 3 characters in base64
859 encoding. In this case, 6 characters will be added to PREFIX to
860 form the file name. Otherwise, if Emacs is running on a system
861 with long file names, add the pid as a decimal number.
863 This function signals an error if no unique file name could be
867 make_temp_name (prefix
, base64_p
)
874 unsigned char *p
, *data
;
878 CHECK_STRING (prefix
);
880 /* VAL is created by adding 6 characters to PREFIX. The first
881 three are the PID of this process, in base 64, and the second
882 three are incremented if the file already exists. This ensures
883 262144 unique file names per PID per PREFIX. */
885 pid
= (int) getpid ();
889 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
890 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
891 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
896 #ifdef HAVE_LONG_FILE_NAMES
897 sprintf (pidbuf
, "%d", pid
);
898 pidlen
= strlen (pidbuf
);
900 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
901 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
902 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
907 len
= SCHARS (prefix
);
908 val
= make_uninit_string (len
+ 3 + pidlen
);
910 bcopy(SDATA (prefix
), data
, len
);
913 bcopy (pidbuf
, p
, pidlen
);
916 /* Here we try to minimize useless stat'ing when this function is
917 invoked many times successively with the same PREFIX. We achieve
918 this by initializing count to a random value, and incrementing it
921 We don't want make-temp-name to be called while dumping,
922 because then make_temp_name_count_initialized_p would get set
923 and then make_temp_name_count would not be set when Emacs starts. */
925 if (!make_temp_name_count_initialized_p
)
927 make_temp_name_count
= (unsigned) time (NULL
);
928 make_temp_name_count_initialized_p
= 1;
934 unsigned num
= make_temp_name_count
;
936 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
937 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
938 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
940 /* Poor man's congruential RN generator. Replace with
941 ++make_temp_name_count for debugging. */
942 make_temp_name_count
+= 25229;
943 make_temp_name_count
%= 225307;
945 if (stat (data
, &ignored
) < 0)
947 /* We want to return only if errno is ENOENT. */
951 /* The error here is dubious, but there is little else we
952 can do. The alternatives are to return nil, which is
953 as bad as (and in many cases worse than) throwing the
954 error, or to ignore the error, which will likely result
955 in looping through 225307 stat's, which is not only
956 dog-slow, but also useless since it will fallback to
957 the errow below, anyway. */
958 report_file_error ("Cannot create temporary name for prefix",
959 Fcons (prefix
, Qnil
));
964 error ("Cannot create temporary name for prefix `%s'",
970 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
971 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
972 The Emacs process number forms part of the result,
973 so there is no danger of generating a name being used by another process.
975 In addition, this function makes an attempt to choose a name
976 which has no existing file. To make this work,
977 PREFIX should be an absolute file name.
979 There is a race condition between calling `make-temp-name' and creating the
980 file which opens all kinds of security holes. For that reason, you should
981 probably use `make-temp-file' instead, except in three circumstances:
983 * If you are creating the file in the user's home directory.
984 * If you are creating a directory rather than an ordinary file.
985 * If you are taking special precautions as `make-temp-file' does. */)
989 return make_temp_name (prefix
, 0);
994 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
995 doc
: /* Convert filename NAME to absolute, and canonicalize it.
996 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
997 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
998 the current buffer's value of default-directory is used.
999 File name components that are `.' are removed, and
1000 so are file name components followed by `..', along with the `..' itself;
1001 note that these simplifications are done without checking the resulting
1002 file names in the file system.
1003 An initial `~/' expands to your home directory.
1004 An initial `~USER/' expands to USER's home directory.
1005 See also the function `substitute-in-file-name'. */)
1006 (name
, default_directory
)
1007 Lisp_Object name
, default_directory
;
1011 register unsigned char *newdir
, *p
, *o
;
1013 unsigned char *target
;
1016 unsigned char * colon
= 0;
1017 unsigned char * close
= 0;
1018 unsigned char * slash
= 0;
1019 unsigned char * brack
= 0;
1020 int lbrack
= 0, rbrack
= 0;
1025 int collapse_newdir
= 1;
1029 Lisp_Object handler
;
1031 CHECK_STRING (name
);
1033 /* If the file name has special constructs in it,
1034 call the corresponding file handler. */
1035 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1036 if (!NILP (handler
))
1037 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1039 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1040 if (NILP (default_directory
))
1041 default_directory
= current_buffer
->directory
;
1042 if (! STRINGP (default_directory
))
1045 /* "/" is not considered a root directory on DOS_NT, so using "/"
1046 here causes an infinite recursion in, e.g., the following:
1048 (let (default-directory)
1049 (expand-file-name "a"))
1051 To avoid this, we set default_directory to the root of the
1053 extern char *emacs_root_dir (void);
1055 default_directory
= build_string (emacs_root_dir ());
1057 default_directory
= build_string ("/");
1061 if (!NILP (default_directory
))
1063 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1064 if (!NILP (handler
))
1065 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1068 o
= SDATA (default_directory
);
1070 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1071 It would be better to do this down below where we actually use
1072 default_directory. Unfortunately, calling Fexpand_file_name recursively
1073 could invoke GC, and the strings might be relocated. This would
1074 be annoying because we have pointers into strings lying around
1075 that would need adjusting, and people would add new pointers to
1076 the code and forget to adjust them, resulting in intermittent bugs.
1077 Putting this call here avoids all that crud.
1079 The EQ test avoids infinite recursion. */
1080 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1081 /* Save time in some common cases - as long as default_directory
1082 is not relative, it can be canonicalized with name below (if it
1083 is needed at all) without requiring it to be expanded now. */
1085 /* Detect MSDOS file names with drive specifiers. */
1086 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1088 /* Detect Windows file names in UNC format. */
1089 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1091 #else /* not DOS_NT */
1092 /* Detect Unix absolute file names (/... alone is not absolute on
1094 && ! (IS_DIRECTORY_SEP (o
[0]))
1095 #endif /* not DOS_NT */
1098 struct gcpro gcpro1
;
1101 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1106 /* Filenames on VMS are always upper case. */
1107 name
= Fupcase (name
);
1109 #ifdef FILE_SYSTEM_CASE
1110 name
= FILE_SYSTEM_CASE (name
);
1116 /* We will force directory separators to be either all \ or /, so make
1117 a local copy to modify, even if there ends up being no change. */
1118 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1120 /* Note if special escape prefix is present, but remove for now. */
1121 if (nm
[0] == '/' && nm
[1] == ':')
1127 /* Find and remove drive specifier if present; this makes nm absolute
1128 even if the rest of the name appears to be relative. Only look for
1129 drive specifier at the beginning. */
1130 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1137 /* If we see "c://somedir", we want to strip the first slash after the
1138 colon when stripping the drive letter. Otherwise, this expands to
1140 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1142 #endif /* WINDOWSNT */
1146 /* Discard any previous drive specifier if nm is now in UNC format. */
1147 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1153 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1154 none are found, we can probably return right away. We will avoid
1155 allocating a new string if name is already fully expanded. */
1157 IS_DIRECTORY_SEP (nm
[0])
1159 && drive
&& !is_escaped
1162 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1169 /* If it turns out that the filename we want to return is just a
1170 suffix of FILENAME, we don't need to go through and edit
1171 things; we just need to construct a new string using data
1172 starting at the middle of FILENAME. If we set lose to a
1173 non-zero value, that means we've discovered that we can't do
1180 /* Since we know the name is absolute, we can assume that each
1181 element starts with a "/". */
1183 /* "." and ".." are hairy. */
1184 if (IS_DIRECTORY_SEP (p
[0])
1186 && (IS_DIRECTORY_SEP (p
[2])
1188 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1191 /* We want to replace multiple `/' in a row with a single
1194 && IS_DIRECTORY_SEP (p
[0])
1195 && IS_DIRECTORY_SEP (p
[1]))
1202 /* if dev:[dir]/, move nm to / */
1203 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1204 nm
= (brack
? brack
+ 1 : colon
+ 1);
1205 lbrack
= rbrack
= 0;
1213 /* VMS pre V4.4,convert '-'s in filenames. */
1214 if (lbrack
== rbrack
)
1216 if (dots
< 2) /* this is to allow negative version numbers */
1221 if (lbrack
> rbrack
&&
1222 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1223 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1229 /* count open brackets, reset close bracket pointer */
1230 if (p
[0] == '[' || p
[0] == '<')
1231 lbrack
++, brack
= 0;
1232 /* count close brackets, set close bracket pointer */
1233 if (p
[0] == ']' || p
[0] == '>')
1234 rbrack
++, brack
= p
;
1235 /* detect ][ or >< */
1236 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1238 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1239 nm
= p
+ 1, lose
= 1;
1240 if (p
[0] == ':' && (colon
|| slash
))
1241 /* if dev1:[dir]dev2:, move nm to dev2: */
1247 /* if /name/dev:, move nm to dev: */
1250 /* if node::dev:, move colon following dev */
1251 else if (colon
&& colon
[-1] == ':')
1253 /* if dev1:dev2:, move nm to dev2: */
1254 else if (colon
&& colon
[-1] != ':')
1259 if (p
[0] == ':' && !colon
)
1265 if (lbrack
== rbrack
)
1268 else if (p
[0] == '.')
1276 if (index (nm
, '/'))
1278 nm
= sys_translate_unix (nm
);
1279 return make_specified_string (nm
, -1, strlen (nm
),
1280 STRING_MULTIBYTE (name
));
1284 /* Make sure directories are all separated with / or \ as
1285 desired, but avoid allocation of a new string when not
1287 CORRECT_DIR_SEPS (nm
);
1289 if (IS_DIRECTORY_SEP (nm
[1]))
1291 if (strcmp (nm
, SDATA (name
)) != 0)
1292 name
= make_specified_string (nm
, -1, strlen (nm
),
1293 STRING_MULTIBYTE (name
));
1297 /* drive must be set, so this is okay */
1298 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1302 name
= make_specified_string (nm
, -1, p
- nm
,
1303 STRING_MULTIBYTE (name
));
1304 temp
[0] = DRIVE_LETTER (drive
);
1305 name
= concat2 (build_string (temp
), name
);
1308 #else /* not DOS_NT */
1309 if (nm
== SDATA (name
))
1311 return make_specified_string (nm
, -1, strlen (nm
),
1312 STRING_MULTIBYTE (name
));
1313 #endif /* not DOS_NT */
1317 /* At this point, nm might or might not be an absolute file name. We
1318 need to expand ~ or ~user if present, otherwise prefix nm with
1319 default_directory if nm is not absolute, and finally collapse /./
1320 and /foo/../ sequences.
1322 We set newdir to be the appropriate prefix if one is needed:
1323 - the relevant user directory if nm starts with ~ or ~user
1324 - the specified drive's working dir (DOS/NT only) if nm does not
1326 - the value of default_directory.
1328 Note that these prefixes are not guaranteed to be absolute (except
1329 for the working dir of a drive). Therefore, to ensure we always
1330 return an absolute name, if the final prefix is not absolute we
1331 append it to the current working directory. */
1335 if (nm
[0] == '~') /* prefix ~ */
1337 if (IS_DIRECTORY_SEP (nm
[1])
1341 || nm
[1] == 0) /* ~ by itself */
1343 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1344 newdir
= (unsigned char *) "";
1347 collapse_newdir
= 0;
1350 nm
++; /* Don't leave the slash in nm. */
1353 else /* ~user/filename */
1355 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1360 o
= (unsigned char *) alloca (p
- nm
+ 1);
1361 bcopy ((char *) nm
, o
, p
- nm
);
1364 pw
= (struct passwd
*) getpwnam (o
+ 1);
1367 newdir
= (unsigned char *) pw
-> pw_dir
;
1369 nm
= p
+ 1; /* skip the terminator */
1373 collapse_newdir
= 0;
1378 /* If we don't find a user of that name, leave the name
1379 unchanged; don't move nm forward to p. */
1384 /* On DOS and Windows, nm is absolute if a drive name was specified;
1385 use the drive's current directory as the prefix if needed. */
1386 if (!newdir
&& drive
)
1388 /* Get default directory if needed to make nm absolute. */
1389 if (!IS_DIRECTORY_SEP (nm
[0]))
1391 newdir
= alloca (MAXPATHLEN
+ 1);
1392 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1397 /* Either nm starts with /, or drive isn't mounted. */
1398 newdir
= alloca (4);
1399 newdir
[0] = DRIVE_LETTER (drive
);
1407 /* Finally, if no prefix has been specified and nm is not absolute,
1408 then it must be expanded relative to default_directory. */
1412 /* /... alone is not absolute on DOS and Windows. */
1413 && !IS_DIRECTORY_SEP (nm
[0])
1416 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1423 newdir
= SDATA (default_directory
);
1425 /* Note if special escape prefix is present, but remove for now. */
1426 if (newdir
[0] == '/' && newdir
[1] == ':')
1437 /* First ensure newdir is an absolute name. */
1439 /* Detect MSDOS file names with drive specifiers. */
1440 ! (IS_DRIVE (newdir
[0])
1441 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1443 /* Detect Windows file names in UNC format. */
1444 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1448 /* Effectively, let newdir be (expand-file-name newdir cwd).
1449 Because of the admonition against calling expand-file-name
1450 when we have pointers into lisp strings, we accomplish this
1451 indirectly by prepending newdir to nm if necessary, and using
1452 cwd (or the wd of newdir's drive) as the new newdir. */
1454 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1459 if (!IS_DIRECTORY_SEP (nm
[0]))
1461 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1462 file_name_as_directory (tmp
, newdir
);
1466 newdir
= alloca (MAXPATHLEN
+ 1);
1469 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1476 /* Strip off drive name from prefix, if present. */
1477 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1483 /* Keep only a prefix from newdir if nm starts with slash
1484 (//server/share for UNC, nothing otherwise). */
1485 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1488 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1490 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1492 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1494 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1506 /* Get rid of any slash at the end of newdir, unless newdir is
1507 just / or // (an incomplete UNC name). */
1508 length
= strlen (newdir
);
1509 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1511 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1515 unsigned char *temp
= (unsigned char *) alloca (length
);
1516 bcopy (newdir
, temp
, length
- 1);
1517 temp
[length
- 1] = 0;
1525 /* Now concatenate the directory and name to new space in the stack frame */
1526 tlen
+= strlen (nm
) + 1;
1528 /* Reserve space for drive specifier and escape prefix, since either
1529 or both may need to be inserted. (The Microsoft x86 compiler
1530 produces incorrect code if the following two lines are combined.) */
1531 target
= (unsigned char *) alloca (tlen
+ 4);
1533 #else /* not DOS_NT */
1534 target
= (unsigned char *) alloca (tlen
);
1535 #endif /* not DOS_NT */
1541 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1544 /* If newdir is effectively "C:/", then the drive letter will have
1545 been stripped and newdir will be "/". Concatenating with an
1546 absolute directory in nm produces "//", which will then be
1547 incorrectly treated as a network share. Ignore newdir in
1548 this case (keeping the drive letter). */
1549 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1550 && newdir
[1] == '\0'))
1552 strcpy (target
, newdir
);
1556 file_name_as_directory (target
, newdir
);
1559 strcat (target
, nm
);
1561 if (index (target
, '/'))
1562 strcpy (target
, sys_translate_unix (target
));
1565 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1567 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1576 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1582 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1583 /* brackets are offset from each other by 2 */
1586 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1587 /* convert [foo][bar] to [bar] */
1588 while (o
[-1] != '[' && o
[-1] != '<')
1590 else if (*p
== '-' && *o
!= '.')
1593 else if (p
[0] == '-' && o
[-1] == '.' &&
1594 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1595 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1599 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1600 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1602 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1604 /* else [foo.-] ==> [-] */
1610 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1611 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1617 if (!IS_DIRECTORY_SEP (*p
))
1621 else if (IS_DIRECTORY_SEP (p
[0])
1623 && (IS_DIRECTORY_SEP (p
[2])
1626 /* If "/." is the entire filename, keep the "/". Otherwise,
1627 just delete the whole "/.". */
1628 if (o
== target
&& p
[2] == '\0')
1632 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1633 /* `/../' is the "superroot" on certain file systems. */
1635 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1637 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1639 /* Keep initial / only if this is the whole name. */
1640 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1645 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1647 /* Collapse multiple `/' in a row. */
1649 while (IS_DIRECTORY_SEP (*p
))
1656 #endif /* not VMS */
1660 /* At last, set drive name. */
1662 /* Except for network file name. */
1663 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1664 #endif /* WINDOWSNT */
1666 if (!drive
) abort ();
1668 target
[0] = DRIVE_LETTER (drive
);
1671 /* Reinsert the escape prefix if required. */
1678 CORRECT_DIR_SEPS (target
);
1681 return make_specified_string (target
, -1, o
- target
,
1682 STRING_MULTIBYTE (name
));
1686 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1687 This is the old version of expand-file-name, before it was thoroughly
1688 rewritten for Emacs 10.31. We leave this version here commented-out,
1689 because the code is very complex and likely to have subtle bugs. If
1690 bugs _are_ found, it might be of interest to look at the old code and
1691 see what did it do in the relevant situation.
1693 Don't remove this code: it's true that it will be accessible via CVS,
1694 but a few years from deletion, people will forget it is there. */
1696 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1697 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1698 "Convert FILENAME to absolute, and canonicalize it.\n\
1699 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1700 (does not start with slash); if DEFAULT is nil or missing,\n\
1701 the current buffer's value of default-directory is used.\n\
1702 Filenames containing `.' or `..' as components are simplified;\n\
1703 initial `~/' expands to your home directory.\n\
1704 See also the function `substitute-in-file-name'.")
1706 Lisp_Object name
, defalt
;
1710 register unsigned char *newdir
, *p
, *o
;
1712 unsigned char *target
;
1716 unsigned char * colon
= 0;
1717 unsigned char * close
= 0;
1718 unsigned char * slash
= 0;
1719 unsigned char * brack
= 0;
1720 int lbrack
= 0, rbrack
= 0;
1724 CHECK_STRING (name
);
1727 /* Filenames on VMS are always upper case. */
1728 name
= Fupcase (name
);
1733 /* If nm is absolute, flush ...// and detect /./ and /../.
1734 If no /./ or /../ we can return right away. */
1746 if (p
[0] == '/' && p
[1] == '/'
1748 /* // at start of filename is meaningful on Apollo system. */
1753 if (p
[0] == '/' && p
[1] == '~')
1754 nm
= p
+ 1, lose
= 1;
1755 if (p
[0] == '/' && p
[1] == '.'
1756 && (p
[2] == '/' || p
[2] == 0
1757 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1763 /* if dev:[dir]/, move nm to / */
1764 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1765 nm
= (brack
? brack
+ 1 : colon
+ 1);
1766 lbrack
= rbrack
= 0;
1774 /* VMS pre V4.4,convert '-'s in filenames. */
1775 if (lbrack
== rbrack
)
1777 if (dots
< 2) /* this is to allow negative version numbers */
1782 if (lbrack
> rbrack
&&
1783 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1784 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1790 /* count open brackets, reset close bracket pointer */
1791 if (p
[0] == '[' || p
[0] == '<')
1792 lbrack
++, brack
= 0;
1793 /* count close brackets, set close bracket pointer */
1794 if (p
[0] == ']' || p
[0] == '>')
1795 rbrack
++, brack
= p
;
1796 /* detect ][ or >< */
1797 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1799 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1800 nm
= p
+ 1, lose
= 1;
1801 if (p
[0] == ':' && (colon
|| slash
))
1802 /* if dev1:[dir]dev2:, move nm to dev2: */
1808 /* If /name/dev:, move nm to dev: */
1811 /* If node::dev:, move colon following dev */
1812 else if (colon
&& colon
[-1] == ':')
1814 /* If dev1:dev2:, move nm to dev2: */
1815 else if (colon
&& colon
[-1] != ':')
1820 if (p
[0] == ':' && !colon
)
1826 if (lbrack
== rbrack
)
1829 else if (p
[0] == '.')
1837 if (index (nm
, '/'))
1838 return build_string (sys_translate_unix (nm
));
1840 if (nm
== SDATA (name
))
1842 return build_string (nm
);
1846 /* Now determine directory to start with and put it in NEWDIR */
1850 if (nm
[0] == '~') /* prefix ~ */
1855 || nm
[1] == 0)/* ~/filename */
1857 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1858 newdir
= (unsigned char *) "";
1861 nm
++; /* Don't leave the slash in nm. */
1864 else /* ~user/filename */
1866 /* Get past ~ to user */
1867 unsigned char *user
= nm
+ 1;
1868 /* Find end of name. */
1869 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1870 int len
= ptr
? ptr
- user
: strlen (user
);
1872 unsigned char *ptr1
= index (user
, ':');
1873 if (ptr1
!= 0 && ptr1
- user
< len
)
1876 /* Copy the user name into temp storage. */
1877 o
= (unsigned char *) alloca (len
+ 1);
1878 bcopy ((char *) user
, o
, len
);
1881 /* Look up the user name. */
1882 pw
= (struct passwd
*) getpwnam (o
+ 1);
1884 error ("\"%s\" isn't a registered user", o
+ 1);
1886 newdir
= (unsigned char *) pw
->pw_dir
;
1888 /* Discard the user name from NM. */
1895 #endif /* not VMS */
1899 defalt
= current_buffer
->directory
;
1900 CHECK_STRING (defalt
);
1901 newdir
= SDATA (defalt
);
1904 /* Now concatenate the directory and name to new space in the stack frame */
1906 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1907 target
= (unsigned char *) alloca (tlen
);
1913 if (nm
[0] == 0 || nm
[0] == '/')
1914 strcpy (target
, newdir
);
1917 file_name_as_directory (target
, newdir
);
1920 strcat (target
, nm
);
1922 if (index (target
, '/'))
1923 strcpy (target
, sys_translate_unix (target
));
1926 /* Now canonicalize by removing /. and /foo/.. if they appear */
1934 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1940 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1941 /* brackets are offset from each other by 2 */
1944 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1945 /* convert [foo][bar] to [bar] */
1946 while (o
[-1] != '[' && o
[-1] != '<')
1948 else if (*p
== '-' && *o
!= '.')
1951 else if (p
[0] == '-' && o
[-1] == '.' &&
1952 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1953 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1957 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1958 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1960 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1962 /* else [foo.-] ==> [-] */
1968 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1969 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1979 else if (!strncmp (p
, "//", 2)
1981 /* // at start of filename is meaningful in Apollo system. */
1989 else if (p
[0] == '/' && p
[1] == '.' &&
1990 (p
[2] == '/' || p
[2] == 0))
1992 else if (!strncmp (p
, "/..", 3)
1993 /* `/../' is the "superroot" on certain file systems. */
1995 && (p
[3] == '/' || p
[3] == 0))
1997 while (o
!= target
&& *--o
!= '/')
2000 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2004 if (o
== target
&& *o
== '/')
2012 #endif /* not VMS */
2015 return make_string (target
, o
- target
);
2019 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2020 Ssubstitute_in_file_name
, 1, 1, 0,
2021 doc
: /* Substitute environment variables referred to in FILENAME.
2022 `$FOO' where FOO is an environment variable name means to substitute
2023 the value of that variable. The variable name should be terminated
2024 with a character not a letter, digit or underscore; otherwise, enclose
2025 the entire variable name in braces.
2026 If `/~' appears, all of FILENAME through that `/' is discarded.
2028 On VMS, `$' substitution is not done; this function does little and only
2029 duplicates what `expand-file-name' does. */)
2031 Lisp_Object filename
;
2035 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2036 unsigned char *target
= NULL
;
2038 int substituted
= 0;
2041 Lisp_Object handler
;
2043 CHECK_STRING (filename
);
2045 /* If the file name has special constructs in it,
2046 call the corresponding file handler. */
2047 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2048 if (!NILP (handler
))
2049 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2051 nm
= SDATA (filename
);
2053 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2054 CORRECT_DIR_SEPS (nm
);
2055 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2057 endp
= nm
+ SBYTES (filename
);
2059 /* If /~ or // appears, discard everything through first slash. */
2061 for (p
= nm
; p
!= endp
; p
++)
2064 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2065 /* // at start of file name is meaningful in Apollo,
2066 WindowsNT and Cygwin systems. */
2067 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2068 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2069 || IS_DIRECTORY_SEP (p
[0])
2070 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2075 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2077 || IS_DIRECTORY_SEP (p
[-1])))
2079 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2084 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2086 o
= (unsigned char *) alloca (s
- p
+ 1);
2087 bcopy ((char *) p
, o
, s
- p
);
2090 pw
= (struct passwd
*) getpwnam (o
+ 1);
2092 /* If we have ~/ or ~user and `user' exists, discard
2093 everything up to ~. But if `user' does not exist, leave
2094 ~user alone, it might be a literal file name. */
2095 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2102 /* see comment in expand-file-name about drive specifiers */
2103 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2104 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2113 return make_specified_string (nm
, -1, strlen (nm
),
2114 STRING_MULTIBYTE (filename
));
2117 /* See if any variables are substituted into the string
2118 and find the total length of their values in `total' */
2120 for (p
= nm
; p
!= endp
;)
2130 /* "$$" means a single "$" */
2139 while (p
!= endp
&& *p
!= '}') p
++;
2140 if (*p
!= '}') goto missingclose
;
2146 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2150 /* Copy out the variable name */
2151 target
= (unsigned char *) alloca (s
- o
+ 1);
2152 strncpy (target
, o
, s
- o
);
2155 strupr (target
); /* $home == $HOME etc. */
2158 /* Get variable value */
2159 o
= (unsigned char *) egetenv (target
);
2162 total
+= strlen (o
);
2172 /* If substitution required, recopy the string and do it */
2173 /* Make space in stack frame for the new copy */
2174 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2177 /* Copy the rest of the name through, replacing $ constructs with values */
2194 while (p
!= endp
&& *p
!= '}') p
++;
2195 if (*p
!= '}') goto missingclose
;
2201 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2205 /* Copy out the variable name */
2206 target
= (unsigned char *) alloca (s
- o
+ 1);
2207 strncpy (target
, o
, s
- o
);
2210 strupr (target
); /* $home == $HOME etc. */
2213 /* Get variable value */
2214 o
= (unsigned char *) egetenv (target
);
2218 strcpy (x
, target
); x
+= strlen (target
);
2220 else if (STRING_MULTIBYTE (filename
))
2222 /* If the original string is multibyte,
2223 convert what we substitute into multibyte. */
2226 int c
= unibyte_char_to_multibyte (*o
++);
2227 x
+= CHAR_STRING (c
, x
);
2239 /* If /~ or // appears, discard everything through first slash. */
2241 for (p
= xnm
; p
!= x
; p
++)
2243 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2244 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2245 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2246 || IS_DIRECTORY_SEP (p
[0])
2247 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2249 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2252 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2253 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2257 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2260 error ("Bad format environment-variable substitution");
2262 error ("Missing \"}\" in environment-variable substitution");
2264 error ("Substituting nonexistent environment variable \"%s\"", target
);
2267 #endif /* not VMS */
2271 /* A slightly faster and more convenient way to get
2272 (directory-file-name (expand-file-name FOO)). */
2275 expand_and_dir_to_file (filename
, defdir
)
2276 Lisp_Object filename
, defdir
;
2278 register Lisp_Object absname
;
2280 absname
= Fexpand_file_name (filename
, defdir
);
2283 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2284 if (c
== ':' || c
== ']' || c
== '>')
2285 absname
= Fdirectory_file_name (absname
);
2288 /* Remove final slash, if any (unless this is the root dir).
2289 stat behaves differently depending! */
2290 if (SCHARS (absname
) > 1
2291 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2292 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2293 /* We cannot take shortcuts; they might be wrong for magic file names. */
2294 absname
= Fdirectory_file_name (absname
);
2299 /* Signal an error if the file ABSNAME already exists.
2300 If INTERACTIVE is nonzero, ask the user whether to proceed,
2301 and bypass the error if the user says to go ahead.
2302 QUERYSTRING is a name for the action that is being considered
2305 *STATPTR is used to store the stat information if the file exists.
2306 If the file does not exist, STATPTR->st_mode is set to 0.
2307 If STATPTR is null, we don't store into it.
2309 If QUICK is nonzero, we ask for y or n, not yes or no. */
2312 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2313 Lisp_Object absname
;
2314 unsigned char *querystring
;
2316 struct stat
*statptr
;
2319 register Lisp_Object tem
, encoded_filename
;
2320 struct stat statbuf
;
2321 struct gcpro gcpro1
;
2323 encoded_filename
= ENCODE_FILE (absname
);
2325 /* stat is a good way to tell whether the file exists,
2326 regardless of what access permissions it has. */
2327 if (stat (SDATA (encoded_filename
), &statbuf
) >= 0)
2330 Fsignal (Qfile_already_exists
,
2331 Fcons (build_string ("File already exists"),
2332 Fcons (absname
, Qnil
)));
2334 tem
= format2 ("File %s already exists; %s anyway? ",
2335 absname
, build_string (querystring
));
2337 tem
= Fy_or_n_p (tem
);
2339 tem
= do_yes_or_no_p (tem
);
2342 Fsignal (Qfile_already_exists
,
2343 Fcons (build_string ("File already exists"),
2344 Fcons (absname
, Qnil
)));
2351 statptr
->st_mode
= 0;
2356 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2357 "fCopy file: \nFCopy %s to file: \np\nP",
2358 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2359 If NEWNAME names a directory, copy FILE there.
2360 Signals a `file-already-exists' error if file NEWNAME already exists,
2361 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2362 A number as third arg means request confirmation if NEWNAME already exists.
2363 This is what happens in interactive use with M-x.
2364 Fourth arg KEEP-TIME non-nil means give the new file the same
2365 last-modified time as the old one. (This works on only some systems.)
2366 A prefix arg makes KEEP-TIME non-nil. */)
2367 (file
, newname
, ok_if_already_exists
, keep_time
)
2368 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2371 char buf
[16 * 1024];
2372 struct stat st
, out_st
;
2373 Lisp_Object handler
;
2374 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2375 int count
= SPECPDL_INDEX ();
2376 int input_file_statable_p
;
2377 Lisp_Object encoded_file
, encoded_newname
;
2379 encoded_file
= encoded_newname
= Qnil
;
2380 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2381 CHECK_STRING (file
);
2382 CHECK_STRING (newname
);
2384 if (!NILP (Ffile_directory_p (newname
)))
2385 newname
= Fexpand_file_name (file
, newname
);
2387 newname
= Fexpand_file_name (newname
, Qnil
);
2389 file
= Fexpand_file_name (file
, Qnil
);
2391 /* If the input file name has special constructs in it,
2392 call the corresponding file handler. */
2393 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2394 /* Likewise for output file name. */
2396 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2397 if (!NILP (handler
))
2398 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2399 ok_if_already_exists
, keep_time
));
2401 encoded_file
= ENCODE_FILE (file
);
2402 encoded_newname
= ENCODE_FILE (newname
);
2404 if (NILP (ok_if_already_exists
)
2405 || INTEGERP (ok_if_already_exists
))
2406 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2407 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2408 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2412 if (!CopyFile (SDATA (encoded_file
),
2413 SDATA (encoded_newname
),
2415 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2416 /* CopyFile retains the timestamp by default. */
2417 else if (NILP (keep_time
))
2423 EMACS_GET_TIME (now
);
2424 filename
= SDATA (encoded_newname
);
2426 /* Ensure file is writable while its modified time is set. */
2427 attributes
= GetFileAttributes (filename
);
2428 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2429 if (set_file_times (filename
, now
, now
))
2431 /* Restore original attributes. */
2432 SetFileAttributes (filename
, attributes
);
2433 Fsignal (Qfile_date_error
,
2434 Fcons (build_string ("Cannot set file date"),
2435 Fcons (newname
, Qnil
)));
2437 /* Restore original attributes. */
2438 SetFileAttributes (filename
, attributes
);
2440 #else /* not WINDOWSNT */
2442 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2446 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2448 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2450 /* We can only copy regular files and symbolic links. Other files are not
2452 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2454 #if !defined (DOS_NT) || __DJGPP__ > 1
2455 if (out_st
.st_mode
!= 0
2456 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2459 report_file_error ("Input and output files are the same",
2460 Fcons (file
, Fcons (newname
, Qnil
)));
2464 #if defined (S_ISREG) && defined (S_ISLNK)
2465 if (input_file_statable_p
)
2467 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2469 #if defined (EISDIR)
2470 /* Get a better looking error message. */
2473 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2476 #endif /* S_ISREG && S_ISLNK */
2479 /* Create the copy file with the same record format as the input file */
2480 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2483 /* System's default file type was set to binary by _fmode in emacs.c. */
2484 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2485 #else /* not MSDOS */
2486 ofd
= creat (SDATA (encoded_newname
), 0666);
2487 #endif /* not MSDOS */
2490 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2492 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2496 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2497 if (emacs_write (ofd
, buf
, n
) != n
)
2498 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2501 /* Closing the output clobbers the file times on some systems. */
2502 if (emacs_close (ofd
) < 0)
2503 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2505 if (input_file_statable_p
)
2507 if (!NILP (keep_time
))
2509 EMACS_TIME atime
, mtime
;
2510 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2511 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2512 if (set_file_times (SDATA (encoded_newname
),
2514 Fsignal (Qfile_date_error
,
2515 Fcons (build_string ("Cannot set file date"),
2516 Fcons (newname
, Qnil
)));
2519 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2521 #if defined (__DJGPP__) && __DJGPP__ > 1
2522 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2523 and if it can't, it tells so. Otherwise, under MSDOS we usually
2524 get only the READ bit, which will make the copied file read-only,
2525 so it's better not to chmod at all. */
2526 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2527 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2528 #endif /* DJGPP version 2 or newer */
2533 #endif /* WINDOWSNT */
2535 /* Discard the unwind protects. */
2536 specpdl_ptr
= specpdl
+ count
;
2542 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2543 Smake_directory_internal
, 1, 1, 0,
2544 doc
: /* Create a new directory named DIRECTORY. */)
2546 Lisp_Object directory
;
2548 const unsigned char *dir
;
2549 Lisp_Object handler
;
2550 Lisp_Object encoded_dir
;
2552 CHECK_STRING (directory
);
2553 directory
= Fexpand_file_name (directory
, Qnil
);
2555 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2556 if (!NILP (handler
))
2557 return call2 (handler
, Qmake_directory_internal
, directory
);
2559 encoded_dir
= ENCODE_FILE (directory
);
2561 dir
= SDATA (encoded_dir
);
2564 if (mkdir (dir
) != 0)
2566 if (mkdir (dir
, 0777) != 0)
2568 report_file_error ("Creating directory", Flist (1, &directory
));
2573 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2574 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2576 Lisp_Object directory
;
2578 const unsigned char *dir
;
2579 Lisp_Object handler
;
2580 Lisp_Object encoded_dir
;
2582 CHECK_STRING (directory
);
2583 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2585 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2586 if (!NILP (handler
))
2587 return call2 (handler
, Qdelete_directory
, directory
);
2589 encoded_dir
= ENCODE_FILE (directory
);
2591 dir
= SDATA (encoded_dir
);
2593 if (rmdir (dir
) != 0)
2594 report_file_error ("Removing directory", Flist (1, &directory
));
2599 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2600 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2601 If file has multiple names, it continues to exist with the other names. */)
2603 Lisp_Object filename
;
2605 Lisp_Object handler
;
2606 Lisp_Object encoded_file
;
2607 struct gcpro gcpro1
;
2610 if (!NILP (Ffile_directory_p (filename
)))
2611 Fsignal (Qfile_error
,
2612 Fcons (build_string ("Removing old name: is a directory"),
2613 Fcons (filename
, Qnil
)));
2615 filename
= Fexpand_file_name (filename
, Qnil
);
2617 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2618 if (!NILP (handler
))
2619 return call2 (handler
, Qdelete_file
, filename
);
2621 encoded_file
= ENCODE_FILE (filename
);
2623 if (0 > unlink (SDATA (encoded_file
)))
2624 report_file_error ("Removing old name", Flist (1, &filename
));
2629 internal_delete_file_1 (ignore
)
2635 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2638 internal_delete_file (filename
)
2639 Lisp_Object filename
;
2641 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2642 Qt
, internal_delete_file_1
));
2645 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2646 "fRename file: \nFRename %s to file: \np",
2647 doc
: /* Rename FILE as NEWNAME. Both args strings.
2648 If file has names other than FILE, it continues to have those names.
2649 Signals a `file-already-exists' error if a file NEWNAME already exists
2650 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2651 A number as third arg means request confirmation if NEWNAME already exists.
2652 This is what happens in interactive use with M-x. */)
2653 (file
, newname
, ok_if_already_exists
)
2654 Lisp_Object file
, newname
, ok_if_already_exists
;
2657 Lisp_Object args
[2];
2659 Lisp_Object handler
;
2660 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2661 Lisp_Object encoded_file
, encoded_newname
;
2663 encoded_file
= encoded_newname
= Qnil
;
2664 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2665 CHECK_STRING (file
);
2666 CHECK_STRING (newname
);
2667 file
= Fexpand_file_name (file
, Qnil
);
2668 newname
= Fexpand_file_name (newname
, Qnil
);
2670 /* If the file name has special constructs in it,
2671 call the corresponding file handler. */
2672 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2674 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2675 if (!NILP (handler
))
2676 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2677 file
, newname
, ok_if_already_exists
));
2679 encoded_file
= ENCODE_FILE (file
);
2680 encoded_newname
= ENCODE_FILE (newname
);
2683 /* If the file names are identical but for the case, don't ask for
2684 confirmation: they simply want to change the letter-case of the
2686 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2688 if (NILP (ok_if_already_exists
)
2689 || INTEGERP (ok_if_already_exists
))
2690 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2691 INTEGERP (ok_if_already_exists
), 0, 0);
2693 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2695 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2696 || 0 > unlink (SDATA (encoded_file
)))
2701 Fcopy_file (file
, newname
,
2702 /* We have already prompted if it was an integer,
2703 so don't have copy-file prompt again. */
2704 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2705 Fdelete_file (file
);
2712 report_file_error ("Renaming", Flist (2, args
));
2715 report_file_error ("Renaming", Flist (2, &file
));
2722 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2723 "fAdd name to file: \nFName to add to %s: \np",
2724 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2725 Signals a `file-already-exists' error if a file NEWNAME already exists
2726 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2727 A number as third arg means request confirmation if NEWNAME already exists.
2728 This is what happens in interactive use with M-x. */)
2729 (file
, newname
, ok_if_already_exists
)
2730 Lisp_Object file
, newname
, ok_if_already_exists
;
2733 Lisp_Object args
[2];
2735 Lisp_Object handler
;
2736 Lisp_Object encoded_file
, encoded_newname
;
2737 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2739 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2740 encoded_file
= encoded_newname
= Qnil
;
2741 CHECK_STRING (file
);
2742 CHECK_STRING (newname
);
2743 file
= Fexpand_file_name (file
, Qnil
);
2744 newname
= Fexpand_file_name (newname
, Qnil
);
2746 /* If the file name has special constructs in it,
2747 call the corresponding file handler. */
2748 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2749 if (!NILP (handler
))
2750 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2751 newname
, ok_if_already_exists
));
2753 /* If the new name has special constructs in it,
2754 call the corresponding file handler. */
2755 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2756 if (!NILP (handler
))
2757 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2758 newname
, ok_if_already_exists
));
2760 encoded_file
= ENCODE_FILE (file
);
2761 encoded_newname
= ENCODE_FILE (newname
);
2763 if (NILP (ok_if_already_exists
)
2764 || INTEGERP (ok_if_already_exists
))
2765 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2766 INTEGERP (ok_if_already_exists
), 0, 0);
2768 unlink (SDATA (newname
));
2769 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2774 report_file_error ("Adding new name", Flist (2, args
));
2776 report_file_error ("Adding new name", Flist (2, &file
));
2785 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2786 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2787 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2788 Signals a `file-already-exists' error if a file LINKNAME already exists
2789 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2790 A number as third arg means request confirmation if LINKNAME already exists.
2791 This happens for interactive use with M-x. */)
2792 (filename
, linkname
, ok_if_already_exists
)
2793 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2796 Lisp_Object args
[2];
2798 Lisp_Object handler
;
2799 Lisp_Object encoded_filename
, encoded_linkname
;
2800 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2802 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2803 encoded_filename
= encoded_linkname
= Qnil
;
2804 CHECK_STRING (filename
);
2805 CHECK_STRING (linkname
);
2806 /* If the link target has a ~, we must expand it to get
2807 a truly valid file name. Otherwise, do not expand;
2808 we want to permit links to relative file names. */
2809 if (SREF (filename
, 0) == '~')
2810 filename
= Fexpand_file_name (filename
, Qnil
);
2811 linkname
= Fexpand_file_name (linkname
, Qnil
);
2813 /* If the file name has special constructs in it,
2814 call the corresponding file handler. */
2815 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2816 if (!NILP (handler
))
2817 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2818 linkname
, ok_if_already_exists
));
2820 /* If the new link name has special constructs in it,
2821 call the corresponding file handler. */
2822 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2823 if (!NILP (handler
))
2824 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2825 linkname
, ok_if_already_exists
));
2827 encoded_filename
= ENCODE_FILE (filename
);
2828 encoded_linkname
= ENCODE_FILE (linkname
);
2830 if (NILP (ok_if_already_exists
)
2831 || INTEGERP (ok_if_already_exists
))
2832 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2833 INTEGERP (ok_if_already_exists
), 0, 0);
2834 if (0 > symlink (SDATA (encoded_filename
),
2835 SDATA (encoded_linkname
)))
2837 /* If we didn't complain already, silently delete existing file. */
2838 if (errno
== EEXIST
)
2840 unlink (SDATA (encoded_linkname
));
2841 if (0 <= symlink (SDATA (encoded_filename
),
2842 SDATA (encoded_linkname
)))
2852 report_file_error ("Making symbolic link", Flist (2, args
));
2854 report_file_error ("Making symbolic link", Flist (2, &filename
));
2860 #endif /* S_IFLNK */
2864 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2865 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2866 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2867 If STRING is nil or a null string, the logical name NAME is deleted. */)
2872 CHECK_STRING (name
);
2874 delete_logical_name (SDATA (name
));
2877 CHECK_STRING (string
);
2879 if (SCHARS (string
) == 0)
2880 delete_logical_name (SDATA (name
));
2882 define_logical_name (SDATA (name
), SDATA (string
));
2891 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2892 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2894 Lisp_Object path
, login
;
2898 CHECK_STRING (path
);
2899 CHECK_STRING (login
);
2901 netresult
= netunam (SDATA (path
), SDATA (login
));
2903 if (netresult
== -1)
2908 #endif /* HPUX_NET */
2910 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2912 doc
: /* Return t if file FILENAME specifies an absolute file name.
2913 On Unix, this is a name starting with a `/' or a `~'. */)
2915 Lisp_Object filename
;
2917 const unsigned char *ptr
;
2919 CHECK_STRING (filename
);
2920 ptr
= SDATA (filename
);
2921 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2923 /* ??? This criterion is probably wrong for '<'. */
2924 || index (ptr
, ':') || index (ptr
, '<')
2925 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2929 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2937 /* Return nonzero if file FILENAME exists and can be executed. */
2940 check_executable (filename
)
2944 int len
= strlen (filename
);
2947 if (stat (filename
, &st
) < 0)
2949 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2950 return ((st
.st_mode
& S_IEXEC
) != 0);
2952 return (S_ISREG (st
.st_mode
)
2954 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2955 || stricmp (suffix
, ".exe") == 0
2956 || stricmp (suffix
, ".bat") == 0)
2957 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2958 #endif /* not WINDOWSNT */
2959 #else /* not DOS_NT */
2960 #ifdef HAVE_EUIDACCESS
2961 return (euidaccess (filename
, 1) >= 0);
2963 /* Access isn't quite right because it uses the real uid
2964 and we really want to test with the effective uid.
2965 But Unix doesn't give us a right way to do it. */
2966 return (access (filename
, 1) >= 0);
2968 #endif /* not DOS_NT */
2971 /* Return nonzero if file FILENAME exists and can be written. */
2974 check_writable (filename
)
2979 if (stat (filename
, &st
) < 0)
2981 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2982 #else /* not MSDOS */
2983 #ifdef HAVE_EUIDACCESS
2984 return (euidaccess (filename
, 2) >= 0);
2986 /* Access isn't quite right because it uses the real uid
2987 and we really want to test with the effective uid.
2988 But Unix doesn't give us a right way to do it.
2989 Opening with O_WRONLY could work for an ordinary file,
2990 but would lose for directories. */
2991 return (access (filename
, 2) >= 0);
2993 #endif /* not MSDOS */
2996 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2997 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
2998 See also `file-readable-p' and `file-attributes'. */)
3000 Lisp_Object filename
;
3002 Lisp_Object absname
;
3003 Lisp_Object handler
;
3004 struct stat statbuf
;
3006 CHECK_STRING (filename
);
3007 absname
= Fexpand_file_name (filename
, Qnil
);
3009 /* If the file name has special constructs in it,
3010 call the corresponding file handler. */
3011 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3012 if (!NILP (handler
))
3013 return call2 (handler
, Qfile_exists_p
, absname
);
3015 absname
= ENCODE_FILE (absname
);
3017 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3020 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3021 doc
: /* Return t if FILENAME can be executed by you.
3022 For a directory, this means you can access files in that directory. */)
3024 Lisp_Object filename
;
3026 Lisp_Object absname
;
3027 Lisp_Object handler
;
3029 CHECK_STRING (filename
);
3030 absname
= Fexpand_file_name (filename
, Qnil
);
3032 /* If the file name has special constructs in it,
3033 call the corresponding file handler. */
3034 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3035 if (!NILP (handler
))
3036 return call2 (handler
, Qfile_executable_p
, absname
);
3038 absname
= ENCODE_FILE (absname
);
3040 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3043 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3044 doc
: /* Return t if file FILENAME exists and you can read it.
3045 See also `file-exists-p' and `file-attributes'. */)
3047 Lisp_Object filename
;
3049 Lisp_Object absname
;
3050 Lisp_Object handler
;
3053 struct stat statbuf
;
3055 CHECK_STRING (filename
);
3056 absname
= Fexpand_file_name (filename
, Qnil
);
3058 /* If the file name has special constructs in it,
3059 call the corresponding file handler. */
3060 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3061 if (!NILP (handler
))
3062 return call2 (handler
, Qfile_readable_p
, absname
);
3064 absname
= ENCODE_FILE (absname
);
3066 #if defined(DOS_NT) || defined(macintosh)
3067 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3069 if (access (SDATA (absname
), 0) == 0)
3072 #else /* not DOS_NT and not macintosh */
3074 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3075 /* Opening a fifo without O_NONBLOCK can wait.
3076 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3077 except in the case of a fifo, on a system which handles it. */
3078 desc
= stat (SDATA (absname
), &statbuf
);
3081 if (S_ISFIFO (statbuf
.st_mode
))
3082 flags
|= O_NONBLOCK
;
3084 desc
= emacs_open (SDATA (absname
), flags
, 0);
3089 #endif /* not DOS_NT and not macintosh */
3092 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3094 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3095 doc
: /* Return t if file FILENAME can be written or created by you. */)
3097 Lisp_Object filename
;
3099 Lisp_Object absname
, dir
, encoded
;
3100 Lisp_Object handler
;
3101 struct stat statbuf
;
3103 CHECK_STRING (filename
);
3104 absname
= Fexpand_file_name (filename
, Qnil
);
3106 /* If the file name has special constructs in it,
3107 call the corresponding file handler. */
3108 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3109 if (!NILP (handler
))
3110 return call2 (handler
, Qfile_writable_p
, absname
);
3112 encoded
= ENCODE_FILE (absname
);
3113 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3114 return (check_writable (SDATA (encoded
))
3117 dir
= Ffile_name_directory (absname
);
3120 dir
= Fdirectory_file_name (dir
);
3124 dir
= Fdirectory_file_name (dir
);
3127 dir
= ENCODE_FILE (dir
);
3129 /* The read-only attribute of the parent directory doesn't affect
3130 whether a file or directory can be created within it. Some day we
3131 should check ACLs though, which do affect this. */
3132 if (stat (SDATA (dir
), &statbuf
) < 0)
3134 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3136 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3141 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3142 doc
: /* Access file FILENAME, and get an error if that does not work.
3143 The second argument STRING is used in the error message.
3144 If there is no error, we return nil. */)
3146 Lisp_Object filename
, string
;
3148 Lisp_Object handler
, encoded_filename
, absname
;
3151 CHECK_STRING (filename
);
3152 absname
= Fexpand_file_name (filename
, Qnil
);
3154 CHECK_STRING (string
);
3156 /* If the file name has special constructs in it,
3157 call the corresponding file handler. */
3158 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3159 if (!NILP (handler
))
3160 return call3 (handler
, Qaccess_file
, absname
, string
);
3162 encoded_filename
= ENCODE_FILE (absname
);
3164 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3166 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3172 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3173 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3174 The value is the name of the file to which it is linked.
3175 Otherwise returns nil. */)
3177 Lisp_Object filename
;
3184 Lisp_Object handler
;
3186 CHECK_STRING (filename
);
3187 filename
= Fexpand_file_name (filename
, Qnil
);
3189 /* If the file name has special constructs in it,
3190 call the corresponding file handler. */
3191 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3192 if (!NILP (handler
))
3193 return call2 (handler
, Qfile_symlink_p
, filename
);
3195 filename
= ENCODE_FILE (filename
);
3202 buf
= (char *) xrealloc (buf
, bufsize
);
3203 bzero (buf
, bufsize
);
3206 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3210 /* HP-UX reports ERANGE if buffer is too small. */
3211 if (errno
== ERANGE
)
3221 while (valsize
>= bufsize
);
3223 val
= make_string (buf
, valsize
);
3224 if (buf
[0] == '/' && index (buf
, ':'))
3225 val
= concat2 (build_string ("/:"), val
);
3227 val
= DECODE_FILE (val
);
3229 #else /* not S_IFLNK */
3231 #endif /* not S_IFLNK */
3234 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3235 doc
: /* Return t if FILENAME names an existing directory.
3236 Symbolic links to directories count as directories.
3237 See `file-symlink-p' to distinguish symlinks. */)
3239 Lisp_Object filename
;
3241 register Lisp_Object absname
;
3243 Lisp_Object handler
;
3245 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3247 /* If the file name has special constructs in it,
3248 call the corresponding file handler. */
3249 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3250 if (!NILP (handler
))
3251 return call2 (handler
, Qfile_directory_p
, absname
);
3253 absname
= ENCODE_FILE (absname
);
3255 if (stat (SDATA (absname
), &st
) < 0)
3257 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3260 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3261 doc
: /* Return t if file FILENAME names a directory you can open.
3262 For the value to be t, FILENAME must specify the name of a directory as a file,
3263 and the directory must allow you to open files in it. In order to use a
3264 directory as a buffer's current directory, this predicate must return true.
3265 A directory name spec may be given instead; then the value is t
3266 if the directory so specified exists and really is a readable and
3267 searchable directory. */)
3269 Lisp_Object filename
;
3271 Lisp_Object handler
;
3273 struct gcpro gcpro1
;
3275 /* If the file name has special constructs in it,
3276 call the corresponding file handler. */
3277 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3278 if (!NILP (handler
))
3279 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3282 tem
= (NILP (Ffile_directory_p (filename
))
3283 || NILP (Ffile_executable_p (filename
)));
3285 return tem
? Qnil
: Qt
;
3288 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3289 doc
: /* Return t if file FILENAME is the name of a regular file.
3290 This is the sort of file that holds an ordinary stream of data bytes. */)
3292 Lisp_Object filename
;
3294 register Lisp_Object absname
;
3296 Lisp_Object handler
;
3298 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3300 /* If the file name has special constructs in it,
3301 call the corresponding file handler. */
3302 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3303 if (!NILP (handler
))
3304 return call2 (handler
, Qfile_regular_p
, absname
);
3306 absname
= ENCODE_FILE (absname
);
3311 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3313 /* Tell stat to use expensive method to get accurate info. */
3314 Vw32_get_true_file_attributes
= Qt
;
3315 result
= stat (SDATA (absname
), &st
);
3316 Vw32_get_true_file_attributes
= tem
;
3320 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3323 if (stat (SDATA (absname
), &st
) < 0)
3325 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3329 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3330 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
3332 Lisp_Object filename
;
3334 Lisp_Object absname
;
3336 Lisp_Object handler
;
3338 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3340 /* If the file name has special constructs in it,
3341 call the corresponding file handler. */
3342 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3343 if (!NILP (handler
))
3344 return call2 (handler
, Qfile_modes
, absname
);
3346 absname
= ENCODE_FILE (absname
);
3348 if (stat (SDATA (absname
), &st
) < 0)
3350 #if defined (MSDOS) && __DJGPP__ < 2
3351 if (check_executable (SDATA (absname
)))
3352 st
.st_mode
|= S_IEXEC
;
3353 #endif /* MSDOS && __DJGPP__ < 2 */
3355 return make_number (st
.st_mode
& 07777);
3358 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3359 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3360 Only the 12 low bits of MODE are used. */)
3362 Lisp_Object filename
, mode
;
3364 Lisp_Object absname
, encoded_absname
;
3365 Lisp_Object handler
;
3367 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3368 CHECK_NUMBER (mode
);
3370 /* If the file name has special constructs in it,
3371 call the corresponding file handler. */
3372 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3373 if (!NILP (handler
))
3374 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3376 encoded_absname
= ENCODE_FILE (absname
);
3378 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3379 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3384 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3385 doc
: /* Set the file permission bits for newly created files.
3386 The argument MODE should be an integer; only the low 9 bits are used.
3387 This setting is inherited by subprocesses. */)
3391 CHECK_NUMBER (mode
);
3393 umask ((~ XINT (mode
)) & 0777);
3398 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3399 doc
: /* Return the default file protection for created files.
3400 The value is an integer. */)
3406 realmask
= umask (0);
3409 XSETINT (value
, (~ realmask
) & 0777);
3419 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3420 doc
: /* Tell Unix to finish all pending disk updates. */)
3429 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3430 doc
: /* Return t if file FILE1 is newer than file FILE2.
3431 If FILE1 does not exist, the answer is nil;
3432 otherwise, if FILE2 does not exist, the answer is t. */)
3434 Lisp_Object file1
, file2
;
3436 Lisp_Object absname1
, absname2
;
3439 Lisp_Object handler
;
3440 struct gcpro gcpro1
, gcpro2
;
3442 CHECK_STRING (file1
);
3443 CHECK_STRING (file2
);
3446 GCPRO2 (absname1
, file2
);
3447 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3448 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3451 /* If the file name has special constructs in it,
3452 call the corresponding file handler. */
3453 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3455 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3456 if (!NILP (handler
))
3457 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3459 GCPRO2 (absname1
, absname2
);
3460 absname1
= ENCODE_FILE (absname1
);
3461 absname2
= ENCODE_FILE (absname2
);
3464 if (stat (SDATA (absname1
), &st
) < 0)
3467 mtime1
= st
.st_mtime
;
3469 if (stat (SDATA (absname2
), &st
) < 0)
3472 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3476 Lisp_Object Qfind_buffer_file_type
;
3479 #ifndef READ_BUF_SIZE
3480 #define READ_BUF_SIZE (64 << 10)
3483 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3485 /* This function is called after Lisp functions to decide a coding
3486 system are called, or when they cause an error. Before they are
3487 called, the current buffer is set unibyte and it contains only a
3488 newly inserted text (thus the buffer was empty before the
3491 The functions may set markers, overlays, text properties, or even
3492 alter the buffer contents, change the current buffer.
3494 Here, we reset all those changes by:
3495 o set back the current buffer.
3496 o move all markers and overlays to BEG.
3497 o remove all text properties.
3498 o set back the buffer multibyteness. */
3501 decide_coding_unwind (unwind_data
)
3502 Lisp_Object unwind_data
;
3504 Lisp_Object multibyte
, undo_list
, buffer
;
3506 multibyte
= XCAR (unwind_data
);
3507 unwind_data
= XCDR (unwind_data
);
3508 undo_list
= XCAR (unwind_data
);
3509 buffer
= XCDR (unwind_data
);
3511 if (current_buffer
!= XBUFFER (buffer
))
3512 set_buffer_internal (XBUFFER (buffer
));
3513 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3514 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3515 BUF_INTERVALS (current_buffer
) = 0;
3516 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3518 /* Now we are safe to change the buffer's multibyteness directly. */
3519 current_buffer
->enable_multibyte_characters
= multibyte
;
3520 current_buffer
->undo_list
= undo_list
;
3526 /* Used to pass values from insert-file-contents to read_non_regular. */
3528 static int non_regular_fd
;
3529 static int non_regular_inserted
;
3530 static int non_regular_nbytes
;
3533 /* Read from a non-regular file.
3534 Read non_regular_trytry bytes max from non_regular_fd.
3535 Non_regular_inserted specifies where to put the read bytes.
3536 Value is the number of bytes read. */
3545 nbytes
= emacs_read (non_regular_fd
,
3546 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3547 non_regular_nbytes
);
3549 return make_number (nbytes
);
3553 /* Condition-case handler used when reading from non-regular files
3554 in insert-file-contents. */
3557 read_non_regular_quit ()
3563 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3565 doc
: /* Insert contents of file FILENAME after point.
3566 Returns list of absolute file name and number of bytes inserted.
3567 If second argument VISIT is non-nil, the buffer's visited filename
3568 and last save file modtime are set, and it is marked unmodified.
3569 If visiting and the file does not exist, visiting is completed
3570 before the error is signaled.
3571 The optional third and fourth arguments BEG and END
3572 specify what portion of the file to insert.
3573 These arguments count bytes in the file, not characters in the buffer.
3574 If VISIT is non-nil, BEG and END must be nil.
3576 If optional fifth argument REPLACE is non-nil,
3577 it means replace the current buffer contents (in the accessible portion)
3578 with the file contents. This is better than simply deleting and inserting
3579 the whole thing because (1) it preserves some marker positions
3580 and (2) it puts less data in the undo list.
3581 When REPLACE is non-nil, the value is the number of characters actually read,
3582 which is often less than the number of characters to be read.
3584 This does code conversion according to the value of
3585 `coding-system-for-read' or `file-coding-system-alist',
3586 and sets the variable `last-coding-system-used' to the coding system
3588 (filename
, visit
, beg
, end
, replace
)
3589 Lisp_Object filename
, visit
, beg
, end
, replace
;
3594 register int how_much
;
3595 register int unprocessed
;
3596 int count
= SPECPDL_INDEX ();
3597 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3598 Lisp_Object handler
, val
, insval
, orig_filename
;
3601 int not_regular
= 0;
3602 unsigned char read_buf
[READ_BUF_SIZE
];
3603 struct coding_system coding
;
3604 unsigned char buffer
[1 << 14];
3605 int replace_handled
= 0;
3606 int set_coding_system
= 0;
3607 int coding_system_decided
= 0;
3610 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3611 error ("Cannot do file visiting in an indirect buffer");
3613 if (!NILP (current_buffer
->read_only
))
3614 Fbarf_if_buffer_read_only ();
3618 orig_filename
= Qnil
;
3620 GCPRO4 (filename
, val
, p
, orig_filename
);
3622 CHECK_STRING (filename
);
3623 filename
= Fexpand_file_name (filename
, Qnil
);
3625 /* If the file name has special constructs in it,
3626 call the corresponding file handler. */
3627 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3628 if (!NILP (handler
))
3630 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3631 visit
, beg
, end
, replace
);
3632 if (CONSP (val
) && CONSP (XCDR (val
)))
3633 inserted
= XINT (XCAR (XCDR (val
)));
3637 orig_filename
= filename
;
3638 filename
= ENCODE_FILE (filename
);
3644 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3646 /* Tell stat to use expensive method to get accurate info. */
3647 Vw32_get_true_file_attributes
= Qt
;
3648 total
= stat (SDATA (filename
), &st
);
3649 Vw32_get_true_file_attributes
= tem
;
3654 if (stat (SDATA (filename
), &st
) < 0)
3656 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3657 || fstat (fd
, &st
) < 0)
3658 #endif /* not APOLLO */
3659 #endif /* WINDOWSNT */
3661 if (fd
>= 0) emacs_close (fd
);
3664 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3667 if (!NILP (Vcoding_system_for_read
))
3668 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3673 /* This code will need to be changed in order to work on named
3674 pipes, and it's probably just not worth it. So we should at
3675 least signal an error. */
3676 if (!S_ISREG (st
.st_mode
))
3683 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3684 Fsignal (Qfile_error
,
3685 Fcons (build_string ("not a regular file"),
3686 Fcons (orig_filename
, Qnil
)));
3691 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3694 /* Replacement should preserve point as it preserves markers. */
3695 if (!NILP (replace
))
3696 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3698 record_unwind_protect (close_file_unwind
, make_number (fd
));
3700 /* Supposedly happens on VMS. */
3701 /* Can happen on any platform that uses long as type of off_t, but allows
3702 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3703 give a message suitable for the latter case. */
3704 if (! not_regular
&& st
.st_size
< 0)
3705 error ("Maximum buffer size exceeded");
3707 /* Prevent redisplay optimizations. */
3708 current_buffer
->clip_changed
= 1;
3712 if (!NILP (beg
) || !NILP (end
))
3713 error ("Attempt to visit less than an entire file");
3714 if (BEG
< Z
&& NILP (replace
))
3715 error ("Cannot do file visiting in a non-empty buffer");
3721 XSETFASTINT (beg
, 0);
3729 XSETINT (end
, st
.st_size
);
3731 /* Arithmetic overflow can occur if an Emacs integer cannot
3732 represent the file size, or if the calculations below
3733 overflow. The calculations below double the file size
3734 twice, so check that it can be multiplied by 4 safely. */
3735 if (XINT (end
) != st
.st_size
3736 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3737 error ("Maximum buffer size exceeded");
3739 /* The file size returned from stat may be zero, but data
3740 may be readable nonetheless, for example when this is a
3741 file in the /proc filesystem. */
3742 if (st
.st_size
== 0)
3743 XSETINT (end
, READ_BUF_SIZE
);
3749 /* Decide the coding system to use for reading the file now
3750 because we can't use an optimized method for handling
3751 `coding:' tag if the current buffer is not empty. */
3755 if (!NILP (Vcoding_system_for_read
))
3756 val
= Vcoding_system_for_read
;
3757 else if (! NILP (replace
))
3758 /* In REPLACE mode, we can use the same coding system
3759 that was used to visit the file. */
3760 val
= current_buffer
->buffer_file_coding_system
;
3763 /* Don't try looking inside a file for a coding system
3764 specification if it is not seekable. */
3765 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3767 /* Find a coding system specified in the heading two
3768 lines or in the tailing several lines of the file.
3769 We assume that the 1K-byte and 3K-byte for heading
3770 and tailing respectively are sufficient for this
3774 if (st
.st_size
<= (1024 * 4))
3775 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3778 nread
= emacs_read (fd
, read_buf
, 1024);
3781 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3782 report_file_error ("Setting file position",
3783 Fcons (orig_filename
, Qnil
));
3784 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3789 error ("IO error reading %s: %s",
3790 SDATA (orig_filename
), emacs_strerror (errno
));
3793 struct buffer
*prev
= current_buffer
;
3797 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3799 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3800 buf
= XBUFFER (buffer
);
3802 buf
->directory
= current_buffer
->directory
;
3803 buf
->read_only
= Qnil
;
3804 buf
->filename
= Qnil
;
3805 buf
->undo_list
= Qt
;
3806 buf
->overlays_before
= Qnil
;
3807 buf
->overlays_after
= Qnil
;
3809 set_buffer_internal (buf
);
3811 buf
->enable_multibyte_characters
= Qnil
;
3813 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3814 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3815 val
= call2 (Vset_auto_coding_function
,
3816 filename
, make_number (nread
));
3817 set_buffer_internal (prev
);
3819 /* Discard the unwind protect for recovering the
3823 /* Rewind the file for the actual read done later. */
3824 if (lseek (fd
, 0, 0) < 0)
3825 report_file_error ("Setting file position",
3826 Fcons (orig_filename
, Qnil
));
3832 /* If we have not yet decided a coding system, check
3833 file-coding-system-alist. */
3834 Lisp_Object args
[6], coding_systems
;
3836 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3837 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3838 coding_systems
= Ffind_operation_coding_system (6, args
);
3839 if (CONSP (coding_systems
))
3840 val
= XCAR (coding_systems
);
3844 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3845 /* Ensure we set Vlast_coding_system_used. */
3846 set_coding_system
= 1;
3848 if (NILP (current_buffer
->enable_multibyte_characters
)
3850 /* We must suppress all character code conversion except for
3851 end-of-line conversion. */
3852 setup_raw_text_coding_system (&coding
);
3854 coding
.src_multibyte
= 0;
3855 coding
.dst_multibyte
3856 = !NILP (current_buffer
->enable_multibyte_characters
);
3857 coding_system_decided
= 1;
3860 /* If requested, replace the accessible part of the buffer
3861 with the file contents. Avoid replacing text at the
3862 beginning or end of the buffer that matches the file contents;
3863 that preserves markers pointing to the unchanged parts.
3865 Here we implement this feature in an optimized way
3866 for the case where code conversion is NOT needed.
3867 The following if-statement handles the case of conversion
3868 in a less optimal way.
3870 If the code conversion is "automatic" then we try using this
3871 method and hope for the best.
3872 But if we discover the need for conversion, we give up on this method
3873 and let the following if-statement handle the replace job. */
3876 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3878 /* same_at_start and same_at_end count bytes,
3879 because file access counts bytes
3880 and BEG and END count bytes. */
3881 int same_at_start
= BEGV_BYTE
;
3882 int same_at_end
= ZV_BYTE
;
3884 /* There is still a possibility we will find the need to do code
3885 conversion. If that happens, we set this variable to 1 to
3886 give up on handling REPLACE in the optimized way. */
3887 int giveup_match_end
= 0;
3889 if (XINT (beg
) != 0)
3891 if (lseek (fd
, XINT (beg
), 0) < 0)
3892 report_file_error ("Setting file position",
3893 Fcons (orig_filename
, Qnil
));
3898 /* Count how many chars at the start of the file
3899 match the text at the beginning of the buffer. */
3904 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3906 error ("IO error reading %s: %s",
3907 SDATA (orig_filename
), emacs_strerror (errno
));
3908 else if (nread
== 0)
3911 if (coding
.type
== coding_type_undecided
)
3912 detect_coding (&coding
, buffer
, nread
);
3913 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
3914 /* We found that the file should be decoded somehow.
3915 Let's give up here. */
3917 giveup_match_end
= 1;
3921 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3922 detect_eol (&coding
, buffer
, nread
);
3923 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3924 && coding
.eol_type
!= CODING_EOL_LF
)
3925 /* We found that the format of eol should be decoded.
3926 Let's give up here. */
3928 giveup_match_end
= 1;
3933 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3934 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3935 same_at_start
++, bufpos
++;
3936 /* If we found a discrepancy, stop the scan.
3937 Otherwise loop around and scan the next bufferful. */
3938 if (bufpos
!= nread
)
3942 /* If the file matches the buffer completely,
3943 there's no need to replace anything. */
3944 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3948 /* Truncate the buffer to the size of the file. */
3949 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3954 /* Count how many chars at the end of the file
3955 match the text at the end of the buffer. But, if we have
3956 already found that decoding is necessary, don't waste time. */
3957 while (!giveup_match_end
)
3959 int total_read
, nread
, bufpos
, curpos
, trial
;
3961 /* At what file position are we now scanning? */
3962 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3963 /* If the entire file matches the buffer tail, stop the scan. */
3966 /* How much can we scan in the next step? */
3967 trial
= min (curpos
, sizeof buffer
);
3968 if (lseek (fd
, curpos
- trial
, 0) < 0)
3969 report_file_error ("Setting file position",
3970 Fcons (orig_filename
, Qnil
));
3972 total_read
= nread
= 0;
3973 while (total_read
< trial
)
3975 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3977 error ("IO error reading %s: %s",
3978 SDATA (orig_filename
), emacs_strerror (errno
));
3979 else if (nread
== 0)
3981 total_read
+= nread
;
3984 /* Scan this bufferful from the end, comparing with
3985 the Emacs buffer. */
3986 bufpos
= total_read
;
3988 /* Compare with same_at_start to avoid counting some buffer text
3989 as matching both at the file's beginning and at the end. */
3990 while (bufpos
> 0 && same_at_end
> same_at_start
3991 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3992 same_at_end
--, bufpos
--;
3994 /* If we found a discrepancy, stop the scan.
3995 Otherwise loop around and scan the preceding bufferful. */
3998 /* If this discrepancy is because of code conversion,
3999 we cannot use this method; giveup and try the other. */
4000 if (same_at_end
> same_at_start
4001 && FETCH_BYTE (same_at_end
- 1) >= 0200
4002 && ! NILP (current_buffer
->enable_multibyte_characters
)
4003 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4004 giveup_match_end
= 1;
4013 if (! giveup_match_end
)
4017 /* We win! We can handle REPLACE the optimized way. */
4019 /* Extend the start of non-matching text area to multibyte
4020 character boundary. */
4021 if (! NILP (current_buffer
->enable_multibyte_characters
))
4022 while (same_at_start
> BEGV_BYTE
4023 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4026 /* Extend the end of non-matching text area to multibyte
4027 character boundary. */
4028 if (! NILP (current_buffer
->enable_multibyte_characters
))
4029 while (same_at_end
< ZV_BYTE
4030 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4033 /* Don't try to reuse the same piece of text twice. */
4034 overlap
= (same_at_start
- BEGV_BYTE
4035 - (same_at_end
+ st
.st_size
- ZV
));
4037 same_at_end
+= overlap
;
4039 /* Arrange to read only the nonmatching middle part of the file. */
4040 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4041 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4043 del_range_byte (same_at_start
, same_at_end
, 0);
4044 /* Insert from the file at the proper position. */
4045 temp
= BYTE_TO_CHAR (same_at_start
);
4046 SET_PT_BOTH (temp
, same_at_start
);
4048 /* If display currently starts at beginning of line,
4049 keep it that way. */
4050 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4051 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4053 replace_handled
= 1;
4057 /* If requested, replace the accessible part of the buffer
4058 with the file contents. Avoid replacing text at the
4059 beginning or end of the buffer that matches the file contents;
4060 that preserves markers pointing to the unchanged parts.
4062 Here we implement this feature for the case where code conversion
4063 is needed, in a simple way that needs a lot of memory.
4064 The preceding if-statement handles the case of no conversion
4065 in a more optimized way. */
4066 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4068 int same_at_start
= BEGV_BYTE
;
4069 int same_at_end
= ZV_BYTE
;
4072 /* Make sure that the gap is large enough. */
4073 int bufsize
= 2 * st
.st_size
;
4074 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4077 /* First read the whole file, performing code conversion into
4078 CONVERSION_BUFFER. */
4080 if (lseek (fd
, XINT (beg
), 0) < 0)
4082 xfree (conversion_buffer
);
4083 report_file_error ("Setting file position",
4084 Fcons (orig_filename
, Qnil
));
4087 total
= st
.st_size
; /* Total bytes in the file. */
4088 how_much
= 0; /* Bytes read from file so far. */
4089 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4090 unprocessed
= 0; /* Bytes not processed in previous loop. */
4092 while (how_much
< total
)
4094 /* try is reserved in some compilers (Microsoft C) */
4095 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4096 unsigned char *destination
= read_buf
+ unprocessed
;
4099 /* Allow quitting out of the actual I/O. */
4102 this = emacs_read (fd
, destination
, trytry
);
4105 if (this < 0 || this + unprocessed
== 0)
4113 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4115 int require
, result
;
4117 this += unprocessed
;
4119 /* If we are using more space than estimated,
4120 make CONVERSION_BUFFER bigger. */
4121 require
= decoding_buffer_size (&coding
, this);
4122 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4124 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4125 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4128 /* Convert this batch with results in CONVERSION_BUFFER. */
4129 if (how_much
>= total
) /* This is the last block. */
4130 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4131 if (coding
.composing
!= COMPOSITION_DISABLED
)
4132 coding_allocate_composition_data (&coding
, BEGV
);
4133 result
= decode_coding (&coding
, read_buf
,
4134 conversion_buffer
+ inserted
,
4135 this, bufsize
- inserted
);
4137 /* Save for next iteration whatever we didn't convert. */
4138 unprocessed
= this - coding
.consumed
;
4139 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4140 if (!NILP (current_buffer
->enable_multibyte_characters
))
4141 this = coding
.produced
;
4143 this = str_as_unibyte (conversion_buffer
+ inserted
,
4150 /* At this point, INSERTED is how many characters (i.e. bytes)
4151 are present in CONVERSION_BUFFER.
4152 HOW_MUCH should equal TOTAL,
4153 or should be <= 0 if we couldn't read the file. */
4157 xfree (conversion_buffer
);
4160 error ("IO error reading %s: %s",
4161 SDATA (orig_filename
), emacs_strerror (errno
));
4162 else if (how_much
== -2)
4163 error ("maximum buffer size exceeded");
4166 /* Compare the beginning of the converted file
4167 with the buffer text. */
4170 while (bufpos
< inserted
&& same_at_start
< same_at_end
4171 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4172 same_at_start
++, bufpos
++;
4174 /* If the file matches the buffer completely,
4175 there's no need to replace anything. */
4177 if (bufpos
== inserted
)
4179 xfree (conversion_buffer
);
4182 /* Truncate the buffer to the size of the file. */
4183 del_range_byte (same_at_start
, same_at_end
, 0);
4188 /* Extend the start of non-matching text area to multibyte
4189 character boundary. */
4190 if (! NILP (current_buffer
->enable_multibyte_characters
))
4191 while (same_at_start
> BEGV_BYTE
4192 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4195 /* Scan this bufferful from the end, comparing with
4196 the Emacs buffer. */
4199 /* Compare with same_at_start to avoid counting some buffer text
4200 as matching both at the file's beginning and at the end. */
4201 while (bufpos
> 0 && same_at_end
> same_at_start
4202 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4203 same_at_end
--, bufpos
--;
4205 /* Extend the end of non-matching text area to multibyte
4206 character boundary. */
4207 if (! NILP (current_buffer
->enable_multibyte_characters
))
4208 while (same_at_end
< ZV_BYTE
4209 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4212 /* Don't try to reuse the same piece of text twice. */
4213 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4215 same_at_end
+= overlap
;
4217 /* If display currently starts at beginning of line,
4218 keep it that way. */
4219 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4220 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4222 /* Replace the chars that we need to replace,
4223 and update INSERTED to equal the number of bytes
4224 we are taking from the file. */
4225 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4227 if (same_at_end
!= same_at_start
)
4229 del_range_byte (same_at_start
, same_at_end
, 0);
4231 same_at_start
= GPT_BYTE
;
4235 temp
= BYTE_TO_CHAR (same_at_start
);
4237 /* Insert from the file at the proper position. */
4238 SET_PT_BOTH (temp
, same_at_start
);
4239 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
4241 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4242 coding_restore_composition (&coding
, Fcurrent_buffer ());
4243 coding_free_composition_data (&coding
);
4245 /* Set `inserted' to the number of inserted characters. */
4246 inserted
= PT
- temp
;
4248 xfree (conversion_buffer
);
4257 register Lisp_Object temp
;
4259 total
= XINT (end
) - XINT (beg
);
4261 /* Make sure point-max won't overflow after this insertion. */
4262 XSETINT (temp
, total
);
4263 if (total
!= XINT (temp
))
4264 error ("Maximum buffer size exceeded");
4267 /* For a special file, all we can do is guess. */
4268 total
= READ_BUF_SIZE
;
4270 if (NILP (visit
) && total
> 0)
4271 prepare_to_modify_buffer (PT
, PT
, NULL
);
4274 if (GAP_SIZE
< total
)
4275 make_gap (total
- GAP_SIZE
);
4277 if (XINT (beg
) != 0 || !NILP (replace
))
4279 if (lseek (fd
, XINT (beg
), 0) < 0)
4280 report_file_error ("Setting file position",
4281 Fcons (orig_filename
, Qnil
));
4284 /* In the following loop, HOW_MUCH contains the total bytes read so
4285 far for a regular file, and not changed for a special file. But,
4286 before exiting the loop, it is set to a negative value if I/O
4290 /* Total bytes inserted. */
4293 /* Here, we don't do code conversion in the loop. It is done by
4294 code_convert_region after all data are read into the buffer. */
4296 int gap_size
= GAP_SIZE
;
4298 while (how_much
< total
)
4300 /* try is reserved in some compilers (Microsoft C) */
4301 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4308 /* Maybe make more room. */
4309 if (gap_size
< trytry
)
4311 make_gap (total
- gap_size
);
4312 gap_size
= GAP_SIZE
;
4315 /* Read from the file, capturing `quit'. When an
4316 error occurs, end the loop, and arrange for a quit
4317 to be signaled after decoding the text we read. */
4318 non_regular_fd
= fd
;
4319 non_regular_inserted
= inserted
;
4320 non_regular_nbytes
= trytry
;
4321 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4322 read_non_regular_quit
);
4333 /* Allow quitting out of the actual I/O. We don't make text
4334 part of the buffer until all the reading is done, so a C-g
4335 here doesn't do any harm. */
4338 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4350 /* For a regular file, where TOTAL is the real size,
4351 count HOW_MUCH to compare with it.
4352 For a special file, where TOTAL is just a buffer size,
4353 so don't bother counting in HOW_MUCH.
4354 (INSERTED is where we count the number of characters inserted.) */
4361 /* Make the text read part of the buffer. */
4362 GAP_SIZE
-= inserted
;
4364 GPT_BYTE
+= inserted
;
4366 ZV_BYTE
+= inserted
;
4371 /* Put an anchor to ensure multi-byte form ends at gap. */
4376 /* Discard the unwind protect for closing the file. */
4380 error ("IO error reading %s: %s",
4381 SDATA (orig_filename
), emacs_strerror (errno
));
4385 if (! coding_system_decided
)
4387 /* The coding system is not yet decided. Decide it by an
4388 optimized method for handling `coding:' tag.
4390 Note that we can get here only if the buffer was empty
4391 before the insertion. */
4395 if (!NILP (Vcoding_system_for_read
))
4396 val
= Vcoding_system_for_read
;
4399 /* Since we are sure that the current buffer was empty
4400 before the insertion, we can toggle
4401 enable-multibyte-characters directly here without taking
4402 care of marker adjustment and byte combining problem. By
4403 this way, we can run Lisp program safely before decoding
4404 the inserted text. */
4405 Lisp_Object unwind_data
;
4406 int count
= SPECPDL_INDEX ();
4408 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4409 Fcons (current_buffer
->undo_list
,
4410 Fcurrent_buffer ()));
4411 current_buffer
->enable_multibyte_characters
= Qnil
;
4412 current_buffer
->undo_list
= Qt
;
4413 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4415 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4417 val
= call2 (Vset_auto_coding_function
,
4418 filename
, make_number (inserted
));
4423 /* If the coding system is not yet decided, check
4424 file-coding-system-alist. */
4425 Lisp_Object args
[6], coding_systems
;
4427 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4428 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4429 coding_systems
= Ffind_operation_coding_system (6, args
);
4430 if (CONSP (coding_systems
))
4431 val
= XCAR (coding_systems
);
4434 unbind_to (count
, Qnil
);
4435 inserted
= Z_BYTE
- BEG_BYTE
;
4438 /* The following kludgy code is to avoid some compiler bug.
4440 setup_coding_system (val, &coding);
4443 struct coding_system temp_coding
;
4444 setup_coding_system (val
, &temp_coding
);
4445 bcopy (&temp_coding
, &coding
, sizeof coding
);
4447 /* Ensure we set Vlast_coding_system_used. */
4448 set_coding_system
= 1;
4450 if (NILP (current_buffer
->enable_multibyte_characters
)
4452 /* We must suppress all character code conversion except for
4453 end-of-line conversion. */
4454 setup_raw_text_coding_system (&coding
);
4455 coding
.src_multibyte
= 0;
4456 coding
.dst_multibyte
4457 = !NILP (current_buffer
->enable_multibyte_characters
);
4461 /* Can't do this if part of the buffer might be preserved. */
4463 && (coding
.type
== coding_type_no_conversion
4464 || coding
.type
== coding_type_raw_text
))
4466 /* Visiting a file with these coding system makes the buffer
4468 current_buffer
->enable_multibyte_characters
= Qnil
;
4469 coding
.dst_multibyte
= 0;
4472 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4474 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4476 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4478 inserted
= coding
.produced_char
;
4481 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4486 /* Use the conversion type to determine buffer-file-type
4487 (find-buffer-file-type is now used to help determine the
4489 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4490 || coding
.eol_type
== CODING_EOL_LF
)
4491 && ! CODING_REQUIRE_DECODING (&coding
))
4492 current_buffer
->buffer_file_type
= Qt
;
4494 current_buffer
->buffer_file_type
= Qnil
;
4501 if (!EQ (current_buffer
->undo_list
, Qt
))
4502 current_buffer
->undo_list
= Qnil
;
4504 stat (SDATA (filename
), &st
);
4509 current_buffer
->modtime
= st
.st_mtime
;
4510 current_buffer
->filename
= orig_filename
;
4513 SAVE_MODIFF
= MODIFF
;
4514 current_buffer
->auto_save_modified
= MODIFF
;
4515 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4516 #ifdef CLASH_DETECTION
4519 if (!NILP (current_buffer
->file_truename
))
4520 unlock_file (current_buffer
->file_truename
);
4521 unlock_file (filename
);
4523 #endif /* CLASH_DETECTION */
4525 Fsignal (Qfile_error
,
4526 Fcons (build_string ("not a regular file"),
4527 Fcons (orig_filename
, Qnil
)));
4530 /* Decode file format */
4533 int empty_undo_list_p
= 0;
4535 /* If we're anyway going to discard undo information, don't
4536 record it in the first place. The buffer's undo list at this
4537 point is either nil or t when visiting a file. */
4540 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4541 current_buffer
->undo_list
= Qt
;
4544 insval
= call3 (Qformat_decode
,
4545 Qnil
, make_number (inserted
), visit
);
4546 CHECK_NUMBER (insval
);
4547 inserted
= XFASTINT (insval
);
4550 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4553 if (set_coding_system
)
4554 Vlast_coding_system_used
= coding
.symbol
;
4556 /* Call after-change hooks for the inserted text, aside from the case
4557 of normal visiting (not with REPLACE), which is done in a new buffer
4558 "before" the buffer is changed. */
4559 if (inserted
> 0 && total
> 0
4560 && (NILP (visit
) || !NILP (replace
)))
4562 signal_after_change (PT
, 0, inserted
);
4563 update_compositions (PT
, PT
, CHECK_BORDER
);
4566 p
= Vafter_insert_file_functions
;
4569 insval
= call1 (XCAR (p
), make_number (inserted
));
4572 CHECK_NUMBER (insval
);
4573 inserted
= XFASTINT (insval
);
4580 && current_buffer
->modtime
== -1)
4582 /* If visiting nonexistent file, return nil. */
4583 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4587 Fsignal (Qquit
, Qnil
);
4589 /* ??? Retval needs to be dealt with in all cases consistently. */
4591 val
= Fcons (orig_filename
,
4592 Fcons (make_number (inserted
),
4595 RETURN_UNGCPRO (unbind_to (count
, val
));
4598 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4599 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4600 Lisp_Object
, Lisp_Object
));
4602 /* If build_annotations switched buffers, switch back to BUF.
4603 Kill the temporary buffer that was selected in the meantime.
4605 Since this kill only the last temporary buffer, some buffers remain
4606 not killed if build_annotations switched buffers more than once.
4610 build_annotations_unwind (buf
)
4615 if (XBUFFER (buf
) == current_buffer
)
4617 tembuf
= Fcurrent_buffer ();
4619 Fkill_buffer (tembuf
);
4623 /* Decide the coding-system to encode the data with. */
4626 choose_write_coding_system (start
, end
, filename
,
4627 append
, visit
, lockname
, coding
)
4628 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4629 struct coding_system
*coding
;
4635 else if (!NILP (Vcoding_system_for_write
))
4637 val
= Vcoding_system_for_write
;
4638 if (coding_system_require_warning
4639 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4640 /* Confirm that VAL can surely encode the current region. */
4641 val
= call5 (Vselect_safe_coding_system_function
,
4642 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4647 /* If the variable `buffer-file-coding-system' is set locally,
4648 it means that the file was read with some kind of code
4649 conversion or the variable is explicitly set by users. We
4650 had better write it out with the same coding system even if
4651 `enable-multibyte-characters' is nil.
4653 If it is not set locally, we anyway have to convert EOL
4654 format if the default value of `buffer-file-coding-system'
4655 tells that it is not Unix-like (LF only) format. */
4656 int using_default_coding
= 0;
4657 int force_raw_text
= 0;
4659 val
= current_buffer
->buffer_file_coding_system
;
4661 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4664 if (NILP (current_buffer
->enable_multibyte_characters
))
4670 /* Check file-coding-system-alist. */
4671 Lisp_Object args
[7], coding_systems
;
4673 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4674 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4676 coding_systems
= Ffind_operation_coding_system (7, args
);
4677 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4678 val
= XCDR (coding_systems
);
4682 && !NILP (current_buffer
->buffer_file_coding_system
))
4684 /* If we still have not decided a coding system, use the
4685 default value of buffer-file-coding-system. */
4686 val
= current_buffer
->buffer_file_coding_system
;
4687 using_default_coding
= 1;
4691 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4692 /* Confirm that VAL can surely encode the current region. */
4693 val
= call5 (Vselect_safe_coding_system_function
,
4694 start
, end
, val
, Qnil
, filename
);
4696 setup_coding_system (Fcheck_coding_system (val
), coding
);
4697 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4698 && !using_default_coding
)
4700 if (! EQ (default_buffer_file_coding
.symbol
,
4701 buffer_defaults
.buffer_file_coding_system
))
4702 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4703 &default_buffer_file_coding
);
4704 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4706 Lisp_Object subsidiaries
;
4708 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4709 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4710 if (VECTORP (subsidiaries
)
4711 && XVECTOR (subsidiaries
)->size
== 3)
4713 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4718 setup_raw_text_coding_system (coding
);
4719 goto done_setup_coding
;
4722 setup_coding_system (Fcheck_coding_system (val
), coding
);
4725 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4726 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4729 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4730 "r\nFWrite region to file: \ni\ni\ni\np",
4731 doc
: /* Write current region into specified file.
4732 When called from a program, requires three arguments:
4733 START, END and FILENAME. START and END are normally buffer positions
4734 specifying the part of the buffer to write.
4735 If START is nil, that means to use the entire buffer contents.
4736 If START is a string, then output that string to the file
4737 instead of any buffer contents; END is ignored.
4739 Optional fourth argument APPEND if non-nil means
4740 append to existing file contents (if any). If it is an integer,
4741 seek to that offset in the file before writing.
4742 Optional fifth argument VISIT if t means
4743 set the last-save-file-modtime of buffer to this file's modtime
4744 and mark buffer not modified.
4745 If VISIT is a string, it is a second file name;
4746 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4747 VISIT is also the file name to lock and unlock for clash detection.
4748 If VISIT is neither t nor nil nor a string,
4749 that means do not display the \"Wrote file\" message.
4750 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4751 use for locking and unlocking, overriding FILENAME and VISIT.
4752 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4753 for an existing file with the same name. If MUSTBENEW is `excl',
4754 that means to get an error if the file already exists; never overwrite.
4755 If MUSTBENEW is neither nil nor `excl', that means ask for
4756 confirmation before overwriting, but do go ahead and overwrite the file
4757 if the user confirms.
4759 This does code conversion according to the value of
4760 `coding-system-for-write', `buffer-file-coding-system', or
4761 `file-coding-system-alist', and sets the variable
4762 `last-coding-system-used' to the coding system actually used. */)
4763 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4764 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4769 const unsigned char *fn
;
4772 int count
= SPECPDL_INDEX ();
4775 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4777 Lisp_Object handler
;
4778 Lisp_Object visit_file
;
4779 Lisp_Object annotations
;
4780 Lisp_Object encoded_filename
;
4781 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4782 int quietly
= !NILP (visit
);
4783 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4784 struct buffer
*given_buffer
;
4786 int buffer_file_type
= O_BINARY
;
4788 struct coding_system coding
;
4790 if (current_buffer
->base_buffer
&& visiting
)
4791 error ("Cannot do file visiting in an indirect buffer");
4793 if (!NILP (start
) && !STRINGP (start
))
4794 validate_region (&start
, &end
);
4796 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4798 filename
= Fexpand_file_name (filename
, Qnil
);
4800 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4801 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4803 if (STRINGP (visit
))
4804 visit_file
= Fexpand_file_name (visit
, Qnil
);
4806 visit_file
= filename
;
4808 if (NILP (lockname
))
4809 lockname
= visit_file
;
4813 /* If the file name has special constructs in it,
4814 call the corresponding file handler. */
4815 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4816 /* If FILENAME has no handler, see if VISIT has one. */
4817 if (NILP (handler
) && STRINGP (visit
))
4818 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4820 if (!NILP (handler
))
4823 val
= call6 (handler
, Qwrite_region
, start
, end
,
4824 filename
, append
, visit
);
4828 SAVE_MODIFF
= MODIFF
;
4829 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4830 current_buffer
->filename
= visit_file
;
4836 /* Special kludge to simplify auto-saving. */
4839 XSETFASTINT (start
, BEG
);
4840 XSETFASTINT (end
, Z
);
4843 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4844 count1
= SPECPDL_INDEX ();
4846 given_buffer
= current_buffer
;
4848 if (!STRINGP (start
))
4850 annotations
= build_annotations (start
, end
);
4852 if (current_buffer
!= given_buffer
)
4854 XSETFASTINT (start
, BEGV
);
4855 XSETFASTINT (end
, ZV
);
4861 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4863 /* Decide the coding-system to encode the data with.
4864 We used to make this choice before calling build_annotations, but that
4865 leads to problems when a write-annotate-function takes care of
4866 unsavable chars (as was the case with X-Symbol). */
4867 choose_write_coding_system (start
, end
, filename
,
4868 append
, visit
, lockname
, &coding
);
4869 Vlast_coding_system_used
= coding
.symbol
;
4871 given_buffer
= current_buffer
;
4872 if (! STRINGP (start
))
4874 annotations
= build_annotations_2 (start
, end
,
4875 coding
.pre_write_conversion
, annotations
);
4876 if (current_buffer
!= given_buffer
)
4878 XSETFASTINT (start
, BEGV
);
4879 XSETFASTINT (end
, ZV
);
4883 #ifdef CLASH_DETECTION
4886 #if 0 /* This causes trouble for GNUS. */
4887 /* If we've locked this file for some other buffer,
4888 query before proceeding. */
4889 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4890 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4893 lock_file (lockname
);
4895 #endif /* CLASH_DETECTION */
4897 encoded_filename
= ENCODE_FILE (filename
);
4899 fn
= SDATA (encoded_filename
);
4903 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4904 #else /* not DOS_NT */
4905 desc
= emacs_open (fn
, O_WRONLY
, 0);
4906 #endif /* not DOS_NT */
4908 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4910 if (auto_saving
) /* Overwrite any previous version of autosave file */
4912 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4913 desc
= emacs_open (fn
, O_RDWR
, 0);
4915 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4916 ? SDATA (current_buffer
->filename
) : 0,
4919 else /* Write to temporary name and rename if no errors */
4921 Lisp_Object temp_name
;
4922 temp_name
= Ffile_name_directory (filename
);
4924 if (!NILP (temp_name
))
4926 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4927 build_string ("$$SAVE$$")));
4928 fname
= SDATA (filename
);
4929 fn
= SDATA (temp_name
);
4930 desc
= creat_copy_attrs (fname
, fn
);
4933 /* If we can't open the temporary file, try creating a new
4934 version of the original file. VMS "creat" creates a
4935 new version rather than truncating an existing file. */
4938 desc
= creat (fn
, 0666);
4939 #if 0 /* This can clobber an existing file and fail to replace it,
4940 if the user runs out of space. */
4943 /* We can't make a new version;
4944 try to truncate and rewrite existing version if any. */
4946 desc
= emacs_open (fn
, O_RDWR
, 0);
4952 desc
= creat (fn
, 0666);
4956 desc
= emacs_open (fn
,
4957 O_WRONLY
| O_CREAT
| buffer_file_type
4958 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4959 S_IREAD
| S_IWRITE
);
4960 #else /* not DOS_NT */
4961 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4962 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4963 auto_saving
? auto_save_mode_bits
: 0666);
4964 #endif /* not DOS_NT */
4965 #endif /* not VMS */
4969 #ifdef CLASH_DETECTION
4971 if (!auto_saving
) unlock_file (lockname
);
4973 #endif /* CLASH_DETECTION */
4975 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4978 record_unwind_protect (close_file_unwind
, make_number (desc
));
4980 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4984 if (NUMBERP (append
))
4985 ret
= lseek (desc
, XINT (append
), 1);
4987 ret
= lseek (desc
, 0, 2);
4990 #ifdef CLASH_DETECTION
4991 if (!auto_saving
) unlock_file (lockname
);
4992 #endif /* CLASH_DETECTION */
4994 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5002 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5003 * if we do writes that don't end with a carriage return. Furthermore
5004 * it cannot handle writes of more then 16K. The modified
5005 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5006 * this EXCEPT for the last record (iff it doesn't end with a carriage
5007 * return). This implies that if your buffer doesn't end with a carriage
5008 * return, you get one free... tough. However it also means that if
5009 * we make two calls to sys_write (a la the following code) you can
5010 * get one at the gap as well. The easiest way to fix this (honest)
5011 * is to move the gap to the next newline (or the end of the buffer).
5016 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5017 move_gap (find_next_newline (GPT
, 1));
5019 /* Whether VMS or not, we must move the gap to the next of newline
5020 when we must put designation sequences at beginning of line. */
5021 if (INTEGERP (start
)
5022 && coding
.type
== coding_type_iso2022
5023 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5024 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5026 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5027 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5028 move_gap_both (PT
, PT_BYTE
);
5029 SET_PT_BOTH (opoint
, opoint_byte
);
5036 if (STRINGP (start
))
5038 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5039 &annotations
, &coding
);
5042 else if (XINT (start
) != XINT (end
))
5044 tem
= CHAR_TO_BYTE (XINT (start
));
5046 if (XINT (start
) < GPT
)
5048 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5049 min (GPT
, XINT (end
)) - XINT (start
),
5050 &annotations
, &coding
);
5054 if (XINT (end
) > GPT
&& !failure
)
5056 tem
= max (XINT (start
), GPT
);
5057 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5058 &annotations
, &coding
);
5064 /* If file was empty, still need to write the annotations */
5065 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5066 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5070 if (CODING_REQUIRE_FLUSHING (&coding
)
5071 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5074 /* We have to flush out a data. */
5075 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5076 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5083 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5084 Disk full in NFS may be reported here. */
5085 /* mib says that closing the file will try to write as fast as NFS can do
5086 it, and that means the fsync here is not crucial for autosave files. */
5087 if (!auto_saving
&& fsync (desc
) < 0)
5089 /* If fsync fails with EINTR, don't treat that as serious. */
5091 failure
= 1, save_errno
= errno
;
5095 /* Spurious "file has changed on disk" warnings have been
5096 observed on Suns as well.
5097 It seems that `close' can change the modtime, under nfs.
5099 (This has supposedly been fixed in Sunos 4,
5100 but who knows about all the other machines with NFS?) */
5103 /* On VMS and APOLLO, must do the stat after the close
5104 since closing changes the modtime. */
5107 /* Recall that #if defined does not work on VMS. */
5114 /* NFS can report a write failure now. */
5115 if (emacs_close (desc
) < 0)
5116 failure
= 1, save_errno
= errno
;
5119 /* If we wrote to a temporary name and had no errors, rename to real name. */
5123 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5131 /* Discard the unwind protect for close_file_unwind. */
5132 specpdl_ptr
= specpdl
+ count1
;
5133 /* Restore the original current buffer. */
5134 visit_file
= unbind_to (count
, visit_file
);
5136 #ifdef CLASH_DETECTION
5138 unlock_file (lockname
);
5139 #endif /* CLASH_DETECTION */
5141 /* Do this before reporting IO error
5142 to avoid a "file has changed on disk" warning on
5143 next attempt to save. */
5145 current_buffer
->modtime
= st
.st_mtime
;
5148 error ("IO error writing %s: %s", SDATA (filename
),
5149 emacs_strerror (save_errno
));
5153 SAVE_MODIFF
= MODIFF
;
5154 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5155 current_buffer
->filename
= visit_file
;
5156 update_mode_lines
++;
5162 message_with_string ("Wrote %s", visit_file
, 1);
5167 Lisp_Object
merge ();
5169 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5170 doc
: /* Return t if (car A) is numerically less than (car B). */)
5174 return Flss (Fcar (a
), Fcar (b
));
5177 /* Build the complete list of annotations appropriate for writing out
5178 the text between START and END, by calling all the functions in
5179 write-region-annotate-functions and merging the lists they return.
5180 If one of these functions switches to a different buffer, we assume
5181 that buffer contains altered text. Therefore, the caller must
5182 make sure to restore the current buffer in all cases,
5183 as save-excursion would do. */
5186 build_annotations (start
, end
)
5187 Lisp_Object start
, end
;
5189 Lisp_Object annotations
;
5191 struct gcpro gcpro1
, gcpro2
;
5192 Lisp_Object original_buffer
;
5195 XSETBUFFER (original_buffer
, current_buffer
);
5198 p
= Vwrite_region_annotate_functions
;
5199 GCPRO2 (annotations
, p
);
5202 struct buffer
*given_buffer
= current_buffer
;
5203 Vwrite_region_annotations_so_far
= annotations
;
5204 res
= call2 (XCAR (p
), start
, end
);
5205 /* If the function makes a different buffer current,
5206 assume that means this buffer contains altered text to be output.
5207 Reset START and END from the buffer bounds
5208 and discard all previous annotations because they should have
5209 been dealt with by this function. */
5210 if (current_buffer
!= given_buffer
)
5212 XSETFASTINT (start
, BEGV
);
5213 XSETFASTINT (end
, ZV
);
5216 Flength (res
); /* Check basic validity of return value */
5217 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5221 /* Now do the same for annotation functions implied by the file-format */
5222 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5223 p
= Vauto_save_file_format
;
5225 p
= current_buffer
->file_format
;
5226 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5228 struct buffer
*given_buffer
= current_buffer
;
5230 Vwrite_region_annotations_so_far
= annotations
;
5232 /* Value is either a list of annotations or nil if the function
5233 has written annotations to a temporary buffer, which is now
5235 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5236 original_buffer
, make_number (i
));
5237 if (current_buffer
!= given_buffer
)
5239 XSETFASTINT (start
, BEGV
);
5240 XSETFASTINT (end
, ZV
);
5245 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5253 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5254 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5256 struct gcpro gcpro1
;
5259 GCPRO1 (annotations
);
5260 /* At last, do the same for the function PRE_WRITE_CONVERSION
5261 implied by the current coding-system. */
5262 if (!NILP (pre_write_conversion
))
5264 struct buffer
*given_buffer
= current_buffer
;
5265 Vwrite_region_annotations_so_far
= annotations
;
5266 res
= call2 (pre_write_conversion
, start
, end
);
5268 annotations
= (current_buffer
!= given_buffer
5270 : merge (annotations
, res
, Qcar_less_than_car
));
5277 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5278 If STRING is nil, POS is the character position in the current buffer.
5279 Intersperse with them the annotations from *ANNOT
5280 which fall within the range of POS to POS + NCHARS,
5281 each at its appropriate position.
5283 We modify *ANNOT by discarding elements as we use them up.
5285 The return value is negative in case of system call failure. */
5288 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5291 register int nchars
;
5294 struct coding_system
*coding
;
5298 int lastpos
= pos
+ nchars
;
5300 while (NILP (*annot
) || CONSP (*annot
))
5302 tem
= Fcar_safe (Fcar (*annot
));
5305 nextpos
= XFASTINT (tem
);
5307 /* If there are no more annotations in this range,
5308 output the rest of the range all at once. */
5309 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5310 return e_write (desc
, string
, pos
, lastpos
, coding
);
5312 /* Output buffer text up to the next annotation's position. */
5315 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5319 /* Output the annotation. */
5320 tem
= Fcdr (Fcar (*annot
));
5323 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5326 *annot
= Fcdr (*annot
);
5331 #ifndef WRITE_BUF_SIZE
5332 #define WRITE_BUF_SIZE (16 * 1024)
5335 /* Write text in the range START and END into descriptor DESC,
5336 encoding them with coding system CODING. If STRING is nil, START
5337 and END are character positions of the current buffer, else they
5338 are indexes to the string STRING. */
5341 e_write (desc
, string
, start
, end
, coding
)
5345 struct coding_system
*coding
;
5347 register char *addr
;
5348 register int nbytes
;
5349 char buf
[WRITE_BUF_SIZE
];
5353 coding
->composing
= COMPOSITION_DISABLED
;
5354 if (coding
->composing
!= COMPOSITION_DISABLED
)
5355 coding_save_composition (coding
, start
, end
, string
);
5357 if (STRINGP (string
))
5359 addr
= SDATA (string
);
5360 nbytes
= SBYTES (string
);
5361 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5363 else if (start
< end
)
5365 /* It is assured that the gap is not in the range START and END-1. */
5366 addr
= CHAR_POS_ADDR (start
);
5367 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5368 coding
->src_multibyte
5369 = !NILP (current_buffer
->enable_multibyte_characters
);
5375 coding
->src_multibyte
= 1;
5378 /* We used to have a code for handling selective display here. But,
5379 now it is handled within encode_coding. */
5384 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5385 if (coding
->produced
> 0)
5387 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5388 if (coding
->produced
)
5394 nbytes
-= coding
->consumed
;
5395 addr
+= coding
->consumed
;
5396 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5399 /* The source text ends by an incomplete multibyte form.
5400 There's no way other than write it out as is. */
5401 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5410 start
+= coding
->consumed_char
;
5411 if (coding
->cmp_data
)
5412 coding_adjust_composition_offset (coding
, start
);
5415 if (coding
->cmp_data
)
5416 coding_free_composition_data (coding
);
5421 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5422 Sverify_visited_file_modtime
, 1, 1, 0,
5423 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5424 This means that the file has not been changed since it was visited or saved. */)
5430 Lisp_Object handler
;
5431 Lisp_Object filename
;
5436 if (!STRINGP (b
->filename
)) return Qt
;
5437 if (b
->modtime
== 0) return Qt
;
5439 /* If the file name has special constructs in it,
5440 call the corresponding file handler. */
5441 handler
= Ffind_file_name_handler (b
->filename
,
5442 Qverify_visited_file_modtime
);
5443 if (!NILP (handler
))
5444 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5446 filename
= ENCODE_FILE (b
->filename
);
5448 if (stat (SDATA (filename
), &st
) < 0)
5450 /* If the file doesn't exist now and didn't exist before,
5451 we say that it isn't modified, provided the error is a tame one. */
5452 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5457 if (st
.st_mtime
== b
->modtime
5458 /* If both are positive, accept them if they are off by one second. */
5459 || (st
.st_mtime
> 0 && b
->modtime
> 0
5460 && (st
.st_mtime
== b
->modtime
+ 1
5461 || st
.st_mtime
== b
->modtime
- 1)))
5466 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5467 Sclear_visited_file_modtime
, 0, 0, 0,
5468 doc
: /* Clear out records of last mod time of visited file.
5469 Next attempt to save will certainly not complain of a discrepancy. */)
5472 current_buffer
->modtime
= 0;
5476 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5477 Svisited_file_modtime
, 0, 0, 0,
5478 doc
: /* Return the current buffer's recorded visited file modification time.
5479 The value is a list of the form (HIGH . LOW), like the time values
5480 that `file-attributes' returns. */)
5483 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5486 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5487 Sset_visited_file_modtime
, 0, 1, 0,
5488 doc
: /* Update buffer's recorded modification time from the visited file's time.
5489 Useful if the buffer was not read from the file normally
5490 or if the file itself has been changed for some known benign reason.
5491 An argument specifies the modification time value to use
5492 \(instead of that of the visited file), in the form of a list
5493 \(HIGH . LOW) or (HIGH LOW). */)
5495 Lisp_Object time_list
;
5497 if (!NILP (time_list
))
5498 current_buffer
->modtime
= cons_to_long (time_list
);
5501 register Lisp_Object filename
;
5503 Lisp_Object handler
;
5505 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5507 /* If the file name has special constructs in it,
5508 call the corresponding file handler. */
5509 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5510 if (!NILP (handler
))
5511 /* The handler can find the file name the same way we did. */
5512 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5514 filename
= ENCODE_FILE (filename
);
5516 if (stat (SDATA (filename
), &st
) >= 0)
5517 current_buffer
->modtime
= st
.st_mtime
;
5524 auto_save_error (error
)
5527 Lisp_Object args
[3], msg
;
5529 struct gcpro gcpro1
;
5533 args
[0] = build_string ("Auto-saving %s: %s");
5534 args
[1] = current_buffer
->name
;
5535 args
[2] = Ferror_message_string (error
);
5536 msg
= Fformat (3, args
);
5538 nbytes
= SBYTES (msg
);
5540 for (i
= 0; i
< 3; ++i
)
5543 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5545 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5546 Fsleep_for (make_number (1), Qnil
);
5558 /* Get visited file's mode to become the auto save file's mode. */
5559 if (! NILP (current_buffer
->filename
)
5560 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5561 /* But make sure we can overwrite it later! */
5562 auto_save_mode_bits
= st
.st_mode
| 0600;
5564 auto_save_mode_bits
= 0666;
5567 Fwrite_region (Qnil
, Qnil
,
5568 current_buffer
->auto_save_file_name
,
5569 Qnil
, Qlambda
, Qnil
, Qnil
);
5573 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5578 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5579 | XFASTINT (XCDR (stream
))));
5584 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5587 minibuffer_auto_raise
= XINT (value
);
5592 do_auto_save_make_dir (dir
)
5595 return call2 (Qmake_directory
, dir
, Qt
);
5599 do_auto_save_eh (ignore
)
5605 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5606 doc
: /* Auto-save all buffers that need it.
5607 This is all buffers that have auto-saving enabled
5608 and are changed since last auto-saved.
5609 Auto-saving writes the buffer into a file
5610 so that your editing is not lost if the system crashes.
5611 This file is not the file you visited; that changes only when you save.
5612 Normally we run the normal hook `auto-save-hook' before saving.
5614 A non-nil NO-MESSAGE argument means do not print any message if successful.
5615 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5616 (no_message
, current_only
)
5617 Lisp_Object no_message
, current_only
;
5619 struct buffer
*old
= current_buffer
, *b
;
5620 Lisp_Object tail
, buf
;
5622 int do_handled_files
;
5625 Lisp_Object lispstream
;
5626 int count
= SPECPDL_INDEX ();
5627 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5628 int old_message_p
= 0;
5629 struct gcpro gcpro1
, gcpro2
;
5631 if (max_specpdl_size
< specpdl_size
+ 40)
5632 max_specpdl_size
= specpdl_size
+ 40;
5637 if (NILP (no_message
))
5639 old_message_p
= push_message ();
5640 record_unwind_protect (pop_message_unwind
, Qnil
);
5643 /* Ordinarily don't quit within this function,
5644 but don't make it impossible to quit (in case we get hung in I/O). */
5648 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5649 point to non-strings reached from Vbuffer_alist. */
5651 if (!NILP (Vrun_hooks
))
5652 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5654 if (STRINGP (Vauto_save_list_file_name
))
5656 Lisp_Object listfile
;
5658 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5660 /* Don't try to create the directory when shutting down Emacs,
5661 because creating the directory might signal an error, and
5662 that would leave Emacs in a strange state. */
5663 if (!NILP (Vrun_hooks
))
5667 GCPRO2 (dir
, listfile
);
5668 dir
= Ffile_name_directory (listfile
);
5669 if (NILP (Ffile_directory_p (dir
)))
5670 internal_condition_case_1 (do_auto_save_make_dir
,
5671 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5676 stream
= fopen (SDATA (listfile
), "w");
5679 /* Arrange to close that file whether or not we get an error.
5680 Also reset auto_saving to 0. */
5681 lispstream
= Fcons (Qnil
, Qnil
);
5682 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5683 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5694 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5695 record_unwind_protect (do_auto_save_unwind_1
,
5696 make_number (minibuffer_auto_raise
));
5697 minibuffer_auto_raise
= 0;
5700 /* First, save all files which don't have handlers. If Emacs is
5701 crashing, the handlers may tweak what is causing Emacs to crash
5702 in the first place, and it would be a shame if Emacs failed to
5703 autosave perfectly ordinary files because it couldn't handle some
5705 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5706 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5708 buf
= XCDR (XCAR (tail
));
5711 /* Record all the buffers that have auto save mode
5712 in the special file that lists them. For each of these buffers,
5713 Record visited name (if any) and auto save name. */
5714 if (STRINGP (b
->auto_save_file_name
)
5715 && stream
!= NULL
&& do_handled_files
== 0)
5717 if (!NILP (b
->filename
))
5719 fwrite (SDATA (b
->filename
), 1,
5720 SBYTES (b
->filename
), stream
);
5722 putc ('\n', stream
);
5723 fwrite (SDATA (b
->auto_save_file_name
), 1,
5724 SBYTES (b
->auto_save_file_name
), stream
);
5725 putc ('\n', stream
);
5728 if (!NILP (current_only
)
5729 && b
!= current_buffer
)
5732 /* Don't auto-save indirect buffers.
5733 The base buffer takes care of it. */
5737 /* Check for auto save enabled
5738 and file changed since last auto save
5739 and file changed since last real save. */
5740 if (STRINGP (b
->auto_save_file_name
)
5741 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5742 && b
->auto_save_modified
< BUF_MODIFF (b
)
5743 /* -1 means we've turned off autosaving for a while--see below. */
5744 && XINT (b
->save_length
) >= 0
5745 && (do_handled_files
5746 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5749 EMACS_TIME before_time
, after_time
;
5751 EMACS_GET_TIME (before_time
);
5753 /* If we had a failure, don't try again for 20 minutes. */
5754 if (b
->auto_save_failure_time
>= 0
5755 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5758 if ((XFASTINT (b
->save_length
) * 10
5759 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5760 /* A short file is likely to change a large fraction;
5761 spare the user annoying messages. */
5762 && XFASTINT (b
->save_length
) > 5000
5763 /* These messages are frequent and annoying for `*mail*'. */
5764 && !EQ (b
->filename
, Qnil
)
5765 && NILP (no_message
))
5767 /* It has shrunk too much; turn off auto-saving here. */
5768 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5769 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5771 minibuffer_auto_raise
= 0;
5772 /* Turn off auto-saving until there's a real save,
5773 and prevent any more warnings. */
5774 XSETINT (b
->save_length
, -1);
5775 Fsleep_for (make_number (1), Qnil
);
5778 set_buffer_internal (b
);
5779 if (!auto_saved
&& NILP (no_message
))
5780 message1 ("Auto-saving...");
5781 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5783 b
->auto_save_modified
= BUF_MODIFF (b
);
5784 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5785 set_buffer_internal (old
);
5787 EMACS_GET_TIME (after_time
);
5789 /* If auto-save took more than 60 seconds,
5790 assume it was an NFS failure that got a timeout. */
5791 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5792 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5796 /* Prevent another auto save till enough input events come in. */
5797 record_auto_save ();
5799 if (auto_saved
&& NILP (no_message
))
5803 /* If we are going to restore an old message,
5804 give time to read ours. */
5805 sit_for (1, 0, 0, 0, 0);
5809 /* If we displayed a message and then restored a state
5810 with no message, leave a "done" message on the screen. */
5811 message1 ("Auto-saving...done");
5816 /* This restores the message-stack status. */
5817 unbind_to (count
, Qnil
);
5821 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5822 Sset_buffer_auto_saved
, 0, 0, 0,
5823 doc
: /* Mark current buffer as auto-saved with its current text.
5824 No auto-save file will be written until the buffer changes again. */)
5827 current_buffer
->auto_save_modified
= MODIFF
;
5828 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5829 current_buffer
->auto_save_failure_time
= -1;
5833 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5834 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5835 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5838 current_buffer
->auto_save_failure_time
= -1;
5842 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5844 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
5847 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5850 /* Reading and completing file names */
5851 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5853 /* In the string VAL, change each $ to $$ and return the result. */
5856 double_dollars (val
)
5859 register const unsigned char *old
;
5860 register unsigned char *new;
5864 osize
= SBYTES (val
);
5866 /* Count the number of $ characters. */
5867 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
5868 if (*old
++ == '$') count
++;
5872 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
5875 for (n
= osize
; n
> 0; n
--)
5889 read_file_name_cleanup (arg
)
5892 return (current_buffer
->directory
= arg
);
5895 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5897 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
5898 (string
, dir
, action
)
5899 Lisp_Object string
, dir
, action
;
5900 /* action is nil for complete, t for return list of completions,
5901 lambda for verify final value */
5903 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5905 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5907 CHECK_STRING (string
);
5914 /* No need to protect ACTION--we only compare it with t and nil. */
5915 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5917 if (SCHARS (string
) == 0)
5919 if (EQ (action
, Qlambda
))
5927 orig_string
= string
;
5928 string
= Fsubstitute_in_file_name (string
);
5929 changed
= NILP (Fstring_equal (string
, orig_string
));
5930 name
= Ffile_name_nondirectory (string
);
5931 val
= Ffile_name_directory (string
);
5933 realdir
= Fexpand_file_name (val
, realdir
);
5938 specdir
= Ffile_name_directory (string
);
5939 val
= Ffile_name_completion (name
, realdir
);
5944 return double_dollars (string
);
5948 if (!NILP (specdir
))
5949 val
= concat2 (specdir
, val
);
5951 return double_dollars (val
);
5954 #endif /* not VMS */
5958 if (EQ (action
, Qt
))
5960 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
5964 if (NILP (Vread_file_name_predicate
)
5965 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
5969 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
5971 /* Brute-force speed up for directory checking:
5972 Discard strings which don't end in a slash. */
5973 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
5975 Lisp_Object tem
= XCAR (all
);
5977 if (STRINGP (tem
) &&
5978 (len
= SCHARS (tem
), len
> 0) &&
5979 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
5980 comp
= Fcons (tem
, comp
);
5986 /* Must do it the hard (and slow) way. */
5987 GCPRO3 (all
, comp
, specdir
);
5988 count
= SPECPDL_INDEX ();
5989 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
5990 current_buffer
->directory
= realdir
;
5991 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
5992 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
5993 comp
= Fcons (XCAR (all
), comp
);
5994 unbind_to (count
, Qnil
);
5997 return Fnreverse (comp
);
6000 /* Only other case actually used is ACTION = lambda */
6002 /* Supposedly this helps commands such as `cd' that read directory names,
6003 but can someone explain how it helps them? -- RMS */
6004 if (SCHARS (name
) == 0)
6007 if (!NILP (Vread_file_name_predicate
))
6008 return call1 (Vread_file_name_predicate
, string
);
6009 return Ffile_exists_p (string
);
6012 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6013 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6014 Value is not expanded---you must call `expand-file-name' yourself.
6015 Default name to DEFAULT-FILENAME if user enters a null string.
6016 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6017 except that if INITIAL is specified, that combined with DIR is used.)
6018 Fourth arg MUSTMATCH non-nil means require existing file's name.
6019 Non-nil and non-t means also require confirmation after completion.
6020 Fifth arg INITIAL specifies text to start with.
6021 If optional sixth arg PREDICATE is non-nil, possible completions and the
6022 resulting file name must satisfy (funcall PREDICATE NAME).
6023 DIR defaults to current buffer's directory default.
6025 If this command was invoked with the mouse, use a file dialog box if
6026 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6027 provides a file dialog box. */)
6028 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6029 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6031 Lisp_Object val
, insdef
, tem
;
6032 struct gcpro gcpro1
, gcpro2
;
6033 register char *homedir
;
6034 Lisp_Object decoded_homedir
;
6035 int replace_in_history
= 0;
6036 int add_to_history
= 0;
6040 dir
= current_buffer
->directory
;
6041 if (NILP (default_filename
))
6042 default_filename
= !NILP (initial
)
6043 ? Fexpand_file_name (initial
, dir
)
6044 : current_buffer
->filename
;
6046 /* If dir starts with user's homedir, change that to ~. */
6047 homedir
= (char *) egetenv ("HOME");
6049 /* homedir can be NULL in temacs, since Vprocess_environment is not
6050 yet set up. We shouldn't crash in that case. */
6053 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6054 CORRECT_DIR_SEPS (homedir
);
6059 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6062 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6063 SBYTES (decoded_homedir
))
6064 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6066 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6067 dir
= concat2 (build_string ("~"), dir
);
6069 /* Likewise for default_filename. */
6071 && STRINGP (default_filename
)
6072 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6073 SBYTES (decoded_homedir
))
6074 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6077 = Fsubstring (default_filename
,
6078 make_number (SCHARS (decoded_homedir
)), Qnil
);
6079 default_filename
= concat2 (build_string ("~"), default_filename
);
6081 if (!NILP (default_filename
))
6083 CHECK_STRING (default_filename
);
6084 default_filename
= double_dollars (default_filename
);
6087 if (insert_default_directory
&& STRINGP (dir
))
6090 if (!NILP (initial
))
6092 Lisp_Object args
[2], pos
;
6096 insdef
= Fconcat (2, args
);
6097 pos
= make_number (SCHARS (double_dollars (dir
)));
6098 insdef
= Fcons (double_dollars (insdef
), pos
);
6101 insdef
= double_dollars (insdef
);
6103 else if (STRINGP (initial
))
6104 insdef
= Fcons (double_dollars (initial
), make_number (0));
6108 if (!NILP (Vread_file_name_function
))
6110 Lisp_Object args
[7];
6112 GCPRO2 (insdef
, default_filename
);
6113 args
[0] = Vread_file_name_function
;
6116 args
[3] = default_filename
;
6117 args
[4] = mustmatch
;
6119 args
[6] = predicate
;
6120 RETURN_UNGCPRO (Ffuncall (7, args
));
6123 count
= SPECPDL_INDEX ();
6125 specbind (intern ("completion-ignore-case"), Qt
);
6128 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6129 specbind (intern ("read-file-name-predicate"),
6130 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6132 GCPRO2 (insdef
, default_filename
);
6134 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
6135 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6139 /* If DIR contains a file name, split it. */
6141 file
= Ffile_name_nondirectory (dir
);
6142 if (SCHARS (file
) && NILP (default_filename
))
6144 default_filename
= file
;
6145 dir
= Ffile_name_directory (dir
);
6147 if (!NILP(default_filename
))
6148 default_filename
= Fexpand_file_name (default_filename
, dir
);
6149 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6154 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6155 dir
, mustmatch
, insdef
,
6156 Qfile_name_history
, default_filename
, Qnil
);
6158 tem
= Fsymbol_value (Qfile_name_history
);
6159 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6160 replace_in_history
= 1;
6162 /* If Fcompleting_read returned the inserted default string itself
6163 (rather than a new string with the same contents),
6164 it has to mean that the user typed RET with the minibuffer empty.
6165 In that case, we really want to return ""
6166 so that commands such as set-visited-file-name can distinguish. */
6167 if (EQ (val
, default_filename
))
6169 /* In this case, Fcompleting_read has not added an element
6170 to the history. Maybe we should. */
6171 if (! replace_in_history
)
6177 unbind_to (count
, Qnil
);
6180 error ("No file name specified");
6182 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6184 if (!NILP (tem
) && !NILP (default_filename
))
6185 val
= default_filename
;
6186 else if (SCHARS (val
) == 0 && NILP (insdef
))
6188 if (!NILP (default_filename
))
6189 val
= default_filename
;
6191 error ("No default file name");
6193 val
= Fsubstitute_in_file_name (val
);
6195 if (replace_in_history
)
6196 /* Replace what Fcompleting_read added to the history
6197 with what we will actually return. */
6198 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6199 else if (add_to_history
)
6201 /* Add the value to the history--but not if it matches
6202 the last value already there. */
6203 Lisp_Object val1
= double_dollars (val
);
6204 tem
= Fsymbol_value (Qfile_name_history
);
6205 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6206 Fset (Qfile_name_history
,
6217 /* Must be set before any path manipulation is performed. */
6218 XSETFASTINT (Vdirectory_sep_char
, '/');
6225 Qexpand_file_name
= intern ("expand-file-name");
6226 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6227 Qdirectory_file_name
= intern ("directory-file-name");
6228 Qfile_name_directory
= intern ("file-name-directory");
6229 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6230 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6231 Qfile_name_as_directory
= intern ("file-name-as-directory");
6232 Qcopy_file
= intern ("copy-file");
6233 Qmake_directory_internal
= intern ("make-directory-internal");
6234 Qmake_directory
= intern ("make-directory");
6235 Qdelete_directory
= intern ("delete-directory");
6236 Qdelete_file
= intern ("delete-file");
6237 Qrename_file
= intern ("rename-file");
6238 Qadd_name_to_file
= intern ("add-name-to-file");
6239 Qmake_symbolic_link
= intern ("make-symbolic-link");
6240 Qfile_exists_p
= intern ("file-exists-p");
6241 Qfile_executable_p
= intern ("file-executable-p");
6242 Qfile_readable_p
= intern ("file-readable-p");
6243 Qfile_writable_p
= intern ("file-writable-p");
6244 Qfile_symlink_p
= intern ("file-symlink-p");
6245 Qaccess_file
= intern ("access-file");
6246 Qfile_directory_p
= intern ("file-directory-p");
6247 Qfile_regular_p
= intern ("file-regular-p");
6248 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6249 Qfile_modes
= intern ("file-modes");
6250 Qset_file_modes
= intern ("set-file-modes");
6251 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6252 Qinsert_file_contents
= intern ("insert-file-contents");
6253 Qwrite_region
= intern ("write-region");
6254 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6255 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6257 staticpro (&Qexpand_file_name
);
6258 staticpro (&Qsubstitute_in_file_name
);
6259 staticpro (&Qdirectory_file_name
);
6260 staticpro (&Qfile_name_directory
);
6261 staticpro (&Qfile_name_nondirectory
);
6262 staticpro (&Qunhandled_file_name_directory
);
6263 staticpro (&Qfile_name_as_directory
);
6264 staticpro (&Qcopy_file
);
6265 staticpro (&Qmake_directory_internal
);
6266 staticpro (&Qmake_directory
);
6267 staticpro (&Qdelete_directory
);
6268 staticpro (&Qdelete_file
);
6269 staticpro (&Qrename_file
);
6270 staticpro (&Qadd_name_to_file
);
6271 staticpro (&Qmake_symbolic_link
);
6272 staticpro (&Qfile_exists_p
);
6273 staticpro (&Qfile_executable_p
);
6274 staticpro (&Qfile_readable_p
);
6275 staticpro (&Qfile_writable_p
);
6276 staticpro (&Qaccess_file
);
6277 staticpro (&Qfile_symlink_p
);
6278 staticpro (&Qfile_directory_p
);
6279 staticpro (&Qfile_regular_p
);
6280 staticpro (&Qfile_accessible_directory_p
);
6281 staticpro (&Qfile_modes
);
6282 staticpro (&Qset_file_modes
);
6283 staticpro (&Qfile_newer_than_file_p
);
6284 staticpro (&Qinsert_file_contents
);
6285 staticpro (&Qwrite_region
);
6286 staticpro (&Qverify_visited_file_modtime
);
6287 staticpro (&Qset_visited_file_modtime
);
6289 Qfile_name_history
= intern ("file-name-history");
6290 Fset (Qfile_name_history
, Qnil
);
6291 staticpro (&Qfile_name_history
);
6293 Qfile_error
= intern ("file-error");
6294 staticpro (&Qfile_error
);
6295 Qfile_already_exists
= intern ("file-already-exists");
6296 staticpro (&Qfile_already_exists
);
6297 Qfile_date_error
= intern ("file-date-error");
6298 staticpro (&Qfile_date_error
);
6299 Qexcl
= intern ("excl");
6303 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6304 staticpro (&Qfind_buffer_file_type
);
6307 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6308 doc
: /* *Coding system for encoding file names.
6309 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6310 Vfile_name_coding_system
= Qnil
;
6312 DEFVAR_LISP ("default-file-name-coding-system",
6313 &Vdefault_file_name_coding_system
,
6314 doc
: /* Default coding system for encoding file names.
6315 This variable is used only when `file-name-coding-system' is nil.
6317 This variable is set/changed by the command `set-language-environment'.
6318 User should not set this variable manually,
6319 instead use `file-name-coding-system' to get a constant encoding
6320 of file names regardless of the current language environment. */);
6321 Vdefault_file_name_coding_system
= Qnil
;
6323 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6324 doc
: /* *Format in which to write auto-save files.
6325 Should be a list of symbols naming formats that are defined in `format-alist'.
6326 If it is t, which is the default, auto-save files are written in the
6327 same format as a regular save would use. */);
6328 Vauto_save_file_format
= Qt
;
6330 Qformat_decode
= intern ("format-decode");
6331 staticpro (&Qformat_decode
);
6332 Qformat_annotate_function
= intern ("format-annotate-function");
6333 staticpro (&Qformat_annotate_function
);
6335 Qcar_less_than_car
= intern ("car-less-than-car");
6336 staticpro (&Qcar_less_than_car
);
6338 Fput (Qfile_error
, Qerror_conditions
,
6339 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6340 Fput (Qfile_error
, Qerror_message
,
6341 build_string ("File error"));
6343 Fput (Qfile_already_exists
, Qerror_conditions
,
6344 Fcons (Qfile_already_exists
,
6345 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6346 Fput (Qfile_already_exists
, Qerror_message
,
6347 build_string ("File already exists"));
6349 Fput (Qfile_date_error
, Qerror_conditions
,
6350 Fcons (Qfile_date_error
,
6351 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6352 Fput (Qfile_date_error
, Qerror_message
,
6353 build_string ("Cannot set file date"));
6355 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6356 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6357 Vread_file_name_function
= Qnil
;
6359 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6360 doc
: /* Current predicate used by `read-file-name-internal'. */);
6361 Vread_file_name_predicate
= Qnil
;
6363 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6364 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer. */);
6365 insert_default_directory
= 1;
6367 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6368 doc
: /* *Non-nil means write new files with record format `stmlf'.
6369 nil means use format `var'. This variable is meaningful only on VMS. */);
6370 vms_stmlf_recfm
= 0;
6372 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6373 doc
: /* Directory separator character for built-in functions that return file names.
6374 The value is always ?/. Don't use this variable, just use `/'. */);
6376 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6377 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6378 If a file name matches REGEXP, then all I/O on that file is done by calling
6381 The first argument given to HANDLER is the name of the I/O primitive
6382 to be handled; the remaining arguments are the arguments that were
6383 passed to that primitive. For example, if you do
6384 (file-exists-p FILENAME)
6385 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6386 (funcall HANDLER 'file-exists-p FILENAME)
6387 The function `find-file-name-handler' checks this list for a handler
6388 for its argument. */);
6389 Vfile_name_handler_alist
= Qnil
;
6391 DEFVAR_LISP ("set-auto-coding-function",
6392 &Vset_auto_coding_function
,
6393 doc
: /* If non-nil, a function to call to decide a coding system of file.
6394 Two arguments are passed to this function: the file name
6395 and the length of a file contents following the point.
6396 This function should return a coding system to decode the file contents.
6397 It should check the file name against `auto-coding-alist'.
6398 If no coding system is decided, it should check a coding system
6399 specified in the heading lines with the format:
6400 -*- ... coding: CODING-SYSTEM; ... -*-
6401 or local variable spec of the tailing lines with `coding:' tag. */);
6402 Vset_auto_coding_function
= Qnil
;
6404 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6405 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6406 Each is passed one argument, the number of bytes inserted. It should return
6407 the new byte count, and leave point the same. If `insert-file-contents' is
6408 intercepted by a handler from `file-name-handler-alist', that handler is
6409 responsible for calling the after-insert-file-functions if appropriate. */);
6410 Vafter_insert_file_functions
= Qnil
;
6412 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6413 doc
: /* A list of functions to be called at the start of `write-region'.
6414 Each is passed two arguments, START and END as for `write-region'.
6415 These are usually two numbers but not always; see the documentation
6416 for `write-region'. The function should return a list of pairs
6417 of the form (POSITION . STRING), consisting of strings to be effectively
6418 inserted at the specified positions of the file being written (1 means to
6419 insert before the first byte written). The POSITIONs must be sorted into
6420 increasing order. If there are several functions in the list, the several
6421 lists are merged destructively. Alternatively, the function can return
6422 with a different buffer current and value nil.*/);
6423 Vwrite_region_annotate_functions
= Qnil
;
6425 DEFVAR_LISP ("write-region-annotations-so-far",
6426 &Vwrite_region_annotations_so_far
,
6427 doc
: /* When an annotation function is called, this holds the previous annotations.
6428 These are the annotations made by other annotation functions
6429 that were already called. See also `write-region-annotate-functions'. */);
6430 Vwrite_region_annotations_so_far
= Qnil
;
6432 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6433 doc
: /* A list of file name handlers that temporarily should not be used.
6434 This applies only to the operation `inhibit-file-name-operation'. */);
6435 Vinhibit_file_name_handlers
= Qnil
;
6437 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6438 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6439 Vinhibit_file_name_operation
= Qnil
;
6441 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6442 doc
: /* File name in which we write a list of all auto save file names.
6443 This variable is initialized automatically from `auto-save-list-file-prefix'
6444 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6445 a non-nil value. */);
6446 Vauto_save_list_file_name
= Qnil
;
6448 defsubr (&Sfind_file_name_handler
);
6449 defsubr (&Sfile_name_directory
);
6450 defsubr (&Sfile_name_nondirectory
);
6451 defsubr (&Sunhandled_file_name_directory
);
6452 defsubr (&Sfile_name_as_directory
);
6453 defsubr (&Sdirectory_file_name
);
6454 defsubr (&Smake_temp_name
);
6455 defsubr (&Sexpand_file_name
);
6456 defsubr (&Ssubstitute_in_file_name
);
6457 defsubr (&Scopy_file
);
6458 defsubr (&Smake_directory_internal
);
6459 defsubr (&Sdelete_directory
);
6460 defsubr (&Sdelete_file
);
6461 defsubr (&Srename_file
);
6462 defsubr (&Sadd_name_to_file
);
6464 defsubr (&Smake_symbolic_link
);
6465 #endif /* S_IFLNK */
6467 defsubr (&Sdefine_logical_name
);
6470 defsubr (&Ssysnetunam
);
6471 #endif /* HPUX_NET */
6472 defsubr (&Sfile_name_absolute_p
);
6473 defsubr (&Sfile_exists_p
);
6474 defsubr (&Sfile_executable_p
);
6475 defsubr (&Sfile_readable_p
);
6476 defsubr (&Sfile_writable_p
);
6477 defsubr (&Saccess_file
);
6478 defsubr (&Sfile_symlink_p
);
6479 defsubr (&Sfile_directory_p
);
6480 defsubr (&Sfile_accessible_directory_p
);
6481 defsubr (&Sfile_regular_p
);
6482 defsubr (&Sfile_modes
);
6483 defsubr (&Sset_file_modes
);
6484 defsubr (&Sset_default_file_modes
);
6485 defsubr (&Sdefault_file_modes
);
6486 defsubr (&Sfile_newer_than_file_p
);
6487 defsubr (&Sinsert_file_contents
);
6488 defsubr (&Swrite_region
);
6489 defsubr (&Scar_less_than_car
);
6490 defsubr (&Sverify_visited_file_modtime
);
6491 defsubr (&Sclear_visited_file_modtime
);
6492 defsubr (&Svisited_file_modtime
);
6493 defsubr (&Sset_visited_file_modtime
);
6494 defsubr (&Sdo_auto_save
);
6495 defsubr (&Sset_buffer_auto_saved
);
6496 defsubr (&Sclear_buffer_auto_save_failure
);
6497 defsubr (&Srecent_auto_save_p
);
6499 defsubr (&Sread_file_name_internal
);
6500 defsubr (&Sread_file_name
);
6503 defsubr (&Sunix_sync
);