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
, result
;
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 result
= make_specified_string (target
, -1, o
- target
,
1682 STRING_MULTIBYTE (name
));
1684 /* Again look to see if the file name has special constructs in it
1685 and perhaps call the corresponding file handler. This is needed
1686 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1687 the ".." component gives us "/user@host:/bar/../baz" which needs
1688 to be expanded again. */
1689 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1690 if (!NILP (handler
))
1691 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1697 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1698 This is the old version of expand-file-name, before it was thoroughly
1699 rewritten for Emacs 10.31. We leave this version here commented-out,
1700 because the code is very complex and likely to have subtle bugs. If
1701 bugs _are_ found, it might be of interest to look at the old code and
1702 see what did it do in the relevant situation.
1704 Don't remove this code: it's true that it will be accessible via CVS,
1705 but a few years from deletion, people will forget it is there. */
1707 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1708 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1709 "Convert FILENAME to absolute, and canonicalize it.\n\
1710 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1711 (does not start with slash); if DEFAULT is nil or missing,\n\
1712 the current buffer's value of default-directory is used.\n\
1713 Filenames containing `.' or `..' as components are simplified;\n\
1714 initial `~/' expands to your home directory.\n\
1715 See also the function `substitute-in-file-name'.")
1717 Lisp_Object name
, defalt
;
1721 register unsigned char *newdir
, *p
, *o
;
1723 unsigned char *target
;
1727 unsigned char * colon
= 0;
1728 unsigned char * close
= 0;
1729 unsigned char * slash
= 0;
1730 unsigned char * brack
= 0;
1731 int lbrack
= 0, rbrack
= 0;
1735 CHECK_STRING (name
);
1738 /* Filenames on VMS are always upper case. */
1739 name
= Fupcase (name
);
1744 /* If nm is absolute, flush ...// and detect /./ and /../.
1745 If no /./ or /../ we can return right away. */
1757 if (p
[0] == '/' && p
[1] == '/'
1759 /* // at start of filename is meaningful on Apollo system. */
1764 if (p
[0] == '/' && p
[1] == '~')
1765 nm
= p
+ 1, lose
= 1;
1766 if (p
[0] == '/' && p
[1] == '.'
1767 && (p
[2] == '/' || p
[2] == 0
1768 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1774 /* if dev:[dir]/, move nm to / */
1775 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1776 nm
= (brack
? brack
+ 1 : colon
+ 1);
1777 lbrack
= rbrack
= 0;
1785 /* VMS pre V4.4,convert '-'s in filenames. */
1786 if (lbrack
== rbrack
)
1788 if (dots
< 2) /* this is to allow negative version numbers */
1793 if (lbrack
> rbrack
&&
1794 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1795 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1801 /* count open brackets, reset close bracket pointer */
1802 if (p
[0] == '[' || p
[0] == '<')
1803 lbrack
++, brack
= 0;
1804 /* count close brackets, set close bracket pointer */
1805 if (p
[0] == ']' || p
[0] == '>')
1806 rbrack
++, brack
= p
;
1807 /* detect ][ or >< */
1808 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1810 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1811 nm
= p
+ 1, lose
= 1;
1812 if (p
[0] == ':' && (colon
|| slash
))
1813 /* if dev1:[dir]dev2:, move nm to dev2: */
1819 /* If /name/dev:, move nm to dev: */
1822 /* If node::dev:, move colon following dev */
1823 else if (colon
&& colon
[-1] == ':')
1825 /* If dev1:dev2:, move nm to dev2: */
1826 else if (colon
&& colon
[-1] != ':')
1831 if (p
[0] == ':' && !colon
)
1837 if (lbrack
== rbrack
)
1840 else if (p
[0] == '.')
1848 if (index (nm
, '/'))
1849 return build_string (sys_translate_unix (nm
));
1851 if (nm
== SDATA (name
))
1853 return build_string (nm
);
1857 /* Now determine directory to start with and put it in NEWDIR */
1861 if (nm
[0] == '~') /* prefix ~ */
1866 || nm
[1] == 0)/* ~/filename */
1868 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1869 newdir
= (unsigned char *) "";
1872 nm
++; /* Don't leave the slash in nm. */
1875 else /* ~user/filename */
1877 /* Get past ~ to user */
1878 unsigned char *user
= nm
+ 1;
1879 /* Find end of name. */
1880 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1881 int len
= ptr
? ptr
- user
: strlen (user
);
1883 unsigned char *ptr1
= index (user
, ':');
1884 if (ptr1
!= 0 && ptr1
- user
< len
)
1887 /* Copy the user name into temp storage. */
1888 o
= (unsigned char *) alloca (len
+ 1);
1889 bcopy ((char *) user
, o
, len
);
1892 /* Look up the user name. */
1893 pw
= (struct passwd
*) getpwnam (o
+ 1);
1895 error ("\"%s\" isn't a registered user", o
+ 1);
1897 newdir
= (unsigned char *) pw
->pw_dir
;
1899 /* Discard the user name from NM. */
1906 #endif /* not VMS */
1910 defalt
= current_buffer
->directory
;
1911 CHECK_STRING (defalt
);
1912 newdir
= SDATA (defalt
);
1915 /* Now concatenate the directory and name to new space in the stack frame */
1917 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1918 target
= (unsigned char *) alloca (tlen
);
1924 if (nm
[0] == 0 || nm
[0] == '/')
1925 strcpy (target
, newdir
);
1928 file_name_as_directory (target
, newdir
);
1931 strcat (target
, nm
);
1933 if (index (target
, '/'))
1934 strcpy (target
, sys_translate_unix (target
));
1937 /* Now canonicalize by removing /. and /foo/.. if they appear */
1945 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1951 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1952 /* brackets are offset from each other by 2 */
1955 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1956 /* convert [foo][bar] to [bar] */
1957 while (o
[-1] != '[' && o
[-1] != '<')
1959 else if (*p
== '-' && *o
!= '.')
1962 else if (p
[0] == '-' && o
[-1] == '.' &&
1963 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1964 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1968 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1969 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1971 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1973 /* else [foo.-] ==> [-] */
1979 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1980 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1990 else if (!strncmp (p
, "//", 2)
1992 /* // at start of filename is meaningful in Apollo system. */
2000 else if (p
[0] == '/' && p
[1] == '.' &&
2001 (p
[2] == '/' || p
[2] == 0))
2003 else if (!strncmp (p
, "/..", 3)
2004 /* `/../' is the "superroot" on certain file systems. */
2006 && (p
[3] == '/' || p
[3] == 0))
2008 while (o
!= target
&& *--o
!= '/')
2011 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2015 if (o
== target
&& *o
== '/')
2023 #endif /* not VMS */
2026 return make_string (target
, o
- target
);
2030 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2031 Ssubstitute_in_file_name
, 1, 1, 0,
2032 doc
: /* Substitute environment variables referred to in FILENAME.
2033 `$FOO' where FOO is an environment variable name means to substitute
2034 the value of that variable. The variable name should be terminated
2035 with a character not a letter, digit or underscore; otherwise, enclose
2036 the entire variable name in braces.
2037 If `/~' appears, all of FILENAME through that `/' is discarded.
2039 On VMS, `$' substitution is not done; this function does little and only
2040 duplicates what `expand-file-name' does. */)
2042 Lisp_Object filename
;
2046 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2047 unsigned char *target
= NULL
;
2049 int substituted
= 0;
2052 Lisp_Object handler
;
2054 CHECK_STRING (filename
);
2056 /* If the file name has special constructs in it,
2057 call the corresponding file handler. */
2058 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2059 if (!NILP (handler
))
2060 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2062 nm
= SDATA (filename
);
2064 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2065 CORRECT_DIR_SEPS (nm
);
2066 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2068 endp
= nm
+ SBYTES (filename
);
2070 /* If /~ or // appears, discard everything through first slash. */
2072 for (p
= nm
; p
!= endp
; p
++)
2075 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2076 /* // at start of file name is meaningful in Apollo,
2077 WindowsNT and Cygwin systems. */
2078 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2079 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2080 || IS_DIRECTORY_SEP (p
[0])
2081 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2086 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2088 || IS_DIRECTORY_SEP (p
[-1])))
2090 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2095 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2097 o
= (unsigned char *) alloca (s
- p
+ 1);
2098 bcopy ((char *) p
, o
, s
- p
);
2101 pw
= (struct passwd
*) getpwnam (o
+ 1);
2103 /* If we have ~/ or ~user and `user' exists, discard
2104 everything up to ~. But if `user' does not exist, leave
2105 ~user alone, it might be a literal file name. */
2106 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2113 /* see comment in expand-file-name about drive specifiers */
2114 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2115 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2124 return make_specified_string (nm
, -1, strlen (nm
),
2125 STRING_MULTIBYTE (filename
));
2128 /* See if any variables are substituted into the string
2129 and find the total length of their values in `total' */
2131 for (p
= nm
; p
!= endp
;)
2141 /* "$$" means a single "$" */
2150 while (p
!= endp
&& *p
!= '}') p
++;
2151 if (*p
!= '}') goto missingclose
;
2157 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2161 /* Copy out the variable name */
2162 target
= (unsigned char *) alloca (s
- o
+ 1);
2163 strncpy (target
, o
, s
- o
);
2166 strupr (target
); /* $home == $HOME etc. */
2169 /* Get variable value */
2170 o
= (unsigned char *) egetenv (target
);
2173 total
+= strlen (o
);
2183 /* If substitution required, recopy the string and do it */
2184 /* Make space in stack frame for the new copy */
2185 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2188 /* Copy the rest of the name through, replacing $ constructs with values */
2205 while (p
!= endp
&& *p
!= '}') p
++;
2206 if (*p
!= '}') goto missingclose
;
2212 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2216 /* Copy out the variable name */
2217 target
= (unsigned char *) alloca (s
- o
+ 1);
2218 strncpy (target
, o
, s
- o
);
2221 strupr (target
); /* $home == $HOME etc. */
2224 /* Get variable value */
2225 o
= (unsigned char *) egetenv (target
);
2229 strcpy (x
, target
); x
+= strlen (target
);
2231 else if (STRING_MULTIBYTE (filename
))
2233 /* If the original string is multibyte,
2234 convert what we substitute into multibyte. */
2237 int c
= unibyte_char_to_multibyte (*o
++);
2238 x
+= CHAR_STRING (c
, x
);
2250 /* If /~ or // appears, discard everything through first slash. */
2252 for (p
= xnm
; p
!= x
; p
++)
2254 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2255 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2256 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2257 || IS_DIRECTORY_SEP (p
[0])
2258 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2260 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2263 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2264 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2268 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2271 error ("Bad format environment-variable substitution");
2273 error ("Missing \"}\" in environment-variable substitution");
2275 error ("Substituting nonexistent environment variable \"%s\"", target
);
2278 #endif /* not VMS */
2282 /* A slightly faster and more convenient way to get
2283 (directory-file-name (expand-file-name FOO)). */
2286 expand_and_dir_to_file (filename
, defdir
)
2287 Lisp_Object filename
, defdir
;
2289 register Lisp_Object absname
;
2291 absname
= Fexpand_file_name (filename
, defdir
);
2294 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2295 if (c
== ':' || c
== ']' || c
== '>')
2296 absname
= Fdirectory_file_name (absname
);
2299 /* Remove final slash, if any (unless this is the root dir).
2300 stat behaves differently depending! */
2301 if (SCHARS (absname
) > 1
2302 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2303 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2304 /* We cannot take shortcuts; they might be wrong for magic file names. */
2305 absname
= Fdirectory_file_name (absname
);
2310 /* Signal an error if the file ABSNAME already exists.
2311 If INTERACTIVE is nonzero, ask the user whether to proceed,
2312 and bypass the error if the user says to go ahead.
2313 QUERYSTRING is a name for the action that is being considered
2316 *STATPTR is used to store the stat information if the file exists.
2317 If the file does not exist, STATPTR->st_mode is set to 0.
2318 If STATPTR is null, we don't store into it.
2320 If QUICK is nonzero, we ask for y or n, not yes or no. */
2323 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2324 Lisp_Object absname
;
2325 unsigned char *querystring
;
2327 struct stat
*statptr
;
2330 register Lisp_Object tem
, encoded_filename
;
2331 struct stat statbuf
;
2332 struct gcpro gcpro1
;
2334 encoded_filename
= ENCODE_FILE (absname
);
2336 /* stat is a good way to tell whether the file exists,
2337 regardless of what access permissions it has. */
2338 if (stat (SDATA (encoded_filename
), &statbuf
) >= 0)
2341 Fsignal (Qfile_already_exists
,
2342 Fcons (build_string ("File already exists"),
2343 Fcons (absname
, Qnil
)));
2345 tem
= format2 ("File %s already exists; %s anyway? ",
2346 absname
, build_string (querystring
));
2348 tem
= Fy_or_n_p (tem
);
2350 tem
= do_yes_or_no_p (tem
);
2353 Fsignal (Qfile_already_exists
,
2354 Fcons (build_string ("File already exists"),
2355 Fcons (absname
, Qnil
)));
2362 statptr
->st_mode
= 0;
2367 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2368 "fCopy file: \nFCopy %s to file: \np\nP",
2369 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2370 If NEWNAME names a directory, copy FILE there.
2371 Signals a `file-already-exists' error if file NEWNAME already exists,
2372 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2373 A number as third arg means request confirmation if NEWNAME already exists.
2374 This is what happens in interactive use with M-x.
2375 Fourth arg KEEP-TIME non-nil means give the new file the same
2376 last-modified time as the old one. (This works on only some systems.)
2377 A prefix arg makes KEEP-TIME non-nil. */)
2378 (file
, newname
, ok_if_already_exists
, keep_time
)
2379 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2382 char buf
[16 * 1024];
2383 struct stat st
, out_st
;
2384 Lisp_Object handler
;
2385 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2386 int count
= SPECPDL_INDEX ();
2387 int input_file_statable_p
;
2388 Lisp_Object encoded_file
, encoded_newname
;
2390 encoded_file
= encoded_newname
= Qnil
;
2391 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2392 CHECK_STRING (file
);
2393 CHECK_STRING (newname
);
2395 if (!NILP (Ffile_directory_p (newname
)))
2396 newname
= Fexpand_file_name (file
, newname
);
2398 newname
= Fexpand_file_name (newname
, Qnil
);
2400 file
= Fexpand_file_name (file
, Qnil
);
2402 /* If the input file name has special constructs in it,
2403 call the corresponding file handler. */
2404 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2405 /* Likewise for output file name. */
2407 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2408 if (!NILP (handler
))
2409 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2410 ok_if_already_exists
, keep_time
));
2412 encoded_file
= ENCODE_FILE (file
);
2413 encoded_newname
= ENCODE_FILE (newname
);
2415 if (NILP (ok_if_already_exists
)
2416 || INTEGERP (ok_if_already_exists
))
2417 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2418 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2419 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2423 if (!CopyFile (SDATA (encoded_file
),
2424 SDATA (encoded_newname
),
2426 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2427 /* CopyFile retains the timestamp by default. */
2428 else if (NILP (keep_time
))
2434 EMACS_GET_TIME (now
);
2435 filename
= SDATA (encoded_newname
);
2437 /* Ensure file is writable while its modified time is set. */
2438 attributes
= GetFileAttributes (filename
);
2439 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2440 if (set_file_times (filename
, now
, now
))
2442 /* Restore original attributes. */
2443 SetFileAttributes (filename
, attributes
);
2444 Fsignal (Qfile_date_error
,
2445 Fcons (build_string ("Cannot set file date"),
2446 Fcons (newname
, Qnil
)));
2448 /* Restore original attributes. */
2449 SetFileAttributes (filename
, attributes
);
2451 #else /* not WINDOWSNT */
2453 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2457 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2459 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2461 /* We can only copy regular files and symbolic links. Other files are not
2463 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2465 #if !defined (DOS_NT) || __DJGPP__ > 1
2466 if (out_st
.st_mode
!= 0
2467 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2470 report_file_error ("Input and output files are the same",
2471 Fcons (file
, Fcons (newname
, Qnil
)));
2475 #if defined (S_ISREG) && defined (S_ISLNK)
2476 if (input_file_statable_p
)
2478 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2480 #if defined (EISDIR)
2481 /* Get a better looking error message. */
2484 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2487 #endif /* S_ISREG && S_ISLNK */
2490 /* Create the copy file with the same record format as the input file */
2491 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2494 /* System's default file type was set to binary by _fmode in emacs.c. */
2495 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2496 #else /* not MSDOS */
2497 ofd
= creat (SDATA (encoded_newname
), 0666);
2498 #endif /* not MSDOS */
2501 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2503 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2507 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2508 if (emacs_write (ofd
, buf
, n
) != n
)
2509 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2512 /* Closing the output clobbers the file times on some systems. */
2513 if (emacs_close (ofd
) < 0)
2514 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2516 if (input_file_statable_p
)
2518 if (!NILP (keep_time
))
2520 EMACS_TIME atime
, mtime
;
2521 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2522 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2523 if (set_file_times (SDATA (encoded_newname
),
2525 Fsignal (Qfile_date_error
,
2526 Fcons (build_string ("Cannot set file date"),
2527 Fcons (newname
, Qnil
)));
2530 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2532 #if defined (__DJGPP__) && __DJGPP__ > 1
2533 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2534 and if it can't, it tells so. Otherwise, under MSDOS we usually
2535 get only the READ bit, which will make the copied file read-only,
2536 so it's better not to chmod at all. */
2537 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2538 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2539 #endif /* DJGPP version 2 or newer */
2544 #endif /* WINDOWSNT */
2546 /* Discard the unwind protects. */
2547 specpdl_ptr
= specpdl
+ count
;
2553 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2554 Smake_directory_internal
, 1, 1, 0,
2555 doc
: /* Create a new directory named DIRECTORY. */)
2557 Lisp_Object directory
;
2559 const unsigned char *dir
;
2560 Lisp_Object handler
;
2561 Lisp_Object encoded_dir
;
2563 CHECK_STRING (directory
);
2564 directory
= Fexpand_file_name (directory
, Qnil
);
2566 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2567 if (!NILP (handler
))
2568 return call2 (handler
, Qmake_directory_internal
, directory
);
2570 encoded_dir
= ENCODE_FILE (directory
);
2572 dir
= SDATA (encoded_dir
);
2575 if (mkdir (dir
) != 0)
2577 if (mkdir (dir
, 0777) != 0)
2579 report_file_error ("Creating directory", Flist (1, &directory
));
2584 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2585 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2587 Lisp_Object directory
;
2589 const unsigned char *dir
;
2590 Lisp_Object handler
;
2591 Lisp_Object encoded_dir
;
2593 CHECK_STRING (directory
);
2594 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2596 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2597 if (!NILP (handler
))
2598 return call2 (handler
, Qdelete_directory
, directory
);
2600 encoded_dir
= ENCODE_FILE (directory
);
2602 dir
= SDATA (encoded_dir
);
2604 if (rmdir (dir
) != 0)
2605 report_file_error ("Removing directory", Flist (1, &directory
));
2610 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2611 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2612 If file has multiple names, it continues to exist with the other names. */)
2614 Lisp_Object filename
;
2616 Lisp_Object handler
;
2617 Lisp_Object encoded_file
;
2618 struct gcpro gcpro1
;
2621 if (!NILP (Ffile_directory_p (filename
)))
2622 Fsignal (Qfile_error
,
2623 Fcons (build_string ("Removing old name: is a directory"),
2624 Fcons (filename
, Qnil
)));
2626 filename
= Fexpand_file_name (filename
, Qnil
);
2628 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2629 if (!NILP (handler
))
2630 return call2 (handler
, Qdelete_file
, filename
);
2632 encoded_file
= ENCODE_FILE (filename
);
2634 if (0 > unlink (SDATA (encoded_file
)))
2635 report_file_error ("Removing old name", Flist (1, &filename
));
2640 internal_delete_file_1 (ignore
)
2646 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2649 internal_delete_file (filename
)
2650 Lisp_Object filename
;
2652 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2653 Qt
, internal_delete_file_1
));
2656 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2657 "fRename file: \nFRename %s to file: \np",
2658 doc
: /* Rename FILE as NEWNAME. Both args strings.
2659 If file has names other than FILE, it continues to have those names.
2660 Signals a `file-already-exists' error if a file NEWNAME already exists
2661 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2662 A number as third arg means request confirmation if NEWNAME already exists.
2663 This is what happens in interactive use with M-x. */)
2664 (file
, newname
, ok_if_already_exists
)
2665 Lisp_Object file
, newname
, ok_if_already_exists
;
2668 Lisp_Object args
[2];
2670 Lisp_Object handler
;
2671 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2672 Lisp_Object encoded_file
, encoded_newname
;
2674 encoded_file
= encoded_newname
= Qnil
;
2675 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2676 CHECK_STRING (file
);
2677 CHECK_STRING (newname
);
2678 file
= Fexpand_file_name (file
, Qnil
);
2679 newname
= Fexpand_file_name (newname
, Qnil
);
2681 /* If the file name has special constructs in it,
2682 call the corresponding file handler. */
2683 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2685 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2686 if (!NILP (handler
))
2687 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2688 file
, newname
, ok_if_already_exists
));
2690 encoded_file
= ENCODE_FILE (file
);
2691 encoded_newname
= ENCODE_FILE (newname
);
2694 /* If the file names are identical but for the case, don't ask for
2695 confirmation: they simply want to change the letter-case of the
2697 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2699 if (NILP (ok_if_already_exists
)
2700 || INTEGERP (ok_if_already_exists
))
2701 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2702 INTEGERP (ok_if_already_exists
), 0, 0);
2704 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2706 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2707 || 0 > unlink (SDATA (encoded_file
)))
2712 Fcopy_file (file
, newname
,
2713 /* We have already prompted if it was an integer,
2714 so don't have copy-file prompt again. */
2715 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2716 Fdelete_file (file
);
2723 report_file_error ("Renaming", Flist (2, args
));
2726 report_file_error ("Renaming", Flist (2, &file
));
2733 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2734 "fAdd name to file: \nFName to add to %s: \np",
2735 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2736 Signals a `file-already-exists' error if a file NEWNAME already exists
2737 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2738 A number as third arg means request confirmation if NEWNAME already exists.
2739 This is what happens in interactive use with M-x. */)
2740 (file
, newname
, ok_if_already_exists
)
2741 Lisp_Object file
, newname
, ok_if_already_exists
;
2744 Lisp_Object args
[2];
2746 Lisp_Object handler
;
2747 Lisp_Object encoded_file
, encoded_newname
;
2748 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2750 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2751 encoded_file
= encoded_newname
= Qnil
;
2752 CHECK_STRING (file
);
2753 CHECK_STRING (newname
);
2754 file
= Fexpand_file_name (file
, Qnil
);
2755 newname
= Fexpand_file_name (newname
, Qnil
);
2757 /* If the file name has special constructs in it,
2758 call the corresponding file handler. */
2759 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2760 if (!NILP (handler
))
2761 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2762 newname
, ok_if_already_exists
));
2764 /* If the new name has special constructs in it,
2765 call the corresponding file handler. */
2766 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2767 if (!NILP (handler
))
2768 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2769 newname
, ok_if_already_exists
));
2771 encoded_file
= ENCODE_FILE (file
);
2772 encoded_newname
= ENCODE_FILE (newname
);
2774 if (NILP (ok_if_already_exists
)
2775 || INTEGERP (ok_if_already_exists
))
2776 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2777 INTEGERP (ok_if_already_exists
), 0, 0);
2779 unlink (SDATA (newname
));
2780 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2785 report_file_error ("Adding new name", Flist (2, args
));
2787 report_file_error ("Adding new name", Flist (2, &file
));
2796 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2797 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2798 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2799 Signals a `file-already-exists' error if a file LINKNAME already exists
2800 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2801 A number as third arg means request confirmation if LINKNAME already exists.
2802 This happens for interactive use with M-x. */)
2803 (filename
, linkname
, ok_if_already_exists
)
2804 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2807 Lisp_Object args
[2];
2809 Lisp_Object handler
;
2810 Lisp_Object encoded_filename
, encoded_linkname
;
2811 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2813 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2814 encoded_filename
= encoded_linkname
= Qnil
;
2815 CHECK_STRING (filename
);
2816 CHECK_STRING (linkname
);
2817 /* If the link target has a ~, we must expand it to get
2818 a truly valid file name. Otherwise, do not expand;
2819 we want to permit links to relative file names. */
2820 if (SREF (filename
, 0) == '~')
2821 filename
= Fexpand_file_name (filename
, Qnil
);
2822 linkname
= Fexpand_file_name (linkname
, Qnil
);
2824 /* If the file name has special constructs in it,
2825 call the corresponding file handler. */
2826 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2827 if (!NILP (handler
))
2828 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2829 linkname
, ok_if_already_exists
));
2831 /* If the new link name has special constructs in it,
2832 call the corresponding file handler. */
2833 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2834 if (!NILP (handler
))
2835 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2836 linkname
, ok_if_already_exists
));
2838 encoded_filename
= ENCODE_FILE (filename
);
2839 encoded_linkname
= ENCODE_FILE (linkname
);
2841 if (NILP (ok_if_already_exists
)
2842 || INTEGERP (ok_if_already_exists
))
2843 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2844 INTEGERP (ok_if_already_exists
), 0, 0);
2845 if (0 > symlink (SDATA (encoded_filename
),
2846 SDATA (encoded_linkname
)))
2848 /* If we didn't complain already, silently delete existing file. */
2849 if (errno
== EEXIST
)
2851 unlink (SDATA (encoded_linkname
));
2852 if (0 <= symlink (SDATA (encoded_filename
),
2853 SDATA (encoded_linkname
)))
2863 report_file_error ("Making symbolic link", Flist (2, args
));
2865 report_file_error ("Making symbolic link", Flist (2, &filename
));
2871 #endif /* S_IFLNK */
2875 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2876 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2877 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2878 If STRING is nil or a null string, the logical name NAME is deleted. */)
2883 CHECK_STRING (name
);
2885 delete_logical_name (SDATA (name
));
2888 CHECK_STRING (string
);
2890 if (SCHARS (string
) == 0)
2891 delete_logical_name (SDATA (name
));
2893 define_logical_name (SDATA (name
), SDATA (string
));
2902 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2903 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2905 Lisp_Object path
, login
;
2909 CHECK_STRING (path
);
2910 CHECK_STRING (login
);
2912 netresult
= netunam (SDATA (path
), SDATA (login
));
2914 if (netresult
== -1)
2919 #endif /* HPUX_NET */
2921 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2923 doc
: /* Return t if file FILENAME specifies an absolute file name.
2924 On Unix, this is a name starting with a `/' or a `~'. */)
2926 Lisp_Object filename
;
2928 const unsigned char *ptr
;
2930 CHECK_STRING (filename
);
2931 ptr
= SDATA (filename
);
2932 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2934 /* ??? This criterion is probably wrong for '<'. */
2935 || index (ptr
, ':') || index (ptr
, '<')
2936 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2940 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2948 /* Return nonzero if file FILENAME exists and can be executed. */
2951 check_executable (filename
)
2955 int len
= strlen (filename
);
2958 if (stat (filename
, &st
) < 0)
2960 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2961 return ((st
.st_mode
& S_IEXEC
) != 0);
2963 return (S_ISREG (st
.st_mode
)
2965 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2966 || stricmp (suffix
, ".exe") == 0
2967 || stricmp (suffix
, ".bat") == 0)
2968 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2969 #endif /* not WINDOWSNT */
2970 #else /* not DOS_NT */
2971 #ifdef HAVE_EUIDACCESS
2972 return (euidaccess (filename
, 1) >= 0);
2974 /* Access isn't quite right because it uses the real uid
2975 and we really want to test with the effective uid.
2976 But Unix doesn't give us a right way to do it. */
2977 return (access (filename
, 1) >= 0);
2979 #endif /* not DOS_NT */
2982 /* Return nonzero if file FILENAME exists and can be written. */
2985 check_writable (filename
)
2990 if (stat (filename
, &st
) < 0)
2992 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2993 #else /* not MSDOS */
2994 #ifdef HAVE_EUIDACCESS
2995 return (euidaccess (filename
, 2) >= 0);
2997 /* Access isn't quite right because it uses the real uid
2998 and we really want to test with the effective uid.
2999 But Unix doesn't give us a right way to do it.
3000 Opening with O_WRONLY could work for an ordinary file,
3001 but would lose for directories. */
3002 return (access (filename
, 2) >= 0);
3004 #endif /* not MSDOS */
3007 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3008 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3009 See also `file-readable-p' and `file-attributes'. */)
3011 Lisp_Object filename
;
3013 Lisp_Object absname
;
3014 Lisp_Object handler
;
3015 struct stat statbuf
;
3017 CHECK_STRING (filename
);
3018 absname
= Fexpand_file_name (filename
, Qnil
);
3020 /* If the file name has special constructs in it,
3021 call the corresponding file handler. */
3022 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3023 if (!NILP (handler
))
3024 return call2 (handler
, Qfile_exists_p
, absname
);
3026 absname
= ENCODE_FILE (absname
);
3028 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3031 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3032 doc
: /* Return t if FILENAME can be executed by you.
3033 For a directory, this means you can access files in that directory. */)
3035 Lisp_Object filename
;
3037 Lisp_Object absname
;
3038 Lisp_Object handler
;
3040 CHECK_STRING (filename
);
3041 absname
= Fexpand_file_name (filename
, Qnil
);
3043 /* If the file name has special constructs in it,
3044 call the corresponding file handler. */
3045 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3046 if (!NILP (handler
))
3047 return call2 (handler
, Qfile_executable_p
, absname
);
3049 absname
= ENCODE_FILE (absname
);
3051 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3054 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3055 doc
: /* Return t if file FILENAME exists and you can read it.
3056 See also `file-exists-p' and `file-attributes'. */)
3058 Lisp_Object filename
;
3060 Lisp_Object absname
;
3061 Lisp_Object handler
;
3064 struct stat statbuf
;
3066 CHECK_STRING (filename
);
3067 absname
= Fexpand_file_name (filename
, Qnil
);
3069 /* If the file name has special constructs in it,
3070 call the corresponding file handler. */
3071 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3072 if (!NILP (handler
))
3073 return call2 (handler
, Qfile_readable_p
, absname
);
3075 absname
= ENCODE_FILE (absname
);
3077 #if defined(DOS_NT) || defined(macintosh)
3078 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3080 if (access (SDATA (absname
), 0) == 0)
3083 #else /* not DOS_NT and not macintosh */
3085 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3086 /* Opening a fifo without O_NONBLOCK can wait.
3087 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3088 except in the case of a fifo, on a system which handles it. */
3089 desc
= stat (SDATA (absname
), &statbuf
);
3092 if (S_ISFIFO (statbuf
.st_mode
))
3093 flags
|= O_NONBLOCK
;
3095 desc
= emacs_open (SDATA (absname
), flags
, 0);
3100 #endif /* not DOS_NT and not macintosh */
3103 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3105 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3106 doc
: /* Return t if file FILENAME can be written or created by you. */)
3108 Lisp_Object filename
;
3110 Lisp_Object absname
, dir
, encoded
;
3111 Lisp_Object handler
;
3112 struct stat statbuf
;
3114 CHECK_STRING (filename
);
3115 absname
= Fexpand_file_name (filename
, Qnil
);
3117 /* If the file name has special constructs in it,
3118 call the corresponding file handler. */
3119 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3120 if (!NILP (handler
))
3121 return call2 (handler
, Qfile_writable_p
, absname
);
3123 encoded
= ENCODE_FILE (absname
);
3124 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3125 return (check_writable (SDATA (encoded
))
3128 dir
= Ffile_name_directory (absname
);
3131 dir
= Fdirectory_file_name (dir
);
3135 dir
= Fdirectory_file_name (dir
);
3138 dir
= ENCODE_FILE (dir
);
3140 /* The read-only attribute of the parent directory doesn't affect
3141 whether a file or directory can be created within it. Some day we
3142 should check ACLs though, which do affect this. */
3143 if (stat (SDATA (dir
), &statbuf
) < 0)
3145 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3147 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3152 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3153 doc
: /* Access file FILENAME, and get an error if that does not work.
3154 The second argument STRING is used in the error message.
3155 If there is no error, we return nil. */)
3157 Lisp_Object filename
, string
;
3159 Lisp_Object handler
, encoded_filename
, absname
;
3162 CHECK_STRING (filename
);
3163 absname
= Fexpand_file_name (filename
, Qnil
);
3165 CHECK_STRING (string
);
3167 /* If the file name has special constructs in it,
3168 call the corresponding file handler. */
3169 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3170 if (!NILP (handler
))
3171 return call3 (handler
, Qaccess_file
, absname
, string
);
3173 encoded_filename
= ENCODE_FILE (absname
);
3175 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3177 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3183 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3184 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3185 The value is the link target, as a string.
3186 Otherwise returns nil. */)
3188 Lisp_Object filename
;
3195 Lisp_Object handler
;
3197 CHECK_STRING (filename
);
3198 filename
= Fexpand_file_name (filename
, Qnil
);
3200 /* If the file name has special constructs in it,
3201 call the corresponding file handler. */
3202 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3203 if (!NILP (handler
))
3204 return call2 (handler
, Qfile_symlink_p
, filename
);
3206 filename
= ENCODE_FILE (filename
);
3213 buf
= (char *) xrealloc (buf
, bufsize
);
3214 bzero (buf
, bufsize
);
3217 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3221 /* HP-UX reports ERANGE if buffer is too small. */
3222 if (errno
== ERANGE
)
3232 while (valsize
>= bufsize
);
3234 val
= make_string (buf
, valsize
);
3235 if (buf
[0] == '/' && index (buf
, ':'))
3236 val
= concat2 (build_string ("/:"), val
);
3238 val
= DECODE_FILE (val
);
3240 #else /* not S_IFLNK */
3242 #endif /* not S_IFLNK */
3245 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3246 doc
: /* Return t if FILENAME names an existing directory.
3247 Symbolic links to directories count as directories.
3248 See `file-symlink-p' to distinguish symlinks. */)
3250 Lisp_Object filename
;
3252 register Lisp_Object absname
;
3254 Lisp_Object handler
;
3256 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3258 /* If the file name has special constructs in it,
3259 call the corresponding file handler. */
3260 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3261 if (!NILP (handler
))
3262 return call2 (handler
, Qfile_directory_p
, absname
);
3264 absname
= ENCODE_FILE (absname
);
3266 if (stat (SDATA (absname
), &st
) < 0)
3268 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3271 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3272 doc
: /* Return t if file FILENAME names a directory you can open.
3273 For the value to be t, FILENAME must specify the name of a directory as a file,
3274 and the directory must allow you to open files in it. In order to use a
3275 directory as a buffer's current directory, this predicate must return true.
3276 A directory name spec may be given instead; then the value is t
3277 if the directory so specified exists and really is a readable and
3278 searchable directory. */)
3280 Lisp_Object filename
;
3282 Lisp_Object handler
;
3284 struct gcpro gcpro1
;
3286 /* If the file name has special constructs in it,
3287 call the corresponding file handler. */
3288 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3289 if (!NILP (handler
))
3290 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3293 tem
= (NILP (Ffile_directory_p (filename
))
3294 || NILP (Ffile_executable_p (filename
)));
3296 return tem
? Qnil
: Qt
;
3299 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3300 doc
: /* Return t if file FILENAME is the name of a regular file.
3301 This is the sort of file that holds an ordinary stream of data bytes. */)
3303 Lisp_Object filename
;
3305 register Lisp_Object absname
;
3307 Lisp_Object handler
;
3309 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3311 /* If the file name has special constructs in it,
3312 call the corresponding file handler. */
3313 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3314 if (!NILP (handler
))
3315 return call2 (handler
, Qfile_regular_p
, absname
);
3317 absname
= ENCODE_FILE (absname
);
3322 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3324 /* Tell stat to use expensive method to get accurate info. */
3325 Vw32_get_true_file_attributes
= Qt
;
3326 result
= stat (SDATA (absname
), &st
);
3327 Vw32_get_true_file_attributes
= tem
;
3331 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3334 if (stat (SDATA (absname
), &st
) < 0)
3336 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3340 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3341 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
3343 Lisp_Object filename
;
3345 Lisp_Object absname
;
3347 Lisp_Object handler
;
3349 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3351 /* If the file name has special constructs in it,
3352 call the corresponding file handler. */
3353 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3354 if (!NILP (handler
))
3355 return call2 (handler
, Qfile_modes
, absname
);
3357 absname
= ENCODE_FILE (absname
);
3359 if (stat (SDATA (absname
), &st
) < 0)
3361 #if defined (MSDOS) && __DJGPP__ < 2
3362 if (check_executable (SDATA (absname
)))
3363 st
.st_mode
|= S_IEXEC
;
3364 #endif /* MSDOS && __DJGPP__ < 2 */
3366 return make_number (st
.st_mode
& 07777);
3369 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3370 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3371 Only the 12 low bits of MODE are used. */)
3373 Lisp_Object filename
, mode
;
3375 Lisp_Object absname
, encoded_absname
;
3376 Lisp_Object handler
;
3378 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3379 CHECK_NUMBER (mode
);
3381 /* If the file name has special constructs in it,
3382 call the corresponding file handler. */
3383 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3384 if (!NILP (handler
))
3385 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3387 encoded_absname
= ENCODE_FILE (absname
);
3389 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3390 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3395 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3396 doc
: /* Set the file permission bits for newly created files.
3397 The argument MODE should be an integer; only the low 9 bits are used.
3398 This setting is inherited by subprocesses. */)
3402 CHECK_NUMBER (mode
);
3404 umask ((~ XINT (mode
)) & 0777);
3409 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3410 doc
: /* Return the default file protection for created files.
3411 The value is an integer. */)
3417 realmask
= umask (0);
3420 XSETINT (value
, (~ realmask
) & 0777);
3430 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3431 doc
: /* Tell Unix to finish all pending disk updates. */)
3440 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3441 doc
: /* Return t if file FILE1 is newer than file FILE2.
3442 If FILE1 does not exist, the answer is nil;
3443 otherwise, if FILE2 does not exist, the answer is t. */)
3445 Lisp_Object file1
, file2
;
3447 Lisp_Object absname1
, absname2
;
3450 Lisp_Object handler
;
3451 struct gcpro gcpro1
, gcpro2
;
3453 CHECK_STRING (file1
);
3454 CHECK_STRING (file2
);
3457 GCPRO2 (absname1
, file2
);
3458 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3459 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3462 /* If the file name has special constructs in it,
3463 call the corresponding file handler. */
3464 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3466 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3467 if (!NILP (handler
))
3468 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3470 GCPRO2 (absname1
, absname2
);
3471 absname1
= ENCODE_FILE (absname1
);
3472 absname2
= ENCODE_FILE (absname2
);
3475 if (stat (SDATA (absname1
), &st
) < 0)
3478 mtime1
= st
.st_mtime
;
3480 if (stat (SDATA (absname2
), &st
) < 0)
3483 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3487 Lisp_Object Qfind_buffer_file_type
;
3490 #ifndef READ_BUF_SIZE
3491 #define READ_BUF_SIZE (64 << 10)
3494 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3496 /* This function is called after Lisp functions to decide a coding
3497 system are called, or when they cause an error. Before they are
3498 called, the current buffer is set unibyte and it contains only a
3499 newly inserted text (thus the buffer was empty before the
3502 The functions may set markers, overlays, text properties, or even
3503 alter the buffer contents, change the current buffer.
3505 Here, we reset all those changes by:
3506 o set back the current buffer.
3507 o move all markers and overlays to BEG.
3508 o remove all text properties.
3509 o set back the buffer multibyteness. */
3512 decide_coding_unwind (unwind_data
)
3513 Lisp_Object unwind_data
;
3515 Lisp_Object multibyte
, undo_list
, buffer
;
3517 multibyte
= XCAR (unwind_data
);
3518 unwind_data
= XCDR (unwind_data
);
3519 undo_list
= XCAR (unwind_data
);
3520 buffer
= XCDR (unwind_data
);
3522 if (current_buffer
!= XBUFFER (buffer
))
3523 set_buffer_internal (XBUFFER (buffer
));
3524 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3525 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3526 BUF_INTERVALS (current_buffer
) = 0;
3527 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3529 /* Now we are safe to change the buffer's multibyteness directly. */
3530 current_buffer
->enable_multibyte_characters
= multibyte
;
3531 current_buffer
->undo_list
= undo_list
;
3537 /* Used to pass values from insert-file-contents to read_non_regular. */
3539 static int non_regular_fd
;
3540 static int non_regular_inserted
;
3541 static int non_regular_nbytes
;
3544 /* Read from a non-regular file.
3545 Read non_regular_trytry bytes max from non_regular_fd.
3546 Non_regular_inserted specifies where to put the read bytes.
3547 Value is the number of bytes read. */
3556 nbytes
= emacs_read (non_regular_fd
,
3557 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3558 non_regular_nbytes
);
3560 return make_number (nbytes
);
3564 /* Condition-case handler used when reading from non-regular files
3565 in insert-file-contents. */
3568 read_non_regular_quit ()
3574 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3576 doc
: /* Insert contents of file FILENAME after point.
3577 Returns list of absolute file name and number of characters inserted.
3578 If second argument VISIT is non-nil, the buffer's visited filename
3579 and last save file modtime are set, and it is marked unmodified.
3580 If visiting and the file does not exist, visiting is completed
3581 before the error is signaled.
3582 The optional third and fourth arguments BEG and END
3583 specify what portion of the file to insert.
3584 These arguments count bytes in the file, not characters in the buffer.
3585 If VISIT is non-nil, BEG and END must be nil.
3587 If optional fifth argument REPLACE is non-nil,
3588 it means replace the current buffer contents (in the accessible portion)
3589 with the file contents. This is better than simply deleting and inserting
3590 the whole thing because (1) it preserves some marker positions
3591 and (2) it puts less data in the undo list.
3592 When REPLACE is non-nil, the value is the number of characters actually read,
3593 which is often less than the number of characters to be read.
3595 This does code conversion according to the value of
3596 `coding-system-for-read' or `file-coding-system-alist',
3597 and sets the variable `last-coding-system-used' to the coding system
3599 (filename
, visit
, beg
, end
, replace
)
3600 Lisp_Object filename
, visit
, beg
, end
, replace
;
3605 register int how_much
;
3606 register int unprocessed
;
3607 int count
= SPECPDL_INDEX ();
3608 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3609 Lisp_Object handler
, val
, insval
, orig_filename
;
3612 int not_regular
= 0;
3613 unsigned char read_buf
[READ_BUF_SIZE
];
3614 struct coding_system coding
;
3615 unsigned char buffer
[1 << 14];
3616 int replace_handled
= 0;
3617 int set_coding_system
= 0;
3618 int coding_system_decided
= 0;
3621 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3622 error ("Cannot do file visiting in an indirect buffer");
3624 if (!NILP (current_buffer
->read_only
))
3625 Fbarf_if_buffer_read_only ();
3629 orig_filename
= Qnil
;
3631 GCPRO4 (filename
, val
, p
, orig_filename
);
3633 CHECK_STRING (filename
);
3634 filename
= Fexpand_file_name (filename
, Qnil
);
3636 /* If the file name has special constructs in it,
3637 call the corresponding file handler. */
3638 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3639 if (!NILP (handler
))
3641 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3642 visit
, beg
, end
, replace
);
3643 if (CONSP (val
) && CONSP (XCDR (val
)))
3644 inserted
= XINT (XCAR (XCDR (val
)));
3648 orig_filename
= filename
;
3649 filename
= ENCODE_FILE (filename
);
3655 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3657 /* Tell stat to use expensive method to get accurate info. */
3658 Vw32_get_true_file_attributes
= Qt
;
3659 total
= stat (SDATA (filename
), &st
);
3660 Vw32_get_true_file_attributes
= tem
;
3665 if (stat (SDATA (filename
), &st
) < 0)
3667 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3668 || fstat (fd
, &st
) < 0)
3669 #endif /* not APOLLO */
3670 #endif /* WINDOWSNT */
3672 if (fd
>= 0) emacs_close (fd
);
3675 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3678 if (!NILP (Vcoding_system_for_read
))
3679 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3684 /* This code will need to be changed in order to work on named
3685 pipes, and it's probably just not worth it. So we should at
3686 least signal an error. */
3687 if (!S_ISREG (st
.st_mode
))
3694 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3695 Fsignal (Qfile_error
,
3696 Fcons (build_string ("not a regular file"),
3697 Fcons (orig_filename
, Qnil
)));
3702 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3705 /* Replacement should preserve point as it preserves markers. */
3706 if (!NILP (replace
))
3707 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3709 record_unwind_protect (close_file_unwind
, make_number (fd
));
3711 /* Supposedly happens on VMS. */
3712 /* Can happen on any platform that uses long as type of off_t, but allows
3713 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3714 give a message suitable for the latter case. */
3715 if (! not_regular
&& st
.st_size
< 0)
3716 error ("Maximum buffer size exceeded");
3718 /* Prevent redisplay optimizations. */
3719 current_buffer
->clip_changed
= 1;
3723 if (!NILP (beg
) || !NILP (end
))
3724 error ("Attempt to visit less than an entire file");
3725 if (BEG
< Z
&& NILP (replace
))
3726 error ("Cannot do file visiting in a non-empty buffer");
3732 XSETFASTINT (beg
, 0);
3740 XSETINT (end
, st
.st_size
);
3742 /* Arithmetic overflow can occur if an Emacs integer cannot
3743 represent the file size, or if the calculations below
3744 overflow. The calculations below double the file size
3745 twice, so check that it can be multiplied by 4 safely. */
3746 if (XINT (end
) != st
.st_size
3747 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3748 error ("Maximum buffer size exceeded");
3750 /* The file size returned from stat may be zero, but data
3751 may be readable nonetheless, for example when this is a
3752 file in the /proc filesystem. */
3753 if (st
.st_size
== 0)
3754 XSETINT (end
, READ_BUF_SIZE
);
3760 /* Decide the coding system to use for reading the file now
3761 because we can't use an optimized method for handling
3762 `coding:' tag if the current buffer is not empty. */
3766 if (!NILP (Vcoding_system_for_read
))
3767 val
= Vcoding_system_for_read
;
3768 else if (! NILP (replace
))
3769 /* In REPLACE mode, we can use the same coding system
3770 that was used to visit the file. */
3771 val
= current_buffer
->buffer_file_coding_system
;
3774 /* Don't try looking inside a file for a coding system
3775 specification if it is not seekable. */
3776 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3778 /* Find a coding system specified in the heading two
3779 lines or in the tailing several lines of the file.
3780 We assume that the 1K-byte and 3K-byte for heading
3781 and tailing respectively are sufficient for this
3785 if (st
.st_size
<= (1024 * 4))
3786 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3789 nread
= emacs_read (fd
, read_buf
, 1024);
3792 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3793 report_file_error ("Setting file position",
3794 Fcons (orig_filename
, Qnil
));
3795 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3800 error ("IO error reading %s: %s",
3801 SDATA (orig_filename
), emacs_strerror (errno
));
3804 struct buffer
*prev
= current_buffer
;
3808 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3810 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3811 buf
= XBUFFER (buffer
);
3813 buf
->directory
= current_buffer
->directory
;
3814 buf
->read_only
= Qnil
;
3815 buf
->filename
= Qnil
;
3816 buf
->undo_list
= Qt
;
3817 buf
->overlays_before
= Qnil
;
3818 buf
->overlays_after
= Qnil
;
3820 set_buffer_internal (buf
);
3822 buf
->enable_multibyte_characters
= Qnil
;
3824 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3825 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3826 val
= call2 (Vset_auto_coding_function
,
3827 filename
, make_number (nread
));
3828 set_buffer_internal (prev
);
3830 /* Discard the unwind protect for recovering the
3834 /* Rewind the file for the actual read done later. */
3835 if (lseek (fd
, 0, 0) < 0)
3836 report_file_error ("Setting file position",
3837 Fcons (orig_filename
, Qnil
));
3843 /* If we have not yet decided a coding system, check
3844 file-coding-system-alist. */
3845 Lisp_Object args
[6], coding_systems
;
3847 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3848 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3849 coding_systems
= Ffind_operation_coding_system (6, args
);
3850 if (CONSP (coding_systems
))
3851 val
= XCAR (coding_systems
);
3855 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3856 /* Ensure we set Vlast_coding_system_used. */
3857 set_coding_system
= 1;
3859 if (NILP (current_buffer
->enable_multibyte_characters
)
3861 /* We must suppress all character code conversion except for
3862 end-of-line conversion. */
3863 setup_raw_text_coding_system (&coding
);
3865 coding
.src_multibyte
= 0;
3866 coding
.dst_multibyte
3867 = !NILP (current_buffer
->enable_multibyte_characters
);
3868 coding_system_decided
= 1;
3871 /* If requested, replace the accessible part of the buffer
3872 with the file contents. Avoid replacing text at the
3873 beginning or end of the buffer that matches the file contents;
3874 that preserves markers pointing to the unchanged parts.
3876 Here we implement this feature in an optimized way
3877 for the case where code conversion is NOT needed.
3878 The following if-statement handles the case of conversion
3879 in a less optimal way.
3881 If the code conversion is "automatic" then we try using this
3882 method and hope for the best.
3883 But if we discover the need for conversion, we give up on this method
3884 and let the following if-statement handle the replace job. */
3887 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3889 /* same_at_start and same_at_end count bytes,
3890 because file access counts bytes
3891 and BEG and END count bytes. */
3892 int same_at_start
= BEGV_BYTE
;
3893 int same_at_end
= ZV_BYTE
;
3895 /* There is still a possibility we will find the need to do code
3896 conversion. If that happens, we set this variable to 1 to
3897 give up on handling REPLACE in the optimized way. */
3898 int giveup_match_end
= 0;
3900 if (XINT (beg
) != 0)
3902 if (lseek (fd
, XINT (beg
), 0) < 0)
3903 report_file_error ("Setting file position",
3904 Fcons (orig_filename
, Qnil
));
3909 /* Count how many chars at the start of the file
3910 match the text at the beginning of the buffer. */
3915 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3917 error ("IO error reading %s: %s",
3918 SDATA (orig_filename
), emacs_strerror (errno
));
3919 else if (nread
== 0)
3922 if (coding
.type
== coding_type_undecided
)
3923 detect_coding (&coding
, buffer
, nread
);
3924 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
3925 /* We found that the file should be decoded somehow.
3926 Let's give up here. */
3928 giveup_match_end
= 1;
3932 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3933 detect_eol (&coding
, buffer
, nread
);
3934 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3935 && coding
.eol_type
!= CODING_EOL_LF
)
3936 /* We found that the format of eol should be decoded.
3937 Let's give up here. */
3939 giveup_match_end
= 1;
3944 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3945 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3946 same_at_start
++, bufpos
++;
3947 /* If we found a discrepancy, stop the scan.
3948 Otherwise loop around and scan the next bufferful. */
3949 if (bufpos
!= nread
)
3953 /* If the file matches the buffer completely,
3954 there's no need to replace anything. */
3955 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3959 /* Truncate the buffer to the size of the file. */
3960 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3965 /* Count how many chars at the end of the file
3966 match the text at the end of the buffer. But, if we have
3967 already found that decoding is necessary, don't waste time. */
3968 while (!giveup_match_end
)
3970 int total_read
, nread
, bufpos
, curpos
, trial
;
3972 /* At what file position are we now scanning? */
3973 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3974 /* If the entire file matches the buffer tail, stop the scan. */
3977 /* How much can we scan in the next step? */
3978 trial
= min (curpos
, sizeof buffer
);
3979 if (lseek (fd
, curpos
- trial
, 0) < 0)
3980 report_file_error ("Setting file position",
3981 Fcons (orig_filename
, Qnil
));
3983 total_read
= nread
= 0;
3984 while (total_read
< trial
)
3986 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3988 error ("IO error reading %s: %s",
3989 SDATA (orig_filename
), emacs_strerror (errno
));
3990 else if (nread
== 0)
3992 total_read
+= nread
;
3995 /* Scan this bufferful from the end, comparing with
3996 the Emacs buffer. */
3997 bufpos
= total_read
;
3999 /* Compare with same_at_start to avoid counting some buffer text
4000 as matching both at the file's beginning and at the end. */
4001 while (bufpos
> 0 && same_at_end
> same_at_start
4002 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4003 same_at_end
--, bufpos
--;
4005 /* If we found a discrepancy, stop the scan.
4006 Otherwise loop around and scan the preceding bufferful. */
4009 /* If this discrepancy is because of code conversion,
4010 we cannot use this method; giveup and try the other. */
4011 if (same_at_end
> same_at_start
4012 && FETCH_BYTE (same_at_end
- 1) >= 0200
4013 && ! NILP (current_buffer
->enable_multibyte_characters
)
4014 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4015 giveup_match_end
= 1;
4024 if (! giveup_match_end
)
4028 /* We win! We can handle REPLACE the optimized way. */
4030 /* Extend the start of non-matching text area to multibyte
4031 character boundary. */
4032 if (! NILP (current_buffer
->enable_multibyte_characters
))
4033 while (same_at_start
> BEGV_BYTE
4034 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4037 /* Extend the end of non-matching text area to multibyte
4038 character boundary. */
4039 if (! NILP (current_buffer
->enable_multibyte_characters
))
4040 while (same_at_end
< ZV_BYTE
4041 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4044 /* Don't try to reuse the same piece of text twice. */
4045 overlap
= (same_at_start
- BEGV_BYTE
4046 - (same_at_end
+ st
.st_size
- ZV
));
4048 same_at_end
+= overlap
;
4050 /* Arrange to read only the nonmatching middle part of the file. */
4051 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4052 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4054 del_range_byte (same_at_start
, same_at_end
, 0);
4055 /* Insert from the file at the proper position. */
4056 temp
= BYTE_TO_CHAR (same_at_start
);
4057 SET_PT_BOTH (temp
, same_at_start
);
4059 /* If display currently starts at beginning of line,
4060 keep it that way. */
4061 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4062 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4064 replace_handled
= 1;
4068 /* If requested, replace the accessible part of the buffer
4069 with the file contents. Avoid replacing text at the
4070 beginning or end of the buffer that matches the file contents;
4071 that preserves markers pointing to the unchanged parts.
4073 Here we implement this feature for the case where code conversion
4074 is needed, in a simple way that needs a lot of memory.
4075 The preceding if-statement handles the case of no conversion
4076 in a more optimized way. */
4077 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4079 int same_at_start
= BEGV_BYTE
;
4080 int same_at_end
= ZV_BYTE
;
4083 /* Make sure that the gap is large enough. */
4084 int bufsize
= 2 * st
.st_size
;
4085 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4088 /* First read the whole file, performing code conversion into
4089 CONVERSION_BUFFER. */
4091 if (lseek (fd
, XINT (beg
), 0) < 0)
4093 xfree (conversion_buffer
);
4094 report_file_error ("Setting file position",
4095 Fcons (orig_filename
, Qnil
));
4098 total
= st
.st_size
; /* Total bytes in the file. */
4099 how_much
= 0; /* Bytes read from file so far. */
4100 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4101 unprocessed
= 0; /* Bytes not processed in previous loop. */
4103 while (how_much
< total
)
4105 /* try is reserved in some compilers (Microsoft C) */
4106 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4107 unsigned char *destination
= read_buf
+ unprocessed
;
4110 /* Allow quitting out of the actual I/O. */
4113 this = emacs_read (fd
, destination
, trytry
);
4116 if (this < 0 || this + unprocessed
== 0)
4124 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4126 int require
, result
;
4128 this += unprocessed
;
4130 /* If we are using more space than estimated,
4131 make CONVERSION_BUFFER bigger. */
4132 require
= decoding_buffer_size (&coding
, this);
4133 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4135 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4136 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4139 /* Convert this batch with results in CONVERSION_BUFFER. */
4140 if (how_much
>= total
) /* This is the last block. */
4141 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4142 if (coding
.composing
!= COMPOSITION_DISABLED
)
4143 coding_allocate_composition_data (&coding
, BEGV
);
4144 result
= decode_coding (&coding
, read_buf
,
4145 conversion_buffer
+ inserted
,
4146 this, bufsize
- inserted
);
4148 /* Save for next iteration whatever we didn't convert. */
4149 unprocessed
= this - coding
.consumed
;
4150 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4151 if (!NILP (current_buffer
->enable_multibyte_characters
))
4152 this = coding
.produced
;
4154 this = str_as_unibyte (conversion_buffer
+ inserted
,
4161 /* At this point, INSERTED is how many characters (i.e. bytes)
4162 are present in CONVERSION_BUFFER.
4163 HOW_MUCH should equal TOTAL,
4164 or should be <= 0 if we couldn't read the file. */
4168 xfree (conversion_buffer
);
4171 error ("IO error reading %s: %s",
4172 SDATA (orig_filename
), emacs_strerror (errno
));
4173 else if (how_much
== -2)
4174 error ("maximum buffer size exceeded");
4177 /* Compare the beginning of the converted file
4178 with the buffer text. */
4181 while (bufpos
< inserted
&& same_at_start
< same_at_end
4182 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4183 same_at_start
++, bufpos
++;
4185 /* If the file matches the buffer completely,
4186 there's no need to replace anything. */
4188 if (bufpos
== inserted
)
4190 xfree (conversion_buffer
);
4193 /* Truncate the buffer to the size of the file. */
4194 del_range_byte (same_at_start
, same_at_end
, 0);
4199 /* Extend the start of non-matching text area to multibyte
4200 character boundary. */
4201 if (! NILP (current_buffer
->enable_multibyte_characters
))
4202 while (same_at_start
> BEGV_BYTE
4203 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4206 /* Scan this bufferful from the end, comparing with
4207 the Emacs buffer. */
4210 /* Compare with same_at_start to avoid counting some buffer text
4211 as matching both at the file's beginning and at the end. */
4212 while (bufpos
> 0 && same_at_end
> same_at_start
4213 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4214 same_at_end
--, bufpos
--;
4216 /* Extend the end of non-matching text area to multibyte
4217 character boundary. */
4218 if (! NILP (current_buffer
->enable_multibyte_characters
))
4219 while (same_at_end
< ZV_BYTE
4220 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4223 /* Don't try to reuse the same piece of text twice. */
4224 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4226 same_at_end
+= overlap
;
4228 /* If display currently starts at beginning of line,
4229 keep it that way. */
4230 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4231 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4233 /* Replace the chars that we need to replace,
4234 and update INSERTED to equal the number of bytes
4235 we are taking from the file. */
4236 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4238 if (same_at_end
!= same_at_start
)
4240 del_range_byte (same_at_start
, same_at_end
, 0);
4242 same_at_start
= GPT_BYTE
;
4246 temp
= BYTE_TO_CHAR (same_at_start
);
4248 /* Insert from the file at the proper position. */
4249 SET_PT_BOTH (temp
, same_at_start
);
4250 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
4252 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4253 coding_restore_composition (&coding
, Fcurrent_buffer ());
4254 coding_free_composition_data (&coding
);
4256 /* Set `inserted' to the number of inserted characters. */
4257 inserted
= PT
- temp
;
4259 xfree (conversion_buffer
);
4268 register Lisp_Object temp
;
4270 total
= XINT (end
) - XINT (beg
);
4272 /* Make sure point-max won't overflow after this insertion. */
4273 XSETINT (temp
, total
);
4274 if (total
!= XINT (temp
))
4275 error ("Maximum buffer size exceeded");
4278 /* For a special file, all we can do is guess. */
4279 total
= READ_BUF_SIZE
;
4281 if (NILP (visit
) && total
> 0)
4282 prepare_to_modify_buffer (PT
, PT
, NULL
);
4285 if (GAP_SIZE
< total
)
4286 make_gap (total
- GAP_SIZE
);
4288 if (XINT (beg
) != 0 || !NILP (replace
))
4290 if (lseek (fd
, XINT (beg
), 0) < 0)
4291 report_file_error ("Setting file position",
4292 Fcons (orig_filename
, Qnil
));
4295 /* In the following loop, HOW_MUCH contains the total bytes read so
4296 far for a regular file, and not changed for a special file. But,
4297 before exiting the loop, it is set to a negative value if I/O
4301 /* Total bytes inserted. */
4304 /* Here, we don't do code conversion in the loop. It is done by
4305 code_convert_region after all data are read into the buffer. */
4307 int gap_size
= GAP_SIZE
;
4309 while (how_much
< total
)
4311 /* try is reserved in some compilers (Microsoft C) */
4312 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4319 /* Maybe make more room. */
4320 if (gap_size
< trytry
)
4322 make_gap (total
- gap_size
);
4323 gap_size
= GAP_SIZE
;
4326 /* Read from the file, capturing `quit'. When an
4327 error occurs, end the loop, and arrange for a quit
4328 to be signaled after decoding the text we read. */
4329 non_regular_fd
= fd
;
4330 non_regular_inserted
= inserted
;
4331 non_regular_nbytes
= trytry
;
4332 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4333 read_non_regular_quit
);
4344 /* Allow quitting out of the actual I/O. We don't make text
4345 part of the buffer until all the reading is done, so a C-g
4346 here doesn't do any harm. */
4349 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4361 /* For a regular file, where TOTAL is the real size,
4362 count HOW_MUCH to compare with it.
4363 For a special file, where TOTAL is just a buffer size,
4364 so don't bother counting in HOW_MUCH.
4365 (INSERTED is where we count the number of characters inserted.) */
4372 /* Make the text read part of the buffer. */
4373 GAP_SIZE
-= inserted
;
4375 GPT_BYTE
+= inserted
;
4377 ZV_BYTE
+= inserted
;
4382 /* Put an anchor to ensure multi-byte form ends at gap. */
4387 /* Discard the unwind protect for closing the file. */
4391 error ("IO error reading %s: %s",
4392 SDATA (orig_filename
), emacs_strerror (errno
));
4396 if (! coding_system_decided
)
4398 /* The coding system is not yet decided. Decide it by an
4399 optimized method for handling `coding:' tag.
4401 Note that we can get here only if the buffer was empty
4402 before the insertion. */
4406 if (!NILP (Vcoding_system_for_read
))
4407 val
= Vcoding_system_for_read
;
4410 /* Since we are sure that the current buffer was empty
4411 before the insertion, we can toggle
4412 enable-multibyte-characters directly here without taking
4413 care of marker adjustment and byte combining problem. By
4414 this way, we can run Lisp program safely before decoding
4415 the inserted text. */
4416 Lisp_Object unwind_data
;
4417 int count
= SPECPDL_INDEX ();
4419 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4420 Fcons (current_buffer
->undo_list
,
4421 Fcurrent_buffer ()));
4422 current_buffer
->enable_multibyte_characters
= Qnil
;
4423 current_buffer
->undo_list
= Qt
;
4424 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4426 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4428 val
= call2 (Vset_auto_coding_function
,
4429 filename
, make_number (inserted
));
4434 /* If the coding system is not yet decided, check
4435 file-coding-system-alist. */
4436 Lisp_Object args
[6], coding_systems
;
4438 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4439 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4440 coding_systems
= Ffind_operation_coding_system (6, args
);
4441 if (CONSP (coding_systems
))
4442 val
= XCAR (coding_systems
);
4445 unbind_to (count
, Qnil
);
4446 inserted
= Z_BYTE
- BEG_BYTE
;
4449 /* The following kludgy code is to avoid some compiler bug.
4451 setup_coding_system (val, &coding);
4454 struct coding_system temp_coding
;
4455 setup_coding_system (val
, &temp_coding
);
4456 bcopy (&temp_coding
, &coding
, sizeof coding
);
4458 /* Ensure we set Vlast_coding_system_used. */
4459 set_coding_system
= 1;
4461 if (NILP (current_buffer
->enable_multibyte_characters
)
4463 /* We must suppress all character code conversion except for
4464 end-of-line conversion. */
4465 setup_raw_text_coding_system (&coding
);
4466 coding
.src_multibyte
= 0;
4467 coding
.dst_multibyte
4468 = !NILP (current_buffer
->enable_multibyte_characters
);
4472 /* Can't do this if part of the buffer might be preserved. */
4474 && (coding
.type
== coding_type_no_conversion
4475 || coding
.type
== coding_type_raw_text
))
4477 /* Visiting a file with these coding system makes the buffer
4479 current_buffer
->enable_multibyte_characters
= Qnil
;
4480 coding
.dst_multibyte
= 0;
4483 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4485 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4487 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4489 inserted
= coding
.produced_char
;
4492 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4496 /* Now INSERTED is measured in characters. */
4499 /* Use the conversion type to determine buffer-file-type
4500 (find-buffer-file-type is now used to help determine the
4502 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4503 || coding
.eol_type
== CODING_EOL_LF
)
4504 && ! CODING_REQUIRE_DECODING (&coding
))
4505 current_buffer
->buffer_file_type
= Qt
;
4507 current_buffer
->buffer_file_type
= Qnil
;
4514 if (!EQ (current_buffer
->undo_list
, Qt
))
4515 current_buffer
->undo_list
= Qnil
;
4517 stat (SDATA (filename
), &st
);
4522 current_buffer
->modtime
= st
.st_mtime
;
4523 current_buffer
->filename
= orig_filename
;
4526 SAVE_MODIFF
= MODIFF
;
4527 current_buffer
->auto_save_modified
= MODIFF
;
4528 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4529 #ifdef CLASH_DETECTION
4532 if (!NILP (current_buffer
->file_truename
))
4533 unlock_file (current_buffer
->file_truename
);
4534 unlock_file (filename
);
4536 #endif /* CLASH_DETECTION */
4538 Fsignal (Qfile_error
,
4539 Fcons (build_string ("not a regular file"),
4540 Fcons (orig_filename
, Qnil
)));
4543 /* Decode file format */
4546 int empty_undo_list_p
= 0;
4548 /* If we're anyway going to discard undo information, don't
4549 record it in the first place. The buffer's undo list at this
4550 point is either nil or t when visiting a file. */
4553 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4554 current_buffer
->undo_list
= Qt
;
4557 insval
= call3 (Qformat_decode
,
4558 Qnil
, make_number (inserted
), visit
);
4559 CHECK_NUMBER (insval
);
4560 inserted
= XFASTINT (insval
);
4563 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4566 if (set_coding_system
)
4567 Vlast_coding_system_used
= coding
.symbol
;
4569 /* Call after-change hooks for the inserted text, aside from the case
4570 of normal visiting (not with REPLACE), which is done in a new buffer
4571 "before" the buffer is changed. */
4572 if (inserted
> 0 && total
> 0
4573 && (NILP (visit
) || !NILP (replace
)))
4575 signal_after_change (PT
, 0, inserted
);
4576 update_compositions (PT
, PT
, CHECK_BORDER
);
4579 p
= Vafter_insert_file_functions
;
4582 insval
= call1 (XCAR (p
), make_number (inserted
));
4585 CHECK_NUMBER (insval
);
4586 inserted
= XFASTINT (insval
);
4593 && current_buffer
->modtime
== -1)
4595 /* If visiting nonexistent file, return nil. */
4596 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4600 Fsignal (Qquit
, Qnil
);
4602 /* ??? Retval needs to be dealt with in all cases consistently. */
4604 val
= Fcons (orig_filename
,
4605 Fcons (make_number (inserted
),
4608 RETURN_UNGCPRO (unbind_to (count
, val
));
4611 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4612 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4613 Lisp_Object
, Lisp_Object
));
4615 /* If build_annotations switched buffers, switch back to BUF.
4616 Kill the temporary buffer that was selected in the meantime.
4618 Since this kill only the last temporary buffer, some buffers remain
4619 not killed if build_annotations switched buffers more than once.
4623 build_annotations_unwind (buf
)
4628 if (XBUFFER (buf
) == current_buffer
)
4630 tembuf
= Fcurrent_buffer ();
4632 Fkill_buffer (tembuf
);
4636 /* Decide the coding-system to encode the data with. */
4639 choose_write_coding_system (start
, end
, filename
,
4640 append
, visit
, lockname
, coding
)
4641 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4642 struct coding_system
*coding
;
4648 else if (!NILP (Vcoding_system_for_write
))
4650 val
= Vcoding_system_for_write
;
4651 if (coding_system_require_warning
4652 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4653 /* Confirm that VAL can surely encode the current region. */
4654 val
= call5 (Vselect_safe_coding_system_function
,
4655 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4660 /* If the variable `buffer-file-coding-system' is set locally,
4661 it means that the file was read with some kind of code
4662 conversion or the variable is explicitly set by users. We
4663 had better write it out with the same coding system even if
4664 `enable-multibyte-characters' is nil.
4666 If it is not set locally, we anyway have to convert EOL
4667 format if the default value of `buffer-file-coding-system'
4668 tells that it is not Unix-like (LF only) format. */
4669 int using_default_coding
= 0;
4670 int force_raw_text
= 0;
4672 val
= current_buffer
->buffer_file_coding_system
;
4674 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4677 if (NILP (current_buffer
->enable_multibyte_characters
))
4683 /* Check file-coding-system-alist. */
4684 Lisp_Object args
[7], coding_systems
;
4686 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4687 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4689 coding_systems
= Ffind_operation_coding_system (7, args
);
4690 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4691 val
= XCDR (coding_systems
);
4695 && !NILP (current_buffer
->buffer_file_coding_system
))
4697 /* If we still have not decided a coding system, use the
4698 default value of buffer-file-coding-system. */
4699 val
= current_buffer
->buffer_file_coding_system
;
4700 using_default_coding
= 1;
4704 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4705 /* Confirm that VAL can surely encode the current region. */
4706 val
= call5 (Vselect_safe_coding_system_function
,
4707 start
, end
, val
, Qnil
, filename
);
4709 setup_coding_system (Fcheck_coding_system (val
), coding
);
4710 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4711 && !using_default_coding
)
4713 if (! EQ (default_buffer_file_coding
.symbol
,
4714 buffer_defaults
.buffer_file_coding_system
))
4715 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4716 &default_buffer_file_coding
);
4717 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4719 Lisp_Object subsidiaries
;
4721 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4722 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4723 if (VECTORP (subsidiaries
)
4724 && XVECTOR (subsidiaries
)->size
== 3)
4726 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4731 setup_raw_text_coding_system (coding
);
4732 goto done_setup_coding
;
4735 setup_coding_system (Fcheck_coding_system (val
), coding
);
4738 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4739 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4742 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4743 "r\nFWrite region to file: \ni\ni\ni\np",
4744 doc
: /* Write current region into specified file.
4745 When called from a program, requires three arguments:
4746 START, END and FILENAME. START and END are normally buffer positions
4747 specifying the part of the buffer to write.
4748 If START is nil, that means to use the entire buffer contents.
4749 If START is a string, then output that string to the file
4750 instead of any buffer contents; END is ignored.
4752 Optional fourth argument APPEND if non-nil means
4753 append to existing file contents (if any). If it is an integer,
4754 seek to that offset in the file before writing.
4755 Optional fifth argument VISIT if t means
4756 set the last-save-file-modtime of buffer to this file's modtime
4757 and mark buffer not modified.
4758 If VISIT is a string, it is a second file name;
4759 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4760 VISIT is also the file name to lock and unlock for clash detection.
4761 If VISIT is neither t nor nil nor a string,
4762 that means do not display the \"Wrote file\" message.
4763 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4764 use for locking and unlocking, overriding FILENAME and VISIT.
4765 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4766 for an existing file with the same name. If MUSTBENEW is `excl',
4767 that means to get an error if the file already exists; never overwrite.
4768 If MUSTBENEW is neither nil nor `excl', that means ask for
4769 confirmation before overwriting, but do go ahead and overwrite the file
4770 if the user confirms.
4772 This does code conversion according to the value of
4773 `coding-system-for-write', `buffer-file-coding-system', or
4774 `file-coding-system-alist', and sets the variable
4775 `last-coding-system-used' to the coding system actually used. */)
4776 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4777 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4782 const unsigned char *fn
;
4785 int count
= SPECPDL_INDEX ();
4788 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4790 Lisp_Object handler
;
4791 Lisp_Object visit_file
;
4792 Lisp_Object annotations
;
4793 Lisp_Object encoded_filename
;
4794 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4795 int quietly
= !NILP (visit
);
4796 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4797 struct buffer
*given_buffer
;
4799 int buffer_file_type
= O_BINARY
;
4801 struct coding_system coding
;
4803 if (current_buffer
->base_buffer
&& visiting
)
4804 error ("Cannot do file visiting in an indirect buffer");
4806 if (!NILP (start
) && !STRINGP (start
))
4807 validate_region (&start
, &end
);
4809 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4811 filename
= Fexpand_file_name (filename
, Qnil
);
4813 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4814 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4816 if (STRINGP (visit
))
4817 visit_file
= Fexpand_file_name (visit
, Qnil
);
4819 visit_file
= filename
;
4821 if (NILP (lockname
))
4822 lockname
= visit_file
;
4826 /* If the file name has special constructs in it,
4827 call the corresponding file handler. */
4828 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4829 /* If FILENAME has no handler, see if VISIT has one. */
4830 if (NILP (handler
) && STRINGP (visit
))
4831 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4833 if (!NILP (handler
))
4836 val
= call6 (handler
, Qwrite_region
, start
, end
,
4837 filename
, append
, visit
);
4841 SAVE_MODIFF
= MODIFF
;
4842 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4843 current_buffer
->filename
= visit_file
;
4849 /* Special kludge to simplify auto-saving. */
4852 XSETFASTINT (start
, BEG
);
4853 XSETFASTINT (end
, Z
);
4856 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4857 count1
= SPECPDL_INDEX ();
4859 given_buffer
= current_buffer
;
4861 if (!STRINGP (start
))
4863 annotations
= build_annotations (start
, end
);
4865 if (current_buffer
!= given_buffer
)
4867 XSETFASTINT (start
, BEGV
);
4868 XSETFASTINT (end
, ZV
);
4874 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4876 /* Decide the coding-system to encode the data with.
4877 We used to make this choice before calling build_annotations, but that
4878 leads to problems when a write-annotate-function takes care of
4879 unsavable chars (as was the case with X-Symbol). */
4880 choose_write_coding_system (start
, end
, filename
,
4881 append
, visit
, lockname
, &coding
);
4882 Vlast_coding_system_used
= coding
.symbol
;
4884 given_buffer
= current_buffer
;
4885 if (! STRINGP (start
))
4887 annotations
= build_annotations_2 (start
, end
,
4888 coding
.pre_write_conversion
, annotations
);
4889 if (current_buffer
!= given_buffer
)
4891 XSETFASTINT (start
, BEGV
);
4892 XSETFASTINT (end
, ZV
);
4896 #ifdef CLASH_DETECTION
4899 #if 0 /* This causes trouble for GNUS. */
4900 /* If we've locked this file for some other buffer,
4901 query before proceeding. */
4902 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4903 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4906 lock_file (lockname
);
4908 #endif /* CLASH_DETECTION */
4910 encoded_filename
= ENCODE_FILE (filename
);
4912 fn
= SDATA (encoded_filename
);
4916 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4917 #else /* not DOS_NT */
4918 desc
= emacs_open (fn
, O_WRONLY
, 0);
4919 #endif /* not DOS_NT */
4921 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4923 if (auto_saving
) /* Overwrite any previous version of autosave file */
4925 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4926 desc
= emacs_open (fn
, O_RDWR
, 0);
4928 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4929 ? SDATA (current_buffer
->filename
) : 0,
4932 else /* Write to temporary name and rename if no errors */
4934 Lisp_Object temp_name
;
4935 temp_name
= Ffile_name_directory (filename
);
4937 if (!NILP (temp_name
))
4939 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4940 build_string ("$$SAVE$$")));
4941 fname
= SDATA (filename
);
4942 fn
= SDATA (temp_name
);
4943 desc
= creat_copy_attrs (fname
, fn
);
4946 /* If we can't open the temporary file, try creating a new
4947 version of the original file. VMS "creat" creates a
4948 new version rather than truncating an existing file. */
4951 desc
= creat (fn
, 0666);
4952 #if 0 /* This can clobber an existing file and fail to replace it,
4953 if the user runs out of space. */
4956 /* We can't make a new version;
4957 try to truncate and rewrite existing version if any. */
4959 desc
= emacs_open (fn
, O_RDWR
, 0);
4965 desc
= creat (fn
, 0666);
4969 desc
= emacs_open (fn
,
4970 O_WRONLY
| O_CREAT
| buffer_file_type
4971 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4972 S_IREAD
| S_IWRITE
);
4973 #else /* not DOS_NT */
4974 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4975 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4976 auto_saving
? auto_save_mode_bits
: 0666);
4977 #endif /* not DOS_NT */
4978 #endif /* not VMS */
4982 #ifdef CLASH_DETECTION
4984 if (!auto_saving
) unlock_file (lockname
);
4986 #endif /* CLASH_DETECTION */
4988 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4991 record_unwind_protect (close_file_unwind
, make_number (desc
));
4993 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4997 if (NUMBERP (append
))
4998 ret
= lseek (desc
, XINT (append
), 1);
5000 ret
= lseek (desc
, 0, 2);
5003 #ifdef CLASH_DETECTION
5004 if (!auto_saving
) unlock_file (lockname
);
5005 #endif /* CLASH_DETECTION */
5007 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5015 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5016 * if we do writes that don't end with a carriage return. Furthermore
5017 * it cannot handle writes of more then 16K. The modified
5018 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5019 * this EXCEPT for the last record (iff it doesn't end with a carriage
5020 * return). This implies that if your buffer doesn't end with a carriage
5021 * return, you get one free... tough. However it also means that if
5022 * we make two calls to sys_write (a la the following code) you can
5023 * get one at the gap as well. The easiest way to fix this (honest)
5024 * is to move the gap to the next newline (or the end of the buffer).
5029 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5030 move_gap (find_next_newline (GPT
, 1));
5032 /* Whether VMS or not, we must move the gap to the next of newline
5033 when we must put designation sequences at beginning of line. */
5034 if (INTEGERP (start
)
5035 && coding
.type
== coding_type_iso2022
5036 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5037 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5039 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5040 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5041 move_gap_both (PT
, PT_BYTE
);
5042 SET_PT_BOTH (opoint
, opoint_byte
);
5049 if (STRINGP (start
))
5051 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5052 &annotations
, &coding
);
5055 else if (XINT (start
) != XINT (end
))
5057 tem
= CHAR_TO_BYTE (XINT (start
));
5059 if (XINT (start
) < GPT
)
5061 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5062 min (GPT
, XINT (end
)) - XINT (start
),
5063 &annotations
, &coding
);
5067 if (XINT (end
) > GPT
&& !failure
)
5069 tem
= max (XINT (start
), GPT
);
5070 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5071 &annotations
, &coding
);
5077 /* If file was empty, still need to write the annotations */
5078 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5079 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5083 if (CODING_REQUIRE_FLUSHING (&coding
)
5084 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5087 /* We have to flush out a data. */
5088 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5089 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5096 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5097 Disk full in NFS may be reported here. */
5098 /* mib says that closing the file will try to write as fast as NFS can do
5099 it, and that means the fsync here is not crucial for autosave files. */
5100 if (!auto_saving
&& fsync (desc
) < 0)
5102 /* If fsync fails with EINTR, don't treat that as serious. */
5104 failure
= 1, save_errno
= errno
;
5108 /* Spurious "file has changed on disk" warnings have been
5109 observed on Suns as well.
5110 It seems that `close' can change the modtime, under nfs.
5112 (This has supposedly been fixed in Sunos 4,
5113 but who knows about all the other machines with NFS?) */
5116 /* On VMS and APOLLO, must do the stat after the close
5117 since closing changes the modtime. */
5120 /* Recall that #if defined does not work on VMS. */
5127 /* NFS can report a write failure now. */
5128 if (emacs_close (desc
) < 0)
5129 failure
= 1, save_errno
= errno
;
5132 /* If we wrote to a temporary name and had no errors, rename to real name. */
5136 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5144 /* Discard the unwind protect for close_file_unwind. */
5145 specpdl_ptr
= specpdl
+ count1
;
5146 /* Restore the original current buffer. */
5147 visit_file
= unbind_to (count
, visit_file
);
5149 #ifdef CLASH_DETECTION
5151 unlock_file (lockname
);
5152 #endif /* CLASH_DETECTION */
5154 /* Do this before reporting IO error
5155 to avoid a "file has changed on disk" warning on
5156 next attempt to save. */
5158 current_buffer
->modtime
= st
.st_mtime
;
5161 error ("IO error writing %s: %s", SDATA (filename
),
5162 emacs_strerror (save_errno
));
5166 SAVE_MODIFF
= MODIFF
;
5167 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5168 current_buffer
->filename
= visit_file
;
5169 update_mode_lines
++;
5175 message_with_string ("Wrote %s", visit_file
, 1);
5180 Lisp_Object
merge ();
5182 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5183 doc
: /* Return t if (car A) is numerically less than (car B). */)
5187 return Flss (Fcar (a
), Fcar (b
));
5190 /* Build the complete list of annotations appropriate for writing out
5191 the text between START and END, by calling all the functions in
5192 write-region-annotate-functions and merging the lists they return.
5193 If one of these functions switches to a different buffer, we assume
5194 that buffer contains altered text. Therefore, the caller must
5195 make sure to restore the current buffer in all cases,
5196 as save-excursion would do. */
5199 build_annotations (start
, end
)
5200 Lisp_Object start
, end
;
5202 Lisp_Object annotations
;
5204 struct gcpro gcpro1
, gcpro2
;
5205 Lisp_Object original_buffer
;
5208 XSETBUFFER (original_buffer
, current_buffer
);
5211 p
= Vwrite_region_annotate_functions
;
5212 GCPRO2 (annotations
, p
);
5215 struct buffer
*given_buffer
= current_buffer
;
5216 Vwrite_region_annotations_so_far
= annotations
;
5217 res
= call2 (XCAR (p
), start
, end
);
5218 /* If the function makes a different buffer current,
5219 assume that means this buffer contains altered text to be output.
5220 Reset START and END from the buffer bounds
5221 and discard all previous annotations because they should have
5222 been dealt with by this function. */
5223 if (current_buffer
!= given_buffer
)
5225 XSETFASTINT (start
, BEGV
);
5226 XSETFASTINT (end
, ZV
);
5229 Flength (res
); /* Check basic validity of return value */
5230 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5234 /* Now do the same for annotation functions implied by the file-format */
5235 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5236 p
= Vauto_save_file_format
;
5238 p
= current_buffer
->file_format
;
5239 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5241 struct buffer
*given_buffer
= current_buffer
;
5243 Vwrite_region_annotations_so_far
= annotations
;
5245 /* Value is either a list of annotations or nil if the function
5246 has written annotations to a temporary buffer, which is now
5248 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5249 original_buffer
, make_number (i
));
5250 if (current_buffer
!= given_buffer
)
5252 XSETFASTINT (start
, BEGV
);
5253 XSETFASTINT (end
, ZV
);
5258 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5266 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5267 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5269 struct gcpro gcpro1
;
5272 GCPRO1 (annotations
);
5273 /* At last, do the same for the function PRE_WRITE_CONVERSION
5274 implied by the current coding-system. */
5275 if (!NILP (pre_write_conversion
))
5277 struct buffer
*given_buffer
= current_buffer
;
5278 Vwrite_region_annotations_so_far
= annotations
;
5279 res
= call2 (pre_write_conversion
, start
, end
);
5281 annotations
= (current_buffer
!= given_buffer
5283 : merge (annotations
, res
, Qcar_less_than_car
));
5290 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5291 If STRING is nil, POS is the character position in the current buffer.
5292 Intersperse with them the annotations from *ANNOT
5293 which fall within the range of POS to POS + NCHARS,
5294 each at its appropriate position.
5296 We modify *ANNOT by discarding elements as we use them up.
5298 The return value is negative in case of system call failure. */
5301 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5304 register int nchars
;
5307 struct coding_system
*coding
;
5311 int lastpos
= pos
+ nchars
;
5313 while (NILP (*annot
) || CONSP (*annot
))
5315 tem
= Fcar_safe (Fcar (*annot
));
5318 nextpos
= XFASTINT (tem
);
5320 /* If there are no more annotations in this range,
5321 output the rest of the range all at once. */
5322 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5323 return e_write (desc
, string
, pos
, lastpos
, coding
);
5325 /* Output buffer text up to the next annotation's position. */
5328 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5332 /* Output the annotation. */
5333 tem
= Fcdr (Fcar (*annot
));
5336 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5339 *annot
= Fcdr (*annot
);
5344 #ifndef WRITE_BUF_SIZE
5345 #define WRITE_BUF_SIZE (16 * 1024)
5348 /* Write text in the range START and END into descriptor DESC,
5349 encoding them with coding system CODING. If STRING is nil, START
5350 and END are character positions of the current buffer, else they
5351 are indexes to the string STRING. */
5354 e_write (desc
, string
, start
, end
, coding
)
5358 struct coding_system
*coding
;
5360 register char *addr
;
5361 register int nbytes
;
5362 char buf
[WRITE_BUF_SIZE
];
5366 coding
->composing
= COMPOSITION_DISABLED
;
5367 if (coding
->composing
!= COMPOSITION_DISABLED
)
5368 coding_save_composition (coding
, start
, end
, string
);
5370 if (STRINGP (string
))
5372 addr
= SDATA (string
);
5373 nbytes
= SBYTES (string
);
5374 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5376 else if (start
< end
)
5378 /* It is assured that the gap is not in the range START and END-1. */
5379 addr
= CHAR_POS_ADDR (start
);
5380 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5381 coding
->src_multibyte
5382 = !NILP (current_buffer
->enable_multibyte_characters
);
5388 coding
->src_multibyte
= 1;
5391 /* We used to have a code for handling selective display here. But,
5392 now it is handled within encode_coding. */
5397 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5398 if (coding
->produced
> 0)
5400 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5401 if (coding
->produced
)
5407 nbytes
-= coding
->consumed
;
5408 addr
+= coding
->consumed
;
5409 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5412 /* The source text ends by an incomplete multibyte form.
5413 There's no way other than write it out as is. */
5414 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5423 start
+= coding
->consumed_char
;
5424 if (coding
->cmp_data
)
5425 coding_adjust_composition_offset (coding
, start
);
5428 if (coding
->cmp_data
)
5429 coding_free_composition_data (coding
);
5434 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5435 Sverify_visited_file_modtime
, 1, 1, 0,
5436 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5437 This means that the file has not been changed since it was visited or saved. */)
5443 Lisp_Object handler
;
5444 Lisp_Object filename
;
5449 if (!STRINGP (b
->filename
)) return Qt
;
5450 if (b
->modtime
== 0) return Qt
;
5452 /* If the file name has special constructs in it,
5453 call the corresponding file handler. */
5454 handler
= Ffind_file_name_handler (b
->filename
,
5455 Qverify_visited_file_modtime
);
5456 if (!NILP (handler
))
5457 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5459 filename
= ENCODE_FILE (b
->filename
);
5461 if (stat (SDATA (filename
), &st
) < 0)
5463 /* If the file doesn't exist now and didn't exist before,
5464 we say that it isn't modified, provided the error is a tame one. */
5465 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5470 if (st
.st_mtime
== b
->modtime
5471 /* If both are positive, accept them if they are off by one second. */
5472 || (st
.st_mtime
> 0 && b
->modtime
> 0
5473 && (st
.st_mtime
== b
->modtime
+ 1
5474 || st
.st_mtime
== b
->modtime
- 1)))
5479 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5480 Sclear_visited_file_modtime
, 0, 0, 0,
5481 doc
: /* Clear out records of last mod time of visited file.
5482 Next attempt to save will certainly not complain of a discrepancy. */)
5485 current_buffer
->modtime
= 0;
5489 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5490 Svisited_file_modtime
, 0, 0, 0,
5491 doc
: /* Return the current buffer's recorded visited file modification time.
5492 The value is a list of the form (HIGH . LOW), like the time values
5493 that `file-attributes' returns. */)
5496 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5499 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5500 Sset_visited_file_modtime
, 0, 1, 0,
5501 doc
: /* Update buffer's recorded modification time from the visited file's time.
5502 Useful if the buffer was not read from the file normally
5503 or if the file itself has been changed for some known benign reason.
5504 An argument specifies the modification time value to use
5505 \(instead of that of the visited file), in the form of a list
5506 \(HIGH . LOW) or (HIGH LOW). */)
5508 Lisp_Object time_list
;
5510 if (!NILP (time_list
))
5511 current_buffer
->modtime
= cons_to_long (time_list
);
5514 register Lisp_Object filename
;
5516 Lisp_Object handler
;
5518 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5520 /* If the file name has special constructs in it,
5521 call the corresponding file handler. */
5522 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5523 if (!NILP (handler
))
5524 /* The handler can find the file name the same way we did. */
5525 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5527 filename
= ENCODE_FILE (filename
);
5529 if (stat (SDATA (filename
), &st
) >= 0)
5530 current_buffer
->modtime
= st
.st_mtime
;
5537 auto_save_error (error
)
5540 Lisp_Object args
[3], msg
;
5542 struct gcpro gcpro1
;
5546 args
[0] = build_string ("Auto-saving %s: %s");
5547 args
[1] = current_buffer
->name
;
5548 args
[2] = Ferror_message_string (error
);
5549 msg
= Fformat (3, args
);
5551 nbytes
= SBYTES (msg
);
5553 for (i
= 0; i
< 3; ++i
)
5556 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5558 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5559 Fsleep_for (make_number (1), Qnil
);
5571 /* Get visited file's mode to become the auto save file's mode. */
5572 if (! NILP (current_buffer
->filename
)
5573 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5574 /* But make sure we can overwrite it later! */
5575 auto_save_mode_bits
= st
.st_mode
| 0600;
5577 auto_save_mode_bits
= 0666;
5580 Fwrite_region (Qnil
, Qnil
,
5581 current_buffer
->auto_save_file_name
,
5582 Qnil
, Qlambda
, Qnil
, Qnil
);
5586 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5591 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5592 | XFASTINT (XCDR (stream
))));
5597 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5600 minibuffer_auto_raise
= XINT (value
);
5605 do_auto_save_make_dir (dir
)
5608 return call2 (Qmake_directory
, dir
, Qt
);
5612 do_auto_save_eh (ignore
)
5618 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5619 doc
: /* Auto-save all buffers that need it.
5620 This is all buffers that have auto-saving enabled
5621 and are changed since last auto-saved.
5622 Auto-saving writes the buffer into a file
5623 so that your editing is not lost if the system crashes.
5624 This file is not the file you visited; that changes only when you save.
5625 Normally we run the normal hook `auto-save-hook' before saving.
5627 A non-nil NO-MESSAGE argument means do not print any message if successful.
5628 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5629 (no_message
, current_only
)
5630 Lisp_Object no_message
, current_only
;
5632 struct buffer
*old
= current_buffer
, *b
;
5633 Lisp_Object tail
, buf
;
5635 int do_handled_files
;
5638 Lisp_Object lispstream
;
5639 int count
= SPECPDL_INDEX ();
5640 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5641 int old_message_p
= 0;
5642 struct gcpro gcpro1
, gcpro2
;
5644 if (max_specpdl_size
< specpdl_size
+ 40)
5645 max_specpdl_size
= specpdl_size
+ 40;
5650 if (NILP (no_message
))
5652 old_message_p
= push_message ();
5653 record_unwind_protect (pop_message_unwind
, Qnil
);
5656 /* Ordinarily don't quit within this function,
5657 but don't make it impossible to quit (in case we get hung in I/O). */
5661 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5662 point to non-strings reached from Vbuffer_alist. */
5664 if (!NILP (Vrun_hooks
))
5665 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5667 if (STRINGP (Vauto_save_list_file_name
))
5669 Lisp_Object listfile
;
5671 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5673 /* Don't try to create the directory when shutting down Emacs,
5674 because creating the directory might signal an error, and
5675 that would leave Emacs in a strange state. */
5676 if (!NILP (Vrun_hooks
))
5680 GCPRO2 (dir
, listfile
);
5681 dir
= Ffile_name_directory (listfile
);
5682 if (NILP (Ffile_directory_p (dir
)))
5683 internal_condition_case_1 (do_auto_save_make_dir
,
5684 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5689 stream
= fopen (SDATA (listfile
), "w");
5692 /* Arrange to close that file whether or not we get an error.
5693 Also reset auto_saving to 0. */
5694 lispstream
= Fcons (Qnil
, Qnil
);
5695 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5696 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5707 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5708 record_unwind_protect (do_auto_save_unwind_1
,
5709 make_number (minibuffer_auto_raise
));
5710 minibuffer_auto_raise
= 0;
5713 /* First, save all files which don't have handlers. If Emacs is
5714 crashing, the handlers may tweak what is causing Emacs to crash
5715 in the first place, and it would be a shame if Emacs failed to
5716 autosave perfectly ordinary files because it couldn't handle some
5718 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5719 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5721 buf
= XCDR (XCAR (tail
));
5724 /* Record all the buffers that have auto save mode
5725 in the special file that lists them. For each of these buffers,
5726 Record visited name (if any) and auto save name. */
5727 if (STRINGP (b
->auto_save_file_name
)
5728 && stream
!= NULL
&& do_handled_files
== 0)
5730 if (!NILP (b
->filename
))
5732 fwrite (SDATA (b
->filename
), 1,
5733 SBYTES (b
->filename
), stream
);
5735 putc ('\n', stream
);
5736 fwrite (SDATA (b
->auto_save_file_name
), 1,
5737 SBYTES (b
->auto_save_file_name
), stream
);
5738 putc ('\n', stream
);
5741 if (!NILP (current_only
)
5742 && b
!= current_buffer
)
5745 /* Don't auto-save indirect buffers.
5746 The base buffer takes care of it. */
5750 /* Check for auto save enabled
5751 and file changed since last auto save
5752 and file changed since last real save. */
5753 if (STRINGP (b
->auto_save_file_name
)
5754 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5755 && b
->auto_save_modified
< BUF_MODIFF (b
)
5756 /* -1 means we've turned off autosaving for a while--see below. */
5757 && XINT (b
->save_length
) >= 0
5758 && (do_handled_files
5759 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5762 EMACS_TIME before_time
, after_time
;
5764 EMACS_GET_TIME (before_time
);
5766 /* If we had a failure, don't try again for 20 minutes. */
5767 if (b
->auto_save_failure_time
>= 0
5768 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5771 if ((XFASTINT (b
->save_length
) * 10
5772 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5773 /* A short file is likely to change a large fraction;
5774 spare the user annoying messages. */
5775 && XFASTINT (b
->save_length
) > 5000
5776 /* These messages are frequent and annoying for `*mail*'. */
5777 && !EQ (b
->filename
, Qnil
)
5778 && NILP (no_message
))
5780 /* It has shrunk too much; turn off auto-saving here. */
5781 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5782 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5784 minibuffer_auto_raise
= 0;
5785 /* Turn off auto-saving until there's a real save,
5786 and prevent any more warnings. */
5787 XSETINT (b
->save_length
, -1);
5788 Fsleep_for (make_number (1), Qnil
);
5791 set_buffer_internal (b
);
5792 if (!auto_saved
&& NILP (no_message
))
5793 message1 ("Auto-saving...");
5794 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5796 b
->auto_save_modified
= BUF_MODIFF (b
);
5797 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5798 set_buffer_internal (old
);
5800 EMACS_GET_TIME (after_time
);
5802 /* If auto-save took more than 60 seconds,
5803 assume it was an NFS failure that got a timeout. */
5804 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5805 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5809 /* Prevent another auto save till enough input events come in. */
5810 record_auto_save ();
5812 if (auto_saved
&& NILP (no_message
))
5816 /* If we are going to restore an old message,
5817 give time to read ours. */
5818 sit_for (1, 0, 0, 0, 0);
5822 /* If we displayed a message and then restored a state
5823 with no message, leave a "done" message on the screen. */
5824 message1 ("Auto-saving...done");
5829 /* This restores the message-stack status. */
5830 unbind_to (count
, Qnil
);
5834 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5835 Sset_buffer_auto_saved
, 0, 0, 0,
5836 doc
: /* Mark current buffer as auto-saved with its current text.
5837 No auto-save file will be written until the buffer changes again. */)
5840 current_buffer
->auto_save_modified
= MODIFF
;
5841 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5842 current_buffer
->auto_save_failure_time
= -1;
5846 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5847 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5848 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5851 current_buffer
->auto_save_failure_time
= -1;
5855 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5857 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
5860 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5863 /* Reading and completing file names */
5864 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5866 /* In the string VAL, change each $ to $$ and return the result. */
5869 double_dollars (val
)
5872 register const unsigned char *old
;
5873 register unsigned char *new;
5877 osize
= SBYTES (val
);
5879 /* Count the number of $ characters. */
5880 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
5881 if (*old
++ == '$') count
++;
5885 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
5888 for (n
= osize
; n
> 0; n
--)
5902 read_file_name_cleanup (arg
)
5905 return (current_buffer
->directory
= arg
);
5908 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5910 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
5911 (string
, dir
, action
)
5912 Lisp_Object string
, dir
, action
;
5913 /* action is nil for complete, t for return list of completions,
5914 lambda for verify final value */
5916 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5918 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5920 CHECK_STRING (string
);
5927 /* No need to protect ACTION--we only compare it with t and nil. */
5928 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5930 if (SCHARS (string
) == 0)
5932 if (EQ (action
, Qlambda
))
5940 orig_string
= string
;
5941 string
= Fsubstitute_in_file_name (string
);
5942 changed
= NILP (Fstring_equal (string
, orig_string
));
5943 name
= Ffile_name_nondirectory (string
);
5944 val
= Ffile_name_directory (string
);
5946 realdir
= Fexpand_file_name (val
, realdir
);
5951 specdir
= Ffile_name_directory (string
);
5952 val
= Ffile_name_completion (name
, realdir
);
5957 return double_dollars (string
);
5961 if (!NILP (specdir
))
5962 val
= concat2 (specdir
, val
);
5964 return double_dollars (val
);
5967 #endif /* not VMS */
5971 if (EQ (action
, Qt
))
5973 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
5977 if (NILP (Vread_file_name_predicate
)
5978 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
5982 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
5984 /* Brute-force speed up for directory checking:
5985 Discard strings which don't end in a slash. */
5986 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
5988 Lisp_Object tem
= XCAR (all
);
5990 if (STRINGP (tem
) &&
5991 (len
= SCHARS (tem
), len
> 0) &&
5992 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
5993 comp
= Fcons (tem
, comp
);
5999 /* Must do it the hard (and slow) way. */
6000 GCPRO3 (all
, comp
, specdir
);
6001 count
= SPECPDL_INDEX ();
6002 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6003 current_buffer
->directory
= realdir
;
6004 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6005 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6006 comp
= Fcons (XCAR (all
), comp
);
6007 unbind_to (count
, Qnil
);
6010 return Fnreverse (comp
);
6013 /* Only other case actually used is ACTION = lambda */
6015 /* Supposedly this helps commands such as `cd' that read directory names,
6016 but can someone explain how it helps them? -- RMS */
6017 if (SCHARS (name
) == 0)
6020 if (!NILP (Vread_file_name_predicate
))
6021 return call1 (Vread_file_name_predicate
, string
);
6022 return Ffile_exists_p (string
);
6025 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6026 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6027 Value is not expanded---you must call `expand-file-name' yourself.
6028 Default name to DEFAULT-FILENAME if user enters a null string.
6029 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6030 except that if INITIAL is specified, that combined with DIR is used.)
6031 Fourth arg MUSTMATCH non-nil means require existing file's name.
6032 Non-nil and non-t means also require confirmation after completion.
6033 Fifth arg INITIAL specifies text to start with.
6034 If optional sixth arg PREDICATE is non-nil, possible completions and the
6035 resulting file name must satisfy (funcall PREDICATE NAME).
6036 DIR defaults to current buffer's directory default.
6038 If this command was invoked with the mouse, use a file dialog box if
6039 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6040 provides a file dialog box. */)
6041 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6042 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6044 Lisp_Object val
, insdef
, tem
;
6045 struct gcpro gcpro1
, gcpro2
;
6046 register char *homedir
;
6047 Lisp_Object decoded_homedir
;
6048 int replace_in_history
= 0;
6049 int add_to_history
= 0;
6053 dir
= current_buffer
->directory
;
6054 if (NILP (default_filename
))
6055 default_filename
= !NILP (initial
)
6056 ? Fexpand_file_name (initial
, dir
)
6057 : current_buffer
->filename
;
6059 /* If dir starts with user's homedir, change that to ~. */
6060 homedir
= (char *) egetenv ("HOME");
6062 /* homedir can be NULL in temacs, since Vprocess_environment is not
6063 yet set up. We shouldn't crash in that case. */
6066 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6067 CORRECT_DIR_SEPS (homedir
);
6072 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6075 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6076 SBYTES (decoded_homedir
))
6077 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6079 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6080 dir
= concat2 (build_string ("~"), dir
);
6082 /* Likewise for default_filename. */
6084 && STRINGP (default_filename
)
6085 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6086 SBYTES (decoded_homedir
))
6087 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6090 = Fsubstring (default_filename
,
6091 make_number (SCHARS (decoded_homedir
)), Qnil
);
6092 default_filename
= concat2 (build_string ("~"), default_filename
);
6094 if (!NILP (default_filename
))
6096 CHECK_STRING (default_filename
);
6097 default_filename
= double_dollars (default_filename
);
6100 if (insert_default_directory
&& STRINGP (dir
))
6103 if (!NILP (initial
))
6105 Lisp_Object args
[2], pos
;
6109 insdef
= Fconcat (2, args
);
6110 pos
= make_number (SCHARS (double_dollars (dir
)));
6111 insdef
= Fcons (double_dollars (insdef
), pos
);
6114 insdef
= double_dollars (insdef
);
6116 else if (STRINGP (initial
))
6117 insdef
= Fcons (double_dollars (initial
), make_number (0));
6121 if (!NILP (Vread_file_name_function
))
6123 Lisp_Object args
[7];
6125 GCPRO2 (insdef
, default_filename
);
6126 args
[0] = Vread_file_name_function
;
6129 args
[3] = default_filename
;
6130 args
[4] = mustmatch
;
6132 args
[6] = predicate
;
6133 RETURN_UNGCPRO (Ffuncall (7, args
));
6136 count
= SPECPDL_INDEX ();
6138 specbind (intern ("completion-ignore-case"), Qt
);
6141 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6142 specbind (intern ("read-file-name-predicate"),
6143 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6145 GCPRO2 (insdef
, default_filename
);
6147 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
6148 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6152 /* If DIR contains a file name, split it. */
6154 file
= Ffile_name_nondirectory (dir
);
6155 if (SCHARS (file
) && NILP (default_filename
))
6157 default_filename
= file
;
6158 dir
= Ffile_name_directory (dir
);
6160 if (!NILP(default_filename
))
6161 default_filename
= Fexpand_file_name (default_filename
, dir
);
6162 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6167 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6168 dir
, mustmatch
, insdef
,
6169 Qfile_name_history
, default_filename
, Qnil
);
6171 tem
= Fsymbol_value (Qfile_name_history
);
6172 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6173 replace_in_history
= 1;
6175 /* If Fcompleting_read returned the inserted default string itself
6176 (rather than a new string with the same contents),
6177 it has to mean that the user typed RET with the minibuffer empty.
6178 In that case, we really want to return ""
6179 so that commands such as set-visited-file-name can distinguish. */
6180 if (EQ (val
, default_filename
))
6182 /* In this case, Fcompleting_read has not added an element
6183 to the history. Maybe we should. */
6184 if (! replace_in_history
)
6190 unbind_to (count
, Qnil
);
6193 error ("No file name specified");
6195 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6197 if (!NILP (tem
) && !NILP (default_filename
))
6198 val
= default_filename
;
6199 else if (SCHARS (val
) == 0 && NILP (insdef
))
6201 if (!NILP (default_filename
))
6202 val
= default_filename
;
6204 error ("No default file name");
6206 val
= Fsubstitute_in_file_name (val
);
6208 if (replace_in_history
)
6209 /* Replace what Fcompleting_read added to the history
6210 with what we will actually return. */
6211 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6212 else if (add_to_history
)
6214 /* Add the value to the history--but not if it matches
6215 the last value already there. */
6216 Lisp_Object val1
= double_dollars (val
);
6217 tem
= Fsymbol_value (Qfile_name_history
);
6218 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6219 Fset (Qfile_name_history
,
6230 /* Must be set before any path manipulation is performed. */
6231 XSETFASTINT (Vdirectory_sep_char
, '/');
6238 Qexpand_file_name
= intern ("expand-file-name");
6239 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6240 Qdirectory_file_name
= intern ("directory-file-name");
6241 Qfile_name_directory
= intern ("file-name-directory");
6242 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6243 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6244 Qfile_name_as_directory
= intern ("file-name-as-directory");
6245 Qcopy_file
= intern ("copy-file");
6246 Qmake_directory_internal
= intern ("make-directory-internal");
6247 Qmake_directory
= intern ("make-directory");
6248 Qdelete_directory
= intern ("delete-directory");
6249 Qdelete_file
= intern ("delete-file");
6250 Qrename_file
= intern ("rename-file");
6251 Qadd_name_to_file
= intern ("add-name-to-file");
6252 Qmake_symbolic_link
= intern ("make-symbolic-link");
6253 Qfile_exists_p
= intern ("file-exists-p");
6254 Qfile_executable_p
= intern ("file-executable-p");
6255 Qfile_readable_p
= intern ("file-readable-p");
6256 Qfile_writable_p
= intern ("file-writable-p");
6257 Qfile_symlink_p
= intern ("file-symlink-p");
6258 Qaccess_file
= intern ("access-file");
6259 Qfile_directory_p
= intern ("file-directory-p");
6260 Qfile_regular_p
= intern ("file-regular-p");
6261 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6262 Qfile_modes
= intern ("file-modes");
6263 Qset_file_modes
= intern ("set-file-modes");
6264 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6265 Qinsert_file_contents
= intern ("insert-file-contents");
6266 Qwrite_region
= intern ("write-region");
6267 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6268 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6270 staticpro (&Qexpand_file_name
);
6271 staticpro (&Qsubstitute_in_file_name
);
6272 staticpro (&Qdirectory_file_name
);
6273 staticpro (&Qfile_name_directory
);
6274 staticpro (&Qfile_name_nondirectory
);
6275 staticpro (&Qunhandled_file_name_directory
);
6276 staticpro (&Qfile_name_as_directory
);
6277 staticpro (&Qcopy_file
);
6278 staticpro (&Qmake_directory_internal
);
6279 staticpro (&Qmake_directory
);
6280 staticpro (&Qdelete_directory
);
6281 staticpro (&Qdelete_file
);
6282 staticpro (&Qrename_file
);
6283 staticpro (&Qadd_name_to_file
);
6284 staticpro (&Qmake_symbolic_link
);
6285 staticpro (&Qfile_exists_p
);
6286 staticpro (&Qfile_executable_p
);
6287 staticpro (&Qfile_readable_p
);
6288 staticpro (&Qfile_writable_p
);
6289 staticpro (&Qaccess_file
);
6290 staticpro (&Qfile_symlink_p
);
6291 staticpro (&Qfile_directory_p
);
6292 staticpro (&Qfile_regular_p
);
6293 staticpro (&Qfile_accessible_directory_p
);
6294 staticpro (&Qfile_modes
);
6295 staticpro (&Qset_file_modes
);
6296 staticpro (&Qfile_newer_than_file_p
);
6297 staticpro (&Qinsert_file_contents
);
6298 staticpro (&Qwrite_region
);
6299 staticpro (&Qverify_visited_file_modtime
);
6300 staticpro (&Qset_visited_file_modtime
);
6302 Qfile_name_history
= intern ("file-name-history");
6303 Fset (Qfile_name_history
, Qnil
);
6304 staticpro (&Qfile_name_history
);
6306 Qfile_error
= intern ("file-error");
6307 staticpro (&Qfile_error
);
6308 Qfile_already_exists
= intern ("file-already-exists");
6309 staticpro (&Qfile_already_exists
);
6310 Qfile_date_error
= intern ("file-date-error");
6311 staticpro (&Qfile_date_error
);
6312 Qexcl
= intern ("excl");
6316 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6317 staticpro (&Qfind_buffer_file_type
);
6320 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6321 doc
: /* *Coding system for encoding file names.
6322 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6323 Vfile_name_coding_system
= Qnil
;
6325 DEFVAR_LISP ("default-file-name-coding-system",
6326 &Vdefault_file_name_coding_system
,
6327 doc
: /* Default coding system for encoding file names.
6328 This variable is used only when `file-name-coding-system' is nil.
6330 This variable is set/changed by the command `set-language-environment'.
6331 User should not set this variable manually,
6332 instead use `file-name-coding-system' to get a constant encoding
6333 of file names regardless of the current language environment. */);
6334 Vdefault_file_name_coding_system
= Qnil
;
6336 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6337 doc
: /* *Format in which to write auto-save files.
6338 Should be a list of symbols naming formats that are defined in `format-alist'.
6339 If it is t, which is the default, auto-save files are written in the
6340 same format as a regular save would use. */);
6341 Vauto_save_file_format
= Qt
;
6343 Qformat_decode
= intern ("format-decode");
6344 staticpro (&Qformat_decode
);
6345 Qformat_annotate_function
= intern ("format-annotate-function");
6346 staticpro (&Qformat_annotate_function
);
6348 Qcar_less_than_car
= intern ("car-less-than-car");
6349 staticpro (&Qcar_less_than_car
);
6351 Fput (Qfile_error
, Qerror_conditions
,
6352 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6353 Fput (Qfile_error
, Qerror_message
,
6354 build_string ("File error"));
6356 Fput (Qfile_already_exists
, Qerror_conditions
,
6357 Fcons (Qfile_already_exists
,
6358 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6359 Fput (Qfile_already_exists
, Qerror_message
,
6360 build_string ("File already exists"));
6362 Fput (Qfile_date_error
, Qerror_conditions
,
6363 Fcons (Qfile_date_error
,
6364 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6365 Fput (Qfile_date_error
, Qerror_message
,
6366 build_string ("Cannot set file date"));
6368 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6369 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6370 Vread_file_name_function
= Qnil
;
6372 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6373 doc
: /* Current predicate used by `read-file-name-internal'. */);
6374 Vread_file_name_predicate
= Qnil
;
6376 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6377 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer. */);
6378 insert_default_directory
= 1;
6380 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6381 doc
: /* *Non-nil means write new files with record format `stmlf'.
6382 nil means use format `var'. This variable is meaningful only on VMS. */);
6383 vms_stmlf_recfm
= 0;
6385 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6386 doc
: /* Directory separator character for built-in functions that return file names.
6387 The value is always ?/. Don't use this variable, just use `/'. */);
6389 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6390 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6391 If a file name matches REGEXP, then all I/O on that file is done by calling
6394 The first argument given to HANDLER is the name of the I/O primitive
6395 to be handled; the remaining arguments are the arguments that were
6396 passed to that primitive. For example, if you do
6397 (file-exists-p FILENAME)
6398 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6399 (funcall HANDLER 'file-exists-p FILENAME)
6400 The function `find-file-name-handler' checks this list for a handler
6401 for its argument. */);
6402 Vfile_name_handler_alist
= Qnil
;
6404 DEFVAR_LISP ("set-auto-coding-function",
6405 &Vset_auto_coding_function
,
6406 doc
: /* If non-nil, a function to call to decide a coding system of file.
6407 Two arguments are passed to this function: the file name
6408 and the length of a file contents following the point.
6409 This function should return a coding system to decode the file contents.
6410 It should check the file name against `auto-coding-alist'.
6411 If no coding system is decided, it should check a coding system
6412 specified in the heading lines with the format:
6413 -*- ... coding: CODING-SYSTEM; ... -*-
6414 or local variable spec of the tailing lines with `coding:' tag. */);
6415 Vset_auto_coding_function
= Qnil
;
6417 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6418 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6419 Each is passed one argument, the number of characters inserted.
6420 It should return the new character count, and leave point the same.
6421 If `insert-file-contents' is intercepted by a handler from
6422 `file-name-handler-alist', that handler is responsible for calling the
6423 functions in `after-insert-file-functions' if appropriate. */);
6424 Vafter_insert_file_functions
= Qnil
;
6426 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6427 doc
: /* A list of functions to be called at the start of `write-region'.
6428 Each is passed two arguments, START and END as for `write-region'.
6429 These are usually two numbers but not always; see the documentation
6430 for `write-region'. The function should return a list of pairs
6431 of the form (POSITION . STRING), consisting of strings to be effectively
6432 inserted at the specified positions of the file being written (1 means to
6433 insert before the first byte written). The POSITIONs must be sorted into
6434 increasing order. If there are several functions in the list, the several
6435 lists are merged destructively. Alternatively, the function can return
6436 with a different buffer current and value nil.*/);
6437 Vwrite_region_annotate_functions
= Qnil
;
6439 DEFVAR_LISP ("write-region-annotations-so-far",
6440 &Vwrite_region_annotations_so_far
,
6441 doc
: /* When an annotation function is called, this holds the previous annotations.
6442 These are the annotations made by other annotation functions
6443 that were already called. See also `write-region-annotate-functions'. */);
6444 Vwrite_region_annotations_so_far
= Qnil
;
6446 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6447 doc
: /* A list of file name handlers that temporarily should not be used.
6448 This applies only to the operation `inhibit-file-name-operation'. */);
6449 Vinhibit_file_name_handlers
= Qnil
;
6451 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6452 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6453 Vinhibit_file_name_operation
= Qnil
;
6455 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6456 doc
: /* File name in which we write a list of all auto save file names.
6457 This variable is initialized automatically from `auto-save-list-file-prefix'
6458 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6459 a non-nil value. */);
6460 Vauto_save_list_file_name
= Qnil
;
6462 defsubr (&Sfind_file_name_handler
);
6463 defsubr (&Sfile_name_directory
);
6464 defsubr (&Sfile_name_nondirectory
);
6465 defsubr (&Sunhandled_file_name_directory
);
6466 defsubr (&Sfile_name_as_directory
);
6467 defsubr (&Sdirectory_file_name
);
6468 defsubr (&Smake_temp_name
);
6469 defsubr (&Sexpand_file_name
);
6470 defsubr (&Ssubstitute_in_file_name
);
6471 defsubr (&Scopy_file
);
6472 defsubr (&Smake_directory_internal
);
6473 defsubr (&Sdelete_directory
);
6474 defsubr (&Sdelete_file
);
6475 defsubr (&Srename_file
);
6476 defsubr (&Sadd_name_to_file
);
6478 defsubr (&Smake_symbolic_link
);
6479 #endif /* S_IFLNK */
6481 defsubr (&Sdefine_logical_name
);
6484 defsubr (&Ssysnetunam
);
6485 #endif /* HPUX_NET */
6486 defsubr (&Sfile_name_absolute_p
);
6487 defsubr (&Sfile_exists_p
);
6488 defsubr (&Sfile_executable_p
);
6489 defsubr (&Sfile_readable_p
);
6490 defsubr (&Sfile_writable_p
);
6491 defsubr (&Saccess_file
);
6492 defsubr (&Sfile_symlink_p
);
6493 defsubr (&Sfile_directory_p
);
6494 defsubr (&Sfile_accessible_directory_p
);
6495 defsubr (&Sfile_regular_p
);
6496 defsubr (&Sfile_modes
);
6497 defsubr (&Sset_file_modes
);
6498 defsubr (&Sset_default_file_modes
);
6499 defsubr (&Sdefault_file_modes
);
6500 defsubr (&Sfile_newer_than_file_p
);
6501 defsubr (&Sinsert_file_contents
);
6502 defsubr (&Swrite_region
);
6503 defsubr (&Scar_less_than_car
);
6504 defsubr (&Sverify_visited_file_modtime
);
6505 defsubr (&Sclear_visited_file_modtime
);
6506 defsubr (&Svisited_file_modtime
);
6507 defsubr (&Sset_visited_file_modtime
);
6508 defsubr (&Sdo_auto_save
);
6509 defsubr (&Sset_buffer_auto_saved
);
6510 defsubr (&Sclear_buffer_auto_save_failure
);
6511 defsubr (&Srecent_auto_save_p
);
6513 defsubr (&Sread_file_name_internal
);
6514 defsubr (&Sread_file_name
);
6517 defsubr (&Sunix_sync
);