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
;
3200 Lisp_Object handler
;
3202 CHECK_STRING (filename
);
3203 filename
= Fexpand_file_name (filename
, Qnil
);
3205 /* If the file name has special constructs in it,
3206 call the corresponding file handler. */
3207 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3208 if (!NILP (handler
))
3209 return call2 (handler
, Qfile_symlink_p
, filename
);
3211 filename
= ENCODE_FILE (filename
);
3218 buf
= (char *) xrealloc (buf
, bufsize
);
3219 bzero (buf
, bufsize
);
3222 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3226 /* HP-UX reports ERANGE if buffer is too small. */
3227 if (errno
== ERANGE
)
3237 while (valsize
>= bufsize
);
3239 val
= make_string (buf
, valsize
);
3240 if (buf
[0] == '/' && index (buf
, ':'))
3241 val
= concat2 (build_string ("/:"), val
);
3243 val
= DECODE_FILE (val
);
3245 #else /* not S_IFLNK */
3247 #endif /* not S_IFLNK */
3250 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3251 doc
: /* Return t if FILENAME names an existing directory.
3252 Symbolic links to directories count as directories.
3253 See `file-symlink-p' to distinguish symlinks. */)
3255 Lisp_Object filename
;
3257 register Lisp_Object absname
;
3259 Lisp_Object handler
;
3261 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3263 /* If the file name has special constructs in it,
3264 call the corresponding file handler. */
3265 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3266 if (!NILP (handler
))
3267 return call2 (handler
, Qfile_directory_p
, absname
);
3269 absname
= ENCODE_FILE (absname
);
3271 if (stat (SDATA (absname
), &st
) < 0)
3273 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3276 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3277 doc
: /* Return t if file FILENAME names a directory you can open.
3278 For the value to be t, FILENAME must specify the name of a directory as a file,
3279 and the directory must allow you to open files in it. In order to use a
3280 directory as a buffer's current directory, this predicate must return true.
3281 A directory name spec may be given instead; then the value is t
3282 if the directory so specified exists and really is a readable and
3283 searchable directory. */)
3285 Lisp_Object filename
;
3287 Lisp_Object handler
;
3289 struct gcpro gcpro1
;
3291 /* If the file name has special constructs in it,
3292 call the corresponding file handler. */
3293 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3294 if (!NILP (handler
))
3295 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3298 tem
= (NILP (Ffile_directory_p (filename
))
3299 || NILP (Ffile_executable_p (filename
)));
3301 return tem
? Qnil
: Qt
;
3304 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3305 doc
: /* Return t if file FILENAME is the name of a regular file.
3306 This is the sort of file that holds an ordinary stream of data bytes. */)
3308 Lisp_Object filename
;
3310 register Lisp_Object absname
;
3312 Lisp_Object handler
;
3314 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3316 /* If the file name has special constructs in it,
3317 call the corresponding file handler. */
3318 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3319 if (!NILP (handler
))
3320 return call2 (handler
, Qfile_regular_p
, absname
);
3322 absname
= ENCODE_FILE (absname
);
3327 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3329 /* Tell stat to use expensive method to get accurate info. */
3330 Vw32_get_true_file_attributes
= Qt
;
3331 result
= stat (SDATA (absname
), &st
);
3332 Vw32_get_true_file_attributes
= tem
;
3336 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3339 if (stat (SDATA (absname
), &st
) < 0)
3341 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3345 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3346 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
3348 Lisp_Object filename
;
3350 Lisp_Object absname
;
3352 Lisp_Object handler
;
3354 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3356 /* If the file name has special constructs in it,
3357 call the corresponding file handler. */
3358 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3359 if (!NILP (handler
))
3360 return call2 (handler
, Qfile_modes
, absname
);
3362 absname
= ENCODE_FILE (absname
);
3364 if (stat (SDATA (absname
), &st
) < 0)
3366 #if defined (MSDOS) && __DJGPP__ < 2
3367 if (check_executable (SDATA (absname
)))
3368 st
.st_mode
|= S_IEXEC
;
3369 #endif /* MSDOS && __DJGPP__ < 2 */
3371 return make_number (st
.st_mode
& 07777);
3374 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3375 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3376 Only the 12 low bits of MODE are used. */)
3378 Lisp_Object filename
, mode
;
3380 Lisp_Object absname
, encoded_absname
;
3381 Lisp_Object handler
;
3383 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3384 CHECK_NUMBER (mode
);
3386 /* If the file name has special constructs in it,
3387 call the corresponding file handler. */
3388 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3389 if (!NILP (handler
))
3390 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3392 encoded_absname
= ENCODE_FILE (absname
);
3394 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3395 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3400 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3401 doc
: /* Set the file permission bits for newly created files.
3402 The argument MODE should be an integer; only the low 9 bits are used.
3403 This setting is inherited by subprocesses. */)
3407 CHECK_NUMBER (mode
);
3409 umask ((~ XINT (mode
)) & 0777);
3414 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3415 doc
: /* Return the default file protection for created files.
3416 The value is an integer. */)
3422 realmask
= umask (0);
3425 XSETINT (value
, (~ realmask
) & 0777);
3435 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3436 doc
: /* Tell Unix to finish all pending disk updates. */)
3445 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3446 doc
: /* Return t if file FILE1 is newer than file FILE2.
3447 If FILE1 does not exist, the answer is nil;
3448 otherwise, if FILE2 does not exist, the answer is t. */)
3450 Lisp_Object file1
, file2
;
3452 Lisp_Object absname1
, absname2
;
3455 Lisp_Object handler
;
3456 struct gcpro gcpro1
, gcpro2
;
3458 CHECK_STRING (file1
);
3459 CHECK_STRING (file2
);
3462 GCPRO2 (absname1
, file2
);
3463 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3464 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3467 /* If the file name has special constructs in it,
3468 call the corresponding file handler. */
3469 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3471 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3472 if (!NILP (handler
))
3473 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3475 GCPRO2 (absname1
, absname2
);
3476 absname1
= ENCODE_FILE (absname1
);
3477 absname2
= ENCODE_FILE (absname2
);
3480 if (stat (SDATA (absname1
), &st
) < 0)
3483 mtime1
= st
.st_mtime
;
3485 if (stat (SDATA (absname2
), &st
) < 0)
3488 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3492 Lisp_Object Qfind_buffer_file_type
;
3495 #ifndef READ_BUF_SIZE
3496 #define READ_BUF_SIZE (64 << 10)
3499 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3501 /* This function is called after Lisp functions to decide a coding
3502 system are called, or when they cause an error. Before they are
3503 called, the current buffer is set unibyte and it contains only a
3504 newly inserted text (thus the buffer was empty before the
3507 The functions may set markers, overlays, text properties, or even
3508 alter the buffer contents, change the current buffer.
3510 Here, we reset all those changes by:
3511 o set back the current buffer.
3512 o move all markers and overlays to BEG.
3513 o remove all text properties.
3514 o set back the buffer multibyteness. */
3517 decide_coding_unwind (unwind_data
)
3518 Lisp_Object unwind_data
;
3520 Lisp_Object multibyte
, undo_list
, buffer
;
3522 multibyte
= XCAR (unwind_data
);
3523 unwind_data
= XCDR (unwind_data
);
3524 undo_list
= XCAR (unwind_data
);
3525 buffer
= XCDR (unwind_data
);
3527 if (current_buffer
!= XBUFFER (buffer
))
3528 set_buffer_internal (XBUFFER (buffer
));
3529 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3530 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3531 BUF_INTERVALS (current_buffer
) = 0;
3532 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3534 /* Now we are safe to change the buffer's multibyteness directly. */
3535 current_buffer
->enable_multibyte_characters
= multibyte
;
3536 current_buffer
->undo_list
= undo_list
;
3542 /* Used to pass values from insert-file-contents to read_non_regular. */
3544 static int non_regular_fd
;
3545 static int non_regular_inserted
;
3546 static int non_regular_nbytes
;
3549 /* Read from a non-regular file.
3550 Read non_regular_trytry bytes max from non_regular_fd.
3551 Non_regular_inserted specifies where to put the read bytes.
3552 Value is the number of bytes read. */
3561 nbytes
= emacs_read (non_regular_fd
,
3562 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3563 non_regular_nbytes
);
3565 return make_number (nbytes
);
3569 /* Condition-case handler used when reading from non-regular files
3570 in insert-file-contents. */
3573 read_non_regular_quit ()
3579 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3581 doc
: /* Insert contents of file FILENAME after point.
3582 Returns list of absolute file name and number of characters inserted.
3583 If second argument VISIT is non-nil, the buffer's visited filename
3584 and last save file modtime are set, and it is marked unmodified.
3585 If visiting and the file does not exist, visiting is completed
3586 before the error is signaled.
3587 The optional third and fourth arguments BEG and END
3588 specify what portion of the file to insert.
3589 These arguments count bytes in the file, not characters in the buffer.
3590 If VISIT is non-nil, BEG and END must be nil.
3592 If optional fifth argument REPLACE is non-nil,
3593 it means replace the current buffer contents (in the accessible portion)
3594 with the file contents. This is better than simply deleting and inserting
3595 the whole thing because (1) it preserves some marker positions
3596 and (2) it puts less data in the undo list.
3597 When REPLACE is non-nil, the value is the number of characters actually read,
3598 which is often less than the number of characters to be read.
3600 This does code conversion according to the value of
3601 `coding-system-for-read' or `file-coding-system-alist',
3602 and sets the variable `last-coding-system-used' to the coding system
3604 (filename
, visit
, beg
, end
, replace
)
3605 Lisp_Object filename
, visit
, beg
, end
, replace
;
3610 register int how_much
;
3611 register int unprocessed
;
3612 int count
= SPECPDL_INDEX ();
3613 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3614 Lisp_Object handler
, val
, insval
, orig_filename
;
3617 int not_regular
= 0;
3618 unsigned char read_buf
[READ_BUF_SIZE
];
3619 struct coding_system coding
;
3620 unsigned char buffer
[1 << 14];
3621 int replace_handled
= 0;
3622 int set_coding_system
= 0;
3623 int coding_system_decided
= 0;
3626 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3627 error ("Cannot do file visiting in an indirect buffer");
3629 if (!NILP (current_buffer
->read_only
))
3630 Fbarf_if_buffer_read_only ();
3634 orig_filename
= Qnil
;
3636 GCPRO4 (filename
, val
, p
, orig_filename
);
3638 CHECK_STRING (filename
);
3639 filename
= Fexpand_file_name (filename
, Qnil
);
3641 /* If the file name has special constructs in it,
3642 call the corresponding file handler. */
3643 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3644 if (!NILP (handler
))
3646 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3647 visit
, beg
, end
, replace
);
3648 if (CONSP (val
) && CONSP (XCDR (val
)))
3649 inserted
= XINT (XCAR (XCDR (val
)));
3653 orig_filename
= filename
;
3654 filename
= ENCODE_FILE (filename
);
3660 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3662 /* Tell stat to use expensive method to get accurate info. */
3663 Vw32_get_true_file_attributes
= Qt
;
3664 total
= stat (SDATA (filename
), &st
);
3665 Vw32_get_true_file_attributes
= tem
;
3670 if (stat (SDATA (filename
), &st
) < 0)
3672 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3673 || fstat (fd
, &st
) < 0)
3674 #endif /* not APOLLO */
3675 #endif /* WINDOWSNT */
3677 if (fd
>= 0) emacs_close (fd
);
3680 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3683 if (!NILP (Vcoding_system_for_read
))
3684 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3689 /* This code will need to be changed in order to work on named
3690 pipes, and it's probably just not worth it. So we should at
3691 least signal an error. */
3692 if (!S_ISREG (st
.st_mode
))
3699 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3700 Fsignal (Qfile_error
,
3701 Fcons (build_string ("not a regular file"),
3702 Fcons (orig_filename
, Qnil
)));
3707 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3710 /* Replacement should preserve point as it preserves markers. */
3711 if (!NILP (replace
))
3712 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3714 record_unwind_protect (close_file_unwind
, make_number (fd
));
3716 /* Supposedly happens on VMS. */
3717 /* Can happen on any platform that uses long as type of off_t, but allows
3718 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3719 give a message suitable for the latter case. */
3720 if (! not_regular
&& st
.st_size
< 0)
3721 error ("Maximum buffer size exceeded");
3723 /* Prevent redisplay optimizations. */
3724 current_buffer
->clip_changed
= 1;
3728 if (!NILP (beg
) || !NILP (end
))
3729 error ("Attempt to visit less than an entire file");
3730 if (BEG
< Z
&& NILP (replace
))
3731 error ("Cannot do file visiting in a non-empty buffer");
3737 XSETFASTINT (beg
, 0);
3745 XSETINT (end
, st
.st_size
);
3747 /* Arithmetic overflow can occur if an Emacs integer cannot
3748 represent the file size, or if the calculations below
3749 overflow. The calculations below double the file size
3750 twice, so check that it can be multiplied by 4 safely. */
3751 if (XINT (end
) != st
.st_size
3752 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3753 error ("Maximum buffer size exceeded");
3755 /* The file size returned from stat may be zero, but data
3756 may be readable nonetheless, for example when this is a
3757 file in the /proc filesystem. */
3758 if (st
.st_size
== 0)
3759 XSETINT (end
, READ_BUF_SIZE
);
3765 /* Decide the coding system to use for reading the file now
3766 because we can't use an optimized method for handling
3767 `coding:' tag if the current buffer is not empty. */
3771 if (!NILP (Vcoding_system_for_read
))
3772 val
= Vcoding_system_for_read
;
3773 else if (! NILP (replace
))
3774 /* In REPLACE mode, we can use the same coding system
3775 that was used to visit the file. */
3776 val
= current_buffer
->buffer_file_coding_system
;
3779 /* Don't try looking inside a file for a coding system
3780 specification if it is not seekable. */
3781 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3783 /* Find a coding system specified in the heading two
3784 lines or in the tailing several lines of the file.
3785 We assume that the 1K-byte and 3K-byte for heading
3786 and tailing respectively are sufficient for this
3790 if (st
.st_size
<= (1024 * 4))
3791 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3794 nread
= emacs_read (fd
, read_buf
, 1024);
3797 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3798 report_file_error ("Setting file position",
3799 Fcons (orig_filename
, Qnil
));
3800 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3805 error ("IO error reading %s: %s",
3806 SDATA (orig_filename
), emacs_strerror (errno
));
3809 struct buffer
*prev
= current_buffer
;
3813 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3815 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3816 buf
= XBUFFER (buffer
);
3818 buf
->directory
= current_buffer
->directory
;
3819 buf
->read_only
= Qnil
;
3820 buf
->filename
= Qnil
;
3821 buf
->undo_list
= Qt
;
3822 buf
->overlays_before
= Qnil
;
3823 buf
->overlays_after
= Qnil
;
3825 set_buffer_internal (buf
);
3827 buf
->enable_multibyte_characters
= Qnil
;
3829 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3830 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3831 val
= call2 (Vset_auto_coding_function
,
3832 filename
, make_number (nread
));
3833 set_buffer_internal (prev
);
3835 /* Discard the unwind protect for recovering the
3839 /* Rewind the file for the actual read done later. */
3840 if (lseek (fd
, 0, 0) < 0)
3841 report_file_error ("Setting file position",
3842 Fcons (orig_filename
, Qnil
));
3848 /* If we have not yet decided a coding system, check
3849 file-coding-system-alist. */
3850 Lisp_Object args
[6], coding_systems
;
3852 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3853 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3854 coding_systems
= Ffind_operation_coding_system (6, args
);
3855 if (CONSP (coding_systems
))
3856 val
= XCAR (coding_systems
);
3860 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3861 /* Ensure we set Vlast_coding_system_used. */
3862 set_coding_system
= 1;
3864 if (NILP (current_buffer
->enable_multibyte_characters
)
3866 /* We must suppress all character code conversion except for
3867 end-of-line conversion. */
3868 setup_raw_text_coding_system (&coding
);
3870 coding
.src_multibyte
= 0;
3871 coding
.dst_multibyte
3872 = !NILP (current_buffer
->enable_multibyte_characters
);
3873 coding_system_decided
= 1;
3876 /* If requested, replace the accessible part of the buffer
3877 with the file contents. Avoid replacing text at the
3878 beginning or end of the buffer that matches the file contents;
3879 that preserves markers pointing to the unchanged parts.
3881 Here we implement this feature in an optimized way
3882 for the case where code conversion is NOT needed.
3883 The following if-statement handles the case of conversion
3884 in a less optimal way.
3886 If the code conversion is "automatic" then we try using this
3887 method and hope for the best.
3888 But if we discover the need for conversion, we give up on this method
3889 and let the following if-statement handle the replace job. */
3892 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3894 /* same_at_start and same_at_end count bytes,
3895 because file access counts bytes
3896 and BEG and END count bytes. */
3897 int same_at_start
= BEGV_BYTE
;
3898 int same_at_end
= ZV_BYTE
;
3900 /* There is still a possibility we will find the need to do code
3901 conversion. If that happens, we set this variable to 1 to
3902 give up on handling REPLACE in the optimized way. */
3903 int giveup_match_end
= 0;
3905 if (XINT (beg
) != 0)
3907 if (lseek (fd
, XINT (beg
), 0) < 0)
3908 report_file_error ("Setting file position",
3909 Fcons (orig_filename
, Qnil
));
3914 /* Count how many chars at the start of the file
3915 match the text at the beginning of the buffer. */
3920 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3922 error ("IO error reading %s: %s",
3923 SDATA (orig_filename
), emacs_strerror (errno
));
3924 else if (nread
== 0)
3927 if (coding
.type
== coding_type_undecided
)
3928 detect_coding (&coding
, buffer
, nread
);
3929 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
3930 /* We found that the file should be decoded somehow.
3931 Let's give up here. */
3933 giveup_match_end
= 1;
3937 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3938 detect_eol (&coding
, buffer
, nread
);
3939 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3940 && coding
.eol_type
!= CODING_EOL_LF
)
3941 /* We found that the format of eol should be decoded.
3942 Let's give up here. */
3944 giveup_match_end
= 1;
3949 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3950 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3951 same_at_start
++, bufpos
++;
3952 /* If we found a discrepancy, stop the scan.
3953 Otherwise loop around and scan the next bufferful. */
3954 if (bufpos
!= nread
)
3958 /* If the file matches the buffer completely,
3959 there's no need to replace anything. */
3960 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3964 /* Truncate the buffer to the size of the file. */
3965 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3970 /* Count how many chars at the end of the file
3971 match the text at the end of the buffer. But, if we have
3972 already found that decoding is necessary, don't waste time. */
3973 while (!giveup_match_end
)
3975 int total_read
, nread
, bufpos
, curpos
, trial
;
3977 /* At what file position are we now scanning? */
3978 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3979 /* If the entire file matches the buffer tail, stop the scan. */
3982 /* How much can we scan in the next step? */
3983 trial
= min (curpos
, sizeof buffer
);
3984 if (lseek (fd
, curpos
- trial
, 0) < 0)
3985 report_file_error ("Setting file position",
3986 Fcons (orig_filename
, Qnil
));
3988 total_read
= nread
= 0;
3989 while (total_read
< trial
)
3991 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3993 error ("IO error reading %s: %s",
3994 SDATA (orig_filename
), emacs_strerror (errno
));
3995 else if (nread
== 0)
3997 total_read
+= nread
;
4000 /* Scan this bufferful from the end, comparing with
4001 the Emacs buffer. */
4002 bufpos
= total_read
;
4004 /* Compare with same_at_start to avoid counting some buffer text
4005 as matching both at the file's beginning and at the end. */
4006 while (bufpos
> 0 && same_at_end
> same_at_start
4007 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4008 same_at_end
--, bufpos
--;
4010 /* If we found a discrepancy, stop the scan.
4011 Otherwise loop around and scan the preceding bufferful. */
4014 /* If this discrepancy is because of code conversion,
4015 we cannot use this method; giveup and try the other. */
4016 if (same_at_end
> same_at_start
4017 && FETCH_BYTE (same_at_end
- 1) >= 0200
4018 && ! NILP (current_buffer
->enable_multibyte_characters
)
4019 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4020 giveup_match_end
= 1;
4029 if (! giveup_match_end
)
4033 /* We win! We can handle REPLACE the optimized way. */
4035 /* Extend the start of non-matching text area to multibyte
4036 character boundary. */
4037 if (! NILP (current_buffer
->enable_multibyte_characters
))
4038 while (same_at_start
> BEGV_BYTE
4039 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4042 /* Extend the end of non-matching text area to multibyte
4043 character boundary. */
4044 if (! NILP (current_buffer
->enable_multibyte_characters
))
4045 while (same_at_end
< ZV_BYTE
4046 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4049 /* Don't try to reuse the same piece of text twice. */
4050 overlap
= (same_at_start
- BEGV_BYTE
4051 - (same_at_end
+ st
.st_size
- ZV
));
4053 same_at_end
+= overlap
;
4055 /* Arrange to read only the nonmatching middle part of the file. */
4056 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4057 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4059 del_range_byte (same_at_start
, same_at_end
, 0);
4060 /* Insert from the file at the proper position. */
4061 temp
= BYTE_TO_CHAR (same_at_start
);
4062 SET_PT_BOTH (temp
, same_at_start
);
4064 /* If display currently starts at beginning of line,
4065 keep it that way. */
4066 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4067 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4069 replace_handled
= 1;
4073 /* If requested, replace the accessible part of the buffer
4074 with the file contents. Avoid replacing text at the
4075 beginning or end of the buffer that matches the file contents;
4076 that preserves markers pointing to the unchanged parts.
4078 Here we implement this feature for the case where code conversion
4079 is needed, in a simple way that needs a lot of memory.
4080 The preceding if-statement handles the case of no conversion
4081 in a more optimized way. */
4082 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4084 int same_at_start
= BEGV_BYTE
;
4085 int same_at_end
= ZV_BYTE
;
4088 /* Make sure that the gap is large enough. */
4089 int bufsize
= 2 * st
.st_size
;
4090 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4093 /* First read the whole file, performing code conversion into
4094 CONVERSION_BUFFER. */
4096 if (lseek (fd
, XINT (beg
), 0) < 0)
4098 xfree (conversion_buffer
);
4099 report_file_error ("Setting file position",
4100 Fcons (orig_filename
, Qnil
));
4103 total
= st
.st_size
; /* Total bytes in the file. */
4104 how_much
= 0; /* Bytes read from file so far. */
4105 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4106 unprocessed
= 0; /* Bytes not processed in previous loop. */
4108 while (how_much
< total
)
4110 /* try is reserved in some compilers (Microsoft C) */
4111 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4112 unsigned char *destination
= read_buf
+ unprocessed
;
4115 /* Allow quitting out of the actual I/O. */
4118 this = emacs_read (fd
, destination
, trytry
);
4121 if (this < 0 || this + unprocessed
== 0)
4129 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4131 int require
, result
;
4133 this += unprocessed
;
4135 /* If we are using more space than estimated,
4136 make CONVERSION_BUFFER bigger. */
4137 require
= decoding_buffer_size (&coding
, this);
4138 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4140 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4141 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4144 /* Convert this batch with results in CONVERSION_BUFFER. */
4145 if (how_much
>= total
) /* This is the last block. */
4146 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4147 if (coding
.composing
!= COMPOSITION_DISABLED
)
4148 coding_allocate_composition_data (&coding
, BEGV
);
4149 result
= decode_coding (&coding
, read_buf
,
4150 conversion_buffer
+ inserted
,
4151 this, bufsize
- inserted
);
4153 /* Save for next iteration whatever we didn't convert. */
4154 unprocessed
= this - coding
.consumed
;
4155 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4156 if (!NILP (current_buffer
->enable_multibyte_characters
))
4157 this = coding
.produced
;
4159 this = str_as_unibyte (conversion_buffer
+ inserted
,
4166 /* At this point, INSERTED is how many characters (i.e. bytes)
4167 are present in CONVERSION_BUFFER.
4168 HOW_MUCH should equal TOTAL,
4169 or should be <= 0 if we couldn't read the file. */
4173 xfree (conversion_buffer
);
4176 error ("IO error reading %s: %s",
4177 SDATA (orig_filename
), emacs_strerror (errno
));
4178 else if (how_much
== -2)
4179 error ("maximum buffer size exceeded");
4182 /* Compare the beginning of the converted file
4183 with the buffer text. */
4186 while (bufpos
< inserted
&& same_at_start
< same_at_end
4187 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4188 same_at_start
++, bufpos
++;
4190 /* If the file matches the buffer completely,
4191 there's no need to replace anything. */
4193 if (bufpos
== inserted
)
4195 xfree (conversion_buffer
);
4198 /* Truncate the buffer to the size of the file. */
4199 del_range_byte (same_at_start
, same_at_end
, 0);
4204 /* Extend the start of non-matching text area to multibyte
4205 character boundary. */
4206 if (! NILP (current_buffer
->enable_multibyte_characters
))
4207 while (same_at_start
> BEGV_BYTE
4208 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4211 /* Scan this bufferful from the end, comparing with
4212 the Emacs buffer. */
4215 /* Compare with same_at_start to avoid counting some buffer text
4216 as matching both at the file's beginning and at the end. */
4217 while (bufpos
> 0 && same_at_end
> same_at_start
4218 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4219 same_at_end
--, bufpos
--;
4221 /* Extend the end of non-matching text area to multibyte
4222 character boundary. */
4223 if (! NILP (current_buffer
->enable_multibyte_characters
))
4224 while (same_at_end
< ZV_BYTE
4225 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4228 /* Don't try to reuse the same piece of text twice. */
4229 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4231 same_at_end
+= overlap
;
4233 /* If display currently starts at beginning of line,
4234 keep it that way. */
4235 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4236 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4238 /* Replace the chars that we need to replace,
4239 and update INSERTED to equal the number of bytes
4240 we are taking from the file. */
4241 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4243 if (same_at_end
!= same_at_start
)
4245 del_range_byte (same_at_start
, same_at_end
, 0);
4247 same_at_start
= GPT_BYTE
;
4251 temp
= BYTE_TO_CHAR (same_at_start
);
4253 /* Insert from the file at the proper position. */
4254 SET_PT_BOTH (temp
, same_at_start
);
4255 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
4257 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4258 coding_restore_composition (&coding
, Fcurrent_buffer ());
4259 coding_free_composition_data (&coding
);
4261 /* Set `inserted' to the number of inserted characters. */
4262 inserted
= PT
- temp
;
4264 xfree (conversion_buffer
);
4273 register Lisp_Object temp
;
4275 total
= XINT (end
) - XINT (beg
);
4277 /* Make sure point-max won't overflow after this insertion. */
4278 XSETINT (temp
, total
);
4279 if (total
!= XINT (temp
))
4280 error ("Maximum buffer size exceeded");
4283 /* For a special file, all we can do is guess. */
4284 total
= READ_BUF_SIZE
;
4286 if (NILP (visit
) && total
> 0)
4287 prepare_to_modify_buffer (PT
, PT
, NULL
);
4290 if (GAP_SIZE
< total
)
4291 make_gap (total
- GAP_SIZE
);
4293 if (XINT (beg
) != 0 || !NILP (replace
))
4295 if (lseek (fd
, XINT (beg
), 0) < 0)
4296 report_file_error ("Setting file position",
4297 Fcons (orig_filename
, Qnil
));
4300 /* In the following loop, HOW_MUCH contains the total bytes read so
4301 far for a regular file, and not changed for a special file. But,
4302 before exiting the loop, it is set to a negative value if I/O
4306 /* Total bytes inserted. */
4309 /* Here, we don't do code conversion in the loop. It is done by
4310 code_convert_region after all data are read into the buffer. */
4312 int gap_size
= GAP_SIZE
;
4314 while (how_much
< total
)
4316 /* try is reserved in some compilers (Microsoft C) */
4317 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4324 /* Maybe make more room. */
4325 if (gap_size
< trytry
)
4327 make_gap (total
- gap_size
);
4328 gap_size
= GAP_SIZE
;
4331 /* Read from the file, capturing `quit'. When an
4332 error occurs, end the loop, and arrange for a quit
4333 to be signaled after decoding the text we read. */
4334 non_regular_fd
= fd
;
4335 non_regular_inserted
= inserted
;
4336 non_regular_nbytes
= trytry
;
4337 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4338 read_non_regular_quit
);
4349 /* Allow quitting out of the actual I/O. We don't make text
4350 part of the buffer until all the reading is done, so a C-g
4351 here doesn't do any harm. */
4354 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4366 /* For a regular file, where TOTAL is the real size,
4367 count HOW_MUCH to compare with it.
4368 For a special file, where TOTAL is just a buffer size,
4369 so don't bother counting in HOW_MUCH.
4370 (INSERTED is where we count the number of characters inserted.) */
4377 /* Make the text read part of the buffer. */
4378 GAP_SIZE
-= inserted
;
4380 GPT_BYTE
+= inserted
;
4382 ZV_BYTE
+= inserted
;
4387 /* Put an anchor to ensure multi-byte form ends at gap. */
4392 /* Discard the unwind protect for closing the file. */
4396 error ("IO error reading %s: %s",
4397 SDATA (orig_filename
), emacs_strerror (errno
));
4401 if (! coding_system_decided
)
4403 /* The coding system is not yet decided. Decide it by an
4404 optimized method for handling `coding:' tag.
4406 Note that we can get here only if the buffer was empty
4407 before the insertion. */
4411 if (!NILP (Vcoding_system_for_read
))
4412 val
= Vcoding_system_for_read
;
4415 /* Since we are sure that the current buffer was empty
4416 before the insertion, we can toggle
4417 enable-multibyte-characters directly here without taking
4418 care of marker adjustment and byte combining problem. By
4419 this way, we can run Lisp program safely before decoding
4420 the inserted text. */
4421 Lisp_Object unwind_data
;
4422 int count
= SPECPDL_INDEX ();
4424 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4425 Fcons (current_buffer
->undo_list
,
4426 Fcurrent_buffer ()));
4427 current_buffer
->enable_multibyte_characters
= Qnil
;
4428 current_buffer
->undo_list
= Qt
;
4429 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4431 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4433 val
= call2 (Vset_auto_coding_function
,
4434 filename
, make_number (inserted
));
4439 /* If the coding system is not yet decided, check
4440 file-coding-system-alist. */
4441 Lisp_Object args
[6], coding_systems
;
4443 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4444 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4445 coding_systems
= Ffind_operation_coding_system (6, args
);
4446 if (CONSP (coding_systems
))
4447 val
= XCAR (coding_systems
);
4450 unbind_to (count
, Qnil
);
4451 inserted
= Z_BYTE
- BEG_BYTE
;
4454 /* The following kludgy code is to avoid some compiler bug.
4456 setup_coding_system (val, &coding);
4459 struct coding_system temp_coding
;
4460 setup_coding_system (val
, &temp_coding
);
4461 bcopy (&temp_coding
, &coding
, sizeof coding
);
4463 /* Ensure we set Vlast_coding_system_used. */
4464 set_coding_system
= 1;
4466 if (NILP (current_buffer
->enable_multibyte_characters
)
4468 /* We must suppress all character code conversion except for
4469 end-of-line conversion. */
4470 setup_raw_text_coding_system (&coding
);
4471 coding
.src_multibyte
= 0;
4472 coding
.dst_multibyte
4473 = !NILP (current_buffer
->enable_multibyte_characters
);
4477 /* Can't do this if part of the buffer might be preserved. */
4479 && (coding
.type
== coding_type_no_conversion
4480 || coding
.type
== coding_type_raw_text
))
4482 /* Visiting a file with these coding system makes the buffer
4484 current_buffer
->enable_multibyte_characters
= Qnil
;
4485 coding
.dst_multibyte
= 0;
4488 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4490 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4492 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4494 inserted
= coding
.produced_char
;
4497 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4501 /* Now INSERTED is measured in characters. */
4504 /* Use the conversion type to determine buffer-file-type
4505 (find-buffer-file-type is now used to help determine the
4507 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4508 || coding
.eol_type
== CODING_EOL_LF
)
4509 && ! CODING_REQUIRE_DECODING (&coding
))
4510 current_buffer
->buffer_file_type
= Qt
;
4512 current_buffer
->buffer_file_type
= Qnil
;
4519 if (!EQ (current_buffer
->undo_list
, Qt
))
4520 current_buffer
->undo_list
= Qnil
;
4522 stat (SDATA (filename
), &st
);
4527 current_buffer
->modtime
= st
.st_mtime
;
4528 current_buffer
->filename
= orig_filename
;
4531 SAVE_MODIFF
= MODIFF
;
4532 current_buffer
->auto_save_modified
= MODIFF
;
4533 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4534 #ifdef CLASH_DETECTION
4537 if (!NILP (current_buffer
->file_truename
))
4538 unlock_file (current_buffer
->file_truename
);
4539 unlock_file (filename
);
4541 #endif /* CLASH_DETECTION */
4543 Fsignal (Qfile_error
,
4544 Fcons (build_string ("not a regular file"),
4545 Fcons (orig_filename
, Qnil
)));
4548 if (set_coding_system
)
4549 Vlast_coding_system_used
= coding
.symbol
;
4551 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4553 insval
= call1 (Qafter_insert_file_set_coding
, make_number (inserted
));
4554 if (! NILP (insval
))
4556 CHECK_NUMBER (insval
);
4557 inserted
= XFASTINT (insval
);
4561 /* Decode file format */
4564 int empty_undo_list_p
= 0;
4566 /* If we're anyway going to discard undo information, don't
4567 record it in the first place. The buffer's undo list at this
4568 point is either nil or t when visiting a file. */
4571 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4572 current_buffer
->undo_list
= Qt
;
4575 insval
= call3 (Qformat_decode
,
4576 Qnil
, make_number (inserted
), visit
);
4577 CHECK_NUMBER (insval
);
4578 inserted
= XFASTINT (insval
);
4581 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4584 /* Call after-change hooks for the inserted text, aside from the case
4585 of normal visiting (not with REPLACE), which is done in a new buffer
4586 "before" the buffer is changed. */
4587 if (inserted
> 0 && total
> 0
4588 && (NILP (visit
) || !NILP (replace
)))
4590 signal_after_change (PT
, 0, inserted
);
4591 update_compositions (PT
, PT
, CHECK_BORDER
);
4594 p
= Vafter_insert_file_functions
;
4597 insval
= call1 (XCAR (p
), make_number (inserted
));
4600 CHECK_NUMBER (insval
);
4601 inserted
= XFASTINT (insval
);
4608 && current_buffer
->modtime
== -1)
4610 /* If visiting nonexistent file, return nil. */
4611 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4615 Fsignal (Qquit
, Qnil
);
4617 /* ??? Retval needs to be dealt with in all cases consistently. */
4619 val
= Fcons (orig_filename
,
4620 Fcons (make_number (inserted
),
4623 RETURN_UNGCPRO (unbind_to (count
, val
));
4626 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4627 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4628 Lisp_Object
, Lisp_Object
));
4630 /* If build_annotations switched buffers, switch back to BUF.
4631 Kill the temporary buffer that was selected in the meantime.
4633 Since this kill only the last temporary buffer, some buffers remain
4634 not killed if build_annotations switched buffers more than once.
4638 build_annotations_unwind (buf
)
4643 if (XBUFFER (buf
) == current_buffer
)
4645 tembuf
= Fcurrent_buffer ();
4647 Fkill_buffer (tembuf
);
4651 /* Decide the coding-system to encode the data with. */
4654 choose_write_coding_system (start
, end
, filename
,
4655 append
, visit
, lockname
, coding
)
4656 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4657 struct coding_system
*coding
;
4663 else if (!NILP (Vcoding_system_for_write
))
4665 val
= Vcoding_system_for_write
;
4666 if (coding_system_require_warning
4667 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4668 /* Confirm that VAL can surely encode the current region. */
4669 val
= call5 (Vselect_safe_coding_system_function
,
4670 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4675 /* If the variable `buffer-file-coding-system' is set locally,
4676 it means that the file was read with some kind of code
4677 conversion or the variable is explicitly set by users. We
4678 had better write it out with the same coding system even if
4679 `enable-multibyte-characters' is nil.
4681 If it is not set locally, we anyway have to convert EOL
4682 format if the default value of `buffer-file-coding-system'
4683 tells that it is not Unix-like (LF only) format. */
4684 int using_default_coding
= 0;
4685 int force_raw_text
= 0;
4687 val
= current_buffer
->buffer_file_coding_system
;
4689 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4692 if (NILP (current_buffer
->enable_multibyte_characters
))
4698 /* Check file-coding-system-alist. */
4699 Lisp_Object args
[7], coding_systems
;
4701 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4702 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4704 coding_systems
= Ffind_operation_coding_system (7, args
);
4705 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4706 val
= XCDR (coding_systems
);
4710 && !NILP (current_buffer
->buffer_file_coding_system
))
4712 /* If we still have not decided a coding system, use the
4713 default value of buffer-file-coding-system. */
4714 val
= current_buffer
->buffer_file_coding_system
;
4715 using_default_coding
= 1;
4719 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4720 /* Confirm that VAL can surely encode the current region. */
4721 val
= call5 (Vselect_safe_coding_system_function
,
4722 start
, end
, val
, Qnil
, filename
);
4724 setup_coding_system (Fcheck_coding_system (val
), coding
);
4725 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4726 && !using_default_coding
)
4728 if (! EQ (default_buffer_file_coding
.symbol
,
4729 buffer_defaults
.buffer_file_coding_system
))
4730 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4731 &default_buffer_file_coding
);
4732 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4734 Lisp_Object subsidiaries
;
4736 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4737 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4738 if (VECTORP (subsidiaries
)
4739 && XVECTOR (subsidiaries
)->size
== 3)
4741 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4746 setup_raw_text_coding_system (coding
);
4747 goto done_setup_coding
;
4750 setup_coding_system (Fcheck_coding_system (val
), coding
);
4753 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4754 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4757 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4758 "r\nFWrite region to file: \ni\ni\ni\np",
4759 doc
: /* Write current region into specified file.
4760 When called from a program, requires three arguments:
4761 START, END and FILENAME. START and END are normally buffer positions
4762 specifying the part of the buffer to write.
4763 If START is nil, that means to use the entire buffer contents.
4764 If START is a string, then output that string to the file
4765 instead of any buffer contents; END is ignored.
4767 Optional fourth argument APPEND if non-nil means
4768 append to existing file contents (if any). If it is an integer,
4769 seek to that offset in the file before writing.
4770 Optional fifth argument VISIT if t means
4771 set the last-save-file-modtime of buffer to this file's modtime
4772 and mark buffer not modified.
4773 If VISIT is a string, it is a second file name;
4774 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4775 VISIT is also the file name to lock and unlock for clash detection.
4776 If VISIT is neither t nor nil nor a string,
4777 that means do not display the \"Wrote file\" message.
4778 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4779 use for locking and unlocking, overriding FILENAME and VISIT.
4780 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4781 for an existing file with the same name. If MUSTBENEW is `excl',
4782 that means to get an error if the file already exists; never overwrite.
4783 If MUSTBENEW is neither nil nor `excl', that means ask for
4784 confirmation before overwriting, but do go ahead and overwrite the file
4785 if the user confirms.
4787 This does code conversion according to the value of
4788 `coding-system-for-write', `buffer-file-coding-system', or
4789 `file-coding-system-alist', and sets the variable
4790 `last-coding-system-used' to the coding system actually used. */)
4791 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4792 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4797 const unsigned char *fn
;
4800 int count
= SPECPDL_INDEX ();
4803 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4805 Lisp_Object handler
;
4806 Lisp_Object visit_file
;
4807 Lisp_Object annotations
;
4808 Lisp_Object encoded_filename
;
4809 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4810 int quietly
= !NILP (visit
);
4811 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4812 struct buffer
*given_buffer
;
4814 int buffer_file_type
= O_BINARY
;
4816 struct coding_system coding
;
4818 if (current_buffer
->base_buffer
&& visiting
)
4819 error ("Cannot do file visiting in an indirect buffer");
4821 if (!NILP (start
) && !STRINGP (start
))
4822 validate_region (&start
, &end
);
4824 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4826 filename
= Fexpand_file_name (filename
, Qnil
);
4828 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4829 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4831 if (STRINGP (visit
))
4832 visit_file
= Fexpand_file_name (visit
, Qnil
);
4834 visit_file
= filename
;
4836 if (NILP (lockname
))
4837 lockname
= visit_file
;
4841 /* If the file name has special constructs in it,
4842 call the corresponding file handler. */
4843 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4844 /* If FILENAME has no handler, see if VISIT has one. */
4845 if (NILP (handler
) && STRINGP (visit
))
4846 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4848 if (!NILP (handler
))
4851 val
= call6 (handler
, Qwrite_region
, start
, end
,
4852 filename
, append
, visit
);
4856 SAVE_MODIFF
= MODIFF
;
4857 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4858 current_buffer
->filename
= visit_file
;
4864 /* Special kludge to simplify auto-saving. */
4867 XSETFASTINT (start
, BEG
);
4868 XSETFASTINT (end
, Z
);
4871 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4872 count1
= SPECPDL_INDEX ();
4874 given_buffer
= current_buffer
;
4876 if (!STRINGP (start
))
4878 annotations
= build_annotations (start
, end
);
4880 if (current_buffer
!= given_buffer
)
4882 XSETFASTINT (start
, BEGV
);
4883 XSETFASTINT (end
, ZV
);
4889 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4891 /* Decide the coding-system to encode the data with.
4892 We used to make this choice before calling build_annotations, but that
4893 leads to problems when a write-annotate-function takes care of
4894 unsavable chars (as was the case with X-Symbol). */
4895 choose_write_coding_system (start
, end
, filename
,
4896 append
, visit
, lockname
, &coding
);
4897 Vlast_coding_system_used
= coding
.symbol
;
4899 given_buffer
= current_buffer
;
4900 if (! STRINGP (start
))
4902 annotations
= build_annotations_2 (start
, end
,
4903 coding
.pre_write_conversion
, annotations
);
4904 if (current_buffer
!= given_buffer
)
4906 XSETFASTINT (start
, BEGV
);
4907 XSETFASTINT (end
, ZV
);
4911 #ifdef CLASH_DETECTION
4914 #if 0 /* This causes trouble for GNUS. */
4915 /* If we've locked this file for some other buffer,
4916 query before proceeding. */
4917 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4918 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4921 lock_file (lockname
);
4923 #endif /* CLASH_DETECTION */
4925 encoded_filename
= ENCODE_FILE (filename
);
4927 fn
= SDATA (encoded_filename
);
4931 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4932 #else /* not DOS_NT */
4933 desc
= emacs_open (fn
, O_WRONLY
, 0);
4934 #endif /* not DOS_NT */
4936 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4938 if (auto_saving
) /* Overwrite any previous version of autosave file */
4940 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4941 desc
= emacs_open (fn
, O_RDWR
, 0);
4943 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4944 ? SDATA (current_buffer
->filename
) : 0,
4947 else /* Write to temporary name and rename if no errors */
4949 Lisp_Object temp_name
;
4950 temp_name
= Ffile_name_directory (filename
);
4952 if (!NILP (temp_name
))
4954 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4955 build_string ("$$SAVE$$")));
4956 fname
= SDATA (filename
);
4957 fn
= SDATA (temp_name
);
4958 desc
= creat_copy_attrs (fname
, fn
);
4961 /* If we can't open the temporary file, try creating a new
4962 version of the original file. VMS "creat" creates a
4963 new version rather than truncating an existing file. */
4966 desc
= creat (fn
, 0666);
4967 #if 0 /* This can clobber an existing file and fail to replace it,
4968 if the user runs out of space. */
4971 /* We can't make a new version;
4972 try to truncate and rewrite existing version if any. */
4974 desc
= emacs_open (fn
, O_RDWR
, 0);
4980 desc
= creat (fn
, 0666);
4984 desc
= emacs_open (fn
,
4985 O_WRONLY
| O_CREAT
| buffer_file_type
4986 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4987 S_IREAD
| S_IWRITE
);
4988 #else /* not DOS_NT */
4989 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4990 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4991 auto_saving
? auto_save_mode_bits
: 0666);
4992 #endif /* not DOS_NT */
4993 #endif /* not VMS */
4997 #ifdef CLASH_DETECTION
4999 if (!auto_saving
) unlock_file (lockname
);
5001 #endif /* CLASH_DETECTION */
5003 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5006 record_unwind_protect (close_file_unwind
, make_number (desc
));
5008 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5012 if (NUMBERP (append
))
5013 ret
= lseek (desc
, XINT (append
), 1);
5015 ret
= lseek (desc
, 0, 2);
5018 #ifdef CLASH_DETECTION
5019 if (!auto_saving
) unlock_file (lockname
);
5020 #endif /* CLASH_DETECTION */
5022 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5030 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5031 * if we do writes that don't end with a carriage return. Furthermore
5032 * it cannot handle writes of more then 16K. The modified
5033 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5034 * this EXCEPT for the last record (iff it doesn't end with a carriage
5035 * return). This implies that if your buffer doesn't end with a carriage
5036 * return, you get one free... tough. However it also means that if
5037 * we make two calls to sys_write (a la the following code) you can
5038 * get one at the gap as well. The easiest way to fix this (honest)
5039 * is to move the gap to the next newline (or the end of the buffer).
5044 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5045 move_gap (find_next_newline (GPT
, 1));
5047 /* Whether VMS or not, we must move the gap to the next of newline
5048 when we must put designation sequences at beginning of line. */
5049 if (INTEGERP (start
)
5050 && coding
.type
== coding_type_iso2022
5051 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5052 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5054 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5055 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5056 move_gap_both (PT
, PT_BYTE
);
5057 SET_PT_BOTH (opoint
, opoint_byte
);
5064 if (STRINGP (start
))
5066 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5067 &annotations
, &coding
);
5070 else if (XINT (start
) != XINT (end
))
5072 tem
= CHAR_TO_BYTE (XINT (start
));
5074 if (XINT (start
) < GPT
)
5076 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5077 min (GPT
, XINT (end
)) - XINT (start
),
5078 &annotations
, &coding
);
5082 if (XINT (end
) > GPT
&& !failure
)
5084 tem
= max (XINT (start
), GPT
);
5085 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5086 &annotations
, &coding
);
5092 /* If file was empty, still need to write the annotations */
5093 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5094 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5098 if (CODING_REQUIRE_FLUSHING (&coding
)
5099 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5102 /* We have to flush out a data. */
5103 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5104 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5111 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5112 Disk full in NFS may be reported here. */
5113 /* mib says that closing the file will try to write as fast as NFS can do
5114 it, and that means the fsync here is not crucial for autosave files. */
5115 if (!auto_saving
&& fsync (desc
) < 0)
5117 /* If fsync fails with EINTR, don't treat that as serious. */
5119 failure
= 1, save_errno
= errno
;
5123 /* Spurious "file has changed on disk" warnings have been
5124 observed on Suns as well.
5125 It seems that `close' can change the modtime, under nfs.
5127 (This has supposedly been fixed in Sunos 4,
5128 but who knows about all the other machines with NFS?) */
5131 /* On VMS and APOLLO, must do the stat after the close
5132 since closing changes the modtime. */
5135 /* Recall that #if defined does not work on VMS. */
5142 /* NFS can report a write failure now. */
5143 if (emacs_close (desc
) < 0)
5144 failure
= 1, save_errno
= errno
;
5147 /* If we wrote to a temporary name and had no errors, rename to real name. */
5151 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5159 /* Discard the unwind protect for close_file_unwind. */
5160 specpdl_ptr
= specpdl
+ count1
;
5161 /* Restore the original current buffer. */
5162 visit_file
= unbind_to (count
, visit_file
);
5164 #ifdef CLASH_DETECTION
5166 unlock_file (lockname
);
5167 #endif /* CLASH_DETECTION */
5169 /* Do this before reporting IO error
5170 to avoid a "file has changed on disk" warning on
5171 next attempt to save. */
5173 current_buffer
->modtime
= st
.st_mtime
;
5176 error ("IO error writing %s: %s", SDATA (filename
),
5177 emacs_strerror (save_errno
));
5181 SAVE_MODIFF
= MODIFF
;
5182 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5183 current_buffer
->filename
= visit_file
;
5184 update_mode_lines
++;
5190 message_with_string ("Wrote %s", visit_file
, 1);
5195 Lisp_Object
merge ();
5197 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5198 doc
: /* Return t if (car A) is numerically less than (car B). */)
5202 return Flss (Fcar (a
), Fcar (b
));
5205 /* Build the complete list of annotations appropriate for writing out
5206 the text between START and END, by calling all the functions in
5207 write-region-annotate-functions and merging the lists they return.
5208 If one of these functions switches to a different buffer, we assume
5209 that buffer contains altered text. Therefore, the caller must
5210 make sure to restore the current buffer in all cases,
5211 as save-excursion would do. */
5214 build_annotations (start
, end
)
5215 Lisp_Object start
, end
;
5217 Lisp_Object annotations
;
5219 struct gcpro gcpro1
, gcpro2
;
5220 Lisp_Object original_buffer
;
5221 int i
, used_global
= 0;
5223 XSETBUFFER (original_buffer
, current_buffer
);
5226 p
= Vwrite_region_annotate_functions
;
5227 GCPRO2 (annotations
, p
);
5230 struct buffer
*given_buffer
= current_buffer
;
5231 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5232 { /* Use the global value of the hook. */
5235 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5237 p
= Fappend (2, arg
);
5240 Vwrite_region_annotations_so_far
= annotations
;
5241 res
= call2 (XCAR (p
), start
, end
);
5242 /* If the function makes a different buffer current,
5243 assume that means this buffer contains altered text to be output.
5244 Reset START and END from the buffer bounds
5245 and discard all previous annotations because they should have
5246 been dealt with by this function. */
5247 if (current_buffer
!= given_buffer
)
5249 XSETFASTINT (start
, BEGV
);
5250 XSETFASTINT (end
, ZV
);
5253 Flength (res
); /* Check basic validity of return value */
5254 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5258 /* Now do the same for annotation functions implied by the file-format */
5259 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5260 p
= Vauto_save_file_format
;
5262 p
= current_buffer
->file_format
;
5263 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5265 struct buffer
*given_buffer
= current_buffer
;
5267 Vwrite_region_annotations_so_far
= annotations
;
5269 /* Value is either a list of annotations or nil if the function
5270 has written annotations to a temporary buffer, which is now
5272 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5273 original_buffer
, make_number (i
));
5274 if (current_buffer
!= given_buffer
)
5276 XSETFASTINT (start
, BEGV
);
5277 XSETFASTINT (end
, ZV
);
5282 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5290 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5291 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5293 struct gcpro gcpro1
;
5296 GCPRO1 (annotations
);
5297 /* At last, do the same for the function PRE_WRITE_CONVERSION
5298 implied by the current coding-system. */
5299 if (!NILP (pre_write_conversion
))
5301 struct buffer
*given_buffer
= current_buffer
;
5302 Vwrite_region_annotations_so_far
= annotations
;
5303 res
= call2 (pre_write_conversion
, start
, end
);
5305 annotations
= (current_buffer
!= given_buffer
5307 : merge (annotations
, res
, Qcar_less_than_car
));
5314 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5315 If STRING is nil, POS is the character position in the current buffer.
5316 Intersperse with them the annotations from *ANNOT
5317 which fall within the range of POS to POS + NCHARS,
5318 each at its appropriate position.
5320 We modify *ANNOT by discarding elements as we use them up.
5322 The return value is negative in case of system call failure. */
5325 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5328 register int nchars
;
5331 struct coding_system
*coding
;
5335 int lastpos
= pos
+ nchars
;
5337 while (NILP (*annot
) || CONSP (*annot
))
5339 tem
= Fcar_safe (Fcar (*annot
));
5342 nextpos
= XFASTINT (tem
);
5344 /* If there are no more annotations in this range,
5345 output the rest of the range all at once. */
5346 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5347 return e_write (desc
, string
, pos
, lastpos
, coding
);
5349 /* Output buffer text up to the next annotation's position. */
5352 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5356 /* Output the annotation. */
5357 tem
= Fcdr (Fcar (*annot
));
5360 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5363 *annot
= Fcdr (*annot
);
5368 #ifndef WRITE_BUF_SIZE
5369 #define WRITE_BUF_SIZE (16 * 1024)
5372 /* Write text in the range START and END into descriptor DESC,
5373 encoding them with coding system CODING. If STRING is nil, START
5374 and END are character positions of the current buffer, else they
5375 are indexes to the string STRING. */
5378 e_write (desc
, string
, start
, end
, coding
)
5382 struct coding_system
*coding
;
5384 register char *addr
;
5385 register int nbytes
;
5386 char buf
[WRITE_BUF_SIZE
];
5390 coding
->composing
= COMPOSITION_DISABLED
;
5391 if (coding
->composing
!= COMPOSITION_DISABLED
)
5392 coding_save_composition (coding
, start
, end
, string
);
5394 if (STRINGP (string
))
5396 addr
= SDATA (string
);
5397 nbytes
= SBYTES (string
);
5398 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5400 else if (start
< end
)
5402 /* It is assured that the gap is not in the range START and END-1. */
5403 addr
= CHAR_POS_ADDR (start
);
5404 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5405 coding
->src_multibyte
5406 = !NILP (current_buffer
->enable_multibyte_characters
);
5412 coding
->src_multibyte
= 1;
5415 /* We used to have a code for handling selective display here. But,
5416 now it is handled within encode_coding. */
5421 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5422 if (coding
->produced
> 0)
5424 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5425 if (coding
->produced
)
5431 nbytes
-= coding
->consumed
;
5432 addr
+= coding
->consumed
;
5433 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5436 /* The source text ends by an incomplete multibyte form.
5437 There's no way other than write it out as is. */
5438 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5447 start
+= coding
->consumed_char
;
5448 if (coding
->cmp_data
)
5449 coding_adjust_composition_offset (coding
, start
);
5452 if (coding
->cmp_data
)
5453 coding_free_composition_data (coding
);
5458 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5459 Sverify_visited_file_modtime
, 1, 1, 0,
5460 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5461 This means that the file has not been changed since it was visited or saved. */)
5467 Lisp_Object handler
;
5468 Lisp_Object filename
;
5473 if (!STRINGP (b
->filename
)) return Qt
;
5474 if (b
->modtime
== 0) return Qt
;
5476 /* If the file name has special constructs in it,
5477 call the corresponding file handler. */
5478 handler
= Ffind_file_name_handler (b
->filename
,
5479 Qverify_visited_file_modtime
);
5480 if (!NILP (handler
))
5481 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5483 filename
= ENCODE_FILE (b
->filename
);
5485 if (stat (SDATA (filename
), &st
) < 0)
5487 /* If the file doesn't exist now and didn't exist before,
5488 we say that it isn't modified, provided the error is a tame one. */
5489 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5494 if (st
.st_mtime
== b
->modtime
5495 /* If both are positive, accept them if they are off by one second. */
5496 || (st
.st_mtime
> 0 && b
->modtime
> 0
5497 && (st
.st_mtime
== b
->modtime
+ 1
5498 || st
.st_mtime
== b
->modtime
- 1)))
5503 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5504 Sclear_visited_file_modtime
, 0, 0, 0,
5505 doc
: /* Clear out records of last mod time of visited file.
5506 Next attempt to save will certainly not complain of a discrepancy. */)
5509 current_buffer
->modtime
= 0;
5513 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5514 Svisited_file_modtime
, 0, 0, 0,
5515 doc
: /* Return the current buffer's recorded visited file modification time.
5516 The value is a list of the form (HIGH . LOW), like the time values
5517 that `file-attributes' returns. */)
5520 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5523 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5524 Sset_visited_file_modtime
, 0, 1, 0,
5525 doc
: /* Update buffer's recorded modification time from the visited file's time.
5526 Useful if the buffer was not read from the file normally
5527 or if the file itself has been changed for some known benign reason.
5528 An argument specifies the modification time value to use
5529 \(instead of that of the visited file), in the form of a list
5530 \(HIGH . LOW) or (HIGH LOW). */)
5532 Lisp_Object time_list
;
5534 if (!NILP (time_list
))
5535 current_buffer
->modtime
= cons_to_long (time_list
);
5538 register Lisp_Object filename
;
5540 Lisp_Object handler
;
5542 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5544 /* If the file name has special constructs in it,
5545 call the corresponding file handler. */
5546 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5547 if (!NILP (handler
))
5548 /* The handler can find the file name the same way we did. */
5549 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5551 filename
= ENCODE_FILE (filename
);
5553 if (stat (SDATA (filename
), &st
) >= 0)
5554 current_buffer
->modtime
= st
.st_mtime
;
5561 auto_save_error (error
)
5564 Lisp_Object args
[3], msg
;
5566 struct gcpro gcpro1
;
5570 args
[0] = build_string ("Auto-saving %s: %s");
5571 args
[1] = current_buffer
->name
;
5572 args
[2] = Ferror_message_string (error
);
5573 msg
= Fformat (3, args
);
5575 nbytes
= SBYTES (msg
);
5577 for (i
= 0; i
< 3; ++i
)
5580 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5582 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5583 Fsleep_for (make_number (1), Qnil
);
5595 /* Get visited file's mode to become the auto save file's mode. */
5596 if (! NILP (current_buffer
->filename
)
5597 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5598 /* But make sure we can overwrite it later! */
5599 auto_save_mode_bits
= st
.st_mode
| 0600;
5601 auto_save_mode_bits
= 0666;
5604 Fwrite_region (Qnil
, Qnil
,
5605 current_buffer
->auto_save_file_name
,
5606 Qnil
, Qlambda
, Qnil
, Qnil
);
5610 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5615 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5616 | XFASTINT (XCDR (stream
))));
5621 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5624 minibuffer_auto_raise
= XINT (value
);
5629 do_auto_save_make_dir (dir
)
5632 return call2 (Qmake_directory
, dir
, Qt
);
5636 do_auto_save_eh (ignore
)
5642 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5643 doc
: /* Auto-save all buffers that need it.
5644 This is all buffers that have auto-saving enabled
5645 and are changed since last auto-saved.
5646 Auto-saving writes the buffer into a file
5647 so that your editing is not lost if the system crashes.
5648 This file is not the file you visited; that changes only when you save.
5649 Normally we run the normal hook `auto-save-hook' before saving.
5651 A non-nil NO-MESSAGE argument means do not print any message if successful.
5652 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5653 (no_message
, current_only
)
5654 Lisp_Object no_message
, current_only
;
5656 struct buffer
*old
= current_buffer
, *b
;
5657 Lisp_Object tail
, buf
;
5659 int do_handled_files
;
5662 Lisp_Object lispstream
;
5663 int count
= SPECPDL_INDEX ();
5664 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5665 int old_message_p
= 0;
5666 struct gcpro gcpro1
, gcpro2
;
5668 if (max_specpdl_size
< specpdl_size
+ 40)
5669 max_specpdl_size
= specpdl_size
+ 40;
5674 if (NILP (no_message
))
5676 old_message_p
= push_message ();
5677 record_unwind_protect (pop_message_unwind
, Qnil
);
5680 /* Ordinarily don't quit within this function,
5681 but don't make it impossible to quit (in case we get hung in I/O). */
5685 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5686 point to non-strings reached from Vbuffer_alist. */
5688 if (!NILP (Vrun_hooks
))
5689 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5691 if (STRINGP (Vauto_save_list_file_name
))
5693 Lisp_Object listfile
;
5695 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5697 /* Don't try to create the directory when shutting down Emacs,
5698 because creating the directory might signal an error, and
5699 that would leave Emacs in a strange state. */
5700 if (!NILP (Vrun_hooks
))
5704 GCPRO2 (dir
, listfile
);
5705 dir
= Ffile_name_directory (listfile
);
5706 if (NILP (Ffile_directory_p (dir
)))
5707 internal_condition_case_1 (do_auto_save_make_dir
,
5708 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5713 stream
= fopen (SDATA (listfile
), "w");
5716 /* Arrange to close that file whether or not we get an error.
5717 Also reset auto_saving to 0. */
5718 lispstream
= Fcons (Qnil
, Qnil
);
5719 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5720 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5731 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5732 record_unwind_protect (do_auto_save_unwind_1
,
5733 make_number (minibuffer_auto_raise
));
5734 minibuffer_auto_raise
= 0;
5737 /* First, save all files which don't have handlers. If Emacs is
5738 crashing, the handlers may tweak what is causing Emacs to crash
5739 in the first place, and it would be a shame if Emacs failed to
5740 autosave perfectly ordinary files because it couldn't handle some
5742 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5743 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5745 buf
= XCDR (XCAR (tail
));
5748 /* Record all the buffers that have auto save mode
5749 in the special file that lists them. For each of these buffers,
5750 Record visited name (if any) and auto save name. */
5751 if (STRINGP (b
->auto_save_file_name
)
5752 && stream
!= NULL
&& do_handled_files
== 0)
5754 if (!NILP (b
->filename
))
5756 fwrite (SDATA (b
->filename
), 1,
5757 SBYTES (b
->filename
), stream
);
5759 putc ('\n', stream
);
5760 fwrite (SDATA (b
->auto_save_file_name
), 1,
5761 SBYTES (b
->auto_save_file_name
), stream
);
5762 putc ('\n', stream
);
5765 if (!NILP (current_only
)
5766 && b
!= current_buffer
)
5769 /* Don't auto-save indirect buffers.
5770 The base buffer takes care of it. */
5774 /* Check for auto save enabled
5775 and file changed since last auto save
5776 and file changed since last real save. */
5777 if (STRINGP (b
->auto_save_file_name
)
5778 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5779 && b
->auto_save_modified
< BUF_MODIFF (b
)
5780 /* -1 means we've turned off autosaving for a while--see below. */
5781 && XINT (b
->save_length
) >= 0
5782 && (do_handled_files
5783 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5786 EMACS_TIME before_time
, after_time
;
5788 EMACS_GET_TIME (before_time
);
5790 /* If we had a failure, don't try again for 20 minutes. */
5791 if (b
->auto_save_failure_time
>= 0
5792 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5795 if ((XFASTINT (b
->save_length
) * 10
5796 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5797 /* A short file is likely to change a large fraction;
5798 spare the user annoying messages. */
5799 && XFASTINT (b
->save_length
) > 5000
5800 /* These messages are frequent and annoying for `*mail*'. */
5801 && !EQ (b
->filename
, Qnil
)
5802 && NILP (no_message
))
5804 /* It has shrunk too much; turn off auto-saving here. */
5805 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5806 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5808 minibuffer_auto_raise
= 0;
5809 /* Turn off auto-saving until there's a real save,
5810 and prevent any more warnings. */
5811 XSETINT (b
->save_length
, -1);
5812 Fsleep_for (make_number (1), Qnil
);
5815 set_buffer_internal (b
);
5816 if (!auto_saved
&& NILP (no_message
))
5817 message1 ("Auto-saving...");
5818 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5820 b
->auto_save_modified
= BUF_MODIFF (b
);
5821 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5822 set_buffer_internal (old
);
5824 EMACS_GET_TIME (after_time
);
5826 /* If auto-save took more than 60 seconds,
5827 assume it was an NFS failure that got a timeout. */
5828 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5829 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5833 /* Prevent another auto save till enough input events come in. */
5834 record_auto_save ();
5836 if (auto_saved
&& NILP (no_message
))
5840 /* If we are going to restore an old message,
5841 give time to read ours. */
5842 sit_for (1, 0, 0, 0, 0);
5846 /* If we displayed a message and then restored a state
5847 with no message, leave a "done" message on the screen. */
5848 message1 ("Auto-saving...done");
5853 /* This restores the message-stack status. */
5854 unbind_to (count
, Qnil
);
5858 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5859 Sset_buffer_auto_saved
, 0, 0, 0,
5860 doc
: /* Mark current buffer as auto-saved with its current text.
5861 No auto-save file will be written until the buffer changes again. */)
5864 current_buffer
->auto_save_modified
= MODIFF
;
5865 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5866 current_buffer
->auto_save_failure_time
= -1;
5870 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5871 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5872 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5875 current_buffer
->auto_save_failure_time
= -1;
5879 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5881 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
5884 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5887 /* Reading and completing file names */
5888 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5890 /* In the string VAL, change each $ to $$ and return the result. */
5893 double_dollars (val
)
5896 register const unsigned char *old
;
5897 register unsigned char *new;
5901 osize
= SBYTES (val
);
5903 /* Count the number of $ characters. */
5904 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
5905 if (*old
++ == '$') count
++;
5909 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
5912 for (n
= osize
; n
> 0; n
--)
5926 read_file_name_cleanup (arg
)
5929 return (current_buffer
->directory
= arg
);
5932 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5934 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
5935 (string
, dir
, action
)
5936 Lisp_Object string
, dir
, action
;
5937 /* action is nil for complete, t for return list of completions,
5938 lambda for verify final value */
5940 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5942 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5944 CHECK_STRING (string
);
5951 /* No need to protect ACTION--we only compare it with t and nil. */
5952 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5954 if (SCHARS (string
) == 0)
5956 if (EQ (action
, Qlambda
))
5964 orig_string
= string
;
5965 string
= Fsubstitute_in_file_name (string
);
5966 changed
= NILP (Fstring_equal (string
, orig_string
));
5967 name
= Ffile_name_nondirectory (string
);
5968 val
= Ffile_name_directory (string
);
5970 realdir
= Fexpand_file_name (val
, realdir
);
5975 specdir
= Ffile_name_directory (string
);
5976 val
= Ffile_name_completion (name
, realdir
);
5981 return double_dollars (string
);
5985 if (!NILP (specdir
))
5986 val
= concat2 (specdir
, val
);
5988 return double_dollars (val
);
5991 #endif /* not VMS */
5995 if (EQ (action
, Qt
))
5997 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6001 if (NILP (Vread_file_name_predicate
)
6002 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6006 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6008 /* Brute-force speed up for directory checking:
6009 Discard strings which don't end in a slash. */
6010 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6012 Lisp_Object tem
= XCAR (all
);
6014 if (STRINGP (tem
) &&
6015 (len
= SCHARS (tem
), len
> 0) &&
6016 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6017 comp
= Fcons (tem
, comp
);
6023 /* Must do it the hard (and slow) way. */
6024 GCPRO3 (all
, comp
, specdir
);
6025 count
= SPECPDL_INDEX ();
6026 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6027 current_buffer
->directory
= realdir
;
6028 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6029 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6030 comp
= Fcons (XCAR (all
), comp
);
6031 unbind_to (count
, Qnil
);
6034 return Fnreverse (comp
);
6037 /* Only other case actually used is ACTION = lambda */
6039 /* Supposedly this helps commands such as `cd' that read directory names,
6040 but can someone explain how it helps them? -- RMS */
6041 if (SCHARS (name
) == 0)
6044 if (!NILP (Vread_file_name_predicate
))
6045 return call1 (Vread_file_name_predicate
, string
);
6046 return Ffile_exists_p (string
);
6049 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6050 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6051 Value is not expanded---you must call `expand-file-name' yourself.
6052 Default name to DEFAULT-FILENAME if user enters a null string.
6053 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6054 except that if INITIAL is specified, that combined with DIR is used.)
6055 Fourth arg MUSTMATCH non-nil means require existing file's name.
6056 Non-nil and non-t means also require confirmation after completion.
6057 Fifth arg INITIAL specifies text to start with.
6058 If optional sixth arg PREDICATE is non-nil, possible completions and the
6059 resulting file name must satisfy (funcall PREDICATE NAME).
6060 DIR defaults to current buffer's directory default.
6062 If this command was invoked with the mouse, use a file dialog box if
6063 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6064 provides a file dialog box. */)
6065 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6066 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6068 Lisp_Object val
, insdef
, tem
;
6069 struct gcpro gcpro1
, gcpro2
;
6070 register char *homedir
;
6071 Lisp_Object decoded_homedir
;
6072 int replace_in_history
= 0;
6073 int add_to_history
= 0;
6077 dir
= current_buffer
->directory
;
6078 if (NILP (default_filename
))
6079 default_filename
= !NILP (initial
)
6080 ? Fexpand_file_name (initial
, dir
)
6081 : current_buffer
->filename
;
6083 /* If dir starts with user's homedir, change that to ~. */
6084 homedir
= (char *) egetenv ("HOME");
6086 /* homedir can be NULL in temacs, since Vprocess_environment is not
6087 yet set up. We shouldn't crash in that case. */
6090 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6091 CORRECT_DIR_SEPS (homedir
);
6096 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6099 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6100 SBYTES (decoded_homedir
))
6101 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6103 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6104 dir
= concat2 (build_string ("~"), dir
);
6106 /* Likewise for default_filename. */
6108 && STRINGP (default_filename
)
6109 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6110 SBYTES (decoded_homedir
))
6111 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6114 = Fsubstring (default_filename
,
6115 make_number (SCHARS (decoded_homedir
)), Qnil
);
6116 default_filename
= concat2 (build_string ("~"), default_filename
);
6118 if (!NILP (default_filename
))
6120 CHECK_STRING (default_filename
);
6121 default_filename
= double_dollars (default_filename
);
6124 if (insert_default_directory
&& STRINGP (dir
))
6127 if (!NILP (initial
))
6129 Lisp_Object args
[2], pos
;
6133 insdef
= Fconcat (2, args
);
6134 pos
= make_number (SCHARS (double_dollars (dir
)));
6135 insdef
= Fcons (double_dollars (insdef
), pos
);
6138 insdef
= double_dollars (insdef
);
6140 else if (STRINGP (initial
))
6141 insdef
= Fcons (double_dollars (initial
), make_number (0));
6145 if (!NILP (Vread_file_name_function
))
6147 Lisp_Object args
[7];
6149 GCPRO2 (insdef
, default_filename
);
6150 args
[0] = Vread_file_name_function
;
6153 args
[3] = default_filename
;
6154 args
[4] = mustmatch
;
6156 args
[6] = predicate
;
6157 RETURN_UNGCPRO (Ffuncall (7, args
));
6160 count
= SPECPDL_INDEX ();
6162 specbind (intern ("completion-ignore-case"), Qt
);
6165 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6166 specbind (intern ("read-file-name-predicate"),
6167 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6169 GCPRO2 (insdef
, default_filename
);
6171 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
6172 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6176 /* If DIR contains a file name, split it. */
6178 file
= Ffile_name_nondirectory (dir
);
6179 if (SCHARS (file
) && NILP (default_filename
))
6181 default_filename
= file
;
6182 dir
= Ffile_name_directory (dir
);
6184 if (!NILP(default_filename
))
6185 default_filename
= Fexpand_file_name (default_filename
, dir
);
6186 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6191 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6192 dir
, mustmatch
, insdef
,
6193 Qfile_name_history
, default_filename
, Qnil
);
6195 tem
= Fsymbol_value (Qfile_name_history
);
6196 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6197 replace_in_history
= 1;
6199 /* If Fcompleting_read returned the inserted default string itself
6200 (rather than a new string with the same contents),
6201 it has to mean that the user typed RET with the minibuffer empty.
6202 In that case, we really want to return ""
6203 so that commands such as set-visited-file-name can distinguish. */
6204 if (EQ (val
, default_filename
))
6206 /* In this case, Fcompleting_read has not added an element
6207 to the history. Maybe we should. */
6208 if (! replace_in_history
)
6214 unbind_to (count
, Qnil
);
6217 error ("No file name specified");
6219 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6221 if (!NILP (tem
) && !NILP (default_filename
))
6222 val
= default_filename
;
6223 else if (SCHARS (val
) == 0 && NILP (insdef
))
6225 if (!NILP (default_filename
))
6226 val
= default_filename
;
6228 error ("No default file name");
6230 val
= Fsubstitute_in_file_name (val
);
6232 if (replace_in_history
)
6233 /* Replace what Fcompleting_read added to the history
6234 with what we will actually return. */
6235 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6236 else if (add_to_history
)
6238 /* Add the value to the history--but not if it matches
6239 the last value already there. */
6240 Lisp_Object val1
= double_dollars (val
);
6241 tem
= Fsymbol_value (Qfile_name_history
);
6242 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6243 Fset (Qfile_name_history
,
6254 /* Must be set before any path manipulation is performed. */
6255 XSETFASTINT (Vdirectory_sep_char
, '/');
6262 Qexpand_file_name
= intern ("expand-file-name");
6263 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6264 Qdirectory_file_name
= intern ("directory-file-name");
6265 Qfile_name_directory
= intern ("file-name-directory");
6266 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6267 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6268 Qfile_name_as_directory
= intern ("file-name-as-directory");
6269 Qcopy_file
= intern ("copy-file");
6270 Qmake_directory_internal
= intern ("make-directory-internal");
6271 Qmake_directory
= intern ("make-directory");
6272 Qdelete_directory
= intern ("delete-directory");
6273 Qdelete_file
= intern ("delete-file");
6274 Qrename_file
= intern ("rename-file");
6275 Qadd_name_to_file
= intern ("add-name-to-file");
6276 Qmake_symbolic_link
= intern ("make-symbolic-link");
6277 Qfile_exists_p
= intern ("file-exists-p");
6278 Qfile_executable_p
= intern ("file-executable-p");
6279 Qfile_readable_p
= intern ("file-readable-p");
6280 Qfile_writable_p
= intern ("file-writable-p");
6281 Qfile_symlink_p
= intern ("file-symlink-p");
6282 Qaccess_file
= intern ("access-file");
6283 Qfile_directory_p
= intern ("file-directory-p");
6284 Qfile_regular_p
= intern ("file-regular-p");
6285 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6286 Qfile_modes
= intern ("file-modes");
6287 Qset_file_modes
= intern ("set-file-modes");
6288 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6289 Qinsert_file_contents
= intern ("insert-file-contents");
6290 Qwrite_region
= intern ("write-region");
6291 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6292 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6294 staticpro (&Qexpand_file_name
);
6295 staticpro (&Qsubstitute_in_file_name
);
6296 staticpro (&Qdirectory_file_name
);
6297 staticpro (&Qfile_name_directory
);
6298 staticpro (&Qfile_name_nondirectory
);
6299 staticpro (&Qunhandled_file_name_directory
);
6300 staticpro (&Qfile_name_as_directory
);
6301 staticpro (&Qcopy_file
);
6302 staticpro (&Qmake_directory_internal
);
6303 staticpro (&Qmake_directory
);
6304 staticpro (&Qdelete_directory
);
6305 staticpro (&Qdelete_file
);
6306 staticpro (&Qrename_file
);
6307 staticpro (&Qadd_name_to_file
);
6308 staticpro (&Qmake_symbolic_link
);
6309 staticpro (&Qfile_exists_p
);
6310 staticpro (&Qfile_executable_p
);
6311 staticpro (&Qfile_readable_p
);
6312 staticpro (&Qfile_writable_p
);
6313 staticpro (&Qaccess_file
);
6314 staticpro (&Qfile_symlink_p
);
6315 staticpro (&Qfile_directory_p
);
6316 staticpro (&Qfile_regular_p
);
6317 staticpro (&Qfile_accessible_directory_p
);
6318 staticpro (&Qfile_modes
);
6319 staticpro (&Qset_file_modes
);
6320 staticpro (&Qfile_newer_than_file_p
);
6321 staticpro (&Qinsert_file_contents
);
6322 staticpro (&Qwrite_region
);
6323 staticpro (&Qverify_visited_file_modtime
);
6324 staticpro (&Qset_visited_file_modtime
);
6326 Qfile_name_history
= intern ("file-name-history");
6327 Fset (Qfile_name_history
, Qnil
);
6328 staticpro (&Qfile_name_history
);
6330 Qfile_error
= intern ("file-error");
6331 staticpro (&Qfile_error
);
6332 Qfile_already_exists
= intern ("file-already-exists");
6333 staticpro (&Qfile_already_exists
);
6334 Qfile_date_error
= intern ("file-date-error");
6335 staticpro (&Qfile_date_error
);
6336 Qexcl
= intern ("excl");
6340 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6341 staticpro (&Qfind_buffer_file_type
);
6344 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6345 doc
: /* *Coding system for encoding file names.
6346 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6347 Vfile_name_coding_system
= Qnil
;
6349 DEFVAR_LISP ("default-file-name-coding-system",
6350 &Vdefault_file_name_coding_system
,
6351 doc
: /* Default coding system for encoding file names.
6352 This variable is used only when `file-name-coding-system' is nil.
6354 This variable is set/changed by the command `set-language-environment'.
6355 User should not set this variable manually,
6356 instead use `file-name-coding-system' to get a constant encoding
6357 of file names regardless of the current language environment. */);
6358 Vdefault_file_name_coding_system
= Qnil
;
6360 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6361 doc
: /* *Format in which to write auto-save files.
6362 Should be a list of symbols naming formats that are defined in `format-alist'.
6363 If it is t, which is the default, auto-save files are written in the
6364 same format as a regular save would use. */);
6365 Vauto_save_file_format
= Qt
;
6367 Qformat_decode
= intern ("format-decode");
6368 staticpro (&Qformat_decode
);
6369 Qformat_annotate_function
= intern ("format-annotate-function");
6370 staticpro (&Qformat_annotate_function
);
6371 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6372 staticpro (&Qafter_insert_file_set_coding
);
6374 Qcar_less_than_car
= intern ("car-less-than-car");
6375 staticpro (&Qcar_less_than_car
);
6377 Fput (Qfile_error
, Qerror_conditions
,
6378 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6379 Fput (Qfile_error
, Qerror_message
,
6380 build_string ("File error"));
6382 Fput (Qfile_already_exists
, Qerror_conditions
,
6383 Fcons (Qfile_already_exists
,
6384 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6385 Fput (Qfile_already_exists
, Qerror_message
,
6386 build_string ("File already exists"));
6388 Fput (Qfile_date_error
, Qerror_conditions
,
6389 Fcons (Qfile_date_error
,
6390 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6391 Fput (Qfile_date_error
, Qerror_message
,
6392 build_string ("Cannot set file date"));
6394 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6395 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6396 Vread_file_name_function
= Qnil
;
6398 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6399 doc
: /* Current predicate used by `read-file-name-internal'. */);
6400 Vread_file_name_predicate
= Qnil
;
6402 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6403 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer. */);
6404 insert_default_directory
= 1;
6406 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6407 doc
: /* *Non-nil means write new files with record format `stmlf'.
6408 nil means use format `var'. This variable is meaningful only on VMS. */);
6409 vms_stmlf_recfm
= 0;
6411 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6412 doc
: /* Directory separator character for built-in functions that return file names.
6413 The value is always ?/. Don't use this variable, just use `/'. */);
6415 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6416 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6417 If a file name matches REGEXP, then all I/O on that file is done by calling
6420 The first argument given to HANDLER is the name of the I/O primitive
6421 to be handled; the remaining arguments are the arguments that were
6422 passed to that primitive. For example, if you do
6423 (file-exists-p FILENAME)
6424 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6425 (funcall HANDLER 'file-exists-p FILENAME)
6426 The function `find-file-name-handler' checks this list for a handler
6427 for its argument. */);
6428 Vfile_name_handler_alist
= Qnil
;
6430 DEFVAR_LISP ("set-auto-coding-function",
6431 &Vset_auto_coding_function
,
6432 doc
: /* If non-nil, a function to call to decide a coding system of file.
6433 Two arguments are passed to this function: the file name
6434 and the length of a file contents following the point.
6435 This function should return a coding system to decode the file contents.
6436 It should check the file name against `auto-coding-alist'.
6437 If no coding system is decided, it should check a coding system
6438 specified in the heading lines with the format:
6439 -*- ... coding: CODING-SYSTEM; ... -*-
6440 or local variable spec of the tailing lines with `coding:' tag. */);
6441 Vset_auto_coding_function
= Qnil
;
6443 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6444 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6445 Each is passed one argument, the number of characters inserted.
6446 It should return the new character count, and leave point the same.
6447 If `insert-file-contents' is intercepted by a handler from
6448 `file-name-handler-alist', that handler is responsible for calling the
6449 functions in `after-insert-file-functions' if appropriate. */);
6450 Vafter_insert_file_functions
= Qnil
;
6452 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6453 doc
: /* A list of functions to be called at the start of `write-region'.
6454 Each is passed two arguments, START and END as for `write-region'.
6455 These are usually two numbers but not always; see the documentation
6456 for `write-region'. The function should return a list of pairs
6457 of the form (POSITION . STRING), consisting of strings to be effectively
6458 inserted at the specified positions of the file being written (1 means to
6459 insert before the first byte written). The POSITIONs must be sorted into
6460 increasing order. If there are several functions in the list, the several
6461 lists are merged destructively. Alternatively, the function can return
6462 with a different buffer current; in that case it should pay attention
6463 to the annotations returned by previous functions and listed in
6464 `write-region-annotations-so-far'.*/);
6465 Vwrite_region_annotate_functions
= Qnil
;
6466 staticpro (&Qwrite_region_annotate_functions
);
6467 Qwrite_region_annotate_functions
6468 = intern ("write-region-annotate-functions");
6470 DEFVAR_LISP ("write-region-annotations-so-far",
6471 &Vwrite_region_annotations_so_far
,
6472 doc
: /* When an annotation function is called, this holds the previous annotations.
6473 These are the annotations made by other annotation functions
6474 that were already called. See also `write-region-annotate-functions'. */);
6475 Vwrite_region_annotations_so_far
= Qnil
;
6477 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6478 doc
: /* A list of file name handlers that temporarily should not be used.
6479 This applies only to the operation `inhibit-file-name-operation'. */);
6480 Vinhibit_file_name_handlers
= Qnil
;
6482 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6483 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6484 Vinhibit_file_name_operation
= Qnil
;
6486 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6487 doc
: /* File name in which we write a list of all auto save file names.
6488 This variable is initialized automatically from `auto-save-list-file-prefix'
6489 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6490 a non-nil value. */);
6491 Vauto_save_list_file_name
= Qnil
;
6493 defsubr (&Sfind_file_name_handler
);
6494 defsubr (&Sfile_name_directory
);
6495 defsubr (&Sfile_name_nondirectory
);
6496 defsubr (&Sunhandled_file_name_directory
);
6497 defsubr (&Sfile_name_as_directory
);
6498 defsubr (&Sdirectory_file_name
);
6499 defsubr (&Smake_temp_name
);
6500 defsubr (&Sexpand_file_name
);
6501 defsubr (&Ssubstitute_in_file_name
);
6502 defsubr (&Scopy_file
);
6503 defsubr (&Smake_directory_internal
);
6504 defsubr (&Sdelete_directory
);
6505 defsubr (&Sdelete_file
);
6506 defsubr (&Srename_file
);
6507 defsubr (&Sadd_name_to_file
);
6509 defsubr (&Smake_symbolic_link
);
6510 #endif /* S_IFLNK */
6512 defsubr (&Sdefine_logical_name
);
6515 defsubr (&Ssysnetunam
);
6516 #endif /* HPUX_NET */
6517 defsubr (&Sfile_name_absolute_p
);
6518 defsubr (&Sfile_exists_p
);
6519 defsubr (&Sfile_executable_p
);
6520 defsubr (&Sfile_readable_p
);
6521 defsubr (&Sfile_writable_p
);
6522 defsubr (&Saccess_file
);
6523 defsubr (&Sfile_symlink_p
);
6524 defsubr (&Sfile_directory_p
);
6525 defsubr (&Sfile_accessible_directory_p
);
6526 defsubr (&Sfile_regular_p
);
6527 defsubr (&Sfile_modes
);
6528 defsubr (&Sset_file_modes
);
6529 defsubr (&Sset_default_file_modes
);
6530 defsubr (&Sdefault_file_modes
);
6531 defsubr (&Sfile_newer_than_file_p
);
6532 defsubr (&Sinsert_file_contents
);
6533 defsubr (&Swrite_region
);
6534 defsubr (&Scar_less_than_car
);
6535 defsubr (&Sverify_visited_file_modtime
);
6536 defsubr (&Sclear_visited_file_modtime
);
6537 defsubr (&Svisited_file_modtime
);
6538 defsubr (&Sset_visited_file_modtime
);
6539 defsubr (&Sdo_auto_save
);
6540 defsubr (&Sset_buffer_auto_saved
);
6541 defsubr (&Sclear_buffer_auto_save_failure
);
6542 defsubr (&Srecent_auto_save_p
);
6544 defsubr (&Sread_file_name_internal
);
6545 defsubr (&Sread_file_name
);
6548 defsubr (&Sunix_sync
);