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
;
186 Lisp_Object Qwrite_region_annotate_functions
;
188 /* During build_annotations, each time an annotation function is called,
189 this holds the annotations made by the previous functions. */
190 Lisp_Object Vwrite_region_annotations_so_far
;
192 /* File name in which we write a list of all our auto save files. */
193 Lisp_Object Vauto_save_list_file_name
;
195 /* Function to call to read a file name. */
196 Lisp_Object Vread_file_name_function
;
198 /* Current predicate used by read_file_name_internal. */
199 Lisp_Object Vread_file_name_predicate
;
201 /* Nonzero means, when reading a filename in the minibuffer,
202 start out by inserting the default directory into the minibuffer. */
203 int insert_default_directory
;
205 /* On VMS, nonzero means write new files with record format stmlf.
206 Zero means use var format. */
209 /* On NT, specifies the directory separator character, used (eg.) when
210 expanding file names. This can be bound to / or \. */
211 Lisp_Object Vdirectory_sep_char
;
213 extern Lisp_Object Vuser_login_name
;
216 extern Lisp_Object Vw32_get_true_file_attributes
;
219 extern int minibuf_level
;
221 extern int minibuffer_auto_raise
;
223 /* These variables describe handlers that have "already" had a chance
224 to handle the current operation.
226 Vinhibit_file_name_handlers is a list of file name handlers.
227 Vinhibit_file_name_operation is the operation being handled.
228 If we try to handle that operation, we ignore those handlers. */
230 static Lisp_Object Vinhibit_file_name_handlers
;
231 static Lisp_Object Vinhibit_file_name_operation
;
233 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
235 Lisp_Object Qfile_name_history
;
237 Lisp_Object Qcar_less_than_car
;
239 static int a_write
P_ ((int, Lisp_Object
, int, int,
240 Lisp_Object
*, struct coding_system
*));
241 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
245 report_file_error (string
, data
)
249 Lisp_Object errstring
;
252 synchronize_system_messages_locale ();
253 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
254 Vlocale_coding_system
, 0);
260 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
263 /* System error messages are capitalized. Downcase the initial
264 unless it is followed by a slash. */
265 if (SREF (errstring
, 1) != '/')
266 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
268 Fsignal (Qfile_error
,
269 Fcons (build_string (string
), Fcons (errstring
, data
)));
274 close_file_unwind (fd
)
277 emacs_close (XFASTINT (fd
));
281 /* Restore point, having saved it as a marker. */
284 restore_point_unwind (location
)
285 Lisp_Object location
;
287 Fgoto_char (location
);
288 Fset_marker (location
, Qnil
, Qnil
);
292 Lisp_Object Qexpand_file_name
;
293 Lisp_Object Qsubstitute_in_file_name
;
294 Lisp_Object Qdirectory_file_name
;
295 Lisp_Object Qfile_name_directory
;
296 Lisp_Object Qfile_name_nondirectory
;
297 Lisp_Object Qunhandled_file_name_directory
;
298 Lisp_Object Qfile_name_as_directory
;
299 Lisp_Object Qcopy_file
;
300 Lisp_Object Qmake_directory_internal
;
301 Lisp_Object Qmake_directory
;
302 Lisp_Object Qdelete_directory
;
303 Lisp_Object Qdelete_file
;
304 Lisp_Object Qrename_file
;
305 Lisp_Object Qadd_name_to_file
;
306 Lisp_Object Qmake_symbolic_link
;
307 Lisp_Object Qfile_exists_p
;
308 Lisp_Object Qfile_executable_p
;
309 Lisp_Object Qfile_readable_p
;
310 Lisp_Object Qfile_writable_p
;
311 Lisp_Object Qfile_symlink_p
;
312 Lisp_Object Qaccess_file
;
313 Lisp_Object Qfile_directory_p
;
314 Lisp_Object Qfile_regular_p
;
315 Lisp_Object Qfile_accessible_directory_p
;
316 Lisp_Object Qfile_modes
;
317 Lisp_Object Qset_file_modes
;
318 Lisp_Object Qfile_newer_than_file_p
;
319 Lisp_Object Qinsert_file_contents
;
320 Lisp_Object Qwrite_region
;
321 Lisp_Object Qverify_visited_file_modtime
;
322 Lisp_Object Qset_visited_file_modtime
;
324 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
325 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
326 Otherwise, return nil.
327 A file name is handled if one of the regular expressions in
328 `file-name-handler-alist' matches it.
330 If OPERATION equals `inhibit-file-name-operation', then we ignore
331 any handlers that are members of `inhibit-file-name-handlers',
332 but we still do run any other handlers. This lets handlers
333 use the standard functions without calling themselves recursively. */)
334 (filename
, operation
)
335 Lisp_Object filename
, operation
;
337 /* This function must not munge the match data. */
338 Lisp_Object chain
, inhibited_handlers
, result
;
342 CHECK_STRING (filename
);
344 if (EQ (operation
, Vinhibit_file_name_operation
))
345 inhibited_handlers
= Vinhibit_file_name_handlers
;
347 inhibited_handlers
= Qnil
;
349 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
350 chain
= XCDR (chain
))
360 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
362 Lisp_Object handler
, tem
;
364 handler
= XCDR (elt
);
365 tem
= Fmemq (handler
, inhibited_handlers
);
379 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
381 doc
: /* Return the directory component in file name FILENAME.
382 Return nil if FILENAME does not include a directory.
383 Otherwise return a directory spec.
384 Given a Unix syntax file name, returns a string ending in slash;
385 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
387 Lisp_Object filename
;
390 register const unsigned char *beg
;
392 register unsigned char *beg
;
394 register const unsigned char *p
;
397 CHECK_STRING (filename
);
399 /* If the file name has special constructs in it,
400 call the corresponding file handler. */
401 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
403 return call2 (handler
, Qfile_name_directory
, filename
);
405 #ifdef FILE_SYSTEM_CASE
406 filename
= FILE_SYSTEM_CASE (filename
);
408 beg
= SDATA (filename
);
410 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
412 p
= beg
+ SBYTES (filename
);
414 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
416 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
419 /* only recognise drive specifier at the beginning */
421 /* handle the "/:d:foo" and "/:foo" cases correctly */
422 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
423 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
430 /* Expansion of "c:" to drive and default directory. */
433 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
434 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
435 unsigned char *r
= res
;
437 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
439 strncpy (res
, beg
, 2);
444 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
446 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
449 p
= beg
+ strlen (beg
);
452 CORRECT_DIR_SEPS (beg
);
455 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
458 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
459 Sfile_name_nondirectory
, 1, 1, 0,
460 doc
: /* Return file name FILENAME sans its directory.
461 For example, in a Unix-syntax file name,
462 this is everything after the last slash,
463 or the entire name if it contains no slash. */)
465 Lisp_Object filename
;
467 register const unsigned char *beg
, *p
, *end
;
470 CHECK_STRING (filename
);
472 /* If the file name has special constructs in it,
473 call the corresponding file handler. */
474 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
476 return call2 (handler
, Qfile_name_nondirectory
, filename
);
478 beg
= SDATA (filename
);
479 end
= p
= beg
+ SBYTES (filename
);
481 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
483 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
486 /* only recognise drive specifier at beginning */
488 /* handle the "/:d:foo" case correctly */
489 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
494 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
497 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
498 Sunhandled_file_name_directory
, 1, 1, 0,
499 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
500 A `directly usable' directory name is one that may be used without the
501 intervention of any file handler.
502 If FILENAME is a directly usable file itself, return
503 \(file-name-directory FILENAME).
504 The `call-process' and `start-process' functions use this function to
505 get a current directory to run processes in. */)
507 Lisp_Object filename
;
511 /* If the file name has special constructs in it,
512 call the corresponding file handler. */
513 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
515 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
517 return Ffile_name_directory (filename
);
522 file_name_as_directory (out
, in
)
525 int size
= strlen (in
) - 1;
538 /* Is it already a directory string? */
539 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
541 /* Is it a VMS directory file name? If so, hack VMS syntax. */
542 else if (! index (in
, '/')
543 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
544 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
545 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
546 || ! strncmp (&in
[size
- 5], ".dir", 4))
547 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
548 && in
[size
] == '1')))
550 register char *p
, *dot
;
554 dir:x.dir --> dir:[x]
555 dir:[x]y.dir --> dir:[x.y] */
557 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
560 strncpy (out
, in
, p
- in
);
579 dot
= index (p
, '.');
582 /* blindly remove any extension */
583 size
= strlen (out
) + (dot
- p
);
584 strncat (out
, p
, dot
- p
);
595 /* For Unix syntax, Append a slash if necessary */
596 if (!IS_DIRECTORY_SEP (out
[size
]))
598 /* Cannot use DIRECTORY_SEP, which could have any value */
600 out
[size
+ 2] = '\0';
603 CORRECT_DIR_SEPS (out
);
609 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
610 Sfile_name_as_directory
, 1, 1, 0,
611 doc
: /* Return a string representing the file name FILE interpreted as a directory.
612 This operation exists because a directory is also a file, but its name as
613 a directory is different from its name as a file.
614 The result can be used as the value of `default-directory'
615 or passed as second argument to `expand-file-name'.
616 For a Unix-syntax file name, just appends a slash.
617 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
628 /* If the file name has special constructs in it,
629 call the corresponding file handler. */
630 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
632 return call2 (handler
, Qfile_name_as_directory
, file
);
634 buf
= (char *) alloca (SBYTES (file
) + 10);
635 file_name_as_directory (buf
, SDATA (file
));
636 return make_specified_string (buf
, -1, strlen (buf
),
637 STRING_MULTIBYTE (file
));
641 * Convert from directory name to filename.
643 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
644 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
645 * On UNIX, it's simple: just make sure there isn't a terminating /
647 * Value is nonzero if the string output is different from the input.
651 directory_file_name (src
, dst
)
659 struct FAB fab
= cc$rms_fab
;
660 struct NAM nam
= cc$rms_nam
;
661 char esa
[NAM$C_MAXRSS
];
666 if (! index (src
, '/')
667 && (src
[slen
- 1] == ']'
668 || src
[slen
- 1] == ':'
669 || src
[slen
- 1] == '>'))
671 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
673 fab
.fab$b_fns
= slen
;
674 fab
.fab$l_nam
= &nam
;
675 fab
.fab$l_fop
= FAB$M_NAM
;
678 nam
.nam$b_ess
= sizeof esa
;
679 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
681 /* We call SYS$PARSE to handle such things as [--] for us. */
682 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
684 slen
= nam
.nam$b_esl
;
685 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
690 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
692 /* what about when we have logical_name:???? */
693 if (src
[slen
- 1] == ':')
694 { /* Xlate logical name and see what we get */
695 ptr
= strcpy (dst
, src
); /* upper case for getenv */
698 if ('a' <= *ptr
&& *ptr
<= 'z')
702 dst
[slen
- 1] = 0; /* remove colon */
703 if (!(src
= egetenv (dst
)))
705 /* should we jump to the beginning of this procedure?
706 Good points: allows us to use logical names that xlate
708 Bad points: can be a problem if we just translated to a device
710 For now, I'll punt and always expect VMS names, and hope for
713 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
714 { /* no recursion here! */
720 { /* not a directory spec */
725 bracket
= src
[slen
- 1];
727 /* If bracket is ']' or '>', bracket - 2 is the corresponding
729 ptr
= index (src
, bracket
- 2);
731 { /* no opening bracket */
735 if (!(rptr
= rindex (src
, '.')))
738 strncpy (dst
, src
, slen
);
742 dst
[slen
++] = bracket
;
747 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
748 then translate the device and recurse. */
749 if (dst
[slen
- 1] == ':'
750 && dst
[slen
- 2] != ':' /* skip decnet nodes */
751 && strcmp (src
+ slen
, "[000000]") == 0)
753 dst
[slen
- 1] = '\0';
754 if ((ptr
= egetenv (dst
))
755 && (rlen
= strlen (ptr
) - 1) > 0
756 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
757 && ptr
[rlen
- 1] == '.')
759 char * buf
= (char *) alloca (strlen (ptr
) + 1);
763 return directory_file_name (buf
, dst
);
768 strcat (dst
, "[000000]");
772 rlen
= strlen (rptr
) - 1;
773 strncat (dst
, rptr
, rlen
);
774 dst
[slen
+ rlen
] = '\0';
775 strcat (dst
, ".DIR.1");
779 /* Process as Unix format: just remove any final slash.
780 But leave "/" unchanged; do not change it to "". */
783 /* Handle // as root for apollo's. */
784 if ((slen
> 2 && dst
[slen
- 1] == '/')
785 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
789 && IS_DIRECTORY_SEP (dst
[slen
- 1])
791 && !IS_ANY_SEP (dst
[slen
- 2])
797 CORRECT_DIR_SEPS (dst
);
802 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
804 doc
: /* Returns the file name of the directory named DIRECTORY.
805 This is the name of the file that holds the data for the directory DIRECTORY.
806 This operation exists because a directory is also a file, but its name as
807 a directory is different from its name as a file.
808 In Unix-syntax, this function just removes the final slash.
809 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
810 it returns a file name such as \"[X]Y.DIR.1\". */)
812 Lisp_Object directory
;
817 CHECK_STRING (directory
);
819 if (NILP (directory
))
822 /* If the file name has special constructs in it,
823 call the corresponding file handler. */
824 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
826 return call2 (handler
, Qdirectory_file_name
, directory
);
829 /* 20 extra chars is insufficient for VMS, since we might perform a
830 logical name translation. an equivalence string can be up to 255
831 chars long, so grab that much extra space... - sss */
832 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
834 buf
= (char *) alloca (SBYTES (directory
) + 20);
836 directory_file_name (SDATA (directory
), buf
);
837 return make_specified_string (buf
, -1, strlen (buf
),
838 STRING_MULTIBYTE (directory
));
841 static char make_temp_name_tbl
[64] =
843 'A','B','C','D','E','F','G','H',
844 'I','J','K','L','M','N','O','P',
845 'Q','R','S','T','U','V','W','X',
846 'Y','Z','a','b','c','d','e','f',
847 'g','h','i','j','k','l','m','n',
848 'o','p','q','r','s','t','u','v',
849 'w','x','y','z','0','1','2','3',
850 '4','5','6','7','8','9','-','_'
853 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
855 /* Value is a temporary file name starting with PREFIX, a string.
857 The Emacs process number forms part of the result, so there is
858 no danger of generating a name being used by another process.
859 In addition, this function makes an attempt to choose a name
860 which has no existing file. To make this work, PREFIX should be
861 an absolute file name.
863 BASE64_P non-zero means add the pid as 3 characters in base64
864 encoding. In this case, 6 characters will be added to PREFIX to
865 form the file name. Otherwise, if Emacs is running on a system
866 with long file names, add the pid as a decimal number.
868 This function signals an error if no unique file name could be
872 make_temp_name (prefix
, base64_p
)
879 unsigned char *p
, *data
;
883 CHECK_STRING (prefix
);
885 /* VAL is created by adding 6 characters to PREFIX. The first
886 three are the PID of this process, in base 64, and the second
887 three are incremented if the file already exists. This ensures
888 262144 unique file names per PID per PREFIX. */
890 pid
= (int) getpid ();
894 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
895 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
896 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
901 #ifdef HAVE_LONG_FILE_NAMES
902 sprintf (pidbuf
, "%d", pid
);
903 pidlen
= strlen (pidbuf
);
905 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
906 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
907 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
912 len
= SCHARS (prefix
);
913 val
= make_uninit_string (len
+ 3 + pidlen
);
915 bcopy(SDATA (prefix
), data
, len
);
918 bcopy (pidbuf
, p
, pidlen
);
921 /* Here we try to minimize useless stat'ing when this function is
922 invoked many times successively with the same PREFIX. We achieve
923 this by initializing count to a random value, and incrementing it
926 We don't want make-temp-name to be called while dumping,
927 because then make_temp_name_count_initialized_p would get set
928 and then make_temp_name_count would not be set when Emacs starts. */
930 if (!make_temp_name_count_initialized_p
)
932 make_temp_name_count
= (unsigned) time (NULL
);
933 make_temp_name_count_initialized_p
= 1;
939 unsigned num
= make_temp_name_count
;
941 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
942 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
943 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
945 /* Poor man's congruential RN generator. Replace with
946 ++make_temp_name_count for debugging. */
947 make_temp_name_count
+= 25229;
948 make_temp_name_count
%= 225307;
950 if (stat (data
, &ignored
) < 0)
952 /* We want to return only if errno is ENOENT. */
956 /* The error here is dubious, but there is little else we
957 can do. The alternatives are to return nil, which is
958 as bad as (and in many cases worse than) throwing the
959 error, or to ignore the error, which will likely result
960 in looping through 225307 stat's, which is not only
961 dog-slow, but also useless since it will fallback to
962 the errow below, anyway. */
963 report_file_error ("Cannot create temporary name for prefix",
964 Fcons (prefix
, Qnil
));
969 error ("Cannot create temporary name for prefix `%s'",
975 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
976 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
977 The Emacs process number forms part of the result,
978 so there is no danger of generating a name being used by another process.
980 In addition, this function makes an attempt to choose a name
981 which has no existing file. To make this work,
982 PREFIX should be an absolute file name.
984 There is a race condition between calling `make-temp-name' and creating the
985 file which opens all kinds of security holes. For that reason, you should
986 probably use `make-temp-file' instead, except in three circumstances:
988 * If you are creating the file in the user's home directory.
989 * If you are creating a directory rather than an ordinary file.
990 * If you are taking special precautions as `make-temp-file' does. */)
994 return make_temp_name (prefix
, 0);
999 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1000 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1001 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1002 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1003 the current buffer's value of default-directory is used.
1004 File name components that are `.' are removed, and
1005 so are file name components followed by `..', along with the `..' itself;
1006 note that these simplifications are done without checking the resulting
1007 file names in the file system.
1008 An initial `~/' expands to your home directory.
1009 An initial `~USER/' expands to USER's home directory.
1010 See also the function `substitute-in-file-name'. */)
1011 (name
, default_directory
)
1012 Lisp_Object name
, default_directory
;
1016 register unsigned char *newdir
, *p
, *o
;
1018 unsigned char *target
;
1021 unsigned char * colon
= 0;
1022 unsigned char * close
= 0;
1023 unsigned char * slash
= 0;
1024 unsigned char * brack
= 0;
1025 int lbrack
= 0, rbrack
= 0;
1030 int collapse_newdir
= 1;
1034 Lisp_Object handler
, result
;
1036 CHECK_STRING (name
);
1038 /* If the file name has special constructs in it,
1039 call the corresponding file handler. */
1040 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1041 if (!NILP (handler
))
1042 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1044 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1045 if (NILP (default_directory
))
1046 default_directory
= current_buffer
->directory
;
1047 if (! STRINGP (default_directory
))
1050 /* "/" is not considered a root directory on DOS_NT, so using "/"
1051 here causes an infinite recursion in, e.g., the following:
1053 (let (default-directory)
1054 (expand-file-name "a"))
1056 To avoid this, we set default_directory to the root of the
1058 extern char *emacs_root_dir (void);
1060 default_directory
= build_string (emacs_root_dir ());
1062 default_directory
= build_string ("/");
1066 if (!NILP (default_directory
))
1068 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1069 if (!NILP (handler
))
1070 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1073 o
= SDATA (default_directory
);
1075 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1076 It would be better to do this down below where we actually use
1077 default_directory. Unfortunately, calling Fexpand_file_name recursively
1078 could invoke GC, and the strings might be relocated. This would
1079 be annoying because we have pointers into strings lying around
1080 that would need adjusting, and people would add new pointers to
1081 the code and forget to adjust them, resulting in intermittent bugs.
1082 Putting this call here avoids all that crud.
1084 The EQ test avoids infinite recursion. */
1085 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1086 /* Save time in some common cases - as long as default_directory
1087 is not relative, it can be canonicalized with name below (if it
1088 is needed at all) without requiring it to be expanded now. */
1090 /* Detect MSDOS file names with drive specifiers. */
1091 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1093 /* Detect Windows file names in UNC format. */
1094 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1096 #else /* not DOS_NT */
1097 /* Detect Unix absolute file names (/... alone is not absolute on
1099 && ! (IS_DIRECTORY_SEP (o
[0]))
1100 #endif /* not DOS_NT */
1103 struct gcpro gcpro1
;
1106 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1111 /* Filenames on VMS are always upper case. */
1112 name
= Fupcase (name
);
1114 #ifdef FILE_SYSTEM_CASE
1115 name
= FILE_SYSTEM_CASE (name
);
1121 /* We will force directory separators to be either all \ or /, so make
1122 a local copy to modify, even if there ends up being no change. */
1123 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1125 /* Note if special escape prefix is present, but remove for now. */
1126 if (nm
[0] == '/' && nm
[1] == ':')
1132 /* Find and remove drive specifier if present; this makes nm absolute
1133 even if the rest of the name appears to be relative. Only look for
1134 drive specifier at the beginning. */
1135 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1142 /* If we see "c://somedir", we want to strip the first slash after the
1143 colon when stripping the drive letter. Otherwise, this expands to
1145 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1147 #endif /* WINDOWSNT */
1151 /* Discard any previous drive specifier if nm is now in UNC format. */
1152 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1158 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1159 none are found, we can probably return right away. We will avoid
1160 allocating a new string if name is already fully expanded. */
1162 IS_DIRECTORY_SEP (nm
[0])
1164 && drive
&& !is_escaped
1167 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1174 /* If it turns out that the filename we want to return is just a
1175 suffix of FILENAME, we don't need to go through and edit
1176 things; we just need to construct a new string using data
1177 starting at the middle of FILENAME. If we set lose to a
1178 non-zero value, that means we've discovered that we can't do
1185 /* Since we know the name is absolute, we can assume that each
1186 element starts with a "/". */
1188 /* "." and ".." are hairy. */
1189 if (IS_DIRECTORY_SEP (p
[0])
1191 && (IS_DIRECTORY_SEP (p
[2])
1193 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1196 /* We want to replace multiple `/' in a row with a single
1199 && IS_DIRECTORY_SEP (p
[0])
1200 && IS_DIRECTORY_SEP (p
[1]))
1207 /* if dev:[dir]/, move nm to / */
1208 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1209 nm
= (brack
? brack
+ 1 : colon
+ 1);
1210 lbrack
= rbrack
= 0;
1218 /* VMS pre V4.4,convert '-'s in filenames. */
1219 if (lbrack
== rbrack
)
1221 if (dots
< 2) /* this is to allow negative version numbers */
1226 if (lbrack
> rbrack
&&
1227 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1228 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1234 /* count open brackets, reset close bracket pointer */
1235 if (p
[0] == '[' || p
[0] == '<')
1236 lbrack
++, brack
= 0;
1237 /* count close brackets, set close bracket pointer */
1238 if (p
[0] == ']' || p
[0] == '>')
1239 rbrack
++, brack
= p
;
1240 /* detect ][ or >< */
1241 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1243 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1244 nm
= p
+ 1, lose
= 1;
1245 if (p
[0] == ':' && (colon
|| slash
))
1246 /* if dev1:[dir]dev2:, move nm to dev2: */
1252 /* if /name/dev:, move nm to dev: */
1255 /* if node::dev:, move colon following dev */
1256 else if (colon
&& colon
[-1] == ':')
1258 /* if dev1:dev2:, move nm to dev2: */
1259 else if (colon
&& colon
[-1] != ':')
1264 if (p
[0] == ':' && !colon
)
1270 if (lbrack
== rbrack
)
1273 else if (p
[0] == '.')
1281 if (index (nm
, '/'))
1283 nm
= sys_translate_unix (nm
);
1284 return make_specified_string (nm
, -1, strlen (nm
),
1285 STRING_MULTIBYTE (name
));
1289 /* Make sure directories are all separated with / or \ as
1290 desired, but avoid allocation of a new string when not
1292 CORRECT_DIR_SEPS (nm
);
1294 if (IS_DIRECTORY_SEP (nm
[1]))
1296 if (strcmp (nm
, SDATA (name
)) != 0)
1297 name
= make_specified_string (nm
, -1, strlen (nm
),
1298 STRING_MULTIBYTE (name
));
1302 /* drive must be set, so this is okay */
1303 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1307 name
= make_specified_string (nm
, -1, p
- nm
,
1308 STRING_MULTIBYTE (name
));
1309 temp
[0] = DRIVE_LETTER (drive
);
1310 name
= concat2 (build_string (temp
), name
);
1313 #else /* not DOS_NT */
1314 if (nm
== SDATA (name
))
1316 return make_specified_string (nm
, -1, strlen (nm
),
1317 STRING_MULTIBYTE (name
));
1318 #endif /* not DOS_NT */
1322 /* At this point, nm might or might not be an absolute file name. We
1323 need to expand ~ or ~user if present, otherwise prefix nm with
1324 default_directory if nm is not absolute, and finally collapse /./
1325 and /foo/../ sequences.
1327 We set newdir to be the appropriate prefix if one is needed:
1328 - the relevant user directory if nm starts with ~ or ~user
1329 - the specified drive's working dir (DOS/NT only) if nm does not
1331 - the value of default_directory.
1333 Note that these prefixes are not guaranteed to be absolute (except
1334 for the working dir of a drive). Therefore, to ensure we always
1335 return an absolute name, if the final prefix is not absolute we
1336 append it to the current working directory. */
1340 if (nm
[0] == '~') /* prefix ~ */
1342 if (IS_DIRECTORY_SEP (nm
[1])
1346 || nm
[1] == 0) /* ~ by itself */
1348 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1349 newdir
= (unsigned char *) "";
1352 collapse_newdir
= 0;
1355 nm
++; /* Don't leave the slash in nm. */
1358 else /* ~user/filename */
1360 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1365 o
= (unsigned char *) alloca (p
- nm
+ 1);
1366 bcopy ((char *) nm
, o
, p
- nm
);
1369 pw
= (struct passwd
*) getpwnam (o
+ 1);
1372 newdir
= (unsigned char *) pw
-> pw_dir
;
1374 nm
= p
+ 1; /* skip the terminator */
1378 collapse_newdir
= 0;
1383 /* If we don't find a user of that name, leave the name
1384 unchanged; don't move nm forward to p. */
1389 /* On DOS and Windows, nm is absolute if a drive name was specified;
1390 use the drive's current directory as the prefix if needed. */
1391 if (!newdir
&& drive
)
1393 /* Get default directory if needed to make nm absolute. */
1394 if (!IS_DIRECTORY_SEP (nm
[0]))
1396 newdir
= alloca (MAXPATHLEN
+ 1);
1397 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1402 /* Either nm starts with /, or drive isn't mounted. */
1403 newdir
= alloca (4);
1404 newdir
[0] = DRIVE_LETTER (drive
);
1412 /* Finally, if no prefix has been specified and nm is not absolute,
1413 then it must be expanded relative to default_directory. */
1417 /* /... alone is not absolute on DOS and Windows. */
1418 && !IS_DIRECTORY_SEP (nm
[0])
1421 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1428 newdir
= SDATA (default_directory
);
1430 /* Note if special escape prefix is present, but remove for now. */
1431 if (newdir
[0] == '/' && newdir
[1] == ':')
1442 /* First ensure newdir is an absolute name. */
1444 /* Detect MSDOS file names with drive specifiers. */
1445 ! (IS_DRIVE (newdir
[0])
1446 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1448 /* Detect Windows file names in UNC format. */
1449 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1453 /* Effectively, let newdir be (expand-file-name newdir cwd).
1454 Because of the admonition against calling expand-file-name
1455 when we have pointers into lisp strings, we accomplish this
1456 indirectly by prepending newdir to nm if necessary, and using
1457 cwd (or the wd of newdir's drive) as the new newdir. */
1459 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1464 if (!IS_DIRECTORY_SEP (nm
[0]))
1466 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1467 file_name_as_directory (tmp
, newdir
);
1471 newdir
= alloca (MAXPATHLEN
+ 1);
1474 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1481 /* Strip off drive name from prefix, if present. */
1482 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1488 /* Keep only a prefix from newdir if nm starts with slash
1489 (//server/share for UNC, nothing otherwise). */
1490 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1493 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1495 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1497 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1499 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1511 /* Get rid of any slash at the end of newdir, unless newdir is
1512 just / or // (an incomplete UNC name). */
1513 length
= strlen (newdir
);
1514 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1516 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1520 unsigned char *temp
= (unsigned char *) alloca (length
);
1521 bcopy (newdir
, temp
, length
- 1);
1522 temp
[length
- 1] = 0;
1530 /* Now concatenate the directory and name to new space in the stack frame */
1531 tlen
+= strlen (nm
) + 1;
1533 /* Reserve space for drive specifier and escape prefix, since either
1534 or both may need to be inserted. (The Microsoft x86 compiler
1535 produces incorrect code if the following two lines are combined.) */
1536 target
= (unsigned char *) alloca (tlen
+ 4);
1538 #else /* not DOS_NT */
1539 target
= (unsigned char *) alloca (tlen
);
1540 #endif /* not DOS_NT */
1546 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1549 /* If newdir is effectively "C:/", then the drive letter will have
1550 been stripped and newdir will be "/". Concatenating with an
1551 absolute directory in nm produces "//", which will then be
1552 incorrectly treated as a network share. Ignore newdir in
1553 this case (keeping the drive letter). */
1554 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1555 && newdir
[1] == '\0'))
1557 strcpy (target
, newdir
);
1561 file_name_as_directory (target
, newdir
);
1564 strcat (target
, nm
);
1566 if (index (target
, '/'))
1567 strcpy (target
, sys_translate_unix (target
));
1570 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1572 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1581 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1587 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1588 /* brackets are offset from each other by 2 */
1591 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1592 /* convert [foo][bar] to [bar] */
1593 while (o
[-1] != '[' && o
[-1] != '<')
1595 else if (*p
== '-' && *o
!= '.')
1598 else if (p
[0] == '-' && o
[-1] == '.' &&
1599 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1600 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1604 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1605 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1607 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1609 /* else [foo.-] ==> [-] */
1615 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1616 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1622 if (!IS_DIRECTORY_SEP (*p
))
1626 else if (IS_DIRECTORY_SEP (p
[0])
1628 && (IS_DIRECTORY_SEP (p
[2])
1631 /* If "/." is the entire filename, keep the "/". Otherwise,
1632 just delete the whole "/.". */
1633 if (o
== target
&& p
[2] == '\0')
1637 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1638 /* `/../' is the "superroot" on certain file systems. */
1640 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1642 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1644 /* Keep initial / only if this is the whole name. */
1645 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1650 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1652 /* Collapse multiple `/' in a row. */
1654 while (IS_DIRECTORY_SEP (*p
))
1661 #endif /* not VMS */
1665 /* At last, set drive name. */
1667 /* Except for network file name. */
1668 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1669 #endif /* WINDOWSNT */
1671 if (!drive
) abort ();
1673 target
[0] = DRIVE_LETTER (drive
);
1676 /* Reinsert the escape prefix if required. */
1683 CORRECT_DIR_SEPS (target
);
1686 result
= make_specified_string (target
, -1, o
- target
,
1687 STRING_MULTIBYTE (name
));
1689 /* Again look to see if the file name has special constructs in it
1690 and perhaps call the corresponding file handler. This is needed
1691 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1692 the ".." component gives us "/user@host:/bar/../baz" which needs
1693 to be expanded again. */
1694 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1695 if (!NILP (handler
))
1696 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1702 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1703 This is the old version of expand-file-name, before it was thoroughly
1704 rewritten for Emacs 10.31. We leave this version here commented-out,
1705 because the code is very complex and likely to have subtle bugs. If
1706 bugs _are_ found, it might be of interest to look at the old code and
1707 see what did it do in the relevant situation.
1709 Don't remove this code: it's true that it will be accessible via CVS,
1710 but a few years from deletion, people will forget it is there. */
1712 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1713 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1714 "Convert FILENAME to absolute, and canonicalize it.\n\
1715 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1716 (does not start with slash); if DEFAULT is nil or missing,\n\
1717 the current buffer's value of default-directory is used.\n\
1718 Filenames containing `.' or `..' as components are simplified;\n\
1719 initial `~/' expands to your home directory.\n\
1720 See also the function `substitute-in-file-name'.")
1722 Lisp_Object name
, defalt
;
1726 register unsigned char *newdir
, *p
, *o
;
1728 unsigned char *target
;
1732 unsigned char * colon
= 0;
1733 unsigned char * close
= 0;
1734 unsigned char * slash
= 0;
1735 unsigned char * brack
= 0;
1736 int lbrack
= 0, rbrack
= 0;
1740 CHECK_STRING (name
);
1743 /* Filenames on VMS are always upper case. */
1744 name
= Fupcase (name
);
1749 /* If nm is absolute, flush ...// and detect /./ and /../.
1750 If no /./ or /../ we can return right away. */
1762 if (p
[0] == '/' && p
[1] == '/'
1764 /* // at start of filename is meaningful on Apollo system. */
1769 if (p
[0] == '/' && p
[1] == '~')
1770 nm
= p
+ 1, lose
= 1;
1771 if (p
[0] == '/' && p
[1] == '.'
1772 && (p
[2] == '/' || p
[2] == 0
1773 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1779 /* if dev:[dir]/, move nm to / */
1780 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1781 nm
= (brack
? brack
+ 1 : colon
+ 1);
1782 lbrack
= rbrack
= 0;
1790 /* VMS pre V4.4,convert '-'s in filenames. */
1791 if (lbrack
== rbrack
)
1793 if (dots
< 2) /* this is to allow negative version numbers */
1798 if (lbrack
> rbrack
&&
1799 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1800 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1806 /* count open brackets, reset close bracket pointer */
1807 if (p
[0] == '[' || p
[0] == '<')
1808 lbrack
++, brack
= 0;
1809 /* count close brackets, set close bracket pointer */
1810 if (p
[0] == ']' || p
[0] == '>')
1811 rbrack
++, brack
= p
;
1812 /* detect ][ or >< */
1813 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1815 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1816 nm
= p
+ 1, lose
= 1;
1817 if (p
[0] == ':' && (colon
|| slash
))
1818 /* if dev1:[dir]dev2:, move nm to dev2: */
1824 /* If /name/dev:, move nm to dev: */
1827 /* If node::dev:, move colon following dev */
1828 else if (colon
&& colon
[-1] == ':')
1830 /* If dev1:dev2:, move nm to dev2: */
1831 else if (colon
&& colon
[-1] != ':')
1836 if (p
[0] == ':' && !colon
)
1842 if (lbrack
== rbrack
)
1845 else if (p
[0] == '.')
1853 if (index (nm
, '/'))
1854 return build_string (sys_translate_unix (nm
));
1856 if (nm
== SDATA (name
))
1858 return build_string (nm
);
1862 /* Now determine directory to start with and put it in NEWDIR */
1866 if (nm
[0] == '~') /* prefix ~ */
1871 || nm
[1] == 0)/* ~/filename */
1873 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1874 newdir
= (unsigned char *) "";
1877 nm
++; /* Don't leave the slash in nm. */
1880 else /* ~user/filename */
1882 /* Get past ~ to user */
1883 unsigned char *user
= nm
+ 1;
1884 /* Find end of name. */
1885 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1886 int len
= ptr
? ptr
- user
: strlen (user
);
1888 unsigned char *ptr1
= index (user
, ':');
1889 if (ptr1
!= 0 && ptr1
- user
< len
)
1892 /* Copy the user name into temp storage. */
1893 o
= (unsigned char *) alloca (len
+ 1);
1894 bcopy ((char *) user
, o
, len
);
1897 /* Look up the user name. */
1898 pw
= (struct passwd
*) getpwnam (o
+ 1);
1900 error ("\"%s\" isn't a registered user", o
+ 1);
1902 newdir
= (unsigned char *) pw
->pw_dir
;
1904 /* Discard the user name from NM. */
1911 #endif /* not VMS */
1915 defalt
= current_buffer
->directory
;
1916 CHECK_STRING (defalt
);
1917 newdir
= SDATA (defalt
);
1920 /* Now concatenate the directory and name to new space in the stack frame */
1922 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1923 target
= (unsigned char *) alloca (tlen
);
1929 if (nm
[0] == 0 || nm
[0] == '/')
1930 strcpy (target
, newdir
);
1933 file_name_as_directory (target
, newdir
);
1936 strcat (target
, nm
);
1938 if (index (target
, '/'))
1939 strcpy (target
, sys_translate_unix (target
));
1942 /* Now canonicalize by removing /. and /foo/.. if they appear */
1950 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1956 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1957 /* brackets are offset from each other by 2 */
1960 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1961 /* convert [foo][bar] to [bar] */
1962 while (o
[-1] != '[' && o
[-1] != '<')
1964 else if (*p
== '-' && *o
!= '.')
1967 else if (p
[0] == '-' && o
[-1] == '.' &&
1968 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1969 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1973 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1974 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1976 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1978 /* else [foo.-] ==> [-] */
1984 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1985 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1995 else if (!strncmp (p
, "//", 2)
1997 /* // at start of filename is meaningful in Apollo system. */
2005 else if (p
[0] == '/' && p
[1] == '.' &&
2006 (p
[2] == '/' || p
[2] == 0))
2008 else if (!strncmp (p
, "/..", 3)
2009 /* `/../' is the "superroot" on certain file systems. */
2011 && (p
[3] == '/' || p
[3] == 0))
2013 while (o
!= target
&& *--o
!= '/')
2016 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2020 if (o
== target
&& *o
== '/')
2028 #endif /* not VMS */
2031 return make_string (target
, o
- target
);
2035 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2036 Ssubstitute_in_file_name
, 1, 1, 0,
2037 doc
: /* Substitute environment variables referred to in FILENAME.
2038 `$FOO' where FOO is an environment variable name means to substitute
2039 the value of that variable. The variable name should be terminated
2040 with a character not a letter, digit or underscore; otherwise, enclose
2041 the entire variable name in braces.
2042 If `/~' appears, all of FILENAME through that `/' is discarded.
2044 On VMS, `$' substitution is not done; this function does little and only
2045 duplicates what `expand-file-name' does. */)
2047 Lisp_Object filename
;
2051 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2052 unsigned char *target
= NULL
;
2054 int substituted
= 0;
2057 Lisp_Object handler
;
2059 CHECK_STRING (filename
);
2061 /* If the file name has special constructs in it,
2062 call the corresponding file handler. */
2063 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2064 if (!NILP (handler
))
2065 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2067 nm
= SDATA (filename
);
2069 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2070 CORRECT_DIR_SEPS (nm
);
2071 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2073 endp
= nm
+ SBYTES (filename
);
2075 /* If /~ or // appears, discard everything through first slash. */
2077 for (p
= nm
; p
!= endp
; p
++)
2080 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2081 /* // at start of file name is meaningful in Apollo,
2082 WindowsNT and Cygwin systems. */
2083 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2084 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2085 || IS_DIRECTORY_SEP (p
[0])
2086 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2091 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2093 || IS_DIRECTORY_SEP (p
[-1])))
2095 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2100 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2102 o
= (unsigned char *) alloca (s
- p
+ 1);
2103 bcopy ((char *) p
, o
, s
- p
);
2106 pw
= (struct passwd
*) getpwnam (o
+ 1);
2108 /* If we have ~/ or ~user and `user' exists, discard
2109 everything up to ~. But if `user' does not exist, leave
2110 ~user alone, it might be a literal file name. */
2111 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2118 /* see comment in expand-file-name about drive specifiers */
2119 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2120 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2129 return make_specified_string (nm
, -1, strlen (nm
),
2130 STRING_MULTIBYTE (filename
));
2133 /* See if any variables are substituted into the string
2134 and find the total length of their values in `total' */
2136 for (p
= nm
; p
!= endp
;)
2146 /* "$$" means a single "$" */
2155 while (p
!= endp
&& *p
!= '}') p
++;
2156 if (*p
!= '}') goto missingclose
;
2162 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2166 /* Copy out the variable name */
2167 target
= (unsigned char *) alloca (s
- o
+ 1);
2168 strncpy (target
, o
, s
- o
);
2171 strupr (target
); /* $home == $HOME etc. */
2174 /* Get variable value */
2175 o
= (unsigned char *) egetenv (target
);
2178 total
+= strlen (o
);
2188 /* If substitution required, recopy the string and do it */
2189 /* Make space in stack frame for the new copy */
2190 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2193 /* Copy the rest of the name through, replacing $ constructs with values */
2210 while (p
!= endp
&& *p
!= '}') p
++;
2211 if (*p
!= '}') goto missingclose
;
2217 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2221 /* Copy out the variable name */
2222 target
= (unsigned char *) alloca (s
- o
+ 1);
2223 strncpy (target
, o
, s
- o
);
2226 strupr (target
); /* $home == $HOME etc. */
2229 /* Get variable value */
2230 o
= (unsigned char *) egetenv (target
);
2234 strcpy (x
, target
); x
+= strlen (target
);
2236 else if (STRING_MULTIBYTE (filename
))
2238 /* If the original string is multibyte,
2239 convert what we substitute into multibyte. */
2242 int c
= unibyte_char_to_multibyte (*o
++);
2243 x
+= CHAR_STRING (c
, x
);
2255 /* If /~ or // appears, discard everything through first slash. */
2257 for (p
= xnm
; p
!= x
; p
++)
2259 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2260 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2261 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2262 || IS_DIRECTORY_SEP (p
[0])
2263 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2265 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2268 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2269 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2273 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2276 error ("Bad format environment-variable substitution");
2278 error ("Missing \"}\" in environment-variable substitution");
2280 error ("Substituting nonexistent environment variable \"%s\"", target
);
2283 #endif /* not VMS */
2287 /* A slightly faster and more convenient way to get
2288 (directory-file-name (expand-file-name FOO)). */
2291 expand_and_dir_to_file (filename
, defdir
)
2292 Lisp_Object filename
, defdir
;
2294 register Lisp_Object absname
;
2296 absname
= Fexpand_file_name (filename
, defdir
);
2299 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2300 if (c
== ':' || c
== ']' || c
== '>')
2301 absname
= Fdirectory_file_name (absname
);
2304 /* Remove final slash, if any (unless this is the root dir).
2305 stat behaves differently depending! */
2306 if (SCHARS (absname
) > 1
2307 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2308 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2309 /* We cannot take shortcuts; they might be wrong for magic file names. */
2310 absname
= Fdirectory_file_name (absname
);
2315 /* Signal an error if the file ABSNAME already exists.
2316 If INTERACTIVE is nonzero, ask the user whether to proceed,
2317 and bypass the error if the user says to go ahead.
2318 QUERYSTRING is a name for the action that is being considered
2321 *STATPTR is used to store the stat information if the file exists.
2322 If the file does not exist, STATPTR->st_mode is set to 0.
2323 If STATPTR is null, we don't store into it.
2325 If QUICK is nonzero, we ask for y or n, not yes or no. */
2328 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2329 Lisp_Object absname
;
2330 unsigned char *querystring
;
2332 struct stat
*statptr
;
2335 register Lisp_Object tem
, encoded_filename
;
2336 struct stat statbuf
;
2337 struct gcpro gcpro1
;
2339 encoded_filename
= ENCODE_FILE (absname
);
2341 /* stat is a good way to tell whether the file exists,
2342 regardless of what access permissions it has. */
2343 if (stat (SDATA (encoded_filename
), &statbuf
) >= 0)
2346 Fsignal (Qfile_already_exists
,
2347 Fcons (build_string ("File already exists"),
2348 Fcons (absname
, Qnil
)));
2350 tem
= format2 ("File %s already exists; %s anyway? ",
2351 absname
, build_string (querystring
));
2353 tem
= Fy_or_n_p (tem
);
2355 tem
= do_yes_or_no_p (tem
);
2358 Fsignal (Qfile_already_exists
,
2359 Fcons (build_string ("File already exists"),
2360 Fcons (absname
, Qnil
)));
2367 statptr
->st_mode
= 0;
2372 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2373 "fCopy file: \nFCopy %s to file: \np\nP",
2374 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2375 If NEWNAME names a directory, copy FILE there.
2376 Signals a `file-already-exists' error if file NEWNAME already exists,
2377 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2378 A number as third arg means request confirmation if NEWNAME already exists.
2379 This is what happens in interactive use with M-x.
2380 Fourth arg KEEP-TIME non-nil means give the new file the same
2381 last-modified time as the old one. (This works on only some systems.)
2382 A prefix arg makes KEEP-TIME non-nil. */)
2383 (file
, newname
, ok_if_already_exists
, keep_time
)
2384 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2387 char buf
[16 * 1024];
2388 struct stat st
, out_st
;
2389 Lisp_Object handler
;
2390 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2391 int count
= SPECPDL_INDEX ();
2392 int input_file_statable_p
;
2393 Lisp_Object encoded_file
, encoded_newname
;
2395 encoded_file
= encoded_newname
= Qnil
;
2396 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2397 CHECK_STRING (file
);
2398 CHECK_STRING (newname
);
2400 if (!NILP (Ffile_directory_p (newname
)))
2401 newname
= Fexpand_file_name (file
, newname
);
2403 newname
= Fexpand_file_name (newname
, Qnil
);
2405 file
= Fexpand_file_name (file
, Qnil
);
2407 /* If the input file name has special constructs in it,
2408 call the corresponding file handler. */
2409 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2410 /* Likewise for output file name. */
2412 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2413 if (!NILP (handler
))
2414 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2415 ok_if_already_exists
, keep_time
));
2417 encoded_file
= ENCODE_FILE (file
);
2418 encoded_newname
= ENCODE_FILE (newname
);
2420 if (NILP (ok_if_already_exists
)
2421 || INTEGERP (ok_if_already_exists
))
2422 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2423 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2424 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2428 if (!CopyFile (SDATA (encoded_file
),
2429 SDATA (encoded_newname
),
2431 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2432 /* CopyFile retains the timestamp by default. */
2433 else if (NILP (keep_time
))
2439 EMACS_GET_TIME (now
);
2440 filename
= SDATA (encoded_newname
);
2442 /* Ensure file is writable while its modified time is set. */
2443 attributes
= GetFileAttributes (filename
);
2444 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2445 if (set_file_times (filename
, now
, now
))
2447 /* Restore original attributes. */
2448 SetFileAttributes (filename
, attributes
);
2449 Fsignal (Qfile_date_error
,
2450 Fcons (build_string ("Cannot set file date"),
2451 Fcons (newname
, Qnil
)));
2453 /* Restore original attributes. */
2454 SetFileAttributes (filename
, attributes
);
2456 #else /* not WINDOWSNT */
2458 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2462 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2464 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2466 /* We can only copy regular files and symbolic links. Other files are not
2468 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2470 #if !defined (DOS_NT) || __DJGPP__ > 1
2471 if (out_st
.st_mode
!= 0
2472 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2475 report_file_error ("Input and output files are the same",
2476 Fcons (file
, Fcons (newname
, Qnil
)));
2480 #if defined (S_ISREG) && defined (S_ISLNK)
2481 if (input_file_statable_p
)
2483 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2485 #if defined (EISDIR)
2486 /* Get a better looking error message. */
2489 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2492 #endif /* S_ISREG && S_ISLNK */
2495 /* Create the copy file with the same record format as the input file */
2496 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2499 /* System's default file type was set to binary by _fmode in emacs.c. */
2500 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2501 #else /* not MSDOS */
2502 ofd
= creat (SDATA (encoded_newname
), 0666);
2503 #endif /* not MSDOS */
2506 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2508 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2512 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2513 if (emacs_write (ofd
, buf
, n
) != n
)
2514 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2517 /* Closing the output clobbers the file times on some systems. */
2518 if (emacs_close (ofd
) < 0)
2519 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2521 if (input_file_statable_p
)
2523 if (!NILP (keep_time
))
2525 EMACS_TIME atime
, mtime
;
2526 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2527 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2528 if (set_file_times (SDATA (encoded_newname
),
2530 Fsignal (Qfile_date_error
,
2531 Fcons (build_string ("Cannot set file date"),
2532 Fcons (newname
, Qnil
)));
2535 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2537 #if defined (__DJGPP__) && __DJGPP__ > 1
2538 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2539 and if it can't, it tells so. Otherwise, under MSDOS we usually
2540 get only the READ bit, which will make the copied file read-only,
2541 so it's better not to chmod at all. */
2542 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2543 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2544 #endif /* DJGPP version 2 or newer */
2549 #endif /* WINDOWSNT */
2551 /* Discard the unwind protects. */
2552 specpdl_ptr
= specpdl
+ count
;
2558 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2559 Smake_directory_internal
, 1, 1, 0,
2560 doc
: /* Create a new directory named DIRECTORY. */)
2562 Lisp_Object directory
;
2564 const unsigned char *dir
;
2565 Lisp_Object handler
;
2566 Lisp_Object encoded_dir
;
2568 CHECK_STRING (directory
);
2569 directory
= Fexpand_file_name (directory
, Qnil
);
2571 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2572 if (!NILP (handler
))
2573 return call2 (handler
, Qmake_directory_internal
, directory
);
2575 encoded_dir
= ENCODE_FILE (directory
);
2577 dir
= SDATA (encoded_dir
);
2580 if (mkdir (dir
) != 0)
2582 if (mkdir (dir
, 0777) != 0)
2584 report_file_error ("Creating directory", Flist (1, &directory
));
2589 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2590 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2592 Lisp_Object directory
;
2594 const unsigned char *dir
;
2595 Lisp_Object handler
;
2596 Lisp_Object encoded_dir
;
2598 CHECK_STRING (directory
);
2599 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2601 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2602 if (!NILP (handler
))
2603 return call2 (handler
, Qdelete_directory
, directory
);
2605 encoded_dir
= ENCODE_FILE (directory
);
2607 dir
= SDATA (encoded_dir
);
2609 if (rmdir (dir
) != 0)
2610 report_file_error ("Removing directory", Flist (1, &directory
));
2615 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2616 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2617 If file has multiple names, it continues to exist with the other names. */)
2619 Lisp_Object filename
;
2621 Lisp_Object handler
;
2622 Lisp_Object encoded_file
;
2623 struct gcpro gcpro1
;
2626 if (!NILP (Ffile_directory_p (filename
)))
2627 Fsignal (Qfile_error
,
2628 Fcons (build_string ("Removing old name: is a directory"),
2629 Fcons (filename
, Qnil
)));
2631 filename
= Fexpand_file_name (filename
, Qnil
);
2633 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2634 if (!NILP (handler
))
2635 return call2 (handler
, Qdelete_file
, filename
);
2637 encoded_file
= ENCODE_FILE (filename
);
2639 if (0 > unlink (SDATA (encoded_file
)))
2640 report_file_error ("Removing old name", Flist (1, &filename
));
2645 internal_delete_file_1 (ignore
)
2651 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2654 internal_delete_file (filename
)
2655 Lisp_Object filename
;
2657 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2658 Qt
, internal_delete_file_1
));
2661 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2662 "fRename file: \nFRename %s to file: \np",
2663 doc
: /* Rename FILE as NEWNAME. Both args strings.
2664 If file has names other than FILE, it continues to have those names.
2665 Signals a `file-already-exists' error if a file NEWNAME already exists
2666 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2667 A number as third arg means request confirmation if NEWNAME already exists.
2668 This is what happens in interactive use with M-x. */)
2669 (file
, newname
, ok_if_already_exists
)
2670 Lisp_Object file
, newname
, ok_if_already_exists
;
2673 Lisp_Object args
[2];
2675 Lisp_Object handler
;
2676 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2677 Lisp_Object encoded_file
, encoded_newname
;
2679 encoded_file
= encoded_newname
= Qnil
;
2680 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2681 CHECK_STRING (file
);
2682 CHECK_STRING (newname
);
2683 file
= Fexpand_file_name (file
, Qnil
);
2684 newname
= Fexpand_file_name (newname
, Qnil
);
2686 /* If the file name has special constructs in it,
2687 call the corresponding file handler. */
2688 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2690 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2691 if (!NILP (handler
))
2692 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2693 file
, newname
, ok_if_already_exists
));
2695 encoded_file
= ENCODE_FILE (file
);
2696 encoded_newname
= ENCODE_FILE (newname
);
2699 /* If the file names are identical but for the case, don't ask for
2700 confirmation: they simply want to change the letter-case of the
2702 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2704 if (NILP (ok_if_already_exists
)
2705 || INTEGERP (ok_if_already_exists
))
2706 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2707 INTEGERP (ok_if_already_exists
), 0, 0);
2709 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2711 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2712 || 0 > unlink (SDATA (encoded_file
)))
2717 Fcopy_file (file
, newname
,
2718 /* We have already prompted if it was an integer,
2719 so don't have copy-file prompt again. */
2720 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2721 Fdelete_file (file
);
2728 report_file_error ("Renaming", Flist (2, args
));
2731 report_file_error ("Renaming", Flist (2, &file
));
2738 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2739 "fAdd name to file: \nFName to add to %s: \np",
2740 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2741 Signals a `file-already-exists' error if a file NEWNAME already exists
2742 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2743 A number as third arg means request confirmation if NEWNAME already exists.
2744 This is what happens in interactive use with M-x. */)
2745 (file
, newname
, ok_if_already_exists
)
2746 Lisp_Object file
, newname
, ok_if_already_exists
;
2749 Lisp_Object args
[2];
2751 Lisp_Object handler
;
2752 Lisp_Object encoded_file
, encoded_newname
;
2753 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2755 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2756 encoded_file
= encoded_newname
= Qnil
;
2757 CHECK_STRING (file
);
2758 CHECK_STRING (newname
);
2759 file
= Fexpand_file_name (file
, Qnil
);
2760 newname
= Fexpand_file_name (newname
, Qnil
);
2762 /* If the file name has special constructs in it,
2763 call the corresponding file handler. */
2764 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2765 if (!NILP (handler
))
2766 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2767 newname
, ok_if_already_exists
));
2769 /* If the new name has special constructs in it,
2770 call the corresponding file handler. */
2771 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2772 if (!NILP (handler
))
2773 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2774 newname
, ok_if_already_exists
));
2776 encoded_file
= ENCODE_FILE (file
);
2777 encoded_newname
= ENCODE_FILE (newname
);
2779 if (NILP (ok_if_already_exists
)
2780 || INTEGERP (ok_if_already_exists
))
2781 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2782 INTEGERP (ok_if_already_exists
), 0, 0);
2784 unlink (SDATA (newname
));
2785 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2790 report_file_error ("Adding new name", Flist (2, args
));
2792 report_file_error ("Adding new name", Flist (2, &file
));
2801 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2802 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2803 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2804 Signals a `file-already-exists' error if a file LINKNAME already exists
2805 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2806 A number as third arg means request confirmation if LINKNAME already exists.
2807 This happens for interactive use with M-x. */)
2808 (filename
, linkname
, ok_if_already_exists
)
2809 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2812 Lisp_Object args
[2];
2814 Lisp_Object handler
;
2815 Lisp_Object encoded_filename
, encoded_linkname
;
2816 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2818 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2819 encoded_filename
= encoded_linkname
= Qnil
;
2820 CHECK_STRING (filename
);
2821 CHECK_STRING (linkname
);
2822 /* If the link target has a ~, we must expand it to get
2823 a truly valid file name. Otherwise, do not expand;
2824 we want to permit links to relative file names. */
2825 if (SREF (filename
, 0) == '~')
2826 filename
= Fexpand_file_name (filename
, Qnil
);
2827 linkname
= Fexpand_file_name (linkname
, Qnil
);
2829 /* If the file name has special constructs in it,
2830 call the corresponding file handler. */
2831 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2832 if (!NILP (handler
))
2833 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2834 linkname
, ok_if_already_exists
));
2836 /* If the new link name has special constructs in it,
2837 call the corresponding file handler. */
2838 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2839 if (!NILP (handler
))
2840 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2841 linkname
, ok_if_already_exists
));
2843 encoded_filename
= ENCODE_FILE (filename
);
2844 encoded_linkname
= ENCODE_FILE (linkname
);
2846 if (NILP (ok_if_already_exists
)
2847 || INTEGERP (ok_if_already_exists
))
2848 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2849 INTEGERP (ok_if_already_exists
), 0, 0);
2850 if (0 > symlink (SDATA (encoded_filename
),
2851 SDATA (encoded_linkname
)))
2853 /* If we didn't complain already, silently delete existing file. */
2854 if (errno
== EEXIST
)
2856 unlink (SDATA (encoded_linkname
));
2857 if (0 <= symlink (SDATA (encoded_filename
),
2858 SDATA (encoded_linkname
)))
2868 report_file_error ("Making symbolic link", Flist (2, args
));
2870 report_file_error ("Making symbolic link", Flist (2, &filename
));
2876 #endif /* S_IFLNK */
2880 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2881 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2882 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2883 If STRING is nil or a null string, the logical name NAME is deleted. */)
2888 CHECK_STRING (name
);
2890 delete_logical_name (SDATA (name
));
2893 CHECK_STRING (string
);
2895 if (SCHARS (string
) == 0)
2896 delete_logical_name (SDATA (name
));
2898 define_logical_name (SDATA (name
), SDATA (string
));
2907 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2908 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2910 Lisp_Object path
, login
;
2914 CHECK_STRING (path
);
2915 CHECK_STRING (login
);
2917 netresult
= netunam (SDATA (path
), SDATA (login
));
2919 if (netresult
== -1)
2924 #endif /* HPUX_NET */
2926 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2928 doc
: /* Return t if file FILENAME specifies an absolute file name.
2929 On Unix, this is a name starting with a `/' or a `~'. */)
2931 Lisp_Object filename
;
2933 const unsigned char *ptr
;
2935 CHECK_STRING (filename
);
2936 ptr
= SDATA (filename
);
2937 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2939 /* ??? This criterion is probably wrong for '<'. */
2940 || index (ptr
, ':') || index (ptr
, '<')
2941 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2945 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2953 /* Return nonzero if file FILENAME exists and can be executed. */
2956 check_executable (filename
)
2960 int len
= strlen (filename
);
2963 if (stat (filename
, &st
) < 0)
2965 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2966 return ((st
.st_mode
& S_IEXEC
) != 0);
2968 return (S_ISREG (st
.st_mode
)
2970 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2971 || stricmp (suffix
, ".exe") == 0
2972 || stricmp (suffix
, ".bat") == 0)
2973 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2974 #endif /* not WINDOWSNT */
2975 #else /* not DOS_NT */
2976 #ifdef HAVE_EUIDACCESS
2977 return (euidaccess (filename
, 1) >= 0);
2979 /* Access isn't quite right because it uses the real uid
2980 and we really want to test with the effective uid.
2981 But Unix doesn't give us a right way to do it. */
2982 return (access (filename
, 1) >= 0);
2984 #endif /* not DOS_NT */
2987 /* Return nonzero if file FILENAME exists and can be written. */
2990 check_writable (filename
)
2995 if (stat (filename
, &st
) < 0)
2997 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2998 #else /* not MSDOS */
2999 #ifdef HAVE_EUIDACCESS
3000 return (euidaccess (filename
, 2) >= 0);
3002 /* Access isn't quite right because it uses the real uid
3003 and we really want to test with the effective uid.
3004 But Unix doesn't give us a right way to do it.
3005 Opening with O_WRONLY could work for an ordinary file,
3006 but would lose for directories. */
3007 return (access (filename
, 2) >= 0);
3009 #endif /* not MSDOS */
3012 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3013 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3014 See also `file-readable-p' and `file-attributes'. */)
3016 Lisp_Object filename
;
3018 Lisp_Object absname
;
3019 Lisp_Object handler
;
3020 struct stat statbuf
;
3022 CHECK_STRING (filename
);
3023 absname
= Fexpand_file_name (filename
, Qnil
);
3025 /* If the file name has special constructs in it,
3026 call the corresponding file handler. */
3027 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3028 if (!NILP (handler
))
3029 return call2 (handler
, Qfile_exists_p
, absname
);
3031 absname
= ENCODE_FILE (absname
);
3033 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3036 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3037 doc
: /* Return t if FILENAME can be executed by you.
3038 For a directory, this means you can access files in that directory. */)
3040 Lisp_Object filename
;
3042 Lisp_Object absname
;
3043 Lisp_Object handler
;
3045 CHECK_STRING (filename
);
3046 absname
= Fexpand_file_name (filename
, Qnil
);
3048 /* If the file name has special constructs in it,
3049 call the corresponding file handler. */
3050 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3051 if (!NILP (handler
))
3052 return call2 (handler
, Qfile_executable_p
, absname
);
3054 absname
= ENCODE_FILE (absname
);
3056 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3059 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3060 doc
: /* Return t if file FILENAME exists and you can read it.
3061 See also `file-exists-p' and `file-attributes'. */)
3063 Lisp_Object filename
;
3065 Lisp_Object absname
;
3066 Lisp_Object handler
;
3069 struct stat statbuf
;
3071 CHECK_STRING (filename
);
3072 absname
= Fexpand_file_name (filename
, Qnil
);
3074 /* If the file name has special constructs in it,
3075 call the corresponding file handler. */
3076 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3077 if (!NILP (handler
))
3078 return call2 (handler
, Qfile_readable_p
, absname
);
3080 absname
= ENCODE_FILE (absname
);
3082 #if defined(DOS_NT) || defined(macintosh)
3083 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3085 if (access (SDATA (absname
), 0) == 0)
3088 #else /* not DOS_NT and not macintosh */
3090 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3091 /* Opening a fifo without O_NONBLOCK can wait.
3092 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3093 except in the case of a fifo, on a system which handles it. */
3094 desc
= stat (SDATA (absname
), &statbuf
);
3097 if (S_ISFIFO (statbuf
.st_mode
))
3098 flags
|= O_NONBLOCK
;
3100 desc
= emacs_open (SDATA (absname
), flags
, 0);
3105 #endif /* not DOS_NT and not macintosh */
3108 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3110 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3111 doc
: /* Return t if file FILENAME can be written or created by you. */)
3113 Lisp_Object filename
;
3115 Lisp_Object absname
, dir
, encoded
;
3116 Lisp_Object handler
;
3117 struct stat statbuf
;
3119 CHECK_STRING (filename
);
3120 absname
= Fexpand_file_name (filename
, Qnil
);
3122 /* If the file name has special constructs in it,
3123 call the corresponding file handler. */
3124 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3125 if (!NILP (handler
))
3126 return call2 (handler
, Qfile_writable_p
, absname
);
3128 encoded
= ENCODE_FILE (absname
);
3129 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3130 return (check_writable (SDATA (encoded
))
3133 dir
= Ffile_name_directory (absname
);
3136 dir
= Fdirectory_file_name (dir
);
3140 dir
= Fdirectory_file_name (dir
);
3143 dir
= ENCODE_FILE (dir
);
3145 /* The read-only attribute of the parent directory doesn't affect
3146 whether a file or directory can be created within it. Some day we
3147 should check ACLs though, which do affect this. */
3148 if (stat (SDATA (dir
), &statbuf
) < 0)
3150 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3152 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3157 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3158 doc
: /* Access file FILENAME, and get an error if that does not work.
3159 The second argument STRING is used in the error message.
3160 If there is no error, we return nil. */)
3162 Lisp_Object filename
, string
;
3164 Lisp_Object handler
, encoded_filename
, absname
;
3167 CHECK_STRING (filename
);
3168 absname
= Fexpand_file_name (filename
, Qnil
);
3170 CHECK_STRING (string
);
3172 /* If the file name has special constructs in it,
3173 call the corresponding file handler. */
3174 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3175 if (!NILP (handler
))
3176 return call3 (handler
, Qaccess_file
, absname
, string
);
3178 encoded_filename
= ENCODE_FILE (absname
);
3180 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3182 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3188 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3189 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3190 The value is the link target, as a string.
3191 Otherwise returns nil. */)
3193 Lisp_Object filename
;
3195 Lisp_Object handler
;
3197 CHECK_STRING (filename
);
3198 filename
= Fexpand_file_name (filename
, Qnil
);
3200 /* If the file name has special constructs in it,
3201 call the corresponding file handler. */
3202 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3203 if (!NILP (handler
))
3204 return call2 (handler
, Qfile_symlink_p
, filename
);
3213 filename
= ENCODE_FILE (filename
);
3220 buf
= (char *) xrealloc (buf
, bufsize
);
3221 bzero (buf
, bufsize
);
3224 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3228 /* HP-UX reports ERANGE if buffer is too small. */
3229 if (errno
== ERANGE
)
3239 while (valsize
>= bufsize
);
3241 val
= make_string (buf
, valsize
);
3242 if (buf
[0] == '/' && index (buf
, ':'))
3243 val
= concat2 (build_string ("/:"), val
);
3245 val
= DECODE_FILE (val
);
3248 #else /* not S_IFLNK */
3250 #endif /* not S_IFLNK */
3253 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3254 doc
: /* Return t if FILENAME names an existing directory.
3255 Symbolic links to directories count as directories.
3256 See `file-symlink-p' to distinguish symlinks. */)
3258 Lisp_Object filename
;
3260 register Lisp_Object absname
;
3262 Lisp_Object handler
;
3264 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3266 /* If the file name has special constructs in it,
3267 call the corresponding file handler. */
3268 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3269 if (!NILP (handler
))
3270 return call2 (handler
, Qfile_directory_p
, absname
);
3272 absname
= ENCODE_FILE (absname
);
3274 if (stat (SDATA (absname
), &st
) < 0)
3276 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3279 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3280 doc
: /* Return t if file FILENAME names a directory you can open.
3281 For the value to be t, FILENAME must specify the name of a directory as a file,
3282 and the directory must allow you to open files in it. In order to use a
3283 directory as a buffer's current directory, this predicate must return true.
3284 A directory name spec may be given instead; then the value is t
3285 if the directory so specified exists and really is a readable and
3286 searchable directory. */)
3288 Lisp_Object filename
;
3290 Lisp_Object handler
;
3292 struct gcpro gcpro1
;
3294 /* If the file name has special constructs in it,
3295 call the corresponding file handler. */
3296 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3297 if (!NILP (handler
))
3298 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3301 tem
= (NILP (Ffile_directory_p (filename
))
3302 || NILP (Ffile_executable_p (filename
)));
3304 return tem
? Qnil
: Qt
;
3307 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3308 doc
: /* Return t if file FILENAME is the name of a regular file.
3309 This is the sort of file that holds an ordinary stream of data bytes. */)
3311 Lisp_Object filename
;
3313 register Lisp_Object absname
;
3315 Lisp_Object handler
;
3317 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3319 /* If the file name has special constructs in it,
3320 call the corresponding file handler. */
3321 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3322 if (!NILP (handler
))
3323 return call2 (handler
, Qfile_regular_p
, absname
);
3325 absname
= ENCODE_FILE (absname
);
3330 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3332 /* Tell stat to use expensive method to get accurate info. */
3333 Vw32_get_true_file_attributes
= Qt
;
3334 result
= stat (SDATA (absname
), &st
);
3335 Vw32_get_true_file_attributes
= tem
;
3339 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3342 if (stat (SDATA (absname
), &st
) < 0)
3344 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3348 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3349 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
3351 Lisp_Object filename
;
3353 Lisp_Object absname
;
3355 Lisp_Object handler
;
3357 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3359 /* If the file name has special constructs in it,
3360 call the corresponding file handler. */
3361 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3362 if (!NILP (handler
))
3363 return call2 (handler
, Qfile_modes
, absname
);
3365 absname
= ENCODE_FILE (absname
);
3367 if (stat (SDATA (absname
), &st
) < 0)
3369 #if defined (MSDOS) && __DJGPP__ < 2
3370 if (check_executable (SDATA (absname
)))
3371 st
.st_mode
|= S_IEXEC
;
3372 #endif /* MSDOS && __DJGPP__ < 2 */
3374 return make_number (st
.st_mode
& 07777);
3377 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3378 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3379 Only the 12 low bits of MODE are used. */)
3381 Lisp_Object filename
, mode
;
3383 Lisp_Object absname
, encoded_absname
;
3384 Lisp_Object handler
;
3386 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3387 CHECK_NUMBER (mode
);
3389 /* If the file name has special constructs in it,
3390 call the corresponding file handler. */
3391 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3392 if (!NILP (handler
))
3393 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3395 encoded_absname
= ENCODE_FILE (absname
);
3397 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3398 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3403 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3404 doc
: /* Set the file permission bits for newly created files.
3405 The argument MODE should be an integer; only the low 9 bits are used.
3406 This setting is inherited by subprocesses. */)
3410 CHECK_NUMBER (mode
);
3412 umask ((~ XINT (mode
)) & 0777);
3417 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3418 doc
: /* Return the default file protection for created files.
3419 The value is an integer. */)
3425 realmask
= umask (0);
3428 XSETINT (value
, (~ realmask
) & 0777);
3438 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3439 doc
: /* Tell Unix to finish all pending disk updates. */)
3448 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3449 doc
: /* Return t if file FILE1 is newer than file FILE2.
3450 If FILE1 does not exist, the answer is nil;
3451 otherwise, if FILE2 does not exist, the answer is t. */)
3453 Lisp_Object file1
, file2
;
3455 Lisp_Object absname1
, absname2
;
3458 Lisp_Object handler
;
3459 struct gcpro gcpro1
, gcpro2
;
3461 CHECK_STRING (file1
);
3462 CHECK_STRING (file2
);
3465 GCPRO2 (absname1
, file2
);
3466 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3467 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3470 /* If the file name has special constructs in it,
3471 call the corresponding file handler. */
3472 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3474 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3475 if (!NILP (handler
))
3476 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3478 GCPRO2 (absname1
, absname2
);
3479 absname1
= ENCODE_FILE (absname1
);
3480 absname2
= ENCODE_FILE (absname2
);
3483 if (stat (SDATA (absname1
), &st
) < 0)
3486 mtime1
= st
.st_mtime
;
3488 if (stat (SDATA (absname2
), &st
) < 0)
3491 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3495 Lisp_Object Qfind_buffer_file_type
;
3498 #ifndef READ_BUF_SIZE
3499 #define READ_BUF_SIZE (64 << 10)
3502 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3504 /* This function is called after Lisp functions to decide a coding
3505 system are called, or when they cause an error. Before they are
3506 called, the current buffer is set unibyte and it contains only a
3507 newly inserted text (thus the buffer was empty before the
3510 The functions may set markers, overlays, text properties, or even
3511 alter the buffer contents, change the current buffer.
3513 Here, we reset all those changes by:
3514 o set back the current buffer.
3515 o move all markers and overlays to BEG.
3516 o remove all text properties.
3517 o set back the buffer multibyteness. */
3520 decide_coding_unwind (unwind_data
)
3521 Lisp_Object unwind_data
;
3523 Lisp_Object multibyte
, undo_list
, buffer
;
3525 multibyte
= XCAR (unwind_data
);
3526 unwind_data
= XCDR (unwind_data
);
3527 undo_list
= XCAR (unwind_data
);
3528 buffer
= XCDR (unwind_data
);
3530 if (current_buffer
!= XBUFFER (buffer
))
3531 set_buffer_internal (XBUFFER (buffer
));
3532 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3533 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3534 BUF_INTERVALS (current_buffer
) = 0;
3535 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3537 /* Now we are safe to change the buffer's multibyteness directly. */
3538 current_buffer
->enable_multibyte_characters
= multibyte
;
3539 current_buffer
->undo_list
= undo_list
;
3545 /* Used to pass values from insert-file-contents to read_non_regular. */
3547 static int non_regular_fd
;
3548 static int non_regular_inserted
;
3549 static int non_regular_nbytes
;
3552 /* Read from a non-regular file.
3553 Read non_regular_trytry bytes max from non_regular_fd.
3554 Non_regular_inserted specifies where to put the read bytes.
3555 Value is the number of bytes read. */
3564 nbytes
= emacs_read (non_regular_fd
,
3565 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3566 non_regular_nbytes
);
3568 return make_number (nbytes
);
3572 /* Condition-case handler used when reading from non-regular files
3573 in insert-file-contents. */
3576 read_non_regular_quit ()
3582 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3584 doc
: /* Insert contents of file FILENAME after point.
3585 Returns list of absolute file name and number of characters inserted.
3586 If second argument VISIT is non-nil, the buffer's visited filename
3587 and last save file modtime are set, and it is marked unmodified.
3588 If visiting and the file does not exist, visiting is completed
3589 before the error is signaled.
3590 The optional third and fourth arguments BEG and END
3591 specify what portion of the file to insert.
3592 These arguments count bytes in the file, not characters in the buffer.
3593 If VISIT is non-nil, BEG and END must be nil.
3595 If optional fifth argument REPLACE is non-nil,
3596 it means replace the current buffer contents (in the accessible portion)
3597 with the file contents. This is better than simply deleting and inserting
3598 the whole thing because (1) it preserves some marker positions
3599 and (2) it puts less data in the undo list.
3600 When REPLACE is non-nil, the value is the number of characters actually read,
3601 which is often less than the number of characters to be read.
3603 This does code conversion according to the value of
3604 `coding-system-for-read' or `file-coding-system-alist',
3605 and sets the variable `last-coding-system-used' to the coding system
3607 (filename
, visit
, beg
, end
, replace
)
3608 Lisp_Object filename
, visit
, beg
, end
, replace
;
3613 register int how_much
;
3614 register int unprocessed
;
3615 int count
= SPECPDL_INDEX ();
3616 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3617 Lisp_Object handler
, val
, insval
, orig_filename
;
3620 int not_regular
= 0;
3621 unsigned char read_buf
[READ_BUF_SIZE
];
3622 struct coding_system coding
;
3623 unsigned char buffer
[1 << 14];
3624 int replace_handled
= 0;
3625 int set_coding_system
= 0;
3626 int coding_system_decided
= 0;
3629 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3630 error ("Cannot do file visiting in an indirect buffer");
3632 if (!NILP (current_buffer
->read_only
))
3633 Fbarf_if_buffer_read_only ();
3637 orig_filename
= Qnil
;
3639 GCPRO4 (filename
, val
, p
, orig_filename
);
3641 CHECK_STRING (filename
);
3642 filename
= Fexpand_file_name (filename
, Qnil
);
3644 /* If the file name has special constructs in it,
3645 call the corresponding file handler. */
3646 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3647 if (!NILP (handler
))
3649 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3650 visit
, beg
, end
, replace
);
3651 if (CONSP (val
) && CONSP (XCDR (val
)))
3652 inserted
= XINT (XCAR (XCDR (val
)));
3656 orig_filename
= filename
;
3657 filename
= ENCODE_FILE (filename
);
3663 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3665 /* Tell stat to use expensive method to get accurate info. */
3666 Vw32_get_true_file_attributes
= Qt
;
3667 total
= stat (SDATA (filename
), &st
);
3668 Vw32_get_true_file_attributes
= tem
;
3673 if (stat (SDATA (filename
), &st
) < 0)
3675 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3676 || fstat (fd
, &st
) < 0)
3677 #endif /* not APOLLO */
3678 #endif /* WINDOWSNT */
3680 if (fd
>= 0) emacs_close (fd
);
3683 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3686 if (!NILP (Vcoding_system_for_read
))
3687 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3692 /* This code will need to be changed in order to work on named
3693 pipes, and it's probably just not worth it. So we should at
3694 least signal an error. */
3695 if (!S_ISREG (st
.st_mode
))
3702 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3703 Fsignal (Qfile_error
,
3704 Fcons (build_string ("not a regular file"),
3705 Fcons (orig_filename
, Qnil
)));
3710 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3713 /* Replacement should preserve point as it preserves markers. */
3714 if (!NILP (replace
))
3715 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3717 record_unwind_protect (close_file_unwind
, make_number (fd
));
3719 /* Supposedly happens on VMS. */
3720 /* Can happen on any platform that uses long as type of off_t, but allows
3721 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3722 give a message suitable for the latter case. */
3723 if (! not_regular
&& st
.st_size
< 0)
3724 error ("Maximum buffer size exceeded");
3726 /* Prevent redisplay optimizations. */
3727 current_buffer
->clip_changed
= 1;
3731 if (!NILP (beg
) || !NILP (end
))
3732 error ("Attempt to visit less than an entire file");
3733 if (BEG
< Z
&& NILP (replace
))
3734 error ("Cannot do file visiting in a non-empty buffer");
3740 XSETFASTINT (beg
, 0);
3748 XSETINT (end
, st
.st_size
);
3750 /* Arithmetic overflow can occur if an Emacs integer cannot
3751 represent the file size, or if the calculations below
3752 overflow. The calculations below double the file size
3753 twice, so check that it can be multiplied by 4 safely. */
3754 if (XINT (end
) != st
.st_size
3755 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3756 error ("Maximum buffer size exceeded");
3758 /* The file size returned from stat may be zero, but data
3759 may be readable nonetheless, for example when this is a
3760 file in the /proc filesystem. */
3761 if (st
.st_size
== 0)
3762 XSETINT (end
, READ_BUF_SIZE
);
3768 /* Decide the coding system to use for reading the file now
3769 because we can't use an optimized method for handling
3770 `coding:' tag if the current buffer is not empty. */
3774 if (!NILP (Vcoding_system_for_read
))
3775 val
= Vcoding_system_for_read
;
3776 else if (! NILP (replace
))
3777 /* In REPLACE mode, we can use the same coding system
3778 that was used to visit the file. */
3779 val
= current_buffer
->buffer_file_coding_system
;
3782 /* Don't try looking inside a file for a coding system
3783 specification if it is not seekable. */
3784 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3786 /* Find a coding system specified in the heading two
3787 lines or in the tailing several lines of the file.
3788 We assume that the 1K-byte and 3K-byte for heading
3789 and tailing respectively are sufficient for this
3793 if (st
.st_size
<= (1024 * 4))
3794 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3797 nread
= emacs_read (fd
, read_buf
, 1024);
3800 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3801 report_file_error ("Setting file position",
3802 Fcons (orig_filename
, Qnil
));
3803 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3808 error ("IO error reading %s: %s",
3809 SDATA (orig_filename
), emacs_strerror (errno
));
3812 struct buffer
*prev
= current_buffer
;
3816 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3818 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3819 buf
= XBUFFER (buffer
);
3821 buf
->directory
= current_buffer
->directory
;
3822 buf
->read_only
= Qnil
;
3823 buf
->filename
= Qnil
;
3824 buf
->undo_list
= Qt
;
3825 buf
->overlays_before
= Qnil
;
3826 buf
->overlays_after
= Qnil
;
3828 set_buffer_internal (buf
);
3830 buf
->enable_multibyte_characters
= Qnil
;
3832 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3833 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3834 val
= call2 (Vset_auto_coding_function
,
3835 filename
, make_number (nread
));
3836 set_buffer_internal (prev
);
3838 /* Discard the unwind protect for recovering the
3842 /* Rewind the file for the actual read done later. */
3843 if (lseek (fd
, 0, 0) < 0)
3844 report_file_error ("Setting file position",
3845 Fcons (orig_filename
, Qnil
));
3851 /* If we have not yet decided a coding system, check
3852 file-coding-system-alist. */
3853 Lisp_Object args
[6], coding_systems
;
3855 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3856 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3857 coding_systems
= Ffind_operation_coding_system (6, args
);
3858 if (CONSP (coding_systems
))
3859 val
= XCAR (coding_systems
);
3863 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3864 /* Ensure we set Vlast_coding_system_used. */
3865 set_coding_system
= 1;
3867 if (NILP (current_buffer
->enable_multibyte_characters
)
3869 /* We must suppress all character code conversion except for
3870 end-of-line conversion. */
3871 setup_raw_text_coding_system (&coding
);
3873 coding
.src_multibyte
= 0;
3874 coding
.dst_multibyte
3875 = !NILP (current_buffer
->enable_multibyte_characters
);
3876 coding_system_decided
= 1;
3879 /* If requested, replace the accessible part of the buffer
3880 with the file contents. Avoid replacing text at the
3881 beginning or end of the buffer that matches the file contents;
3882 that preserves markers pointing to the unchanged parts.
3884 Here we implement this feature in an optimized way
3885 for the case where code conversion is NOT needed.
3886 The following if-statement handles the case of conversion
3887 in a less optimal way.
3889 If the code conversion is "automatic" then we try using this
3890 method and hope for the best.
3891 But if we discover the need for conversion, we give up on this method
3892 and let the following if-statement handle the replace job. */
3895 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3897 /* same_at_start and same_at_end count bytes,
3898 because file access counts bytes
3899 and BEG and END count bytes. */
3900 int same_at_start
= BEGV_BYTE
;
3901 int same_at_end
= ZV_BYTE
;
3903 /* There is still a possibility we will find the need to do code
3904 conversion. If that happens, we set this variable to 1 to
3905 give up on handling REPLACE in the optimized way. */
3906 int giveup_match_end
= 0;
3908 if (XINT (beg
) != 0)
3910 if (lseek (fd
, XINT (beg
), 0) < 0)
3911 report_file_error ("Setting file position",
3912 Fcons (orig_filename
, Qnil
));
3917 /* Count how many chars at the start of the file
3918 match the text at the beginning of the buffer. */
3923 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3925 error ("IO error reading %s: %s",
3926 SDATA (orig_filename
), emacs_strerror (errno
));
3927 else if (nread
== 0)
3930 if (coding
.type
== coding_type_undecided
)
3931 detect_coding (&coding
, buffer
, nread
);
3932 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
3933 /* We found that the file should be decoded somehow.
3934 Let's give up here. */
3936 giveup_match_end
= 1;
3940 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3941 detect_eol (&coding
, buffer
, nread
);
3942 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3943 && coding
.eol_type
!= CODING_EOL_LF
)
3944 /* We found that the format of eol should be decoded.
3945 Let's give up here. */
3947 giveup_match_end
= 1;
3952 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3953 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3954 same_at_start
++, bufpos
++;
3955 /* If we found a discrepancy, stop the scan.
3956 Otherwise loop around and scan the next bufferful. */
3957 if (bufpos
!= nread
)
3961 /* If the file matches the buffer completely,
3962 there's no need to replace anything. */
3963 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3967 /* Truncate the buffer to the size of the file. */
3968 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3973 /* Count how many chars at the end of the file
3974 match the text at the end of the buffer. But, if we have
3975 already found that decoding is necessary, don't waste time. */
3976 while (!giveup_match_end
)
3978 int total_read
, nread
, bufpos
, curpos
, trial
;
3980 /* At what file position are we now scanning? */
3981 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3982 /* If the entire file matches the buffer tail, stop the scan. */
3985 /* How much can we scan in the next step? */
3986 trial
= min (curpos
, sizeof buffer
);
3987 if (lseek (fd
, curpos
- trial
, 0) < 0)
3988 report_file_error ("Setting file position",
3989 Fcons (orig_filename
, Qnil
));
3991 total_read
= nread
= 0;
3992 while (total_read
< trial
)
3994 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3996 error ("IO error reading %s: %s",
3997 SDATA (orig_filename
), emacs_strerror (errno
));
3998 else if (nread
== 0)
4000 total_read
+= nread
;
4003 /* Scan this bufferful from the end, comparing with
4004 the Emacs buffer. */
4005 bufpos
= total_read
;
4007 /* Compare with same_at_start to avoid counting some buffer text
4008 as matching both at the file's beginning and at the end. */
4009 while (bufpos
> 0 && same_at_end
> same_at_start
4010 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4011 same_at_end
--, bufpos
--;
4013 /* If we found a discrepancy, stop the scan.
4014 Otherwise loop around and scan the preceding bufferful. */
4017 /* If this discrepancy is because of code conversion,
4018 we cannot use this method; giveup and try the other. */
4019 if (same_at_end
> same_at_start
4020 && FETCH_BYTE (same_at_end
- 1) >= 0200
4021 && ! NILP (current_buffer
->enable_multibyte_characters
)
4022 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4023 giveup_match_end
= 1;
4032 if (! giveup_match_end
)
4036 /* We win! We can handle REPLACE the optimized way. */
4038 /* Extend the start of non-matching text area to multibyte
4039 character boundary. */
4040 if (! NILP (current_buffer
->enable_multibyte_characters
))
4041 while (same_at_start
> BEGV_BYTE
4042 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4045 /* Extend the end of non-matching text area to multibyte
4046 character boundary. */
4047 if (! NILP (current_buffer
->enable_multibyte_characters
))
4048 while (same_at_end
< ZV_BYTE
4049 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4052 /* Don't try to reuse the same piece of text twice. */
4053 overlap
= (same_at_start
- BEGV_BYTE
4054 - (same_at_end
+ st
.st_size
- ZV
));
4056 same_at_end
+= overlap
;
4058 /* Arrange to read only the nonmatching middle part of the file. */
4059 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4060 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4062 del_range_byte (same_at_start
, same_at_end
, 0);
4063 /* Insert from the file at the proper position. */
4064 temp
= BYTE_TO_CHAR (same_at_start
);
4065 SET_PT_BOTH (temp
, same_at_start
);
4067 /* If display currently starts at beginning of line,
4068 keep it that way. */
4069 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4070 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4072 replace_handled
= 1;
4076 /* If requested, replace the accessible part of the buffer
4077 with the file contents. Avoid replacing text at the
4078 beginning or end of the buffer that matches the file contents;
4079 that preserves markers pointing to the unchanged parts.
4081 Here we implement this feature for the case where code conversion
4082 is needed, in a simple way that needs a lot of memory.
4083 The preceding if-statement handles the case of no conversion
4084 in a more optimized way. */
4085 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4087 int same_at_start
= BEGV_BYTE
;
4088 int same_at_end
= ZV_BYTE
;
4091 /* Make sure that the gap is large enough. */
4092 int bufsize
= 2 * st
.st_size
;
4093 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4096 /* First read the whole file, performing code conversion into
4097 CONVERSION_BUFFER. */
4099 if (lseek (fd
, XINT (beg
), 0) < 0)
4101 xfree (conversion_buffer
);
4102 report_file_error ("Setting file position",
4103 Fcons (orig_filename
, Qnil
));
4106 total
= st
.st_size
; /* Total bytes in the file. */
4107 how_much
= 0; /* Bytes read from file so far. */
4108 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4109 unprocessed
= 0; /* Bytes not processed in previous loop. */
4111 while (how_much
< total
)
4113 /* try is reserved in some compilers (Microsoft C) */
4114 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4115 unsigned char *destination
= read_buf
+ unprocessed
;
4118 /* Allow quitting out of the actual I/O. */
4121 this = emacs_read (fd
, destination
, trytry
);
4124 if (this < 0 || this + unprocessed
== 0)
4132 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4134 int require
, result
;
4136 this += unprocessed
;
4138 /* If we are using more space than estimated,
4139 make CONVERSION_BUFFER bigger. */
4140 require
= decoding_buffer_size (&coding
, this);
4141 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4143 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4144 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4147 /* Convert this batch with results in CONVERSION_BUFFER. */
4148 if (how_much
>= total
) /* This is the last block. */
4149 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4150 if (coding
.composing
!= COMPOSITION_DISABLED
)
4151 coding_allocate_composition_data (&coding
, BEGV
);
4152 result
= decode_coding (&coding
, read_buf
,
4153 conversion_buffer
+ inserted
,
4154 this, bufsize
- inserted
);
4156 /* Save for next iteration whatever we didn't convert. */
4157 unprocessed
= this - coding
.consumed
;
4158 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4159 if (!NILP (current_buffer
->enable_multibyte_characters
))
4160 this = coding
.produced
;
4162 this = str_as_unibyte (conversion_buffer
+ inserted
,
4169 /* At this point, INSERTED is how many characters (i.e. bytes)
4170 are present in CONVERSION_BUFFER.
4171 HOW_MUCH should equal TOTAL,
4172 or should be <= 0 if we couldn't read the file. */
4176 xfree (conversion_buffer
);
4179 error ("IO error reading %s: %s",
4180 SDATA (orig_filename
), emacs_strerror (errno
));
4181 else if (how_much
== -2)
4182 error ("maximum buffer size exceeded");
4185 /* Compare the beginning of the converted file
4186 with the buffer text. */
4189 while (bufpos
< inserted
&& same_at_start
< same_at_end
4190 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4191 same_at_start
++, bufpos
++;
4193 /* If the file matches the buffer completely,
4194 there's no need to replace anything. */
4196 if (bufpos
== inserted
)
4198 xfree (conversion_buffer
);
4201 /* Truncate the buffer to the size of the file. */
4202 del_range_byte (same_at_start
, same_at_end
, 0);
4207 /* Extend the start of non-matching text area to multibyte
4208 character boundary. */
4209 if (! NILP (current_buffer
->enable_multibyte_characters
))
4210 while (same_at_start
> BEGV_BYTE
4211 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4214 /* Scan this bufferful from the end, comparing with
4215 the Emacs buffer. */
4218 /* Compare with same_at_start to avoid counting some buffer text
4219 as matching both at the file's beginning and at the end. */
4220 while (bufpos
> 0 && same_at_end
> same_at_start
4221 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4222 same_at_end
--, bufpos
--;
4224 /* Extend the end of non-matching text area to multibyte
4225 character boundary. */
4226 if (! NILP (current_buffer
->enable_multibyte_characters
))
4227 while (same_at_end
< ZV_BYTE
4228 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4231 /* Don't try to reuse the same piece of text twice. */
4232 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4234 same_at_end
+= overlap
;
4236 /* If display currently starts at beginning of line,
4237 keep it that way. */
4238 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4239 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4241 /* Replace the chars that we need to replace,
4242 and update INSERTED to equal the number of bytes
4243 we are taking from the file. */
4244 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4246 if (same_at_end
!= same_at_start
)
4248 del_range_byte (same_at_start
, same_at_end
, 0);
4250 same_at_start
= GPT_BYTE
;
4254 temp
= BYTE_TO_CHAR (same_at_start
);
4256 /* Insert from the file at the proper position. */
4257 SET_PT_BOTH (temp
, same_at_start
);
4258 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
4260 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4261 coding_restore_composition (&coding
, Fcurrent_buffer ());
4262 coding_free_composition_data (&coding
);
4264 /* Set `inserted' to the number of inserted characters. */
4265 inserted
= PT
- temp
;
4267 xfree (conversion_buffer
);
4276 register Lisp_Object temp
;
4278 total
= XINT (end
) - XINT (beg
);
4280 /* Make sure point-max won't overflow after this insertion. */
4281 XSETINT (temp
, total
);
4282 if (total
!= XINT (temp
))
4283 error ("Maximum buffer size exceeded");
4286 /* For a special file, all we can do is guess. */
4287 total
= READ_BUF_SIZE
;
4289 if (NILP (visit
) && total
> 0)
4290 prepare_to_modify_buffer (PT
, PT
, NULL
);
4293 if (GAP_SIZE
< total
)
4294 make_gap (total
- GAP_SIZE
);
4296 if (XINT (beg
) != 0 || !NILP (replace
))
4298 if (lseek (fd
, XINT (beg
), 0) < 0)
4299 report_file_error ("Setting file position",
4300 Fcons (orig_filename
, Qnil
));
4303 /* In the following loop, HOW_MUCH contains the total bytes read so
4304 far for a regular file, and not changed for a special file. But,
4305 before exiting the loop, it is set to a negative value if I/O
4309 /* Total bytes inserted. */
4312 /* Here, we don't do code conversion in the loop. It is done by
4313 code_convert_region after all data are read into the buffer. */
4315 int gap_size
= GAP_SIZE
;
4317 while (how_much
< total
)
4319 /* try is reserved in some compilers (Microsoft C) */
4320 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4327 /* Maybe make more room. */
4328 if (gap_size
< trytry
)
4330 make_gap (total
- gap_size
);
4331 gap_size
= GAP_SIZE
;
4334 /* Read from the file, capturing `quit'. When an
4335 error occurs, end the loop, and arrange for a quit
4336 to be signaled after decoding the text we read. */
4337 non_regular_fd
= fd
;
4338 non_regular_inserted
= inserted
;
4339 non_regular_nbytes
= trytry
;
4340 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4341 read_non_regular_quit
);
4352 /* Allow quitting out of the actual I/O. We don't make text
4353 part of the buffer until all the reading is done, so a C-g
4354 here doesn't do any harm. */
4357 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4369 /* For a regular file, where TOTAL is the real size,
4370 count HOW_MUCH to compare with it.
4371 For a special file, where TOTAL is just a buffer size,
4372 so don't bother counting in HOW_MUCH.
4373 (INSERTED is where we count the number of characters inserted.) */
4380 /* Make the text read part of the buffer. */
4381 GAP_SIZE
-= inserted
;
4383 GPT_BYTE
+= inserted
;
4385 ZV_BYTE
+= inserted
;
4390 /* Put an anchor to ensure multi-byte form ends at gap. */
4395 /* Discard the unwind protect for closing the file. */
4399 error ("IO error reading %s: %s",
4400 SDATA (orig_filename
), emacs_strerror (errno
));
4404 if (! coding_system_decided
)
4406 /* The coding system is not yet decided. Decide it by an
4407 optimized method for handling `coding:' tag.
4409 Note that we can get here only if the buffer was empty
4410 before the insertion. */
4414 if (!NILP (Vcoding_system_for_read
))
4415 val
= Vcoding_system_for_read
;
4418 /* Since we are sure that the current buffer was empty
4419 before the insertion, we can toggle
4420 enable-multibyte-characters directly here without taking
4421 care of marker adjustment and byte combining problem. By
4422 this way, we can run Lisp program safely before decoding
4423 the inserted text. */
4424 Lisp_Object unwind_data
;
4425 int count
= SPECPDL_INDEX ();
4427 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4428 Fcons (current_buffer
->undo_list
,
4429 Fcurrent_buffer ()));
4430 current_buffer
->enable_multibyte_characters
= Qnil
;
4431 current_buffer
->undo_list
= Qt
;
4432 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4434 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4436 val
= call2 (Vset_auto_coding_function
,
4437 filename
, make_number (inserted
));
4442 /* If the coding system is not yet decided, check
4443 file-coding-system-alist. */
4444 Lisp_Object args
[6], coding_systems
;
4446 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4447 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4448 coding_systems
= Ffind_operation_coding_system (6, args
);
4449 if (CONSP (coding_systems
))
4450 val
= XCAR (coding_systems
);
4453 unbind_to (count
, Qnil
);
4454 inserted
= Z_BYTE
- BEG_BYTE
;
4457 /* The following kludgy code is to avoid some compiler bug.
4459 setup_coding_system (val, &coding);
4462 struct coding_system temp_coding
;
4463 setup_coding_system (val
, &temp_coding
);
4464 bcopy (&temp_coding
, &coding
, sizeof coding
);
4466 /* Ensure we set Vlast_coding_system_used. */
4467 set_coding_system
= 1;
4469 if (NILP (current_buffer
->enable_multibyte_characters
)
4471 /* We must suppress all character code conversion except for
4472 end-of-line conversion. */
4473 setup_raw_text_coding_system (&coding
);
4474 coding
.src_multibyte
= 0;
4475 coding
.dst_multibyte
4476 = !NILP (current_buffer
->enable_multibyte_characters
);
4480 /* Can't do this if part of the buffer might be preserved. */
4482 && (coding
.type
== coding_type_no_conversion
4483 || coding
.type
== coding_type_raw_text
))
4485 /* Visiting a file with these coding system makes the buffer
4487 current_buffer
->enable_multibyte_characters
= Qnil
;
4488 coding
.dst_multibyte
= 0;
4491 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4493 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4495 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4497 inserted
= coding
.produced_char
;
4500 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4504 /* Now INSERTED is measured in characters. */
4507 /* Use the conversion type to determine buffer-file-type
4508 (find-buffer-file-type is now used to help determine the
4510 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4511 || coding
.eol_type
== CODING_EOL_LF
)
4512 && ! CODING_REQUIRE_DECODING (&coding
))
4513 current_buffer
->buffer_file_type
= Qt
;
4515 current_buffer
->buffer_file_type
= Qnil
;
4522 if (!EQ (current_buffer
->undo_list
, Qt
))
4523 current_buffer
->undo_list
= Qnil
;
4525 stat (SDATA (filename
), &st
);
4530 current_buffer
->modtime
= st
.st_mtime
;
4531 current_buffer
->filename
= orig_filename
;
4534 SAVE_MODIFF
= MODIFF
;
4535 current_buffer
->auto_save_modified
= MODIFF
;
4536 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4537 #ifdef CLASH_DETECTION
4540 if (!NILP (current_buffer
->file_truename
))
4541 unlock_file (current_buffer
->file_truename
);
4542 unlock_file (filename
);
4544 #endif /* CLASH_DETECTION */
4546 Fsignal (Qfile_error
,
4547 Fcons (build_string ("not a regular file"),
4548 Fcons (orig_filename
, Qnil
)));
4551 if (set_coding_system
)
4552 Vlast_coding_system_used
= coding
.symbol
;
4554 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4556 insval
= call1 (Qafter_insert_file_set_coding
, make_number (inserted
));
4557 if (! NILP (insval
))
4559 CHECK_NUMBER (insval
);
4560 inserted
= XFASTINT (insval
);
4564 /* Decode file format */
4567 int empty_undo_list_p
= 0;
4569 /* If we're anyway going to discard undo information, don't
4570 record it in the first place. The buffer's undo list at this
4571 point is either nil or t when visiting a file. */
4574 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4575 current_buffer
->undo_list
= Qt
;
4578 insval
= call3 (Qformat_decode
,
4579 Qnil
, make_number (inserted
), visit
);
4580 CHECK_NUMBER (insval
);
4581 inserted
= XFASTINT (insval
);
4584 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4587 /* Call after-change hooks for the inserted text, aside from the case
4588 of normal visiting (not with REPLACE), which is done in a new buffer
4589 "before" the buffer is changed. */
4590 if (inserted
> 0 && total
> 0
4591 && (NILP (visit
) || !NILP (replace
)))
4593 signal_after_change (PT
, 0, inserted
);
4594 update_compositions (PT
, PT
, CHECK_BORDER
);
4597 p
= Vafter_insert_file_functions
;
4600 insval
= call1 (XCAR (p
), make_number (inserted
));
4603 CHECK_NUMBER (insval
);
4604 inserted
= XFASTINT (insval
);
4611 && current_buffer
->modtime
== -1)
4613 /* If visiting nonexistent file, return nil. */
4614 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4618 Fsignal (Qquit
, Qnil
);
4620 /* ??? Retval needs to be dealt with in all cases consistently. */
4622 val
= Fcons (orig_filename
,
4623 Fcons (make_number (inserted
),
4626 RETURN_UNGCPRO (unbind_to (count
, val
));
4629 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4630 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4631 Lisp_Object
, Lisp_Object
));
4633 /* If build_annotations switched buffers, switch back to BUF.
4634 Kill the temporary buffer that was selected in the meantime.
4636 Since this kill only the last temporary buffer, some buffers remain
4637 not killed if build_annotations switched buffers more than once.
4641 build_annotations_unwind (buf
)
4646 if (XBUFFER (buf
) == current_buffer
)
4648 tembuf
= Fcurrent_buffer ();
4650 Fkill_buffer (tembuf
);
4654 /* Decide the coding-system to encode the data with. */
4657 choose_write_coding_system (start
, end
, filename
,
4658 append
, visit
, lockname
, coding
)
4659 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4660 struct coding_system
*coding
;
4666 else if (!NILP (Vcoding_system_for_write
))
4668 val
= Vcoding_system_for_write
;
4669 if (coding_system_require_warning
4670 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4671 /* Confirm that VAL can surely encode the current region. */
4672 val
= call5 (Vselect_safe_coding_system_function
,
4673 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4678 /* If the variable `buffer-file-coding-system' is set locally,
4679 it means that the file was read with some kind of code
4680 conversion or the variable is explicitly set by users. We
4681 had better write it out with the same coding system even if
4682 `enable-multibyte-characters' is nil.
4684 If it is not set locally, we anyway have to convert EOL
4685 format if the default value of `buffer-file-coding-system'
4686 tells that it is not Unix-like (LF only) format. */
4687 int using_default_coding
= 0;
4688 int force_raw_text
= 0;
4690 val
= current_buffer
->buffer_file_coding_system
;
4692 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4695 if (NILP (current_buffer
->enable_multibyte_characters
))
4701 /* Check file-coding-system-alist. */
4702 Lisp_Object args
[7], coding_systems
;
4704 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4705 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4707 coding_systems
= Ffind_operation_coding_system (7, args
);
4708 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4709 val
= XCDR (coding_systems
);
4713 && !NILP (current_buffer
->buffer_file_coding_system
))
4715 /* If we still have not decided a coding system, use the
4716 default value of buffer-file-coding-system. */
4717 val
= current_buffer
->buffer_file_coding_system
;
4718 using_default_coding
= 1;
4722 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4723 /* Confirm that VAL can surely encode the current region. */
4724 val
= call5 (Vselect_safe_coding_system_function
,
4725 start
, end
, val
, Qnil
, filename
);
4727 setup_coding_system (Fcheck_coding_system (val
), coding
);
4728 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4729 && !using_default_coding
)
4731 if (! EQ (default_buffer_file_coding
.symbol
,
4732 buffer_defaults
.buffer_file_coding_system
))
4733 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4734 &default_buffer_file_coding
);
4735 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4737 Lisp_Object subsidiaries
;
4739 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4740 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4741 if (VECTORP (subsidiaries
)
4742 && XVECTOR (subsidiaries
)->size
== 3)
4744 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4749 setup_raw_text_coding_system (coding
);
4750 goto done_setup_coding
;
4753 setup_coding_system (Fcheck_coding_system (val
), coding
);
4756 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4757 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4760 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4761 "r\nFWrite region to file: \ni\ni\ni\np",
4762 doc
: /* Write current region into specified file.
4763 When called from a program, requires three arguments:
4764 START, END and FILENAME. START and END are normally buffer positions
4765 specifying the part of the buffer to write.
4766 If START is nil, that means to use the entire buffer contents.
4767 If START is a string, then output that string to the file
4768 instead of any buffer contents; END is ignored.
4770 Optional fourth argument APPEND if non-nil means
4771 append to existing file contents (if any). If it is an integer,
4772 seek to that offset in the file before writing.
4773 Optional fifth argument VISIT if t means
4774 set the last-save-file-modtime of buffer to this file's modtime
4775 and mark buffer not modified.
4776 If VISIT is a string, it is a second file name;
4777 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4778 VISIT is also the file name to lock and unlock for clash detection.
4779 If VISIT is neither t nor nil nor a string,
4780 that means do not display the \"Wrote file\" message.
4781 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4782 use for locking and unlocking, overriding FILENAME and VISIT.
4783 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4784 for an existing file with the same name. If MUSTBENEW is `excl',
4785 that means to get an error if the file already exists; never overwrite.
4786 If MUSTBENEW is neither nil nor `excl', that means ask for
4787 confirmation before overwriting, but do go ahead and overwrite the file
4788 if the user confirms.
4790 This does code conversion according to the value of
4791 `coding-system-for-write', `buffer-file-coding-system', or
4792 `file-coding-system-alist', and sets the variable
4793 `last-coding-system-used' to the coding system actually used. */)
4794 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4795 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4800 const unsigned char *fn
;
4803 int count
= SPECPDL_INDEX ();
4806 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4808 Lisp_Object handler
;
4809 Lisp_Object visit_file
;
4810 Lisp_Object annotations
;
4811 Lisp_Object encoded_filename
;
4812 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4813 int quietly
= !NILP (visit
);
4814 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4815 struct buffer
*given_buffer
;
4817 int buffer_file_type
= O_BINARY
;
4819 struct coding_system coding
;
4821 if (current_buffer
->base_buffer
&& visiting
)
4822 error ("Cannot do file visiting in an indirect buffer");
4824 if (!NILP (start
) && !STRINGP (start
))
4825 validate_region (&start
, &end
);
4827 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4829 filename
= Fexpand_file_name (filename
, Qnil
);
4831 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4832 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4834 if (STRINGP (visit
))
4835 visit_file
= Fexpand_file_name (visit
, Qnil
);
4837 visit_file
= filename
;
4839 if (NILP (lockname
))
4840 lockname
= visit_file
;
4844 /* If the file name has special constructs in it,
4845 call the corresponding file handler. */
4846 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4847 /* If FILENAME has no handler, see if VISIT has one. */
4848 if (NILP (handler
) && STRINGP (visit
))
4849 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4851 if (!NILP (handler
))
4854 val
= call6 (handler
, Qwrite_region
, start
, end
,
4855 filename
, append
, visit
);
4859 SAVE_MODIFF
= MODIFF
;
4860 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4861 current_buffer
->filename
= visit_file
;
4867 /* Special kludge to simplify auto-saving. */
4870 XSETFASTINT (start
, BEG
);
4871 XSETFASTINT (end
, Z
);
4874 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4875 count1
= SPECPDL_INDEX ();
4877 given_buffer
= current_buffer
;
4879 if (!STRINGP (start
))
4881 annotations
= build_annotations (start
, end
);
4883 if (current_buffer
!= given_buffer
)
4885 XSETFASTINT (start
, BEGV
);
4886 XSETFASTINT (end
, ZV
);
4892 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4894 /* Decide the coding-system to encode the data with.
4895 We used to make this choice before calling build_annotations, but that
4896 leads to problems when a write-annotate-function takes care of
4897 unsavable chars (as was the case with X-Symbol). */
4898 choose_write_coding_system (start
, end
, filename
,
4899 append
, visit
, lockname
, &coding
);
4900 Vlast_coding_system_used
= coding
.symbol
;
4902 given_buffer
= current_buffer
;
4903 if (! STRINGP (start
))
4905 annotations
= build_annotations_2 (start
, end
,
4906 coding
.pre_write_conversion
, annotations
);
4907 if (current_buffer
!= given_buffer
)
4909 XSETFASTINT (start
, BEGV
);
4910 XSETFASTINT (end
, ZV
);
4914 #ifdef CLASH_DETECTION
4917 #if 0 /* This causes trouble for GNUS. */
4918 /* If we've locked this file for some other buffer,
4919 query before proceeding. */
4920 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4921 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4924 lock_file (lockname
);
4926 #endif /* CLASH_DETECTION */
4928 encoded_filename
= ENCODE_FILE (filename
);
4930 fn
= SDATA (encoded_filename
);
4934 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4935 #else /* not DOS_NT */
4936 desc
= emacs_open (fn
, O_WRONLY
, 0);
4937 #endif /* not DOS_NT */
4939 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4941 if (auto_saving
) /* Overwrite any previous version of autosave file */
4943 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4944 desc
= emacs_open (fn
, O_RDWR
, 0);
4946 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4947 ? SDATA (current_buffer
->filename
) : 0,
4950 else /* Write to temporary name and rename if no errors */
4952 Lisp_Object temp_name
;
4953 temp_name
= Ffile_name_directory (filename
);
4955 if (!NILP (temp_name
))
4957 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4958 build_string ("$$SAVE$$")));
4959 fname
= SDATA (filename
);
4960 fn
= SDATA (temp_name
);
4961 desc
= creat_copy_attrs (fname
, fn
);
4964 /* If we can't open the temporary file, try creating a new
4965 version of the original file. VMS "creat" creates a
4966 new version rather than truncating an existing file. */
4969 desc
= creat (fn
, 0666);
4970 #if 0 /* This can clobber an existing file and fail to replace it,
4971 if the user runs out of space. */
4974 /* We can't make a new version;
4975 try to truncate and rewrite existing version if any. */
4977 desc
= emacs_open (fn
, O_RDWR
, 0);
4983 desc
= creat (fn
, 0666);
4987 desc
= emacs_open (fn
,
4988 O_WRONLY
| O_CREAT
| buffer_file_type
4989 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4990 S_IREAD
| S_IWRITE
);
4991 #else /* not DOS_NT */
4992 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4993 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4994 auto_saving
? auto_save_mode_bits
: 0666);
4995 #endif /* not DOS_NT */
4996 #endif /* not VMS */
5000 #ifdef CLASH_DETECTION
5002 if (!auto_saving
) unlock_file (lockname
);
5004 #endif /* CLASH_DETECTION */
5006 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5009 record_unwind_protect (close_file_unwind
, make_number (desc
));
5011 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5015 if (NUMBERP (append
))
5016 ret
= lseek (desc
, XINT (append
), 1);
5018 ret
= lseek (desc
, 0, 2);
5021 #ifdef CLASH_DETECTION
5022 if (!auto_saving
) unlock_file (lockname
);
5023 #endif /* CLASH_DETECTION */
5025 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5033 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5034 * if we do writes that don't end with a carriage return. Furthermore
5035 * it cannot handle writes of more then 16K. The modified
5036 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5037 * this EXCEPT for the last record (iff it doesn't end with a carriage
5038 * return). This implies that if your buffer doesn't end with a carriage
5039 * return, you get one free... tough. However it also means that if
5040 * we make two calls to sys_write (a la the following code) you can
5041 * get one at the gap as well. The easiest way to fix this (honest)
5042 * is to move the gap to the next newline (or the end of the buffer).
5047 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5048 move_gap (find_next_newline (GPT
, 1));
5050 /* Whether VMS or not, we must move the gap to the next of newline
5051 when we must put designation sequences at beginning of line. */
5052 if (INTEGERP (start
)
5053 && coding
.type
== coding_type_iso2022
5054 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5055 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5057 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5058 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5059 move_gap_both (PT
, PT_BYTE
);
5060 SET_PT_BOTH (opoint
, opoint_byte
);
5067 if (STRINGP (start
))
5069 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5070 &annotations
, &coding
);
5073 else if (XINT (start
) != XINT (end
))
5075 tem
= CHAR_TO_BYTE (XINT (start
));
5077 if (XINT (start
) < GPT
)
5079 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5080 min (GPT
, XINT (end
)) - XINT (start
),
5081 &annotations
, &coding
);
5085 if (XINT (end
) > GPT
&& !failure
)
5087 tem
= max (XINT (start
), GPT
);
5088 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5089 &annotations
, &coding
);
5095 /* If file was empty, still need to write the annotations */
5096 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5097 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5101 if (CODING_REQUIRE_FLUSHING (&coding
)
5102 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5105 /* We have to flush out a data. */
5106 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5107 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5114 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5115 Disk full in NFS may be reported here. */
5116 /* mib says that closing the file will try to write as fast as NFS can do
5117 it, and that means the fsync here is not crucial for autosave files. */
5118 if (!auto_saving
&& fsync (desc
) < 0)
5120 /* If fsync fails with EINTR, don't treat that as serious. */
5122 failure
= 1, save_errno
= errno
;
5126 /* Spurious "file has changed on disk" warnings have been
5127 observed on Suns as well.
5128 It seems that `close' can change the modtime, under nfs.
5130 (This has supposedly been fixed in Sunos 4,
5131 but who knows about all the other machines with NFS?) */
5134 /* On VMS and APOLLO, must do the stat after the close
5135 since closing changes the modtime. */
5138 /* Recall that #if defined does not work on VMS. */
5145 /* NFS can report a write failure now. */
5146 if (emacs_close (desc
) < 0)
5147 failure
= 1, save_errno
= errno
;
5150 /* If we wrote to a temporary name and had no errors, rename to real name. */
5154 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5162 /* Discard the unwind protect for close_file_unwind. */
5163 specpdl_ptr
= specpdl
+ count1
;
5164 /* Restore the original current buffer. */
5165 visit_file
= unbind_to (count
, visit_file
);
5167 #ifdef CLASH_DETECTION
5169 unlock_file (lockname
);
5170 #endif /* CLASH_DETECTION */
5172 /* Do this before reporting IO error
5173 to avoid a "file has changed on disk" warning on
5174 next attempt to save. */
5176 current_buffer
->modtime
= st
.st_mtime
;
5179 error ("IO error writing %s: %s", SDATA (filename
),
5180 emacs_strerror (save_errno
));
5184 SAVE_MODIFF
= MODIFF
;
5185 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5186 current_buffer
->filename
= visit_file
;
5187 update_mode_lines
++;
5193 message_with_string ("Wrote %s", visit_file
, 1);
5198 Lisp_Object
merge ();
5200 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5201 doc
: /* Return t if (car A) is numerically less than (car B). */)
5205 return Flss (Fcar (a
), Fcar (b
));
5208 /* Build the complete list of annotations appropriate for writing out
5209 the text between START and END, by calling all the functions in
5210 write-region-annotate-functions and merging the lists they return.
5211 If one of these functions switches to a different buffer, we assume
5212 that buffer contains altered text. Therefore, the caller must
5213 make sure to restore the current buffer in all cases,
5214 as save-excursion would do. */
5217 build_annotations (start
, end
)
5218 Lisp_Object start
, end
;
5220 Lisp_Object annotations
;
5222 struct gcpro gcpro1
, gcpro2
;
5223 Lisp_Object original_buffer
;
5224 int i
, used_global
= 0;
5226 XSETBUFFER (original_buffer
, current_buffer
);
5229 p
= Vwrite_region_annotate_functions
;
5230 GCPRO2 (annotations
, p
);
5233 struct buffer
*given_buffer
= current_buffer
;
5234 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5235 { /* Use the global value of the hook. */
5238 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5240 p
= Fappend (2, arg
);
5243 Vwrite_region_annotations_so_far
= annotations
;
5244 res
= call2 (XCAR (p
), start
, end
);
5245 /* If the function makes a different buffer current,
5246 assume that means this buffer contains altered text to be output.
5247 Reset START and END from the buffer bounds
5248 and discard all previous annotations because they should have
5249 been dealt with by this function. */
5250 if (current_buffer
!= given_buffer
)
5252 XSETFASTINT (start
, BEGV
);
5253 XSETFASTINT (end
, ZV
);
5256 Flength (res
); /* Check basic validity of return value */
5257 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5261 /* Now do the same for annotation functions implied by the file-format */
5262 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5263 p
= Vauto_save_file_format
;
5265 p
= current_buffer
->file_format
;
5266 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5268 struct buffer
*given_buffer
= current_buffer
;
5270 Vwrite_region_annotations_so_far
= annotations
;
5272 /* Value is either a list of annotations or nil if the function
5273 has written annotations to a temporary buffer, which is now
5275 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5276 original_buffer
, make_number (i
));
5277 if (current_buffer
!= given_buffer
)
5279 XSETFASTINT (start
, BEGV
);
5280 XSETFASTINT (end
, ZV
);
5285 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5293 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5294 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5296 struct gcpro gcpro1
;
5299 GCPRO1 (annotations
);
5300 /* At last, do the same for the function PRE_WRITE_CONVERSION
5301 implied by the current coding-system. */
5302 if (!NILP (pre_write_conversion
))
5304 struct buffer
*given_buffer
= current_buffer
;
5305 Vwrite_region_annotations_so_far
= annotations
;
5306 res
= call2 (pre_write_conversion
, start
, end
);
5308 annotations
= (current_buffer
!= given_buffer
5310 : merge (annotations
, res
, Qcar_less_than_car
));
5317 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5318 If STRING is nil, POS is the character position in the current buffer.
5319 Intersperse with them the annotations from *ANNOT
5320 which fall within the range of POS to POS + NCHARS,
5321 each at its appropriate position.
5323 We modify *ANNOT by discarding elements as we use them up.
5325 The return value is negative in case of system call failure. */
5328 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5331 register int nchars
;
5334 struct coding_system
*coding
;
5338 int lastpos
= pos
+ nchars
;
5340 while (NILP (*annot
) || CONSP (*annot
))
5342 tem
= Fcar_safe (Fcar (*annot
));
5345 nextpos
= XFASTINT (tem
);
5347 /* If there are no more annotations in this range,
5348 output the rest of the range all at once. */
5349 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5350 return e_write (desc
, string
, pos
, lastpos
, coding
);
5352 /* Output buffer text up to the next annotation's position. */
5355 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5359 /* Output the annotation. */
5360 tem
= Fcdr (Fcar (*annot
));
5363 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5366 *annot
= Fcdr (*annot
);
5371 #ifndef WRITE_BUF_SIZE
5372 #define WRITE_BUF_SIZE (16 * 1024)
5375 /* Write text in the range START and END into descriptor DESC,
5376 encoding them with coding system CODING. If STRING is nil, START
5377 and END are character positions of the current buffer, else they
5378 are indexes to the string STRING. */
5381 e_write (desc
, string
, start
, end
, coding
)
5385 struct coding_system
*coding
;
5387 register char *addr
;
5388 register int nbytes
;
5389 char buf
[WRITE_BUF_SIZE
];
5393 coding
->composing
= COMPOSITION_DISABLED
;
5394 if (coding
->composing
!= COMPOSITION_DISABLED
)
5395 coding_save_composition (coding
, start
, end
, string
);
5397 if (STRINGP (string
))
5399 addr
= SDATA (string
);
5400 nbytes
= SBYTES (string
);
5401 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5403 else if (start
< end
)
5405 /* It is assured that the gap is not in the range START and END-1. */
5406 addr
= CHAR_POS_ADDR (start
);
5407 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5408 coding
->src_multibyte
5409 = !NILP (current_buffer
->enable_multibyte_characters
);
5415 coding
->src_multibyte
= 1;
5418 /* We used to have a code for handling selective display here. But,
5419 now it is handled within encode_coding. */
5424 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5425 if (coding
->produced
> 0)
5427 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5428 if (coding
->produced
)
5434 nbytes
-= coding
->consumed
;
5435 addr
+= coding
->consumed
;
5436 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5439 /* The source text ends by an incomplete multibyte form.
5440 There's no way other than write it out as is. */
5441 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5450 start
+= coding
->consumed_char
;
5451 if (coding
->cmp_data
)
5452 coding_adjust_composition_offset (coding
, start
);
5455 if (coding
->cmp_data
)
5456 coding_free_composition_data (coding
);
5461 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5462 Sverify_visited_file_modtime
, 1, 1, 0,
5463 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5464 This means that the file has not been changed since it was visited or saved. */)
5470 Lisp_Object handler
;
5471 Lisp_Object filename
;
5476 if (!STRINGP (b
->filename
)) return Qt
;
5477 if (b
->modtime
== 0) return Qt
;
5479 /* If the file name has special constructs in it,
5480 call the corresponding file handler. */
5481 handler
= Ffind_file_name_handler (b
->filename
,
5482 Qverify_visited_file_modtime
);
5483 if (!NILP (handler
))
5484 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5486 filename
= ENCODE_FILE (b
->filename
);
5488 if (stat (SDATA (filename
), &st
) < 0)
5490 /* If the file doesn't exist now and didn't exist before,
5491 we say that it isn't modified, provided the error is a tame one. */
5492 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5497 if (st
.st_mtime
== b
->modtime
5498 /* If both are positive, accept them if they are off by one second. */
5499 || (st
.st_mtime
> 0 && b
->modtime
> 0
5500 && (st
.st_mtime
== b
->modtime
+ 1
5501 || st
.st_mtime
== b
->modtime
- 1)))
5506 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5507 Sclear_visited_file_modtime
, 0, 0, 0,
5508 doc
: /* Clear out records of last mod time of visited file.
5509 Next attempt to save will certainly not complain of a discrepancy. */)
5512 current_buffer
->modtime
= 0;
5516 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5517 Svisited_file_modtime
, 0, 0, 0,
5518 doc
: /* Return the current buffer's recorded visited file modification time.
5519 The value is a list of the form (HIGH . LOW), like the time values
5520 that `file-attributes' returns. */)
5523 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5526 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5527 Sset_visited_file_modtime
, 0, 1, 0,
5528 doc
: /* Update buffer's recorded modification time from the visited file's time.
5529 Useful if the buffer was not read from the file normally
5530 or if the file itself has been changed for some known benign reason.
5531 An argument specifies the modification time value to use
5532 \(instead of that of the visited file), in the form of a list
5533 \(HIGH . LOW) or (HIGH LOW). */)
5535 Lisp_Object time_list
;
5537 if (!NILP (time_list
))
5538 current_buffer
->modtime
= cons_to_long (time_list
);
5541 register Lisp_Object filename
;
5543 Lisp_Object handler
;
5545 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5547 /* If the file name has special constructs in it,
5548 call the corresponding file handler. */
5549 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5550 if (!NILP (handler
))
5551 /* The handler can find the file name the same way we did. */
5552 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5554 filename
= ENCODE_FILE (filename
);
5556 if (stat (SDATA (filename
), &st
) >= 0)
5557 current_buffer
->modtime
= st
.st_mtime
;
5564 auto_save_error (error
)
5567 Lisp_Object args
[3], msg
;
5569 struct gcpro gcpro1
;
5573 args
[0] = build_string ("Auto-saving %s: %s");
5574 args
[1] = current_buffer
->name
;
5575 args
[2] = Ferror_message_string (error
);
5576 msg
= Fformat (3, args
);
5578 nbytes
= SBYTES (msg
);
5580 for (i
= 0; i
< 3; ++i
)
5583 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5585 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5586 Fsleep_for (make_number (1), Qnil
);
5598 /* Get visited file's mode to become the auto save file's mode. */
5599 if (! NILP (current_buffer
->filename
)
5600 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5601 /* But make sure we can overwrite it later! */
5602 auto_save_mode_bits
= st
.st_mode
| 0600;
5604 auto_save_mode_bits
= 0666;
5607 Fwrite_region (Qnil
, Qnil
,
5608 current_buffer
->auto_save_file_name
,
5609 Qnil
, Qlambda
, Qnil
, Qnil
);
5613 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5618 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5619 | XFASTINT (XCDR (stream
))));
5624 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5627 minibuffer_auto_raise
= XINT (value
);
5632 do_auto_save_make_dir (dir
)
5635 return call2 (Qmake_directory
, dir
, Qt
);
5639 do_auto_save_eh (ignore
)
5645 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5646 doc
: /* Auto-save all buffers that need it.
5647 This is all buffers that have auto-saving enabled
5648 and are changed since last auto-saved.
5649 Auto-saving writes the buffer into a file
5650 so that your editing is not lost if the system crashes.
5651 This file is not the file you visited; that changes only when you save.
5652 Normally we run the normal hook `auto-save-hook' before saving.
5654 A non-nil NO-MESSAGE argument means do not print any message if successful.
5655 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5656 (no_message
, current_only
)
5657 Lisp_Object no_message
, current_only
;
5659 struct buffer
*old
= current_buffer
, *b
;
5660 Lisp_Object tail
, buf
;
5662 int do_handled_files
;
5665 Lisp_Object lispstream
;
5666 int count
= SPECPDL_INDEX ();
5667 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5668 int old_message_p
= 0;
5669 struct gcpro gcpro1
, gcpro2
;
5671 if (max_specpdl_size
< specpdl_size
+ 40)
5672 max_specpdl_size
= specpdl_size
+ 40;
5677 if (NILP (no_message
))
5679 old_message_p
= push_message ();
5680 record_unwind_protect (pop_message_unwind
, Qnil
);
5683 /* Ordinarily don't quit within this function,
5684 but don't make it impossible to quit (in case we get hung in I/O). */
5688 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5689 point to non-strings reached from Vbuffer_alist. */
5691 if (!NILP (Vrun_hooks
))
5692 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5694 if (STRINGP (Vauto_save_list_file_name
))
5696 Lisp_Object listfile
;
5698 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5700 /* Don't try to create the directory when shutting down Emacs,
5701 because creating the directory might signal an error, and
5702 that would leave Emacs in a strange state. */
5703 if (!NILP (Vrun_hooks
))
5707 GCPRO2 (dir
, listfile
);
5708 dir
= Ffile_name_directory (listfile
);
5709 if (NILP (Ffile_directory_p (dir
)))
5710 internal_condition_case_1 (do_auto_save_make_dir
,
5711 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5716 stream
= fopen (SDATA (listfile
), "w");
5719 /* Arrange to close that file whether or not we get an error.
5720 Also reset auto_saving to 0. */
5721 lispstream
= Fcons (Qnil
, Qnil
);
5722 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5723 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5734 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5735 record_unwind_protect (do_auto_save_unwind_1
,
5736 make_number (minibuffer_auto_raise
));
5737 minibuffer_auto_raise
= 0;
5740 /* First, save all files which don't have handlers. If Emacs is
5741 crashing, the handlers may tweak what is causing Emacs to crash
5742 in the first place, and it would be a shame if Emacs failed to
5743 autosave perfectly ordinary files because it couldn't handle some
5745 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5746 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5748 buf
= XCDR (XCAR (tail
));
5751 /* Record all the buffers that have auto save mode
5752 in the special file that lists them. For each of these buffers,
5753 Record visited name (if any) and auto save name. */
5754 if (STRINGP (b
->auto_save_file_name
)
5755 && stream
!= NULL
&& do_handled_files
== 0)
5757 if (!NILP (b
->filename
))
5759 fwrite (SDATA (b
->filename
), 1,
5760 SBYTES (b
->filename
), stream
);
5762 putc ('\n', stream
);
5763 fwrite (SDATA (b
->auto_save_file_name
), 1,
5764 SBYTES (b
->auto_save_file_name
), stream
);
5765 putc ('\n', stream
);
5768 if (!NILP (current_only
)
5769 && b
!= current_buffer
)
5772 /* Don't auto-save indirect buffers.
5773 The base buffer takes care of it. */
5777 /* Check for auto save enabled
5778 and file changed since last auto save
5779 and file changed since last real save. */
5780 if (STRINGP (b
->auto_save_file_name
)
5781 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5782 && b
->auto_save_modified
< BUF_MODIFF (b
)
5783 /* -1 means we've turned off autosaving for a while--see below. */
5784 && XINT (b
->save_length
) >= 0
5785 && (do_handled_files
5786 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5789 EMACS_TIME before_time
, after_time
;
5791 EMACS_GET_TIME (before_time
);
5793 /* If we had a failure, don't try again for 20 minutes. */
5794 if (b
->auto_save_failure_time
>= 0
5795 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5798 if ((XFASTINT (b
->save_length
) * 10
5799 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5800 /* A short file is likely to change a large fraction;
5801 spare the user annoying messages. */
5802 && XFASTINT (b
->save_length
) > 5000
5803 /* These messages are frequent and annoying for `*mail*'. */
5804 && !EQ (b
->filename
, Qnil
)
5805 && NILP (no_message
))
5807 /* It has shrunk too much; turn off auto-saving here. */
5808 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5809 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5811 minibuffer_auto_raise
= 0;
5812 /* Turn off auto-saving until there's a real save,
5813 and prevent any more warnings. */
5814 XSETINT (b
->save_length
, -1);
5815 Fsleep_for (make_number (1), Qnil
);
5818 set_buffer_internal (b
);
5819 if (!auto_saved
&& NILP (no_message
))
5820 message1 ("Auto-saving...");
5821 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5823 b
->auto_save_modified
= BUF_MODIFF (b
);
5824 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5825 set_buffer_internal (old
);
5827 EMACS_GET_TIME (after_time
);
5829 /* If auto-save took more than 60 seconds,
5830 assume it was an NFS failure that got a timeout. */
5831 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5832 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5836 /* Prevent another auto save till enough input events come in. */
5837 record_auto_save ();
5839 if (auto_saved
&& NILP (no_message
))
5843 /* If we are going to restore an old message,
5844 give time to read ours. */
5845 sit_for (1, 0, 0, 0, 0);
5849 /* If we displayed a message and then restored a state
5850 with no message, leave a "done" message on the screen. */
5851 message1 ("Auto-saving...done");
5856 /* This restores the message-stack status. */
5857 unbind_to (count
, Qnil
);
5861 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5862 Sset_buffer_auto_saved
, 0, 0, 0,
5863 doc
: /* Mark current buffer as auto-saved with its current text.
5864 No auto-save file will be written until the buffer changes again. */)
5867 current_buffer
->auto_save_modified
= MODIFF
;
5868 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5869 current_buffer
->auto_save_failure_time
= -1;
5873 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5874 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5875 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5878 current_buffer
->auto_save_failure_time
= -1;
5882 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5884 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
5887 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5890 /* Reading and completing file names */
5891 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5893 /* In the string VAL, change each $ to $$ and return the result. */
5896 double_dollars (val
)
5899 register const unsigned char *old
;
5900 register unsigned char *new;
5904 osize
= SBYTES (val
);
5906 /* Count the number of $ characters. */
5907 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
5908 if (*old
++ == '$') count
++;
5912 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
5915 for (n
= osize
; n
> 0; n
--)
5929 read_file_name_cleanup (arg
)
5932 return (current_buffer
->directory
= arg
);
5935 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5937 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
5938 (string
, dir
, action
)
5939 Lisp_Object string
, dir
, action
;
5940 /* action is nil for complete, t for return list of completions,
5941 lambda for verify final value */
5943 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5945 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5947 CHECK_STRING (string
);
5954 /* No need to protect ACTION--we only compare it with t and nil. */
5955 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5957 if (SCHARS (string
) == 0)
5959 if (EQ (action
, Qlambda
))
5967 orig_string
= string
;
5968 string
= Fsubstitute_in_file_name (string
);
5969 changed
= NILP (Fstring_equal (string
, orig_string
));
5970 name
= Ffile_name_nondirectory (string
);
5971 val
= Ffile_name_directory (string
);
5973 realdir
= Fexpand_file_name (val
, realdir
);
5978 specdir
= Ffile_name_directory (string
);
5979 val
= Ffile_name_completion (name
, realdir
);
5984 return double_dollars (string
);
5988 if (!NILP (specdir
))
5989 val
= concat2 (specdir
, val
);
5991 return double_dollars (val
);
5994 #endif /* not VMS */
5998 if (EQ (action
, Qt
))
6000 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6004 if (NILP (Vread_file_name_predicate
)
6005 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6009 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6011 /* Brute-force speed up for directory checking:
6012 Discard strings which don't end in a slash. */
6013 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6015 Lisp_Object tem
= XCAR (all
);
6017 if (STRINGP (tem
) &&
6018 (len
= SCHARS (tem
), len
> 0) &&
6019 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6020 comp
= Fcons (tem
, comp
);
6026 /* Must do it the hard (and slow) way. */
6027 GCPRO3 (all
, comp
, specdir
);
6028 count
= SPECPDL_INDEX ();
6029 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6030 current_buffer
->directory
= realdir
;
6031 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6032 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6033 comp
= Fcons (XCAR (all
), comp
);
6034 unbind_to (count
, Qnil
);
6037 return Fnreverse (comp
);
6040 /* Only other case actually used is ACTION = lambda */
6042 /* Supposedly this helps commands such as `cd' that read directory names,
6043 but can someone explain how it helps them? -- RMS */
6044 if (SCHARS (name
) == 0)
6047 if (!NILP (Vread_file_name_predicate
))
6048 return call1 (Vread_file_name_predicate
, string
);
6049 return Ffile_exists_p (string
);
6052 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6053 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6054 Value is not expanded---you must call `expand-file-name' yourself.
6055 Default name to DEFAULT-FILENAME if user enters a null string.
6056 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6057 except that if INITIAL is specified, that combined with DIR is used.)
6058 Fourth arg MUSTMATCH non-nil means require existing file's name.
6059 Non-nil and non-t means also require confirmation after completion.
6060 Fifth arg INITIAL specifies text to start with.
6061 If optional sixth arg PREDICATE is non-nil, possible completions and the
6062 resulting file name must satisfy (funcall PREDICATE NAME).
6063 DIR defaults to current buffer's directory default.
6065 If this command was invoked with the mouse, use a file dialog box if
6066 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6067 provides a file dialog box. */)
6068 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6069 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6071 Lisp_Object val
, insdef
, tem
;
6072 struct gcpro gcpro1
, gcpro2
;
6073 register char *homedir
;
6074 Lisp_Object decoded_homedir
;
6075 int replace_in_history
= 0;
6076 int add_to_history
= 0;
6080 dir
= current_buffer
->directory
;
6081 if (NILP (default_filename
))
6082 default_filename
= !NILP (initial
)
6083 ? Fexpand_file_name (initial
, dir
)
6084 : current_buffer
->filename
;
6086 /* If dir starts with user's homedir, change that to ~. */
6087 homedir
= (char *) egetenv ("HOME");
6089 /* homedir can be NULL in temacs, since Vprocess_environment is not
6090 yet set up. We shouldn't crash in that case. */
6093 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6094 CORRECT_DIR_SEPS (homedir
);
6099 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6102 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6103 SBYTES (decoded_homedir
))
6104 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6106 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6107 dir
= concat2 (build_string ("~"), dir
);
6109 /* Likewise for default_filename. */
6111 && STRINGP (default_filename
)
6112 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6113 SBYTES (decoded_homedir
))
6114 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6117 = Fsubstring (default_filename
,
6118 make_number (SCHARS (decoded_homedir
)), Qnil
);
6119 default_filename
= concat2 (build_string ("~"), default_filename
);
6121 if (!NILP (default_filename
))
6123 CHECK_STRING (default_filename
);
6124 default_filename
= double_dollars (default_filename
);
6127 if (insert_default_directory
&& STRINGP (dir
))
6130 if (!NILP (initial
))
6132 Lisp_Object args
[2], pos
;
6136 insdef
= Fconcat (2, args
);
6137 pos
= make_number (SCHARS (double_dollars (dir
)));
6138 insdef
= Fcons (double_dollars (insdef
), pos
);
6141 insdef
= double_dollars (insdef
);
6143 else if (STRINGP (initial
))
6144 insdef
= Fcons (double_dollars (initial
), make_number (0));
6148 if (!NILP (Vread_file_name_function
))
6150 Lisp_Object args
[7];
6152 GCPRO2 (insdef
, default_filename
);
6153 args
[0] = Vread_file_name_function
;
6156 args
[3] = default_filename
;
6157 args
[4] = mustmatch
;
6159 args
[6] = predicate
;
6160 RETURN_UNGCPRO (Ffuncall (7, args
));
6163 count
= SPECPDL_INDEX ();
6165 specbind (intern ("completion-ignore-case"), Qt
);
6168 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6169 specbind (intern ("read-file-name-predicate"),
6170 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6172 GCPRO2 (insdef
, default_filename
);
6174 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
6175 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6179 /* If DIR contains a file name, split it. */
6181 file
= Ffile_name_nondirectory (dir
);
6182 if (SCHARS (file
) && NILP (default_filename
))
6184 default_filename
= file
;
6185 dir
= Ffile_name_directory (dir
);
6187 if (!NILP(default_filename
))
6188 default_filename
= Fexpand_file_name (default_filename
, dir
);
6189 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6194 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6195 dir
, mustmatch
, insdef
,
6196 Qfile_name_history
, default_filename
, Qnil
);
6198 tem
= Fsymbol_value (Qfile_name_history
);
6199 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6200 replace_in_history
= 1;
6202 /* If Fcompleting_read returned the inserted default string itself
6203 (rather than a new string with the same contents),
6204 it has to mean that the user typed RET with the minibuffer empty.
6205 In that case, we really want to return ""
6206 so that commands such as set-visited-file-name can distinguish. */
6207 if (EQ (val
, default_filename
))
6209 /* In this case, Fcompleting_read has not added an element
6210 to the history. Maybe we should. */
6211 if (! replace_in_history
)
6217 unbind_to (count
, Qnil
);
6220 error ("No file name specified");
6222 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6224 if (!NILP (tem
) && !NILP (default_filename
))
6225 val
= default_filename
;
6226 else if (SCHARS (val
) == 0 && NILP (insdef
))
6228 if (!NILP (default_filename
))
6229 val
= default_filename
;
6231 error ("No default file name");
6233 val
= Fsubstitute_in_file_name (val
);
6235 if (replace_in_history
)
6236 /* Replace what Fcompleting_read added to the history
6237 with what we will actually return. */
6238 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6239 else if (add_to_history
)
6241 /* Add the value to the history--but not if it matches
6242 the last value already there. */
6243 Lisp_Object val1
= double_dollars (val
);
6244 tem
= Fsymbol_value (Qfile_name_history
);
6245 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6246 Fset (Qfile_name_history
,
6257 /* Must be set before any path manipulation is performed. */
6258 XSETFASTINT (Vdirectory_sep_char
, '/');
6265 Qexpand_file_name
= intern ("expand-file-name");
6266 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6267 Qdirectory_file_name
= intern ("directory-file-name");
6268 Qfile_name_directory
= intern ("file-name-directory");
6269 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6270 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6271 Qfile_name_as_directory
= intern ("file-name-as-directory");
6272 Qcopy_file
= intern ("copy-file");
6273 Qmake_directory_internal
= intern ("make-directory-internal");
6274 Qmake_directory
= intern ("make-directory");
6275 Qdelete_directory
= intern ("delete-directory");
6276 Qdelete_file
= intern ("delete-file");
6277 Qrename_file
= intern ("rename-file");
6278 Qadd_name_to_file
= intern ("add-name-to-file");
6279 Qmake_symbolic_link
= intern ("make-symbolic-link");
6280 Qfile_exists_p
= intern ("file-exists-p");
6281 Qfile_executable_p
= intern ("file-executable-p");
6282 Qfile_readable_p
= intern ("file-readable-p");
6283 Qfile_writable_p
= intern ("file-writable-p");
6284 Qfile_symlink_p
= intern ("file-symlink-p");
6285 Qaccess_file
= intern ("access-file");
6286 Qfile_directory_p
= intern ("file-directory-p");
6287 Qfile_regular_p
= intern ("file-regular-p");
6288 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6289 Qfile_modes
= intern ("file-modes");
6290 Qset_file_modes
= intern ("set-file-modes");
6291 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6292 Qinsert_file_contents
= intern ("insert-file-contents");
6293 Qwrite_region
= intern ("write-region");
6294 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6295 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6297 staticpro (&Qexpand_file_name
);
6298 staticpro (&Qsubstitute_in_file_name
);
6299 staticpro (&Qdirectory_file_name
);
6300 staticpro (&Qfile_name_directory
);
6301 staticpro (&Qfile_name_nondirectory
);
6302 staticpro (&Qunhandled_file_name_directory
);
6303 staticpro (&Qfile_name_as_directory
);
6304 staticpro (&Qcopy_file
);
6305 staticpro (&Qmake_directory_internal
);
6306 staticpro (&Qmake_directory
);
6307 staticpro (&Qdelete_directory
);
6308 staticpro (&Qdelete_file
);
6309 staticpro (&Qrename_file
);
6310 staticpro (&Qadd_name_to_file
);
6311 staticpro (&Qmake_symbolic_link
);
6312 staticpro (&Qfile_exists_p
);
6313 staticpro (&Qfile_executable_p
);
6314 staticpro (&Qfile_readable_p
);
6315 staticpro (&Qfile_writable_p
);
6316 staticpro (&Qaccess_file
);
6317 staticpro (&Qfile_symlink_p
);
6318 staticpro (&Qfile_directory_p
);
6319 staticpro (&Qfile_regular_p
);
6320 staticpro (&Qfile_accessible_directory_p
);
6321 staticpro (&Qfile_modes
);
6322 staticpro (&Qset_file_modes
);
6323 staticpro (&Qfile_newer_than_file_p
);
6324 staticpro (&Qinsert_file_contents
);
6325 staticpro (&Qwrite_region
);
6326 staticpro (&Qverify_visited_file_modtime
);
6327 staticpro (&Qset_visited_file_modtime
);
6329 Qfile_name_history
= intern ("file-name-history");
6330 Fset (Qfile_name_history
, Qnil
);
6331 staticpro (&Qfile_name_history
);
6333 Qfile_error
= intern ("file-error");
6334 staticpro (&Qfile_error
);
6335 Qfile_already_exists
= intern ("file-already-exists");
6336 staticpro (&Qfile_already_exists
);
6337 Qfile_date_error
= intern ("file-date-error");
6338 staticpro (&Qfile_date_error
);
6339 Qexcl
= intern ("excl");
6343 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6344 staticpro (&Qfind_buffer_file_type
);
6347 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6348 doc
: /* *Coding system for encoding file names.
6349 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6350 Vfile_name_coding_system
= Qnil
;
6352 DEFVAR_LISP ("default-file-name-coding-system",
6353 &Vdefault_file_name_coding_system
,
6354 doc
: /* Default coding system for encoding file names.
6355 This variable is used only when `file-name-coding-system' is nil.
6357 This variable is set/changed by the command `set-language-environment'.
6358 User should not set this variable manually,
6359 instead use `file-name-coding-system' to get a constant encoding
6360 of file names regardless of the current language environment. */);
6361 Vdefault_file_name_coding_system
= Qnil
;
6363 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6364 doc
: /* *Format in which to write auto-save files.
6365 Should be a list of symbols naming formats that are defined in `format-alist'.
6366 If it is t, which is the default, auto-save files are written in the
6367 same format as a regular save would use. */);
6368 Vauto_save_file_format
= Qt
;
6370 Qformat_decode
= intern ("format-decode");
6371 staticpro (&Qformat_decode
);
6372 Qformat_annotate_function
= intern ("format-annotate-function");
6373 staticpro (&Qformat_annotate_function
);
6374 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6375 staticpro (&Qafter_insert_file_set_coding
);
6377 Qcar_less_than_car
= intern ("car-less-than-car");
6378 staticpro (&Qcar_less_than_car
);
6380 Fput (Qfile_error
, Qerror_conditions
,
6381 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6382 Fput (Qfile_error
, Qerror_message
,
6383 build_string ("File error"));
6385 Fput (Qfile_already_exists
, Qerror_conditions
,
6386 Fcons (Qfile_already_exists
,
6387 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6388 Fput (Qfile_already_exists
, Qerror_message
,
6389 build_string ("File already exists"));
6391 Fput (Qfile_date_error
, Qerror_conditions
,
6392 Fcons (Qfile_date_error
,
6393 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6394 Fput (Qfile_date_error
, Qerror_message
,
6395 build_string ("Cannot set file date"));
6397 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6398 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6399 Vread_file_name_function
= Qnil
;
6401 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6402 doc
: /* Current predicate used by `read-file-name-internal'. */);
6403 Vread_file_name_predicate
= Qnil
;
6405 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6406 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer. */);
6407 insert_default_directory
= 1;
6409 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6410 doc
: /* *Non-nil means write new files with record format `stmlf'.
6411 nil means use format `var'. This variable is meaningful only on VMS. */);
6412 vms_stmlf_recfm
= 0;
6414 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6415 doc
: /* Directory separator character for built-in functions that return file names.
6416 The value is always ?/. Don't use this variable, just use `/'. */);
6418 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6419 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6420 If a file name matches REGEXP, then all I/O on that file is done by calling
6423 The first argument given to HANDLER is the name of the I/O primitive
6424 to be handled; the remaining arguments are the arguments that were
6425 passed to that primitive. For example, if you do
6426 (file-exists-p FILENAME)
6427 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6428 (funcall HANDLER 'file-exists-p FILENAME)
6429 The function `find-file-name-handler' checks this list for a handler
6430 for its argument. */);
6431 Vfile_name_handler_alist
= Qnil
;
6433 DEFVAR_LISP ("set-auto-coding-function",
6434 &Vset_auto_coding_function
,
6435 doc
: /* If non-nil, a function to call to decide a coding system of file.
6436 Two arguments are passed to this function: the file name
6437 and the length of a file contents following the point.
6438 This function should return a coding system to decode the file contents.
6439 It should check the file name against `auto-coding-alist'.
6440 If no coding system is decided, it should check a coding system
6441 specified in the heading lines with the format:
6442 -*- ... coding: CODING-SYSTEM; ... -*-
6443 or local variable spec of the tailing lines with `coding:' tag. */);
6444 Vset_auto_coding_function
= Qnil
;
6446 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6447 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6448 Each is passed one argument, the number of characters inserted.
6449 It should return the new character count, and leave point the same.
6450 If `insert-file-contents' is intercepted by a handler from
6451 `file-name-handler-alist', that handler is responsible for calling the
6452 functions in `after-insert-file-functions' if appropriate. */);
6453 Vafter_insert_file_functions
= Qnil
;
6455 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6456 doc
: /* A list of functions to be called at the start of `write-region'.
6457 Each is passed two arguments, START and END as for `write-region'.
6458 These are usually two numbers but not always; see the documentation
6459 for `write-region'. The function should return a list of pairs
6460 of the form (POSITION . STRING), consisting of strings to be effectively
6461 inserted at the specified positions of the file being written (1 means to
6462 insert before the first byte written). The POSITIONs must be sorted into
6463 increasing order. If there are several functions in the list, the several
6464 lists are merged destructively. Alternatively, the function can return
6465 with a different buffer current; in that case it should pay attention
6466 to the annotations returned by previous functions and listed in
6467 `write-region-annotations-so-far'.*/);
6468 Vwrite_region_annotate_functions
= Qnil
;
6469 staticpro (&Qwrite_region_annotate_functions
);
6470 Qwrite_region_annotate_functions
6471 = intern ("write-region-annotate-functions");
6473 DEFVAR_LISP ("write-region-annotations-so-far",
6474 &Vwrite_region_annotations_so_far
,
6475 doc
: /* When an annotation function is called, this holds the previous annotations.
6476 These are the annotations made by other annotation functions
6477 that were already called. See also `write-region-annotate-functions'. */);
6478 Vwrite_region_annotations_so_far
= Qnil
;
6480 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6481 doc
: /* A list of file name handlers that temporarily should not be used.
6482 This applies only to the operation `inhibit-file-name-operation'. */);
6483 Vinhibit_file_name_handlers
= Qnil
;
6485 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6486 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6487 Vinhibit_file_name_operation
= Qnil
;
6489 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6490 doc
: /* File name in which we write a list of all auto save file names.
6491 This variable is initialized automatically from `auto-save-list-file-prefix'
6492 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6493 a non-nil value. */);
6494 Vauto_save_list_file_name
= Qnil
;
6496 defsubr (&Sfind_file_name_handler
);
6497 defsubr (&Sfile_name_directory
);
6498 defsubr (&Sfile_name_nondirectory
);
6499 defsubr (&Sunhandled_file_name_directory
);
6500 defsubr (&Sfile_name_as_directory
);
6501 defsubr (&Sdirectory_file_name
);
6502 defsubr (&Smake_temp_name
);
6503 defsubr (&Sexpand_file_name
);
6504 defsubr (&Ssubstitute_in_file_name
);
6505 defsubr (&Scopy_file
);
6506 defsubr (&Smake_directory_internal
);
6507 defsubr (&Sdelete_directory
);
6508 defsubr (&Sdelete_file
);
6509 defsubr (&Srename_file
);
6510 defsubr (&Sadd_name_to_file
);
6512 defsubr (&Smake_symbolic_link
);
6513 #endif /* S_IFLNK */
6515 defsubr (&Sdefine_logical_name
);
6518 defsubr (&Ssysnetunam
);
6519 #endif /* HPUX_NET */
6520 defsubr (&Sfile_name_absolute_p
);
6521 defsubr (&Sfile_exists_p
);
6522 defsubr (&Sfile_executable_p
);
6523 defsubr (&Sfile_readable_p
);
6524 defsubr (&Sfile_writable_p
);
6525 defsubr (&Saccess_file
);
6526 defsubr (&Sfile_symlink_p
);
6527 defsubr (&Sfile_directory_p
);
6528 defsubr (&Sfile_accessible_directory_p
);
6529 defsubr (&Sfile_regular_p
);
6530 defsubr (&Sfile_modes
);
6531 defsubr (&Sset_file_modes
);
6532 defsubr (&Sset_default_file_modes
);
6533 defsubr (&Sdefault_file_modes
);
6534 defsubr (&Sfile_newer_than_file_p
);
6535 defsubr (&Sinsert_file_contents
);
6536 defsubr (&Swrite_region
);
6537 defsubr (&Scar_less_than_car
);
6538 defsubr (&Sverify_visited_file_modtime
);
6539 defsubr (&Sclear_visited_file_modtime
);
6540 defsubr (&Svisited_file_modtime
);
6541 defsubr (&Sset_visited_file_modtime
);
6542 defsubr (&Sdo_auto_save
);
6543 defsubr (&Sset_buffer_auto_saved
);
6544 defsubr (&Sclear_buffer_auto_save_failure
);
6545 defsubr (&Srecent_auto_save_p
);
6547 defsubr (&Sread_file_name_internal
);
6548 defsubr (&Sread_file_name
);
6551 defsubr (&Sunix_sync
);