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 name of the file to which it is linked.
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 bytes 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
,
4497 /* Use the conversion type to determine buffer-file-type
4498 (find-buffer-file-type is now used to help determine the
4500 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4501 || coding
.eol_type
== CODING_EOL_LF
)
4502 && ! CODING_REQUIRE_DECODING (&coding
))
4503 current_buffer
->buffer_file_type
= Qt
;
4505 current_buffer
->buffer_file_type
= Qnil
;
4512 if (!EQ (current_buffer
->undo_list
, Qt
))
4513 current_buffer
->undo_list
= Qnil
;
4515 stat (SDATA (filename
), &st
);
4520 current_buffer
->modtime
= st
.st_mtime
;
4521 current_buffer
->filename
= orig_filename
;
4524 SAVE_MODIFF
= MODIFF
;
4525 current_buffer
->auto_save_modified
= MODIFF
;
4526 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4527 #ifdef CLASH_DETECTION
4530 if (!NILP (current_buffer
->file_truename
))
4531 unlock_file (current_buffer
->file_truename
);
4532 unlock_file (filename
);
4534 #endif /* CLASH_DETECTION */
4536 Fsignal (Qfile_error
,
4537 Fcons (build_string ("not a regular file"),
4538 Fcons (orig_filename
, Qnil
)));
4541 /* Decode file format */
4544 int empty_undo_list_p
= 0;
4546 /* If we're anyway going to discard undo information, don't
4547 record it in the first place. The buffer's undo list at this
4548 point is either nil or t when visiting a file. */
4551 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4552 current_buffer
->undo_list
= Qt
;
4555 insval
= call3 (Qformat_decode
,
4556 Qnil
, make_number (inserted
), visit
);
4557 CHECK_NUMBER (insval
);
4558 inserted
= XFASTINT (insval
);
4561 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4564 if (set_coding_system
)
4565 Vlast_coding_system_used
= coding
.symbol
;
4567 /* Call after-change hooks for the inserted text, aside from the case
4568 of normal visiting (not with REPLACE), which is done in a new buffer
4569 "before" the buffer is changed. */
4570 if (inserted
> 0 && total
> 0
4571 && (NILP (visit
) || !NILP (replace
)))
4573 signal_after_change (PT
, 0, inserted
);
4574 update_compositions (PT
, PT
, CHECK_BORDER
);
4577 p
= Vafter_insert_file_functions
;
4580 insval
= call1 (XCAR (p
), make_number (inserted
));
4583 CHECK_NUMBER (insval
);
4584 inserted
= XFASTINT (insval
);
4591 && current_buffer
->modtime
== -1)
4593 /* If visiting nonexistent file, return nil. */
4594 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4598 Fsignal (Qquit
, Qnil
);
4600 /* ??? Retval needs to be dealt with in all cases consistently. */
4602 val
= Fcons (orig_filename
,
4603 Fcons (make_number (inserted
),
4606 RETURN_UNGCPRO (unbind_to (count
, val
));
4609 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4610 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4611 Lisp_Object
, Lisp_Object
));
4613 /* If build_annotations switched buffers, switch back to BUF.
4614 Kill the temporary buffer that was selected in the meantime.
4616 Since this kill only the last temporary buffer, some buffers remain
4617 not killed if build_annotations switched buffers more than once.
4621 build_annotations_unwind (buf
)
4626 if (XBUFFER (buf
) == current_buffer
)
4628 tembuf
= Fcurrent_buffer ();
4630 Fkill_buffer (tembuf
);
4634 /* Decide the coding-system to encode the data with. */
4637 choose_write_coding_system (start
, end
, filename
,
4638 append
, visit
, lockname
, coding
)
4639 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4640 struct coding_system
*coding
;
4646 else if (!NILP (Vcoding_system_for_write
))
4648 val
= Vcoding_system_for_write
;
4649 if (coding_system_require_warning
4650 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4651 /* Confirm that VAL can surely encode the current region. */
4652 val
= call5 (Vselect_safe_coding_system_function
,
4653 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4658 /* If the variable `buffer-file-coding-system' is set locally,
4659 it means that the file was read with some kind of code
4660 conversion or the variable is explicitly set by users. We
4661 had better write it out with the same coding system even if
4662 `enable-multibyte-characters' is nil.
4664 If it is not set locally, we anyway have to convert EOL
4665 format if the default value of `buffer-file-coding-system'
4666 tells that it is not Unix-like (LF only) format. */
4667 int using_default_coding
= 0;
4668 int force_raw_text
= 0;
4670 val
= current_buffer
->buffer_file_coding_system
;
4672 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4675 if (NILP (current_buffer
->enable_multibyte_characters
))
4681 /* Check file-coding-system-alist. */
4682 Lisp_Object args
[7], coding_systems
;
4684 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4685 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4687 coding_systems
= Ffind_operation_coding_system (7, args
);
4688 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4689 val
= XCDR (coding_systems
);
4693 && !NILP (current_buffer
->buffer_file_coding_system
))
4695 /* If we still have not decided a coding system, use the
4696 default value of buffer-file-coding-system. */
4697 val
= current_buffer
->buffer_file_coding_system
;
4698 using_default_coding
= 1;
4702 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4703 /* Confirm that VAL can surely encode the current region. */
4704 val
= call5 (Vselect_safe_coding_system_function
,
4705 start
, end
, val
, Qnil
, filename
);
4707 setup_coding_system (Fcheck_coding_system (val
), coding
);
4708 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4709 && !using_default_coding
)
4711 if (! EQ (default_buffer_file_coding
.symbol
,
4712 buffer_defaults
.buffer_file_coding_system
))
4713 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4714 &default_buffer_file_coding
);
4715 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4717 Lisp_Object subsidiaries
;
4719 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4720 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4721 if (VECTORP (subsidiaries
)
4722 && XVECTOR (subsidiaries
)->size
== 3)
4724 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4729 setup_raw_text_coding_system (coding
);
4730 goto done_setup_coding
;
4733 setup_coding_system (Fcheck_coding_system (val
), coding
);
4736 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4737 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4740 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4741 "r\nFWrite region to file: \ni\ni\ni\np",
4742 doc
: /* Write current region into specified file.
4743 When called from a program, requires three arguments:
4744 START, END and FILENAME. START and END are normally buffer positions
4745 specifying the part of the buffer to write.
4746 If START is nil, that means to use the entire buffer contents.
4747 If START is a string, then output that string to the file
4748 instead of any buffer contents; END is ignored.
4750 Optional fourth argument APPEND if non-nil means
4751 append to existing file contents (if any). If it is an integer,
4752 seek to that offset in the file before writing.
4753 Optional fifth argument VISIT if t means
4754 set the last-save-file-modtime of buffer to this file's modtime
4755 and mark buffer not modified.
4756 If VISIT is a string, it is a second file name;
4757 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4758 VISIT is also the file name to lock and unlock for clash detection.
4759 If VISIT is neither t nor nil nor a string,
4760 that means do not display the \"Wrote file\" message.
4761 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4762 use for locking and unlocking, overriding FILENAME and VISIT.
4763 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4764 for an existing file with the same name. If MUSTBENEW is `excl',
4765 that means to get an error if the file already exists; never overwrite.
4766 If MUSTBENEW is neither nil nor `excl', that means ask for
4767 confirmation before overwriting, but do go ahead and overwrite the file
4768 if the user confirms.
4770 This does code conversion according to the value of
4771 `coding-system-for-write', `buffer-file-coding-system', or
4772 `file-coding-system-alist', and sets the variable
4773 `last-coding-system-used' to the coding system actually used. */)
4774 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4775 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4780 const unsigned char *fn
;
4783 int count
= SPECPDL_INDEX ();
4786 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4788 Lisp_Object handler
;
4789 Lisp_Object visit_file
;
4790 Lisp_Object annotations
;
4791 Lisp_Object encoded_filename
;
4792 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4793 int quietly
= !NILP (visit
);
4794 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4795 struct buffer
*given_buffer
;
4797 int buffer_file_type
= O_BINARY
;
4799 struct coding_system coding
;
4801 if (current_buffer
->base_buffer
&& visiting
)
4802 error ("Cannot do file visiting in an indirect buffer");
4804 if (!NILP (start
) && !STRINGP (start
))
4805 validate_region (&start
, &end
);
4807 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4809 filename
= Fexpand_file_name (filename
, Qnil
);
4811 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4812 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4814 if (STRINGP (visit
))
4815 visit_file
= Fexpand_file_name (visit
, Qnil
);
4817 visit_file
= filename
;
4819 if (NILP (lockname
))
4820 lockname
= visit_file
;
4824 /* If the file name has special constructs in it,
4825 call the corresponding file handler. */
4826 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4827 /* If FILENAME has no handler, see if VISIT has one. */
4828 if (NILP (handler
) && STRINGP (visit
))
4829 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4831 if (!NILP (handler
))
4834 val
= call6 (handler
, Qwrite_region
, start
, end
,
4835 filename
, append
, visit
);
4839 SAVE_MODIFF
= MODIFF
;
4840 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4841 current_buffer
->filename
= visit_file
;
4847 /* Special kludge to simplify auto-saving. */
4850 XSETFASTINT (start
, BEG
);
4851 XSETFASTINT (end
, Z
);
4854 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4855 count1
= SPECPDL_INDEX ();
4857 given_buffer
= current_buffer
;
4859 if (!STRINGP (start
))
4861 annotations
= build_annotations (start
, end
);
4863 if (current_buffer
!= given_buffer
)
4865 XSETFASTINT (start
, BEGV
);
4866 XSETFASTINT (end
, ZV
);
4872 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4874 /* Decide the coding-system to encode the data with.
4875 We used to make this choice before calling build_annotations, but that
4876 leads to problems when a write-annotate-function takes care of
4877 unsavable chars (as was the case with X-Symbol). */
4878 choose_write_coding_system (start
, end
, filename
,
4879 append
, visit
, lockname
, &coding
);
4880 Vlast_coding_system_used
= coding
.symbol
;
4882 given_buffer
= current_buffer
;
4883 if (! STRINGP (start
))
4885 annotations
= build_annotations_2 (start
, end
,
4886 coding
.pre_write_conversion
, annotations
);
4887 if (current_buffer
!= given_buffer
)
4889 XSETFASTINT (start
, BEGV
);
4890 XSETFASTINT (end
, ZV
);
4894 #ifdef CLASH_DETECTION
4897 #if 0 /* This causes trouble for GNUS. */
4898 /* If we've locked this file for some other buffer,
4899 query before proceeding. */
4900 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4901 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4904 lock_file (lockname
);
4906 #endif /* CLASH_DETECTION */
4908 encoded_filename
= ENCODE_FILE (filename
);
4910 fn
= SDATA (encoded_filename
);
4914 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4915 #else /* not DOS_NT */
4916 desc
= emacs_open (fn
, O_WRONLY
, 0);
4917 #endif /* not DOS_NT */
4919 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4921 if (auto_saving
) /* Overwrite any previous version of autosave file */
4923 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4924 desc
= emacs_open (fn
, O_RDWR
, 0);
4926 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4927 ? SDATA (current_buffer
->filename
) : 0,
4930 else /* Write to temporary name and rename if no errors */
4932 Lisp_Object temp_name
;
4933 temp_name
= Ffile_name_directory (filename
);
4935 if (!NILP (temp_name
))
4937 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4938 build_string ("$$SAVE$$")));
4939 fname
= SDATA (filename
);
4940 fn
= SDATA (temp_name
);
4941 desc
= creat_copy_attrs (fname
, fn
);
4944 /* If we can't open the temporary file, try creating a new
4945 version of the original file. VMS "creat" creates a
4946 new version rather than truncating an existing file. */
4949 desc
= creat (fn
, 0666);
4950 #if 0 /* This can clobber an existing file and fail to replace it,
4951 if the user runs out of space. */
4954 /* We can't make a new version;
4955 try to truncate and rewrite existing version if any. */
4957 desc
= emacs_open (fn
, O_RDWR
, 0);
4963 desc
= creat (fn
, 0666);
4967 desc
= emacs_open (fn
,
4968 O_WRONLY
| O_CREAT
| buffer_file_type
4969 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4970 S_IREAD
| S_IWRITE
);
4971 #else /* not DOS_NT */
4972 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4973 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4974 auto_saving
? auto_save_mode_bits
: 0666);
4975 #endif /* not DOS_NT */
4976 #endif /* not VMS */
4980 #ifdef CLASH_DETECTION
4982 if (!auto_saving
) unlock_file (lockname
);
4984 #endif /* CLASH_DETECTION */
4986 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4989 record_unwind_protect (close_file_unwind
, make_number (desc
));
4991 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4995 if (NUMBERP (append
))
4996 ret
= lseek (desc
, XINT (append
), 1);
4998 ret
= lseek (desc
, 0, 2);
5001 #ifdef CLASH_DETECTION
5002 if (!auto_saving
) unlock_file (lockname
);
5003 #endif /* CLASH_DETECTION */
5005 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5013 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5014 * if we do writes that don't end with a carriage return. Furthermore
5015 * it cannot handle writes of more then 16K. The modified
5016 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5017 * this EXCEPT for the last record (iff it doesn't end with a carriage
5018 * return). This implies that if your buffer doesn't end with a carriage
5019 * return, you get one free... tough. However it also means that if
5020 * we make two calls to sys_write (a la the following code) you can
5021 * get one at the gap as well. The easiest way to fix this (honest)
5022 * is to move the gap to the next newline (or the end of the buffer).
5027 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5028 move_gap (find_next_newline (GPT
, 1));
5030 /* Whether VMS or not, we must move the gap to the next of newline
5031 when we must put designation sequences at beginning of line. */
5032 if (INTEGERP (start
)
5033 && coding
.type
== coding_type_iso2022
5034 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5035 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5037 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5038 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5039 move_gap_both (PT
, PT_BYTE
);
5040 SET_PT_BOTH (opoint
, opoint_byte
);
5047 if (STRINGP (start
))
5049 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5050 &annotations
, &coding
);
5053 else if (XINT (start
) != XINT (end
))
5055 tem
= CHAR_TO_BYTE (XINT (start
));
5057 if (XINT (start
) < GPT
)
5059 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5060 min (GPT
, XINT (end
)) - XINT (start
),
5061 &annotations
, &coding
);
5065 if (XINT (end
) > GPT
&& !failure
)
5067 tem
= max (XINT (start
), GPT
);
5068 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5069 &annotations
, &coding
);
5075 /* If file was empty, still need to write the annotations */
5076 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5077 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5081 if (CODING_REQUIRE_FLUSHING (&coding
)
5082 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5085 /* We have to flush out a data. */
5086 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5087 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5094 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5095 Disk full in NFS may be reported here. */
5096 /* mib says that closing the file will try to write as fast as NFS can do
5097 it, and that means the fsync here is not crucial for autosave files. */
5098 if (!auto_saving
&& fsync (desc
) < 0)
5100 /* If fsync fails with EINTR, don't treat that as serious. */
5102 failure
= 1, save_errno
= errno
;
5106 /* Spurious "file has changed on disk" warnings have been
5107 observed on Suns as well.
5108 It seems that `close' can change the modtime, under nfs.
5110 (This has supposedly been fixed in Sunos 4,
5111 but who knows about all the other machines with NFS?) */
5114 /* On VMS and APOLLO, must do the stat after the close
5115 since closing changes the modtime. */
5118 /* Recall that #if defined does not work on VMS. */
5125 /* NFS can report a write failure now. */
5126 if (emacs_close (desc
) < 0)
5127 failure
= 1, save_errno
= errno
;
5130 /* If we wrote to a temporary name and had no errors, rename to real name. */
5134 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5142 /* Discard the unwind protect for close_file_unwind. */
5143 specpdl_ptr
= specpdl
+ count1
;
5144 /* Restore the original current buffer. */
5145 visit_file
= unbind_to (count
, visit_file
);
5147 #ifdef CLASH_DETECTION
5149 unlock_file (lockname
);
5150 #endif /* CLASH_DETECTION */
5152 /* Do this before reporting IO error
5153 to avoid a "file has changed on disk" warning on
5154 next attempt to save. */
5156 current_buffer
->modtime
= st
.st_mtime
;
5159 error ("IO error writing %s: %s", SDATA (filename
),
5160 emacs_strerror (save_errno
));
5164 SAVE_MODIFF
= MODIFF
;
5165 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5166 current_buffer
->filename
= visit_file
;
5167 update_mode_lines
++;
5173 message_with_string ("Wrote %s", visit_file
, 1);
5178 Lisp_Object
merge ();
5180 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5181 doc
: /* Return t if (car A) is numerically less than (car B). */)
5185 return Flss (Fcar (a
), Fcar (b
));
5188 /* Build the complete list of annotations appropriate for writing out
5189 the text between START and END, by calling all the functions in
5190 write-region-annotate-functions and merging the lists they return.
5191 If one of these functions switches to a different buffer, we assume
5192 that buffer contains altered text. Therefore, the caller must
5193 make sure to restore the current buffer in all cases,
5194 as save-excursion would do. */
5197 build_annotations (start
, end
)
5198 Lisp_Object start
, end
;
5200 Lisp_Object annotations
;
5202 struct gcpro gcpro1
, gcpro2
;
5203 Lisp_Object original_buffer
;
5206 XSETBUFFER (original_buffer
, current_buffer
);
5209 p
= Vwrite_region_annotate_functions
;
5210 GCPRO2 (annotations
, p
);
5213 struct buffer
*given_buffer
= current_buffer
;
5214 Vwrite_region_annotations_so_far
= annotations
;
5215 res
= call2 (XCAR (p
), start
, end
);
5216 /* If the function makes a different buffer current,
5217 assume that means this buffer contains altered text to be output.
5218 Reset START and END from the buffer bounds
5219 and discard all previous annotations because they should have
5220 been dealt with by this function. */
5221 if (current_buffer
!= given_buffer
)
5223 XSETFASTINT (start
, BEGV
);
5224 XSETFASTINT (end
, ZV
);
5227 Flength (res
); /* Check basic validity of return value */
5228 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5232 /* Now do the same for annotation functions implied by the file-format */
5233 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5234 p
= Vauto_save_file_format
;
5236 p
= current_buffer
->file_format
;
5237 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5239 struct buffer
*given_buffer
= current_buffer
;
5241 Vwrite_region_annotations_so_far
= annotations
;
5243 /* Value is either a list of annotations or nil if the function
5244 has written annotations to a temporary buffer, which is now
5246 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5247 original_buffer
, make_number (i
));
5248 if (current_buffer
!= given_buffer
)
5250 XSETFASTINT (start
, BEGV
);
5251 XSETFASTINT (end
, ZV
);
5256 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5264 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5265 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5267 struct gcpro gcpro1
;
5270 GCPRO1 (annotations
);
5271 /* At last, do the same for the function PRE_WRITE_CONVERSION
5272 implied by the current coding-system. */
5273 if (!NILP (pre_write_conversion
))
5275 struct buffer
*given_buffer
= current_buffer
;
5276 Vwrite_region_annotations_so_far
= annotations
;
5277 res
= call2 (pre_write_conversion
, start
, end
);
5279 annotations
= (current_buffer
!= given_buffer
5281 : merge (annotations
, res
, Qcar_less_than_car
));
5288 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5289 If STRING is nil, POS is the character position in the current buffer.
5290 Intersperse with them the annotations from *ANNOT
5291 which fall within the range of POS to POS + NCHARS,
5292 each at its appropriate position.
5294 We modify *ANNOT by discarding elements as we use them up.
5296 The return value is negative in case of system call failure. */
5299 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5302 register int nchars
;
5305 struct coding_system
*coding
;
5309 int lastpos
= pos
+ nchars
;
5311 while (NILP (*annot
) || CONSP (*annot
))
5313 tem
= Fcar_safe (Fcar (*annot
));
5316 nextpos
= XFASTINT (tem
);
5318 /* If there are no more annotations in this range,
5319 output the rest of the range all at once. */
5320 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5321 return e_write (desc
, string
, pos
, lastpos
, coding
);
5323 /* Output buffer text up to the next annotation's position. */
5326 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5330 /* Output the annotation. */
5331 tem
= Fcdr (Fcar (*annot
));
5334 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5337 *annot
= Fcdr (*annot
);
5342 #ifndef WRITE_BUF_SIZE
5343 #define WRITE_BUF_SIZE (16 * 1024)
5346 /* Write text in the range START and END into descriptor DESC,
5347 encoding them with coding system CODING. If STRING is nil, START
5348 and END are character positions of the current buffer, else they
5349 are indexes to the string STRING. */
5352 e_write (desc
, string
, start
, end
, coding
)
5356 struct coding_system
*coding
;
5358 register char *addr
;
5359 register int nbytes
;
5360 char buf
[WRITE_BUF_SIZE
];
5364 coding
->composing
= COMPOSITION_DISABLED
;
5365 if (coding
->composing
!= COMPOSITION_DISABLED
)
5366 coding_save_composition (coding
, start
, end
, string
);
5368 if (STRINGP (string
))
5370 addr
= SDATA (string
);
5371 nbytes
= SBYTES (string
);
5372 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5374 else if (start
< end
)
5376 /* It is assured that the gap is not in the range START and END-1. */
5377 addr
= CHAR_POS_ADDR (start
);
5378 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5379 coding
->src_multibyte
5380 = !NILP (current_buffer
->enable_multibyte_characters
);
5386 coding
->src_multibyte
= 1;
5389 /* We used to have a code for handling selective display here. But,
5390 now it is handled within encode_coding. */
5395 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5396 if (coding
->produced
> 0)
5398 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5399 if (coding
->produced
)
5405 nbytes
-= coding
->consumed
;
5406 addr
+= coding
->consumed
;
5407 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5410 /* The source text ends by an incomplete multibyte form.
5411 There's no way other than write it out as is. */
5412 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5421 start
+= coding
->consumed_char
;
5422 if (coding
->cmp_data
)
5423 coding_adjust_composition_offset (coding
, start
);
5426 if (coding
->cmp_data
)
5427 coding_free_composition_data (coding
);
5432 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5433 Sverify_visited_file_modtime
, 1, 1, 0,
5434 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5435 This means that the file has not been changed since it was visited or saved. */)
5441 Lisp_Object handler
;
5442 Lisp_Object filename
;
5447 if (!STRINGP (b
->filename
)) return Qt
;
5448 if (b
->modtime
== 0) return Qt
;
5450 /* If the file name has special constructs in it,
5451 call the corresponding file handler. */
5452 handler
= Ffind_file_name_handler (b
->filename
,
5453 Qverify_visited_file_modtime
);
5454 if (!NILP (handler
))
5455 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5457 filename
= ENCODE_FILE (b
->filename
);
5459 if (stat (SDATA (filename
), &st
) < 0)
5461 /* If the file doesn't exist now and didn't exist before,
5462 we say that it isn't modified, provided the error is a tame one. */
5463 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5468 if (st
.st_mtime
== b
->modtime
5469 /* If both are positive, accept them if they are off by one second. */
5470 || (st
.st_mtime
> 0 && b
->modtime
> 0
5471 && (st
.st_mtime
== b
->modtime
+ 1
5472 || st
.st_mtime
== b
->modtime
- 1)))
5477 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5478 Sclear_visited_file_modtime
, 0, 0, 0,
5479 doc
: /* Clear out records of last mod time of visited file.
5480 Next attempt to save will certainly not complain of a discrepancy. */)
5483 current_buffer
->modtime
= 0;
5487 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5488 Svisited_file_modtime
, 0, 0, 0,
5489 doc
: /* Return the current buffer's recorded visited file modification time.
5490 The value is a list of the form (HIGH . LOW), like the time values
5491 that `file-attributes' returns. */)
5494 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5497 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5498 Sset_visited_file_modtime
, 0, 1, 0,
5499 doc
: /* Update buffer's recorded modification time from the visited file's time.
5500 Useful if the buffer was not read from the file normally
5501 or if the file itself has been changed for some known benign reason.
5502 An argument specifies the modification time value to use
5503 \(instead of that of the visited file), in the form of a list
5504 \(HIGH . LOW) or (HIGH LOW). */)
5506 Lisp_Object time_list
;
5508 if (!NILP (time_list
))
5509 current_buffer
->modtime
= cons_to_long (time_list
);
5512 register Lisp_Object filename
;
5514 Lisp_Object handler
;
5516 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5518 /* If the file name has special constructs in it,
5519 call the corresponding file handler. */
5520 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5521 if (!NILP (handler
))
5522 /* The handler can find the file name the same way we did. */
5523 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5525 filename
= ENCODE_FILE (filename
);
5527 if (stat (SDATA (filename
), &st
) >= 0)
5528 current_buffer
->modtime
= st
.st_mtime
;
5535 auto_save_error (error
)
5538 Lisp_Object args
[3], msg
;
5540 struct gcpro gcpro1
;
5544 args
[0] = build_string ("Auto-saving %s: %s");
5545 args
[1] = current_buffer
->name
;
5546 args
[2] = Ferror_message_string (error
);
5547 msg
= Fformat (3, args
);
5549 nbytes
= SBYTES (msg
);
5551 for (i
= 0; i
< 3; ++i
)
5554 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5556 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5557 Fsleep_for (make_number (1), Qnil
);
5569 /* Get visited file's mode to become the auto save file's mode. */
5570 if (! NILP (current_buffer
->filename
)
5571 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5572 /* But make sure we can overwrite it later! */
5573 auto_save_mode_bits
= st
.st_mode
| 0600;
5575 auto_save_mode_bits
= 0666;
5578 Fwrite_region (Qnil
, Qnil
,
5579 current_buffer
->auto_save_file_name
,
5580 Qnil
, Qlambda
, Qnil
, Qnil
);
5584 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5589 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5590 | XFASTINT (XCDR (stream
))));
5595 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5598 minibuffer_auto_raise
= XINT (value
);
5603 do_auto_save_make_dir (dir
)
5606 return call2 (Qmake_directory
, dir
, Qt
);
5610 do_auto_save_eh (ignore
)
5616 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5617 doc
: /* Auto-save all buffers that need it.
5618 This is all buffers that have auto-saving enabled
5619 and are changed since last auto-saved.
5620 Auto-saving writes the buffer into a file
5621 so that your editing is not lost if the system crashes.
5622 This file is not the file you visited; that changes only when you save.
5623 Normally we run the normal hook `auto-save-hook' before saving.
5625 A non-nil NO-MESSAGE argument means do not print any message if successful.
5626 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5627 (no_message
, current_only
)
5628 Lisp_Object no_message
, current_only
;
5630 struct buffer
*old
= current_buffer
, *b
;
5631 Lisp_Object tail
, buf
;
5633 int do_handled_files
;
5636 Lisp_Object lispstream
;
5637 int count
= SPECPDL_INDEX ();
5638 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5639 int old_message_p
= 0;
5640 struct gcpro gcpro1
, gcpro2
;
5642 if (max_specpdl_size
< specpdl_size
+ 40)
5643 max_specpdl_size
= specpdl_size
+ 40;
5648 if (NILP (no_message
))
5650 old_message_p
= push_message ();
5651 record_unwind_protect (pop_message_unwind
, Qnil
);
5654 /* Ordinarily don't quit within this function,
5655 but don't make it impossible to quit (in case we get hung in I/O). */
5659 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5660 point to non-strings reached from Vbuffer_alist. */
5662 if (!NILP (Vrun_hooks
))
5663 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5665 if (STRINGP (Vauto_save_list_file_name
))
5667 Lisp_Object listfile
;
5669 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5671 /* Don't try to create the directory when shutting down Emacs,
5672 because creating the directory might signal an error, and
5673 that would leave Emacs in a strange state. */
5674 if (!NILP (Vrun_hooks
))
5678 GCPRO2 (dir
, listfile
);
5679 dir
= Ffile_name_directory (listfile
);
5680 if (NILP (Ffile_directory_p (dir
)))
5681 internal_condition_case_1 (do_auto_save_make_dir
,
5682 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5687 stream
= fopen (SDATA (listfile
), "w");
5690 /* Arrange to close that file whether or not we get an error.
5691 Also reset auto_saving to 0. */
5692 lispstream
= Fcons (Qnil
, Qnil
);
5693 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5694 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5705 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5706 record_unwind_protect (do_auto_save_unwind_1
,
5707 make_number (minibuffer_auto_raise
));
5708 minibuffer_auto_raise
= 0;
5711 /* First, save all files which don't have handlers. If Emacs is
5712 crashing, the handlers may tweak what is causing Emacs to crash
5713 in the first place, and it would be a shame if Emacs failed to
5714 autosave perfectly ordinary files because it couldn't handle some
5716 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5717 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5719 buf
= XCDR (XCAR (tail
));
5722 /* Record all the buffers that have auto save mode
5723 in the special file that lists them. For each of these buffers,
5724 Record visited name (if any) and auto save name. */
5725 if (STRINGP (b
->auto_save_file_name
)
5726 && stream
!= NULL
&& do_handled_files
== 0)
5728 if (!NILP (b
->filename
))
5730 fwrite (SDATA (b
->filename
), 1,
5731 SBYTES (b
->filename
), stream
);
5733 putc ('\n', stream
);
5734 fwrite (SDATA (b
->auto_save_file_name
), 1,
5735 SBYTES (b
->auto_save_file_name
), stream
);
5736 putc ('\n', stream
);
5739 if (!NILP (current_only
)
5740 && b
!= current_buffer
)
5743 /* Don't auto-save indirect buffers.
5744 The base buffer takes care of it. */
5748 /* Check for auto save enabled
5749 and file changed since last auto save
5750 and file changed since last real save. */
5751 if (STRINGP (b
->auto_save_file_name
)
5752 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5753 && b
->auto_save_modified
< BUF_MODIFF (b
)
5754 /* -1 means we've turned off autosaving for a while--see below. */
5755 && XINT (b
->save_length
) >= 0
5756 && (do_handled_files
5757 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5760 EMACS_TIME before_time
, after_time
;
5762 EMACS_GET_TIME (before_time
);
5764 /* If we had a failure, don't try again for 20 minutes. */
5765 if (b
->auto_save_failure_time
>= 0
5766 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5769 if ((XFASTINT (b
->save_length
) * 10
5770 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5771 /* A short file is likely to change a large fraction;
5772 spare the user annoying messages. */
5773 && XFASTINT (b
->save_length
) > 5000
5774 /* These messages are frequent and annoying for `*mail*'. */
5775 && !EQ (b
->filename
, Qnil
)
5776 && NILP (no_message
))
5778 /* It has shrunk too much; turn off auto-saving here. */
5779 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5780 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5782 minibuffer_auto_raise
= 0;
5783 /* Turn off auto-saving until there's a real save,
5784 and prevent any more warnings. */
5785 XSETINT (b
->save_length
, -1);
5786 Fsleep_for (make_number (1), Qnil
);
5789 set_buffer_internal (b
);
5790 if (!auto_saved
&& NILP (no_message
))
5791 message1 ("Auto-saving...");
5792 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5794 b
->auto_save_modified
= BUF_MODIFF (b
);
5795 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5796 set_buffer_internal (old
);
5798 EMACS_GET_TIME (after_time
);
5800 /* If auto-save took more than 60 seconds,
5801 assume it was an NFS failure that got a timeout. */
5802 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5803 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5807 /* Prevent another auto save till enough input events come in. */
5808 record_auto_save ();
5810 if (auto_saved
&& NILP (no_message
))
5814 /* If we are going to restore an old message,
5815 give time to read ours. */
5816 sit_for (1, 0, 0, 0, 0);
5820 /* If we displayed a message and then restored a state
5821 with no message, leave a "done" message on the screen. */
5822 message1 ("Auto-saving...done");
5827 /* This restores the message-stack status. */
5828 unbind_to (count
, Qnil
);
5832 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5833 Sset_buffer_auto_saved
, 0, 0, 0,
5834 doc
: /* Mark current buffer as auto-saved with its current text.
5835 No auto-save file will be written until the buffer changes again. */)
5838 current_buffer
->auto_save_modified
= MODIFF
;
5839 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5840 current_buffer
->auto_save_failure_time
= -1;
5844 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5845 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5846 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5849 current_buffer
->auto_save_failure_time
= -1;
5853 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5855 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
5858 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5861 /* Reading and completing file names */
5862 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5864 /* In the string VAL, change each $ to $$ and return the result. */
5867 double_dollars (val
)
5870 register const unsigned char *old
;
5871 register unsigned char *new;
5875 osize
= SBYTES (val
);
5877 /* Count the number of $ characters. */
5878 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
5879 if (*old
++ == '$') count
++;
5883 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
5886 for (n
= osize
; n
> 0; n
--)
5900 read_file_name_cleanup (arg
)
5903 return (current_buffer
->directory
= arg
);
5906 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5908 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
5909 (string
, dir
, action
)
5910 Lisp_Object string
, dir
, action
;
5911 /* action is nil for complete, t for return list of completions,
5912 lambda for verify final value */
5914 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5916 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5918 CHECK_STRING (string
);
5925 /* No need to protect ACTION--we only compare it with t and nil. */
5926 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5928 if (SCHARS (string
) == 0)
5930 if (EQ (action
, Qlambda
))
5938 orig_string
= string
;
5939 string
= Fsubstitute_in_file_name (string
);
5940 changed
= NILP (Fstring_equal (string
, orig_string
));
5941 name
= Ffile_name_nondirectory (string
);
5942 val
= Ffile_name_directory (string
);
5944 realdir
= Fexpand_file_name (val
, realdir
);
5949 specdir
= Ffile_name_directory (string
);
5950 val
= Ffile_name_completion (name
, realdir
);
5955 return double_dollars (string
);
5959 if (!NILP (specdir
))
5960 val
= concat2 (specdir
, val
);
5962 return double_dollars (val
);
5965 #endif /* not VMS */
5969 if (EQ (action
, Qt
))
5971 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
5975 if (NILP (Vread_file_name_predicate
)
5976 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
5980 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
5982 /* Brute-force speed up for directory checking:
5983 Discard strings which don't end in a slash. */
5984 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
5986 Lisp_Object tem
= XCAR (all
);
5988 if (STRINGP (tem
) &&
5989 (len
= SCHARS (tem
), len
> 0) &&
5990 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
5991 comp
= Fcons (tem
, comp
);
5997 /* Must do it the hard (and slow) way. */
5998 GCPRO3 (all
, comp
, specdir
);
5999 count
= SPECPDL_INDEX ();
6000 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6001 current_buffer
->directory
= realdir
;
6002 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6003 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6004 comp
= Fcons (XCAR (all
), comp
);
6005 unbind_to (count
, Qnil
);
6008 return Fnreverse (comp
);
6011 /* Only other case actually used is ACTION = lambda */
6013 /* Supposedly this helps commands such as `cd' that read directory names,
6014 but can someone explain how it helps them? -- RMS */
6015 if (SCHARS (name
) == 0)
6018 if (!NILP (Vread_file_name_predicate
))
6019 return call1 (Vread_file_name_predicate
, string
);
6020 return Ffile_exists_p (string
);
6023 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6024 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6025 Value is not expanded---you must call `expand-file-name' yourself.
6026 Default name to DEFAULT-FILENAME if user enters a null string.
6027 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6028 except that if INITIAL is specified, that combined with DIR is used.)
6029 Fourth arg MUSTMATCH non-nil means require existing file's name.
6030 Non-nil and non-t means also require confirmation after completion.
6031 Fifth arg INITIAL specifies text to start with.
6032 If optional sixth arg PREDICATE is non-nil, possible completions and the
6033 resulting file name must satisfy (funcall PREDICATE NAME).
6034 DIR defaults to current buffer's directory default.
6036 If this command was invoked with the mouse, use a file dialog box if
6037 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6038 provides a file dialog box. */)
6039 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6040 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6042 Lisp_Object val
, insdef
, tem
;
6043 struct gcpro gcpro1
, gcpro2
;
6044 register char *homedir
;
6045 Lisp_Object decoded_homedir
;
6046 int replace_in_history
= 0;
6047 int add_to_history
= 0;
6051 dir
= current_buffer
->directory
;
6052 if (NILP (default_filename
))
6053 default_filename
= !NILP (initial
)
6054 ? Fexpand_file_name (initial
, dir
)
6055 : current_buffer
->filename
;
6057 /* If dir starts with user's homedir, change that to ~. */
6058 homedir
= (char *) egetenv ("HOME");
6060 /* homedir can be NULL in temacs, since Vprocess_environment is not
6061 yet set up. We shouldn't crash in that case. */
6064 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6065 CORRECT_DIR_SEPS (homedir
);
6070 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6073 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6074 SBYTES (decoded_homedir
))
6075 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6077 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6078 dir
= concat2 (build_string ("~"), dir
);
6080 /* Likewise for default_filename. */
6082 && STRINGP (default_filename
)
6083 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6084 SBYTES (decoded_homedir
))
6085 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6088 = Fsubstring (default_filename
,
6089 make_number (SCHARS (decoded_homedir
)), Qnil
);
6090 default_filename
= concat2 (build_string ("~"), default_filename
);
6092 if (!NILP (default_filename
))
6094 CHECK_STRING (default_filename
);
6095 default_filename
= double_dollars (default_filename
);
6098 if (insert_default_directory
&& STRINGP (dir
))
6101 if (!NILP (initial
))
6103 Lisp_Object args
[2], pos
;
6107 insdef
= Fconcat (2, args
);
6108 pos
= make_number (SCHARS (double_dollars (dir
)));
6109 insdef
= Fcons (double_dollars (insdef
), pos
);
6112 insdef
= double_dollars (insdef
);
6114 else if (STRINGP (initial
))
6115 insdef
= Fcons (double_dollars (initial
), make_number (0));
6119 if (!NILP (Vread_file_name_function
))
6121 Lisp_Object args
[7];
6123 GCPRO2 (insdef
, default_filename
);
6124 args
[0] = Vread_file_name_function
;
6127 args
[3] = default_filename
;
6128 args
[4] = mustmatch
;
6130 args
[6] = predicate
;
6131 RETURN_UNGCPRO (Ffuncall (7, args
));
6134 count
= SPECPDL_INDEX ();
6136 specbind (intern ("completion-ignore-case"), Qt
);
6139 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6140 specbind (intern ("read-file-name-predicate"),
6141 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6143 GCPRO2 (insdef
, default_filename
);
6145 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
6146 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6150 /* If DIR contains a file name, split it. */
6152 file
= Ffile_name_nondirectory (dir
);
6153 if (SCHARS (file
) && NILP (default_filename
))
6155 default_filename
= file
;
6156 dir
= Ffile_name_directory (dir
);
6158 if (!NILP(default_filename
))
6159 default_filename
= Fexpand_file_name (default_filename
, dir
);
6160 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6165 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6166 dir
, mustmatch
, insdef
,
6167 Qfile_name_history
, default_filename
, Qnil
);
6169 tem
= Fsymbol_value (Qfile_name_history
);
6170 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6171 replace_in_history
= 1;
6173 /* If Fcompleting_read returned the inserted default string itself
6174 (rather than a new string with the same contents),
6175 it has to mean that the user typed RET with the minibuffer empty.
6176 In that case, we really want to return ""
6177 so that commands such as set-visited-file-name can distinguish. */
6178 if (EQ (val
, default_filename
))
6180 /* In this case, Fcompleting_read has not added an element
6181 to the history. Maybe we should. */
6182 if (! replace_in_history
)
6188 unbind_to (count
, Qnil
);
6191 error ("No file name specified");
6193 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6195 if (!NILP (tem
) && !NILP (default_filename
))
6196 val
= default_filename
;
6197 else if (SCHARS (val
) == 0 && NILP (insdef
))
6199 if (!NILP (default_filename
))
6200 val
= default_filename
;
6202 error ("No default file name");
6204 val
= Fsubstitute_in_file_name (val
);
6206 if (replace_in_history
)
6207 /* Replace what Fcompleting_read added to the history
6208 with what we will actually return. */
6209 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6210 else if (add_to_history
)
6212 /* Add the value to the history--but not if it matches
6213 the last value already there. */
6214 Lisp_Object val1
= double_dollars (val
);
6215 tem
= Fsymbol_value (Qfile_name_history
);
6216 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6217 Fset (Qfile_name_history
,
6228 /* Must be set before any path manipulation is performed. */
6229 XSETFASTINT (Vdirectory_sep_char
, '/');
6236 Qexpand_file_name
= intern ("expand-file-name");
6237 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6238 Qdirectory_file_name
= intern ("directory-file-name");
6239 Qfile_name_directory
= intern ("file-name-directory");
6240 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6241 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6242 Qfile_name_as_directory
= intern ("file-name-as-directory");
6243 Qcopy_file
= intern ("copy-file");
6244 Qmake_directory_internal
= intern ("make-directory-internal");
6245 Qmake_directory
= intern ("make-directory");
6246 Qdelete_directory
= intern ("delete-directory");
6247 Qdelete_file
= intern ("delete-file");
6248 Qrename_file
= intern ("rename-file");
6249 Qadd_name_to_file
= intern ("add-name-to-file");
6250 Qmake_symbolic_link
= intern ("make-symbolic-link");
6251 Qfile_exists_p
= intern ("file-exists-p");
6252 Qfile_executable_p
= intern ("file-executable-p");
6253 Qfile_readable_p
= intern ("file-readable-p");
6254 Qfile_writable_p
= intern ("file-writable-p");
6255 Qfile_symlink_p
= intern ("file-symlink-p");
6256 Qaccess_file
= intern ("access-file");
6257 Qfile_directory_p
= intern ("file-directory-p");
6258 Qfile_regular_p
= intern ("file-regular-p");
6259 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6260 Qfile_modes
= intern ("file-modes");
6261 Qset_file_modes
= intern ("set-file-modes");
6262 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6263 Qinsert_file_contents
= intern ("insert-file-contents");
6264 Qwrite_region
= intern ("write-region");
6265 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6266 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6268 staticpro (&Qexpand_file_name
);
6269 staticpro (&Qsubstitute_in_file_name
);
6270 staticpro (&Qdirectory_file_name
);
6271 staticpro (&Qfile_name_directory
);
6272 staticpro (&Qfile_name_nondirectory
);
6273 staticpro (&Qunhandled_file_name_directory
);
6274 staticpro (&Qfile_name_as_directory
);
6275 staticpro (&Qcopy_file
);
6276 staticpro (&Qmake_directory_internal
);
6277 staticpro (&Qmake_directory
);
6278 staticpro (&Qdelete_directory
);
6279 staticpro (&Qdelete_file
);
6280 staticpro (&Qrename_file
);
6281 staticpro (&Qadd_name_to_file
);
6282 staticpro (&Qmake_symbolic_link
);
6283 staticpro (&Qfile_exists_p
);
6284 staticpro (&Qfile_executable_p
);
6285 staticpro (&Qfile_readable_p
);
6286 staticpro (&Qfile_writable_p
);
6287 staticpro (&Qaccess_file
);
6288 staticpro (&Qfile_symlink_p
);
6289 staticpro (&Qfile_directory_p
);
6290 staticpro (&Qfile_regular_p
);
6291 staticpro (&Qfile_accessible_directory_p
);
6292 staticpro (&Qfile_modes
);
6293 staticpro (&Qset_file_modes
);
6294 staticpro (&Qfile_newer_than_file_p
);
6295 staticpro (&Qinsert_file_contents
);
6296 staticpro (&Qwrite_region
);
6297 staticpro (&Qverify_visited_file_modtime
);
6298 staticpro (&Qset_visited_file_modtime
);
6300 Qfile_name_history
= intern ("file-name-history");
6301 Fset (Qfile_name_history
, Qnil
);
6302 staticpro (&Qfile_name_history
);
6304 Qfile_error
= intern ("file-error");
6305 staticpro (&Qfile_error
);
6306 Qfile_already_exists
= intern ("file-already-exists");
6307 staticpro (&Qfile_already_exists
);
6308 Qfile_date_error
= intern ("file-date-error");
6309 staticpro (&Qfile_date_error
);
6310 Qexcl
= intern ("excl");
6314 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6315 staticpro (&Qfind_buffer_file_type
);
6318 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6319 doc
: /* *Coding system for encoding file names.
6320 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6321 Vfile_name_coding_system
= Qnil
;
6323 DEFVAR_LISP ("default-file-name-coding-system",
6324 &Vdefault_file_name_coding_system
,
6325 doc
: /* Default coding system for encoding file names.
6326 This variable is used only when `file-name-coding-system' is nil.
6328 This variable is set/changed by the command `set-language-environment'.
6329 User should not set this variable manually,
6330 instead use `file-name-coding-system' to get a constant encoding
6331 of file names regardless of the current language environment. */);
6332 Vdefault_file_name_coding_system
= Qnil
;
6334 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6335 doc
: /* *Format in which to write auto-save files.
6336 Should be a list of symbols naming formats that are defined in `format-alist'.
6337 If it is t, which is the default, auto-save files are written in the
6338 same format as a regular save would use. */);
6339 Vauto_save_file_format
= Qt
;
6341 Qformat_decode
= intern ("format-decode");
6342 staticpro (&Qformat_decode
);
6343 Qformat_annotate_function
= intern ("format-annotate-function");
6344 staticpro (&Qformat_annotate_function
);
6346 Qcar_less_than_car
= intern ("car-less-than-car");
6347 staticpro (&Qcar_less_than_car
);
6349 Fput (Qfile_error
, Qerror_conditions
,
6350 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6351 Fput (Qfile_error
, Qerror_message
,
6352 build_string ("File error"));
6354 Fput (Qfile_already_exists
, Qerror_conditions
,
6355 Fcons (Qfile_already_exists
,
6356 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6357 Fput (Qfile_already_exists
, Qerror_message
,
6358 build_string ("File already exists"));
6360 Fput (Qfile_date_error
, Qerror_conditions
,
6361 Fcons (Qfile_date_error
,
6362 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6363 Fput (Qfile_date_error
, Qerror_message
,
6364 build_string ("Cannot set file date"));
6366 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6367 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6368 Vread_file_name_function
= Qnil
;
6370 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6371 doc
: /* Current predicate used by `read-file-name-internal'. */);
6372 Vread_file_name_predicate
= Qnil
;
6374 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6375 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer. */);
6376 insert_default_directory
= 1;
6378 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6379 doc
: /* *Non-nil means write new files with record format `stmlf'.
6380 nil means use format `var'. This variable is meaningful only on VMS. */);
6381 vms_stmlf_recfm
= 0;
6383 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6384 doc
: /* Directory separator character for built-in functions that return file names.
6385 The value is always ?/. Don't use this variable, just use `/'. */);
6387 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6388 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6389 If a file name matches REGEXP, then all I/O on that file is done by calling
6392 The first argument given to HANDLER is the name of the I/O primitive
6393 to be handled; the remaining arguments are the arguments that were
6394 passed to that primitive. For example, if you do
6395 (file-exists-p FILENAME)
6396 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6397 (funcall HANDLER 'file-exists-p FILENAME)
6398 The function `find-file-name-handler' checks this list for a handler
6399 for its argument. */);
6400 Vfile_name_handler_alist
= Qnil
;
6402 DEFVAR_LISP ("set-auto-coding-function",
6403 &Vset_auto_coding_function
,
6404 doc
: /* If non-nil, a function to call to decide a coding system of file.
6405 Two arguments are passed to this function: the file name
6406 and the length of a file contents following the point.
6407 This function should return a coding system to decode the file contents.
6408 It should check the file name against `auto-coding-alist'.
6409 If no coding system is decided, it should check a coding system
6410 specified in the heading lines with the format:
6411 -*- ... coding: CODING-SYSTEM; ... -*-
6412 or local variable spec of the tailing lines with `coding:' tag. */);
6413 Vset_auto_coding_function
= Qnil
;
6415 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6416 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6417 Each is passed one argument, the number of bytes inserted. It should return
6418 the new byte count, and leave point the same. If `insert-file-contents' is
6419 intercepted by a handler from `file-name-handler-alist', that handler is
6420 responsible for calling the after-insert-file-functions if appropriate. */);
6421 Vafter_insert_file_functions
= Qnil
;
6423 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6424 doc
: /* A list of functions to be called at the start of `write-region'.
6425 Each is passed two arguments, START and END as for `write-region'.
6426 These are usually two numbers but not always; see the documentation
6427 for `write-region'. The function should return a list of pairs
6428 of the form (POSITION . STRING), consisting of strings to be effectively
6429 inserted at the specified positions of the file being written (1 means to
6430 insert before the first byte written). The POSITIONs must be sorted into
6431 increasing order. If there are several functions in the list, the several
6432 lists are merged destructively. Alternatively, the function can return
6433 with a different buffer current and value nil.*/);
6434 Vwrite_region_annotate_functions
= Qnil
;
6436 DEFVAR_LISP ("write-region-annotations-so-far",
6437 &Vwrite_region_annotations_so_far
,
6438 doc
: /* When an annotation function is called, this holds the previous annotations.
6439 These are the annotations made by other annotation functions
6440 that were already called. See also `write-region-annotate-functions'. */);
6441 Vwrite_region_annotations_so_far
= Qnil
;
6443 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6444 doc
: /* A list of file name handlers that temporarily should not be used.
6445 This applies only to the operation `inhibit-file-name-operation'. */);
6446 Vinhibit_file_name_handlers
= Qnil
;
6448 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6449 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6450 Vinhibit_file_name_operation
= Qnil
;
6452 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6453 doc
: /* File name in which we write a list of all auto save file names.
6454 This variable is initialized automatically from `auto-save-list-file-prefix'
6455 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6456 a non-nil value. */);
6457 Vauto_save_list_file_name
= Qnil
;
6459 defsubr (&Sfind_file_name_handler
);
6460 defsubr (&Sfile_name_directory
);
6461 defsubr (&Sfile_name_nondirectory
);
6462 defsubr (&Sunhandled_file_name_directory
);
6463 defsubr (&Sfile_name_as_directory
);
6464 defsubr (&Sdirectory_file_name
);
6465 defsubr (&Smake_temp_name
);
6466 defsubr (&Sexpand_file_name
);
6467 defsubr (&Ssubstitute_in_file_name
);
6468 defsubr (&Scopy_file
);
6469 defsubr (&Smake_directory_internal
);
6470 defsubr (&Sdelete_directory
);
6471 defsubr (&Sdelete_file
);
6472 defsubr (&Srename_file
);
6473 defsubr (&Sadd_name_to_file
);
6475 defsubr (&Smake_symbolic_link
);
6476 #endif /* S_IFLNK */
6478 defsubr (&Sdefine_logical_name
);
6481 defsubr (&Ssysnetunam
);
6482 #endif /* HPUX_NET */
6483 defsubr (&Sfile_name_absolute_p
);
6484 defsubr (&Sfile_exists_p
);
6485 defsubr (&Sfile_executable_p
);
6486 defsubr (&Sfile_readable_p
);
6487 defsubr (&Sfile_writable_p
);
6488 defsubr (&Saccess_file
);
6489 defsubr (&Sfile_symlink_p
);
6490 defsubr (&Sfile_directory_p
);
6491 defsubr (&Sfile_accessible_directory_p
);
6492 defsubr (&Sfile_regular_p
);
6493 defsubr (&Sfile_modes
);
6494 defsubr (&Sset_file_modes
);
6495 defsubr (&Sset_default_file_modes
);
6496 defsubr (&Sdefault_file_modes
);
6497 defsubr (&Sfile_newer_than_file_p
);
6498 defsubr (&Sinsert_file_contents
);
6499 defsubr (&Swrite_region
);
6500 defsubr (&Scar_less_than_car
);
6501 defsubr (&Sverify_visited_file_modtime
);
6502 defsubr (&Sclear_visited_file_modtime
);
6503 defsubr (&Svisited_file_modtime
);
6504 defsubr (&Sset_visited_file_modtime
);
6505 defsubr (&Sdo_auto_save
);
6506 defsubr (&Sset_buffer_auto_saved
);
6507 defsubr (&Sclear_buffer_auto_save_failure
);
6508 defsubr (&Srecent_auto_save_p
);
6510 defsubr (&Sread_file_name_internal
);
6511 defsubr (&Sread_file_name
);
6514 defsubr (&Sunix_sync
);