1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000,01,2003
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"
82 #include "dispextern.h"
89 #endif /* not WINDOWSNT */
93 #include <sys/param.h>
101 #define CORRECT_DIR_SEPS(s) \
102 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
103 else unixtodos_filename (s); \
105 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
106 redirector allows the six letters between 'Z' and 'a' as well. */
108 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
111 #define IS_DRIVE(x) isalpha (x)
113 /* Need to lower-case the drive letter, or else expanded
114 filenames will sometimes compare inequal, because
115 `expand-file-name' doesn't always down-case the drive letter. */
116 #define DRIVE_LETTER(x) (tolower (x))
137 #include "commands.h"
138 extern int use_dialog_box
;
139 extern int use_file_dialog
;
153 /* Nonzero during writing of auto-save files */
156 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
157 a new file with the same mode as the original */
158 int auto_save_mode_bits
;
160 /* The symbol bound to coding-system-for-read when
161 insert-file-contents is called for recovering a file. This is not
162 an actual coding system name, but just an indicator to tell
163 insert-file-contents to use `emacs-mule' with a special flag for
164 auto saving and recovering a file. */
165 Lisp_Object Qauto_save_coding
;
167 /* Coding system for file names, or nil if none. */
168 Lisp_Object Vfile_name_coding_system
;
170 /* Coding system for file names used only when
171 Vfile_name_coding_system is nil. */
172 Lisp_Object Vdefault_file_name_coding_system
;
174 /* Alist of elements (REGEXP . HANDLER) for file names
175 whose I/O is done with a special handler. */
176 Lisp_Object Vfile_name_handler_alist
;
178 /* Format for auto-save files */
179 Lisp_Object Vauto_save_file_format
;
181 /* Lisp functions for translating file formats */
182 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
184 /* Function to be called to decide a coding system of a reading file. */
185 Lisp_Object Vset_auto_coding_function
;
187 /* Functions to be called to process text properties in inserted file. */
188 Lisp_Object Vafter_insert_file_functions
;
190 /* Lisp function for setting buffer-file-coding-system and the
191 multibyteness of the current buffer after inserting a file. */
192 Lisp_Object Qafter_insert_file_set_coding
;
194 /* Functions to be called to create text property annotations for file. */
195 Lisp_Object Vwrite_region_annotate_functions
;
196 Lisp_Object Qwrite_region_annotate_functions
;
198 /* During build_annotations, each time an annotation function is called,
199 this holds the annotations made by the previous functions. */
200 Lisp_Object Vwrite_region_annotations_so_far
;
202 /* File name in which we write a list of all our auto save files. */
203 Lisp_Object Vauto_save_list_file_name
;
205 /* Function to call to read a file name. */
206 Lisp_Object Vread_file_name_function
;
208 /* Current predicate used by read_file_name_internal. */
209 Lisp_Object Vread_file_name_predicate
;
211 /* Nonzero means, when reading a filename in the minibuffer,
212 start out by inserting the default directory into the minibuffer. */
213 int insert_default_directory
;
215 /* On VMS, nonzero means write new files with record format stmlf.
216 Zero means use var format. */
219 /* On NT, specifies the directory separator character, used (eg.) when
220 expanding file names. This can be bound to / or \. */
221 Lisp_Object Vdirectory_sep_char
;
223 extern Lisp_Object Vuser_login_name
;
226 extern Lisp_Object Vw32_get_true_file_attributes
;
229 extern int minibuf_level
;
231 extern int minibuffer_auto_raise
;
233 /* These variables describe handlers that have "already" had a chance
234 to handle the current operation.
236 Vinhibit_file_name_handlers is a list of file name handlers.
237 Vinhibit_file_name_operation is the operation being handled.
238 If we try to handle that operation, we ignore those handlers. */
240 static Lisp_Object Vinhibit_file_name_handlers
;
241 static Lisp_Object Vinhibit_file_name_operation
;
243 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
245 Lisp_Object Qfile_name_history
;
247 Lisp_Object Qcar_less_than_car
;
249 static int a_write
P_ ((int, Lisp_Object
, int, int,
250 Lisp_Object
*, struct coding_system
*));
251 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
255 report_file_error (string
, data
)
259 Lisp_Object errstring
;
262 synchronize_system_messages_locale ();
263 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
264 Vlocale_coding_system
, 0);
270 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
273 /* System error messages are capitalized. Downcase the initial
274 unless it is followed by a slash. */
275 if (SREF (errstring
, 1) != '/')
276 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
278 Fsignal (Qfile_error
,
279 Fcons (build_string (string
), Fcons (errstring
, data
)));
284 close_file_unwind (fd
)
287 emacs_close (XFASTINT (fd
));
291 /* Restore point, having saved it as a marker. */
294 restore_point_unwind (location
)
295 Lisp_Object location
;
297 Fgoto_char (location
);
298 Fset_marker (location
, Qnil
, Qnil
);
302 Lisp_Object Qexpand_file_name
;
303 Lisp_Object Qsubstitute_in_file_name
;
304 Lisp_Object Qdirectory_file_name
;
305 Lisp_Object Qfile_name_directory
;
306 Lisp_Object Qfile_name_nondirectory
;
307 Lisp_Object Qunhandled_file_name_directory
;
308 Lisp_Object Qfile_name_as_directory
;
309 Lisp_Object Qcopy_file
;
310 Lisp_Object Qmake_directory_internal
;
311 Lisp_Object Qmake_directory
;
312 Lisp_Object Qdelete_directory
;
313 Lisp_Object Qdelete_file
;
314 Lisp_Object Qrename_file
;
315 Lisp_Object Qadd_name_to_file
;
316 Lisp_Object Qmake_symbolic_link
;
317 Lisp_Object Qfile_exists_p
;
318 Lisp_Object Qfile_executable_p
;
319 Lisp_Object Qfile_readable_p
;
320 Lisp_Object Qfile_writable_p
;
321 Lisp_Object Qfile_symlink_p
;
322 Lisp_Object Qaccess_file
;
323 Lisp_Object Qfile_directory_p
;
324 Lisp_Object Qfile_regular_p
;
325 Lisp_Object Qfile_accessible_directory_p
;
326 Lisp_Object Qfile_modes
;
327 Lisp_Object Qset_file_modes
;
328 Lisp_Object Qset_file_times
;
329 Lisp_Object Qfile_newer_than_file_p
;
330 Lisp_Object Qinsert_file_contents
;
331 Lisp_Object Qwrite_region
;
332 Lisp_Object Qverify_visited_file_modtime
;
333 Lisp_Object Qset_visited_file_modtime
;
335 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
336 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
337 Otherwise, return nil.
338 A file name is handled if one of the regular expressions in
339 `file-name-handler-alist' matches it.
341 If OPERATION equals `inhibit-file-name-operation', then we ignore
342 any handlers that are members of `inhibit-file-name-handlers',
343 but we still do run any other handlers. This lets handlers
344 use the standard functions without calling themselves recursively. */)
345 (filename
, operation
)
346 Lisp_Object filename
, operation
;
348 /* This function must not munge the match data. */
349 Lisp_Object chain
, inhibited_handlers
, result
;
353 CHECK_STRING (filename
);
355 if (EQ (operation
, Vinhibit_file_name_operation
))
356 inhibited_handlers
= Vinhibit_file_name_handlers
;
358 inhibited_handlers
= Qnil
;
360 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
361 chain
= XCDR (chain
))
371 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
373 Lisp_Object handler
, tem
;
375 handler
= XCDR (elt
);
376 tem
= Fmemq (handler
, inhibited_handlers
);
390 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
392 doc
: /* Return the directory component in file name FILENAME.
393 Return nil if FILENAME does not include a directory.
394 Otherwise return a directory spec.
395 Given a Unix syntax file name, returns a string ending in slash;
396 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
398 Lisp_Object filename
;
401 register const unsigned char *beg
;
403 register unsigned char *beg
;
405 register const unsigned char *p
;
408 CHECK_STRING (filename
);
410 /* If the file name has special constructs in it,
411 call the corresponding file handler. */
412 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
414 return call2 (handler
, Qfile_name_directory
, filename
);
416 #ifdef FILE_SYSTEM_CASE
417 filename
= FILE_SYSTEM_CASE (filename
);
419 beg
= SDATA (filename
);
421 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
423 p
= beg
+ SBYTES (filename
);
425 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
427 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
430 /* only recognise drive specifier at the beginning */
432 /* handle the "/:d:foo" and "/:foo" cases correctly */
433 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
434 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
441 /* Expansion of "c:" to drive and default directory. */
444 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
445 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
446 unsigned char *r
= res
;
448 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
450 strncpy (res
, beg
, 2);
455 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
457 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
460 p
= beg
+ strlen (beg
);
463 CORRECT_DIR_SEPS (beg
);
466 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
469 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
470 Sfile_name_nondirectory
, 1, 1, 0,
471 doc
: /* Return file name FILENAME sans its directory.
472 For example, in a Unix-syntax file name,
473 this is everything after the last slash,
474 or the entire name if it contains no slash. */)
476 Lisp_Object filename
;
478 register const unsigned char *beg
, *p
, *end
;
481 CHECK_STRING (filename
);
483 /* If the file name has special constructs in it,
484 call the corresponding file handler. */
485 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
487 return call2 (handler
, Qfile_name_nondirectory
, filename
);
489 beg
= SDATA (filename
);
490 end
= p
= beg
+ SBYTES (filename
);
492 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
494 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
497 /* only recognise drive specifier at beginning */
499 /* handle the "/:d:foo" case correctly */
500 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
505 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
508 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
509 Sunhandled_file_name_directory
, 1, 1, 0,
510 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
511 A `directly usable' directory name is one that may be used without the
512 intervention of any file handler.
513 If FILENAME is a directly usable file itself, return
514 \(file-name-directory FILENAME).
515 The `call-process' and `start-process' functions use this function to
516 get a current directory to run processes in. */)
518 Lisp_Object filename
;
522 /* If the file name has special constructs in it,
523 call the corresponding file handler. */
524 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
526 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
528 return Ffile_name_directory (filename
);
533 file_name_as_directory (out
, in
)
536 int size
= strlen (in
) - 1;
549 /* Is it already a directory string? */
550 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
552 /* Is it a VMS directory file name? If so, hack VMS syntax. */
553 else if (! index (in
, '/')
554 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
555 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
556 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
557 || ! strncmp (&in
[size
- 5], ".dir", 4))
558 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
559 && in
[size
] == '1')))
561 register char *p
, *dot
;
565 dir:x.dir --> dir:[x]
566 dir:[x]y.dir --> dir:[x.y] */
568 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
571 strncpy (out
, in
, p
- in
);
590 dot
= index (p
, '.');
593 /* blindly remove any extension */
594 size
= strlen (out
) + (dot
- p
);
595 strncat (out
, p
, dot
- p
);
606 /* For Unix syntax, Append a slash if necessary */
607 if (!IS_DIRECTORY_SEP (out
[size
]))
609 /* Cannot use DIRECTORY_SEP, which could have any value */
611 out
[size
+ 2] = '\0';
614 CORRECT_DIR_SEPS (out
);
620 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
621 Sfile_name_as_directory
, 1, 1, 0,
622 doc
: /* Return a string representing the file name FILE interpreted as a directory.
623 This operation exists because a directory is also a file, but its name as
624 a directory is different from its name as a file.
625 The result can be used as the value of `default-directory'
626 or passed as second argument to `expand-file-name'.
627 For a Unix-syntax file name, just appends a slash.
628 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
639 /* If the file name has special constructs in it,
640 call the corresponding file handler. */
641 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
643 return call2 (handler
, Qfile_name_as_directory
, file
);
645 buf
= (char *) alloca (SBYTES (file
) + 10);
646 file_name_as_directory (buf
, SDATA (file
));
647 return make_specified_string (buf
, -1, strlen (buf
),
648 STRING_MULTIBYTE (file
));
652 * Convert from directory name to filename.
654 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
655 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
656 * On UNIX, it's simple: just make sure there isn't a terminating /
658 * Value is nonzero if the string output is different from the input.
662 directory_file_name (src
, dst
)
670 struct FAB fab
= cc$rms_fab
;
671 struct NAM nam
= cc$rms_nam
;
672 char esa
[NAM$C_MAXRSS
];
677 if (! index (src
, '/')
678 && (src
[slen
- 1] == ']'
679 || src
[slen
- 1] == ':'
680 || src
[slen
- 1] == '>'))
682 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
684 fab
.fab$b_fns
= slen
;
685 fab
.fab$l_nam
= &nam
;
686 fab
.fab$l_fop
= FAB$M_NAM
;
689 nam
.nam$b_ess
= sizeof esa
;
690 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
692 /* We call SYS$PARSE to handle such things as [--] for us. */
693 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
695 slen
= nam
.nam$b_esl
;
696 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
701 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
703 /* what about when we have logical_name:???? */
704 if (src
[slen
- 1] == ':')
705 { /* Xlate logical name and see what we get */
706 ptr
= strcpy (dst
, src
); /* upper case for getenv */
709 if ('a' <= *ptr
&& *ptr
<= 'z')
713 dst
[slen
- 1] = 0; /* remove colon */
714 if (!(src
= egetenv (dst
)))
716 /* should we jump to the beginning of this procedure?
717 Good points: allows us to use logical names that xlate
719 Bad points: can be a problem if we just translated to a device
721 For now, I'll punt and always expect VMS names, and hope for
724 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
725 { /* no recursion here! */
731 { /* not a directory spec */
736 bracket
= src
[slen
- 1];
738 /* If bracket is ']' or '>', bracket - 2 is the corresponding
740 ptr
= index (src
, bracket
- 2);
742 { /* no opening bracket */
746 if (!(rptr
= rindex (src
, '.')))
749 strncpy (dst
, src
, slen
);
753 dst
[slen
++] = bracket
;
758 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
759 then translate the device and recurse. */
760 if (dst
[slen
- 1] == ':'
761 && dst
[slen
- 2] != ':' /* skip decnet nodes */
762 && strcmp (src
+ slen
, "[000000]") == 0)
764 dst
[slen
- 1] = '\0';
765 if ((ptr
= egetenv (dst
))
766 && (rlen
= strlen (ptr
) - 1) > 0
767 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
768 && ptr
[rlen
- 1] == '.')
770 char * buf
= (char *) alloca (strlen (ptr
) + 1);
774 return directory_file_name (buf
, dst
);
779 strcat (dst
, "[000000]");
783 rlen
= strlen (rptr
) - 1;
784 strncat (dst
, rptr
, rlen
);
785 dst
[slen
+ rlen
] = '\0';
786 strcat (dst
, ".DIR.1");
790 /* Process as Unix format: just remove any final slash.
791 But leave "/" unchanged; do not change it to "". */
794 /* Handle // as root for apollo's. */
795 if ((slen
> 2 && dst
[slen
- 1] == '/')
796 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
800 && IS_DIRECTORY_SEP (dst
[slen
- 1])
802 && !IS_ANY_SEP (dst
[slen
- 2])
808 CORRECT_DIR_SEPS (dst
);
813 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
815 doc
: /* Returns the file name of the directory named DIRECTORY.
816 This is the name of the file that holds the data for the directory DIRECTORY.
817 This operation exists because a directory is also a file, but its name as
818 a directory is different from its name as a file.
819 In Unix-syntax, this function just removes the final slash.
820 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
821 it returns a file name such as \"[X]Y.DIR.1\". */)
823 Lisp_Object directory
;
828 CHECK_STRING (directory
);
830 if (NILP (directory
))
833 /* If the file name has special constructs in it,
834 call the corresponding file handler. */
835 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
837 return call2 (handler
, Qdirectory_file_name
, directory
);
840 /* 20 extra chars is insufficient for VMS, since we might perform a
841 logical name translation. an equivalence string can be up to 255
842 chars long, so grab that much extra space... - sss */
843 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
845 buf
= (char *) alloca (SBYTES (directory
) + 20);
847 directory_file_name (SDATA (directory
), buf
);
848 return make_specified_string (buf
, -1, strlen (buf
),
849 STRING_MULTIBYTE (directory
));
852 static char make_temp_name_tbl
[64] =
854 'A','B','C','D','E','F','G','H',
855 'I','J','K','L','M','N','O','P',
856 'Q','R','S','T','U','V','W','X',
857 'Y','Z','a','b','c','d','e','f',
858 'g','h','i','j','k','l','m','n',
859 'o','p','q','r','s','t','u','v',
860 'w','x','y','z','0','1','2','3',
861 '4','5','6','7','8','9','-','_'
864 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
866 /* Value is a temporary file name starting with PREFIX, a string.
868 The Emacs process number forms part of the result, so there is
869 no danger of generating a name being used by another process.
870 In addition, this function makes an attempt to choose a name
871 which has no existing file. To make this work, PREFIX should be
872 an absolute file name.
874 BASE64_P non-zero means add the pid as 3 characters in base64
875 encoding. In this case, 6 characters will be added to PREFIX to
876 form the file name. Otherwise, if Emacs is running on a system
877 with long file names, add the pid as a decimal number.
879 This function signals an error if no unique file name could be
883 make_temp_name (prefix
, base64_p
)
890 unsigned char *p
, *data
;
894 CHECK_STRING (prefix
);
896 /* VAL is created by adding 6 characters to PREFIX. The first
897 three are the PID of this process, in base 64, and the second
898 three are incremented if the file already exists. This ensures
899 262144 unique file names per PID per PREFIX. */
901 pid
= (int) getpid ();
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 #ifdef HAVE_LONG_FILE_NAMES
913 sprintf (pidbuf
, "%d", pid
);
914 pidlen
= strlen (pidbuf
);
916 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
917 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
918 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
923 len
= SCHARS (prefix
);
924 val
= make_uninit_string (len
+ 3 + pidlen
);
926 bcopy(SDATA (prefix
), data
, len
);
929 bcopy (pidbuf
, p
, pidlen
);
932 /* Here we try to minimize useless stat'ing when this function is
933 invoked many times successively with the same PREFIX. We achieve
934 this by initializing count to a random value, and incrementing it
937 We don't want make-temp-name to be called while dumping,
938 because then make_temp_name_count_initialized_p would get set
939 and then make_temp_name_count would not be set when Emacs starts. */
941 if (!make_temp_name_count_initialized_p
)
943 make_temp_name_count
= (unsigned) time (NULL
);
944 make_temp_name_count_initialized_p
= 1;
950 unsigned num
= make_temp_name_count
;
952 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
953 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
954 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
956 /* Poor man's congruential RN generator. Replace with
957 ++make_temp_name_count for debugging. */
958 make_temp_name_count
+= 25229;
959 make_temp_name_count
%= 225307;
961 if (stat (data
, &ignored
) < 0)
963 /* We want to return only if errno is ENOENT. */
967 /* The error here is dubious, but there is little else we
968 can do. The alternatives are to return nil, which is
969 as bad as (and in many cases worse than) throwing the
970 error, or to ignore the error, which will likely result
971 in looping through 225307 stat's, which is not only
972 dog-slow, but also useless since it will fallback to
973 the errow below, anyway. */
974 report_file_error ("Cannot create temporary name for prefix",
975 Fcons (prefix
, Qnil
));
980 error ("Cannot create temporary name for prefix `%s'",
986 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
987 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
988 The Emacs process number forms part of the result,
989 so there is no danger of generating a name being used by another process.
991 In addition, this function makes an attempt to choose a name
992 which has no existing file. To make this work,
993 PREFIX should be an absolute file name.
995 There is a race condition between calling `make-temp-name' and creating the
996 file which opens all kinds of security holes. For that reason, you should
997 probably use `make-temp-file' instead, except in three circumstances:
999 * If you are creating the file in the user's home directory.
1000 * If you are creating a directory rather than an ordinary file.
1001 * If you are taking special precautions as `make-temp-file' does. */)
1005 return make_temp_name (prefix
, 0);
1010 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1011 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1012 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1013 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1014 the current buffer's value of default-directory is used.
1015 File name components that are `.' are removed, and
1016 so are file name components followed by `..', along with the `..' itself;
1017 note that these simplifications are done without checking the resulting
1018 file names in the file system.
1019 An initial `~/' expands to your home directory.
1020 An initial `~USER/' expands to USER's home directory.
1021 See also the function `substitute-in-file-name'. */)
1022 (name
, default_directory
)
1023 Lisp_Object name
, default_directory
;
1027 register unsigned char *newdir
, *p
, *o
;
1029 unsigned char *target
;
1032 unsigned char * colon
= 0;
1033 unsigned char * close
= 0;
1034 unsigned char * slash
= 0;
1035 unsigned char * brack
= 0;
1036 int lbrack
= 0, rbrack
= 0;
1041 int collapse_newdir
= 1;
1045 Lisp_Object handler
, result
;
1047 CHECK_STRING (name
);
1049 /* If the file name has special constructs in it,
1050 call the corresponding file handler. */
1051 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1052 if (!NILP (handler
))
1053 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1055 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1056 if (NILP (default_directory
))
1057 default_directory
= current_buffer
->directory
;
1058 if (! STRINGP (default_directory
))
1061 /* "/" is not considered a root directory on DOS_NT, so using "/"
1062 here causes an infinite recursion in, e.g., the following:
1064 (let (default-directory)
1065 (expand-file-name "a"))
1067 To avoid this, we set default_directory to the root of the
1069 extern char *emacs_root_dir (void);
1071 default_directory
= build_string (emacs_root_dir ());
1073 default_directory
= build_string ("/");
1077 if (!NILP (default_directory
))
1079 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1080 if (!NILP (handler
))
1081 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1084 o
= SDATA (default_directory
);
1086 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1087 It would be better to do this down below where we actually use
1088 default_directory. Unfortunately, calling Fexpand_file_name recursively
1089 could invoke GC, and the strings might be relocated. This would
1090 be annoying because we have pointers into strings lying around
1091 that would need adjusting, and people would add new pointers to
1092 the code and forget to adjust them, resulting in intermittent bugs.
1093 Putting this call here avoids all that crud.
1095 The EQ test avoids infinite recursion. */
1096 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1097 /* Save time in some common cases - as long as default_directory
1098 is not relative, it can be canonicalized with name below (if it
1099 is needed at all) without requiring it to be expanded now. */
1101 /* Detect MSDOS file names with drive specifiers. */
1102 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1104 /* Detect Windows file names in UNC format. */
1105 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1107 #else /* not DOS_NT */
1108 /* Detect Unix absolute file names (/... alone is not absolute on
1110 && ! (IS_DIRECTORY_SEP (o
[0]))
1111 #endif /* not DOS_NT */
1114 struct gcpro gcpro1
;
1117 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1122 /* Filenames on VMS are always upper case. */
1123 name
= Fupcase (name
);
1125 #ifdef FILE_SYSTEM_CASE
1126 name
= FILE_SYSTEM_CASE (name
);
1132 /* We will force directory separators to be either all \ or /, so make
1133 a local copy to modify, even if there ends up being no change. */
1134 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1136 /* Note if special escape prefix is present, but remove for now. */
1137 if (nm
[0] == '/' && nm
[1] == ':')
1143 /* Find and remove drive specifier if present; this makes nm absolute
1144 even if the rest of the name appears to be relative. Only look for
1145 drive specifier at the beginning. */
1146 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1153 /* If we see "c://somedir", we want to strip the first slash after the
1154 colon when stripping the drive letter. Otherwise, this expands to
1156 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1158 #endif /* WINDOWSNT */
1162 /* Discard any previous drive specifier if nm is now in UNC format. */
1163 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1169 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1170 none are found, we can probably return right away. We will avoid
1171 allocating a new string if name is already fully expanded. */
1173 IS_DIRECTORY_SEP (nm
[0])
1175 && drive
&& !is_escaped
1178 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1185 /* If it turns out that the filename we want to return is just a
1186 suffix of FILENAME, we don't need to go through and edit
1187 things; we just need to construct a new string using data
1188 starting at the middle of FILENAME. If we set lose to a
1189 non-zero value, that means we've discovered that we can't do
1196 /* Since we know the name is absolute, we can assume that each
1197 element starts with a "/". */
1199 /* "." and ".." are hairy. */
1200 if (IS_DIRECTORY_SEP (p
[0])
1202 && (IS_DIRECTORY_SEP (p
[2])
1204 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1207 /* We want to replace multiple `/' in a row with a single
1210 && IS_DIRECTORY_SEP (p
[0])
1211 && IS_DIRECTORY_SEP (p
[1]))
1218 /* if dev:[dir]/, move nm to / */
1219 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1220 nm
= (brack
? brack
+ 1 : colon
+ 1);
1221 lbrack
= rbrack
= 0;
1229 /* VMS pre V4.4,convert '-'s in filenames. */
1230 if (lbrack
== rbrack
)
1232 if (dots
< 2) /* this is to allow negative version numbers */
1237 if (lbrack
> rbrack
&&
1238 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1239 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1245 /* count open brackets, reset close bracket pointer */
1246 if (p
[0] == '[' || p
[0] == '<')
1247 lbrack
++, brack
= 0;
1248 /* count close brackets, set close bracket pointer */
1249 if (p
[0] == ']' || p
[0] == '>')
1250 rbrack
++, brack
= p
;
1251 /* detect ][ or >< */
1252 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1254 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1255 nm
= p
+ 1, lose
= 1;
1256 if (p
[0] == ':' && (colon
|| slash
))
1257 /* if dev1:[dir]dev2:, move nm to dev2: */
1263 /* if /name/dev:, move nm to dev: */
1266 /* if node::dev:, move colon following dev */
1267 else if (colon
&& colon
[-1] == ':')
1269 /* if dev1:dev2:, move nm to dev2: */
1270 else if (colon
&& colon
[-1] != ':')
1275 if (p
[0] == ':' && !colon
)
1281 if (lbrack
== rbrack
)
1284 else if (p
[0] == '.')
1292 if (index (nm
, '/'))
1294 nm
= sys_translate_unix (nm
);
1295 return make_specified_string (nm
, -1, strlen (nm
),
1296 STRING_MULTIBYTE (name
));
1300 /* Make sure directories are all separated with / or \ as
1301 desired, but avoid allocation of a new string when not
1303 CORRECT_DIR_SEPS (nm
);
1305 if (IS_DIRECTORY_SEP (nm
[1]))
1307 if (strcmp (nm
, SDATA (name
)) != 0)
1308 name
= make_specified_string (nm
, -1, strlen (nm
),
1309 STRING_MULTIBYTE (name
));
1313 /* drive must be set, so this is okay */
1314 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1318 name
= make_specified_string (nm
, -1, p
- nm
,
1319 STRING_MULTIBYTE (name
));
1320 temp
[0] = DRIVE_LETTER (drive
);
1321 name
= concat2 (build_string (temp
), name
);
1324 #else /* not DOS_NT */
1325 if (nm
== SDATA (name
))
1327 return make_specified_string (nm
, -1, strlen (nm
),
1328 STRING_MULTIBYTE (name
));
1329 #endif /* not DOS_NT */
1333 /* At this point, nm might or might not be an absolute file name. We
1334 need to expand ~ or ~user if present, otherwise prefix nm with
1335 default_directory if nm is not absolute, and finally collapse /./
1336 and /foo/../ sequences.
1338 We set newdir to be the appropriate prefix if one is needed:
1339 - the relevant user directory if nm starts with ~ or ~user
1340 - the specified drive's working dir (DOS/NT only) if nm does not
1342 - the value of default_directory.
1344 Note that these prefixes are not guaranteed to be absolute (except
1345 for the working dir of a drive). Therefore, to ensure we always
1346 return an absolute name, if the final prefix is not absolute we
1347 append it to the current working directory. */
1351 if (nm
[0] == '~') /* prefix ~ */
1353 if (IS_DIRECTORY_SEP (nm
[1])
1357 || nm
[1] == 0) /* ~ by itself */
1359 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1360 newdir
= (unsigned char *) "";
1363 collapse_newdir
= 0;
1366 nm
++; /* Don't leave the slash in nm. */
1369 else /* ~user/filename */
1371 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1376 o
= (unsigned char *) alloca (p
- nm
+ 1);
1377 bcopy ((char *) nm
, o
, p
- nm
);
1380 pw
= (struct passwd
*) getpwnam (o
+ 1);
1383 newdir
= (unsigned char *) pw
-> pw_dir
;
1385 nm
= p
+ 1; /* skip the terminator */
1389 collapse_newdir
= 0;
1394 /* If we don't find a user of that name, leave the name
1395 unchanged; don't move nm forward to p. */
1400 /* On DOS and Windows, nm is absolute if a drive name was specified;
1401 use the drive's current directory as the prefix if needed. */
1402 if (!newdir
&& drive
)
1404 /* Get default directory if needed to make nm absolute. */
1405 if (!IS_DIRECTORY_SEP (nm
[0]))
1407 newdir
= alloca (MAXPATHLEN
+ 1);
1408 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1413 /* Either nm starts with /, or drive isn't mounted. */
1414 newdir
= alloca (4);
1415 newdir
[0] = DRIVE_LETTER (drive
);
1423 /* Finally, if no prefix has been specified and nm is not absolute,
1424 then it must be expanded relative to default_directory. */
1428 /* /... alone is not absolute on DOS and Windows. */
1429 && !IS_DIRECTORY_SEP (nm
[0])
1432 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1439 newdir
= SDATA (default_directory
);
1441 /* Note if special escape prefix is present, but remove for now. */
1442 if (newdir
[0] == '/' && newdir
[1] == ':')
1453 /* First ensure newdir is an absolute name. */
1455 /* Detect MSDOS file names with drive specifiers. */
1456 ! (IS_DRIVE (newdir
[0])
1457 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1459 /* Detect Windows file names in UNC format. */
1460 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1464 /* Effectively, let newdir be (expand-file-name newdir cwd).
1465 Because of the admonition against calling expand-file-name
1466 when we have pointers into lisp strings, we accomplish this
1467 indirectly by prepending newdir to nm if necessary, and using
1468 cwd (or the wd of newdir's drive) as the new newdir. */
1470 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1475 if (!IS_DIRECTORY_SEP (nm
[0]))
1477 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1478 file_name_as_directory (tmp
, newdir
);
1482 newdir
= alloca (MAXPATHLEN
+ 1);
1485 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1492 /* Strip off drive name from prefix, if present. */
1493 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1499 /* Keep only a prefix from newdir if nm starts with slash
1500 (//server/share for UNC, nothing otherwise). */
1501 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1504 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1506 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1508 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1510 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1522 /* Get rid of any slash at the end of newdir, unless newdir is
1523 just / or // (an incomplete UNC name). */
1524 length
= strlen (newdir
);
1525 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1527 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1531 unsigned char *temp
= (unsigned char *) alloca (length
);
1532 bcopy (newdir
, temp
, length
- 1);
1533 temp
[length
- 1] = 0;
1541 /* Now concatenate the directory and name to new space in the stack frame */
1542 tlen
+= strlen (nm
) + 1;
1544 /* Reserve space for drive specifier and escape prefix, since either
1545 or both may need to be inserted. (The Microsoft x86 compiler
1546 produces incorrect code if the following two lines are combined.) */
1547 target
= (unsigned char *) alloca (tlen
+ 4);
1549 #else /* not DOS_NT */
1550 target
= (unsigned char *) alloca (tlen
);
1551 #endif /* not DOS_NT */
1557 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1560 /* If newdir is effectively "C:/", then the drive letter will have
1561 been stripped and newdir will be "/". Concatenating with an
1562 absolute directory in nm produces "//", which will then be
1563 incorrectly treated as a network share. Ignore newdir in
1564 this case (keeping the drive letter). */
1565 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1566 && newdir
[1] == '\0'))
1568 strcpy (target
, newdir
);
1572 file_name_as_directory (target
, newdir
);
1575 strcat (target
, nm
);
1577 if (index (target
, '/'))
1578 strcpy (target
, sys_translate_unix (target
));
1581 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1583 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1592 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1598 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1599 /* brackets are offset from each other by 2 */
1602 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1603 /* convert [foo][bar] to [bar] */
1604 while (o
[-1] != '[' && o
[-1] != '<')
1606 else if (*p
== '-' && *o
!= '.')
1609 else if (p
[0] == '-' && o
[-1] == '.' &&
1610 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1611 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1615 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1616 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1618 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1620 /* else [foo.-] ==> [-] */
1626 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1627 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1633 if (!IS_DIRECTORY_SEP (*p
))
1637 else if (IS_DIRECTORY_SEP (p
[0])
1639 && (IS_DIRECTORY_SEP (p
[2])
1642 /* If "/." is the entire filename, keep the "/". Otherwise,
1643 just delete the whole "/.". */
1644 if (o
== target
&& p
[2] == '\0')
1648 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1649 /* `/../' is the "superroot" on certain file systems. */
1651 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1653 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1655 /* Keep initial / only if this is the whole name. */
1656 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1661 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1663 /* Collapse multiple `/' in a row. */
1665 while (IS_DIRECTORY_SEP (*p
))
1672 #endif /* not VMS */
1676 /* At last, set drive name. */
1678 /* Except for network file name. */
1679 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1680 #endif /* WINDOWSNT */
1682 if (!drive
) abort ();
1684 target
[0] = DRIVE_LETTER (drive
);
1687 /* Reinsert the escape prefix if required. */
1694 CORRECT_DIR_SEPS (target
);
1697 result
= make_specified_string (target
, -1, o
- target
,
1698 STRING_MULTIBYTE (name
));
1700 /* Again look to see if the file name has special constructs in it
1701 and perhaps call the corresponding file handler. This is needed
1702 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1703 the ".." component gives us "/user@host:/bar/../baz" which needs
1704 to be expanded again. */
1705 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1706 if (!NILP (handler
))
1707 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1713 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1714 This is the old version of expand-file-name, before it was thoroughly
1715 rewritten for Emacs 10.31. We leave this version here commented-out,
1716 because the code is very complex and likely to have subtle bugs. If
1717 bugs _are_ found, it might be of interest to look at the old code and
1718 see what did it do in the relevant situation.
1720 Don't remove this code: it's true that it will be accessible via CVS,
1721 but a few years from deletion, people will forget it is there. */
1723 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1724 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1725 "Convert FILENAME to absolute, and canonicalize it.\n\
1726 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1727 (does not start with slash); if DEFAULT is nil or missing,\n\
1728 the current buffer's value of default-directory is used.\n\
1729 Filenames containing `.' or `..' as components are simplified;\n\
1730 initial `~/' expands to your home directory.\n\
1731 See also the function `substitute-in-file-name'.")
1733 Lisp_Object name
, defalt
;
1737 register unsigned char *newdir
, *p
, *o
;
1739 unsigned char *target
;
1743 unsigned char * colon
= 0;
1744 unsigned char * close
= 0;
1745 unsigned char * slash
= 0;
1746 unsigned char * brack
= 0;
1747 int lbrack
= 0, rbrack
= 0;
1751 CHECK_STRING (name
);
1754 /* Filenames on VMS are always upper case. */
1755 name
= Fupcase (name
);
1760 /* If nm is absolute, flush ...// and detect /./ and /../.
1761 If no /./ or /../ we can return right away. */
1773 if (p
[0] == '/' && p
[1] == '/'
1775 /* // at start of filename is meaningful on Apollo system. */
1780 if (p
[0] == '/' && p
[1] == '~')
1781 nm
= p
+ 1, lose
= 1;
1782 if (p
[0] == '/' && p
[1] == '.'
1783 && (p
[2] == '/' || p
[2] == 0
1784 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1790 /* if dev:[dir]/, move nm to / */
1791 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1792 nm
= (brack
? brack
+ 1 : colon
+ 1);
1793 lbrack
= rbrack
= 0;
1801 /* VMS pre V4.4,convert '-'s in filenames. */
1802 if (lbrack
== rbrack
)
1804 if (dots
< 2) /* this is to allow negative version numbers */
1809 if (lbrack
> rbrack
&&
1810 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1811 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1817 /* count open brackets, reset close bracket pointer */
1818 if (p
[0] == '[' || p
[0] == '<')
1819 lbrack
++, brack
= 0;
1820 /* count close brackets, set close bracket pointer */
1821 if (p
[0] == ']' || p
[0] == '>')
1822 rbrack
++, brack
= p
;
1823 /* detect ][ or >< */
1824 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1826 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1827 nm
= p
+ 1, lose
= 1;
1828 if (p
[0] == ':' && (colon
|| slash
))
1829 /* if dev1:[dir]dev2:, move nm to dev2: */
1835 /* If /name/dev:, move nm to dev: */
1838 /* If node::dev:, move colon following dev */
1839 else if (colon
&& colon
[-1] == ':')
1841 /* If dev1:dev2:, move nm to dev2: */
1842 else if (colon
&& colon
[-1] != ':')
1847 if (p
[0] == ':' && !colon
)
1853 if (lbrack
== rbrack
)
1856 else if (p
[0] == '.')
1864 if (index (nm
, '/'))
1865 return build_string (sys_translate_unix (nm
));
1867 if (nm
== SDATA (name
))
1869 return build_string (nm
);
1873 /* Now determine directory to start with and put it in NEWDIR */
1877 if (nm
[0] == '~') /* prefix ~ */
1882 || nm
[1] == 0)/* ~/filename */
1884 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1885 newdir
= (unsigned char *) "";
1888 nm
++; /* Don't leave the slash in nm. */
1891 else /* ~user/filename */
1893 /* Get past ~ to user */
1894 unsigned char *user
= nm
+ 1;
1895 /* Find end of name. */
1896 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1897 int len
= ptr
? ptr
- user
: strlen (user
);
1899 unsigned char *ptr1
= index (user
, ':');
1900 if (ptr1
!= 0 && ptr1
- user
< len
)
1903 /* Copy the user name into temp storage. */
1904 o
= (unsigned char *) alloca (len
+ 1);
1905 bcopy ((char *) user
, o
, len
);
1908 /* Look up the user name. */
1909 pw
= (struct passwd
*) getpwnam (o
+ 1);
1911 error ("\"%s\" isn't a registered user", o
+ 1);
1913 newdir
= (unsigned char *) pw
->pw_dir
;
1915 /* Discard the user name from NM. */
1922 #endif /* not VMS */
1926 defalt
= current_buffer
->directory
;
1927 CHECK_STRING (defalt
);
1928 newdir
= SDATA (defalt
);
1931 /* Now concatenate the directory and name to new space in the stack frame */
1933 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1934 target
= (unsigned char *) alloca (tlen
);
1940 if (nm
[0] == 0 || nm
[0] == '/')
1941 strcpy (target
, newdir
);
1944 file_name_as_directory (target
, newdir
);
1947 strcat (target
, nm
);
1949 if (index (target
, '/'))
1950 strcpy (target
, sys_translate_unix (target
));
1953 /* Now canonicalize by removing /. and /foo/.. if they appear */
1961 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1967 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1968 /* brackets are offset from each other by 2 */
1971 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1972 /* convert [foo][bar] to [bar] */
1973 while (o
[-1] != '[' && o
[-1] != '<')
1975 else if (*p
== '-' && *o
!= '.')
1978 else if (p
[0] == '-' && o
[-1] == '.' &&
1979 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1980 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1984 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1985 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1987 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1989 /* else [foo.-] ==> [-] */
1995 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1996 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2006 else if (!strncmp (p
, "//", 2)
2008 /* // at start of filename is meaningful in Apollo system. */
2016 else if (p
[0] == '/' && p
[1] == '.' &&
2017 (p
[2] == '/' || p
[2] == 0))
2019 else if (!strncmp (p
, "/..", 3)
2020 /* `/../' is the "superroot" on certain file systems. */
2022 && (p
[3] == '/' || p
[3] == 0))
2024 while (o
!= target
&& *--o
!= '/')
2027 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2031 if (o
== target
&& *o
== '/')
2039 #endif /* not VMS */
2042 return make_string (target
, o
- target
);
2046 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2047 Ssubstitute_in_file_name
, 1, 1, 0,
2048 doc
: /* Substitute environment variables referred to in FILENAME.
2049 `$FOO' where FOO is an environment variable name means to substitute
2050 the value of that variable. The variable name should be terminated
2051 with a character not a letter, digit or underscore; otherwise, enclose
2052 the entire variable name in braces.
2053 If `/~' appears, all of FILENAME through that `/' is discarded.
2055 On VMS, `$' substitution is not done; this function does little and only
2056 duplicates what `expand-file-name' does. */)
2058 Lisp_Object filename
;
2062 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2063 unsigned char *target
= NULL
;
2065 int substituted
= 0;
2068 Lisp_Object handler
;
2070 CHECK_STRING (filename
);
2072 /* If the file name has special constructs in it,
2073 call the corresponding file handler. */
2074 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2075 if (!NILP (handler
))
2076 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2078 nm
= SDATA (filename
);
2080 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2081 CORRECT_DIR_SEPS (nm
);
2082 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2084 endp
= nm
+ SBYTES (filename
);
2086 /* If /~ or // appears, discard everything through first slash. */
2088 for (p
= nm
; p
!= endp
; p
++)
2091 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2092 /* // at start of file name is meaningful in Apollo,
2093 WindowsNT and Cygwin systems. */
2094 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2095 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2096 || IS_DIRECTORY_SEP (p
[0])
2097 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2102 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2104 || IS_DIRECTORY_SEP (p
[-1])))
2106 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2111 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2113 o
= (unsigned char *) alloca (s
- p
+ 1);
2114 bcopy ((char *) p
, o
, s
- p
);
2117 pw
= (struct passwd
*) getpwnam (o
+ 1);
2119 /* If we have ~/ or ~user and `user' exists, discard
2120 everything up to ~. But if `user' does not exist, leave
2121 ~user alone, it might be a literal file name. */
2122 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2129 /* see comment in expand-file-name about drive specifiers */
2130 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2131 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2140 return make_specified_string (nm
, -1, strlen (nm
),
2141 STRING_MULTIBYTE (filename
));
2144 /* See if any variables are substituted into the string
2145 and find the total length of their values in `total' */
2147 for (p
= nm
; p
!= endp
;)
2157 /* "$$" means a single "$" */
2166 while (p
!= endp
&& *p
!= '}') p
++;
2167 if (*p
!= '}') goto missingclose
;
2173 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2177 /* Copy out the variable name */
2178 target
= (unsigned char *) alloca (s
- o
+ 1);
2179 strncpy (target
, o
, s
- o
);
2182 strupr (target
); /* $home == $HOME etc. */
2185 /* Get variable value */
2186 o
= (unsigned char *) egetenv (target
);
2189 total
+= strlen (o
);
2199 /* If substitution required, recopy the string and do it */
2200 /* Make space in stack frame for the new copy */
2201 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2204 /* Copy the rest of the name through, replacing $ constructs with values */
2221 while (p
!= endp
&& *p
!= '}') p
++;
2222 if (*p
!= '}') goto missingclose
;
2228 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2232 /* Copy out the variable name */
2233 target
= (unsigned char *) alloca (s
- o
+ 1);
2234 strncpy (target
, o
, s
- o
);
2237 strupr (target
); /* $home == $HOME etc. */
2240 /* Get variable value */
2241 o
= (unsigned char *) egetenv (target
);
2245 strcpy (x
, target
); x
+= strlen (target
);
2247 else if (STRING_MULTIBYTE (filename
))
2249 /* If the original string is multibyte,
2250 convert what we substitute into multibyte. */
2253 int c
= unibyte_char_to_multibyte (*o
++);
2254 x
+= CHAR_STRING (c
, x
);
2266 /* If /~ or // appears, discard everything through first slash. */
2268 for (p
= xnm
; p
!= x
; p
++)
2270 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2271 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2272 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2273 || IS_DIRECTORY_SEP (p
[0])
2274 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2276 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2279 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2280 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2284 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2287 error ("Bad format environment-variable substitution");
2289 error ("Missing \"}\" in environment-variable substitution");
2291 error ("Substituting nonexistent environment variable \"%s\"", target
);
2294 #endif /* not VMS */
2298 /* A slightly faster and more convenient way to get
2299 (directory-file-name (expand-file-name FOO)). */
2302 expand_and_dir_to_file (filename
, defdir
)
2303 Lisp_Object filename
, defdir
;
2305 register Lisp_Object absname
;
2307 absname
= Fexpand_file_name (filename
, defdir
);
2310 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2311 if (c
== ':' || c
== ']' || c
== '>')
2312 absname
= Fdirectory_file_name (absname
);
2315 /* Remove final slash, if any (unless this is the root dir).
2316 stat behaves differently depending! */
2317 if (SCHARS (absname
) > 1
2318 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2319 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2320 /* We cannot take shortcuts; they might be wrong for magic file names. */
2321 absname
= Fdirectory_file_name (absname
);
2326 /* Signal an error if the file ABSNAME already exists.
2327 If INTERACTIVE is nonzero, ask the user whether to proceed,
2328 and bypass the error if the user says to go ahead.
2329 QUERYSTRING is a name for the action that is being considered
2332 *STATPTR is used to store the stat information if the file exists.
2333 If the file does not exist, STATPTR->st_mode is set to 0.
2334 If STATPTR is null, we don't store into it.
2336 If QUICK is nonzero, we ask for y or n, not yes or no. */
2339 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2340 Lisp_Object absname
;
2341 unsigned char *querystring
;
2343 struct stat
*statptr
;
2346 register Lisp_Object tem
, encoded_filename
;
2347 struct stat statbuf
;
2348 struct gcpro gcpro1
;
2350 encoded_filename
= ENCODE_FILE (absname
);
2352 /* stat is a good way to tell whether the file exists,
2353 regardless of what access permissions it has. */
2354 if (stat (SDATA (encoded_filename
), &statbuf
) >= 0)
2357 Fsignal (Qfile_already_exists
,
2358 Fcons (build_string ("File already exists"),
2359 Fcons (absname
, Qnil
)));
2361 tem
= format2 ("File %s already exists; %s anyway? ",
2362 absname
, build_string (querystring
));
2364 tem
= Fy_or_n_p (tem
);
2366 tem
= do_yes_or_no_p (tem
);
2369 Fsignal (Qfile_already_exists
,
2370 Fcons (build_string ("File already exists"),
2371 Fcons (absname
, Qnil
)));
2378 statptr
->st_mode
= 0;
2383 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2384 "fCopy file: \nFCopy %s to file: \np\nP",
2385 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2386 If NEWNAME names a directory, copy FILE there.
2387 Signals a `file-already-exists' error if file NEWNAME already exists,
2388 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2389 A number as third arg means request confirmation if NEWNAME already exists.
2390 This is what happens in interactive use with M-x.
2391 Fourth arg KEEP-TIME non-nil means give the new file the same
2392 last-modified time as the old one. (This works on only some systems.)
2393 A prefix arg makes KEEP-TIME non-nil.
2394 Also set the file modes of the target file to match the source file. */)
2395 (file
, newname
, ok_if_already_exists
, keep_time
)
2396 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2399 char buf
[16 * 1024];
2400 struct stat st
, out_st
;
2401 Lisp_Object handler
;
2402 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2403 int count
= SPECPDL_INDEX ();
2404 int input_file_statable_p
;
2405 Lisp_Object encoded_file
, encoded_newname
;
2407 encoded_file
= encoded_newname
= Qnil
;
2408 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2409 CHECK_STRING (file
);
2410 CHECK_STRING (newname
);
2412 if (!NILP (Ffile_directory_p (newname
)))
2413 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2415 newname
= Fexpand_file_name (newname
, Qnil
);
2417 file
= Fexpand_file_name (file
, Qnil
);
2419 /* If the input file name has special constructs in it,
2420 call the corresponding file handler. */
2421 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2422 /* Likewise for output file name. */
2424 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2425 if (!NILP (handler
))
2426 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2427 ok_if_already_exists
, keep_time
));
2429 encoded_file
= ENCODE_FILE (file
);
2430 encoded_newname
= ENCODE_FILE (newname
);
2432 if (NILP (ok_if_already_exists
)
2433 || INTEGERP (ok_if_already_exists
))
2434 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2435 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2436 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2440 if (!CopyFile (SDATA (encoded_file
),
2441 SDATA (encoded_newname
),
2443 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2444 /* CopyFile retains the timestamp by default. */
2445 else if (NILP (keep_time
))
2451 EMACS_GET_TIME (now
);
2452 filename
= SDATA (encoded_newname
);
2454 /* Ensure file is writable while its modified time is set. */
2455 attributes
= GetFileAttributes (filename
);
2456 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2457 if (set_file_times (filename
, now
, now
))
2459 /* Restore original attributes. */
2460 SetFileAttributes (filename
, attributes
);
2461 Fsignal (Qfile_date_error
,
2462 Fcons (build_string ("Cannot set file date"),
2463 Fcons (newname
, Qnil
)));
2465 /* Restore original attributes. */
2466 SetFileAttributes (filename
, attributes
);
2468 #else /* not WINDOWSNT */
2470 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2474 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2476 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2478 /* We can only copy regular files and symbolic links. Other files are not
2480 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2482 #if !defined (DOS_NT) || __DJGPP__ > 1
2483 if (out_st
.st_mode
!= 0
2484 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2487 report_file_error ("Input and output files are the same",
2488 Fcons (file
, Fcons (newname
, Qnil
)));
2492 #if defined (S_ISREG) && defined (S_ISLNK)
2493 if (input_file_statable_p
)
2495 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2497 #if defined (EISDIR)
2498 /* Get a better looking error message. */
2501 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2504 #endif /* S_ISREG && S_ISLNK */
2507 /* Create the copy file with the same record format as the input file */
2508 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2511 /* System's default file type was set to binary by _fmode in emacs.c. */
2512 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2513 #else /* not MSDOS */
2514 ofd
= creat (SDATA (encoded_newname
), 0666);
2515 #endif /* not MSDOS */
2518 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2520 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2524 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2525 if (emacs_write (ofd
, buf
, n
) != n
)
2526 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2529 /* Closing the output clobbers the file times on some systems. */
2530 if (emacs_close (ofd
) < 0)
2531 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2533 if (input_file_statable_p
)
2535 if (!NILP (keep_time
))
2537 EMACS_TIME atime
, mtime
;
2538 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2539 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2540 if (set_file_times (SDATA (encoded_newname
),
2542 Fsignal (Qfile_date_error
,
2543 Fcons (build_string ("Cannot set file date"),
2544 Fcons (newname
, Qnil
)));
2547 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2549 #if defined (__DJGPP__) && __DJGPP__ > 1
2550 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2551 and if it can't, it tells so. Otherwise, under MSDOS we usually
2552 get only the READ bit, which will make the copied file read-only,
2553 so it's better not to chmod at all. */
2554 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2555 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2556 #endif /* DJGPP version 2 or newer */
2561 #endif /* WINDOWSNT */
2563 /* Discard the unwind protects. */
2564 specpdl_ptr
= specpdl
+ count
;
2570 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2571 Smake_directory_internal
, 1, 1, 0,
2572 doc
: /* Create a new directory named DIRECTORY. */)
2574 Lisp_Object directory
;
2576 const unsigned char *dir
;
2577 Lisp_Object handler
;
2578 Lisp_Object encoded_dir
;
2580 CHECK_STRING (directory
);
2581 directory
= Fexpand_file_name (directory
, Qnil
);
2583 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2584 if (!NILP (handler
))
2585 return call2 (handler
, Qmake_directory_internal
, directory
);
2587 encoded_dir
= ENCODE_FILE (directory
);
2589 dir
= SDATA (encoded_dir
);
2592 if (mkdir (dir
) != 0)
2594 if (mkdir (dir
, 0777) != 0)
2596 report_file_error ("Creating directory", Flist (1, &directory
));
2601 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2602 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2604 Lisp_Object directory
;
2606 const unsigned char *dir
;
2607 Lisp_Object handler
;
2608 Lisp_Object encoded_dir
;
2610 CHECK_STRING (directory
);
2611 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2613 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2614 if (!NILP (handler
))
2615 return call2 (handler
, Qdelete_directory
, directory
);
2617 encoded_dir
= ENCODE_FILE (directory
);
2619 dir
= SDATA (encoded_dir
);
2621 if (rmdir (dir
) != 0)
2622 report_file_error ("Removing directory", Flist (1, &directory
));
2627 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2628 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2629 If file has multiple names, it continues to exist with the other names. */)
2631 Lisp_Object filename
;
2633 Lisp_Object handler
;
2634 Lisp_Object encoded_file
;
2635 struct gcpro gcpro1
;
2638 if (!NILP (Ffile_directory_p (filename
))
2639 && NILP (Ffile_symlink_p (filename
)))
2640 Fsignal (Qfile_error
,
2641 Fcons (build_string ("Removing old name: is a directory"),
2642 Fcons (filename
, Qnil
)));
2644 filename
= Fexpand_file_name (filename
, Qnil
);
2646 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2647 if (!NILP (handler
))
2648 return call2 (handler
, Qdelete_file
, filename
);
2650 encoded_file
= ENCODE_FILE (filename
);
2652 if (0 > unlink (SDATA (encoded_file
)))
2653 report_file_error ("Removing old name", Flist (1, &filename
));
2658 internal_delete_file_1 (ignore
)
2664 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2667 internal_delete_file (filename
)
2668 Lisp_Object filename
;
2670 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2671 Qt
, internal_delete_file_1
));
2674 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2675 "fRename file: \nFRename %s to file: \np",
2676 doc
: /* Rename FILE as NEWNAME. Both args strings.
2677 If file has names other than FILE, it continues to have those names.
2678 Signals a `file-already-exists' error if a file NEWNAME already exists
2679 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2680 A number as third arg means request confirmation if NEWNAME already exists.
2681 This is what happens in interactive use with M-x. */)
2682 (file
, newname
, ok_if_already_exists
)
2683 Lisp_Object file
, newname
, ok_if_already_exists
;
2686 Lisp_Object args
[2];
2688 Lisp_Object handler
;
2689 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2690 Lisp_Object encoded_file
, encoded_newname
;
2692 encoded_file
= encoded_newname
= Qnil
;
2693 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2694 CHECK_STRING (file
);
2695 CHECK_STRING (newname
);
2696 file
= Fexpand_file_name (file
, Qnil
);
2697 newname
= Fexpand_file_name (newname
, Qnil
);
2699 /* If the file name has special constructs in it,
2700 call the corresponding file handler. */
2701 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2703 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2704 if (!NILP (handler
))
2705 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2706 file
, newname
, ok_if_already_exists
));
2708 encoded_file
= ENCODE_FILE (file
);
2709 encoded_newname
= ENCODE_FILE (newname
);
2712 /* If the file names are identical but for the case, don't ask for
2713 confirmation: they simply want to change the letter-case of the
2715 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2717 if (NILP (ok_if_already_exists
)
2718 || INTEGERP (ok_if_already_exists
))
2719 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2720 INTEGERP (ok_if_already_exists
), 0, 0);
2722 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2724 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2725 || 0 > unlink (SDATA (encoded_file
)))
2730 Fcopy_file (file
, newname
,
2731 /* We have already prompted if it was an integer,
2732 so don't have copy-file prompt again. */
2733 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2734 Fdelete_file (file
);
2741 report_file_error ("Renaming", Flist (2, args
));
2744 report_file_error ("Renaming", Flist (2, &file
));
2751 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2752 "fAdd name to file: \nFName to add to %s: \np",
2753 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2754 Signals a `file-already-exists' error if a file NEWNAME already exists
2755 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2756 A number as third arg means request confirmation if NEWNAME already exists.
2757 This is what happens in interactive use with M-x. */)
2758 (file
, newname
, ok_if_already_exists
)
2759 Lisp_Object file
, newname
, ok_if_already_exists
;
2762 Lisp_Object args
[2];
2764 Lisp_Object handler
;
2765 Lisp_Object encoded_file
, encoded_newname
;
2766 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2768 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2769 encoded_file
= encoded_newname
= Qnil
;
2770 CHECK_STRING (file
);
2771 CHECK_STRING (newname
);
2772 file
= Fexpand_file_name (file
, Qnil
);
2773 newname
= Fexpand_file_name (newname
, Qnil
);
2775 /* If the file name has special constructs in it,
2776 call the corresponding file handler. */
2777 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2778 if (!NILP (handler
))
2779 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2780 newname
, ok_if_already_exists
));
2782 /* If the new name has special constructs in it,
2783 call the corresponding file handler. */
2784 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2785 if (!NILP (handler
))
2786 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2787 newname
, ok_if_already_exists
));
2789 encoded_file
= ENCODE_FILE (file
);
2790 encoded_newname
= ENCODE_FILE (newname
);
2792 if (NILP (ok_if_already_exists
)
2793 || INTEGERP (ok_if_already_exists
))
2794 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2795 INTEGERP (ok_if_already_exists
), 0, 0);
2797 unlink (SDATA (newname
));
2798 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2803 report_file_error ("Adding new name", Flist (2, args
));
2805 report_file_error ("Adding new name", Flist (2, &file
));
2814 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2815 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2816 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2817 Signals a `file-already-exists' error if a file LINKNAME already exists
2818 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2819 A number as third arg means request confirmation if LINKNAME already exists.
2820 This happens for interactive use with M-x. */)
2821 (filename
, linkname
, ok_if_already_exists
)
2822 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2825 Lisp_Object args
[2];
2827 Lisp_Object handler
;
2828 Lisp_Object encoded_filename
, encoded_linkname
;
2829 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2831 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2832 encoded_filename
= encoded_linkname
= Qnil
;
2833 CHECK_STRING (filename
);
2834 CHECK_STRING (linkname
);
2835 /* If the link target has a ~, we must expand it to get
2836 a truly valid file name. Otherwise, do not expand;
2837 we want to permit links to relative file names. */
2838 if (SREF (filename
, 0) == '~')
2839 filename
= Fexpand_file_name (filename
, Qnil
);
2840 linkname
= Fexpand_file_name (linkname
, Qnil
);
2842 /* If the file name has special constructs in it,
2843 call the corresponding file handler. */
2844 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2845 if (!NILP (handler
))
2846 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2847 linkname
, ok_if_already_exists
));
2849 /* If the new link name has special constructs in it,
2850 call the corresponding file handler. */
2851 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2852 if (!NILP (handler
))
2853 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2854 linkname
, ok_if_already_exists
));
2856 encoded_filename
= ENCODE_FILE (filename
);
2857 encoded_linkname
= ENCODE_FILE (linkname
);
2859 if (NILP (ok_if_already_exists
)
2860 || INTEGERP (ok_if_already_exists
))
2861 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2862 INTEGERP (ok_if_already_exists
), 0, 0);
2863 if (0 > symlink (SDATA (encoded_filename
),
2864 SDATA (encoded_linkname
)))
2866 /* If we didn't complain already, silently delete existing file. */
2867 if (errno
== EEXIST
)
2869 unlink (SDATA (encoded_linkname
));
2870 if (0 <= symlink (SDATA (encoded_filename
),
2871 SDATA (encoded_linkname
)))
2881 report_file_error ("Making symbolic link", Flist (2, args
));
2883 report_file_error ("Making symbolic link", Flist (2, &filename
));
2889 #endif /* S_IFLNK */
2893 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2894 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2895 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2896 If STRING is nil or a null string, the logical name NAME is deleted. */)
2901 CHECK_STRING (name
);
2903 delete_logical_name (SDATA (name
));
2906 CHECK_STRING (string
);
2908 if (SCHARS (string
) == 0)
2909 delete_logical_name (SDATA (name
));
2911 define_logical_name (SDATA (name
), SDATA (string
));
2920 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2921 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2923 Lisp_Object path
, login
;
2927 CHECK_STRING (path
);
2928 CHECK_STRING (login
);
2930 netresult
= netunam (SDATA (path
), SDATA (login
));
2932 if (netresult
== -1)
2937 #endif /* HPUX_NET */
2939 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2941 doc
: /* Return t if file FILENAME specifies an absolute file name.
2942 On Unix, this is a name starting with a `/' or a `~'. */)
2944 Lisp_Object filename
;
2946 const unsigned char *ptr
;
2948 CHECK_STRING (filename
);
2949 ptr
= SDATA (filename
);
2950 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2952 /* ??? This criterion is probably wrong for '<'. */
2953 || index (ptr
, ':') || index (ptr
, '<')
2954 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2958 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2966 /* Return nonzero if file FILENAME exists and can be executed. */
2969 check_executable (filename
)
2973 int len
= strlen (filename
);
2976 if (stat (filename
, &st
) < 0)
2978 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2979 return ((st
.st_mode
& S_IEXEC
) != 0);
2981 return (S_ISREG (st
.st_mode
)
2983 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2984 || stricmp (suffix
, ".exe") == 0
2985 || stricmp (suffix
, ".bat") == 0)
2986 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2987 #endif /* not WINDOWSNT */
2988 #else /* not DOS_NT */
2989 #ifdef HAVE_EUIDACCESS
2990 return (euidaccess (filename
, 1) >= 0);
2992 /* Access isn't quite right because it uses the real uid
2993 and we really want to test with the effective uid.
2994 But Unix doesn't give us a right way to do it. */
2995 return (access (filename
, 1) >= 0);
2997 #endif /* not DOS_NT */
3000 /* Return nonzero if file FILENAME exists and can be written. */
3003 check_writable (filename
)
3008 if (stat (filename
, &st
) < 0)
3010 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3011 #else /* not MSDOS */
3012 #ifdef HAVE_EUIDACCESS
3013 return (euidaccess (filename
, 2) >= 0);
3015 /* Access isn't quite right because it uses the real uid
3016 and we really want to test with the effective uid.
3017 But Unix doesn't give us a right way to do it.
3018 Opening with O_WRONLY could work for an ordinary file,
3019 but would lose for directories. */
3020 return (access (filename
, 2) >= 0);
3022 #endif /* not MSDOS */
3025 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3026 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3027 See also `file-readable-p' and `file-attributes'. */)
3029 Lisp_Object filename
;
3031 Lisp_Object absname
;
3032 Lisp_Object handler
;
3033 struct stat statbuf
;
3035 CHECK_STRING (filename
);
3036 absname
= Fexpand_file_name (filename
, Qnil
);
3038 /* If the file name has special constructs in it,
3039 call the corresponding file handler. */
3040 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3041 if (!NILP (handler
))
3042 return call2 (handler
, Qfile_exists_p
, absname
);
3044 absname
= ENCODE_FILE (absname
);
3046 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3049 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3050 doc
: /* Return t if FILENAME can be executed by you.
3051 For a directory, this means you can access files in that directory. */)
3053 Lisp_Object filename
;
3055 Lisp_Object absname
;
3056 Lisp_Object handler
;
3058 CHECK_STRING (filename
);
3059 absname
= Fexpand_file_name (filename
, Qnil
);
3061 /* If the file name has special constructs in it,
3062 call the corresponding file handler. */
3063 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3064 if (!NILP (handler
))
3065 return call2 (handler
, Qfile_executable_p
, absname
);
3067 absname
= ENCODE_FILE (absname
);
3069 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3072 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3073 doc
: /* Return t if file FILENAME exists and you can read it.
3074 See also `file-exists-p' and `file-attributes'. */)
3076 Lisp_Object filename
;
3078 Lisp_Object absname
;
3079 Lisp_Object handler
;
3082 struct stat statbuf
;
3084 CHECK_STRING (filename
);
3085 absname
= Fexpand_file_name (filename
, Qnil
);
3087 /* If the file name has special constructs in it,
3088 call the corresponding file handler. */
3089 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3090 if (!NILP (handler
))
3091 return call2 (handler
, Qfile_readable_p
, absname
);
3093 absname
= ENCODE_FILE (absname
);
3095 #if defined(DOS_NT) || defined(macintosh)
3096 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3098 if (access (SDATA (absname
), 0) == 0)
3101 #else /* not DOS_NT and not macintosh */
3103 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3104 /* Opening a fifo without O_NONBLOCK can wait.
3105 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3106 except in the case of a fifo, on a system which handles it. */
3107 desc
= stat (SDATA (absname
), &statbuf
);
3110 if (S_ISFIFO (statbuf
.st_mode
))
3111 flags
|= O_NONBLOCK
;
3113 desc
= emacs_open (SDATA (absname
), flags
, 0);
3118 #endif /* not DOS_NT and not macintosh */
3121 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3123 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3124 doc
: /* Return t if file FILENAME can be written or created by you. */)
3126 Lisp_Object filename
;
3128 Lisp_Object absname
, dir
, encoded
;
3129 Lisp_Object handler
;
3130 struct stat statbuf
;
3132 CHECK_STRING (filename
);
3133 absname
= Fexpand_file_name (filename
, Qnil
);
3135 /* If the file name has special constructs in it,
3136 call the corresponding file handler. */
3137 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3138 if (!NILP (handler
))
3139 return call2 (handler
, Qfile_writable_p
, absname
);
3141 encoded
= ENCODE_FILE (absname
);
3142 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3143 return (check_writable (SDATA (encoded
))
3146 dir
= Ffile_name_directory (absname
);
3149 dir
= Fdirectory_file_name (dir
);
3153 dir
= Fdirectory_file_name (dir
);
3156 dir
= ENCODE_FILE (dir
);
3158 /* The read-only attribute of the parent directory doesn't affect
3159 whether a file or directory can be created within it. Some day we
3160 should check ACLs though, which do affect this. */
3161 if (stat (SDATA (dir
), &statbuf
) < 0)
3163 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3165 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3170 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3171 doc
: /* Access file FILENAME, and get an error if that does not work.
3172 The second argument STRING is used in the error message.
3173 If there is no error, we return nil. */)
3175 Lisp_Object filename
, string
;
3177 Lisp_Object handler
, encoded_filename
, absname
;
3180 CHECK_STRING (filename
);
3181 absname
= Fexpand_file_name (filename
, Qnil
);
3183 CHECK_STRING (string
);
3185 /* If the file name has special constructs in it,
3186 call the corresponding file handler. */
3187 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3188 if (!NILP (handler
))
3189 return call3 (handler
, Qaccess_file
, absname
, string
);
3191 encoded_filename
= ENCODE_FILE (absname
);
3193 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3195 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3201 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3202 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3203 The value is the link target, as a string.
3204 Otherwise returns nil. */)
3206 Lisp_Object filename
;
3208 Lisp_Object handler
;
3210 CHECK_STRING (filename
);
3211 filename
= Fexpand_file_name (filename
, Qnil
);
3213 /* If the file name has special constructs in it,
3214 call the corresponding file handler. */
3215 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3216 if (!NILP (handler
))
3217 return call2 (handler
, Qfile_symlink_p
, filename
);
3226 filename
= ENCODE_FILE (filename
);
3233 buf
= (char *) xrealloc (buf
, bufsize
);
3234 bzero (buf
, bufsize
);
3237 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3241 /* HP-UX reports ERANGE if buffer is too small. */
3242 if (errno
== ERANGE
)
3252 while (valsize
>= bufsize
);
3254 val
= make_string (buf
, valsize
);
3255 if (buf
[0] == '/' && index (buf
, ':'))
3256 val
= concat2 (build_string ("/:"), val
);
3258 val
= DECODE_FILE (val
);
3261 #else /* not S_IFLNK */
3263 #endif /* not S_IFLNK */
3266 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3267 doc
: /* Return t if FILENAME names an existing directory.
3268 Symbolic links to directories count as directories.
3269 See `file-symlink-p' to distinguish symlinks. */)
3271 Lisp_Object filename
;
3273 register Lisp_Object absname
;
3275 Lisp_Object handler
;
3277 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3279 /* If the file name has special constructs in it,
3280 call the corresponding file handler. */
3281 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3282 if (!NILP (handler
))
3283 return call2 (handler
, Qfile_directory_p
, absname
);
3285 absname
= ENCODE_FILE (absname
);
3287 if (stat (SDATA (absname
), &st
) < 0)
3289 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3292 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3293 doc
: /* Return t if file FILENAME names a directory you can open.
3294 For the value to be t, FILENAME must specify the name of a directory as a file,
3295 and the directory must allow you to open files in it. In order to use a
3296 directory as a buffer's current directory, this predicate must return true.
3297 A directory name spec may be given instead; then the value is t
3298 if the directory so specified exists and really is a readable and
3299 searchable directory. */)
3301 Lisp_Object filename
;
3303 Lisp_Object handler
;
3305 struct gcpro gcpro1
;
3307 /* If the file name has special constructs in it,
3308 call the corresponding file handler. */
3309 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3310 if (!NILP (handler
))
3311 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3314 tem
= (NILP (Ffile_directory_p (filename
))
3315 || NILP (Ffile_executable_p (filename
)));
3317 return tem
? Qnil
: Qt
;
3320 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3321 doc
: /* Return t if file FILENAME is the name of a regular file.
3322 This is the sort of file that holds an ordinary stream of data bytes. */)
3324 Lisp_Object filename
;
3326 register Lisp_Object absname
;
3328 Lisp_Object handler
;
3330 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3332 /* If the file name has special constructs in it,
3333 call the corresponding file handler. */
3334 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3335 if (!NILP (handler
))
3336 return call2 (handler
, Qfile_regular_p
, absname
);
3338 absname
= ENCODE_FILE (absname
);
3343 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3345 /* Tell stat to use expensive method to get accurate info. */
3346 Vw32_get_true_file_attributes
= Qt
;
3347 result
= stat (SDATA (absname
), &st
);
3348 Vw32_get_true_file_attributes
= tem
;
3352 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3355 if (stat (SDATA (absname
), &st
) < 0)
3357 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3361 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3362 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
3364 Lisp_Object filename
;
3366 Lisp_Object absname
;
3368 Lisp_Object handler
;
3370 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3372 /* If the file name has special constructs in it,
3373 call the corresponding file handler. */
3374 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3375 if (!NILP (handler
))
3376 return call2 (handler
, Qfile_modes
, absname
);
3378 absname
= ENCODE_FILE (absname
);
3380 if (stat (SDATA (absname
), &st
) < 0)
3382 #if defined (MSDOS) && __DJGPP__ < 2
3383 if (check_executable (SDATA (absname
)))
3384 st
.st_mode
|= S_IEXEC
;
3385 #endif /* MSDOS && __DJGPP__ < 2 */
3387 return make_number (st
.st_mode
& 07777);
3390 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3391 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3392 Only the 12 low bits of MODE are used. */)
3394 Lisp_Object filename
, mode
;
3396 Lisp_Object absname
, encoded_absname
;
3397 Lisp_Object handler
;
3399 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3400 CHECK_NUMBER (mode
);
3402 /* If the file name has special constructs in it,
3403 call the corresponding file handler. */
3404 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3405 if (!NILP (handler
))
3406 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3408 encoded_absname
= ENCODE_FILE (absname
);
3410 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3411 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3416 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3417 doc
: /* Set the file permission bits for newly created files.
3418 The argument MODE should be an integer; only the low 9 bits are used.
3419 This setting is inherited by subprocesses. */)
3423 CHECK_NUMBER (mode
);
3425 umask ((~ XINT (mode
)) & 0777);
3430 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3431 doc
: /* Return the default file protection for created files.
3432 The value is an integer. */)
3438 realmask
= umask (0);
3441 XSETINT (value
, (~ realmask
) & 0777);
3445 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3447 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3448 doc
: /* Set times of file FILENAME to TIME.
3449 Set both access and modification times.
3450 Return t on success, else nil.
3451 Use the current time if TIME is nil. TIME is in the format of
3454 Lisp_Object filename
, time
;
3456 Lisp_Object absname
, encoded_absname
;
3457 Lisp_Object handler
;
3461 if (! lisp_time_argument (time
, &sec
, &usec
))
3462 error ("Invalid time specification");
3464 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3466 /* If the file name has special constructs in it,
3467 call the corresponding file handler. */
3468 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3469 if (!NILP (handler
))
3470 return call3 (handler
, Qset_file_times
, absname
, time
);
3472 encoded_absname
= ENCODE_FILE (absname
);
3477 EMACS_SET_SECS (t
, sec
);
3478 EMACS_SET_USECS (t
, usec
);
3480 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3485 /* Setting times on a directory always fails. */
3486 if (stat (SDATA (encoded_absname
), &st
) == 0
3487 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3490 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3503 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3504 doc
: /* Tell Unix to finish all pending disk updates. */)
3513 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3514 doc
: /* Return t if file FILE1 is newer than file FILE2.
3515 If FILE1 does not exist, the answer is nil;
3516 otherwise, if FILE2 does not exist, the answer is t. */)
3518 Lisp_Object file1
, file2
;
3520 Lisp_Object absname1
, absname2
;
3523 Lisp_Object handler
;
3524 struct gcpro gcpro1
, gcpro2
;
3526 CHECK_STRING (file1
);
3527 CHECK_STRING (file2
);
3530 GCPRO2 (absname1
, file2
);
3531 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3532 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3535 /* If the file name has special constructs in it,
3536 call the corresponding file handler. */
3537 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3539 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3540 if (!NILP (handler
))
3541 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3543 GCPRO2 (absname1
, absname2
);
3544 absname1
= ENCODE_FILE (absname1
);
3545 absname2
= ENCODE_FILE (absname2
);
3548 if (stat (SDATA (absname1
), &st
) < 0)
3551 mtime1
= st
.st_mtime
;
3553 if (stat (SDATA (absname2
), &st
) < 0)
3556 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3560 Lisp_Object Qfind_buffer_file_type
;
3563 #ifndef READ_BUF_SIZE
3564 #define READ_BUF_SIZE (64 << 10)
3567 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3569 /* This function is called after Lisp functions to decide a coding
3570 system are called, or when they cause an error. Before they are
3571 called, the current buffer is set unibyte and it contains only a
3572 newly inserted text (thus the buffer was empty before the
3575 The functions may set markers, overlays, text properties, or even
3576 alter the buffer contents, change the current buffer.
3578 Here, we reset all those changes by:
3579 o set back the current buffer.
3580 o move all markers and overlays to BEG.
3581 o remove all text properties.
3582 o set back the buffer multibyteness. */
3585 decide_coding_unwind (unwind_data
)
3586 Lisp_Object unwind_data
;
3588 Lisp_Object multibyte
, undo_list
, buffer
;
3590 multibyte
= XCAR (unwind_data
);
3591 unwind_data
= XCDR (unwind_data
);
3592 undo_list
= XCAR (unwind_data
);
3593 buffer
= XCDR (unwind_data
);
3595 if (current_buffer
!= XBUFFER (buffer
))
3596 set_buffer_internal (XBUFFER (buffer
));
3597 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3598 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3599 BUF_INTERVALS (current_buffer
) = 0;
3600 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3602 /* Now we are safe to change the buffer's multibyteness directly. */
3603 current_buffer
->enable_multibyte_characters
= multibyte
;
3604 current_buffer
->undo_list
= undo_list
;
3610 /* Used to pass values from insert-file-contents to read_non_regular. */
3612 static int non_regular_fd
;
3613 static int non_regular_inserted
;
3614 static int non_regular_nbytes
;
3617 /* Read from a non-regular file.
3618 Read non_regular_trytry bytes max from non_regular_fd.
3619 Non_regular_inserted specifies where to put the read bytes.
3620 Value is the number of bytes read. */
3629 nbytes
= emacs_read (non_regular_fd
,
3630 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3631 non_regular_nbytes
);
3633 return make_number (nbytes
);
3637 /* Condition-case handler used when reading from non-regular files
3638 in insert-file-contents. */
3641 read_non_regular_quit ()
3647 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3649 doc
: /* Insert contents of file FILENAME after point.
3650 Returns list of absolute file name and number of characters inserted.
3651 If second argument VISIT is non-nil, the buffer's visited filename
3652 and last save file modtime are set, and it is marked unmodified.
3653 If visiting and the file does not exist, visiting is completed
3654 before the error is signaled.
3655 The optional third and fourth arguments BEG and END
3656 specify what portion of the file to insert.
3657 These arguments count bytes in the file, not characters in the buffer.
3658 If VISIT is non-nil, BEG and END must be nil.
3660 If optional fifth argument REPLACE is non-nil,
3661 it means replace the current buffer contents (in the accessible portion)
3662 with the file contents. This is better than simply deleting and inserting
3663 the whole thing because (1) it preserves some marker positions
3664 and (2) it puts less data in the undo list.
3665 When REPLACE is non-nil, the value is the number of characters actually read,
3666 which is often less than the number of characters to be read.
3668 This does code conversion according to the value of
3669 `coding-system-for-read' or `file-coding-system-alist',
3670 and sets the variable `last-coding-system-used' to the coding system
3672 (filename
, visit
, beg
, end
, replace
)
3673 Lisp_Object filename
, visit
, beg
, end
, replace
;
3678 register int how_much
;
3679 register int unprocessed
;
3680 int count
= SPECPDL_INDEX ();
3681 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3682 Lisp_Object handler
, val
, insval
, orig_filename
;
3685 int not_regular
= 0;
3686 unsigned char read_buf
[READ_BUF_SIZE
];
3687 struct coding_system coding
;
3688 unsigned char buffer
[1 << 14];
3689 int replace_handled
= 0;
3690 int set_coding_system
= 0;
3691 int coding_system_decided
= 0;
3694 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3695 error ("Cannot do file visiting in an indirect buffer");
3697 if (!NILP (current_buffer
->read_only
))
3698 Fbarf_if_buffer_read_only ();
3702 orig_filename
= Qnil
;
3704 GCPRO4 (filename
, val
, p
, orig_filename
);
3706 CHECK_STRING (filename
);
3707 filename
= Fexpand_file_name (filename
, Qnil
);
3709 /* If the file name has special constructs in it,
3710 call the corresponding file handler. */
3711 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3712 if (!NILP (handler
))
3714 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3715 visit
, beg
, end
, replace
);
3716 if (CONSP (val
) && CONSP (XCDR (val
)))
3717 inserted
= XINT (XCAR (XCDR (val
)));
3721 orig_filename
= filename
;
3722 filename
= ENCODE_FILE (filename
);
3728 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3730 /* Tell stat to use expensive method to get accurate info. */
3731 Vw32_get_true_file_attributes
= Qt
;
3732 total
= stat (SDATA (filename
), &st
);
3733 Vw32_get_true_file_attributes
= tem
;
3738 if (stat (SDATA (filename
), &st
) < 0)
3740 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3741 || fstat (fd
, &st
) < 0)
3742 #endif /* not APOLLO */
3743 #endif /* WINDOWSNT */
3745 if (fd
>= 0) emacs_close (fd
);
3748 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3751 if (!NILP (Vcoding_system_for_read
))
3752 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3757 /* This code will need to be changed in order to work on named
3758 pipes, and it's probably just not worth it. So we should at
3759 least signal an error. */
3760 if (!S_ISREG (st
.st_mode
))
3767 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3768 Fsignal (Qfile_error
,
3769 Fcons (build_string ("not a regular file"),
3770 Fcons (orig_filename
, Qnil
)));
3775 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3778 /* Replacement should preserve point as it preserves markers. */
3779 if (!NILP (replace
))
3780 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3782 record_unwind_protect (close_file_unwind
, make_number (fd
));
3784 /* Supposedly happens on VMS. */
3785 /* Can happen on any platform that uses long as type of off_t, but allows
3786 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3787 give a message suitable for the latter case. */
3788 if (! not_regular
&& st
.st_size
< 0)
3789 error ("Maximum buffer size exceeded");
3791 /* Prevent redisplay optimizations. */
3792 current_buffer
->clip_changed
= 1;
3796 if (!NILP (beg
) || !NILP (end
))
3797 error ("Attempt to visit less than an entire file");
3798 if (BEG
< Z
&& NILP (replace
))
3799 error ("Cannot do file visiting in a non-empty buffer");
3805 XSETFASTINT (beg
, 0);
3813 XSETINT (end
, st
.st_size
);
3815 /* Arithmetic overflow can occur if an Emacs integer cannot
3816 represent the file size, or if the calculations below
3817 overflow. The calculations below double the file size
3818 twice, so check that it can be multiplied by 4 safely. */
3819 if (XINT (end
) != st
.st_size
3820 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3821 error ("Maximum buffer size exceeded");
3823 /* The file size returned from stat may be zero, but data
3824 may be readable nonetheless, for example when this is a
3825 file in the /proc filesystem. */
3826 if (st
.st_size
== 0)
3827 XSETINT (end
, READ_BUF_SIZE
);
3831 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3833 /* We use emacs-mule for auto saving... */
3834 setup_coding_system (Qemacs_mule
, &coding
);
3835 /* ... but with the special flag to indicate to read in a
3836 multibyte sequence for eight-bit-control char as is. */
3838 coding
.src_multibyte
= 0;
3839 coding
.dst_multibyte
3840 = !NILP (current_buffer
->enable_multibyte_characters
);
3841 coding
.eol_type
= CODING_EOL_LF
;
3842 coding_system_decided
= 1;
3846 /* Decide the coding system to use for reading the file now
3847 because we can't use an optimized method for handling
3848 `coding:' tag if the current buffer is not empty. */
3852 if (!NILP (Vcoding_system_for_read
))
3853 val
= Vcoding_system_for_read
;
3854 else if (! NILP (replace
))
3855 /* In REPLACE mode, we can use the same coding system
3856 that was used to visit the file. */
3857 val
= current_buffer
->buffer_file_coding_system
;
3860 /* Don't try looking inside a file for a coding system
3861 specification if it is not seekable. */
3862 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3864 /* Find a coding system specified in the heading two
3865 lines or in the tailing several lines of the file.
3866 We assume that the 1K-byte and 3K-byte for heading
3867 and tailing respectively are sufficient for this
3871 if (st
.st_size
<= (1024 * 4))
3872 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3875 nread
= emacs_read (fd
, read_buf
, 1024);
3878 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3879 report_file_error ("Setting file position",
3880 Fcons (orig_filename
, Qnil
));
3881 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3886 error ("IO error reading %s: %s",
3887 SDATA (orig_filename
), emacs_strerror (errno
));
3890 struct buffer
*prev
= current_buffer
;
3894 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3896 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3897 buf
= XBUFFER (buffer
);
3899 delete_all_overlays (buf
);
3900 buf
->directory
= current_buffer
->directory
;
3901 buf
->read_only
= Qnil
;
3902 buf
->filename
= Qnil
;
3903 buf
->undo_list
= Qt
;
3904 eassert (buf
->overlays_before
== NULL
);
3905 eassert (buf
->overlays_after
== NULL
);
3907 set_buffer_internal (buf
);
3909 buf
->enable_multibyte_characters
= Qnil
;
3911 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3912 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3913 val
= call2 (Vset_auto_coding_function
,
3914 filename
, make_number (nread
));
3915 set_buffer_internal (prev
);
3917 /* Discard the unwind protect for recovering the
3921 /* Rewind the file for the actual read done later. */
3922 if (lseek (fd
, 0, 0) < 0)
3923 report_file_error ("Setting file position",
3924 Fcons (orig_filename
, Qnil
));
3930 /* If we have not yet decided a coding system, check
3931 file-coding-system-alist. */
3932 Lisp_Object args
[6], coding_systems
;
3934 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3935 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3936 coding_systems
= Ffind_operation_coding_system (6, args
);
3937 if (CONSP (coding_systems
))
3938 val
= XCAR (coding_systems
);
3942 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3943 /* Ensure we set Vlast_coding_system_used. */
3944 set_coding_system
= 1;
3946 if (NILP (current_buffer
->enable_multibyte_characters
)
3948 /* We must suppress all character code conversion except for
3949 end-of-line conversion. */
3950 setup_raw_text_coding_system (&coding
);
3952 coding
.src_multibyte
= 0;
3953 coding
.dst_multibyte
3954 = !NILP (current_buffer
->enable_multibyte_characters
);
3955 coding_system_decided
= 1;
3958 /* If requested, replace the accessible part of the buffer
3959 with the file contents. Avoid replacing text at the
3960 beginning or end of the buffer that matches the file contents;
3961 that preserves markers pointing to the unchanged parts.
3963 Here we implement this feature in an optimized way
3964 for the case where code conversion is NOT needed.
3965 The following if-statement handles the case of conversion
3966 in a less optimal way.
3968 If the code conversion is "automatic" then we try using this
3969 method and hope for the best.
3970 But if we discover the need for conversion, we give up on this method
3971 and let the following if-statement handle the replace job. */
3974 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3976 /* same_at_start and same_at_end count bytes,
3977 because file access counts bytes
3978 and BEG and END count bytes. */
3979 int same_at_start
= BEGV_BYTE
;
3980 int same_at_end
= ZV_BYTE
;
3982 /* There is still a possibility we will find the need to do code
3983 conversion. If that happens, we set this variable to 1 to
3984 give up on handling REPLACE in the optimized way. */
3985 int giveup_match_end
= 0;
3987 if (XINT (beg
) != 0)
3989 if (lseek (fd
, XINT (beg
), 0) < 0)
3990 report_file_error ("Setting file position",
3991 Fcons (orig_filename
, Qnil
));
3996 /* Count how many chars at the start of the file
3997 match the text at the beginning of the buffer. */
4002 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4004 error ("IO error reading %s: %s",
4005 SDATA (orig_filename
), emacs_strerror (errno
));
4006 else if (nread
== 0)
4009 if (coding
.type
== coding_type_undecided
)
4010 detect_coding (&coding
, buffer
, nread
);
4011 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4012 /* We found that the file should be decoded somehow.
4013 Let's give up here. */
4015 giveup_match_end
= 1;
4019 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4020 detect_eol (&coding
, buffer
, nread
);
4021 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4022 && coding
.eol_type
!= CODING_EOL_LF
)
4023 /* We found that the format of eol should be decoded.
4024 Let's give up here. */
4026 giveup_match_end
= 1;
4031 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4032 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4033 same_at_start
++, bufpos
++;
4034 /* If we found a discrepancy, stop the scan.
4035 Otherwise loop around and scan the next bufferful. */
4036 if (bufpos
!= nread
)
4040 /* If the file matches the buffer completely,
4041 there's no need to replace anything. */
4042 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4046 /* Truncate the buffer to the size of the file. */
4047 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4052 /* Count how many chars at the end of the file
4053 match the text at the end of the buffer. But, if we have
4054 already found that decoding is necessary, don't waste time. */
4055 while (!giveup_match_end
)
4057 int total_read
, nread
, bufpos
, curpos
, trial
;
4059 /* At what file position are we now scanning? */
4060 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4061 /* If the entire file matches the buffer tail, stop the scan. */
4064 /* How much can we scan in the next step? */
4065 trial
= min (curpos
, sizeof buffer
);
4066 if (lseek (fd
, curpos
- trial
, 0) < 0)
4067 report_file_error ("Setting file position",
4068 Fcons (orig_filename
, Qnil
));
4070 total_read
= nread
= 0;
4071 while (total_read
< trial
)
4073 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4075 error ("IO error reading %s: %s",
4076 SDATA (orig_filename
), emacs_strerror (errno
));
4077 else if (nread
== 0)
4079 total_read
+= nread
;
4082 /* Scan this bufferful from the end, comparing with
4083 the Emacs buffer. */
4084 bufpos
= total_read
;
4086 /* Compare with same_at_start to avoid counting some buffer text
4087 as matching both at the file's beginning and at the end. */
4088 while (bufpos
> 0 && same_at_end
> same_at_start
4089 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4090 same_at_end
--, bufpos
--;
4092 /* If we found a discrepancy, stop the scan.
4093 Otherwise loop around and scan the preceding bufferful. */
4096 /* If this discrepancy is because of code conversion,
4097 we cannot use this method; giveup and try the other. */
4098 if (same_at_end
> same_at_start
4099 && FETCH_BYTE (same_at_end
- 1) >= 0200
4100 && ! NILP (current_buffer
->enable_multibyte_characters
)
4101 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4102 giveup_match_end
= 1;
4111 if (! giveup_match_end
)
4115 /* We win! We can handle REPLACE the optimized way. */
4117 /* Extend the start of non-matching text area to multibyte
4118 character boundary. */
4119 if (! NILP (current_buffer
->enable_multibyte_characters
))
4120 while (same_at_start
> BEGV_BYTE
4121 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4124 /* Extend the end of non-matching text area to multibyte
4125 character boundary. */
4126 if (! NILP (current_buffer
->enable_multibyte_characters
))
4127 while (same_at_end
< ZV_BYTE
4128 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4131 /* Don't try to reuse the same piece of text twice. */
4132 overlap
= (same_at_start
- BEGV_BYTE
4133 - (same_at_end
+ st
.st_size
- ZV
));
4135 same_at_end
+= overlap
;
4137 /* Arrange to read only the nonmatching middle part of the file. */
4138 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4139 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4141 del_range_byte (same_at_start
, same_at_end
, 0);
4142 /* Insert from the file at the proper position. */
4143 temp
= BYTE_TO_CHAR (same_at_start
);
4144 SET_PT_BOTH (temp
, same_at_start
);
4146 /* If display currently starts at beginning of line,
4147 keep it that way. */
4148 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4149 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4151 replace_handled
= 1;
4155 /* If requested, replace the accessible part of the buffer
4156 with the file contents. Avoid replacing text at the
4157 beginning or end of the buffer that matches the file contents;
4158 that preserves markers pointing to the unchanged parts.
4160 Here we implement this feature for the case where code conversion
4161 is needed, in a simple way that needs a lot of memory.
4162 The preceding if-statement handles the case of no conversion
4163 in a more optimized way. */
4164 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4166 int same_at_start
= BEGV_BYTE
;
4167 int same_at_end
= ZV_BYTE
;
4170 /* Make sure that the gap is large enough. */
4171 int bufsize
= 2 * st
.st_size
;
4172 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4175 /* First read the whole file, performing code conversion into
4176 CONVERSION_BUFFER. */
4178 if (lseek (fd
, XINT (beg
), 0) < 0)
4180 xfree (conversion_buffer
);
4181 report_file_error ("Setting file position",
4182 Fcons (orig_filename
, Qnil
));
4185 total
= st
.st_size
; /* Total bytes in the file. */
4186 how_much
= 0; /* Bytes read from file so far. */
4187 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4188 unprocessed
= 0; /* Bytes not processed in previous loop. */
4190 while (how_much
< total
)
4192 /* try is reserved in some compilers (Microsoft C) */
4193 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4194 unsigned char *destination
= read_buf
+ unprocessed
;
4197 /* Allow quitting out of the actual I/O. */
4200 this = emacs_read (fd
, destination
, trytry
);
4203 if (this < 0 || this + unprocessed
== 0)
4211 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4213 int require
, result
;
4215 this += unprocessed
;
4217 /* If we are using more space than estimated,
4218 make CONVERSION_BUFFER bigger. */
4219 require
= decoding_buffer_size (&coding
, this);
4220 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4222 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4223 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4226 /* Convert this batch with results in CONVERSION_BUFFER. */
4227 if (how_much
>= total
) /* This is the last block. */
4228 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4229 if (coding
.composing
!= COMPOSITION_DISABLED
)
4230 coding_allocate_composition_data (&coding
, BEGV
);
4231 result
= decode_coding (&coding
, read_buf
,
4232 conversion_buffer
+ inserted
,
4233 this, bufsize
- inserted
);
4235 /* Save for next iteration whatever we didn't convert. */
4236 unprocessed
= this - coding
.consumed
;
4237 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4238 if (!NILP (current_buffer
->enable_multibyte_characters
))
4239 this = coding
.produced
;
4241 this = str_as_unibyte (conversion_buffer
+ inserted
,
4248 /* At this point, INSERTED is how many characters (i.e. bytes)
4249 are present in CONVERSION_BUFFER.
4250 HOW_MUCH should equal TOTAL,
4251 or should be <= 0 if we couldn't read the file. */
4255 xfree (conversion_buffer
);
4258 error ("IO error reading %s: %s",
4259 SDATA (orig_filename
), emacs_strerror (errno
));
4260 else if (how_much
== -2)
4261 error ("maximum buffer size exceeded");
4264 /* Compare the beginning of the converted file
4265 with the buffer text. */
4268 while (bufpos
< inserted
&& same_at_start
< same_at_end
4269 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4270 same_at_start
++, bufpos
++;
4272 /* If the file matches the buffer completely,
4273 there's no need to replace anything. */
4275 if (bufpos
== inserted
)
4277 xfree (conversion_buffer
);
4280 /* Truncate the buffer to the size of the file. */
4281 del_range_byte (same_at_start
, same_at_end
, 0);
4286 /* Extend the start of non-matching text area to multibyte
4287 character boundary. */
4288 if (! NILP (current_buffer
->enable_multibyte_characters
))
4289 while (same_at_start
> BEGV_BYTE
4290 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4293 /* Scan this bufferful from the end, comparing with
4294 the Emacs buffer. */
4297 /* Compare with same_at_start to avoid counting some buffer text
4298 as matching both at the file's beginning and at the end. */
4299 while (bufpos
> 0 && same_at_end
> same_at_start
4300 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4301 same_at_end
--, bufpos
--;
4303 /* Extend the end of non-matching text area to multibyte
4304 character boundary. */
4305 if (! NILP (current_buffer
->enable_multibyte_characters
))
4306 while (same_at_end
< ZV_BYTE
4307 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4310 /* Don't try to reuse the same piece of text twice. */
4311 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4313 same_at_end
+= overlap
;
4315 /* If display currently starts at beginning of line,
4316 keep it that way. */
4317 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4318 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4320 /* Replace the chars that we need to replace,
4321 and update INSERTED to equal the number of bytes
4322 we are taking from the file. */
4323 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4325 if (same_at_end
!= same_at_start
)
4327 del_range_byte (same_at_start
, same_at_end
, 0);
4329 same_at_start
= GPT_BYTE
;
4333 temp
= BYTE_TO_CHAR (same_at_start
);
4335 /* Insert from the file at the proper position. */
4336 SET_PT_BOTH (temp
, same_at_start
);
4337 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
4339 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4340 coding_restore_composition (&coding
, Fcurrent_buffer ());
4341 coding_free_composition_data (&coding
);
4343 /* Set `inserted' to the number of inserted characters. */
4344 inserted
= PT
- temp
;
4346 xfree (conversion_buffer
);
4355 register Lisp_Object temp
;
4357 total
= XINT (end
) - XINT (beg
);
4359 /* Make sure point-max won't overflow after this insertion. */
4360 XSETINT (temp
, total
);
4361 if (total
!= XINT (temp
))
4362 error ("Maximum buffer size exceeded");
4365 /* For a special file, all we can do is guess. */
4366 total
= READ_BUF_SIZE
;
4368 if (NILP (visit
) && total
> 0)
4369 prepare_to_modify_buffer (PT
, PT
, NULL
);
4372 if (GAP_SIZE
< total
)
4373 make_gap (total
- GAP_SIZE
);
4375 if (XINT (beg
) != 0 || !NILP (replace
))
4377 if (lseek (fd
, XINT (beg
), 0) < 0)
4378 report_file_error ("Setting file position",
4379 Fcons (orig_filename
, Qnil
));
4382 /* In the following loop, HOW_MUCH contains the total bytes read so
4383 far for a regular file, and not changed for a special file. But,
4384 before exiting the loop, it is set to a negative value if I/O
4388 /* Total bytes inserted. */
4391 /* Here, we don't do code conversion in the loop. It is done by
4392 code_convert_region after all data are read into the buffer. */
4394 int gap_size
= GAP_SIZE
;
4396 while (how_much
< total
)
4398 /* try is reserved in some compilers (Microsoft C) */
4399 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4406 /* Maybe make more room. */
4407 if (gap_size
< trytry
)
4409 make_gap (total
- gap_size
);
4410 gap_size
= GAP_SIZE
;
4413 /* Read from the file, capturing `quit'. When an
4414 error occurs, end the loop, and arrange for a quit
4415 to be signaled after decoding the text we read. */
4416 non_regular_fd
= fd
;
4417 non_regular_inserted
= inserted
;
4418 non_regular_nbytes
= trytry
;
4419 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4420 read_non_regular_quit
);
4431 /* Allow quitting out of the actual I/O. We don't make text
4432 part of the buffer until all the reading is done, so a C-g
4433 here doesn't do any harm. */
4436 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4448 /* For a regular file, where TOTAL is the real size,
4449 count HOW_MUCH to compare with it.
4450 For a special file, where TOTAL is just a buffer size,
4451 so don't bother counting in HOW_MUCH.
4452 (INSERTED is where we count the number of characters inserted.) */
4459 /* Make the text read part of the buffer. */
4460 GAP_SIZE
-= inserted
;
4462 GPT_BYTE
+= inserted
;
4464 ZV_BYTE
+= inserted
;
4469 /* Put an anchor to ensure multi-byte form ends at gap. */
4474 /* Discard the unwind protect for closing the file. */
4478 error ("IO error reading %s: %s",
4479 SDATA (orig_filename
), emacs_strerror (errno
));
4483 if (! coding_system_decided
)
4485 /* The coding system is not yet decided. Decide it by an
4486 optimized method for handling `coding:' tag.
4488 Note that we can get here only if the buffer was empty
4489 before the insertion. */
4493 if (!NILP (Vcoding_system_for_read
))
4494 val
= Vcoding_system_for_read
;
4497 /* Since we are sure that the current buffer was empty
4498 before the insertion, we can toggle
4499 enable-multibyte-characters directly here without taking
4500 care of marker adjustment and byte combining problem. By
4501 this way, we can run Lisp program safely before decoding
4502 the inserted text. */
4503 Lisp_Object unwind_data
;
4504 int count
= SPECPDL_INDEX ();
4506 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4507 Fcons (current_buffer
->undo_list
,
4508 Fcurrent_buffer ()));
4509 current_buffer
->enable_multibyte_characters
= Qnil
;
4510 current_buffer
->undo_list
= Qt
;
4511 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4513 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4515 val
= call2 (Vset_auto_coding_function
,
4516 filename
, make_number (inserted
));
4521 /* If the coding system is not yet decided, check
4522 file-coding-system-alist. */
4523 Lisp_Object args
[6], coding_systems
;
4525 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4526 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4527 coding_systems
= Ffind_operation_coding_system (6, args
);
4528 if (CONSP (coding_systems
))
4529 val
= XCAR (coding_systems
);
4532 unbind_to (count
, Qnil
);
4533 inserted
= Z_BYTE
- BEG_BYTE
;
4536 /* The following kludgy code is to avoid some compiler bug.
4538 setup_coding_system (val, &coding);
4541 struct coding_system temp_coding
;
4542 setup_coding_system (val
, &temp_coding
);
4543 bcopy (&temp_coding
, &coding
, sizeof coding
);
4545 /* Ensure we set Vlast_coding_system_used. */
4546 set_coding_system
= 1;
4548 if (NILP (current_buffer
->enable_multibyte_characters
)
4550 /* We must suppress all character code conversion except for
4551 end-of-line conversion. */
4552 setup_raw_text_coding_system (&coding
);
4553 coding
.src_multibyte
= 0;
4554 coding
.dst_multibyte
4555 = !NILP (current_buffer
->enable_multibyte_characters
);
4559 /* Can't do this if part of the buffer might be preserved. */
4561 && (coding
.type
== coding_type_no_conversion
4562 || coding
.type
== coding_type_raw_text
))
4564 /* Visiting a file with these coding system makes the buffer
4566 current_buffer
->enable_multibyte_characters
= Qnil
;
4567 coding
.dst_multibyte
= 0;
4570 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4572 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4574 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4576 inserted
= coding
.produced_char
;
4579 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4583 /* Now INSERTED is measured in characters. */
4586 /* Use the conversion type to determine buffer-file-type
4587 (find-buffer-file-type is now used to help determine the
4589 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4590 || coding
.eol_type
== CODING_EOL_LF
)
4591 && ! CODING_REQUIRE_DECODING (&coding
))
4592 current_buffer
->buffer_file_type
= Qt
;
4594 current_buffer
->buffer_file_type
= Qnil
;
4601 if (!EQ (current_buffer
->undo_list
, Qt
))
4602 current_buffer
->undo_list
= Qnil
;
4604 stat (SDATA (filename
), &st
);
4609 current_buffer
->modtime
= st
.st_mtime
;
4610 current_buffer
->filename
= orig_filename
;
4613 SAVE_MODIFF
= MODIFF
;
4614 current_buffer
->auto_save_modified
= MODIFF
;
4615 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4616 #ifdef CLASH_DETECTION
4619 if (!NILP (current_buffer
->file_truename
))
4620 unlock_file (current_buffer
->file_truename
);
4621 unlock_file (filename
);
4623 #endif /* CLASH_DETECTION */
4625 Fsignal (Qfile_error
,
4626 Fcons (build_string ("not a regular file"),
4627 Fcons (orig_filename
, Qnil
)));
4630 if (set_coding_system
)
4631 Vlast_coding_system_used
= coding
.symbol
;
4633 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4635 insval
= call1 (Qafter_insert_file_set_coding
, make_number (inserted
));
4636 if (! NILP (insval
))
4638 CHECK_NUMBER (insval
);
4639 inserted
= XFASTINT (insval
);
4643 /* Decode file format */
4646 int empty_undo_list_p
= 0;
4648 /* If we're anyway going to discard undo information, don't
4649 record it in the first place. The buffer's undo list at this
4650 point is either nil or t when visiting a file. */
4653 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4654 current_buffer
->undo_list
= Qt
;
4657 insval
= call3 (Qformat_decode
,
4658 Qnil
, make_number (inserted
), visit
);
4659 CHECK_NUMBER (insval
);
4660 inserted
= XFASTINT (insval
);
4663 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4666 /* Call after-change hooks for the inserted text, aside from the case
4667 of normal visiting (not with REPLACE), which is done in a new buffer
4668 "before" the buffer is changed. */
4669 if (inserted
> 0 && total
> 0
4670 && (NILP (visit
) || !NILP (replace
)))
4672 signal_after_change (PT
, 0, inserted
);
4673 update_compositions (PT
, PT
, CHECK_BORDER
);
4676 p
= Vafter_insert_file_functions
;
4679 insval
= call1 (XCAR (p
), make_number (inserted
));
4682 CHECK_NUMBER (insval
);
4683 inserted
= XFASTINT (insval
);
4690 && current_buffer
->modtime
== -1)
4692 /* If visiting nonexistent file, return nil. */
4693 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4697 Fsignal (Qquit
, Qnil
);
4699 /* ??? Retval needs to be dealt with in all cases consistently. */
4701 val
= Fcons (orig_filename
,
4702 Fcons (make_number (inserted
),
4705 RETURN_UNGCPRO (unbind_to (count
, val
));
4708 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4709 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4710 Lisp_Object
, Lisp_Object
));
4712 /* If build_annotations switched buffers, switch back to BUF.
4713 Kill the temporary buffer that was selected in the meantime.
4715 Since this kill only the last temporary buffer, some buffers remain
4716 not killed if build_annotations switched buffers more than once.
4720 build_annotations_unwind (buf
)
4725 if (XBUFFER (buf
) == current_buffer
)
4727 tembuf
= Fcurrent_buffer ();
4729 Fkill_buffer (tembuf
);
4733 /* Decide the coding-system to encode the data with. */
4736 choose_write_coding_system (start
, end
, filename
,
4737 append
, visit
, lockname
, coding
)
4738 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4739 struct coding_system
*coding
;
4744 && NILP (Fstring_equal (current_buffer
->filename
,
4745 current_buffer
->auto_save_file_name
)))
4747 /* We use emacs-mule for auto saving... */
4748 setup_coding_system (Qemacs_mule
, coding
);
4749 /* ... but with the special flag to indicate not to strip off
4750 leading code of eight-bit-control chars. */
4752 goto done_setup_coding
;
4754 else if (!NILP (Vcoding_system_for_write
))
4756 val
= Vcoding_system_for_write
;
4757 if (coding_system_require_warning
4758 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4759 /* Confirm that VAL can surely encode the current region. */
4760 val
= call5 (Vselect_safe_coding_system_function
,
4761 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4766 /* If the variable `buffer-file-coding-system' is set locally,
4767 it means that the file was read with some kind of code
4768 conversion or the variable is explicitly set by users. We
4769 had better write it out with the same coding system even if
4770 `enable-multibyte-characters' is nil.
4772 If it is not set locally, we anyway have to convert EOL
4773 format if the default value of `buffer-file-coding-system'
4774 tells that it is not Unix-like (LF only) format. */
4775 int using_default_coding
= 0;
4776 int force_raw_text
= 0;
4778 val
= current_buffer
->buffer_file_coding_system
;
4780 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4783 if (NILP (current_buffer
->enable_multibyte_characters
))
4789 /* Check file-coding-system-alist. */
4790 Lisp_Object args
[7], coding_systems
;
4792 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4793 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4795 coding_systems
= Ffind_operation_coding_system (7, args
);
4796 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4797 val
= XCDR (coding_systems
);
4801 && !NILP (current_buffer
->buffer_file_coding_system
))
4803 /* If we still have not decided a coding system, use the
4804 default value of buffer-file-coding-system. */
4805 val
= current_buffer
->buffer_file_coding_system
;
4806 using_default_coding
= 1;
4810 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4811 /* Confirm that VAL can surely encode the current region. */
4812 val
= call5 (Vselect_safe_coding_system_function
,
4813 start
, end
, val
, Qnil
, filename
);
4815 setup_coding_system (Fcheck_coding_system (val
), coding
);
4816 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4817 && !using_default_coding
)
4819 if (! EQ (default_buffer_file_coding
.symbol
,
4820 buffer_defaults
.buffer_file_coding_system
))
4821 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4822 &default_buffer_file_coding
);
4823 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4825 Lisp_Object subsidiaries
;
4827 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4828 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4829 if (VECTORP (subsidiaries
)
4830 && XVECTOR (subsidiaries
)->size
== 3)
4832 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4837 setup_raw_text_coding_system (coding
);
4838 goto done_setup_coding
;
4841 setup_coding_system (Fcheck_coding_system (val
), coding
);
4844 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4845 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4848 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4849 "r\nFWrite region to file: \ni\ni\ni\np",
4850 doc
: /* Write current region into specified file.
4851 When called from a program, requires three arguments:
4852 START, END and FILENAME. START and END are normally buffer positions
4853 specifying the part of the buffer to write.
4854 If START is nil, that means to use the entire buffer contents.
4855 If START is a string, then output that string to the file
4856 instead of any buffer contents; END is ignored.
4858 Optional fourth argument APPEND if non-nil means
4859 append to existing file contents (if any). If it is an integer,
4860 seek to that offset in the file before writing.
4861 Optional fifth argument VISIT if t means
4862 set the last-save-file-modtime of buffer to this file's modtime
4863 and mark buffer not modified.
4864 If VISIT is a string, it is a second file name;
4865 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4866 VISIT is also the file name to lock and unlock for clash detection.
4867 If VISIT is neither t nor nil nor a string,
4868 that means do not display the \"Wrote file\" message.
4869 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4870 use for locking and unlocking, overriding FILENAME and VISIT.
4871 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4872 for an existing file with the same name. If MUSTBENEW is `excl',
4873 that means to get an error if the file already exists; never overwrite.
4874 If MUSTBENEW is neither nil nor `excl', that means ask for
4875 confirmation before overwriting, but do go ahead and overwrite the file
4876 if the user confirms.
4878 This does code conversion according to the value of
4879 `coding-system-for-write', `buffer-file-coding-system', or
4880 `file-coding-system-alist', and sets the variable
4881 `last-coding-system-used' to the coding system actually used. */)
4882 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4883 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4888 const unsigned char *fn
;
4891 int count
= SPECPDL_INDEX ();
4894 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4896 Lisp_Object handler
;
4897 Lisp_Object visit_file
;
4898 Lisp_Object annotations
;
4899 Lisp_Object encoded_filename
;
4900 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4901 int quietly
= !NILP (visit
);
4902 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4903 struct buffer
*given_buffer
;
4905 int buffer_file_type
= O_BINARY
;
4907 struct coding_system coding
;
4909 if (current_buffer
->base_buffer
&& visiting
)
4910 error ("Cannot do file visiting in an indirect buffer");
4912 if (!NILP (start
) && !STRINGP (start
))
4913 validate_region (&start
, &end
);
4915 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4917 filename
= Fexpand_file_name (filename
, Qnil
);
4919 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4920 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4922 if (STRINGP (visit
))
4923 visit_file
= Fexpand_file_name (visit
, Qnil
);
4925 visit_file
= filename
;
4927 if (NILP (lockname
))
4928 lockname
= visit_file
;
4932 /* If the file name has special constructs in it,
4933 call the corresponding file handler. */
4934 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4935 /* If FILENAME has no handler, see if VISIT has one. */
4936 if (NILP (handler
) && STRINGP (visit
))
4937 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4939 if (!NILP (handler
))
4942 val
= call6 (handler
, Qwrite_region
, start
, end
,
4943 filename
, append
, visit
);
4947 SAVE_MODIFF
= MODIFF
;
4948 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4949 current_buffer
->filename
= visit_file
;
4955 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4957 /* Special kludge to simplify auto-saving. */
4960 XSETFASTINT (start
, BEG
);
4961 XSETFASTINT (end
, Z
);
4965 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4966 count1
= SPECPDL_INDEX ();
4968 given_buffer
= current_buffer
;
4970 if (!STRINGP (start
))
4972 annotations
= build_annotations (start
, end
);
4974 if (current_buffer
!= given_buffer
)
4976 XSETFASTINT (start
, BEGV
);
4977 XSETFASTINT (end
, ZV
);
4983 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4985 /* Decide the coding-system to encode the data with.
4986 We used to make this choice before calling build_annotations, but that
4987 leads to problems when a write-annotate-function takes care of
4988 unsavable chars (as was the case with X-Symbol). */
4989 choose_write_coding_system (start
, end
, filename
,
4990 append
, visit
, lockname
, &coding
);
4991 Vlast_coding_system_used
= coding
.symbol
;
4993 given_buffer
= current_buffer
;
4994 if (! STRINGP (start
))
4996 annotations
= build_annotations_2 (start
, end
,
4997 coding
.pre_write_conversion
, annotations
);
4998 if (current_buffer
!= given_buffer
)
5000 XSETFASTINT (start
, BEGV
);
5001 XSETFASTINT (end
, ZV
);
5005 #ifdef CLASH_DETECTION
5008 #if 0 /* This causes trouble for GNUS. */
5009 /* If we've locked this file for some other buffer,
5010 query before proceeding. */
5011 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5012 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5015 lock_file (lockname
);
5017 #endif /* CLASH_DETECTION */
5019 encoded_filename
= ENCODE_FILE (filename
);
5021 fn
= SDATA (encoded_filename
);
5025 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5026 #else /* not DOS_NT */
5027 desc
= emacs_open (fn
, O_WRONLY
, 0);
5028 #endif /* not DOS_NT */
5030 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5032 if (auto_saving
) /* Overwrite any previous version of autosave file */
5034 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5035 desc
= emacs_open (fn
, O_RDWR
, 0);
5037 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5038 ? SDATA (current_buffer
->filename
) : 0,
5041 else /* Write to temporary name and rename if no errors */
5043 Lisp_Object temp_name
;
5044 temp_name
= Ffile_name_directory (filename
);
5046 if (!NILP (temp_name
))
5048 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5049 build_string ("$$SAVE$$")));
5050 fname
= SDATA (filename
);
5051 fn
= SDATA (temp_name
);
5052 desc
= creat_copy_attrs (fname
, fn
);
5055 /* If we can't open the temporary file, try creating a new
5056 version of the original file. VMS "creat" creates a
5057 new version rather than truncating an existing file. */
5060 desc
= creat (fn
, 0666);
5061 #if 0 /* This can clobber an existing file and fail to replace it,
5062 if the user runs out of space. */
5065 /* We can't make a new version;
5066 try to truncate and rewrite existing version if any. */
5068 desc
= emacs_open (fn
, O_RDWR
, 0);
5074 desc
= creat (fn
, 0666);
5078 desc
= emacs_open (fn
,
5079 O_WRONLY
| O_CREAT
| buffer_file_type
5080 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5081 S_IREAD
| S_IWRITE
);
5082 #else /* not DOS_NT */
5083 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5084 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5085 auto_saving
? auto_save_mode_bits
: 0666);
5086 #endif /* not DOS_NT */
5087 #endif /* not VMS */
5091 #ifdef CLASH_DETECTION
5093 if (!auto_saving
) unlock_file (lockname
);
5095 #endif /* CLASH_DETECTION */
5097 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5100 record_unwind_protect (close_file_unwind
, make_number (desc
));
5102 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5106 if (NUMBERP (append
))
5107 ret
= lseek (desc
, XINT (append
), 1);
5109 ret
= lseek (desc
, 0, 2);
5112 #ifdef CLASH_DETECTION
5113 if (!auto_saving
) unlock_file (lockname
);
5114 #endif /* CLASH_DETECTION */
5116 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5124 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5125 * if we do writes that don't end with a carriage return. Furthermore
5126 * it cannot handle writes of more then 16K. The modified
5127 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5128 * this EXCEPT for the last record (iff it doesn't end with a carriage
5129 * return). This implies that if your buffer doesn't end with a carriage
5130 * return, you get one free... tough. However it also means that if
5131 * we make two calls to sys_write (a la the following code) you can
5132 * get one at the gap as well. The easiest way to fix this (honest)
5133 * is to move the gap to the next newline (or the end of the buffer).
5138 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5139 move_gap (find_next_newline (GPT
, 1));
5141 /* Whether VMS or not, we must move the gap to the next of newline
5142 when we must put designation sequences at beginning of line. */
5143 if (INTEGERP (start
)
5144 && coding
.type
== coding_type_iso2022
5145 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5146 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5148 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5149 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5150 move_gap_both (PT
, PT_BYTE
);
5151 SET_PT_BOTH (opoint
, opoint_byte
);
5158 if (STRINGP (start
))
5160 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5161 &annotations
, &coding
);
5164 else if (XINT (start
) != XINT (end
))
5166 tem
= CHAR_TO_BYTE (XINT (start
));
5168 if (XINT (start
) < GPT
)
5170 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5171 min (GPT
, XINT (end
)) - XINT (start
),
5172 &annotations
, &coding
);
5176 if (XINT (end
) > GPT
&& !failure
)
5178 tem
= max (XINT (start
), GPT
);
5179 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5180 &annotations
, &coding
);
5186 /* If file was empty, still need to write the annotations */
5187 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5188 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5192 if (CODING_REQUIRE_FLUSHING (&coding
)
5193 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5196 /* We have to flush out a data. */
5197 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5198 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5205 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5206 Disk full in NFS may be reported here. */
5207 /* mib says that closing the file will try to write as fast as NFS can do
5208 it, and that means the fsync here is not crucial for autosave files. */
5209 if (!auto_saving
&& fsync (desc
) < 0)
5211 /* If fsync fails with EINTR, don't treat that as serious. */
5213 failure
= 1, save_errno
= errno
;
5217 /* Spurious "file has changed on disk" warnings have been
5218 observed on Suns as well.
5219 It seems that `close' can change the modtime, under nfs.
5221 (This has supposedly been fixed in Sunos 4,
5222 but who knows about all the other machines with NFS?) */
5225 /* On VMS and APOLLO, must do the stat after the close
5226 since closing changes the modtime. */
5229 /* Recall that #if defined does not work on VMS. */
5236 /* NFS can report a write failure now. */
5237 if (emacs_close (desc
) < 0)
5238 failure
= 1, save_errno
= errno
;
5241 /* If we wrote to a temporary name and had no errors, rename to real name. */
5245 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5253 /* Discard the unwind protect for close_file_unwind. */
5254 specpdl_ptr
= specpdl
+ count1
;
5255 /* Restore the original current buffer. */
5256 visit_file
= unbind_to (count
, visit_file
);
5258 #ifdef CLASH_DETECTION
5260 unlock_file (lockname
);
5261 #endif /* CLASH_DETECTION */
5263 /* Do this before reporting IO error
5264 to avoid a "file has changed on disk" warning on
5265 next attempt to save. */
5267 current_buffer
->modtime
= st
.st_mtime
;
5270 error ("IO error writing %s: %s", SDATA (filename
),
5271 emacs_strerror (save_errno
));
5275 SAVE_MODIFF
= MODIFF
;
5276 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5277 current_buffer
->filename
= visit_file
;
5278 update_mode_lines
++;
5283 && ! NILP (Fstring_equal (current_buffer
->filename
,
5284 current_buffer
->auto_save_file_name
)))
5285 SAVE_MODIFF
= MODIFF
;
5291 message_with_string ((INTEGERP (append
)
5301 Lisp_Object
merge ();
5303 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5304 doc
: /* Return t if (car A) is numerically less than (car B). */)
5308 return Flss (Fcar (a
), Fcar (b
));
5311 /* Build the complete list of annotations appropriate for writing out
5312 the text between START and END, by calling all the functions in
5313 write-region-annotate-functions and merging the lists they return.
5314 If one of these functions switches to a different buffer, we assume
5315 that buffer contains altered text. Therefore, the caller must
5316 make sure to restore the current buffer in all cases,
5317 as save-excursion would do. */
5320 build_annotations (start
, end
)
5321 Lisp_Object start
, end
;
5323 Lisp_Object annotations
;
5325 struct gcpro gcpro1
, gcpro2
;
5326 Lisp_Object original_buffer
;
5327 int i
, used_global
= 0;
5329 XSETBUFFER (original_buffer
, current_buffer
);
5332 p
= Vwrite_region_annotate_functions
;
5333 GCPRO2 (annotations
, p
);
5336 struct buffer
*given_buffer
= current_buffer
;
5337 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5338 { /* Use the global value of the hook. */
5341 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5343 p
= Fappend (2, arg
);
5346 Vwrite_region_annotations_so_far
= annotations
;
5347 res
= call2 (XCAR (p
), start
, end
);
5348 /* If the function makes a different buffer current,
5349 assume that means this buffer contains altered text to be output.
5350 Reset START and END from the buffer bounds
5351 and discard all previous annotations because they should have
5352 been dealt with by this function. */
5353 if (current_buffer
!= given_buffer
)
5355 XSETFASTINT (start
, BEGV
);
5356 XSETFASTINT (end
, ZV
);
5359 Flength (res
); /* Check basic validity of return value */
5360 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5364 /* Now do the same for annotation functions implied by the file-format */
5365 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5366 p
= Vauto_save_file_format
;
5368 p
= current_buffer
->file_format
;
5369 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5371 struct buffer
*given_buffer
= current_buffer
;
5373 Vwrite_region_annotations_so_far
= annotations
;
5375 /* Value is either a list of annotations or nil if the function
5376 has written annotations to a temporary buffer, which is now
5378 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5379 original_buffer
, make_number (i
));
5380 if (current_buffer
!= given_buffer
)
5382 XSETFASTINT (start
, BEGV
);
5383 XSETFASTINT (end
, ZV
);
5388 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5396 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5397 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5399 struct gcpro gcpro1
;
5402 GCPRO1 (annotations
);
5403 /* At last, do the same for the function PRE_WRITE_CONVERSION
5404 implied by the current coding-system. */
5405 if (!NILP (pre_write_conversion
))
5407 struct buffer
*given_buffer
= current_buffer
;
5408 Vwrite_region_annotations_so_far
= annotations
;
5409 res
= call2 (pre_write_conversion
, start
, end
);
5411 annotations
= (current_buffer
!= given_buffer
5413 : merge (annotations
, res
, Qcar_less_than_car
));
5420 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5421 If STRING is nil, POS is the character position in the current buffer.
5422 Intersperse with them the annotations from *ANNOT
5423 which fall within the range of POS to POS + NCHARS,
5424 each at its appropriate position.
5426 We modify *ANNOT by discarding elements as we use them up.
5428 The return value is negative in case of system call failure. */
5431 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5434 register int nchars
;
5437 struct coding_system
*coding
;
5441 int lastpos
= pos
+ nchars
;
5443 while (NILP (*annot
) || CONSP (*annot
))
5445 tem
= Fcar_safe (Fcar (*annot
));
5448 nextpos
= XFASTINT (tem
);
5450 /* If there are no more annotations in this range,
5451 output the rest of the range all at once. */
5452 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5453 return e_write (desc
, string
, pos
, lastpos
, coding
);
5455 /* Output buffer text up to the next annotation's position. */
5458 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5462 /* Output the annotation. */
5463 tem
= Fcdr (Fcar (*annot
));
5466 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5469 *annot
= Fcdr (*annot
);
5474 #ifndef WRITE_BUF_SIZE
5475 #define WRITE_BUF_SIZE (16 * 1024)
5478 /* Write text in the range START and END into descriptor DESC,
5479 encoding them with coding system CODING. If STRING is nil, START
5480 and END are character positions of the current buffer, else they
5481 are indexes to the string STRING. */
5484 e_write (desc
, string
, start
, end
, coding
)
5488 struct coding_system
*coding
;
5490 register char *addr
;
5491 register int nbytes
;
5492 char buf
[WRITE_BUF_SIZE
];
5496 coding
->composing
= COMPOSITION_DISABLED
;
5497 if (coding
->composing
!= COMPOSITION_DISABLED
)
5498 coding_save_composition (coding
, start
, end
, string
);
5500 if (STRINGP (string
))
5502 addr
= SDATA (string
);
5503 nbytes
= SBYTES (string
);
5504 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5506 else if (start
< end
)
5508 /* It is assured that the gap is not in the range START and END-1. */
5509 addr
= CHAR_POS_ADDR (start
);
5510 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5511 coding
->src_multibyte
5512 = !NILP (current_buffer
->enable_multibyte_characters
);
5518 coding
->src_multibyte
= 1;
5521 /* We used to have a code for handling selective display here. But,
5522 now it is handled within encode_coding. */
5527 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5528 if (coding
->produced
> 0)
5530 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5531 if (coding
->produced
)
5537 nbytes
-= coding
->consumed
;
5538 addr
+= coding
->consumed
;
5539 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5542 /* The source text ends by an incomplete multibyte form.
5543 There's no way other than write it out as is. */
5544 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5553 start
+= coding
->consumed_char
;
5554 if (coding
->cmp_data
)
5555 coding_adjust_composition_offset (coding
, start
);
5558 if (coding
->cmp_data
)
5559 coding_free_composition_data (coding
);
5564 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5565 Sverify_visited_file_modtime
, 1, 1, 0,
5566 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5567 This means that the file has not been changed since it was visited or saved.
5568 See Info node `(elisp)Modification Time' for more details. */)
5574 Lisp_Object handler
;
5575 Lisp_Object filename
;
5580 if (!STRINGP (b
->filename
)) return Qt
;
5581 if (b
->modtime
== 0) return Qt
;
5583 /* If the file name has special constructs in it,
5584 call the corresponding file handler. */
5585 handler
= Ffind_file_name_handler (b
->filename
,
5586 Qverify_visited_file_modtime
);
5587 if (!NILP (handler
))
5588 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5590 filename
= ENCODE_FILE (b
->filename
);
5592 if (stat (SDATA (filename
), &st
) < 0)
5594 /* If the file doesn't exist now and didn't exist before,
5595 we say that it isn't modified, provided the error is a tame one. */
5596 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5601 if (st
.st_mtime
== b
->modtime
5602 /* If both are positive, accept them if they are off by one second. */
5603 || (st
.st_mtime
> 0 && b
->modtime
> 0
5604 && (st
.st_mtime
== b
->modtime
+ 1
5605 || st
.st_mtime
== b
->modtime
- 1)))
5610 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5611 Sclear_visited_file_modtime
, 0, 0, 0,
5612 doc
: /* Clear out records of last mod time of visited file.
5613 Next attempt to save will certainly not complain of a discrepancy. */)
5616 current_buffer
->modtime
= 0;
5620 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5621 Svisited_file_modtime
, 0, 0, 0,
5622 doc
: /* Return the current buffer's recorded visited file modification time.
5623 The value is a list of the form (HIGH . LOW), like the time values
5624 that `file-attributes' returns. If the current buffer has no recorded
5625 file modification time, this function returns 0.
5626 See Info node `(elisp)Modification Time' for more details. */)
5629 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5632 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5633 Sset_visited_file_modtime
, 0, 1, 0,
5634 doc
: /* Update buffer's recorded modification time from the visited file's time.
5635 Useful if the buffer was not read from the file normally
5636 or if the file itself has been changed for some known benign reason.
5637 An argument specifies the modification time value to use
5638 \(instead of that of the visited file), in the form of a list
5639 \(HIGH . LOW) or (HIGH LOW). */)
5641 Lisp_Object time_list
;
5643 if (!NILP (time_list
))
5644 current_buffer
->modtime
= cons_to_long (time_list
);
5647 register Lisp_Object filename
;
5649 Lisp_Object handler
;
5651 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5653 /* If the file name has special constructs in it,
5654 call the corresponding file handler. */
5655 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5656 if (!NILP (handler
))
5657 /* The handler can find the file name the same way we did. */
5658 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5660 filename
= ENCODE_FILE (filename
);
5662 if (stat (SDATA (filename
), &st
) >= 0)
5663 current_buffer
->modtime
= st
.st_mtime
;
5670 auto_save_error (error
)
5673 Lisp_Object args
[3], msg
;
5675 struct gcpro gcpro1
;
5677 ring_bell (XFRAME (selected_frame
));
5679 args
[0] = build_string ("Auto-saving %s: %s");
5680 args
[1] = current_buffer
->name
;
5681 args
[2] = Ferror_message_string (error
);
5682 msg
= Fformat (3, args
);
5684 nbytes
= SBYTES (msg
);
5686 for (i
= 0; i
< 3; ++i
)
5689 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5691 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5692 Fsleep_for (make_number (1), Qnil
);
5704 /* Get visited file's mode to become the auto save file's mode. */
5705 if (! NILP (current_buffer
->filename
)
5706 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5707 /* But make sure we can overwrite it later! */
5708 auto_save_mode_bits
= st
.st_mode
| 0600;
5710 auto_save_mode_bits
= 0666;
5713 Fwrite_region (Qnil
, Qnil
,
5714 current_buffer
->auto_save_file_name
,
5715 Qnil
, Qlambda
, Qnil
, Qnil
);
5719 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5724 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5725 | XFASTINT (XCDR (stream
))));
5730 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5733 minibuffer_auto_raise
= XINT (value
);
5738 do_auto_save_make_dir (dir
)
5741 return call2 (Qmake_directory
, dir
, Qt
);
5745 do_auto_save_eh (ignore
)
5751 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5752 doc
: /* Auto-save all buffers that need it.
5753 This is all buffers that have auto-saving enabled
5754 and are changed since last auto-saved.
5755 Auto-saving writes the buffer into a file
5756 so that your editing is not lost if the system crashes.
5757 This file is not the file you visited; that changes only when you save.
5758 Normally we run the normal hook `auto-save-hook' before saving.
5760 A non-nil NO-MESSAGE argument means do not print any message if successful.
5761 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5762 (no_message
, current_only
)
5763 Lisp_Object no_message
, current_only
;
5765 struct buffer
*old
= current_buffer
, *b
;
5766 Lisp_Object tail
, buf
;
5768 int do_handled_files
;
5771 Lisp_Object lispstream
;
5772 int count
= SPECPDL_INDEX ();
5773 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5774 int old_message_p
= 0;
5775 struct gcpro gcpro1
, gcpro2
;
5777 if (max_specpdl_size
< specpdl_size
+ 40)
5778 max_specpdl_size
= specpdl_size
+ 40;
5783 if (NILP (no_message
))
5785 old_message_p
= push_message ();
5786 record_unwind_protect (pop_message_unwind
, Qnil
);
5789 /* Ordinarily don't quit within this function,
5790 but don't make it impossible to quit (in case we get hung in I/O). */
5794 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5795 point to non-strings reached from Vbuffer_alist. */
5797 if (!NILP (Vrun_hooks
))
5798 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5800 if (STRINGP (Vauto_save_list_file_name
))
5802 Lisp_Object listfile
;
5804 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5806 /* Don't try to create the directory when shutting down Emacs,
5807 because creating the directory might signal an error, and
5808 that would leave Emacs in a strange state. */
5809 if (!NILP (Vrun_hooks
))
5813 GCPRO2 (dir
, listfile
);
5814 dir
= Ffile_name_directory (listfile
);
5815 if (NILP (Ffile_directory_p (dir
)))
5816 internal_condition_case_1 (do_auto_save_make_dir
,
5817 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5822 stream
= fopen (SDATA (listfile
), "w");
5825 /* Arrange to close that file whether or not we get an error.
5826 Also reset auto_saving to 0. */
5827 lispstream
= Fcons (Qnil
, Qnil
);
5828 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5829 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5840 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5841 record_unwind_protect (do_auto_save_unwind_1
,
5842 make_number (minibuffer_auto_raise
));
5843 minibuffer_auto_raise
= 0;
5846 /* On first pass, save all files that don't have handlers.
5847 On second pass, save all files that do have handlers.
5849 If Emacs is crashing, the handlers may tweak what is causing
5850 Emacs to crash in the first place, and it would be a shame if
5851 Emacs failed to autosave perfectly ordinary files because it
5852 couldn't handle some ange-ftp'd file. */
5854 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5855 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5857 buf
= XCDR (XCAR (tail
));
5860 /* Record all the buffers that have auto save mode
5861 in the special file that lists them. For each of these buffers,
5862 Record visited name (if any) and auto save name. */
5863 if (STRINGP (b
->auto_save_file_name
)
5864 && stream
!= NULL
&& do_handled_files
== 0)
5866 if (!NILP (b
->filename
))
5868 fwrite (SDATA (b
->filename
), 1,
5869 SBYTES (b
->filename
), stream
);
5871 putc ('\n', stream
);
5872 fwrite (SDATA (b
->auto_save_file_name
), 1,
5873 SBYTES (b
->auto_save_file_name
), stream
);
5874 putc ('\n', stream
);
5877 if (!NILP (current_only
)
5878 && b
!= current_buffer
)
5881 /* Don't auto-save indirect buffers.
5882 The base buffer takes care of it. */
5886 /* Check for auto save enabled
5887 and file changed since last auto save
5888 and file changed since last real save. */
5889 if (STRINGP (b
->auto_save_file_name
)
5890 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5891 && b
->auto_save_modified
< BUF_MODIFF (b
)
5892 /* -1 means we've turned off autosaving for a while--see below. */
5893 && XINT (b
->save_length
) >= 0
5894 && (do_handled_files
5895 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5898 EMACS_TIME before_time
, after_time
;
5900 EMACS_GET_TIME (before_time
);
5902 /* If we had a failure, don't try again for 20 minutes. */
5903 if (b
->auto_save_failure_time
>= 0
5904 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5907 if ((XFASTINT (b
->save_length
) * 10
5908 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5909 /* A short file is likely to change a large fraction;
5910 spare the user annoying messages. */
5911 && XFASTINT (b
->save_length
) > 5000
5912 /* These messages are frequent and annoying for `*mail*'. */
5913 && !EQ (b
->filename
, Qnil
)
5914 && NILP (no_message
))
5916 /* It has shrunk too much; turn off auto-saving here. */
5917 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5918 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5920 minibuffer_auto_raise
= 0;
5921 /* Turn off auto-saving until there's a real save,
5922 and prevent any more warnings. */
5923 XSETINT (b
->save_length
, -1);
5924 Fsleep_for (make_number (1), Qnil
);
5927 set_buffer_internal (b
);
5928 if (!auto_saved
&& NILP (no_message
))
5929 message1 ("Auto-saving...");
5930 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5932 b
->auto_save_modified
= BUF_MODIFF (b
);
5933 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5934 set_buffer_internal (old
);
5936 EMACS_GET_TIME (after_time
);
5938 /* If auto-save took more than 60 seconds,
5939 assume it was an NFS failure that got a timeout. */
5940 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5941 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5945 /* Prevent another auto save till enough input events come in. */
5946 record_auto_save ();
5948 if (auto_saved
&& NILP (no_message
))
5952 /* If we are going to restore an old message,
5953 give time to read ours. */
5954 sit_for (1, 0, 0, 0, 0);
5958 /* If we displayed a message and then restored a state
5959 with no message, leave a "done" message on the screen. */
5960 message1 ("Auto-saving...done");
5965 /* This restores the message-stack status. */
5966 unbind_to (count
, Qnil
);
5970 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5971 Sset_buffer_auto_saved
, 0, 0, 0,
5972 doc
: /* Mark current buffer as auto-saved with its current text.
5973 No auto-save file will be written until the buffer changes again. */)
5976 current_buffer
->auto_save_modified
= MODIFF
;
5977 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5978 current_buffer
->auto_save_failure_time
= -1;
5982 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5983 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5984 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5987 current_buffer
->auto_save_failure_time
= -1;
5991 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5993 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
5996 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5999 /* Reading and completing file names */
6000 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6002 /* In the string VAL, change each $ to $$ and return the result. */
6005 double_dollars (val
)
6008 register const unsigned char *old
;
6009 register unsigned char *new;
6013 osize
= SBYTES (val
);
6015 /* Count the number of $ characters. */
6016 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6017 if (*old
++ == '$') count
++;
6021 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6024 for (n
= osize
; n
> 0; n
--)
6038 read_file_name_cleanup (arg
)
6041 return (current_buffer
->directory
= arg
);
6044 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6046 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6047 (string
, dir
, action
)
6048 Lisp_Object string
, dir
, action
;
6049 /* action is nil for complete, t for return list of completions,
6050 lambda for verify final value */
6052 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6054 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6056 CHECK_STRING (string
);
6063 /* No need to protect ACTION--we only compare it with t and nil. */
6064 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6066 if (SCHARS (string
) == 0)
6068 if (EQ (action
, Qlambda
))
6076 orig_string
= string
;
6077 string
= Fsubstitute_in_file_name (string
);
6078 changed
= NILP (Fstring_equal (string
, orig_string
));
6079 name
= Ffile_name_nondirectory (string
);
6080 val
= Ffile_name_directory (string
);
6082 realdir
= Fexpand_file_name (val
, realdir
);
6087 specdir
= Ffile_name_directory (string
);
6088 val
= Ffile_name_completion (name
, realdir
);
6093 return double_dollars (string
);
6097 if (!NILP (specdir
))
6098 val
= concat2 (specdir
, val
);
6100 return double_dollars (val
);
6103 #endif /* not VMS */
6107 if (EQ (action
, Qt
))
6109 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6113 if (NILP (Vread_file_name_predicate
)
6114 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6118 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6120 /* Brute-force speed up for directory checking:
6121 Discard strings which don't end in a slash. */
6122 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6124 Lisp_Object tem
= XCAR (all
);
6126 if (STRINGP (tem
) &&
6127 (len
= SCHARS (tem
), len
> 0) &&
6128 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6129 comp
= Fcons (tem
, comp
);
6135 /* Must do it the hard (and slow) way. */
6136 GCPRO3 (all
, comp
, specdir
);
6137 count
= SPECPDL_INDEX ();
6138 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6139 current_buffer
->directory
= realdir
;
6140 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6141 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6142 comp
= Fcons (XCAR (all
), comp
);
6143 unbind_to (count
, Qnil
);
6146 return Fnreverse (comp
);
6149 /* Only other case actually used is ACTION = lambda */
6151 /* Supposedly this helps commands such as `cd' that read directory names,
6152 but can someone explain how it helps them? -- RMS */
6153 if (SCHARS (name
) == 0)
6156 string
= Fexpand_file_name (string
, dir
);
6157 if (!NILP (Vread_file_name_predicate
))
6158 return call1 (Vread_file_name_predicate
, string
);
6159 return Ffile_exists_p (string
);
6162 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6163 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6164 Value is not expanded---you must call `expand-file-name' yourself.
6165 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6166 the same non-empty string that was inserted by this function.
6167 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6168 except that if INITIAL is specified, that combined with DIR is used.)
6169 If the user exits with an empty minibuffer, this function returns
6170 an empty string. (This can only happen if the user erased the
6171 pre-inserted contents or if `insert-default-directory' is nil.)
6172 Fourth arg MUSTMATCH non-nil means require existing file's name.
6173 Non-nil and non-t means also require confirmation after completion.
6174 Fifth arg INITIAL specifies text to start with.
6175 If optional sixth arg PREDICATE is non-nil, possible completions and
6176 the resulting file name must satisfy (funcall PREDICATE NAME).
6177 DIR should be an absolute directory name. It defaults to the value of
6178 `default-directory'.
6180 If this command was invoked with the mouse, use a file dialog box if
6181 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6182 provides a file dialog box. */)
6183 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6184 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6186 Lisp_Object val
, insdef
, tem
;
6187 struct gcpro gcpro1
, gcpro2
;
6188 register char *homedir
;
6189 Lisp_Object decoded_homedir
;
6190 int replace_in_history
= 0;
6191 int add_to_history
= 0;
6195 dir
= current_buffer
->directory
;
6196 if (NILP (default_filename
))
6197 default_filename
= !NILP (initial
)
6198 ? Fexpand_file_name (initial
, dir
)
6199 : current_buffer
->filename
;
6201 /* If dir starts with user's homedir, change that to ~. */
6202 homedir
= (char *) egetenv ("HOME");
6204 /* homedir can be NULL in temacs, since Vprocess_environment is not
6205 yet set up. We shouldn't crash in that case. */
6208 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6209 CORRECT_DIR_SEPS (homedir
);
6214 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6217 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6218 SBYTES (decoded_homedir
))
6219 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6221 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6222 dir
= concat2 (build_string ("~"), dir
);
6224 /* Likewise for default_filename. */
6226 && STRINGP (default_filename
)
6227 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6228 SBYTES (decoded_homedir
))
6229 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6232 = Fsubstring (default_filename
,
6233 make_number (SCHARS (decoded_homedir
)), Qnil
);
6234 default_filename
= concat2 (build_string ("~"), default_filename
);
6236 if (!NILP (default_filename
))
6238 CHECK_STRING (default_filename
);
6239 default_filename
= double_dollars (default_filename
);
6242 if (insert_default_directory
&& STRINGP (dir
))
6245 if (!NILP (initial
))
6247 Lisp_Object args
[2], pos
;
6251 insdef
= Fconcat (2, args
);
6252 pos
= make_number (SCHARS (double_dollars (dir
)));
6253 insdef
= Fcons (double_dollars (insdef
), pos
);
6256 insdef
= double_dollars (insdef
);
6258 else if (STRINGP (initial
))
6259 insdef
= Fcons (double_dollars (initial
), make_number (0));
6263 if (!NILP (Vread_file_name_function
))
6265 Lisp_Object args
[7];
6267 GCPRO2 (insdef
, default_filename
);
6268 args
[0] = Vread_file_name_function
;
6271 args
[3] = default_filename
;
6272 args
[4] = mustmatch
;
6274 args
[6] = predicate
;
6275 RETURN_UNGCPRO (Ffuncall (7, args
));
6278 count
= SPECPDL_INDEX ();
6279 #if defined VMS || defined DOS_NT || defined MAC_OSX
6280 specbind (intern ("completion-ignore-case"), Qt
);
6283 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6284 specbind (intern ("read-file-name-predicate"),
6285 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6287 GCPRO2 (insdef
, default_filename
);
6289 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
6290 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6295 /* If DIR contains a file name, split it. */
6297 file
= Ffile_name_nondirectory (dir
);
6298 if (SCHARS (file
) && NILP (default_filename
))
6300 default_filename
= file
;
6301 dir
= Ffile_name_directory (dir
);
6303 if (!NILP(default_filename
))
6304 default_filename
= Fexpand_file_name (default_filename
, dir
);
6305 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6310 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6311 dir
, mustmatch
, insdef
,
6312 Qfile_name_history
, default_filename
, Qnil
);
6314 tem
= Fsymbol_value (Qfile_name_history
);
6315 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6316 replace_in_history
= 1;
6318 /* If Fcompleting_read returned the inserted default string itself
6319 (rather than a new string with the same contents),
6320 it has to mean that the user typed RET with the minibuffer empty.
6321 In that case, we really want to return ""
6322 so that commands such as set-visited-file-name can distinguish. */
6323 if (EQ (val
, default_filename
))
6325 /* In this case, Fcompleting_read has not added an element
6326 to the history. Maybe we should. */
6327 if (! replace_in_history
)
6333 unbind_to (count
, Qnil
);
6336 error ("No file name specified");
6338 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6340 if (!NILP (tem
) && !NILP (default_filename
))
6341 val
= default_filename
;
6342 val
= Fsubstitute_in_file_name (val
);
6344 if (replace_in_history
)
6345 /* Replace what Fcompleting_read added to the history
6346 with what we will actually return. */
6347 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6348 else if (add_to_history
)
6350 /* Add the value to the history--but not if it matches
6351 the last value already there. */
6352 Lisp_Object val1
= double_dollars (val
);
6353 tem
= Fsymbol_value (Qfile_name_history
);
6354 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6355 Fset (Qfile_name_history
,
6366 /* Must be set before any path manipulation is performed. */
6367 XSETFASTINT (Vdirectory_sep_char
, '/');
6374 Qexpand_file_name
= intern ("expand-file-name");
6375 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6376 Qdirectory_file_name
= intern ("directory-file-name");
6377 Qfile_name_directory
= intern ("file-name-directory");
6378 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6379 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6380 Qfile_name_as_directory
= intern ("file-name-as-directory");
6381 Qcopy_file
= intern ("copy-file");
6382 Qmake_directory_internal
= intern ("make-directory-internal");
6383 Qmake_directory
= intern ("make-directory");
6384 Qdelete_directory
= intern ("delete-directory");
6385 Qdelete_file
= intern ("delete-file");
6386 Qrename_file
= intern ("rename-file");
6387 Qadd_name_to_file
= intern ("add-name-to-file");
6388 Qmake_symbolic_link
= intern ("make-symbolic-link");
6389 Qfile_exists_p
= intern ("file-exists-p");
6390 Qfile_executable_p
= intern ("file-executable-p");
6391 Qfile_readable_p
= intern ("file-readable-p");
6392 Qfile_writable_p
= intern ("file-writable-p");
6393 Qfile_symlink_p
= intern ("file-symlink-p");
6394 Qaccess_file
= intern ("access-file");
6395 Qfile_directory_p
= intern ("file-directory-p");
6396 Qfile_regular_p
= intern ("file-regular-p");
6397 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6398 Qfile_modes
= intern ("file-modes");
6399 Qset_file_modes
= intern ("set-file-modes");
6400 Qset_file_times
= intern ("set-file-times");
6401 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6402 Qinsert_file_contents
= intern ("insert-file-contents");
6403 Qwrite_region
= intern ("write-region");
6404 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6405 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6406 Qauto_save_coding
= intern ("auto-save-coding");
6408 staticpro (&Qexpand_file_name
);
6409 staticpro (&Qsubstitute_in_file_name
);
6410 staticpro (&Qdirectory_file_name
);
6411 staticpro (&Qfile_name_directory
);
6412 staticpro (&Qfile_name_nondirectory
);
6413 staticpro (&Qunhandled_file_name_directory
);
6414 staticpro (&Qfile_name_as_directory
);
6415 staticpro (&Qcopy_file
);
6416 staticpro (&Qmake_directory_internal
);
6417 staticpro (&Qmake_directory
);
6418 staticpro (&Qdelete_directory
);
6419 staticpro (&Qdelete_file
);
6420 staticpro (&Qrename_file
);
6421 staticpro (&Qadd_name_to_file
);
6422 staticpro (&Qmake_symbolic_link
);
6423 staticpro (&Qfile_exists_p
);
6424 staticpro (&Qfile_executable_p
);
6425 staticpro (&Qfile_readable_p
);
6426 staticpro (&Qfile_writable_p
);
6427 staticpro (&Qaccess_file
);
6428 staticpro (&Qfile_symlink_p
);
6429 staticpro (&Qfile_directory_p
);
6430 staticpro (&Qfile_regular_p
);
6431 staticpro (&Qfile_accessible_directory_p
);
6432 staticpro (&Qfile_modes
);
6433 staticpro (&Qset_file_modes
);
6434 staticpro (&Qset_file_times
);
6435 staticpro (&Qfile_newer_than_file_p
);
6436 staticpro (&Qinsert_file_contents
);
6437 staticpro (&Qwrite_region
);
6438 staticpro (&Qverify_visited_file_modtime
);
6439 staticpro (&Qset_visited_file_modtime
);
6440 staticpro (&Qauto_save_coding
);
6442 Qfile_name_history
= intern ("file-name-history");
6443 Fset (Qfile_name_history
, Qnil
);
6444 staticpro (&Qfile_name_history
);
6446 Qfile_error
= intern ("file-error");
6447 staticpro (&Qfile_error
);
6448 Qfile_already_exists
= intern ("file-already-exists");
6449 staticpro (&Qfile_already_exists
);
6450 Qfile_date_error
= intern ("file-date-error");
6451 staticpro (&Qfile_date_error
);
6452 Qexcl
= intern ("excl");
6456 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6457 staticpro (&Qfind_buffer_file_type
);
6460 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6461 doc
: /* *Coding system for encoding file names.
6462 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6463 Vfile_name_coding_system
= Qnil
;
6465 DEFVAR_LISP ("default-file-name-coding-system",
6466 &Vdefault_file_name_coding_system
,
6467 doc
: /* Default coding system for encoding file names.
6468 This variable is used only when `file-name-coding-system' is nil.
6470 This variable is set/changed by the command `set-language-environment'.
6471 User should not set this variable manually,
6472 instead use `file-name-coding-system' to get a constant encoding
6473 of file names regardless of the current language environment. */);
6474 Vdefault_file_name_coding_system
= Qnil
;
6476 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6477 doc
: /* *Format in which to write auto-save files.
6478 Should be a list of symbols naming formats that are defined in `format-alist'.
6479 If it is t, which is the default, auto-save files are written in the
6480 same format as a regular save would use. */);
6481 Vauto_save_file_format
= Qt
;
6483 Qformat_decode
= intern ("format-decode");
6484 staticpro (&Qformat_decode
);
6485 Qformat_annotate_function
= intern ("format-annotate-function");
6486 staticpro (&Qformat_annotate_function
);
6487 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6488 staticpro (&Qafter_insert_file_set_coding
);
6490 Qcar_less_than_car
= intern ("car-less-than-car");
6491 staticpro (&Qcar_less_than_car
);
6493 Fput (Qfile_error
, Qerror_conditions
,
6494 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6495 Fput (Qfile_error
, Qerror_message
,
6496 build_string ("File error"));
6498 Fput (Qfile_already_exists
, Qerror_conditions
,
6499 Fcons (Qfile_already_exists
,
6500 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6501 Fput (Qfile_already_exists
, Qerror_message
,
6502 build_string ("File already exists"));
6504 Fput (Qfile_date_error
, Qerror_conditions
,
6505 Fcons (Qfile_date_error
,
6506 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6507 Fput (Qfile_date_error
, Qerror_message
,
6508 build_string ("Cannot set file date"));
6510 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6511 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6512 Vread_file_name_function
= Qnil
;
6514 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6515 doc
: /* Current predicate used by `read-file-name-internal'. */);
6516 Vread_file_name_predicate
= Qnil
;
6518 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6519 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6520 If the initial minibuffer contents are non-empty, you can usually
6521 request a default filename by typing RETURN without editing. For some
6522 commands, exiting with an empty minibuffer has a special meaning,
6523 such as making the current buffer visit no file in the case of
6524 `set-visited-file-name'.
6525 If this variable is non-nil, the minibuffer contents are always
6526 initially non-empty and typing RETURN without editing will fetch the
6527 default name, if one is provided. Note however that this default name
6528 is not necessarily the name originally inserted in the minibuffer, if
6529 that is just the default directory.
6530 If this variable is nil, the minibuffer often starts out empty. In
6531 that case you may have to explicitly fetch the next history element to
6532 request the default name. */);
6533 insert_default_directory
= 1;
6535 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6536 doc
: /* *Non-nil means write new files with record format `stmlf'.
6537 nil means use format `var'. This variable is meaningful only on VMS. */);
6538 vms_stmlf_recfm
= 0;
6540 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6541 doc
: /* Directory separator character for built-in functions that return file names.
6542 The value is always ?/. Don't use this variable, just use `/'. */);
6544 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6545 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6546 If a file name matches REGEXP, then all I/O on that file is done by calling
6549 The first argument given to HANDLER is the name of the I/O primitive
6550 to be handled; the remaining arguments are the arguments that were
6551 passed to that primitive. For example, if you do
6552 (file-exists-p FILENAME)
6553 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6554 (funcall HANDLER 'file-exists-p FILENAME)
6555 The function `find-file-name-handler' checks this list for a handler
6556 for its argument. */);
6557 Vfile_name_handler_alist
= Qnil
;
6559 DEFVAR_LISP ("set-auto-coding-function",
6560 &Vset_auto_coding_function
,
6561 doc
: /* If non-nil, a function to call to decide a coding system of file.
6562 Two arguments are passed to this function: the file name
6563 and the length of a file contents following the point.
6564 This function should return a coding system to decode the file contents.
6565 It should check the file name against `auto-coding-alist'.
6566 If no coding system is decided, it should check a coding system
6567 specified in the heading lines with the format:
6568 -*- ... coding: CODING-SYSTEM; ... -*-
6569 or local variable spec of the tailing lines with `coding:' tag. */);
6570 Vset_auto_coding_function
= Qnil
;
6572 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6573 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6574 Each is passed one argument, the number of characters inserted.
6575 It should return the new character count, and leave point the same.
6576 If `insert-file-contents' is intercepted by a handler from
6577 `file-name-handler-alist', that handler is responsible for calling the
6578 functions in `after-insert-file-functions' if appropriate. */);
6579 Vafter_insert_file_functions
= Qnil
;
6581 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6582 doc
: /* A list of functions to be called at the start of `write-region'.
6583 Each is passed two arguments, START and END as for `write-region'.
6584 These are usually two numbers but not always; see the documentation
6585 for `write-region'. The function should return a list of pairs
6586 of the form (POSITION . STRING), consisting of strings to be effectively
6587 inserted at the specified positions of the file being written (1 means to
6588 insert before the first byte written). The POSITIONs must be sorted into
6589 increasing order. If there are several functions in the list, the several
6590 lists are merged destructively. Alternatively, the function can return
6591 with a different buffer current; in that case it should pay attention
6592 to the annotations returned by previous functions and listed in
6593 `write-region-annotations-so-far'.*/);
6594 Vwrite_region_annotate_functions
= Qnil
;
6595 staticpro (&Qwrite_region_annotate_functions
);
6596 Qwrite_region_annotate_functions
6597 = intern ("write-region-annotate-functions");
6599 DEFVAR_LISP ("write-region-annotations-so-far",
6600 &Vwrite_region_annotations_so_far
,
6601 doc
: /* When an annotation function is called, this holds the previous annotations.
6602 These are the annotations made by other annotation functions
6603 that were already called. See also `write-region-annotate-functions'. */);
6604 Vwrite_region_annotations_so_far
= Qnil
;
6606 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6607 doc
: /* A list of file name handlers that temporarily should not be used.
6608 This applies only to the operation `inhibit-file-name-operation'. */);
6609 Vinhibit_file_name_handlers
= Qnil
;
6611 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6612 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6613 Vinhibit_file_name_operation
= Qnil
;
6615 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6616 doc
: /* File name in which we write a list of all auto save file names.
6617 This variable is initialized automatically from `auto-save-list-file-prefix'
6618 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6619 a non-nil value. */);
6620 Vauto_save_list_file_name
= Qnil
;
6622 defsubr (&Sfind_file_name_handler
);
6623 defsubr (&Sfile_name_directory
);
6624 defsubr (&Sfile_name_nondirectory
);
6625 defsubr (&Sunhandled_file_name_directory
);
6626 defsubr (&Sfile_name_as_directory
);
6627 defsubr (&Sdirectory_file_name
);
6628 defsubr (&Smake_temp_name
);
6629 defsubr (&Sexpand_file_name
);
6630 defsubr (&Ssubstitute_in_file_name
);
6631 defsubr (&Scopy_file
);
6632 defsubr (&Smake_directory_internal
);
6633 defsubr (&Sdelete_directory
);
6634 defsubr (&Sdelete_file
);
6635 defsubr (&Srename_file
);
6636 defsubr (&Sadd_name_to_file
);
6638 defsubr (&Smake_symbolic_link
);
6639 #endif /* S_IFLNK */
6641 defsubr (&Sdefine_logical_name
);
6644 defsubr (&Ssysnetunam
);
6645 #endif /* HPUX_NET */
6646 defsubr (&Sfile_name_absolute_p
);
6647 defsubr (&Sfile_exists_p
);
6648 defsubr (&Sfile_executable_p
);
6649 defsubr (&Sfile_readable_p
);
6650 defsubr (&Sfile_writable_p
);
6651 defsubr (&Saccess_file
);
6652 defsubr (&Sfile_symlink_p
);
6653 defsubr (&Sfile_directory_p
);
6654 defsubr (&Sfile_accessible_directory_p
);
6655 defsubr (&Sfile_regular_p
);
6656 defsubr (&Sfile_modes
);
6657 defsubr (&Sset_file_modes
);
6658 defsubr (&Sset_file_times
);
6659 defsubr (&Sset_default_file_modes
);
6660 defsubr (&Sdefault_file_modes
);
6661 defsubr (&Sfile_newer_than_file_p
);
6662 defsubr (&Sinsert_file_contents
);
6663 defsubr (&Swrite_region
);
6664 defsubr (&Scar_less_than_car
);
6665 defsubr (&Sverify_visited_file_modtime
);
6666 defsubr (&Sclear_visited_file_modtime
);
6667 defsubr (&Svisited_file_modtime
);
6668 defsubr (&Sset_visited_file_modtime
);
6669 defsubr (&Sdo_auto_save
);
6670 defsubr (&Sset_buffer_auto_saved
);
6671 defsubr (&Sclear_buffer_auto_save_failure
);
6672 defsubr (&Srecent_auto_save_p
);
6674 defsubr (&Sread_file_name_internal
);
6675 defsubr (&Sread_file_name
);
6678 defsubr (&Sunix_sync
);
6682 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6683 (do not change this comment) */