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 /* Lisp function for setting buffer-file-coding-system and the
181 multibyteness of the current buffer after inserting a file. */
182 Lisp_Object Qafter_insert_file_set_coding
;
184 /* Functions to be called to create text property annotations for file. */
185 Lisp_Object Vwrite_region_annotate_functions
;
187 /* During build_annotations, each time an annotation function is called,
188 this holds the annotations made by the previous functions. */
189 Lisp_Object Vwrite_region_annotations_so_far
;
191 /* File name in which we write a list of all our auto save files. */
192 Lisp_Object Vauto_save_list_file_name
;
194 /* Function to call to read a file name. */
195 Lisp_Object Vread_file_name_function
;
197 /* Current predicate used by read_file_name_internal. */
198 Lisp_Object Vread_file_name_predicate
;
200 /* Nonzero means, when reading a filename in the minibuffer,
201 start out by inserting the default directory into the minibuffer. */
202 int insert_default_directory
;
204 /* On VMS, nonzero means write new files with record format stmlf.
205 Zero means use var format. */
208 /* On NT, specifies the directory separator character, used (eg.) when
209 expanding file names. This can be bound to / or \. */
210 Lisp_Object Vdirectory_sep_char
;
212 extern Lisp_Object Vuser_login_name
;
215 extern Lisp_Object Vw32_get_true_file_attributes
;
218 extern int minibuf_level
;
220 extern int minibuffer_auto_raise
;
222 /* These variables describe handlers that have "already" had a chance
223 to handle the current operation.
225 Vinhibit_file_name_handlers is a list of file name handlers.
226 Vinhibit_file_name_operation is the operation being handled.
227 If we try to handle that operation, we ignore those handlers. */
229 static Lisp_Object Vinhibit_file_name_handlers
;
230 static Lisp_Object Vinhibit_file_name_operation
;
232 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
234 Lisp_Object Qfile_name_history
;
236 Lisp_Object Qcar_less_than_car
;
238 static int a_write
P_ ((int, Lisp_Object
, int, int,
239 Lisp_Object
*, struct coding_system
*));
240 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
244 report_file_error (string
, data
)
248 Lisp_Object errstring
;
251 synchronize_system_messages_locale ();
252 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
253 Vlocale_coding_system
, 0);
259 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
262 /* System error messages are capitalized. Downcase the initial
263 unless it is followed by a slash. */
264 if (SREF (errstring
, 1) != '/')
265 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
267 Fsignal (Qfile_error
,
268 Fcons (build_string (string
), Fcons (errstring
, data
)));
273 close_file_unwind (fd
)
276 emacs_close (XFASTINT (fd
));
280 /* Restore point, having saved it as a marker. */
283 restore_point_unwind (location
)
284 Lisp_Object location
;
286 Fgoto_char (location
);
287 Fset_marker (location
, Qnil
, Qnil
);
291 Lisp_Object Qexpand_file_name
;
292 Lisp_Object Qsubstitute_in_file_name
;
293 Lisp_Object Qdirectory_file_name
;
294 Lisp_Object Qfile_name_directory
;
295 Lisp_Object Qfile_name_nondirectory
;
296 Lisp_Object Qunhandled_file_name_directory
;
297 Lisp_Object Qfile_name_as_directory
;
298 Lisp_Object Qcopy_file
;
299 Lisp_Object Qmake_directory_internal
;
300 Lisp_Object Qmake_directory
;
301 Lisp_Object Qdelete_directory
;
302 Lisp_Object Qdelete_file
;
303 Lisp_Object Qrename_file
;
304 Lisp_Object Qadd_name_to_file
;
305 Lisp_Object Qmake_symbolic_link
;
306 Lisp_Object Qfile_exists_p
;
307 Lisp_Object Qfile_executable_p
;
308 Lisp_Object Qfile_readable_p
;
309 Lisp_Object Qfile_writable_p
;
310 Lisp_Object Qfile_symlink_p
;
311 Lisp_Object Qaccess_file
;
312 Lisp_Object Qfile_directory_p
;
313 Lisp_Object Qfile_regular_p
;
314 Lisp_Object Qfile_accessible_directory_p
;
315 Lisp_Object Qfile_modes
;
316 Lisp_Object Qset_file_modes
;
317 Lisp_Object Qfile_newer_than_file_p
;
318 Lisp_Object Qinsert_file_contents
;
319 Lisp_Object Qwrite_region
;
320 Lisp_Object Qverify_visited_file_modtime
;
321 Lisp_Object Qset_visited_file_modtime
;
323 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
324 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
325 Otherwise, return nil.
326 A file name is handled if one of the regular expressions in
327 `file-name-handler-alist' matches it.
329 If OPERATION equals `inhibit-file-name-operation', then we ignore
330 any handlers that are members of `inhibit-file-name-handlers',
331 but we still do run any other handlers. This lets handlers
332 use the standard functions without calling themselves recursively. */)
333 (filename
, operation
)
334 Lisp_Object filename
, operation
;
336 /* This function must not munge the match data. */
337 Lisp_Object chain
, inhibited_handlers
, result
;
341 CHECK_STRING (filename
);
343 if (EQ (operation
, Vinhibit_file_name_operation
))
344 inhibited_handlers
= Vinhibit_file_name_handlers
;
346 inhibited_handlers
= Qnil
;
348 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
349 chain
= XCDR (chain
))
359 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
361 Lisp_Object handler
, tem
;
363 handler
= XCDR (elt
);
364 tem
= Fmemq (handler
, inhibited_handlers
);
378 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
380 doc
: /* Return the directory component in file name FILENAME.
381 Return nil if FILENAME does not include a directory.
382 Otherwise return a directory spec.
383 Given a Unix syntax file name, returns a string ending in slash;
384 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
386 Lisp_Object filename
;
389 register const unsigned char *beg
;
391 register unsigned char *beg
;
393 register const unsigned char *p
;
396 CHECK_STRING (filename
);
398 /* If the file name has special constructs in it,
399 call the corresponding file handler. */
400 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
402 return call2 (handler
, Qfile_name_directory
, filename
);
404 #ifdef FILE_SYSTEM_CASE
405 filename
= FILE_SYSTEM_CASE (filename
);
407 beg
= SDATA (filename
);
409 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
411 p
= beg
+ SBYTES (filename
);
413 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
415 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
418 /* only recognise drive specifier at the beginning */
420 /* handle the "/:d:foo" and "/:foo" cases correctly */
421 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
422 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
429 /* Expansion of "c:" to drive and default directory. */
432 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
433 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
434 unsigned char *r
= res
;
436 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
438 strncpy (res
, beg
, 2);
443 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
445 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
448 p
= beg
+ strlen (beg
);
451 CORRECT_DIR_SEPS (beg
);
454 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
457 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
458 Sfile_name_nondirectory
, 1, 1, 0,
459 doc
: /* Return file name FILENAME sans its directory.
460 For example, in a Unix-syntax file name,
461 this is everything after the last slash,
462 or the entire name if it contains no slash. */)
464 Lisp_Object filename
;
466 register const unsigned char *beg
, *p
, *end
;
469 CHECK_STRING (filename
);
471 /* If the file name has special constructs in it,
472 call the corresponding file handler. */
473 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
475 return call2 (handler
, Qfile_name_nondirectory
, filename
);
477 beg
= SDATA (filename
);
478 end
= p
= beg
+ SBYTES (filename
);
480 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
482 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
485 /* only recognise drive specifier at beginning */
487 /* handle the "/:d:foo" case correctly */
488 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
493 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
496 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
497 Sunhandled_file_name_directory
, 1, 1, 0,
498 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
499 A `directly usable' directory name is one that may be used without the
500 intervention of any file handler.
501 If FILENAME is a directly usable file itself, return
502 \(file-name-directory FILENAME).
503 The `call-process' and `start-process' functions use this function to
504 get a current directory to run processes in. */)
506 Lisp_Object filename
;
510 /* If the file name has special constructs in it,
511 call the corresponding file handler. */
512 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
514 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
516 return Ffile_name_directory (filename
);
521 file_name_as_directory (out
, in
)
524 int size
= strlen (in
) - 1;
537 /* Is it already a directory string? */
538 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
540 /* Is it a VMS directory file name? If so, hack VMS syntax. */
541 else if (! index (in
, '/')
542 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
543 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
544 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
545 || ! strncmp (&in
[size
- 5], ".dir", 4))
546 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
547 && in
[size
] == '1')))
549 register char *p
, *dot
;
553 dir:x.dir --> dir:[x]
554 dir:[x]y.dir --> dir:[x.y] */
556 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
559 strncpy (out
, in
, p
- in
);
578 dot
= index (p
, '.');
581 /* blindly remove any extension */
582 size
= strlen (out
) + (dot
- p
);
583 strncat (out
, p
, dot
- p
);
594 /* For Unix syntax, Append a slash if necessary */
595 if (!IS_DIRECTORY_SEP (out
[size
]))
597 /* Cannot use DIRECTORY_SEP, which could have any value */
599 out
[size
+ 2] = '\0';
602 CORRECT_DIR_SEPS (out
);
608 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
609 Sfile_name_as_directory
, 1, 1, 0,
610 doc
: /* Return a string representing the file name FILE interpreted as a directory.
611 This operation exists because a directory is also a file, but its name as
612 a directory is different from its name as a file.
613 The result can be used as the value of `default-directory'
614 or passed as second argument to `expand-file-name'.
615 For a Unix-syntax file name, just appends a slash.
616 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
627 /* If the file name has special constructs in it,
628 call the corresponding file handler. */
629 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
631 return call2 (handler
, Qfile_name_as_directory
, file
);
633 buf
= (char *) alloca (SBYTES (file
) + 10);
634 file_name_as_directory (buf
, SDATA (file
));
635 return make_specified_string (buf
, -1, strlen (buf
),
636 STRING_MULTIBYTE (file
));
640 * Convert from directory name to filename.
642 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
643 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
644 * On UNIX, it's simple: just make sure there isn't a terminating /
646 * Value is nonzero if the string output is different from the input.
650 directory_file_name (src
, dst
)
658 struct FAB fab
= cc$rms_fab
;
659 struct NAM nam
= cc$rms_nam
;
660 char esa
[NAM$C_MAXRSS
];
665 if (! index (src
, '/')
666 && (src
[slen
- 1] == ']'
667 || src
[slen
- 1] == ':'
668 || src
[slen
- 1] == '>'))
670 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
672 fab
.fab$b_fns
= slen
;
673 fab
.fab$l_nam
= &nam
;
674 fab
.fab$l_fop
= FAB$M_NAM
;
677 nam
.nam$b_ess
= sizeof esa
;
678 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
680 /* We call SYS$PARSE to handle such things as [--] for us. */
681 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
683 slen
= nam
.nam$b_esl
;
684 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
689 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
691 /* what about when we have logical_name:???? */
692 if (src
[slen
- 1] == ':')
693 { /* Xlate logical name and see what we get */
694 ptr
= strcpy (dst
, src
); /* upper case for getenv */
697 if ('a' <= *ptr
&& *ptr
<= 'z')
701 dst
[slen
- 1] = 0; /* remove colon */
702 if (!(src
= egetenv (dst
)))
704 /* should we jump to the beginning of this procedure?
705 Good points: allows us to use logical names that xlate
707 Bad points: can be a problem if we just translated to a device
709 For now, I'll punt and always expect VMS names, and hope for
712 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
713 { /* no recursion here! */
719 { /* not a directory spec */
724 bracket
= src
[slen
- 1];
726 /* If bracket is ']' or '>', bracket - 2 is the corresponding
728 ptr
= index (src
, bracket
- 2);
730 { /* no opening bracket */
734 if (!(rptr
= rindex (src
, '.')))
737 strncpy (dst
, src
, slen
);
741 dst
[slen
++] = bracket
;
746 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
747 then translate the device and recurse. */
748 if (dst
[slen
- 1] == ':'
749 && dst
[slen
- 2] != ':' /* skip decnet nodes */
750 && strcmp (src
+ slen
, "[000000]") == 0)
752 dst
[slen
- 1] = '\0';
753 if ((ptr
= egetenv (dst
))
754 && (rlen
= strlen (ptr
) - 1) > 0
755 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
756 && ptr
[rlen
- 1] == '.')
758 char * buf
= (char *) alloca (strlen (ptr
) + 1);
762 return directory_file_name (buf
, dst
);
767 strcat (dst
, "[000000]");
771 rlen
= strlen (rptr
) - 1;
772 strncat (dst
, rptr
, rlen
);
773 dst
[slen
+ rlen
] = '\0';
774 strcat (dst
, ".DIR.1");
778 /* Process as Unix format: just remove any final slash.
779 But leave "/" unchanged; do not change it to "". */
782 /* Handle // as root for apollo's. */
783 if ((slen
> 2 && dst
[slen
- 1] == '/')
784 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
788 && IS_DIRECTORY_SEP (dst
[slen
- 1])
790 && !IS_ANY_SEP (dst
[slen
- 2])
796 CORRECT_DIR_SEPS (dst
);
801 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
803 doc
: /* Returns the file name of the directory named DIRECTORY.
804 This is the name of the file that holds the data for the directory DIRECTORY.
805 This operation exists because a directory is also a file, but its name as
806 a directory is different from its name as a file.
807 In Unix-syntax, this function just removes the final slash.
808 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
809 it returns a file name such as \"[X]Y.DIR.1\". */)
811 Lisp_Object directory
;
816 CHECK_STRING (directory
);
818 if (NILP (directory
))
821 /* If the file name has special constructs in it,
822 call the corresponding file handler. */
823 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
825 return call2 (handler
, Qdirectory_file_name
, directory
);
828 /* 20 extra chars is insufficient for VMS, since we might perform a
829 logical name translation. an equivalence string can be up to 255
830 chars long, so grab that much extra space... - sss */
831 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
833 buf
= (char *) alloca (SBYTES (directory
) + 20);
835 directory_file_name (SDATA (directory
), buf
);
836 return make_specified_string (buf
, -1, strlen (buf
),
837 STRING_MULTIBYTE (directory
));
840 static char make_temp_name_tbl
[64] =
842 'A','B','C','D','E','F','G','H',
843 'I','J','K','L','M','N','O','P',
844 'Q','R','S','T','U','V','W','X',
845 'Y','Z','a','b','c','d','e','f',
846 'g','h','i','j','k','l','m','n',
847 'o','p','q','r','s','t','u','v',
848 'w','x','y','z','0','1','2','3',
849 '4','5','6','7','8','9','-','_'
852 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
854 /* Value is a temporary file name starting with PREFIX, a string.
856 The Emacs process number forms part of the result, so there is
857 no danger of generating a name being used by another process.
858 In addition, this function makes an attempt to choose a name
859 which has no existing file. To make this work, PREFIX should be
860 an absolute file name.
862 BASE64_P non-zero means add the pid as 3 characters in base64
863 encoding. In this case, 6 characters will be added to PREFIX to
864 form the file name. Otherwise, if Emacs is running on a system
865 with long file names, add the pid as a decimal number.
867 This function signals an error if no unique file name could be
871 make_temp_name (prefix
, base64_p
)
878 unsigned char *p
, *data
;
882 CHECK_STRING (prefix
);
884 /* VAL is created by adding 6 characters to PREFIX. The first
885 three are the PID of this process, in base 64, and the second
886 three are incremented if the file already exists. This ensures
887 262144 unique file names per PID per PREFIX. */
889 pid
= (int) getpid ();
893 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
894 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
895 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
900 #ifdef HAVE_LONG_FILE_NAMES
901 sprintf (pidbuf
, "%d", pid
);
902 pidlen
= strlen (pidbuf
);
904 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
905 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
906 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
911 len
= SCHARS (prefix
);
912 val
= make_uninit_string (len
+ 3 + pidlen
);
914 bcopy(SDATA (prefix
), data
, len
);
917 bcopy (pidbuf
, p
, pidlen
);
920 /* Here we try to minimize useless stat'ing when this function is
921 invoked many times successively with the same PREFIX. We achieve
922 this by initializing count to a random value, and incrementing it
925 We don't want make-temp-name to be called while dumping,
926 because then make_temp_name_count_initialized_p would get set
927 and then make_temp_name_count would not be set when Emacs starts. */
929 if (!make_temp_name_count_initialized_p
)
931 make_temp_name_count
= (unsigned) time (NULL
);
932 make_temp_name_count_initialized_p
= 1;
938 unsigned num
= make_temp_name_count
;
940 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
941 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
942 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
944 /* Poor man's congruential RN generator. Replace with
945 ++make_temp_name_count for debugging. */
946 make_temp_name_count
+= 25229;
947 make_temp_name_count
%= 225307;
949 if (stat (data
, &ignored
) < 0)
951 /* We want to return only if errno is ENOENT. */
955 /* The error here is dubious, but there is little else we
956 can do. The alternatives are to return nil, which is
957 as bad as (and in many cases worse than) throwing the
958 error, or to ignore the error, which will likely result
959 in looping through 225307 stat's, which is not only
960 dog-slow, but also useless since it will fallback to
961 the errow below, anyway. */
962 report_file_error ("Cannot create temporary name for prefix",
963 Fcons (prefix
, Qnil
));
968 error ("Cannot create temporary name for prefix `%s'",
974 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
975 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
976 The Emacs process number forms part of the result,
977 so there is no danger of generating a name being used by another process.
979 In addition, this function makes an attempt to choose a name
980 which has no existing file. To make this work,
981 PREFIX should be an absolute file name.
983 There is a race condition between calling `make-temp-name' and creating the
984 file which opens all kinds of security holes. For that reason, you should
985 probably use `make-temp-file' instead, except in three circumstances:
987 * If you are creating the file in the user's home directory.
988 * If you are creating a directory rather than an ordinary file.
989 * If you are taking special precautions as `make-temp-file' does. */)
993 return make_temp_name (prefix
, 0);
998 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
999 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1000 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1001 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1002 the current buffer's value of default-directory is used.
1003 File name components that are `.' are removed, and
1004 so are file name components followed by `..', along with the `..' itself;
1005 note that these simplifications are done without checking the resulting
1006 file names in the file system.
1007 An initial `~/' expands to your home directory.
1008 An initial `~USER/' expands to USER's home directory.
1009 See also the function `substitute-in-file-name'. */)
1010 (name
, default_directory
)
1011 Lisp_Object name
, default_directory
;
1015 register unsigned char *newdir
, *p
, *o
;
1017 unsigned char *target
;
1020 unsigned char * colon
= 0;
1021 unsigned char * close
= 0;
1022 unsigned char * slash
= 0;
1023 unsigned char * brack
= 0;
1024 int lbrack
= 0, rbrack
= 0;
1029 int collapse_newdir
= 1;
1033 Lisp_Object handler
, result
;
1035 CHECK_STRING (name
);
1037 /* If the file name has special constructs in it,
1038 call the corresponding file handler. */
1039 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1040 if (!NILP (handler
))
1041 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1043 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1044 if (NILP (default_directory
))
1045 default_directory
= current_buffer
->directory
;
1046 if (! STRINGP (default_directory
))
1049 /* "/" is not considered a root directory on DOS_NT, so using "/"
1050 here causes an infinite recursion in, e.g., the following:
1052 (let (default-directory)
1053 (expand-file-name "a"))
1055 To avoid this, we set default_directory to the root of the
1057 extern char *emacs_root_dir (void);
1059 default_directory
= build_string (emacs_root_dir ());
1061 default_directory
= build_string ("/");
1065 if (!NILP (default_directory
))
1067 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1068 if (!NILP (handler
))
1069 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1072 o
= SDATA (default_directory
);
1074 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1075 It would be better to do this down below where we actually use
1076 default_directory. Unfortunately, calling Fexpand_file_name recursively
1077 could invoke GC, and the strings might be relocated. This would
1078 be annoying because we have pointers into strings lying around
1079 that would need adjusting, and people would add new pointers to
1080 the code and forget to adjust them, resulting in intermittent bugs.
1081 Putting this call here avoids all that crud.
1083 The EQ test avoids infinite recursion. */
1084 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1085 /* Save time in some common cases - as long as default_directory
1086 is not relative, it can be canonicalized with name below (if it
1087 is needed at all) without requiring it to be expanded now. */
1089 /* Detect MSDOS file names with drive specifiers. */
1090 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1092 /* Detect Windows file names in UNC format. */
1093 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1095 #else /* not DOS_NT */
1096 /* Detect Unix absolute file names (/... alone is not absolute on
1098 && ! (IS_DIRECTORY_SEP (o
[0]))
1099 #endif /* not DOS_NT */
1102 struct gcpro gcpro1
;
1105 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1110 /* Filenames on VMS are always upper case. */
1111 name
= Fupcase (name
);
1113 #ifdef FILE_SYSTEM_CASE
1114 name
= FILE_SYSTEM_CASE (name
);
1120 /* We will force directory separators to be either all \ or /, so make
1121 a local copy to modify, even if there ends up being no change. */
1122 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1124 /* Note if special escape prefix is present, but remove for now. */
1125 if (nm
[0] == '/' && nm
[1] == ':')
1131 /* Find and remove drive specifier if present; this makes nm absolute
1132 even if the rest of the name appears to be relative. Only look for
1133 drive specifier at the beginning. */
1134 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1141 /* If we see "c://somedir", we want to strip the first slash after the
1142 colon when stripping the drive letter. Otherwise, this expands to
1144 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1146 #endif /* WINDOWSNT */
1150 /* Discard any previous drive specifier if nm is now in UNC format. */
1151 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1157 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1158 none are found, we can probably return right away. We will avoid
1159 allocating a new string if name is already fully expanded. */
1161 IS_DIRECTORY_SEP (nm
[0])
1163 && drive
&& !is_escaped
1166 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1173 /* If it turns out that the filename we want to return is just a
1174 suffix of FILENAME, we don't need to go through and edit
1175 things; we just need to construct a new string using data
1176 starting at the middle of FILENAME. If we set lose to a
1177 non-zero value, that means we've discovered that we can't do
1184 /* Since we know the name is absolute, we can assume that each
1185 element starts with a "/". */
1187 /* "." and ".." are hairy. */
1188 if (IS_DIRECTORY_SEP (p
[0])
1190 && (IS_DIRECTORY_SEP (p
[2])
1192 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1195 /* We want to replace multiple `/' in a row with a single
1198 && IS_DIRECTORY_SEP (p
[0])
1199 && IS_DIRECTORY_SEP (p
[1]))
1206 /* if dev:[dir]/, move nm to / */
1207 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1208 nm
= (brack
? brack
+ 1 : colon
+ 1);
1209 lbrack
= rbrack
= 0;
1217 /* VMS pre V4.4,convert '-'s in filenames. */
1218 if (lbrack
== rbrack
)
1220 if (dots
< 2) /* this is to allow negative version numbers */
1225 if (lbrack
> rbrack
&&
1226 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1227 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1233 /* count open brackets, reset close bracket pointer */
1234 if (p
[0] == '[' || p
[0] == '<')
1235 lbrack
++, brack
= 0;
1236 /* count close brackets, set close bracket pointer */
1237 if (p
[0] == ']' || p
[0] == '>')
1238 rbrack
++, brack
= p
;
1239 /* detect ][ or >< */
1240 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1242 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1243 nm
= p
+ 1, lose
= 1;
1244 if (p
[0] == ':' && (colon
|| slash
))
1245 /* if dev1:[dir]dev2:, move nm to dev2: */
1251 /* if /name/dev:, move nm to dev: */
1254 /* if node::dev:, move colon following dev */
1255 else if (colon
&& colon
[-1] == ':')
1257 /* if dev1:dev2:, move nm to dev2: */
1258 else if (colon
&& colon
[-1] != ':')
1263 if (p
[0] == ':' && !colon
)
1269 if (lbrack
== rbrack
)
1272 else if (p
[0] == '.')
1280 if (index (nm
, '/'))
1282 nm
= sys_translate_unix (nm
);
1283 return make_specified_string (nm
, -1, strlen (nm
),
1284 STRING_MULTIBYTE (name
));
1288 /* Make sure directories are all separated with / or \ as
1289 desired, but avoid allocation of a new string when not
1291 CORRECT_DIR_SEPS (nm
);
1293 if (IS_DIRECTORY_SEP (nm
[1]))
1295 if (strcmp (nm
, SDATA (name
)) != 0)
1296 name
= make_specified_string (nm
, -1, strlen (nm
),
1297 STRING_MULTIBYTE (name
));
1301 /* drive must be set, so this is okay */
1302 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1306 name
= make_specified_string (nm
, -1, p
- nm
,
1307 STRING_MULTIBYTE (name
));
1308 temp
[0] = DRIVE_LETTER (drive
);
1309 name
= concat2 (build_string (temp
), name
);
1312 #else /* not DOS_NT */
1313 if (nm
== SDATA (name
))
1315 return make_specified_string (nm
, -1, strlen (nm
),
1316 STRING_MULTIBYTE (name
));
1317 #endif /* not DOS_NT */
1321 /* At this point, nm might or might not be an absolute file name. We
1322 need to expand ~ or ~user if present, otherwise prefix nm with
1323 default_directory if nm is not absolute, and finally collapse /./
1324 and /foo/../ sequences.
1326 We set newdir to be the appropriate prefix if one is needed:
1327 - the relevant user directory if nm starts with ~ or ~user
1328 - the specified drive's working dir (DOS/NT only) if nm does not
1330 - the value of default_directory.
1332 Note that these prefixes are not guaranteed to be absolute (except
1333 for the working dir of a drive). Therefore, to ensure we always
1334 return an absolute name, if the final prefix is not absolute we
1335 append it to the current working directory. */
1339 if (nm
[0] == '~') /* prefix ~ */
1341 if (IS_DIRECTORY_SEP (nm
[1])
1345 || nm
[1] == 0) /* ~ by itself */
1347 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1348 newdir
= (unsigned char *) "";
1351 collapse_newdir
= 0;
1354 nm
++; /* Don't leave the slash in nm. */
1357 else /* ~user/filename */
1359 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1364 o
= (unsigned char *) alloca (p
- nm
+ 1);
1365 bcopy ((char *) nm
, o
, p
- nm
);
1368 pw
= (struct passwd
*) getpwnam (o
+ 1);
1371 newdir
= (unsigned char *) pw
-> pw_dir
;
1373 nm
= p
+ 1; /* skip the terminator */
1377 collapse_newdir
= 0;
1382 /* If we don't find a user of that name, leave the name
1383 unchanged; don't move nm forward to p. */
1388 /* On DOS and Windows, nm is absolute if a drive name was specified;
1389 use the drive's current directory as the prefix if needed. */
1390 if (!newdir
&& drive
)
1392 /* Get default directory if needed to make nm absolute. */
1393 if (!IS_DIRECTORY_SEP (nm
[0]))
1395 newdir
= alloca (MAXPATHLEN
+ 1);
1396 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1401 /* Either nm starts with /, or drive isn't mounted. */
1402 newdir
= alloca (4);
1403 newdir
[0] = DRIVE_LETTER (drive
);
1411 /* Finally, if no prefix has been specified and nm is not absolute,
1412 then it must be expanded relative to default_directory. */
1416 /* /... alone is not absolute on DOS and Windows. */
1417 && !IS_DIRECTORY_SEP (nm
[0])
1420 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1427 newdir
= SDATA (default_directory
);
1429 /* Note if special escape prefix is present, but remove for now. */
1430 if (newdir
[0] == '/' && newdir
[1] == ':')
1441 /* First ensure newdir is an absolute name. */
1443 /* Detect MSDOS file names with drive specifiers. */
1444 ! (IS_DRIVE (newdir
[0])
1445 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1447 /* Detect Windows file names in UNC format. */
1448 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1452 /* Effectively, let newdir be (expand-file-name newdir cwd).
1453 Because of the admonition against calling expand-file-name
1454 when we have pointers into lisp strings, we accomplish this
1455 indirectly by prepending newdir to nm if necessary, and using
1456 cwd (or the wd of newdir's drive) as the new newdir. */
1458 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1463 if (!IS_DIRECTORY_SEP (nm
[0]))
1465 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1466 file_name_as_directory (tmp
, newdir
);
1470 newdir
= alloca (MAXPATHLEN
+ 1);
1473 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1480 /* Strip off drive name from prefix, if present. */
1481 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1487 /* Keep only a prefix from newdir if nm starts with slash
1488 (//server/share for UNC, nothing otherwise). */
1489 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1492 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1494 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1496 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1498 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1510 /* Get rid of any slash at the end of newdir, unless newdir is
1511 just / or // (an incomplete UNC name). */
1512 length
= strlen (newdir
);
1513 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1515 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1519 unsigned char *temp
= (unsigned char *) alloca (length
);
1520 bcopy (newdir
, temp
, length
- 1);
1521 temp
[length
- 1] = 0;
1529 /* Now concatenate the directory and name to new space in the stack frame */
1530 tlen
+= strlen (nm
) + 1;
1532 /* Reserve space for drive specifier and escape prefix, since either
1533 or both may need to be inserted. (The Microsoft x86 compiler
1534 produces incorrect code if the following two lines are combined.) */
1535 target
= (unsigned char *) alloca (tlen
+ 4);
1537 #else /* not DOS_NT */
1538 target
= (unsigned char *) alloca (tlen
);
1539 #endif /* not DOS_NT */
1545 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1548 /* If newdir is effectively "C:/", then the drive letter will have
1549 been stripped and newdir will be "/". Concatenating with an
1550 absolute directory in nm produces "//", which will then be
1551 incorrectly treated as a network share. Ignore newdir in
1552 this case (keeping the drive letter). */
1553 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1554 && newdir
[1] == '\0'))
1556 strcpy (target
, newdir
);
1560 file_name_as_directory (target
, newdir
);
1563 strcat (target
, nm
);
1565 if (index (target
, '/'))
1566 strcpy (target
, sys_translate_unix (target
));
1569 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1571 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1580 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1586 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1587 /* brackets are offset from each other by 2 */
1590 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1591 /* convert [foo][bar] to [bar] */
1592 while (o
[-1] != '[' && o
[-1] != '<')
1594 else if (*p
== '-' && *o
!= '.')
1597 else if (p
[0] == '-' && o
[-1] == '.' &&
1598 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1599 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1603 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1604 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1606 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1608 /* else [foo.-] ==> [-] */
1614 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1615 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1621 if (!IS_DIRECTORY_SEP (*p
))
1625 else if (IS_DIRECTORY_SEP (p
[0])
1627 && (IS_DIRECTORY_SEP (p
[2])
1630 /* If "/." is the entire filename, keep the "/". Otherwise,
1631 just delete the whole "/.". */
1632 if (o
== target
&& p
[2] == '\0')
1636 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1637 /* `/../' is the "superroot" on certain file systems. */
1639 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1641 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1643 /* Keep initial / only if this is the whole name. */
1644 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1649 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1651 /* Collapse multiple `/' in a row. */
1653 while (IS_DIRECTORY_SEP (*p
))
1660 #endif /* not VMS */
1664 /* At last, set drive name. */
1666 /* Except for network file name. */
1667 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1668 #endif /* WINDOWSNT */
1670 if (!drive
) abort ();
1672 target
[0] = DRIVE_LETTER (drive
);
1675 /* Reinsert the escape prefix if required. */
1682 CORRECT_DIR_SEPS (target
);
1685 result
= make_specified_string (target
, -1, o
- target
,
1686 STRING_MULTIBYTE (name
));
1688 /* Again look to see if the file name has special constructs in it
1689 and perhaps call the corresponding file handler. This is needed
1690 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1691 the ".." component gives us "/user@host:/bar/../baz" which needs
1692 to be expanded again. */
1693 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1694 if (!NILP (handler
))
1695 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1701 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1702 This is the old version of expand-file-name, before it was thoroughly
1703 rewritten for Emacs 10.31. We leave this version here commented-out,
1704 because the code is very complex and likely to have subtle bugs. If
1705 bugs _are_ found, it might be of interest to look at the old code and
1706 see what did it do in the relevant situation.
1708 Don't remove this code: it's true that it will be accessible via CVS,
1709 but a few years from deletion, people will forget it is there. */
1711 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1712 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1713 "Convert FILENAME to absolute, and canonicalize it.\n\
1714 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1715 (does not start with slash); if DEFAULT is nil or missing,\n\
1716 the current buffer's value of default-directory is used.\n\
1717 Filenames containing `.' or `..' as components are simplified;\n\
1718 initial `~/' expands to your home directory.\n\
1719 See also the function `substitute-in-file-name'.")
1721 Lisp_Object name
, defalt
;
1725 register unsigned char *newdir
, *p
, *o
;
1727 unsigned char *target
;
1731 unsigned char * colon
= 0;
1732 unsigned char * close
= 0;
1733 unsigned char * slash
= 0;
1734 unsigned char * brack
= 0;
1735 int lbrack
= 0, rbrack
= 0;
1739 CHECK_STRING (name
);
1742 /* Filenames on VMS are always upper case. */
1743 name
= Fupcase (name
);
1748 /* If nm is absolute, flush ...// and detect /./ and /../.
1749 If no /./ or /../ we can return right away. */
1761 if (p
[0] == '/' && p
[1] == '/'
1763 /* // at start of filename is meaningful on Apollo system. */
1768 if (p
[0] == '/' && p
[1] == '~')
1769 nm
= p
+ 1, lose
= 1;
1770 if (p
[0] == '/' && p
[1] == '.'
1771 && (p
[2] == '/' || p
[2] == 0
1772 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1778 /* if dev:[dir]/, move nm to / */
1779 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1780 nm
= (brack
? brack
+ 1 : colon
+ 1);
1781 lbrack
= rbrack
= 0;
1789 /* VMS pre V4.4,convert '-'s in filenames. */
1790 if (lbrack
== rbrack
)
1792 if (dots
< 2) /* this is to allow negative version numbers */
1797 if (lbrack
> rbrack
&&
1798 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1799 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1805 /* count open brackets, reset close bracket pointer */
1806 if (p
[0] == '[' || p
[0] == '<')
1807 lbrack
++, brack
= 0;
1808 /* count close brackets, set close bracket pointer */
1809 if (p
[0] == ']' || p
[0] == '>')
1810 rbrack
++, brack
= p
;
1811 /* detect ][ or >< */
1812 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1814 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1815 nm
= p
+ 1, lose
= 1;
1816 if (p
[0] == ':' && (colon
|| slash
))
1817 /* if dev1:[dir]dev2:, move nm to dev2: */
1823 /* If /name/dev:, move nm to dev: */
1826 /* If node::dev:, move colon following dev */
1827 else if (colon
&& colon
[-1] == ':')
1829 /* If dev1:dev2:, move nm to dev2: */
1830 else if (colon
&& colon
[-1] != ':')
1835 if (p
[0] == ':' && !colon
)
1841 if (lbrack
== rbrack
)
1844 else if (p
[0] == '.')
1852 if (index (nm
, '/'))
1853 return build_string (sys_translate_unix (nm
));
1855 if (nm
== SDATA (name
))
1857 return build_string (nm
);
1861 /* Now determine directory to start with and put it in NEWDIR */
1865 if (nm
[0] == '~') /* prefix ~ */
1870 || nm
[1] == 0)/* ~/filename */
1872 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1873 newdir
= (unsigned char *) "";
1876 nm
++; /* Don't leave the slash in nm. */
1879 else /* ~user/filename */
1881 /* Get past ~ to user */
1882 unsigned char *user
= nm
+ 1;
1883 /* Find end of name. */
1884 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1885 int len
= ptr
? ptr
- user
: strlen (user
);
1887 unsigned char *ptr1
= index (user
, ':');
1888 if (ptr1
!= 0 && ptr1
- user
< len
)
1891 /* Copy the user name into temp storage. */
1892 o
= (unsigned char *) alloca (len
+ 1);
1893 bcopy ((char *) user
, o
, len
);
1896 /* Look up the user name. */
1897 pw
= (struct passwd
*) getpwnam (o
+ 1);
1899 error ("\"%s\" isn't a registered user", o
+ 1);
1901 newdir
= (unsigned char *) pw
->pw_dir
;
1903 /* Discard the user name from NM. */
1910 #endif /* not VMS */
1914 defalt
= current_buffer
->directory
;
1915 CHECK_STRING (defalt
);
1916 newdir
= SDATA (defalt
);
1919 /* Now concatenate the directory and name to new space in the stack frame */
1921 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1922 target
= (unsigned char *) alloca (tlen
);
1928 if (nm
[0] == 0 || nm
[0] == '/')
1929 strcpy (target
, newdir
);
1932 file_name_as_directory (target
, newdir
);
1935 strcat (target
, nm
);
1937 if (index (target
, '/'))
1938 strcpy (target
, sys_translate_unix (target
));
1941 /* Now canonicalize by removing /. and /foo/.. if they appear */
1949 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1955 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1956 /* brackets are offset from each other by 2 */
1959 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1960 /* convert [foo][bar] to [bar] */
1961 while (o
[-1] != '[' && o
[-1] != '<')
1963 else if (*p
== '-' && *o
!= '.')
1966 else if (p
[0] == '-' && o
[-1] == '.' &&
1967 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1968 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1972 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1973 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1975 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1977 /* else [foo.-] ==> [-] */
1983 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1984 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1994 else if (!strncmp (p
, "//", 2)
1996 /* // at start of filename is meaningful in Apollo system. */
2004 else if (p
[0] == '/' && p
[1] == '.' &&
2005 (p
[2] == '/' || p
[2] == 0))
2007 else if (!strncmp (p
, "/..", 3)
2008 /* `/../' is the "superroot" on certain file systems. */
2010 && (p
[3] == '/' || p
[3] == 0))
2012 while (o
!= target
&& *--o
!= '/')
2015 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2019 if (o
== target
&& *o
== '/')
2027 #endif /* not VMS */
2030 return make_string (target
, o
- target
);
2034 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2035 Ssubstitute_in_file_name
, 1, 1, 0,
2036 doc
: /* Substitute environment variables referred to in FILENAME.
2037 `$FOO' where FOO is an environment variable name means to substitute
2038 the value of that variable. The variable name should be terminated
2039 with a character not a letter, digit or underscore; otherwise, enclose
2040 the entire variable name in braces.
2041 If `/~' appears, all of FILENAME through that `/' is discarded.
2043 On VMS, `$' substitution is not done; this function does little and only
2044 duplicates what `expand-file-name' does. */)
2046 Lisp_Object filename
;
2050 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2051 unsigned char *target
= NULL
;
2053 int substituted
= 0;
2056 Lisp_Object handler
;
2058 CHECK_STRING (filename
);
2060 /* If the file name has special constructs in it,
2061 call the corresponding file handler. */
2062 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2063 if (!NILP (handler
))
2064 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2066 nm
= SDATA (filename
);
2068 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2069 CORRECT_DIR_SEPS (nm
);
2070 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2072 endp
= nm
+ SBYTES (filename
);
2074 /* If /~ or // appears, discard everything through first slash. */
2076 for (p
= nm
; p
!= endp
; p
++)
2079 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2080 /* // at start of file name is meaningful in Apollo,
2081 WindowsNT and Cygwin systems. */
2082 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2083 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2084 || IS_DIRECTORY_SEP (p
[0])
2085 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2090 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2092 || IS_DIRECTORY_SEP (p
[-1])))
2094 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2099 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2101 o
= (unsigned char *) alloca (s
- p
+ 1);
2102 bcopy ((char *) p
, o
, s
- p
);
2105 pw
= (struct passwd
*) getpwnam (o
+ 1);
2107 /* If we have ~/ or ~user and `user' exists, discard
2108 everything up to ~. But if `user' does not exist, leave
2109 ~user alone, it might be a literal file name. */
2110 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2117 /* see comment in expand-file-name about drive specifiers */
2118 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2119 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2128 return make_specified_string (nm
, -1, strlen (nm
),
2129 STRING_MULTIBYTE (filename
));
2132 /* See if any variables are substituted into the string
2133 and find the total length of their values in `total' */
2135 for (p
= nm
; p
!= endp
;)
2145 /* "$$" means a single "$" */
2154 while (p
!= endp
&& *p
!= '}') p
++;
2155 if (*p
!= '}') goto missingclose
;
2161 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2165 /* Copy out the variable name */
2166 target
= (unsigned char *) alloca (s
- o
+ 1);
2167 strncpy (target
, o
, s
- o
);
2170 strupr (target
); /* $home == $HOME etc. */
2173 /* Get variable value */
2174 o
= (unsigned char *) egetenv (target
);
2177 total
+= strlen (o
);
2187 /* If substitution required, recopy the string and do it */
2188 /* Make space in stack frame for the new copy */
2189 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2192 /* Copy the rest of the name through, replacing $ constructs with values */
2209 while (p
!= endp
&& *p
!= '}') p
++;
2210 if (*p
!= '}') goto missingclose
;
2216 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2220 /* Copy out the variable name */
2221 target
= (unsigned char *) alloca (s
- o
+ 1);
2222 strncpy (target
, o
, s
- o
);
2225 strupr (target
); /* $home == $HOME etc. */
2228 /* Get variable value */
2229 o
= (unsigned char *) egetenv (target
);
2233 strcpy (x
, target
); x
+= strlen (target
);
2235 else if (STRING_MULTIBYTE (filename
))
2237 /* If the original string is multibyte,
2238 convert what we substitute into multibyte. */
2241 int c
= unibyte_char_to_multibyte (*o
++);
2242 x
+= CHAR_STRING (c
, x
);
2254 /* If /~ or // appears, discard everything through first slash. */
2256 for (p
= xnm
; p
!= x
; p
++)
2258 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2259 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2260 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2261 || IS_DIRECTORY_SEP (p
[0])
2262 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2264 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2267 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2268 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2272 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2275 error ("Bad format environment-variable substitution");
2277 error ("Missing \"}\" in environment-variable substitution");
2279 error ("Substituting nonexistent environment variable \"%s\"", target
);
2282 #endif /* not VMS */
2286 /* A slightly faster and more convenient way to get
2287 (directory-file-name (expand-file-name FOO)). */
2290 expand_and_dir_to_file (filename
, defdir
)
2291 Lisp_Object filename
, defdir
;
2293 register Lisp_Object absname
;
2295 absname
= Fexpand_file_name (filename
, defdir
);
2298 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2299 if (c
== ':' || c
== ']' || c
== '>')
2300 absname
= Fdirectory_file_name (absname
);
2303 /* Remove final slash, if any (unless this is the root dir).
2304 stat behaves differently depending! */
2305 if (SCHARS (absname
) > 1
2306 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2307 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2308 /* We cannot take shortcuts; they might be wrong for magic file names. */
2309 absname
= Fdirectory_file_name (absname
);
2314 /* Signal an error if the file ABSNAME already exists.
2315 If INTERACTIVE is nonzero, ask the user whether to proceed,
2316 and bypass the error if the user says to go ahead.
2317 QUERYSTRING is a name for the action that is being considered
2320 *STATPTR is used to store the stat information if the file exists.
2321 If the file does not exist, STATPTR->st_mode is set to 0.
2322 If STATPTR is null, we don't store into it.
2324 If QUICK is nonzero, we ask for y or n, not yes or no. */
2327 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2328 Lisp_Object absname
;
2329 unsigned char *querystring
;
2331 struct stat
*statptr
;
2334 register Lisp_Object tem
, encoded_filename
;
2335 struct stat statbuf
;
2336 struct gcpro gcpro1
;
2338 encoded_filename
= ENCODE_FILE (absname
);
2340 /* stat is a good way to tell whether the file exists,
2341 regardless of what access permissions it has. */
2342 if (stat (SDATA (encoded_filename
), &statbuf
) >= 0)
2345 Fsignal (Qfile_already_exists
,
2346 Fcons (build_string ("File already exists"),
2347 Fcons (absname
, Qnil
)));
2349 tem
= format2 ("File %s already exists; %s anyway? ",
2350 absname
, build_string (querystring
));
2352 tem
= Fy_or_n_p (tem
);
2354 tem
= do_yes_or_no_p (tem
);
2357 Fsignal (Qfile_already_exists
,
2358 Fcons (build_string ("File already exists"),
2359 Fcons (absname
, Qnil
)));
2366 statptr
->st_mode
= 0;
2371 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2372 "fCopy file: \nFCopy %s to file: \np\nP",
2373 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2374 If NEWNAME names a directory, copy FILE there.
2375 Signals a `file-already-exists' error if file NEWNAME already exists,
2376 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2377 A number as third arg means request confirmation if NEWNAME already exists.
2378 This is what happens in interactive use with M-x.
2379 Fourth arg KEEP-TIME non-nil means give the new file the same
2380 last-modified time as the old one. (This works on only some systems.)
2381 A prefix arg makes KEEP-TIME non-nil. */)
2382 (file
, newname
, ok_if_already_exists
, keep_time
)
2383 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2386 char buf
[16 * 1024];
2387 struct stat st
, out_st
;
2388 Lisp_Object handler
;
2389 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2390 int count
= SPECPDL_INDEX ();
2391 int input_file_statable_p
;
2392 Lisp_Object encoded_file
, encoded_newname
;
2394 encoded_file
= encoded_newname
= Qnil
;
2395 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2396 CHECK_STRING (file
);
2397 CHECK_STRING (newname
);
2399 if (!NILP (Ffile_directory_p (newname
)))
2400 newname
= Fexpand_file_name (file
, newname
);
2402 newname
= Fexpand_file_name (newname
, Qnil
);
2404 file
= Fexpand_file_name (file
, Qnil
);
2406 /* If the input file name has special constructs in it,
2407 call the corresponding file handler. */
2408 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2409 /* Likewise for output file name. */
2411 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2412 if (!NILP (handler
))
2413 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2414 ok_if_already_exists
, keep_time
));
2416 encoded_file
= ENCODE_FILE (file
);
2417 encoded_newname
= ENCODE_FILE (newname
);
2419 if (NILP (ok_if_already_exists
)
2420 || INTEGERP (ok_if_already_exists
))
2421 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2422 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2423 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2427 if (!CopyFile (SDATA (encoded_file
),
2428 SDATA (encoded_newname
),
2430 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2431 /* CopyFile retains the timestamp by default. */
2432 else if (NILP (keep_time
))
2438 EMACS_GET_TIME (now
);
2439 filename
= SDATA (encoded_newname
);
2441 /* Ensure file is writable while its modified time is set. */
2442 attributes
= GetFileAttributes (filename
);
2443 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2444 if (set_file_times (filename
, now
, now
))
2446 /* Restore original attributes. */
2447 SetFileAttributes (filename
, attributes
);
2448 Fsignal (Qfile_date_error
,
2449 Fcons (build_string ("Cannot set file date"),
2450 Fcons (newname
, Qnil
)));
2452 /* Restore original attributes. */
2453 SetFileAttributes (filename
, attributes
);
2455 #else /* not WINDOWSNT */
2457 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2461 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2463 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2465 /* We can only copy regular files and symbolic links. Other files are not
2467 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2469 #if !defined (DOS_NT) || __DJGPP__ > 1
2470 if (out_st
.st_mode
!= 0
2471 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2474 report_file_error ("Input and output files are the same",
2475 Fcons (file
, Fcons (newname
, Qnil
)));
2479 #if defined (S_ISREG) && defined (S_ISLNK)
2480 if (input_file_statable_p
)
2482 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2484 #if defined (EISDIR)
2485 /* Get a better looking error message. */
2488 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2491 #endif /* S_ISREG && S_ISLNK */
2494 /* Create the copy file with the same record format as the input file */
2495 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2498 /* System's default file type was set to binary by _fmode in emacs.c. */
2499 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2500 #else /* not MSDOS */
2501 ofd
= creat (SDATA (encoded_newname
), 0666);
2502 #endif /* not MSDOS */
2505 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2507 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2511 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2512 if (emacs_write (ofd
, buf
, n
) != n
)
2513 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2516 /* Closing the output clobbers the file times on some systems. */
2517 if (emacs_close (ofd
) < 0)
2518 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2520 if (input_file_statable_p
)
2522 if (!NILP (keep_time
))
2524 EMACS_TIME atime
, mtime
;
2525 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2526 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2527 if (set_file_times (SDATA (encoded_newname
),
2529 Fsignal (Qfile_date_error
,
2530 Fcons (build_string ("Cannot set file date"),
2531 Fcons (newname
, Qnil
)));
2534 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2536 #if defined (__DJGPP__) && __DJGPP__ > 1
2537 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2538 and if it can't, it tells so. Otherwise, under MSDOS we usually
2539 get only the READ bit, which will make the copied file read-only,
2540 so it's better not to chmod at all. */
2541 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2542 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2543 #endif /* DJGPP version 2 or newer */
2548 #endif /* WINDOWSNT */
2550 /* Discard the unwind protects. */
2551 specpdl_ptr
= specpdl
+ count
;
2557 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2558 Smake_directory_internal
, 1, 1, 0,
2559 doc
: /* Create a new directory named DIRECTORY. */)
2561 Lisp_Object directory
;
2563 const unsigned char *dir
;
2564 Lisp_Object handler
;
2565 Lisp_Object encoded_dir
;
2567 CHECK_STRING (directory
);
2568 directory
= Fexpand_file_name (directory
, Qnil
);
2570 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2571 if (!NILP (handler
))
2572 return call2 (handler
, Qmake_directory_internal
, directory
);
2574 encoded_dir
= ENCODE_FILE (directory
);
2576 dir
= SDATA (encoded_dir
);
2579 if (mkdir (dir
) != 0)
2581 if (mkdir (dir
, 0777) != 0)
2583 report_file_error ("Creating directory", Flist (1, &directory
));
2588 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2589 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2591 Lisp_Object directory
;
2593 const unsigned char *dir
;
2594 Lisp_Object handler
;
2595 Lisp_Object encoded_dir
;
2597 CHECK_STRING (directory
);
2598 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2600 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2601 if (!NILP (handler
))
2602 return call2 (handler
, Qdelete_directory
, directory
);
2604 encoded_dir
= ENCODE_FILE (directory
);
2606 dir
= SDATA (encoded_dir
);
2608 if (rmdir (dir
) != 0)
2609 report_file_error ("Removing directory", Flist (1, &directory
));
2614 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2615 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2616 If file has multiple names, it continues to exist with the other names. */)
2618 Lisp_Object filename
;
2620 Lisp_Object handler
;
2621 Lisp_Object encoded_file
;
2622 struct gcpro gcpro1
;
2625 if (!NILP (Ffile_directory_p (filename
)))
2626 Fsignal (Qfile_error
,
2627 Fcons (build_string ("Removing old name: is a directory"),
2628 Fcons (filename
, Qnil
)));
2630 filename
= Fexpand_file_name (filename
, Qnil
);
2632 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2633 if (!NILP (handler
))
2634 return call2 (handler
, Qdelete_file
, filename
);
2636 encoded_file
= ENCODE_FILE (filename
);
2638 if (0 > unlink (SDATA (encoded_file
)))
2639 report_file_error ("Removing old name", Flist (1, &filename
));
2644 internal_delete_file_1 (ignore
)
2650 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2653 internal_delete_file (filename
)
2654 Lisp_Object filename
;
2656 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2657 Qt
, internal_delete_file_1
));
2660 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2661 "fRename file: \nFRename %s to file: \np",
2662 doc
: /* Rename FILE as NEWNAME. Both args strings.
2663 If file has names other than FILE, it continues to have those names.
2664 Signals a `file-already-exists' error if a file NEWNAME already exists
2665 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2666 A number as third arg means request confirmation if NEWNAME already exists.
2667 This is what happens in interactive use with M-x. */)
2668 (file
, newname
, ok_if_already_exists
)
2669 Lisp_Object file
, newname
, ok_if_already_exists
;
2672 Lisp_Object args
[2];
2674 Lisp_Object handler
;
2675 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2676 Lisp_Object encoded_file
, encoded_newname
;
2678 encoded_file
= encoded_newname
= Qnil
;
2679 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2680 CHECK_STRING (file
);
2681 CHECK_STRING (newname
);
2682 file
= Fexpand_file_name (file
, Qnil
);
2683 newname
= Fexpand_file_name (newname
, Qnil
);
2685 /* If the file name has special constructs in it,
2686 call the corresponding file handler. */
2687 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2689 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2690 if (!NILP (handler
))
2691 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2692 file
, newname
, ok_if_already_exists
));
2694 encoded_file
= ENCODE_FILE (file
);
2695 encoded_newname
= ENCODE_FILE (newname
);
2698 /* If the file names are identical but for the case, don't ask for
2699 confirmation: they simply want to change the letter-case of the
2701 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2703 if (NILP (ok_if_already_exists
)
2704 || INTEGERP (ok_if_already_exists
))
2705 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2706 INTEGERP (ok_if_already_exists
), 0, 0);
2708 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2710 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2711 || 0 > unlink (SDATA (encoded_file
)))
2716 Fcopy_file (file
, newname
,
2717 /* We have already prompted if it was an integer,
2718 so don't have copy-file prompt again. */
2719 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2720 Fdelete_file (file
);
2727 report_file_error ("Renaming", Flist (2, args
));
2730 report_file_error ("Renaming", Flist (2, &file
));
2737 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2738 "fAdd name to file: \nFName to add to %s: \np",
2739 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2740 Signals a `file-already-exists' error if a file NEWNAME already exists
2741 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2742 A number as third arg means request confirmation if NEWNAME already exists.
2743 This is what happens in interactive use with M-x. */)
2744 (file
, newname
, ok_if_already_exists
)
2745 Lisp_Object file
, newname
, ok_if_already_exists
;
2748 Lisp_Object args
[2];
2750 Lisp_Object handler
;
2751 Lisp_Object encoded_file
, encoded_newname
;
2752 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2754 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2755 encoded_file
= encoded_newname
= Qnil
;
2756 CHECK_STRING (file
);
2757 CHECK_STRING (newname
);
2758 file
= Fexpand_file_name (file
, Qnil
);
2759 newname
= Fexpand_file_name (newname
, Qnil
);
2761 /* If the file name has special constructs in it,
2762 call the corresponding file handler. */
2763 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2764 if (!NILP (handler
))
2765 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2766 newname
, ok_if_already_exists
));
2768 /* If the new name has special constructs in it,
2769 call the corresponding file handler. */
2770 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2771 if (!NILP (handler
))
2772 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2773 newname
, ok_if_already_exists
));
2775 encoded_file
= ENCODE_FILE (file
);
2776 encoded_newname
= ENCODE_FILE (newname
);
2778 if (NILP (ok_if_already_exists
)
2779 || INTEGERP (ok_if_already_exists
))
2780 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2781 INTEGERP (ok_if_already_exists
), 0, 0);
2783 unlink (SDATA (newname
));
2784 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2789 report_file_error ("Adding new name", Flist (2, args
));
2791 report_file_error ("Adding new name", Flist (2, &file
));
2800 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2801 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2802 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2803 Signals a `file-already-exists' error if a file LINKNAME already exists
2804 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2805 A number as third arg means request confirmation if LINKNAME already exists.
2806 This happens for interactive use with M-x. */)
2807 (filename
, linkname
, ok_if_already_exists
)
2808 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2811 Lisp_Object args
[2];
2813 Lisp_Object handler
;
2814 Lisp_Object encoded_filename
, encoded_linkname
;
2815 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2817 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2818 encoded_filename
= encoded_linkname
= Qnil
;
2819 CHECK_STRING (filename
);
2820 CHECK_STRING (linkname
);
2821 /* If the link target has a ~, we must expand it to get
2822 a truly valid file name. Otherwise, do not expand;
2823 we want to permit links to relative file names. */
2824 if (SREF (filename
, 0) == '~')
2825 filename
= Fexpand_file_name (filename
, Qnil
);
2826 linkname
= Fexpand_file_name (linkname
, Qnil
);
2828 /* If the file name has special constructs in it,
2829 call the corresponding file handler. */
2830 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2831 if (!NILP (handler
))
2832 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2833 linkname
, ok_if_already_exists
));
2835 /* If the new link name has special constructs in it,
2836 call the corresponding file handler. */
2837 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2838 if (!NILP (handler
))
2839 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2840 linkname
, ok_if_already_exists
));
2842 encoded_filename
= ENCODE_FILE (filename
);
2843 encoded_linkname
= ENCODE_FILE (linkname
);
2845 if (NILP (ok_if_already_exists
)
2846 || INTEGERP (ok_if_already_exists
))
2847 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2848 INTEGERP (ok_if_already_exists
), 0, 0);
2849 if (0 > symlink (SDATA (encoded_filename
),
2850 SDATA (encoded_linkname
)))
2852 /* If we didn't complain already, silently delete existing file. */
2853 if (errno
== EEXIST
)
2855 unlink (SDATA (encoded_linkname
));
2856 if (0 <= symlink (SDATA (encoded_filename
),
2857 SDATA (encoded_linkname
)))
2867 report_file_error ("Making symbolic link", Flist (2, args
));
2869 report_file_error ("Making symbolic link", Flist (2, &filename
));
2875 #endif /* S_IFLNK */
2879 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2880 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2881 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2882 If STRING is nil or a null string, the logical name NAME is deleted. */)
2887 CHECK_STRING (name
);
2889 delete_logical_name (SDATA (name
));
2892 CHECK_STRING (string
);
2894 if (SCHARS (string
) == 0)
2895 delete_logical_name (SDATA (name
));
2897 define_logical_name (SDATA (name
), SDATA (string
));
2906 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2907 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2909 Lisp_Object path
, login
;
2913 CHECK_STRING (path
);
2914 CHECK_STRING (login
);
2916 netresult
= netunam (SDATA (path
), SDATA (login
));
2918 if (netresult
== -1)
2923 #endif /* HPUX_NET */
2925 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2927 doc
: /* Return t if file FILENAME specifies an absolute file name.
2928 On Unix, this is a name starting with a `/' or a `~'. */)
2930 Lisp_Object filename
;
2932 const unsigned char *ptr
;
2934 CHECK_STRING (filename
);
2935 ptr
= SDATA (filename
);
2936 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2938 /* ??? This criterion is probably wrong for '<'. */
2939 || index (ptr
, ':') || index (ptr
, '<')
2940 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2944 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2952 /* Return nonzero if file FILENAME exists and can be executed. */
2955 check_executable (filename
)
2959 int len
= strlen (filename
);
2962 if (stat (filename
, &st
) < 0)
2964 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2965 return ((st
.st_mode
& S_IEXEC
) != 0);
2967 return (S_ISREG (st
.st_mode
)
2969 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2970 || stricmp (suffix
, ".exe") == 0
2971 || stricmp (suffix
, ".bat") == 0)
2972 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2973 #endif /* not WINDOWSNT */
2974 #else /* not DOS_NT */
2975 #ifdef HAVE_EUIDACCESS
2976 return (euidaccess (filename
, 1) >= 0);
2978 /* Access isn't quite right because it uses the real uid
2979 and we really want to test with the effective uid.
2980 But Unix doesn't give us a right way to do it. */
2981 return (access (filename
, 1) >= 0);
2983 #endif /* not DOS_NT */
2986 /* Return nonzero if file FILENAME exists and can be written. */
2989 check_writable (filename
)
2994 if (stat (filename
, &st
) < 0)
2996 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2997 #else /* not MSDOS */
2998 #ifdef HAVE_EUIDACCESS
2999 return (euidaccess (filename
, 2) >= 0);
3001 /* Access isn't quite right because it uses the real uid
3002 and we really want to test with the effective uid.
3003 But Unix doesn't give us a right way to do it.
3004 Opening with O_WRONLY could work for an ordinary file,
3005 but would lose for directories. */
3006 return (access (filename
, 2) >= 0);
3008 #endif /* not MSDOS */
3011 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3012 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3013 See also `file-readable-p' and `file-attributes'. */)
3015 Lisp_Object filename
;
3017 Lisp_Object absname
;
3018 Lisp_Object handler
;
3019 struct stat statbuf
;
3021 CHECK_STRING (filename
);
3022 absname
= Fexpand_file_name (filename
, Qnil
);
3024 /* If the file name has special constructs in it,
3025 call the corresponding file handler. */
3026 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3027 if (!NILP (handler
))
3028 return call2 (handler
, Qfile_exists_p
, absname
);
3030 absname
= ENCODE_FILE (absname
);
3032 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3035 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3036 doc
: /* Return t if FILENAME can be executed by you.
3037 For a directory, this means you can access files in that directory. */)
3039 Lisp_Object filename
;
3041 Lisp_Object absname
;
3042 Lisp_Object handler
;
3044 CHECK_STRING (filename
);
3045 absname
= Fexpand_file_name (filename
, Qnil
);
3047 /* If the file name has special constructs in it,
3048 call the corresponding file handler. */
3049 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3050 if (!NILP (handler
))
3051 return call2 (handler
, Qfile_executable_p
, absname
);
3053 absname
= ENCODE_FILE (absname
);
3055 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3058 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3059 doc
: /* Return t if file FILENAME exists and you can read it.
3060 See also `file-exists-p' and `file-attributes'. */)
3062 Lisp_Object filename
;
3064 Lisp_Object absname
;
3065 Lisp_Object handler
;
3068 struct stat statbuf
;
3070 CHECK_STRING (filename
);
3071 absname
= Fexpand_file_name (filename
, Qnil
);
3073 /* If the file name has special constructs in it,
3074 call the corresponding file handler. */
3075 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3076 if (!NILP (handler
))
3077 return call2 (handler
, Qfile_readable_p
, absname
);
3079 absname
= ENCODE_FILE (absname
);
3081 #if defined(DOS_NT) || defined(macintosh)
3082 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3084 if (access (SDATA (absname
), 0) == 0)
3087 #else /* not DOS_NT and not macintosh */
3089 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3090 /* Opening a fifo without O_NONBLOCK can wait.
3091 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3092 except in the case of a fifo, on a system which handles it. */
3093 desc
= stat (SDATA (absname
), &statbuf
);
3096 if (S_ISFIFO (statbuf
.st_mode
))
3097 flags
|= O_NONBLOCK
;
3099 desc
= emacs_open (SDATA (absname
), flags
, 0);
3104 #endif /* not DOS_NT and not macintosh */
3107 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3109 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3110 doc
: /* Return t if file FILENAME can be written or created by you. */)
3112 Lisp_Object filename
;
3114 Lisp_Object absname
, dir
, encoded
;
3115 Lisp_Object handler
;
3116 struct stat statbuf
;
3118 CHECK_STRING (filename
);
3119 absname
= Fexpand_file_name (filename
, Qnil
);
3121 /* If the file name has special constructs in it,
3122 call the corresponding file handler. */
3123 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3124 if (!NILP (handler
))
3125 return call2 (handler
, Qfile_writable_p
, absname
);
3127 encoded
= ENCODE_FILE (absname
);
3128 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3129 return (check_writable (SDATA (encoded
))
3132 dir
= Ffile_name_directory (absname
);
3135 dir
= Fdirectory_file_name (dir
);
3139 dir
= Fdirectory_file_name (dir
);
3142 dir
= ENCODE_FILE (dir
);
3144 /* The read-only attribute of the parent directory doesn't affect
3145 whether a file or directory can be created within it. Some day we
3146 should check ACLs though, which do affect this. */
3147 if (stat (SDATA (dir
), &statbuf
) < 0)
3149 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3151 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3156 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3157 doc
: /* Access file FILENAME, and get an error if that does not work.
3158 The second argument STRING is used in the error message.
3159 If there is no error, we return nil. */)
3161 Lisp_Object filename
, string
;
3163 Lisp_Object handler
, encoded_filename
, absname
;
3166 CHECK_STRING (filename
);
3167 absname
= Fexpand_file_name (filename
, Qnil
);
3169 CHECK_STRING (string
);
3171 /* If the file name has special constructs in it,
3172 call the corresponding file handler. */
3173 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3174 if (!NILP (handler
))
3175 return call3 (handler
, Qaccess_file
, absname
, string
);
3177 encoded_filename
= ENCODE_FILE (absname
);
3179 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3181 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3187 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3188 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3189 The value is the link target, as a string.
3190 Otherwise returns nil. */)
3192 Lisp_Object filename
;
3199 Lisp_Object handler
;
3201 CHECK_STRING (filename
);
3202 filename
= Fexpand_file_name (filename
, Qnil
);
3204 /* If the file name has special constructs in it,
3205 call the corresponding file handler. */
3206 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3207 if (!NILP (handler
))
3208 return call2 (handler
, Qfile_symlink_p
, filename
);
3210 filename
= ENCODE_FILE (filename
);
3217 buf
= (char *) xrealloc (buf
, bufsize
);
3218 bzero (buf
, bufsize
);
3221 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3225 /* HP-UX reports ERANGE if buffer is too small. */
3226 if (errno
== ERANGE
)
3236 while (valsize
>= bufsize
);
3238 val
= make_string (buf
, valsize
);
3239 if (buf
[0] == '/' && index (buf
, ':'))
3240 val
= concat2 (build_string ("/:"), val
);
3242 val
= DECODE_FILE (val
);
3244 #else /* not S_IFLNK */
3246 #endif /* not S_IFLNK */
3249 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3250 doc
: /* Return t if FILENAME names an existing directory.
3251 Symbolic links to directories count as directories.
3252 See `file-symlink-p' to distinguish symlinks. */)
3254 Lisp_Object filename
;
3256 register Lisp_Object absname
;
3258 Lisp_Object handler
;
3260 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3262 /* If the file name has special constructs in it,
3263 call the corresponding file handler. */
3264 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3265 if (!NILP (handler
))
3266 return call2 (handler
, Qfile_directory_p
, absname
);
3268 absname
= ENCODE_FILE (absname
);
3270 if (stat (SDATA (absname
), &st
) < 0)
3272 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3275 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3276 doc
: /* Return t if file FILENAME names a directory you can open.
3277 For the value to be t, FILENAME must specify the name of a directory as a file,
3278 and the directory must allow you to open files in it. In order to use a
3279 directory as a buffer's current directory, this predicate must return true.
3280 A directory name spec may be given instead; then the value is t
3281 if the directory so specified exists and really is a readable and
3282 searchable directory. */)
3284 Lisp_Object filename
;
3286 Lisp_Object handler
;
3288 struct gcpro gcpro1
;
3290 /* If the file name has special constructs in it,
3291 call the corresponding file handler. */
3292 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3293 if (!NILP (handler
))
3294 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3297 tem
= (NILP (Ffile_directory_p (filename
))
3298 || NILP (Ffile_executable_p (filename
)));
3300 return tem
? Qnil
: Qt
;
3303 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3304 doc
: /* Return t if file FILENAME is the name of a regular file.
3305 This is the sort of file that holds an ordinary stream of data bytes. */)
3307 Lisp_Object filename
;
3309 register Lisp_Object absname
;
3311 Lisp_Object handler
;
3313 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3315 /* If the file name has special constructs in it,
3316 call the corresponding file handler. */
3317 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3318 if (!NILP (handler
))
3319 return call2 (handler
, Qfile_regular_p
, absname
);
3321 absname
= ENCODE_FILE (absname
);
3326 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3328 /* Tell stat to use expensive method to get accurate info. */
3329 Vw32_get_true_file_attributes
= Qt
;
3330 result
= stat (SDATA (absname
), &st
);
3331 Vw32_get_true_file_attributes
= tem
;
3335 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3338 if (stat (SDATA (absname
), &st
) < 0)
3340 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3344 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3345 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
3347 Lisp_Object filename
;
3349 Lisp_Object absname
;
3351 Lisp_Object handler
;
3353 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3355 /* If the file name has special constructs in it,
3356 call the corresponding file handler. */
3357 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3358 if (!NILP (handler
))
3359 return call2 (handler
, Qfile_modes
, absname
);
3361 absname
= ENCODE_FILE (absname
);
3363 if (stat (SDATA (absname
), &st
) < 0)
3365 #if defined (MSDOS) && __DJGPP__ < 2
3366 if (check_executable (SDATA (absname
)))
3367 st
.st_mode
|= S_IEXEC
;
3368 #endif /* MSDOS && __DJGPP__ < 2 */
3370 return make_number (st
.st_mode
& 07777);
3373 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3374 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3375 Only the 12 low bits of MODE are used. */)
3377 Lisp_Object filename
, mode
;
3379 Lisp_Object absname
, encoded_absname
;
3380 Lisp_Object handler
;
3382 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3383 CHECK_NUMBER (mode
);
3385 /* If the file name has special constructs in it,
3386 call the corresponding file handler. */
3387 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3388 if (!NILP (handler
))
3389 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3391 encoded_absname
= ENCODE_FILE (absname
);
3393 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3394 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3399 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3400 doc
: /* Set the file permission bits for newly created files.
3401 The argument MODE should be an integer; only the low 9 bits are used.
3402 This setting is inherited by subprocesses. */)
3406 CHECK_NUMBER (mode
);
3408 umask ((~ XINT (mode
)) & 0777);
3413 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3414 doc
: /* Return the default file protection for created files.
3415 The value is an integer. */)
3421 realmask
= umask (0);
3424 XSETINT (value
, (~ realmask
) & 0777);
3434 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3435 doc
: /* Tell Unix to finish all pending disk updates. */)
3444 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3445 doc
: /* Return t if file FILE1 is newer than file FILE2.
3446 If FILE1 does not exist, the answer is nil;
3447 otherwise, if FILE2 does not exist, the answer is t. */)
3449 Lisp_Object file1
, file2
;
3451 Lisp_Object absname1
, absname2
;
3454 Lisp_Object handler
;
3455 struct gcpro gcpro1
, gcpro2
;
3457 CHECK_STRING (file1
);
3458 CHECK_STRING (file2
);
3461 GCPRO2 (absname1
, file2
);
3462 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3463 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3466 /* If the file name has special constructs in it,
3467 call the corresponding file handler. */
3468 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3470 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3471 if (!NILP (handler
))
3472 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3474 GCPRO2 (absname1
, absname2
);
3475 absname1
= ENCODE_FILE (absname1
);
3476 absname2
= ENCODE_FILE (absname2
);
3479 if (stat (SDATA (absname1
), &st
) < 0)
3482 mtime1
= st
.st_mtime
;
3484 if (stat (SDATA (absname2
), &st
) < 0)
3487 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3491 Lisp_Object Qfind_buffer_file_type
;
3494 #ifndef READ_BUF_SIZE
3495 #define READ_BUF_SIZE (64 << 10)
3498 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3500 /* This function is called after Lisp functions to decide a coding
3501 system are called, or when they cause an error. Before they are
3502 called, the current buffer is set unibyte and it contains only a
3503 newly inserted text (thus the buffer was empty before the
3506 The functions may set markers, overlays, text properties, or even
3507 alter the buffer contents, change the current buffer.
3509 Here, we reset all those changes by:
3510 o set back the current buffer.
3511 o move all markers and overlays to BEG.
3512 o remove all text properties.
3513 o set back the buffer multibyteness. */
3516 decide_coding_unwind (unwind_data
)
3517 Lisp_Object unwind_data
;
3519 Lisp_Object multibyte
, undo_list
, buffer
;
3521 multibyte
= XCAR (unwind_data
);
3522 unwind_data
= XCDR (unwind_data
);
3523 undo_list
= XCAR (unwind_data
);
3524 buffer
= XCDR (unwind_data
);
3526 if (current_buffer
!= XBUFFER (buffer
))
3527 set_buffer_internal (XBUFFER (buffer
));
3528 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3529 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3530 BUF_INTERVALS (current_buffer
) = 0;
3531 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3533 /* Now we are safe to change the buffer's multibyteness directly. */
3534 current_buffer
->enable_multibyte_characters
= multibyte
;
3535 current_buffer
->undo_list
= undo_list
;
3541 /* Used to pass values from insert-file-contents to read_non_regular. */
3543 static int non_regular_fd
;
3544 static int non_regular_inserted
;
3545 static int non_regular_nbytes
;
3548 /* Read from a non-regular file.
3549 Read non_regular_trytry bytes max from non_regular_fd.
3550 Non_regular_inserted specifies where to put the read bytes.
3551 Value is the number of bytes read. */
3560 nbytes
= emacs_read (non_regular_fd
,
3561 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3562 non_regular_nbytes
);
3564 return make_number (nbytes
);
3568 /* Condition-case handler used when reading from non-regular files
3569 in insert-file-contents. */
3572 read_non_regular_quit ()
3578 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3580 doc
: /* Insert contents of file FILENAME after point.
3581 Returns list of absolute file name and number of characters inserted.
3582 If second argument VISIT is non-nil, the buffer's visited filename
3583 and last save file modtime are set, and it is marked unmodified.
3584 If visiting and the file does not exist, visiting is completed
3585 before the error is signaled.
3586 The optional third and fourth arguments BEG and END
3587 specify what portion of the file to insert.
3588 These arguments count bytes in the file, not characters in the buffer.
3589 If VISIT is non-nil, BEG and END must be nil.
3591 If optional fifth argument REPLACE is non-nil,
3592 it means replace the current buffer contents (in the accessible portion)
3593 with the file contents. This is better than simply deleting and inserting
3594 the whole thing because (1) it preserves some marker positions
3595 and (2) it puts less data in the undo list.
3596 When REPLACE is non-nil, the value is the number of characters actually read,
3597 which is often less than the number of characters to be read.
3599 This does code conversion according to the value of
3600 `coding-system-for-read' or `file-coding-system-alist',
3601 and sets the variable `last-coding-system-used' to the coding system
3603 (filename
, visit
, beg
, end
, replace
)
3604 Lisp_Object filename
, visit
, beg
, end
, replace
;
3609 register int how_much
;
3610 register int unprocessed
;
3611 int count
= SPECPDL_INDEX ();
3612 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3613 Lisp_Object handler
, val
, insval
, orig_filename
;
3616 int not_regular
= 0;
3617 unsigned char read_buf
[READ_BUF_SIZE
];
3618 struct coding_system coding
;
3619 unsigned char buffer
[1 << 14];
3620 int replace_handled
= 0;
3621 int set_coding_system
= 0;
3622 int coding_system_decided
= 0;
3625 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3626 error ("Cannot do file visiting in an indirect buffer");
3628 if (!NILP (current_buffer
->read_only
))
3629 Fbarf_if_buffer_read_only ();
3633 orig_filename
= Qnil
;
3635 GCPRO4 (filename
, val
, p
, orig_filename
);
3637 CHECK_STRING (filename
);
3638 filename
= Fexpand_file_name (filename
, Qnil
);
3640 /* If the file name has special constructs in it,
3641 call the corresponding file handler. */
3642 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3643 if (!NILP (handler
))
3645 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3646 visit
, beg
, end
, replace
);
3647 if (CONSP (val
) && CONSP (XCDR (val
)))
3648 inserted
= XINT (XCAR (XCDR (val
)));
3652 orig_filename
= filename
;
3653 filename
= ENCODE_FILE (filename
);
3659 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3661 /* Tell stat to use expensive method to get accurate info. */
3662 Vw32_get_true_file_attributes
= Qt
;
3663 total
= stat (SDATA (filename
), &st
);
3664 Vw32_get_true_file_attributes
= tem
;
3669 if (stat (SDATA (filename
), &st
) < 0)
3671 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3672 || fstat (fd
, &st
) < 0)
3673 #endif /* not APOLLO */
3674 #endif /* WINDOWSNT */
3676 if (fd
>= 0) emacs_close (fd
);
3679 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3682 if (!NILP (Vcoding_system_for_read
))
3683 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3688 /* This code will need to be changed in order to work on named
3689 pipes, and it's probably just not worth it. So we should at
3690 least signal an error. */
3691 if (!S_ISREG (st
.st_mode
))
3698 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3699 Fsignal (Qfile_error
,
3700 Fcons (build_string ("not a regular file"),
3701 Fcons (orig_filename
, Qnil
)));
3706 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3709 /* Replacement should preserve point as it preserves markers. */
3710 if (!NILP (replace
))
3711 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3713 record_unwind_protect (close_file_unwind
, make_number (fd
));
3715 /* Supposedly happens on VMS. */
3716 /* Can happen on any platform that uses long as type of off_t, but allows
3717 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3718 give a message suitable for the latter case. */
3719 if (! not_regular
&& st
.st_size
< 0)
3720 error ("Maximum buffer size exceeded");
3722 /* Prevent redisplay optimizations. */
3723 current_buffer
->clip_changed
= 1;
3727 if (!NILP (beg
) || !NILP (end
))
3728 error ("Attempt to visit less than an entire file");
3729 if (BEG
< Z
&& NILP (replace
))
3730 error ("Cannot do file visiting in a non-empty buffer");
3736 XSETFASTINT (beg
, 0);
3744 XSETINT (end
, st
.st_size
);
3746 /* Arithmetic overflow can occur if an Emacs integer cannot
3747 represent the file size, or if the calculations below
3748 overflow. The calculations below double the file size
3749 twice, so check that it can be multiplied by 4 safely. */
3750 if (XINT (end
) != st
.st_size
3751 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3752 error ("Maximum buffer size exceeded");
3754 /* The file size returned from stat may be zero, but data
3755 may be readable nonetheless, for example when this is a
3756 file in the /proc filesystem. */
3757 if (st
.st_size
== 0)
3758 XSETINT (end
, READ_BUF_SIZE
);
3764 /* Decide the coding system to use for reading the file now
3765 because we can't use an optimized method for handling
3766 `coding:' tag if the current buffer is not empty. */
3770 if (!NILP (Vcoding_system_for_read
))
3771 val
= Vcoding_system_for_read
;
3772 else if (! NILP (replace
))
3773 /* In REPLACE mode, we can use the same coding system
3774 that was used to visit the file. */
3775 val
= current_buffer
->buffer_file_coding_system
;
3778 /* Don't try looking inside a file for a coding system
3779 specification if it is not seekable. */
3780 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3782 /* Find a coding system specified in the heading two
3783 lines or in the tailing several lines of the file.
3784 We assume that the 1K-byte and 3K-byte for heading
3785 and tailing respectively are sufficient for this
3789 if (st
.st_size
<= (1024 * 4))
3790 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3793 nread
= emacs_read (fd
, read_buf
, 1024);
3796 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3797 report_file_error ("Setting file position",
3798 Fcons (orig_filename
, Qnil
));
3799 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3804 error ("IO error reading %s: %s",
3805 SDATA (orig_filename
), emacs_strerror (errno
));
3808 struct buffer
*prev
= current_buffer
;
3812 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3814 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3815 buf
= XBUFFER (buffer
);
3817 buf
->directory
= current_buffer
->directory
;
3818 buf
->read_only
= Qnil
;
3819 buf
->filename
= Qnil
;
3820 buf
->undo_list
= Qt
;
3821 buf
->overlays_before
= Qnil
;
3822 buf
->overlays_after
= Qnil
;
3824 set_buffer_internal (buf
);
3826 buf
->enable_multibyte_characters
= Qnil
;
3828 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3829 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3830 val
= call2 (Vset_auto_coding_function
,
3831 filename
, make_number (nread
));
3832 set_buffer_internal (prev
);
3834 /* Discard the unwind protect for recovering the
3838 /* Rewind the file for the actual read done later. */
3839 if (lseek (fd
, 0, 0) < 0)
3840 report_file_error ("Setting file position",
3841 Fcons (orig_filename
, Qnil
));
3847 /* If we have not yet decided a coding system, check
3848 file-coding-system-alist. */
3849 Lisp_Object args
[6], coding_systems
;
3851 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3852 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3853 coding_systems
= Ffind_operation_coding_system (6, args
);
3854 if (CONSP (coding_systems
))
3855 val
= XCAR (coding_systems
);
3859 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3860 /* Ensure we set Vlast_coding_system_used. */
3861 set_coding_system
= 1;
3863 if (NILP (current_buffer
->enable_multibyte_characters
)
3865 /* We must suppress all character code conversion except for
3866 end-of-line conversion. */
3867 setup_raw_text_coding_system (&coding
);
3869 coding
.src_multibyte
= 0;
3870 coding
.dst_multibyte
3871 = !NILP (current_buffer
->enable_multibyte_characters
);
3872 coding_system_decided
= 1;
3875 /* If requested, replace the accessible part of the buffer
3876 with the file contents. Avoid replacing text at the
3877 beginning or end of the buffer that matches the file contents;
3878 that preserves markers pointing to the unchanged parts.
3880 Here we implement this feature in an optimized way
3881 for the case where code conversion is NOT needed.
3882 The following if-statement handles the case of conversion
3883 in a less optimal way.
3885 If the code conversion is "automatic" then we try using this
3886 method and hope for the best.
3887 But if we discover the need for conversion, we give up on this method
3888 and let the following if-statement handle the replace job. */
3891 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3893 /* same_at_start and same_at_end count bytes,
3894 because file access counts bytes
3895 and BEG and END count bytes. */
3896 int same_at_start
= BEGV_BYTE
;
3897 int same_at_end
= ZV_BYTE
;
3899 /* There is still a possibility we will find the need to do code
3900 conversion. If that happens, we set this variable to 1 to
3901 give up on handling REPLACE in the optimized way. */
3902 int giveup_match_end
= 0;
3904 if (XINT (beg
) != 0)
3906 if (lseek (fd
, XINT (beg
), 0) < 0)
3907 report_file_error ("Setting file position",
3908 Fcons (orig_filename
, Qnil
));
3913 /* Count how many chars at the start of the file
3914 match the text at the beginning of the buffer. */
3919 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3921 error ("IO error reading %s: %s",
3922 SDATA (orig_filename
), emacs_strerror (errno
));
3923 else if (nread
== 0)
3926 if (coding
.type
== coding_type_undecided
)
3927 detect_coding (&coding
, buffer
, nread
);
3928 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
3929 /* We found that the file should be decoded somehow.
3930 Let's give up here. */
3932 giveup_match_end
= 1;
3936 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3937 detect_eol (&coding
, buffer
, nread
);
3938 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3939 && coding
.eol_type
!= CODING_EOL_LF
)
3940 /* We found that the format of eol should be decoded.
3941 Let's give up here. */
3943 giveup_match_end
= 1;
3948 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3949 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3950 same_at_start
++, bufpos
++;
3951 /* If we found a discrepancy, stop the scan.
3952 Otherwise loop around and scan the next bufferful. */
3953 if (bufpos
!= nread
)
3957 /* If the file matches the buffer completely,
3958 there's no need to replace anything. */
3959 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3963 /* Truncate the buffer to the size of the file. */
3964 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3969 /* Count how many chars at the end of the file
3970 match the text at the end of the buffer. But, if we have
3971 already found that decoding is necessary, don't waste time. */
3972 while (!giveup_match_end
)
3974 int total_read
, nread
, bufpos
, curpos
, trial
;
3976 /* At what file position are we now scanning? */
3977 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3978 /* If the entire file matches the buffer tail, stop the scan. */
3981 /* How much can we scan in the next step? */
3982 trial
= min (curpos
, sizeof buffer
);
3983 if (lseek (fd
, curpos
- trial
, 0) < 0)
3984 report_file_error ("Setting file position",
3985 Fcons (orig_filename
, Qnil
));
3987 total_read
= nread
= 0;
3988 while (total_read
< trial
)
3990 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3992 error ("IO error reading %s: %s",
3993 SDATA (orig_filename
), emacs_strerror (errno
));
3994 else if (nread
== 0)
3996 total_read
+= nread
;
3999 /* Scan this bufferful from the end, comparing with
4000 the Emacs buffer. */
4001 bufpos
= total_read
;
4003 /* Compare with same_at_start to avoid counting some buffer text
4004 as matching both at the file's beginning and at the end. */
4005 while (bufpos
> 0 && same_at_end
> same_at_start
4006 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4007 same_at_end
--, bufpos
--;
4009 /* If we found a discrepancy, stop the scan.
4010 Otherwise loop around and scan the preceding bufferful. */
4013 /* If this discrepancy is because of code conversion,
4014 we cannot use this method; giveup and try the other. */
4015 if (same_at_end
> same_at_start
4016 && FETCH_BYTE (same_at_end
- 1) >= 0200
4017 && ! NILP (current_buffer
->enable_multibyte_characters
)
4018 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4019 giveup_match_end
= 1;
4028 if (! giveup_match_end
)
4032 /* We win! We can handle REPLACE the optimized way. */
4034 /* Extend the start of non-matching text area to multibyte
4035 character boundary. */
4036 if (! NILP (current_buffer
->enable_multibyte_characters
))
4037 while (same_at_start
> BEGV_BYTE
4038 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4041 /* Extend the end of non-matching text area to multibyte
4042 character boundary. */
4043 if (! NILP (current_buffer
->enable_multibyte_characters
))
4044 while (same_at_end
< ZV_BYTE
4045 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4048 /* Don't try to reuse the same piece of text twice. */
4049 overlap
= (same_at_start
- BEGV_BYTE
4050 - (same_at_end
+ st
.st_size
- ZV
));
4052 same_at_end
+= overlap
;
4054 /* Arrange to read only the nonmatching middle part of the file. */
4055 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4056 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4058 del_range_byte (same_at_start
, same_at_end
, 0);
4059 /* Insert from the file at the proper position. */
4060 temp
= BYTE_TO_CHAR (same_at_start
);
4061 SET_PT_BOTH (temp
, same_at_start
);
4063 /* If display currently starts at beginning of line,
4064 keep it that way. */
4065 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4066 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4068 replace_handled
= 1;
4072 /* If requested, replace the accessible part of the buffer
4073 with the file contents. Avoid replacing text at the
4074 beginning or end of the buffer that matches the file contents;
4075 that preserves markers pointing to the unchanged parts.
4077 Here we implement this feature for the case where code conversion
4078 is needed, in a simple way that needs a lot of memory.
4079 The preceding if-statement handles the case of no conversion
4080 in a more optimized way. */
4081 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4083 int same_at_start
= BEGV_BYTE
;
4084 int same_at_end
= ZV_BYTE
;
4087 /* Make sure that the gap is large enough. */
4088 int bufsize
= 2 * st
.st_size
;
4089 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4092 /* First read the whole file, performing code conversion into
4093 CONVERSION_BUFFER. */
4095 if (lseek (fd
, XINT (beg
), 0) < 0)
4097 xfree (conversion_buffer
);
4098 report_file_error ("Setting file position",
4099 Fcons (orig_filename
, Qnil
));
4102 total
= st
.st_size
; /* Total bytes in the file. */
4103 how_much
= 0; /* Bytes read from file so far. */
4104 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4105 unprocessed
= 0; /* Bytes not processed in previous loop. */
4107 while (how_much
< total
)
4109 /* try is reserved in some compilers (Microsoft C) */
4110 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4111 unsigned char *destination
= read_buf
+ unprocessed
;
4114 /* Allow quitting out of the actual I/O. */
4117 this = emacs_read (fd
, destination
, trytry
);
4120 if (this < 0 || this + unprocessed
== 0)
4128 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4130 int require
, result
;
4132 this += unprocessed
;
4134 /* If we are using more space than estimated,
4135 make CONVERSION_BUFFER bigger. */
4136 require
= decoding_buffer_size (&coding
, this);
4137 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4139 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4140 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4143 /* Convert this batch with results in CONVERSION_BUFFER. */
4144 if (how_much
>= total
) /* This is the last block. */
4145 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4146 if (coding
.composing
!= COMPOSITION_DISABLED
)
4147 coding_allocate_composition_data (&coding
, BEGV
);
4148 result
= decode_coding (&coding
, read_buf
,
4149 conversion_buffer
+ inserted
,
4150 this, bufsize
- inserted
);
4152 /* Save for next iteration whatever we didn't convert. */
4153 unprocessed
= this - coding
.consumed
;
4154 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4155 if (!NILP (current_buffer
->enable_multibyte_characters
))
4156 this = coding
.produced
;
4158 this = str_as_unibyte (conversion_buffer
+ inserted
,
4165 /* At this point, INSERTED is how many characters (i.e. bytes)
4166 are present in CONVERSION_BUFFER.
4167 HOW_MUCH should equal TOTAL,
4168 or should be <= 0 if we couldn't read the file. */
4172 xfree (conversion_buffer
);
4175 error ("IO error reading %s: %s",
4176 SDATA (orig_filename
), emacs_strerror (errno
));
4177 else if (how_much
== -2)
4178 error ("maximum buffer size exceeded");
4181 /* Compare the beginning of the converted file
4182 with the buffer text. */
4185 while (bufpos
< inserted
&& same_at_start
< same_at_end
4186 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4187 same_at_start
++, bufpos
++;
4189 /* If the file matches the buffer completely,
4190 there's no need to replace anything. */
4192 if (bufpos
== inserted
)
4194 xfree (conversion_buffer
);
4197 /* Truncate the buffer to the size of the file. */
4198 del_range_byte (same_at_start
, same_at_end
, 0);
4203 /* Extend the start of non-matching text area to multibyte
4204 character boundary. */
4205 if (! NILP (current_buffer
->enable_multibyte_characters
))
4206 while (same_at_start
> BEGV_BYTE
4207 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4210 /* Scan this bufferful from the end, comparing with
4211 the Emacs buffer. */
4214 /* Compare with same_at_start to avoid counting some buffer text
4215 as matching both at the file's beginning and at the end. */
4216 while (bufpos
> 0 && same_at_end
> same_at_start
4217 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4218 same_at_end
--, bufpos
--;
4220 /* Extend the end of non-matching text area to multibyte
4221 character boundary. */
4222 if (! NILP (current_buffer
->enable_multibyte_characters
))
4223 while (same_at_end
< ZV_BYTE
4224 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4227 /* Don't try to reuse the same piece of text twice. */
4228 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4230 same_at_end
+= overlap
;
4232 /* If display currently starts at beginning of line,
4233 keep it that way. */
4234 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4235 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4237 /* Replace the chars that we need to replace,
4238 and update INSERTED to equal the number of bytes
4239 we are taking from the file. */
4240 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4242 if (same_at_end
!= same_at_start
)
4244 del_range_byte (same_at_start
, same_at_end
, 0);
4246 same_at_start
= GPT_BYTE
;
4250 temp
= BYTE_TO_CHAR (same_at_start
);
4252 /* Insert from the file at the proper position. */
4253 SET_PT_BOTH (temp
, same_at_start
);
4254 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
4256 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4257 coding_restore_composition (&coding
, Fcurrent_buffer ());
4258 coding_free_composition_data (&coding
);
4260 /* Set `inserted' to the number of inserted characters. */
4261 inserted
= PT
- temp
;
4263 xfree (conversion_buffer
);
4272 register Lisp_Object temp
;
4274 total
= XINT (end
) - XINT (beg
);
4276 /* Make sure point-max won't overflow after this insertion. */
4277 XSETINT (temp
, total
);
4278 if (total
!= XINT (temp
))
4279 error ("Maximum buffer size exceeded");
4282 /* For a special file, all we can do is guess. */
4283 total
= READ_BUF_SIZE
;
4285 if (NILP (visit
) && total
> 0)
4286 prepare_to_modify_buffer (PT
, PT
, NULL
);
4289 if (GAP_SIZE
< total
)
4290 make_gap (total
- GAP_SIZE
);
4292 if (XINT (beg
) != 0 || !NILP (replace
))
4294 if (lseek (fd
, XINT (beg
), 0) < 0)
4295 report_file_error ("Setting file position",
4296 Fcons (orig_filename
, Qnil
));
4299 /* In the following loop, HOW_MUCH contains the total bytes read so
4300 far for a regular file, and not changed for a special file. But,
4301 before exiting the loop, it is set to a negative value if I/O
4305 /* Total bytes inserted. */
4308 /* Here, we don't do code conversion in the loop. It is done by
4309 code_convert_region after all data are read into the buffer. */
4311 int gap_size
= GAP_SIZE
;
4313 while (how_much
< total
)
4315 /* try is reserved in some compilers (Microsoft C) */
4316 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4323 /* Maybe make more room. */
4324 if (gap_size
< trytry
)
4326 make_gap (total
- gap_size
);
4327 gap_size
= GAP_SIZE
;
4330 /* Read from the file, capturing `quit'. When an
4331 error occurs, end the loop, and arrange for a quit
4332 to be signaled after decoding the text we read. */
4333 non_regular_fd
= fd
;
4334 non_regular_inserted
= inserted
;
4335 non_regular_nbytes
= trytry
;
4336 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4337 read_non_regular_quit
);
4348 /* Allow quitting out of the actual I/O. We don't make text
4349 part of the buffer until all the reading is done, so a C-g
4350 here doesn't do any harm. */
4353 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4365 /* For a regular file, where TOTAL is the real size,
4366 count HOW_MUCH to compare with it.
4367 For a special file, where TOTAL is just a buffer size,
4368 so don't bother counting in HOW_MUCH.
4369 (INSERTED is where we count the number of characters inserted.) */
4376 /* Make the text read part of the buffer. */
4377 GAP_SIZE
-= inserted
;
4379 GPT_BYTE
+= inserted
;
4381 ZV_BYTE
+= inserted
;
4386 /* Put an anchor to ensure multi-byte form ends at gap. */
4391 /* Discard the unwind protect for closing the file. */
4395 error ("IO error reading %s: %s",
4396 SDATA (orig_filename
), emacs_strerror (errno
));
4400 if (! coding_system_decided
)
4402 /* The coding system is not yet decided. Decide it by an
4403 optimized method for handling `coding:' tag.
4405 Note that we can get here only if the buffer was empty
4406 before the insertion. */
4410 if (!NILP (Vcoding_system_for_read
))
4411 val
= Vcoding_system_for_read
;
4414 /* Since we are sure that the current buffer was empty
4415 before the insertion, we can toggle
4416 enable-multibyte-characters directly here without taking
4417 care of marker adjustment and byte combining problem. By
4418 this way, we can run Lisp program safely before decoding
4419 the inserted text. */
4420 Lisp_Object unwind_data
;
4421 int count
= SPECPDL_INDEX ();
4423 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4424 Fcons (current_buffer
->undo_list
,
4425 Fcurrent_buffer ()));
4426 current_buffer
->enable_multibyte_characters
= Qnil
;
4427 current_buffer
->undo_list
= Qt
;
4428 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4430 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4432 val
= call2 (Vset_auto_coding_function
,
4433 filename
, make_number (inserted
));
4438 /* If the coding system is not yet decided, check
4439 file-coding-system-alist. */
4440 Lisp_Object args
[6], coding_systems
;
4442 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4443 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4444 coding_systems
= Ffind_operation_coding_system (6, args
);
4445 if (CONSP (coding_systems
))
4446 val
= XCAR (coding_systems
);
4449 unbind_to (count
, Qnil
);
4450 inserted
= Z_BYTE
- BEG_BYTE
;
4453 /* The following kludgy code is to avoid some compiler bug.
4455 setup_coding_system (val, &coding);
4458 struct coding_system temp_coding
;
4459 setup_coding_system (val
, &temp_coding
);
4460 bcopy (&temp_coding
, &coding
, sizeof coding
);
4462 /* Ensure we set Vlast_coding_system_used. */
4463 set_coding_system
= 1;
4465 if (NILP (current_buffer
->enable_multibyte_characters
)
4467 /* We must suppress all character code conversion except for
4468 end-of-line conversion. */
4469 setup_raw_text_coding_system (&coding
);
4470 coding
.src_multibyte
= 0;
4471 coding
.dst_multibyte
4472 = !NILP (current_buffer
->enable_multibyte_characters
);
4476 /* Can't do this if part of the buffer might be preserved. */
4478 && (coding
.type
== coding_type_no_conversion
4479 || coding
.type
== coding_type_raw_text
))
4481 /* Visiting a file with these coding system makes the buffer
4483 current_buffer
->enable_multibyte_characters
= Qnil
;
4484 coding
.dst_multibyte
= 0;
4487 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4489 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4491 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4493 inserted
= coding
.produced_char
;
4496 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4500 /* Now INSERTED is measured in characters. */
4503 /* Use the conversion type to determine buffer-file-type
4504 (find-buffer-file-type is now used to help determine the
4506 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4507 || coding
.eol_type
== CODING_EOL_LF
)
4508 && ! CODING_REQUIRE_DECODING (&coding
))
4509 current_buffer
->buffer_file_type
= Qt
;
4511 current_buffer
->buffer_file_type
= Qnil
;
4518 if (!EQ (current_buffer
->undo_list
, Qt
))
4519 current_buffer
->undo_list
= Qnil
;
4521 stat (SDATA (filename
), &st
);
4526 current_buffer
->modtime
= st
.st_mtime
;
4527 current_buffer
->filename
= orig_filename
;
4530 SAVE_MODIFF
= MODIFF
;
4531 current_buffer
->auto_save_modified
= MODIFF
;
4532 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4533 #ifdef CLASH_DETECTION
4536 if (!NILP (current_buffer
->file_truename
))
4537 unlock_file (current_buffer
->file_truename
);
4538 unlock_file (filename
);
4540 #endif /* CLASH_DETECTION */
4542 Fsignal (Qfile_error
,
4543 Fcons (build_string ("not a regular file"),
4544 Fcons (orig_filename
, Qnil
)));
4547 if (set_coding_system
)
4548 Vlast_coding_system_used
= coding
.symbol
;
4550 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4552 insval
= call1 (Qafter_insert_file_set_coding
, make_number (inserted
));
4553 if (! NILP (insval
))
4555 CHECK_NUMBER (insval
);
4556 inserted
= XFASTINT (insval
);
4560 /* Decode file format */
4563 int empty_undo_list_p
= 0;
4565 /* If we're anyway going to discard undo information, don't
4566 record it in the first place. The buffer's undo list at this
4567 point is either nil or t when visiting a file. */
4570 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4571 current_buffer
->undo_list
= Qt
;
4574 insval
= call3 (Qformat_decode
,
4575 Qnil
, make_number (inserted
), visit
);
4576 CHECK_NUMBER (insval
);
4577 inserted
= XFASTINT (insval
);
4580 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4583 /* Call after-change hooks for the inserted text, aside from the case
4584 of normal visiting (not with REPLACE), which is done in a new buffer
4585 "before" the buffer is changed. */
4586 if (inserted
> 0 && total
> 0
4587 && (NILP (visit
) || !NILP (replace
)))
4589 signal_after_change (PT
, 0, inserted
);
4590 update_compositions (PT
, PT
, CHECK_BORDER
);
4593 p
= Vafter_insert_file_functions
;
4596 insval
= call1 (XCAR (p
), make_number (inserted
));
4599 CHECK_NUMBER (insval
);
4600 inserted
= XFASTINT (insval
);
4607 && current_buffer
->modtime
== -1)
4609 /* If visiting nonexistent file, return nil. */
4610 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4614 Fsignal (Qquit
, Qnil
);
4616 /* ??? Retval needs to be dealt with in all cases consistently. */
4618 val
= Fcons (orig_filename
,
4619 Fcons (make_number (inserted
),
4622 RETURN_UNGCPRO (unbind_to (count
, val
));
4625 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4626 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4627 Lisp_Object
, Lisp_Object
));
4629 /* If build_annotations switched buffers, switch back to BUF.
4630 Kill the temporary buffer that was selected in the meantime.
4632 Since this kill only the last temporary buffer, some buffers remain
4633 not killed if build_annotations switched buffers more than once.
4637 build_annotations_unwind (buf
)
4642 if (XBUFFER (buf
) == current_buffer
)
4644 tembuf
= Fcurrent_buffer ();
4646 Fkill_buffer (tembuf
);
4650 /* Decide the coding-system to encode the data with. */
4653 choose_write_coding_system (start
, end
, filename
,
4654 append
, visit
, lockname
, coding
)
4655 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4656 struct coding_system
*coding
;
4662 else if (!NILP (Vcoding_system_for_write
))
4664 val
= Vcoding_system_for_write
;
4665 if (coding_system_require_warning
4666 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4667 /* Confirm that VAL can surely encode the current region. */
4668 val
= call5 (Vselect_safe_coding_system_function
,
4669 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4674 /* If the variable `buffer-file-coding-system' is set locally,
4675 it means that the file was read with some kind of code
4676 conversion or the variable is explicitly set by users. We
4677 had better write it out with the same coding system even if
4678 `enable-multibyte-characters' is nil.
4680 If it is not set locally, we anyway have to convert EOL
4681 format if the default value of `buffer-file-coding-system'
4682 tells that it is not Unix-like (LF only) format. */
4683 int using_default_coding
= 0;
4684 int force_raw_text
= 0;
4686 val
= current_buffer
->buffer_file_coding_system
;
4688 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4691 if (NILP (current_buffer
->enable_multibyte_characters
))
4697 /* Check file-coding-system-alist. */
4698 Lisp_Object args
[7], coding_systems
;
4700 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4701 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4703 coding_systems
= Ffind_operation_coding_system (7, args
);
4704 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4705 val
= XCDR (coding_systems
);
4709 && !NILP (current_buffer
->buffer_file_coding_system
))
4711 /* If we still have not decided a coding system, use the
4712 default value of buffer-file-coding-system. */
4713 val
= current_buffer
->buffer_file_coding_system
;
4714 using_default_coding
= 1;
4718 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4719 /* Confirm that VAL can surely encode the current region. */
4720 val
= call5 (Vselect_safe_coding_system_function
,
4721 start
, end
, val
, Qnil
, filename
);
4723 setup_coding_system (Fcheck_coding_system (val
), coding
);
4724 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4725 && !using_default_coding
)
4727 if (! EQ (default_buffer_file_coding
.symbol
,
4728 buffer_defaults
.buffer_file_coding_system
))
4729 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4730 &default_buffer_file_coding
);
4731 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4733 Lisp_Object subsidiaries
;
4735 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4736 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4737 if (VECTORP (subsidiaries
)
4738 && XVECTOR (subsidiaries
)->size
== 3)
4740 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4745 setup_raw_text_coding_system (coding
);
4746 goto done_setup_coding
;
4749 setup_coding_system (Fcheck_coding_system (val
), coding
);
4752 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4753 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4756 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4757 "r\nFWrite region to file: \ni\ni\ni\np",
4758 doc
: /* Write current region into specified file.
4759 When called from a program, requires three arguments:
4760 START, END and FILENAME. START and END are normally buffer positions
4761 specifying the part of the buffer to write.
4762 If START is nil, that means to use the entire buffer contents.
4763 If START is a string, then output that string to the file
4764 instead of any buffer contents; END is ignored.
4766 Optional fourth argument APPEND if non-nil means
4767 append to existing file contents (if any). If it is an integer,
4768 seek to that offset in the file before writing.
4769 Optional fifth argument VISIT if t means
4770 set the last-save-file-modtime of buffer to this file's modtime
4771 and mark buffer not modified.
4772 If VISIT is a string, it is a second file name;
4773 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4774 VISIT is also the file name to lock and unlock for clash detection.
4775 If VISIT is neither t nor nil nor a string,
4776 that means do not display the \"Wrote file\" message.
4777 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4778 use for locking and unlocking, overriding FILENAME and VISIT.
4779 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4780 for an existing file with the same name. If MUSTBENEW is `excl',
4781 that means to get an error if the file already exists; never overwrite.
4782 If MUSTBENEW is neither nil nor `excl', that means ask for
4783 confirmation before overwriting, but do go ahead and overwrite the file
4784 if the user confirms.
4786 This does code conversion according to the value of
4787 `coding-system-for-write', `buffer-file-coding-system', or
4788 `file-coding-system-alist', and sets the variable
4789 `last-coding-system-used' to the coding system actually used. */)
4790 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4791 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4796 const unsigned char *fn
;
4799 int count
= SPECPDL_INDEX ();
4802 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4804 Lisp_Object handler
;
4805 Lisp_Object visit_file
;
4806 Lisp_Object annotations
;
4807 Lisp_Object encoded_filename
;
4808 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4809 int quietly
= !NILP (visit
);
4810 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4811 struct buffer
*given_buffer
;
4813 int buffer_file_type
= O_BINARY
;
4815 struct coding_system coding
;
4817 if (current_buffer
->base_buffer
&& visiting
)
4818 error ("Cannot do file visiting in an indirect buffer");
4820 if (!NILP (start
) && !STRINGP (start
))
4821 validate_region (&start
, &end
);
4823 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4825 filename
= Fexpand_file_name (filename
, Qnil
);
4827 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4828 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4830 if (STRINGP (visit
))
4831 visit_file
= Fexpand_file_name (visit
, Qnil
);
4833 visit_file
= filename
;
4835 if (NILP (lockname
))
4836 lockname
= visit_file
;
4840 /* If the file name has special constructs in it,
4841 call the corresponding file handler. */
4842 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4843 /* If FILENAME has no handler, see if VISIT has one. */
4844 if (NILP (handler
) && STRINGP (visit
))
4845 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4847 if (!NILP (handler
))
4850 val
= call6 (handler
, Qwrite_region
, start
, end
,
4851 filename
, append
, visit
);
4855 SAVE_MODIFF
= MODIFF
;
4856 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4857 current_buffer
->filename
= visit_file
;
4863 /* Special kludge to simplify auto-saving. */
4866 XSETFASTINT (start
, BEG
);
4867 XSETFASTINT (end
, Z
);
4870 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4871 count1
= SPECPDL_INDEX ();
4873 given_buffer
= current_buffer
;
4875 if (!STRINGP (start
))
4877 annotations
= build_annotations (start
, end
);
4879 if (current_buffer
!= given_buffer
)
4881 XSETFASTINT (start
, BEGV
);
4882 XSETFASTINT (end
, ZV
);
4888 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4890 /* Decide the coding-system to encode the data with.
4891 We used to make this choice before calling build_annotations, but that
4892 leads to problems when a write-annotate-function takes care of
4893 unsavable chars (as was the case with X-Symbol). */
4894 choose_write_coding_system (start
, end
, filename
,
4895 append
, visit
, lockname
, &coding
);
4896 Vlast_coding_system_used
= coding
.symbol
;
4898 given_buffer
= current_buffer
;
4899 if (! STRINGP (start
))
4901 annotations
= build_annotations_2 (start
, end
,
4902 coding
.pre_write_conversion
, annotations
);
4903 if (current_buffer
!= given_buffer
)
4905 XSETFASTINT (start
, BEGV
);
4906 XSETFASTINT (end
, ZV
);
4910 #ifdef CLASH_DETECTION
4913 #if 0 /* This causes trouble for GNUS. */
4914 /* If we've locked this file for some other buffer,
4915 query before proceeding. */
4916 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4917 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4920 lock_file (lockname
);
4922 #endif /* CLASH_DETECTION */
4924 encoded_filename
= ENCODE_FILE (filename
);
4926 fn
= SDATA (encoded_filename
);
4930 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4931 #else /* not DOS_NT */
4932 desc
= emacs_open (fn
, O_WRONLY
, 0);
4933 #endif /* not DOS_NT */
4935 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4937 if (auto_saving
) /* Overwrite any previous version of autosave file */
4939 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4940 desc
= emacs_open (fn
, O_RDWR
, 0);
4942 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4943 ? SDATA (current_buffer
->filename
) : 0,
4946 else /* Write to temporary name and rename if no errors */
4948 Lisp_Object temp_name
;
4949 temp_name
= Ffile_name_directory (filename
);
4951 if (!NILP (temp_name
))
4953 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4954 build_string ("$$SAVE$$")));
4955 fname
= SDATA (filename
);
4956 fn
= SDATA (temp_name
);
4957 desc
= creat_copy_attrs (fname
, fn
);
4960 /* If we can't open the temporary file, try creating a new
4961 version of the original file. VMS "creat" creates a
4962 new version rather than truncating an existing file. */
4965 desc
= creat (fn
, 0666);
4966 #if 0 /* This can clobber an existing file and fail to replace it,
4967 if the user runs out of space. */
4970 /* We can't make a new version;
4971 try to truncate and rewrite existing version if any. */
4973 desc
= emacs_open (fn
, O_RDWR
, 0);
4979 desc
= creat (fn
, 0666);
4983 desc
= emacs_open (fn
,
4984 O_WRONLY
| O_CREAT
| buffer_file_type
4985 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4986 S_IREAD
| S_IWRITE
);
4987 #else /* not DOS_NT */
4988 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4989 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4990 auto_saving
? auto_save_mode_bits
: 0666);
4991 #endif /* not DOS_NT */
4992 #endif /* not VMS */
4996 #ifdef CLASH_DETECTION
4998 if (!auto_saving
) unlock_file (lockname
);
5000 #endif /* CLASH_DETECTION */
5002 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5005 record_unwind_protect (close_file_unwind
, make_number (desc
));
5007 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5011 if (NUMBERP (append
))
5012 ret
= lseek (desc
, XINT (append
), 1);
5014 ret
= lseek (desc
, 0, 2);
5017 #ifdef CLASH_DETECTION
5018 if (!auto_saving
) unlock_file (lockname
);
5019 #endif /* CLASH_DETECTION */
5021 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5029 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5030 * if we do writes that don't end with a carriage return. Furthermore
5031 * it cannot handle writes of more then 16K. The modified
5032 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5033 * this EXCEPT for the last record (iff it doesn't end with a carriage
5034 * return). This implies that if your buffer doesn't end with a carriage
5035 * return, you get one free... tough. However it also means that if
5036 * we make two calls to sys_write (a la the following code) you can
5037 * get one at the gap as well. The easiest way to fix this (honest)
5038 * is to move the gap to the next newline (or the end of the buffer).
5043 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5044 move_gap (find_next_newline (GPT
, 1));
5046 /* Whether VMS or not, we must move the gap to the next of newline
5047 when we must put designation sequences at beginning of line. */
5048 if (INTEGERP (start
)
5049 && coding
.type
== coding_type_iso2022
5050 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5051 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5053 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5054 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5055 move_gap_both (PT
, PT_BYTE
);
5056 SET_PT_BOTH (opoint
, opoint_byte
);
5063 if (STRINGP (start
))
5065 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5066 &annotations
, &coding
);
5069 else if (XINT (start
) != XINT (end
))
5071 tem
= CHAR_TO_BYTE (XINT (start
));
5073 if (XINT (start
) < GPT
)
5075 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5076 min (GPT
, XINT (end
)) - XINT (start
),
5077 &annotations
, &coding
);
5081 if (XINT (end
) > GPT
&& !failure
)
5083 tem
= max (XINT (start
), GPT
);
5084 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5085 &annotations
, &coding
);
5091 /* If file was empty, still need to write the annotations */
5092 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5093 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5097 if (CODING_REQUIRE_FLUSHING (&coding
)
5098 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5101 /* We have to flush out a data. */
5102 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5103 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5110 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5111 Disk full in NFS may be reported here. */
5112 /* mib says that closing the file will try to write as fast as NFS can do
5113 it, and that means the fsync here is not crucial for autosave files. */
5114 if (!auto_saving
&& fsync (desc
) < 0)
5116 /* If fsync fails with EINTR, don't treat that as serious. */
5118 failure
= 1, save_errno
= errno
;
5122 /* Spurious "file has changed on disk" warnings have been
5123 observed on Suns as well.
5124 It seems that `close' can change the modtime, under nfs.
5126 (This has supposedly been fixed in Sunos 4,
5127 but who knows about all the other machines with NFS?) */
5130 /* On VMS and APOLLO, must do the stat after the close
5131 since closing changes the modtime. */
5134 /* Recall that #if defined does not work on VMS. */
5141 /* NFS can report a write failure now. */
5142 if (emacs_close (desc
) < 0)
5143 failure
= 1, save_errno
= errno
;
5146 /* If we wrote to a temporary name and had no errors, rename to real name. */
5150 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5158 /* Discard the unwind protect for close_file_unwind. */
5159 specpdl_ptr
= specpdl
+ count1
;
5160 /* Restore the original current buffer. */
5161 visit_file
= unbind_to (count
, visit_file
);
5163 #ifdef CLASH_DETECTION
5165 unlock_file (lockname
);
5166 #endif /* CLASH_DETECTION */
5168 /* Do this before reporting IO error
5169 to avoid a "file has changed on disk" warning on
5170 next attempt to save. */
5172 current_buffer
->modtime
= st
.st_mtime
;
5175 error ("IO error writing %s: %s", SDATA (filename
),
5176 emacs_strerror (save_errno
));
5180 SAVE_MODIFF
= MODIFF
;
5181 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5182 current_buffer
->filename
= visit_file
;
5183 update_mode_lines
++;
5189 message_with_string ("Wrote %s", visit_file
, 1);
5194 Lisp_Object
merge ();
5196 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5197 doc
: /* Return t if (car A) is numerically less than (car B). */)
5201 return Flss (Fcar (a
), Fcar (b
));
5204 /* Build the complete list of annotations appropriate for writing out
5205 the text between START and END, by calling all the functions in
5206 write-region-annotate-functions and merging the lists they return.
5207 If one of these functions switches to a different buffer, we assume
5208 that buffer contains altered text. Therefore, the caller must
5209 make sure to restore the current buffer in all cases,
5210 as save-excursion would do. */
5213 build_annotations (start
, end
)
5214 Lisp_Object start
, end
;
5216 Lisp_Object annotations
;
5218 struct gcpro gcpro1
, gcpro2
;
5219 Lisp_Object original_buffer
;
5222 XSETBUFFER (original_buffer
, current_buffer
);
5225 p
= Vwrite_region_annotate_functions
;
5226 GCPRO2 (annotations
, p
);
5229 struct buffer
*given_buffer
= current_buffer
;
5230 Vwrite_region_annotations_so_far
= annotations
;
5231 res
= call2 (XCAR (p
), start
, end
);
5232 /* If the function makes a different buffer current,
5233 assume that means this buffer contains altered text to be output.
5234 Reset START and END from the buffer bounds
5235 and discard all previous annotations because they should have
5236 been dealt with by this function. */
5237 if (current_buffer
!= given_buffer
)
5239 XSETFASTINT (start
, BEGV
);
5240 XSETFASTINT (end
, ZV
);
5243 Flength (res
); /* Check basic validity of return value */
5244 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5248 /* Now do the same for annotation functions implied by the file-format */
5249 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5250 p
= Vauto_save_file_format
;
5252 p
= current_buffer
->file_format
;
5253 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5255 struct buffer
*given_buffer
= current_buffer
;
5257 Vwrite_region_annotations_so_far
= annotations
;
5259 /* Value is either a list of annotations or nil if the function
5260 has written annotations to a temporary buffer, which is now
5262 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5263 original_buffer
, make_number (i
));
5264 if (current_buffer
!= given_buffer
)
5266 XSETFASTINT (start
, BEGV
);
5267 XSETFASTINT (end
, ZV
);
5272 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5280 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5281 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5283 struct gcpro gcpro1
;
5286 GCPRO1 (annotations
);
5287 /* At last, do the same for the function PRE_WRITE_CONVERSION
5288 implied by the current coding-system. */
5289 if (!NILP (pre_write_conversion
))
5291 struct buffer
*given_buffer
= current_buffer
;
5292 Vwrite_region_annotations_so_far
= annotations
;
5293 res
= call2 (pre_write_conversion
, start
, end
);
5295 annotations
= (current_buffer
!= given_buffer
5297 : merge (annotations
, res
, Qcar_less_than_car
));
5304 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5305 If STRING is nil, POS is the character position in the current buffer.
5306 Intersperse with them the annotations from *ANNOT
5307 which fall within the range of POS to POS + NCHARS,
5308 each at its appropriate position.
5310 We modify *ANNOT by discarding elements as we use them up.
5312 The return value is negative in case of system call failure. */
5315 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5318 register int nchars
;
5321 struct coding_system
*coding
;
5325 int lastpos
= pos
+ nchars
;
5327 while (NILP (*annot
) || CONSP (*annot
))
5329 tem
= Fcar_safe (Fcar (*annot
));
5332 nextpos
= XFASTINT (tem
);
5334 /* If there are no more annotations in this range,
5335 output the rest of the range all at once. */
5336 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5337 return e_write (desc
, string
, pos
, lastpos
, coding
);
5339 /* Output buffer text up to the next annotation's position. */
5342 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5346 /* Output the annotation. */
5347 tem
= Fcdr (Fcar (*annot
));
5350 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5353 *annot
= Fcdr (*annot
);
5358 #ifndef WRITE_BUF_SIZE
5359 #define WRITE_BUF_SIZE (16 * 1024)
5362 /* Write text in the range START and END into descriptor DESC,
5363 encoding them with coding system CODING. If STRING is nil, START
5364 and END are character positions of the current buffer, else they
5365 are indexes to the string STRING. */
5368 e_write (desc
, string
, start
, end
, coding
)
5372 struct coding_system
*coding
;
5374 register char *addr
;
5375 register int nbytes
;
5376 char buf
[WRITE_BUF_SIZE
];
5380 coding
->composing
= COMPOSITION_DISABLED
;
5381 if (coding
->composing
!= COMPOSITION_DISABLED
)
5382 coding_save_composition (coding
, start
, end
, string
);
5384 if (STRINGP (string
))
5386 addr
= SDATA (string
);
5387 nbytes
= SBYTES (string
);
5388 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5390 else if (start
< end
)
5392 /* It is assured that the gap is not in the range START and END-1. */
5393 addr
= CHAR_POS_ADDR (start
);
5394 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5395 coding
->src_multibyte
5396 = !NILP (current_buffer
->enable_multibyte_characters
);
5402 coding
->src_multibyte
= 1;
5405 /* We used to have a code for handling selective display here. But,
5406 now it is handled within encode_coding. */
5411 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5412 if (coding
->produced
> 0)
5414 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5415 if (coding
->produced
)
5421 nbytes
-= coding
->consumed
;
5422 addr
+= coding
->consumed
;
5423 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5426 /* The source text ends by an incomplete multibyte form.
5427 There's no way other than write it out as is. */
5428 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5437 start
+= coding
->consumed_char
;
5438 if (coding
->cmp_data
)
5439 coding_adjust_composition_offset (coding
, start
);
5442 if (coding
->cmp_data
)
5443 coding_free_composition_data (coding
);
5448 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5449 Sverify_visited_file_modtime
, 1, 1, 0,
5450 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5451 This means that the file has not been changed since it was visited or saved. */)
5457 Lisp_Object handler
;
5458 Lisp_Object filename
;
5463 if (!STRINGP (b
->filename
)) return Qt
;
5464 if (b
->modtime
== 0) return Qt
;
5466 /* If the file name has special constructs in it,
5467 call the corresponding file handler. */
5468 handler
= Ffind_file_name_handler (b
->filename
,
5469 Qverify_visited_file_modtime
);
5470 if (!NILP (handler
))
5471 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5473 filename
= ENCODE_FILE (b
->filename
);
5475 if (stat (SDATA (filename
), &st
) < 0)
5477 /* If the file doesn't exist now and didn't exist before,
5478 we say that it isn't modified, provided the error is a tame one. */
5479 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5484 if (st
.st_mtime
== b
->modtime
5485 /* If both are positive, accept them if they are off by one second. */
5486 || (st
.st_mtime
> 0 && b
->modtime
> 0
5487 && (st
.st_mtime
== b
->modtime
+ 1
5488 || st
.st_mtime
== b
->modtime
- 1)))
5493 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5494 Sclear_visited_file_modtime
, 0, 0, 0,
5495 doc
: /* Clear out records of last mod time of visited file.
5496 Next attempt to save will certainly not complain of a discrepancy. */)
5499 current_buffer
->modtime
= 0;
5503 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5504 Svisited_file_modtime
, 0, 0, 0,
5505 doc
: /* Return the current buffer's recorded visited file modification time.
5506 The value is a list of the form (HIGH . LOW), like the time values
5507 that `file-attributes' returns. */)
5510 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5513 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5514 Sset_visited_file_modtime
, 0, 1, 0,
5515 doc
: /* Update buffer's recorded modification time from the visited file's time.
5516 Useful if the buffer was not read from the file normally
5517 or if the file itself has been changed for some known benign reason.
5518 An argument specifies the modification time value to use
5519 \(instead of that of the visited file), in the form of a list
5520 \(HIGH . LOW) or (HIGH LOW). */)
5522 Lisp_Object time_list
;
5524 if (!NILP (time_list
))
5525 current_buffer
->modtime
= cons_to_long (time_list
);
5528 register Lisp_Object filename
;
5530 Lisp_Object handler
;
5532 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5534 /* If the file name has special constructs in it,
5535 call the corresponding file handler. */
5536 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5537 if (!NILP (handler
))
5538 /* The handler can find the file name the same way we did. */
5539 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5541 filename
= ENCODE_FILE (filename
);
5543 if (stat (SDATA (filename
), &st
) >= 0)
5544 current_buffer
->modtime
= st
.st_mtime
;
5551 auto_save_error (error
)
5554 Lisp_Object args
[3], msg
;
5556 struct gcpro gcpro1
;
5560 args
[0] = build_string ("Auto-saving %s: %s");
5561 args
[1] = current_buffer
->name
;
5562 args
[2] = Ferror_message_string (error
);
5563 msg
= Fformat (3, args
);
5565 nbytes
= SBYTES (msg
);
5567 for (i
= 0; i
< 3; ++i
)
5570 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5572 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5573 Fsleep_for (make_number (1), Qnil
);
5585 /* Get visited file's mode to become the auto save file's mode. */
5586 if (! NILP (current_buffer
->filename
)
5587 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5588 /* But make sure we can overwrite it later! */
5589 auto_save_mode_bits
= st
.st_mode
| 0600;
5591 auto_save_mode_bits
= 0666;
5594 Fwrite_region (Qnil
, Qnil
,
5595 current_buffer
->auto_save_file_name
,
5596 Qnil
, Qlambda
, Qnil
, Qnil
);
5600 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5605 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5606 | XFASTINT (XCDR (stream
))));
5611 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5614 minibuffer_auto_raise
= XINT (value
);
5619 do_auto_save_make_dir (dir
)
5622 return call2 (Qmake_directory
, dir
, Qt
);
5626 do_auto_save_eh (ignore
)
5632 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5633 doc
: /* Auto-save all buffers that need it.
5634 This is all buffers that have auto-saving enabled
5635 and are changed since last auto-saved.
5636 Auto-saving writes the buffer into a file
5637 so that your editing is not lost if the system crashes.
5638 This file is not the file you visited; that changes only when you save.
5639 Normally we run the normal hook `auto-save-hook' before saving.
5641 A non-nil NO-MESSAGE argument means do not print any message if successful.
5642 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5643 (no_message
, current_only
)
5644 Lisp_Object no_message
, current_only
;
5646 struct buffer
*old
= current_buffer
, *b
;
5647 Lisp_Object tail
, buf
;
5649 int do_handled_files
;
5652 Lisp_Object lispstream
;
5653 int count
= SPECPDL_INDEX ();
5654 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5655 int old_message_p
= 0;
5656 struct gcpro gcpro1
, gcpro2
;
5658 if (max_specpdl_size
< specpdl_size
+ 40)
5659 max_specpdl_size
= specpdl_size
+ 40;
5664 if (NILP (no_message
))
5666 old_message_p
= push_message ();
5667 record_unwind_protect (pop_message_unwind
, Qnil
);
5670 /* Ordinarily don't quit within this function,
5671 but don't make it impossible to quit (in case we get hung in I/O). */
5675 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5676 point to non-strings reached from Vbuffer_alist. */
5678 if (!NILP (Vrun_hooks
))
5679 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5681 if (STRINGP (Vauto_save_list_file_name
))
5683 Lisp_Object listfile
;
5685 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5687 /* Don't try to create the directory when shutting down Emacs,
5688 because creating the directory might signal an error, and
5689 that would leave Emacs in a strange state. */
5690 if (!NILP (Vrun_hooks
))
5694 GCPRO2 (dir
, listfile
);
5695 dir
= Ffile_name_directory (listfile
);
5696 if (NILP (Ffile_directory_p (dir
)))
5697 internal_condition_case_1 (do_auto_save_make_dir
,
5698 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5703 stream
= fopen (SDATA (listfile
), "w");
5706 /* Arrange to close that file whether or not we get an error.
5707 Also reset auto_saving to 0. */
5708 lispstream
= Fcons (Qnil
, Qnil
);
5709 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5710 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5721 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5722 record_unwind_protect (do_auto_save_unwind_1
,
5723 make_number (minibuffer_auto_raise
));
5724 minibuffer_auto_raise
= 0;
5727 /* First, save all files which don't have handlers. If Emacs is
5728 crashing, the handlers may tweak what is causing Emacs to crash
5729 in the first place, and it would be a shame if Emacs failed to
5730 autosave perfectly ordinary files because it couldn't handle some
5732 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5733 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5735 buf
= XCDR (XCAR (tail
));
5738 /* Record all the buffers that have auto save mode
5739 in the special file that lists them. For each of these buffers,
5740 Record visited name (if any) and auto save name. */
5741 if (STRINGP (b
->auto_save_file_name
)
5742 && stream
!= NULL
&& do_handled_files
== 0)
5744 if (!NILP (b
->filename
))
5746 fwrite (SDATA (b
->filename
), 1,
5747 SBYTES (b
->filename
), stream
);
5749 putc ('\n', stream
);
5750 fwrite (SDATA (b
->auto_save_file_name
), 1,
5751 SBYTES (b
->auto_save_file_name
), stream
);
5752 putc ('\n', stream
);
5755 if (!NILP (current_only
)
5756 && b
!= current_buffer
)
5759 /* Don't auto-save indirect buffers.
5760 The base buffer takes care of it. */
5764 /* Check for auto save enabled
5765 and file changed since last auto save
5766 and file changed since last real save. */
5767 if (STRINGP (b
->auto_save_file_name
)
5768 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5769 && b
->auto_save_modified
< BUF_MODIFF (b
)
5770 /* -1 means we've turned off autosaving for a while--see below. */
5771 && XINT (b
->save_length
) >= 0
5772 && (do_handled_files
5773 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5776 EMACS_TIME before_time
, after_time
;
5778 EMACS_GET_TIME (before_time
);
5780 /* If we had a failure, don't try again for 20 minutes. */
5781 if (b
->auto_save_failure_time
>= 0
5782 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5785 if ((XFASTINT (b
->save_length
) * 10
5786 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5787 /* A short file is likely to change a large fraction;
5788 spare the user annoying messages. */
5789 && XFASTINT (b
->save_length
) > 5000
5790 /* These messages are frequent and annoying for `*mail*'. */
5791 && !EQ (b
->filename
, Qnil
)
5792 && NILP (no_message
))
5794 /* It has shrunk too much; turn off auto-saving here. */
5795 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5796 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5798 minibuffer_auto_raise
= 0;
5799 /* Turn off auto-saving until there's a real save,
5800 and prevent any more warnings. */
5801 XSETINT (b
->save_length
, -1);
5802 Fsleep_for (make_number (1), Qnil
);
5805 set_buffer_internal (b
);
5806 if (!auto_saved
&& NILP (no_message
))
5807 message1 ("Auto-saving...");
5808 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5810 b
->auto_save_modified
= BUF_MODIFF (b
);
5811 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5812 set_buffer_internal (old
);
5814 EMACS_GET_TIME (after_time
);
5816 /* If auto-save took more than 60 seconds,
5817 assume it was an NFS failure that got a timeout. */
5818 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5819 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5823 /* Prevent another auto save till enough input events come in. */
5824 record_auto_save ();
5826 if (auto_saved
&& NILP (no_message
))
5830 /* If we are going to restore an old message,
5831 give time to read ours. */
5832 sit_for (1, 0, 0, 0, 0);
5836 /* If we displayed a message and then restored a state
5837 with no message, leave a "done" message on the screen. */
5838 message1 ("Auto-saving...done");
5843 /* This restores the message-stack status. */
5844 unbind_to (count
, Qnil
);
5848 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5849 Sset_buffer_auto_saved
, 0, 0, 0,
5850 doc
: /* Mark current buffer as auto-saved with its current text.
5851 No auto-save file will be written until the buffer changes again. */)
5854 current_buffer
->auto_save_modified
= MODIFF
;
5855 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5856 current_buffer
->auto_save_failure_time
= -1;
5860 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5861 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5862 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5865 current_buffer
->auto_save_failure_time
= -1;
5869 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5871 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
5874 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5877 /* Reading and completing file names */
5878 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5880 /* In the string VAL, change each $ to $$ and return the result. */
5883 double_dollars (val
)
5886 register const unsigned char *old
;
5887 register unsigned char *new;
5891 osize
= SBYTES (val
);
5893 /* Count the number of $ characters. */
5894 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
5895 if (*old
++ == '$') count
++;
5899 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
5902 for (n
= osize
; n
> 0; n
--)
5916 read_file_name_cleanup (arg
)
5919 return (current_buffer
->directory
= arg
);
5922 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5924 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
5925 (string
, dir
, action
)
5926 Lisp_Object string
, dir
, action
;
5927 /* action is nil for complete, t for return list of completions,
5928 lambda for verify final value */
5930 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5932 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5934 CHECK_STRING (string
);
5941 /* No need to protect ACTION--we only compare it with t and nil. */
5942 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5944 if (SCHARS (string
) == 0)
5946 if (EQ (action
, Qlambda
))
5954 orig_string
= string
;
5955 string
= Fsubstitute_in_file_name (string
);
5956 changed
= NILP (Fstring_equal (string
, orig_string
));
5957 name
= Ffile_name_nondirectory (string
);
5958 val
= Ffile_name_directory (string
);
5960 realdir
= Fexpand_file_name (val
, realdir
);
5965 specdir
= Ffile_name_directory (string
);
5966 val
= Ffile_name_completion (name
, realdir
);
5971 return double_dollars (string
);
5975 if (!NILP (specdir
))
5976 val
= concat2 (specdir
, val
);
5978 return double_dollars (val
);
5981 #endif /* not VMS */
5985 if (EQ (action
, Qt
))
5987 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
5991 if (NILP (Vread_file_name_predicate
)
5992 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
5996 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
5998 /* Brute-force speed up for directory checking:
5999 Discard strings which don't end in a slash. */
6000 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6002 Lisp_Object tem
= XCAR (all
);
6004 if (STRINGP (tem
) &&
6005 (len
= SCHARS (tem
), len
> 0) &&
6006 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6007 comp
= Fcons (tem
, comp
);
6013 /* Must do it the hard (and slow) way. */
6014 GCPRO3 (all
, comp
, specdir
);
6015 count
= SPECPDL_INDEX ();
6016 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6017 current_buffer
->directory
= realdir
;
6018 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6019 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6020 comp
= Fcons (XCAR (all
), comp
);
6021 unbind_to (count
, Qnil
);
6024 return Fnreverse (comp
);
6027 /* Only other case actually used is ACTION = lambda */
6029 /* Supposedly this helps commands such as `cd' that read directory names,
6030 but can someone explain how it helps them? -- RMS */
6031 if (SCHARS (name
) == 0)
6034 if (!NILP (Vread_file_name_predicate
))
6035 return call1 (Vread_file_name_predicate
, string
);
6036 return Ffile_exists_p (string
);
6039 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6040 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6041 Value is not expanded---you must call `expand-file-name' yourself.
6042 Default name to DEFAULT-FILENAME if user enters a null string.
6043 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6044 except that if INITIAL is specified, that combined with DIR is used.)
6045 Fourth arg MUSTMATCH non-nil means require existing file's name.
6046 Non-nil and non-t means also require confirmation after completion.
6047 Fifth arg INITIAL specifies text to start with.
6048 If optional sixth arg PREDICATE is non-nil, possible completions and the
6049 resulting file name must satisfy (funcall PREDICATE NAME).
6050 DIR defaults to current buffer's directory default.
6052 If this command was invoked with the mouse, use a file dialog box if
6053 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6054 provides a file dialog box. */)
6055 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6056 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6058 Lisp_Object val
, insdef
, tem
;
6059 struct gcpro gcpro1
, gcpro2
;
6060 register char *homedir
;
6061 Lisp_Object decoded_homedir
;
6062 int replace_in_history
= 0;
6063 int add_to_history
= 0;
6067 dir
= current_buffer
->directory
;
6068 if (NILP (default_filename
))
6069 default_filename
= !NILP (initial
)
6070 ? Fexpand_file_name (initial
, dir
)
6071 : current_buffer
->filename
;
6073 /* If dir starts with user's homedir, change that to ~. */
6074 homedir
= (char *) egetenv ("HOME");
6076 /* homedir can be NULL in temacs, since Vprocess_environment is not
6077 yet set up. We shouldn't crash in that case. */
6080 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6081 CORRECT_DIR_SEPS (homedir
);
6086 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6089 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6090 SBYTES (decoded_homedir
))
6091 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6093 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6094 dir
= concat2 (build_string ("~"), dir
);
6096 /* Likewise for default_filename. */
6098 && STRINGP (default_filename
)
6099 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6100 SBYTES (decoded_homedir
))
6101 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6104 = Fsubstring (default_filename
,
6105 make_number (SCHARS (decoded_homedir
)), Qnil
);
6106 default_filename
= concat2 (build_string ("~"), default_filename
);
6108 if (!NILP (default_filename
))
6110 CHECK_STRING (default_filename
);
6111 default_filename
= double_dollars (default_filename
);
6114 if (insert_default_directory
&& STRINGP (dir
))
6117 if (!NILP (initial
))
6119 Lisp_Object args
[2], pos
;
6123 insdef
= Fconcat (2, args
);
6124 pos
= make_number (SCHARS (double_dollars (dir
)));
6125 insdef
= Fcons (double_dollars (insdef
), pos
);
6128 insdef
= double_dollars (insdef
);
6130 else if (STRINGP (initial
))
6131 insdef
= Fcons (double_dollars (initial
), make_number (0));
6135 if (!NILP (Vread_file_name_function
))
6137 Lisp_Object args
[7];
6139 GCPRO2 (insdef
, default_filename
);
6140 args
[0] = Vread_file_name_function
;
6143 args
[3] = default_filename
;
6144 args
[4] = mustmatch
;
6146 args
[6] = predicate
;
6147 RETURN_UNGCPRO (Ffuncall (7, args
));
6150 count
= SPECPDL_INDEX ();
6152 specbind (intern ("completion-ignore-case"), Qt
);
6155 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6156 specbind (intern ("read-file-name-predicate"),
6157 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6159 GCPRO2 (insdef
, default_filename
);
6161 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
6162 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6166 /* If DIR contains a file name, split it. */
6168 file
= Ffile_name_nondirectory (dir
);
6169 if (SCHARS (file
) && NILP (default_filename
))
6171 default_filename
= file
;
6172 dir
= Ffile_name_directory (dir
);
6174 if (!NILP(default_filename
))
6175 default_filename
= Fexpand_file_name (default_filename
, dir
);
6176 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6181 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6182 dir
, mustmatch
, insdef
,
6183 Qfile_name_history
, default_filename
, Qnil
);
6185 tem
= Fsymbol_value (Qfile_name_history
);
6186 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6187 replace_in_history
= 1;
6189 /* If Fcompleting_read returned the inserted default string itself
6190 (rather than a new string with the same contents),
6191 it has to mean that the user typed RET with the minibuffer empty.
6192 In that case, we really want to return ""
6193 so that commands such as set-visited-file-name can distinguish. */
6194 if (EQ (val
, default_filename
))
6196 /* In this case, Fcompleting_read has not added an element
6197 to the history. Maybe we should. */
6198 if (! replace_in_history
)
6204 unbind_to (count
, Qnil
);
6207 error ("No file name specified");
6209 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6211 if (!NILP (tem
) && !NILP (default_filename
))
6212 val
= default_filename
;
6213 else if (SCHARS (val
) == 0 && NILP (insdef
))
6215 if (!NILP (default_filename
))
6216 val
= default_filename
;
6218 error ("No default file name");
6220 val
= Fsubstitute_in_file_name (val
);
6222 if (replace_in_history
)
6223 /* Replace what Fcompleting_read added to the history
6224 with what we will actually return. */
6225 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6226 else if (add_to_history
)
6228 /* Add the value to the history--but not if it matches
6229 the last value already there. */
6230 Lisp_Object val1
= double_dollars (val
);
6231 tem
= Fsymbol_value (Qfile_name_history
);
6232 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6233 Fset (Qfile_name_history
,
6244 /* Must be set before any path manipulation is performed. */
6245 XSETFASTINT (Vdirectory_sep_char
, '/');
6252 Qexpand_file_name
= intern ("expand-file-name");
6253 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6254 Qdirectory_file_name
= intern ("directory-file-name");
6255 Qfile_name_directory
= intern ("file-name-directory");
6256 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6257 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6258 Qfile_name_as_directory
= intern ("file-name-as-directory");
6259 Qcopy_file
= intern ("copy-file");
6260 Qmake_directory_internal
= intern ("make-directory-internal");
6261 Qmake_directory
= intern ("make-directory");
6262 Qdelete_directory
= intern ("delete-directory");
6263 Qdelete_file
= intern ("delete-file");
6264 Qrename_file
= intern ("rename-file");
6265 Qadd_name_to_file
= intern ("add-name-to-file");
6266 Qmake_symbolic_link
= intern ("make-symbolic-link");
6267 Qfile_exists_p
= intern ("file-exists-p");
6268 Qfile_executable_p
= intern ("file-executable-p");
6269 Qfile_readable_p
= intern ("file-readable-p");
6270 Qfile_writable_p
= intern ("file-writable-p");
6271 Qfile_symlink_p
= intern ("file-symlink-p");
6272 Qaccess_file
= intern ("access-file");
6273 Qfile_directory_p
= intern ("file-directory-p");
6274 Qfile_regular_p
= intern ("file-regular-p");
6275 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6276 Qfile_modes
= intern ("file-modes");
6277 Qset_file_modes
= intern ("set-file-modes");
6278 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6279 Qinsert_file_contents
= intern ("insert-file-contents");
6280 Qwrite_region
= intern ("write-region");
6281 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6282 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6284 staticpro (&Qexpand_file_name
);
6285 staticpro (&Qsubstitute_in_file_name
);
6286 staticpro (&Qdirectory_file_name
);
6287 staticpro (&Qfile_name_directory
);
6288 staticpro (&Qfile_name_nondirectory
);
6289 staticpro (&Qunhandled_file_name_directory
);
6290 staticpro (&Qfile_name_as_directory
);
6291 staticpro (&Qcopy_file
);
6292 staticpro (&Qmake_directory_internal
);
6293 staticpro (&Qmake_directory
);
6294 staticpro (&Qdelete_directory
);
6295 staticpro (&Qdelete_file
);
6296 staticpro (&Qrename_file
);
6297 staticpro (&Qadd_name_to_file
);
6298 staticpro (&Qmake_symbolic_link
);
6299 staticpro (&Qfile_exists_p
);
6300 staticpro (&Qfile_executable_p
);
6301 staticpro (&Qfile_readable_p
);
6302 staticpro (&Qfile_writable_p
);
6303 staticpro (&Qaccess_file
);
6304 staticpro (&Qfile_symlink_p
);
6305 staticpro (&Qfile_directory_p
);
6306 staticpro (&Qfile_regular_p
);
6307 staticpro (&Qfile_accessible_directory_p
);
6308 staticpro (&Qfile_modes
);
6309 staticpro (&Qset_file_modes
);
6310 staticpro (&Qfile_newer_than_file_p
);
6311 staticpro (&Qinsert_file_contents
);
6312 staticpro (&Qwrite_region
);
6313 staticpro (&Qverify_visited_file_modtime
);
6314 staticpro (&Qset_visited_file_modtime
);
6316 Qfile_name_history
= intern ("file-name-history");
6317 Fset (Qfile_name_history
, Qnil
);
6318 staticpro (&Qfile_name_history
);
6320 Qfile_error
= intern ("file-error");
6321 staticpro (&Qfile_error
);
6322 Qfile_already_exists
= intern ("file-already-exists");
6323 staticpro (&Qfile_already_exists
);
6324 Qfile_date_error
= intern ("file-date-error");
6325 staticpro (&Qfile_date_error
);
6326 Qexcl
= intern ("excl");
6330 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6331 staticpro (&Qfind_buffer_file_type
);
6334 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6335 doc
: /* *Coding system for encoding file names.
6336 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6337 Vfile_name_coding_system
= Qnil
;
6339 DEFVAR_LISP ("default-file-name-coding-system",
6340 &Vdefault_file_name_coding_system
,
6341 doc
: /* Default coding system for encoding file names.
6342 This variable is used only when `file-name-coding-system' is nil.
6344 This variable is set/changed by the command `set-language-environment'.
6345 User should not set this variable manually,
6346 instead use `file-name-coding-system' to get a constant encoding
6347 of file names regardless of the current language environment. */);
6348 Vdefault_file_name_coding_system
= Qnil
;
6350 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6351 doc
: /* *Format in which to write auto-save files.
6352 Should be a list of symbols naming formats that are defined in `format-alist'.
6353 If it is t, which is the default, auto-save files are written in the
6354 same format as a regular save would use. */);
6355 Vauto_save_file_format
= Qt
;
6357 Qformat_decode
= intern ("format-decode");
6358 staticpro (&Qformat_decode
);
6359 Qformat_annotate_function
= intern ("format-annotate-function");
6360 staticpro (&Qformat_annotate_function
);
6361 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6362 staticpro (&Qafter_insert_file_set_coding
);
6364 Qcar_less_than_car
= intern ("car-less-than-car");
6365 staticpro (&Qcar_less_than_car
);
6367 Fput (Qfile_error
, Qerror_conditions
,
6368 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6369 Fput (Qfile_error
, Qerror_message
,
6370 build_string ("File error"));
6372 Fput (Qfile_already_exists
, Qerror_conditions
,
6373 Fcons (Qfile_already_exists
,
6374 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6375 Fput (Qfile_already_exists
, Qerror_message
,
6376 build_string ("File already exists"));
6378 Fput (Qfile_date_error
, Qerror_conditions
,
6379 Fcons (Qfile_date_error
,
6380 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6381 Fput (Qfile_date_error
, Qerror_message
,
6382 build_string ("Cannot set file date"));
6384 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6385 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6386 Vread_file_name_function
= Qnil
;
6388 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6389 doc
: /* Current predicate used by `read-file-name-internal'. */);
6390 Vread_file_name_predicate
= Qnil
;
6392 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6393 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer. */);
6394 insert_default_directory
= 1;
6396 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6397 doc
: /* *Non-nil means write new files with record format `stmlf'.
6398 nil means use format `var'. This variable is meaningful only on VMS. */);
6399 vms_stmlf_recfm
= 0;
6401 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6402 doc
: /* Directory separator character for built-in functions that return file names.
6403 The value is always ?/. Don't use this variable, just use `/'. */);
6405 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6406 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6407 If a file name matches REGEXP, then all I/O on that file is done by calling
6410 The first argument given to HANDLER is the name of the I/O primitive
6411 to be handled; the remaining arguments are the arguments that were
6412 passed to that primitive. For example, if you do
6413 (file-exists-p FILENAME)
6414 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6415 (funcall HANDLER 'file-exists-p FILENAME)
6416 The function `find-file-name-handler' checks this list for a handler
6417 for its argument. */);
6418 Vfile_name_handler_alist
= Qnil
;
6420 DEFVAR_LISP ("set-auto-coding-function",
6421 &Vset_auto_coding_function
,
6422 doc
: /* If non-nil, a function to call to decide a coding system of file.
6423 Two arguments are passed to this function: the file name
6424 and the length of a file contents following the point.
6425 This function should return a coding system to decode the file contents.
6426 It should check the file name against `auto-coding-alist'.
6427 If no coding system is decided, it should check a coding system
6428 specified in the heading lines with the format:
6429 -*- ... coding: CODING-SYSTEM; ... -*-
6430 or local variable spec of the tailing lines with `coding:' tag. */);
6431 Vset_auto_coding_function
= Qnil
;
6433 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6434 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6435 Each is passed one argument, the number of characters inserted.
6436 It should return the new character count, and leave point the same.
6437 If `insert-file-contents' is intercepted by a handler from
6438 `file-name-handler-alist', that handler is responsible for calling the
6439 functions in `after-insert-file-functions' if appropriate. */);
6440 Vafter_insert_file_functions
= Qnil
;
6442 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6443 doc
: /* A list of functions to be called at the start of `write-region'.
6444 Each is passed two arguments, START and END as for `write-region'.
6445 These are usually two numbers but not always; see the documentation
6446 for `write-region'. The function should return a list of pairs
6447 of the form (POSITION . STRING), consisting of strings to be effectively
6448 inserted at the specified positions of the file being written (1 means to
6449 insert before the first byte written). The POSITIONs must be sorted into
6450 increasing order. If there are several functions in the list, the several
6451 lists are merged destructively. Alternatively, the function can return
6452 with a different buffer current and value nil.*/);
6453 Vwrite_region_annotate_functions
= Qnil
;
6455 DEFVAR_LISP ("write-region-annotations-so-far",
6456 &Vwrite_region_annotations_so_far
,
6457 doc
: /* When an annotation function is called, this holds the previous annotations.
6458 These are the annotations made by other annotation functions
6459 that were already called. See also `write-region-annotate-functions'. */);
6460 Vwrite_region_annotations_so_far
= Qnil
;
6462 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6463 doc
: /* A list of file name handlers that temporarily should not be used.
6464 This applies only to the operation `inhibit-file-name-operation'. */);
6465 Vinhibit_file_name_handlers
= Qnil
;
6467 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6468 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6469 Vinhibit_file_name_operation
= Qnil
;
6471 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6472 doc
: /* File name in which we write a list of all auto save file names.
6473 This variable is initialized automatically from `auto-save-list-file-prefix'
6474 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6475 a non-nil value. */);
6476 Vauto_save_list_file_name
= Qnil
;
6478 defsubr (&Sfind_file_name_handler
);
6479 defsubr (&Sfile_name_directory
);
6480 defsubr (&Sfile_name_nondirectory
);
6481 defsubr (&Sunhandled_file_name_directory
);
6482 defsubr (&Sfile_name_as_directory
);
6483 defsubr (&Sdirectory_file_name
);
6484 defsubr (&Smake_temp_name
);
6485 defsubr (&Sexpand_file_name
);
6486 defsubr (&Ssubstitute_in_file_name
);
6487 defsubr (&Scopy_file
);
6488 defsubr (&Smake_directory_internal
);
6489 defsubr (&Sdelete_directory
);
6490 defsubr (&Sdelete_file
);
6491 defsubr (&Srename_file
);
6492 defsubr (&Sadd_name_to_file
);
6494 defsubr (&Smake_symbolic_link
);
6495 #endif /* S_IFLNK */
6497 defsubr (&Sdefine_logical_name
);
6500 defsubr (&Ssysnetunam
);
6501 #endif /* HPUX_NET */
6502 defsubr (&Sfile_name_absolute_p
);
6503 defsubr (&Sfile_exists_p
);
6504 defsubr (&Sfile_executable_p
);
6505 defsubr (&Sfile_readable_p
);
6506 defsubr (&Sfile_writable_p
);
6507 defsubr (&Saccess_file
);
6508 defsubr (&Sfile_symlink_p
);
6509 defsubr (&Sfile_directory_p
);
6510 defsubr (&Sfile_accessible_directory_p
);
6511 defsubr (&Sfile_regular_p
);
6512 defsubr (&Sfile_modes
);
6513 defsubr (&Sset_file_modes
);
6514 defsubr (&Sset_default_file_modes
);
6515 defsubr (&Sdefault_file_modes
);
6516 defsubr (&Sfile_newer_than_file_p
);
6517 defsubr (&Sinsert_file_contents
);
6518 defsubr (&Swrite_region
);
6519 defsubr (&Scar_less_than_car
);
6520 defsubr (&Sverify_visited_file_modtime
);
6521 defsubr (&Sclear_visited_file_modtime
);
6522 defsubr (&Svisited_file_modtime
);
6523 defsubr (&Sset_visited_file_modtime
);
6524 defsubr (&Sdo_auto_save
);
6525 defsubr (&Sset_buffer_auto_saved
);
6526 defsubr (&Sclear_buffer_auto_save_failure
);
6527 defsubr (&Srecent_auto_save_p
);
6529 defsubr (&Sread_file_name_internal
);
6530 defsubr (&Sread_file_name
);
6533 defsubr (&Sunix_sync
);