1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998,
3 1999, 2000, 2001, 2003, 2004 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 /* Lisp functions for translating file formats */
179 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
181 /* Function to be called to decide a coding system of a reading file. */
182 Lisp_Object Vset_auto_coding_function
;
184 /* Functions to be called to process text properties in inserted file. */
185 Lisp_Object Vafter_insert_file_functions
;
187 /* Lisp function for setting buffer-file-coding-system and the
188 multibyteness of the current buffer after inserting a file. */
189 Lisp_Object Qafter_insert_file_set_coding
;
191 /* Functions to be called to create text property annotations for file. */
192 Lisp_Object Vwrite_region_annotate_functions
;
193 Lisp_Object Qwrite_region_annotate_functions
;
195 /* During build_annotations, each time an annotation function is called,
196 this holds the annotations made by the previous functions. */
197 Lisp_Object Vwrite_region_annotations_so_far
;
199 /* File name in which we write a list of all our auto save files. */
200 Lisp_Object Vauto_save_list_file_name
;
202 /* Function to call to read a file name. */
203 Lisp_Object Vread_file_name_function
;
205 /* Current predicate used by read_file_name_internal. */
206 Lisp_Object Vread_file_name_predicate
;
208 /* Nonzero means completion ignores case when reading file name. */
209 int read_file_name_completion_ignore_case
;
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
= SBYTES (prefix
); clen
= SCHARS (prefix
);
924 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
925 if (!STRING_MULTIBYTE (prefix
))
926 STRING_SET_UNIBYTE (val
);
928 bcopy(SDATA (prefix
), data
, len
);
931 bcopy (pidbuf
, p
, pidlen
);
934 /* Here we try to minimize useless stat'ing when this function is
935 invoked many times successively with the same PREFIX. We achieve
936 this by initializing count to a random value, and incrementing it
939 We don't want make-temp-name to be called while dumping,
940 because then make_temp_name_count_initialized_p would get set
941 and then make_temp_name_count would not be set when Emacs starts. */
943 if (!make_temp_name_count_initialized_p
)
945 make_temp_name_count
= (unsigned) time (NULL
);
946 make_temp_name_count_initialized_p
= 1;
952 unsigned num
= make_temp_name_count
;
954 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
955 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
956 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
958 /* Poor man's congruential RN generator. Replace with
959 ++make_temp_name_count for debugging. */
960 make_temp_name_count
+= 25229;
961 make_temp_name_count
%= 225307;
963 if (stat (data
, &ignored
) < 0)
965 /* We want to return only if errno is ENOENT. */
969 /* The error here is dubious, but there is little else we
970 can do. The alternatives are to return nil, which is
971 as bad as (and in many cases worse than) throwing the
972 error, or to ignore the error, which will likely result
973 in looping through 225307 stat's, which is not only
974 dog-slow, but also useless since it will fallback to
975 the errow below, anyway. */
976 report_file_error ("Cannot create temporary name for prefix",
977 Fcons (prefix
, Qnil
));
982 error ("Cannot create temporary name for prefix `%s'",
988 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
989 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
990 The Emacs process number forms part of the result,
991 so there is no danger of generating a name being used by another process.
993 In addition, this function makes an attempt to choose a name
994 which has no existing file. To make this work,
995 PREFIX should be an absolute file name.
997 There is a race condition between calling `make-temp-name' and creating the
998 file which opens all kinds of security holes. For that reason, you should
999 probably use `make-temp-file' instead, except in three circumstances:
1001 * If you are creating the file in the user's home directory.
1002 * If you are creating a directory rather than an ordinary file.
1003 * If you are taking special precautions as `make-temp-file' does. */)
1007 return make_temp_name (prefix
, 0);
1012 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1013 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1014 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1015 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1016 the current buffer's value of default-directory is used.
1017 File name components that are `.' are removed, and
1018 so are file name components followed by `..', along with the `..' itself;
1019 note that these simplifications are done without checking the resulting
1020 file names in the file system.
1021 An initial `~/' expands to your home directory.
1022 An initial `~USER/' expands to USER's home directory.
1023 See also the function `substitute-in-file-name'. */)
1024 (name
, default_directory
)
1025 Lisp_Object name
, default_directory
;
1029 register unsigned char *newdir
, *p
, *o
;
1031 unsigned char *target
;
1034 unsigned char * colon
= 0;
1035 unsigned char * close
= 0;
1036 unsigned char * slash
= 0;
1037 unsigned char * brack
= 0;
1038 int lbrack
= 0, rbrack
= 0;
1043 int collapse_newdir
= 1;
1047 Lisp_Object handler
, result
;
1049 CHECK_STRING (name
);
1051 /* If the file name has special constructs in it,
1052 call the corresponding file handler. */
1053 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1054 if (!NILP (handler
))
1055 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1057 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1058 if (NILP (default_directory
))
1059 default_directory
= current_buffer
->directory
;
1060 if (! STRINGP (default_directory
))
1063 /* "/" is not considered a root directory on DOS_NT, so using "/"
1064 here causes an infinite recursion in, e.g., the following:
1066 (let (default-directory)
1067 (expand-file-name "a"))
1069 To avoid this, we set default_directory to the root of the
1071 extern char *emacs_root_dir (void);
1073 default_directory
= build_string (emacs_root_dir ());
1075 default_directory
= build_string ("/");
1079 if (!NILP (default_directory
))
1081 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1082 if (!NILP (handler
))
1083 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1086 o
= SDATA (default_directory
);
1088 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1089 It would be better to do this down below where we actually use
1090 default_directory. Unfortunately, calling Fexpand_file_name recursively
1091 could invoke GC, and the strings might be relocated. This would
1092 be annoying because we have pointers into strings lying around
1093 that would need adjusting, and people would add new pointers to
1094 the code and forget to adjust them, resulting in intermittent bugs.
1095 Putting this call here avoids all that crud.
1097 The EQ test avoids infinite recursion. */
1098 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1099 /* Save time in some common cases - as long as default_directory
1100 is not relative, it can be canonicalized with name below (if it
1101 is needed at all) without requiring it to be expanded now. */
1103 /* Detect MSDOS file names with drive specifiers. */
1104 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1106 /* Detect Windows file names in UNC format. */
1107 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1109 #else /* not DOS_NT */
1110 /* Detect Unix absolute file names (/... alone is not absolute on
1112 && ! (IS_DIRECTORY_SEP (o
[0]))
1113 #endif /* not DOS_NT */
1116 struct gcpro gcpro1
;
1119 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1124 /* Filenames on VMS are always upper case. */
1125 name
= Fupcase (name
);
1127 #ifdef FILE_SYSTEM_CASE
1128 name
= FILE_SYSTEM_CASE (name
);
1134 /* We will force directory separators to be either all \ or /, so make
1135 a local copy to modify, even if there ends up being no change. */
1136 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1138 /* Note if special escape prefix is present, but remove for now. */
1139 if (nm
[0] == '/' && nm
[1] == ':')
1145 /* Find and remove drive specifier if present; this makes nm absolute
1146 even if the rest of the name appears to be relative. Only look for
1147 drive specifier at the beginning. */
1148 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1155 /* If we see "c://somedir", we want to strip the first slash after the
1156 colon when stripping the drive letter. Otherwise, this expands to
1158 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1160 #endif /* WINDOWSNT */
1164 /* Discard any previous drive specifier if nm is now in UNC format. */
1165 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1171 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1172 none are found, we can probably return right away. We will avoid
1173 allocating a new string if name is already fully expanded. */
1175 IS_DIRECTORY_SEP (nm
[0])
1177 && drive
&& !is_escaped
1180 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1187 /* If it turns out that the filename we want to return is just a
1188 suffix of FILENAME, we don't need to go through and edit
1189 things; we just need to construct a new string using data
1190 starting at the middle of FILENAME. If we set lose to a
1191 non-zero value, that means we've discovered that we can't do
1198 /* Since we know the name is absolute, we can assume that each
1199 element starts with a "/". */
1201 /* "." and ".." are hairy. */
1202 if (IS_DIRECTORY_SEP (p
[0])
1204 && (IS_DIRECTORY_SEP (p
[2])
1206 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1209 /* We want to replace multiple `/' in a row with a single
1212 && IS_DIRECTORY_SEP (p
[0])
1213 && IS_DIRECTORY_SEP (p
[1]))
1220 /* if dev:[dir]/, move nm to / */
1221 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1222 nm
= (brack
? brack
+ 1 : colon
+ 1);
1223 lbrack
= rbrack
= 0;
1231 /* VMS pre V4.4,convert '-'s in filenames. */
1232 if (lbrack
== rbrack
)
1234 if (dots
< 2) /* this is to allow negative version numbers */
1239 if (lbrack
> rbrack
&&
1240 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1241 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1247 /* count open brackets, reset close bracket pointer */
1248 if (p
[0] == '[' || p
[0] == '<')
1249 lbrack
++, brack
= 0;
1250 /* count close brackets, set close bracket pointer */
1251 if (p
[0] == ']' || p
[0] == '>')
1252 rbrack
++, brack
= p
;
1253 /* detect ][ or >< */
1254 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1256 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1257 nm
= p
+ 1, lose
= 1;
1258 if (p
[0] == ':' && (colon
|| slash
))
1259 /* if dev1:[dir]dev2:, move nm to dev2: */
1265 /* if /name/dev:, move nm to dev: */
1268 /* if node::dev:, move colon following dev */
1269 else if (colon
&& colon
[-1] == ':')
1271 /* if dev1:dev2:, move nm to dev2: */
1272 else if (colon
&& colon
[-1] != ':')
1277 if (p
[0] == ':' && !colon
)
1283 if (lbrack
== rbrack
)
1286 else if (p
[0] == '.')
1294 if (index (nm
, '/'))
1296 nm
= sys_translate_unix (nm
);
1297 return make_specified_string (nm
, -1, strlen (nm
),
1298 STRING_MULTIBYTE (name
));
1302 /* Make sure directories are all separated with / or \ as
1303 desired, but avoid allocation of a new string when not
1305 CORRECT_DIR_SEPS (nm
);
1307 if (IS_DIRECTORY_SEP (nm
[1]))
1309 if (strcmp (nm
, SDATA (name
)) != 0)
1310 name
= make_specified_string (nm
, -1, strlen (nm
),
1311 STRING_MULTIBYTE (name
));
1315 /* drive must be set, so this is okay */
1316 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1320 name
= make_specified_string (nm
, -1, p
- nm
,
1321 STRING_MULTIBYTE (name
));
1322 temp
[0] = DRIVE_LETTER (drive
);
1323 name
= concat2 (build_string (temp
), name
);
1326 #else /* not DOS_NT */
1327 if (nm
== SDATA (name
))
1329 return make_specified_string (nm
, -1, strlen (nm
),
1330 STRING_MULTIBYTE (name
));
1331 #endif /* not DOS_NT */
1335 /* At this point, nm might or might not be an absolute file name. We
1336 need to expand ~ or ~user if present, otherwise prefix nm with
1337 default_directory if nm is not absolute, and finally collapse /./
1338 and /foo/../ sequences.
1340 We set newdir to be the appropriate prefix if one is needed:
1341 - the relevant user directory if nm starts with ~ or ~user
1342 - the specified drive's working dir (DOS/NT only) if nm does not
1344 - the value of default_directory.
1346 Note that these prefixes are not guaranteed to be absolute (except
1347 for the working dir of a drive). Therefore, to ensure we always
1348 return an absolute name, if the final prefix is not absolute we
1349 append it to the current working directory. */
1353 if (nm
[0] == '~') /* prefix ~ */
1355 if (IS_DIRECTORY_SEP (nm
[1])
1359 || nm
[1] == 0) /* ~ by itself */
1361 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1362 newdir
= (unsigned char *) "";
1365 collapse_newdir
= 0;
1368 nm
++; /* Don't leave the slash in nm. */
1371 else /* ~user/filename */
1373 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1378 o
= (unsigned char *) alloca (p
- nm
+ 1);
1379 bcopy ((char *) nm
, o
, p
- nm
);
1382 pw
= (struct passwd
*) getpwnam (o
+ 1);
1385 newdir
= (unsigned char *) pw
-> pw_dir
;
1387 nm
= p
+ 1; /* skip the terminator */
1391 collapse_newdir
= 0;
1396 /* If we don't find a user of that name, leave the name
1397 unchanged; don't move nm forward to p. */
1402 /* On DOS and Windows, nm is absolute if a drive name was specified;
1403 use the drive's current directory as the prefix if needed. */
1404 if (!newdir
&& drive
)
1406 /* Get default directory if needed to make nm absolute. */
1407 if (!IS_DIRECTORY_SEP (nm
[0]))
1409 newdir
= alloca (MAXPATHLEN
+ 1);
1410 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1415 /* Either nm starts with /, or drive isn't mounted. */
1416 newdir
= alloca (4);
1417 newdir
[0] = DRIVE_LETTER (drive
);
1425 /* Finally, if no prefix has been specified and nm is not absolute,
1426 then it must be expanded relative to default_directory. */
1430 /* /... alone is not absolute on DOS and Windows. */
1431 && !IS_DIRECTORY_SEP (nm
[0])
1434 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1441 newdir
= SDATA (default_directory
);
1443 /* Note if special escape prefix is present, but remove for now. */
1444 if (newdir
[0] == '/' && newdir
[1] == ':')
1455 /* First ensure newdir is an absolute name. */
1457 /* Detect MSDOS file names with drive specifiers. */
1458 ! (IS_DRIVE (newdir
[0])
1459 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1461 /* Detect Windows file names in UNC format. */
1462 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1466 /* Effectively, let newdir be (expand-file-name newdir cwd).
1467 Because of the admonition against calling expand-file-name
1468 when we have pointers into lisp strings, we accomplish this
1469 indirectly by prepending newdir to nm if necessary, and using
1470 cwd (or the wd of newdir's drive) as the new newdir. */
1472 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1477 if (!IS_DIRECTORY_SEP (nm
[0]))
1479 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1480 file_name_as_directory (tmp
, newdir
);
1484 newdir
= alloca (MAXPATHLEN
+ 1);
1487 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1494 /* Strip off drive name from prefix, if present. */
1495 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1501 /* Keep only a prefix from newdir if nm starts with slash
1502 (//server/share for UNC, nothing otherwise). */
1503 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1506 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1508 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1510 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1512 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1524 /* Get rid of any slash at the end of newdir, unless newdir is
1525 just / or // (an incomplete UNC name). */
1526 length
= strlen (newdir
);
1527 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1529 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1533 unsigned char *temp
= (unsigned char *) alloca (length
);
1534 bcopy (newdir
, temp
, length
- 1);
1535 temp
[length
- 1] = 0;
1543 /* Now concatenate the directory and name to new space in the stack frame */
1544 tlen
+= strlen (nm
) + 1;
1546 /* Reserve space for drive specifier and escape prefix, since either
1547 or both may need to be inserted. (The Microsoft x86 compiler
1548 produces incorrect code if the following two lines are combined.) */
1549 target
= (unsigned char *) alloca (tlen
+ 4);
1551 #else /* not DOS_NT */
1552 target
= (unsigned char *) alloca (tlen
);
1553 #endif /* not DOS_NT */
1559 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1562 /* If newdir is effectively "C:/", then the drive letter will have
1563 been stripped and newdir will be "/". Concatenating with an
1564 absolute directory in nm produces "//", which will then be
1565 incorrectly treated as a network share. Ignore newdir in
1566 this case (keeping the drive letter). */
1567 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1568 && newdir
[1] == '\0'))
1570 strcpy (target
, newdir
);
1574 file_name_as_directory (target
, newdir
);
1577 strcat (target
, nm
);
1579 if (index (target
, '/'))
1580 strcpy (target
, sys_translate_unix (target
));
1583 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1585 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1594 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1600 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1601 /* brackets are offset from each other by 2 */
1604 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1605 /* convert [foo][bar] to [bar] */
1606 while (o
[-1] != '[' && o
[-1] != '<')
1608 else if (*p
== '-' && *o
!= '.')
1611 else if (p
[0] == '-' && o
[-1] == '.' &&
1612 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1613 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1617 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1618 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1620 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1622 /* else [foo.-] ==> [-] */
1628 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1629 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1635 if (!IS_DIRECTORY_SEP (*p
))
1639 else if (IS_DIRECTORY_SEP (p
[0])
1641 && (IS_DIRECTORY_SEP (p
[2])
1644 /* If "/." is the entire filename, keep the "/". Otherwise,
1645 just delete the whole "/.". */
1646 if (o
== target
&& p
[2] == '\0')
1650 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1651 /* `/../' is the "superroot" on certain file systems. */
1653 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1655 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1657 /* Keep initial / only if this is the whole name. */
1658 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1663 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1665 /* Collapse multiple `/' in a row. */
1667 while (IS_DIRECTORY_SEP (*p
))
1674 #endif /* not VMS */
1678 /* At last, set drive name. */
1680 /* Except for network file name. */
1681 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1682 #endif /* WINDOWSNT */
1684 if (!drive
) abort ();
1686 target
[0] = DRIVE_LETTER (drive
);
1689 /* Reinsert the escape prefix if required. */
1696 CORRECT_DIR_SEPS (target
);
1699 result
= make_specified_string (target
, -1, o
- target
,
1700 STRING_MULTIBYTE (name
));
1702 /* Again look to see if the file name has special constructs in it
1703 and perhaps call the corresponding file handler. This is needed
1704 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1705 the ".." component gives us "/user@host:/bar/../baz" which needs
1706 to be expanded again. */
1707 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1708 if (!NILP (handler
))
1709 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1715 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1716 This is the old version of expand-file-name, before it was thoroughly
1717 rewritten for Emacs 10.31. We leave this version here commented-out,
1718 because the code is very complex and likely to have subtle bugs. If
1719 bugs _are_ found, it might be of interest to look at the old code and
1720 see what did it do in the relevant situation.
1722 Don't remove this code: it's true that it will be accessible via CVS,
1723 but a few years from deletion, people will forget it is there. */
1725 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1726 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1727 "Convert FILENAME to absolute, and canonicalize it.\n\
1728 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1729 (does not start with slash); if DEFAULT is nil or missing,\n\
1730 the current buffer's value of default-directory is used.\n\
1731 Filenames containing `.' or `..' as components are simplified;\n\
1732 initial `~/' expands to your home directory.\n\
1733 See also the function `substitute-in-file-name'.")
1735 Lisp_Object name
, defalt
;
1739 register unsigned char *newdir
, *p
, *o
;
1741 unsigned char *target
;
1745 unsigned char * colon
= 0;
1746 unsigned char * close
= 0;
1747 unsigned char * slash
= 0;
1748 unsigned char * brack
= 0;
1749 int lbrack
= 0, rbrack
= 0;
1753 CHECK_STRING (name
);
1756 /* Filenames on VMS are always upper case. */
1757 name
= Fupcase (name
);
1762 /* If nm is absolute, flush ...// and detect /./ and /../.
1763 If no /./ or /../ we can return right away. */
1775 if (p
[0] == '/' && p
[1] == '/'
1777 /* // at start of filename is meaningful on Apollo system. */
1782 if (p
[0] == '/' && p
[1] == '~')
1783 nm
= p
+ 1, lose
= 1;
1784 if (p
[0] == '/' && p
[1] == '.'
1785 && (p
[2] == '/' || p
[2] == 0
1786 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1792 /* if dev:[dir]/, move nm to / */
1793 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1794 nm
= (brack
? brack
+ 1 : colon
+ 1);
1795 lbrack
= rbrack
= 0;
1803 /* VMS pre V4.4,convert '-'s in filenames. */
1804 if (lbrack
== rbrack
)
1806 if (dots
< 2) /* this is to allow negative version numbers */
1811 if (lbrack
> rbrack
&&
1812 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1813 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1819 /* count open brackets, reset close bracket pointer */
1820 if (p
[0] == '[' || p
[0] == '<')
1821 lbrack
++, brack
= 0;
1822 /* count close brackets, set close bracket pointer */
1823 if (p
[0] == ']' || p
[0] == '>')
1824 rbrack
++, brack
= p
;
1825 /* detect ][ or >< */
1826 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1828 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1829 nm
= p
+ 1, lose
= 1;
1830 if (p
[0] == ':' && (colon
|| slash
))
1831 /* if dev1:[dir]dev2:, move nm to dev2: */
1837 /* If /name/dev:, move nm to dev: */
1840 /* If node::dev:, move colon following dev */
1841 else if (colon
&& colon
[-1] == ':')
1843 /* If dev1:dev2:, move nm to dev2: */
1844 else if (colon
&& colon
[-1] != ':')
1849 if (p
[0] == ':' && !colon
)
1855 if (lbrack
== rbrack
)
1858 else if (p
[0] == '.')
1866 if (index (nm
, '/'))
1867 return build_string (sys_translate_unix (nm
));
1869 if (nm
== SDATA (name
))
1871 return build_string (nm
);
1875 /* Now determine directory to start with and put it in NEWDIR */
1879 if (nm
[0] == '~') /* prefix ~ */
1884 || nm
[1] == 0)/* ~/filename */
1886 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1887 newdir
= (unsigned char *) "";
1890 nm
++; /* Don't leave the slash in nm. */
1893 else /* ~user/filename */
1895 /* Get past ~ to user */
1896 unsigned char *user
= nm
+ 1;
1897 /* Find end of name. */
1898 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1899 int len
= ptr
? ptr
- user
: strlen (user
);
1901 unsigned char *ptr1
= index (user
, ':');
1902 if (ptr1
!= 0 && ptr1
- user
< len
)
1905 /* Copy the user name into temp storage. */
1906 o
= (unsigned char *) alloca (len
+ 1);
1907 bcopy ((char *) user
, o
, len
);
1910 /* Look up the user name. */
1911 pw
= (struct passwd
*) getpwnam (o
+ 1);
1913 error ("\"%s\" isn't a registered user", o
+ 1);
1915 newdir
= (unsigned char *) pw
->pw_dir
;
1917 /* Discard the user name from NM. */
1924 #endif /* not VMS */
1928 defalt
= current_buffer
->directory
;
1929 CHECK_STRING (defalt
);
1930 newdir
= SDATA (defalt
);
1933 /* Now concatenate the directory and name to new space in the stack frame */
1935 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1936 target
= (unsigned char *) alloca (tlen
);
1942 if (nm
[0] == 0 || nm
[0] == '/')
1943 strcpy (target
, newdir
);
1946 file_name_as_directory (target
, newdir
);
1949 strcat (target
, nm
);
1951 if (index (target
, '/'))
1952 strcpy (target
, sys_translate_unix (target
));
1955 /* Now canonicalize by removing /. and /foo/.. if they appear */
1963 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1969 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1970 /* brackets are offset from each other by 2 */
1973 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1974 /* convert [foo][bar] to [bar] */
1975 while (o
[-1] != '[' && o
[-1] != '<')
1977 else if (*p
== '-' && *o
!= '.')
1980 else if (p
[0] == '-' && o
[-1] == '.' &&
1981 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1982 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1986 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1987 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1989 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1991 /* else [foo.-] ==> [-] */
1997 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1998 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2008 else if (!strncmp (p
, "//", 2)
2010 /* // at start of filename is meaningful in Apollo system. */
2018 else if (p
[0] == '/' && p
[1] == '.' &&
2019 (p
[2] == '/' || p
[2] == 0))
2021 else if (!strncmp (p
, "/..", 3)
2022 /* `/../' is the "superroot" on certain file systems. */
2024 && (p
[3] == '/' || p
[3] == 0))
2026 while (o
!= target
&& *--o
!= '/')
2029 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2033 if (o
== target
&& *o
== '/')
2041 #endif /* not VMS */
2044 return make_string (target
, o
- target
);
2048 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2049 Ssubstitute_in_file_name
, 1, 1, 0,
2050 doc
: /* Substitute environment variables referred to in FILENAME.
2051 `$FOO' where FOO is an environment variable name means to substitute
2052 the value of that variable. The variable name should be terminated
2053 with a character not a letter, digit or underscore; otherwise, enclose
2054 the entire variable name in braces.
2055 If `/~' appears, all of FILENAME through that `/' is discarded.
2057 On VMS, `$' substitution is not done; this function does little and only
2058 duplicates what `expand-file-name' does. */)
2060 Lisp_Object filename
;
2064 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2065 unsigned char *target
= NULL
;
2067 int substituted
= 0;
2070 Lisp_Object handler
;
2072 CHECK_STRING (filename
);
2074 /* If the file name has special constructs in it,
2075 call the corresponding file handler. */
2076 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2077 if (!NILP (handler
))
2078 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2080 nm
= SDATA (filename
);
2082 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2083 CORRECT_DIR_SEPS (nm
);
2084 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2086 endp
= nm
+ SBYTES (filename
);
2088 /* If /~ or // appears, discard everything through first slash. */
2090 for (p
= nm
; p
!= endp
; p
++)
2093 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2094 /* // at start of file name is meaningful in Apollo,
2095 WindowsNT and Cygwin systems. */
2096 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2097 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2098 || IS_DIRECTORY_SEP (p
[0])
2099 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2104 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2106 || IS_DIRECTORY_SEP (p
[-1])))
2108 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2113 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2115 o
= (unsigned char *) alloca (s
- p
+ 1);
2116 bcopy ((char *) p
, o
, s
- p
);
2119 pw
= (struct passwd
*) getpwnam (o
+ 1);
2121 /* If we have ~/ or ~user and `user' exists, discard
2122 everything up to ~. But if `user' does not exist, leave
2123 ~user alone, it might be a literal file name. */
2124 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2131 /* see comment in expand-file-name about drive specifiers */
2132 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2133 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2142 return make_specified_string (nm
, -1, strlen (nm
),
2143 STRING_MULTIBYTE (filename
));
2146 /* See if any variables are substituted into the string
2147 and find the total length of their values in `total' */
2149 for (p
= nm
; p
!= endp
;)
2159 /* "$$" means a single "$" */
2168 while (p
!= endp
&& *p
!= '}') p
++;
2169 if (*p
!= '}') goto missingclose
;
2175 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2179 /* Copy out the variable name */
2180 target
= (unsigned char *) alloca (s
- o
+ 1);
2181 strncpy (target
, o
, s
- o
);
2184 strupr (target
); /* $home == $HOME etc. */
2187 /* Get variable value */
2188 o
= (unsigned char *) egetenv (target
);
2191 total
+= strlen (o
);
2201 /* If substitution required, recopy the string and do it */
2202 /* Make space in stack frame for the new copy */
2203 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2206 /* Copy the rest of the name through, replacing $ constructs with values */
2223 while (p
!= endp
&& *p
!= '}') p
++;
2224 if (*p
!= '}') goto missingclose
;
2230 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2234 /* Copy out the variable name */
2235 target
= (unsigned char *) alloca (s
- o
+ 1);
2236 strncpy (target
, o
, s
- o
);
2239 strupr (target
); /* $home == $HOME etc. */
2242 /* Get variable value */
2243 o
= (unsigned char *) egetenv (target
);
2247 strcpy (x
, target
); x
+= strlen (target
);
2249 else if (STRING_MULTIBYTE (filename
))
2251 /* If the original string is multibyte,
2252 convert what we substitute into multibyte. */
2255 int c
= unibyte_char_to_multibyte (*o
++);
2256 x
+= CHAR_STRING (c
, x
);
2268 /* If /~ or // appears, discard everything through first slash. */
2270 for (p
= xnm
; p
!= x
; p
++)
2272 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2273 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2274 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2275 || IS_DIRECTORY_SEP (p
[0])
2276 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2278 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2281 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2282 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2286 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2289 error ("Bad format environment-variable substitution");
2291 error ("Missing \"}\" in environment-variable substitution");
2293 error ("Substituting nonexistent environment variable \"%s\"", target
);
2296 #endif /* not VMS */
2300 /* A slightly faster and more convenient way to get
2301 (directory-file-name (expand-file-name FOO)). */
2304 expand_and_dir_to_file (filename
, defdir
)
2305 Lisp_Object filename
, defdir
;
2307 register Lisp_Object absname
;
2309 absname
= Fexpand_file_name (filename
, defdir
);
2312 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2313 if (c
== ':' || c
== ']' || c
== '>')
2314 absname
= Fdirectory_file_name (absname
);
2317 /* Remove final slash, if any (unless this is the root dir).
2318 stat behaves differently depending! */
2319 if (SCHARS (absname
) > 1
2320 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2321 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2322 /* We cannot take shortcuts; they might be wrong for magic file names. */
2323 absname
= Fdirectory_file_name (absname
);
2328 /* Signal an error if the file ABSNAME already exists.
2329 If INTERACTIVE is nonzero, ask the user whether to proceed,
2330 and bypass the error if the user says to go ahead.
2331 QUERYSTRING is a name for the action that is being considered
2334 *STATPTR is used to store the stat information if the file exists.
2335 If the file does not exist, STATPTR->st_mode is set to 0.
2336 If STATPTR is null, we don't store into it.
2338 If QUICK is nonzero, we ask for y or n, not yes or no. */
2341 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2342 Lisp_Object absname
;
2343 unsigned char *querystring
;
2345 struct stat
*statptr
;
2348 register Lisp_Object tem
, encoded_filename
;
2349 struct stat statbuf
;
2350 struct gcpro gcpro1
;
2352 encoded_filename
= ENCODE_FILE (absname
);
2354 /* stat is a good way to tell whether the file exists,
2355 regardless of what access permissions it has. */
2356 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2359 Fsignal (Qfile_already_exists
,
2360 Fcons (build_string ("File already exists"),
2361 Fcons (absname
, Qnil
)));
2363 tem
= format2 ("File %s already exists; %s anyway? ",
2364 absname
, build_string (querystring
));
2366 tem
= Fy_or_n_p (tem
);
2368 tem
= do_yes_or_no_p (tem
);
2371 Fsignal (Qfile_already_exists
,
2372 Fcons (build_string ("File already exists"),
2373 Fcons (absname
, Qnil
)));
2380 statptr
->st_mode
= 0;
2385 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2386 "fCopy file: \nFCopy %s to file: \np\nP",
2387 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2388 If NEWNAME names a directory, copy FILE there.
2389 Signals a `file-already-exists' error if file NEWNAME already exists,
2390 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2391 A number as third arg means request confirmation if NEWNAME already exists.
2392 This is what happens in interactive use with M-x.
2393 Fourth arg KEEP-TIME non-nil means give the new file the same
2394 last-modified time as the old one. (This works on only some systems.)
2395 A prefix arg makes KEEP-TIME non-nil.
2396 Also set the file modes of the target file to match the source file. */)
2397 (file
, newname
, ok_if_already_exists
, keep_time
)
2398 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2401 char buf
[16 * 1024];
2402 struct stat st
, out_st
;
2403 Lisp_Object handler
;
2404 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2405 int count
= SPECPDL_INDEX ();
2406 int input_file_statable_p
;
2407 Lisp_Object encoded_file
, encoded_newname
;
2409 encoded_file
= encoded_newname
= Qnil
;
2410 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2411 CHECK_STRING (file
);
2412 CHECK_STRING (newname
);
2414 if (!NILP (Ffile_directory_p (newname
)))
2415 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2417 newname
= Fexpand_file_name (newname
, Qnil
);
2419 file
= Fexpand_file_name (file
, Qnil
);
2421 /* If the input file name has special constructs in it,
2422 call the corresponding file handler. */
2423 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2424 /* Likewise for output file name. */
2426 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2427 if (!NILP (handler
))
2428 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2429 ok_if_already_exists
, keep_time
));
2431 encoded_file
= ENCODE_FILE (file
);
2432 encoded_newname
= ENCODE_FILE (newname
);
2434 if (NILP (ok_if_already_exists
)
2435 || INTEGERP (ok_if_already_exists
))
2436 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2437 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2438 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2442 if (!CopyFile (SDATA (encoded_file
),
2443 SDATA (encoded_newname
),
2445 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2446 /* CopyFile retains the timestamp by default. */
2447 else if (NILP (keep_time
))
2453 EMACS_GET_TIME (now
);
2454 filename
= SDATA (encoded_newname
);
2456 /* Ensure file is writable while its modified time is set. */
2457 attributes
= GetFileAttributes (filename
);
2458 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2459 if (set_file_times (filename
, now
, now
))
2461 /* Restore original attributes. */
2462 SetFileAttributes (filename
, attributes
);
2463 Fsignal (Qfile_date_error
,
2464 Fcons (build_string ("Cannot set file date"),
2465 Fcons (newname
, Qnil
)));
2467 /* Restore original attributes. */
2468 SetFileAttributes (filename
, attributes
);
2470 #else /* not WINDOWSNT */
2472 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2476 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2478 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2480 /* We can only copy regular files and symbolic links. Other files are not
2482 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2484 #if !defined (DOS_NT) || __DJGPP__ > 1
2485 if (out_st
.st_mode
!= 0
2486 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2489 report_file_error ("Input and output files are the same",
2490 Fcons (file
, Fcons (newname
, Qnil
)));
2494 #if defined (S_ISREG) && defined (S_ISLNK)
2495 if (input_file_statable_p
)
2497 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2499 #if defined (EISDIR)
2500 /* Get a better looking error message. */
2503 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2506 #endif /* S_ISREG && S_ISLNK */
2509 /* Create the copy file with the same record format as the input file */
2510 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2513 /* System's default file type was set to binary by _fmode in emacs.c. */
2514 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2515 #else /* not MSDOS */
2516 ofd
= creat (SDATA (encoded_newname
), 0666);
2517 #endif /* not MSDOS */
2520 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2522 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2526 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2527 if (emacs_write (ofd
, buf
, n
) != n
)
2528 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2531 /* Closing the output clobbers the file times on some systems. */
2532 if (emacs_close (ofd
) < 0)
2533 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2535 if (input_file_statable_p
)
2537 if (!NILP (keep_time
))
2539 EMACS_TIME atime
, mtime
;
2540 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2541 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2542 if (set_file_times (SDATA (encoded_newname
),
2544 Fsignal (Qfile_date_error
,
2545 Fcons (build_string ("Cannot set file date"),
2546 Fcons (newname
, Qnil
)));
2549 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2551 #if defined (__DJGPP__) && __DJGPP__ > 1
2552 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2553 and if it can't, it tells so. Otherwise, under MSDOS we usually
2554 get only the READ bit, which will make the copied file read-only,
2555 so it's better not to chmod at all. */
2556 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2557 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2558 #endif /* DJGPP version 2 or newer */
2563 #endif /* WINDOWSNT */
2565 /* Discard the unwind protects. */
2566 specpdl_ptr
= specpdl
+ count
;
2572 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2573 Smake_directory_internal
, 1, 1, 0,
2574 doc
: /* Create a new directory named DIRECTORY. */)
2576 Lisp_Object directory
;
2578 const unsigned char *dir
;
2579 Lisp_Object handler
;
2580 Lisp_Object encoded_dir
;
2582 CHECK_STRING (directory
);
2583 directory
= Fexpand_file_name (directory
, Qnil
);
2585 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2586 if (!NILP (handler
))
2587 return call2 (handler
, Qmake_directory_internal
, directory
);
2589 encoded_dir
= ENCODE_FILE (directory
);
2591 dir
= SDATA (encoded_dir
);
2594 if (mkdir (dir
) != 0)
2596 if (mkdir (dir
, 0777) != 0)
2598 report_file_error ("Creating directory", Flist (1, &directory
));
2603 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2604 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2606 Lisp_Object directory
;
2608 const unsigned char *dir
;
2609 Lisp_Object handler
;
2610 Lisp_Object encoded_dir
;
2612 CHECK_STRING (directory
);
2613 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2615 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2616 if (!NILP (handler
))
2617 return call2 (handler
, Qdelete_directory
, directory
);
2619 encoded_dir
= ENCODE_FILE (directory
);
2621 dir
= SDATA (encoded_dir
);
2623 if (rmdir (dir
) != 0)
2624 report_file_error ("Removing directory", Flist (1, &directory
));
2629 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2630 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2631 If file has multiple names, it continues to exist with the other names. */)
2633 Lisp_Object filename
;
2635 Lisp_Object handler
;
2636 Lisp_Object encoded_file
;
2637 struct gcpro gcpro1
;
2640 if (!NILP (Ffile_directory_p (filename
))
2641 && NILP (Ffile_symlink_p (filename
)))
2642 Fsignal (Qfile_error
,
2643 Fcons (build_string ("Removing old name: is a directory"),
2644 Fcons (filename
, Qnil
)));
2646 filename
= Fexpand_file_name (filename
, Qnil
);
2648 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2649 if (!NILP (handler
))
2650 return call2 (handler
, Qdelete_file
, filename
);
2652 encoded_file
= ENCODE_FILE (filename
);
2654 if (0 > unlink (SDATA (encoded_file
)))
2655 report_file_error ("Removing old name", Flist (1, &filename
));
2660 internal_delete_file_1 (ignore
)
2666 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2669 internal_delete_file (filename
)
2670 Lisp_Object filename
;
2672 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2673 Qt
, internal_delete_file_1
));
2676 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2677 "fRename file: \nFRename %s to file: \np",
2678 doc
: /* Rename FILE as NEWNAME. Both args strings.
2679 If file has names other than FILE, it continues to have those names.
2680 Signals a `file-already-exists' error if a file NEWNAME already exists
2681 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2682 A number as third arg means request confirmation if NEWNAME already exists.
2683 This is what happens in interactive use with M-x. */)
2684 (file
, newname
, ok_if_already_exists
)
2685 Lisp_Object file
, newname
, ok_if_already_exists
;
2688 Lisp_Object args
[2];
2690 Lisp_Object handler
;
2691 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2692 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2694 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2695 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2696 CHECK_STRING (file
);
2697 CHECK_STRING (newname
);
2698 file
= Fexpand_file_name (file
, Qnil
);
2699 newname
= Fexpand_file_name (newname
, Qnil
);
2701 /* If the file name has special constructs in it,
2702 call the corresponding file handler. */
2703 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2705 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2706 if (!NILP (handler
))
2707 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2708 file
, newname
, ok_if_already_exists
));
2710 encoded_file
= ENCODE_FILE (file
);
2711 encoded_newname
= ENCODE_FILE (newname
);
2714 /* If the file names are identical but for the case, don't ask for
2715 confirmation: they simply want to change the letter-case of the
2717 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2719 if (NILP (ok_if_already_exists
)
2720 || INTEGERP (ok_if_already_exists
))
2721 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2722 INTEGERP (ok_if_already_exists
), 0, 0);
2724 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2726 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2727 || 0 > unlink (SDATA (encoded_file
)))
2733 symlink_target
= Ffile_symlink_p (file
);
2734 if (! NILP (symlink_target
))
2735 Fmake_symbolic_link (symlink_target
, newname
,
2736 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2739 Fcopy_file (file
, newname
,
2740 /* We have already prompted if it was an integer,
2741 so don't have copy-file prompt again. */
2742 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2743 Fdelete_file (file
);
2750 report_file_error ("Renaming", Flist (2, args
));
2753 report_file_error ("Renaming", Flist (2, &file
));
2760 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2761 "fAdd name to file: \nFName to add to %s: \np",
2762 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2763 Signals a `file-already-exists' error if a file NEWNAME already exists
2764 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2765 A number as third arg means request confirmation if NEWNAME already exists.
2766 This is what happens in interactive use with M-x. */)
2767 (file
, newname
, ok_if_already_exists
)
2768 Lisp_Object file
, newname
, ok_if_already_exists
;
2771 Lisp_Object args
[2];
2773 Lisp_Object handler
;
2774 Lisp_Object encoded_file
, encoded_newname
;
2775 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2777 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2778 encoded_file
= encoded_newname
= Qnil
;
2779 CHECK_STRING (file
);
2780 CHECK_STRING (newname
);
2781 file
= Fexpand_file_name (file
, Qnil
);
2782 newname
= Fexpand_file_name (newname
, Qnil
);
2784 /* If the file name has special constructs in it,
2785 call the corresponding file handler. */
2786 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2787 if (!NILP (handler
))
2788 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2789 newname
, ok_if_already_exists
));
2791 /* If the new name has special constructs in it,
2792 call the corresponding file handler. */
2793 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2794 if (!NILP (handler
))
2795 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2796 newname
, ok_if_already_exists
));
2798 encoded_file
= ENCODE_FILE (file
);
2799 encoded_newname
= ENCODE_FILE (newname
);
2801 if (NILP (ok_if_already_exists
)
2802 || INTEGERP (ok_if_already_exists
))
2803 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2804 INTEGERP (ok_if_already_exists
), 0, 0);
2806 unlink (SDATA (newname
));
2807 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2812 report_file_error ("Adding new name", Flist (2, args
));
2814 report_file_error ("Adding new name", Flist (2, &file
));
2823 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2824 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2825 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2826 Signals a `file-already-exists' error if a file LINKNAME already exists
2827 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2828 A number as third arg means request confirmation if LINKNAME already exists.
2829 This happens for interactive use with M-x. */)
2830 (filename
, linkname
, ok_if_already_exists
)
2831 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2834 Lisp_Object args
[2];
2836 Lisp_Object handler
;
2837 Lisp_Object encoded_filename
, encoded_linkname
;
2838 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2840 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2841 encoded_filename
= encoded_linkname
= Qnil
;
2842 CHECK_STRING (filename
);
2843 CHECK_STRING (linkname
);
2844 /* If the link target has a ~, we must expand it to get
2845 a truly valid file name. Otherwise, do not expand;
2846 we want to permit links to relative file names. */
2847 if (SREF (filename
, 0) == '~')
2848 filename
= Fexpand_file_name (filename
, Qnil
);
2849 linkname
= Fexpand_file_name (linkname
, Qnil
);
2851 /* If the file name has special constructs in it,
2852 call the corresponding file handler. */
2853 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2854 if (!NILP (handler
))
2855 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2856 linkname
, ok_if_already_exists
));
2858 /* If the new link name has special constructs in it,
2859 call the corresponding file handler. */
2860 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2861 if (!NILP (handler
))
2862 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2863 linkname
, ok_if_already_exists
));
2865 encoded_filename
= ENCODE_FILE (filename
);
2866 encoded_linkname
= ENCODE_FILE (linkname
);
2868 if (NILP (ok_if_already_exists
)
2869 || INTEGERP (ok_if_already_exists
))
2870 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2871 INTEGERP (ok_if_already_exists
), 0, 0);
2872 if (0 > symlink (SDATA (encoded_filename
),
2873 SDATA (encoded_linkname
)))
2875 /* If we didn't complain already, silently delete existing file. */
2876 if (errno
== EEXIST
)
2878 unlink (SDATA (encoded_linkname
));
2879 if (0 <= symlink (SDATA (encoded_filename
),
2880 SDATA (encoded_linkname
)))
2890 report_file_error ("Making symbolic link", Flist (2, args
));
2892 report_file_error ("Making symbolic link", Flist (2, &filename
));
2898 #endif /* S_IFLNK */
2902 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2903 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2904 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2905 If STRING is nil or a null string, the logical name NAME is deleted. */)
2910 CHECK_STRING (name
);
2912 delete_logical_name (SDATA (name
));
2915 CHECK_STRING (string
);
2917 if (SCHARS (string
) == 0)
2918 delete_logical_name (SDATA (name
));
2920 define_logical_name (SDATA (name
), SDATA (string
));
2929 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2930 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2932 Lisp_Object path
, login
;
2936 CHECK_STRING (path
);
2937 CHECK_STRING (login
);
2939 netresult
= netunam (SDATA (path
), SDATA (login
));
2941 if (netresult
== -1)
2946 #endif /* HPUX_NET */
2948 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2950 doc
: /* Return t if file FILENAME specifies an absolute file name.
2951 On Unix, this is a name starting with a `/' or a `~'. */)
2953 Lisp_Object filename
;
2955 const unsigned char *ptr
;
2957 CHECK_STRING (filename
);
2958 ptr
= SDATA (filename
);
2959 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2961 /* ??? This criterion is probably wrong for '<'. */
2962 || index (ptr
, ':') || index (ptr
, '<')
2963 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2967 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2975 /* Return nonzero if file FILENAME exists and can be executed. */
2978 check_executable (filename
)
2982 int len
= strlen (filename
);
2985 if (stat (filename
, &st
) < 0)
2987 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2988 return ((st
.st_mode
& S_IEXEC
) != 0);
2990 return (S_ISREG (st
.st_mode
)
2992 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2993 || stricmp (suffix
, ".exe") == 0
2994 || stricmp (suffix
, ".bat") == 0)
2995 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2996 #endif /* not WINDOWSNT */
2997 #else /* not DOS_NT */
2998 #ifdef HAVE_EUIDACCESS
2999 return (euidaccess (filename
, 1) >= 0);
3001 /* Access isn't quite right because it uses the real uid
3002 and we really want to test with the effective uid.
3003 But Unix doesn't give us a right way to do it. */
3004 return (access (filename
, 1) >= 0);
3006 #endif /* not DOS_NT */
3009 /* Return nonzero if file FILENAME exists and can be written. */
3012 check_writable (filename
)
3017 if (stat (filename
, &st
) < 0)
3019 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3020 #else /* not MSDOS */
3021 #ifdef HAVE_EUIDACCESS
3022 return (euidaccess (filename
, 2) >= 0);
3024 /* Access isn't quite right because it uses the real uid
3025 and we really want to test with the effective uid.
3026 But Unix doesn't give us a right way to do it.
3027 Opening with O_WRONLY could work for an ordinary file,
3028 but would lose for directories. */
3029 return (access (filename
, 2) >= 0);
3031 #endif /* not MSDOS */
3034 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3035 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3036 See also `file-readable-p' and `file-attributes'. */)
3038 Lisp_Object filename
;
3040 Lisp_Object absname
;
3041 Lisp_Object handler
;
3042 struct stat statbuf
;
3044 CHECK_STRING (filename
);
3045 absname
= Fexpand_file_name (filename
, Qnil
);
3047 /* If the file name has special constructs in it,
3048 call the corresponding file handler. */
3049 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3050 if (!NILP (handler
))
3051 return call2 (handler
, Qfile_exists_p
, absname
);
3053 absname
= ENCODE_FILE (absname
);
3055 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3058 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3059 doc
: /* Return t if FILENAME can be executed by you.
3060 For a directory, this means you can access files in that directory. */)
3062 Lisp_Object filename
;
3064 Lisp_Object absname
;
3065 Lisp_Object handler
;
3067 CHECK_STRING (filename
);
3068 absname
= Fexpand_file_name (filename
, Qnil
);
3070 /* If the file name has special constructs in it,
3071 call the corresponding file handler. */
3072 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3073 if (!NILP (handler
))
3074 return call2 (handler
, Qfile_executable_p
, absname
);
3076 absname
= ENCODE_FILE (absname
);
3078 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3081 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3082 doc
: /* Return t if file FILENAME exists and you can read it.
3083 See also `file-exists-p' and `file-attributes'. */)
3085 Lisp_Object filename
;
3087 Lisp_Object absname
;
3088 Lisp_Object handler
;
3091 struct stat statbuf
;
3093 CHECK_STRING (filename
);
3094 absname
= Fexpand_file_name (filename
, Qnil
);
3096 /* If the file name has special constructs in it,
3097 call the corresponding file handler. */
3098 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3099 if (!NILP (handler
))
3100 return call2 (handler
, Qfile_readable_p
, absname
);
3102 absname
= ENCODE_FILE (absname
);
3104 #if defined(DOS_NT) || defined(macintosh)
3105 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3107 if (access (SDATA (absname
), 0) == 0)
3110 #else /* not DOS_NT and not macintosh */
3112 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3113 /* Opening a fifo without O_NONBLOCK can wait.
3114 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3115 except in the case of a fifo, on a system which handles it. */
3116 desc
= stat (SDATA (absname
), &statbuf
);
3119 if (S_ISFIFO (statbuf
.st_mode
))
3120 flags
|= O_NONBLOCK
;
3122 desc
= emacs_open (SDATA (absname
), flags
, 0);
3127 #endif /* not DOS_NT and not macintosh */
3130 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3132 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3133 doc
: /* Return t if file FILENAME can be written or created by you. */)
3135 Lisp_Object filename
;
3137 Lisp_Object absname
, dir
, encoded
;
3138 Lisp_Object handler
;
3139 struct stat statbuf
;
3141 CHECK_STRING (filename
);
3142 absname
= Fexpand_file_name (filename
, Qnil
);
3144 /* If the file name has special constructs in it,
3145 call the corresponding file handler. */
3146 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3147 if (!NILP (handler
))
3148 return call2 (handler
, Qfile_writable_p
, absname
);
3150 encoded
= ENCODE_FILE (absname
);
3151 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3152 return (check_writable (SDATA (encoded
))
3155 dir
= Ffile_name_directory (absname
);
3158 dir
= Fdirectory_file_name (dir
);
3162 dir
= Fdirectory_file_name (dir
);
3165 dir
= ENCODE_FILE (dir
);
3167 /* The read-only attribute of the parent directory doesn't affect
3168 whether a file or directory can be created within it. Some day we
3169 should check ACLs though, which do affect this. */
3170 if (stat (SDATA (dir
), &statbuf
) < 0)
3172 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3174 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3179 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3180 doc
: /* Access file FILENAME, and get an error if that does not work.
3181 The second argument STRING is used in the error message.
3182 If there is no error, we return nil. */)
3184 Lisp_Object filename
, string
;
3186 Lisp_Object handler
, encoded_filename
, absname
;
3189 CHECK_STRING (filename
);
3190 absname
= Fexpand_file_name (filename
, Qnil
);
3192 CHECK_STRING (string
);
3194 /* If the file name has special constructs in it,
3195 call the corresponding file handler. */
3196 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3197 if (!NILP (handler
))
3198 return call3 (handler
, Qaccess_file
, absname
, string
);
3200 encoded_filename
= ENCODE_FILE (absname
);
3202 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3204 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3210 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3211 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3212 The value is the link target, as a string.
3213 Otherwise returns nil. */)
3215 Lisp_Object filename
;
3217 Lisp_Object handler
;
3219 CHECK_STRING (filename
);
3220 filename
= Fexpand_file_name (filename
, Qnil
);
3222 /* If the file name has special constructs in it,
3223 call the corresponding file handler. */
3224 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3225 if (!NILP (handler
))
3226 return call2 (handler
, Qfile_symlink_p
, filename
);
3235 filename
= ENCODE_FILE (filename
);
3242 buf
= (char *) xrealloc (buf
, bufsize
);
3243 bzero (buf
, bufsize
);
3246 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3250 /* HP-UX reports ERANGE if buffer is too small. */
3251 if (errno
== ERANGE
)
3261 while (valsize
>= bufsize
);
3263 val
= make_string (buf
, valsize
);
3264 if (buf
[0] == '/' && index (buf
, ':'))
3265 val
= concat2 (build_string ("/:"), val
);
3267 val
= DECODE_FILE (val
);
3270 #else /* not S_IFLNK */
3272 #endif /* not S_IFLNK */
3275 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3276 doc
: /* Return t if FILENAME names an existing directory.
3277 Symbolic links to directories count as directories.
3278 See `file-symlink-p' to distinguish symlinks. */)
3280 Lisp_Object filename
;
3282 register Lisp_Object absname
;
3284 Lisp_Object handler
;
3286 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3288 /* If the file name has special constructs in it,
3289 call the corresponding file handler. */
3290 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3291 if (!NILP (handler
))
3292 return call2 (handler
, Qfile_directory_p
, absname
);
3294 absname
= ENCODE_FILE (absname
);
3296 if (stat (SDATA (absname
), &st
) < 0)
3298 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3301 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3302 doc
: /* Return t if file FILENAME names a directory you can open.
3303 For the value to be t, FILENAME must specify the name of a directory as a file,
3304 and the directory must allow you to open files in it. In order to use a
3305 directory as a buffer's current directory, this predicate must return true.
3306 A directory name spec may be given instead; then the value is t
3307 if the directory so specified exists and really is a readable and
3308 searchable directory. */)
3310 Lisp_Object filename
;
3312 Lisp_Object handler
;
3314 struct gcpro gcpro1
;
3316 /* If the file name has special constructs in it,
3317 call the corresponding file handler. */
3318 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3319 if (!NILP (handler
))
3320 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3323 tem
= (NILP (Ffile_directory_p (filename
))
3324 || NILP (Ffile_executable_p (filename
)));
3326 return tem
? Qnil
: Qt
;
3329 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3330 doc
: /* Return t if file FILENAME is the name of a regular file.
3331 This is the sort of file that holds an ordinary stream of data bytes. */)
3333 Lisp_Object filename
;
3335 register Lisp_Object absname
;
3337 Lisp_Object handler
;
3339 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3341 /* If the file name has special constructs in it,
3342 call the corresponding file handler. */
3343 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3344 if (!NILP (handler
))
3345 return call2 (handler
, Qfile_regular_p
, absname
);
3347 absname
= ENCODE_FILE (absname
);
3352 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3354 /* Tell stat to use expensive method to get accurate info. */
3355 Vw32_get_true_file_attributes
= Qt
;
3356 result
= stat (SDATA (absname
), &st
);
3357 Vw32_get_true_file_attributes
= tem
;
3361 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3364 if (stat (SDATA (absname
), &st
) < 0)
3366 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3370 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3371 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
3373 Lisp_Object filename
;
3375 Lisp_Object absname
;
3377 Lisp_Object handler
;
3379 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3381 /* If the file name has special constructs in it,
3382 call the corresponding file handler. */
3383 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3384 if (!NILP (handler
))
3385 return call2 (handler
, Qfile_modes
, absname
);
3387 absname
= ENCODE_FILE (absname
);
3389 if (stat (SDATA (absname
), &st
) < 0)
3391 #if defined (MSDOS) && __DJGPP__ < 2
3392 if (check_executable (SDATA (absname
)))
3393 st
.st_mode
|= S_IEXEC
;
3394 #endif /* MSDOS && __DJGPP__ < 2 */
3396 return make_number (st
.st_mode
& 07777);
3399 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3400 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3401 Only the 12 low bits of MODE are used. */)
3403 Lisp_Object filename
, mode
;
3405 Lisp_Object absname
, encoded_absname
;
3406 Lisp_Object handler
;
3408 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3409 CHECK_NUMBER (mode
);
3411 /* If the file name has special constructs in it,
3412 call the corresponding file handler. */
3413 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3414 if (!NILP (handler
))
3415 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3417 encoded_absname
= ENCODE_FILE (absname
);
3419 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3420 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3425 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3426 doc
: /* Set the file permission bits for newly created files.
3427 The argument MODE should be an integer; only the low 9 bits are used.
3428 This setting is inherited by subprocesses. */)
3432 CHECK_NUMBER (mode
);
3434 umask ((~ XINT (mode
)) & 0777);
3439 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3440 doc
: /* Return the default file protection for created files.
3441 The value is an integer. */)
3447 realmask
= umask (0);
3450 XSETINT (value
, (~ realmask
) & 0777);
3454 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3456 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3457 doc
: /* Set times of file FILENAME to TIME.
3458 Set both access and modification times.
3459 Return t on success, else nil.
3460 Use the current time if TIME is nil. TIME is in the format of
3463 Lisp_Object filename
, time
;
3465 Lisp_Object absname
, encoded_absname
;
3466 Lisp_Object handler
;
3470 if (! lisp_time_argument (time
, &sec
, &usec
))
3471 error ("Invalid time specification");
3473 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3475 /* If the file name has special constructs in it,
3476 call the corresponding file handler. */
3477 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3478 if (!NILP (handler
))
3479 return call3 (handler
, Qset_file_times
, absname
, time
);
3481 encoded_absname
= ENCODE_FILE (absname
);
3486 EMACS_SET_SECS (t
, sec
);
3487 EMACS_SET_USECS (t
, usec
);
3489 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3494 /* Setting times on a directory always fails. */
3495 if (stat (SDATA (encoded_absname
), &st
) == 0
3496 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3499 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3512 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3513 doc
: /* Tell Unix to finish all pending disk updates. */)
3522 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3523 doc
: /* Return t if file FILE1 is newer than file FILE2.
3524 If FILE1 does not exist, the answer is nil;
3525 otherwise, if FILE2 does not exist, the answer is t. */)
3527 Lisp_Object file1
, file2
;
3529 Lisp_Object absname1
, absname2
;
3532 Lisp_Object handler
;
3533 struct gcpro gcpro1
, gcpro2
;
3535 CHECK_STRING (file1
);
3536 CHECK_STRING (file2
);
3539 GCPRO2 (absname1
, file2
);
3540 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3541 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3544 /* If the file name has special constructs in it,
3545 call the corresponding file handler. */
3546 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3548 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3549 if (!NILP (handler
))
3550 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3552 GCPRO2 (absname1
, absname2
);
3553 absname1
= ENCODE_FILE (absname1
);
3554 absname2
= ENCODE_FILE (absname2
);
3557 if (stat (SDATA (absname1
), &st
) < 0)
3560 mtime1
= st
.st_mtime
;
3562 if (stat (SDATA (absname2
), &st
) < 0)
3565 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3569 Lisp_Object Qfind_buffer_file_type
;
3572 #ifndef READ_BUF_SIZE
3573 #define READ_BUF_SIZE (64 << 10)
3576 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3578 /* This function is called after Lisp functions to decide a coding
3579 system are called, or when they cause an error. Before they are
3580 called, the current buffer is set unibyte and it contains only a
3581 newly inserted text (thus the buffer was empty before the
3584 The functions may set markers, overlays, text properties, or even
3585 alter the buffer contents, change the current buffer.
3587 Here, we reset all those changes by:
3588 o set back the current buffer.
3589 o move all markers and overlays to BEG.
3590 o remove all text properties.
3591 o set back the buffer multibyteness. */
3594 decide_coding_unwind (unwind_data
)
3595 Lisp_Object unwind_data
;
3597 Lisp_Object multibyte
, undo_list
, buffer
;
3599 multibyte
= XCAR (unwind_data
);
3600 unwind_data
= XCDR (unwind_data
);
3601 undo_list
= XCAR (unwind_data
);
3602 buffer
= XCDR (unwind_data
);
3604 if (current_buffer
!= XBUFFER (buffer
))
3605 set_buffer_internal (XBUFFER (buffer
));
3606 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3607 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3608 BUF_INTERVALS (current_buffer
) = 0;
3609 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3611 /* Now we are safe to change the buffer's multibyteness directly. */
3612 current_buffer
->enable_multibyte_characters
= multibyte
;
3613 current_buffer
->undo_list
= undo_list
;
3619 /* Used to pass values from insert-file-contents to read_non_regular. */
3621 static int non_regular_fd
;
3622 static int non_regular_inserted
;
3623 static int non_regular_nbytes
;
3626 /* Read from a non-regular file.
3627 Read non_regular_trytry bytes max from non_regular_fd.
3628 Non_regular_inserted specifies where to put the read bytes.
3629 Value is the number of bytes read. */
3638 nbytes
= emacs_read (non_regular_fd
,
3639 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3640 non_regular_nbytes
);
3642 return make_number (nbytes
);
3646 /* Condition-case handler used when reading from non-regular files
3647 in insert-file-contents. */
3650 read_non_regular_quit ()
3656 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3658 doc
: /* Insert contents of file FILENAME after point.
3659 Returns list of absolute file name and number of characters inserted.
3660 If second argument VISIT is non-nil, the buffer's visited filename
3661 and last save file modtime are set, and it is marked unmodified.
3662 If visiting and the file does not exist, visiting is completed
3663 before the error is signaled.
3664 The optional third and fourth arguments BEG and END
3665 specify what portion of the file to insert.
3666 These arguments count bytes in the file, not characters in the buffer.
3667 If VISIT is non-nil, BEG and END must be nil.
3669 If optional fifth argument REPLACE is non-nil,
3670 it means replace the current buffer contents (in the accessible portion)
3671 with the file contents. This is better than simply deleting and inserting
3672 the whole thing because (1) it preserves some marker positions
3673 and (2) it puts less data in the undo list.
3674 When REPLACE is non-nil, the value is the number of characters actually read,
3675 which is often less than the number of characters to be read.
3677 This does code conversion according to the value of
3678 `coding-system-for-read' or `file-coding-system-alist',
3679 and sets the variable `last-coding-system-used' to the coding system
3681 (filename
, visit
, beg
, end
, replace
)
3682 Lisp_Object filename
, visit
, beg
, end
, replace
;
3687 register int how_much
;
3688 register int unprocessed
;
3689 int count
= SPECPDL_INDEX ();
3690 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3691 Lisp_Object handler
, val
, insval
, orig_filename
;
3694 int not_regular
= 0;
3695 unsigned char read_buf
[READ_BUF_SIZE
];
3696 struct coding_system coding
;
3697 unsigned char buffer
[1 << 14];
3698 int replace_handled
= 0;
3699 int set_coding_system
= 0;
3700 int coding_system_decided
= 0;
3703 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3704 error ("Cannot do file visiting in an indirect buffer");
3706 if (!NILP (current_buffer
->read_only
))
3707 Fbarf_if_buffer_read_only ();
3711 orig_filename
= Qnil
;
3713 GCPRO4 (filename
, val
, p
, orig_filename
);
3715 CHECK_STRING (filename
);
3716 filename
= Fexpand_file_name (filename
, Qnil
);
3718 /* If the file name has special constructs in it,
3719 call the corresponding file handler. */
3720 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3721 if (!NILP (handler
))
3723 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3724 visit
, beg
, end
, replace
);
3725 if (CONSP (val
) && CONSP (XCDR (val
)))
3726 inserted
= XINT (XCAR (XCDR (val
)));
3730 orig_filename
= filename
;
3731 filename
= ENCODE_FILE (filename
);
3737 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3739 /* Tell stat to use expensive method to get accurate info. */
3740 Vw32_get_true_file_attributes
= Qt
;
3741 total
= stat (SDATA (filename
), &st
);
3742 Vw32_get_true_file_attributes
= tem
;
3747 if (stat (SDATA (filename
), &st
) < 0)
3749 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3750 || fstat (fd
, &st
) < 0)
3751 #endif /* not APOLLO */
3752 #endif /* WINDOWSNT */
3754 if (fd
>= 0) emacs_close (fd
);
3757 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3760 if (!NILP (Vcoding_system_for_read
))
3761 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3766 /* This code will need to be changed in order to work on named
3767 pipes, and it's probably just not worth it. So we should at
3768 least signal an error. */
3769 if (!S_ISREG (st
.st_mode
))
3776 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3777 Fsignal (Qfile_error
,
3778 Fcons (build_string ("not a regular file"),
3779 Fcons (orig_filename
, Qnil
)));
3784 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3787 /* Replacement should preserve point as it preserves markers. */
3788 if (!NILP (replace
))
3789 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3791 record_unwind_protect (close_file_unwind
, make_number (fd
));
3793 /* Supposedly happens on VMS. */
3794 /* Can happen on any platform that uses long as type of off_t, but allows
3795 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3796 give a message suitable for the latter case. */
3797 if (! not_regular
&& st
.st_size
< 0)
3798 error ("Maximum buffer size exceeded");
3800 /* Prevent redisplay optimizations. */
3801 current_buffer
->clip_changed
= 1;
3805 if (!NILP (beg
) || !NILP (end
))
3806 error ("Attempt to visit less than an entire file");
3807 if (BEG
< Z
&& NILP (replace
))
3808 error ("Cannot do file visiting in a non-empty buffer");
3814 XSETFASTINT (beg
, 0);
3822 XSETINT (end
, st
.st_size
);
3824 /* Arithmetic overflow can occur if an Emacs integer cannot
3825 represent the file size, or if the calculations below
3826 overflow. The calculations below double the file size
3827 twice, so check that it can be multiplied by 4 safely. */
3828 if (XINT (end
) != st
.st_size
3829 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3830 error ("Maximum buffer size exceeded");
3832 /* The file size returned from stat may be zero, but data
3833 may be readable nonetheless, for example when this is a
3834 file in the /proc filesystem. */
3835 if (st
.st_size
== 0)
3836 XSETINT (end
, READ_BUF_SIZE
);
3840 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3842 /* We use emacs-mule for auto saving... */
3843 setup_coding_system (Qemacs_mule
, &coding
);
3844 /* ... but with the special flag to indicate to read in a
3845 multibyte sequence for eight-bit-control char as is. */
3847 coding
.src_multibyte
= 0;
3848 coding
.dst_multibyte
3849 = !NILP (current_buffer
->enable_multibyte_characters
);
3850 coding
.eol_type
= CODING_EOL_LF
;
3851 coding_system_decided
= 1;
3855 /* Decide the coding system to use for reading the file now
3856 because we can't use an optimized method for handling
3857 `coding:' tag if the current buffer is not empty. */
3861 if (!NILP (Vcoding_system_for_read
))
3862 val
= Vcoding_system_for_read
;
3863 else if (! NILP (replace
))
3864 /* In REPLACE mode, we can use the same coding system
3865 that was used to visit the file. */
3866 val
= current_buffer
->buffer_file_coding_system
;
3869 /* Don't try looking inside a file for a coding system
3870 specification if it is not seekable. */
3871 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3873 /* Find a coding system specified in the heading two
3874 lines or in the tailing several lines of the file.
3875 We assume that the 1K-byte and 3K-byte for heading
3876 and tailing respectively are sufficient for this
3880 if (st
.st_size
<= (1024 * 4))
3881 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3884 nread
= emacs_read (fd
, read_buf
, 1024);
3887 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3888 report_file_error ("Setting file position",
3889 Fcons (orig_filename
, Qnil
));
3890 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3895 error ("IO error reading %s: %s",
3896 SDATA (orig_filename
), emacs_strerror (errno
));
3899 struct buffer
*prev
= current_buffer
;
3903 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3905 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3906 buf
= XBUFFER (buffer
);
3908 delete_all_overlays (buf
);
3909 buf
->directory
= current_buffer
->directory
;
3910 buf
->read_only
= Qnil
;
3911 buf
->filename
= Qnil
;
3912 buf
->undo_list
= Qt
;
3913 eassert (buf
->overlays_before
== NULL
);
3914 eassert (buf
->overlays_after
== NULL
);
3916 set_buffer_internal (buf
);
3918 buf
->enable_multibyte_characters
= Qnil
;
3920 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3921 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3922 val
= call2 (Vset_auto_coding_function
,
3923 filename
, make_number (nread
));
3924 set_buffer_internal (prev
);
3926 /* Discard the unwind protect for recovering the
3930 /* Rewind the file for the actual read done later. */
3931 if (lseek (fd
, 0, 0) < 0)
3932 report_file_error ("Setting file position",
3933 Fcons (orig_filename
, Qnil
));
3939 /* If we have not yet decided a coding system, check
3940 file-coding-system-alist. */
3941 Lisp_Object args
[6], coding_systems
;
3943 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3944 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3945 coding_systems
= Ffind_operation_coding_system (6, args
);
3946 if (CONSP (coding_systems
))
3947 val
= XCAR (coding_systems
);
3951 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3952 /* Ensure we set Vlast_coding_system_used. */
3953 set_coding_system
= 1;
3955 if (NILP (current_buffer
->enable_multibyte_characters
)
3957 /* We must suppress all character code conversion except for
3958 end-of-line conversion. */
3959 setup_raw_text_coding_system (&coding
);
3961 coding
.src_multibyte
= 0;
3962 coding
.dst_multibyte
3963 = !NILP (current_buffer
->enable_multibyte_characters
);
3964 coding_system_decided
= 1;
3967 /* If requested, replace the accessible part of the buffer
3968 with the file contents. Avoid replacing text at the
3969 beginning or end of the buffer that matches the file contents;
3970 that preserves markers pointing to the unchanged parts.
3972 Here we implement this feature in an optimized way
3973 for the case where code conversion is NOT needed.
3974 The following if-statement handles the case of conversion
3975 in a less optimal way.
3977 If the code conversion is "automatic" then we try using this
3978 method and hope for the best.
3979 But if we discover the need for conversion, we give up on this method
3980 and let the following if-statement handle the replace job. */
3983 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3985 /* same_at_start and same_at_end count bytes,
3986 because file access counts bytes
3987 and BEG and END count bytes. */
3988 int same_at_start
= BEGV_BYTE
;
3989 int same_at_end
= ZV_BYTE
;
3991 /* There is still a possibility we will find the need to do code
3992 conversion. If that happens, we set this variable to 1 to
3993 give up on handling REPLACE in the optimized way. */
3994 int giveup_match_end
= 0;
3996 if (XINT (beg
) != 0)
3998 if (lseek (fd
, XINT (beg
), 0) < 0)
3999 report_file_error ("Setting file position",
4000 Fcons (orig_filename
, Qnil
));
4005 /* Count how many chars at the start of the file
4006 match the text at the beginning of the buffer. */
4011 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4013 error ("IO error reading %s: %s",
4014 SDATA (orig_filename
), emacs_strerror (errno
));
4015 else if (nread
== 0)
4018 if (coding
.type
== coding_type_undecided
)
4019 detect_coding (&coding
, buffer
, nread
);
4020 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4021 /* We found that the file should be decoded somehow.
4022 Let's give up here. */
4024 giveup_match_end
= 1;
4028 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4029 detect_eol (&coding
, buffer
, nread
);
4030 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4031 && coding
.eol_type
!= CODING_EOL_LF
)
4032 /* We found that the format of eol should be decoded.
4033 Let's give up here. */
4035 giveup_match_end
= 1;
4040 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4041 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4042 same_at_start
++, bufpos
++;
4043 /* If we found a discrepancy, stop the scan.
4044 Otherwise loop around and scan the next bufferful. */
4045 if (bufpos
!= nread
)
4049 /* If the file matches the buffer completely,
4050 there's no need to replace anything. */
4051 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4055 /* Truncate the buffer to the size of the file. */
4056 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4061 /* Count how many chars at the end of the file
4062 match the text at the end of the buffer. But, if we have
4063 already found that decoding is necessary, don't waste time. */
4064 while (!giveup_match_end
)
4066 int total_read
, nread
, bufpos
, curpos
, trial
;
4068 /* At what file position are we now scanning? */
4069 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4070 /* If the entire file matches the buffer tail, stop the scan. */
4073 /* How much can we scan in the next step? */
4074 trial
= min (curpos
, sizeof buffer
);
4075 if (lseek (fd
, curpos
- trial
, 0) < 0)
4076 report_file_error ("Setting file position",
4077 Fcons (orig_filename
, Qnil
));
4079 total_read
= nread
= 0;
4080 while (total_read
< trial
)
4082 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4084 error ("IO error reading %s: %s",
4085 SDATA (orig_filename
), emacs_strerror (errno
));
4086 else if (nread
== 0)
4088 total_read
+= nread
;
4091 /* Scan this bufferful from the end, comparing with
4092 the Emacs buffer. */
4093 bufpos
= total_read
;
4095 /* Compare with same_at_start to avoid counting some buffer text
4096 as matching both at the file's beginning and at the end. */
4097 while (bufpos
> 0 && same_at_end
> same_at_start
4098 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4099 same_at_end
--, bufpos
--;
4101 /* If we found a discrepancy, stop the scan.
4102 Otherwise loop around and scan the preceding bufferful. */
4105 /* If this discrepancy is because of code conversion,
4106 we cannot use this method; giveup and try the other. */
4107 if (same_at_end
> same_at_start
4108 && FETCH_BYTE (same_at_end
- 1) >= 0200
4109 && ! NILP (current_buffer
->enable_multibyte_characters
)
4110 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4111 giveup_match_end
= 1;
4120 if (! giveup_match_end
)
4124 /* We win! We can handle REPLACE the optimized way. */
4126 /* Extend the start of non-matching text area to multibyte
4127 character boundary. */
4128 if (! NILP (current_buffer
->enable_multibyte_characters
))
4129 while (same_at_start
> BEGV_BYTE
4130 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4133 /* Extend the end of non-matching text area to multibyte
4134 character boundary. */
4135 if (! NILP (current_buffer
->enable_multibyte_characters
))
4136 while (same_at_end
< ZV_BYTE
4137 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4140 /* Don't try to reuse the same piece of text twice. */
4141 overlap
= (same_at_start
- BEGV_BYTE
4142 - (same_at_end
+ st
.st_size
- ZV
));
4144 same_at_end
+= overlap
;
4146 /* Arrange to read only the nonmatching middle part of the file. */
4147 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4148 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4150 del_range_byte (same_at_start
, same_at_end
, 0);
4151 /* Insert from the file at the proper position. */
4152 temp
= BYTE_TO_CHAR (same_at_start
);
4153 SET_PT_BOTH (temp
, same_at_start
);
4155 /* If display currently starts at beginning of line,
4156 keep it that way. */
4157 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4158 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4160 replace_handled
= 1;
4164 /* If requested, replace the accessible part of the buffer
4165 with the file contents. Avoid replacing text at the
4166 beginning or end of the buffer that matches the file contents;
4167 that preserves markers pointing to the unchanged parts.
4169 Here we implement this feature for the case where code conversion
4170 is needed, in a simple way that needs a lot of memory.
4171 The preceding if-statement handles the case of no conversion
4172 in a more optimized way. */
4173 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4175 int same_at_start
= BEGV_BYTE
;
4176 int same_at_end
= ZV_BYTE
;
4179 /* Make sure that the gap is large enough. */
4180 int bufsize
= 2 * st
.st_size
;
4181 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4184 /* First read the whole file, performing code conversion into
4185 CONVERSION_BUFFER. */
4187 if (lseek (fd
, XINT (beg
), 0) < 0)
4189 xfree (conversion_buffer
);
4190 report_file_error ("Setting file position",
4191 Fcons (orig_filename
, Qnil
));
4194 total
= st
.st_size
; /* Total bytes in the file. */
4195 how_much
= 0; /* Bytes read from file so far. */
4196 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4197 unprocessed
= 0; /* Bytes not processed in previous loop. */
4199 while (how_much
< total
)
4201 /* try is reserved in some compilers (Microsoft C) */
4202 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4203 unsigned char *destination
= read_buf
+ unprocessed
;
4206 /* Allow quitting out of the actual I/O. */
4209 this = emacs_read (fd
, destination
, trytry
);
4212 if (this < 0 || this + unprocessed
== 0)
4220 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4222 int require
, result
;
4224 this += unprocessed
;
4226 /* If we are using more space than estimated,
4227 make CONVERSION_BUFFER bigger. */
4228 require
= decoding_buffer_size (&coding
, this);
4229 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4231 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4232 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4235 /* Convert this batch with results in CONVERSION_BUFFER. */
4236 if (how_much
>= total
) /* This is the last block. */
4237 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4238 if (coding
.composing
!= COMPOSITION_DISABLED
)
4239 coding_allocate_composition_data (&coding
, BEGV
);
4240 result
= decode_coding (&coding
, read_buf
,
4241 conversion_buffer
+ inserted
,
4242 this, bufsize
- inserted
);
4244 /* Save for next iteration whatever we didn't convert. */
4245 unprocessed
= this - coding
.consumed
;
4246 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4247 if (!NILP (current_buffer
->enable_multibyte_characters
))
4248 this = coding
.produced
;
4250 this = str_as_unibyte (conversion_buffer
+ inserted
,
4257 /* At this point, INSERTED is how many characters (i.e. bytes)
4258 are present in CONVERSION_BUFFER.
4259 HOW_MUCH should equal TOTAL,
4260 or should be <= 0 if we couldn't read the file. */
4264 xfree (conversion_buffer
);
4267 error ("IO error reading %s: %s",
4268 SDATA (orig_filename
), emacs_strerror (errno
));
4269 else if (how_much
== -2)
4270 error ("maximum buffer size exceeded");
4273 /* Compare the beginning of the converted file
4274 with the buffer text. */
4277 while (bufpos
< inserted
&& same_at_start
< same_at_end
4278 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4279 same_at_start
++, bufpos
++;
4281 /* If the file matches the buffer completely,
4282 there's no need to replace anything. */
4284 if (bufpos
== inserted
)
4286 xfree (conversion_buffer
);
4289 /* Truncate the buffer to the size of the file. */
4290 del_range_byte (same_at_start
, same_at_end
, 0);
4295 /* Extend the start of non-matching text area to multibyte
4296 character boundary. */
4297 if (! NILP (current_buffer
->enable_multibyte_characters
))
4298 while (same_at_start
> BEGV_BYTE
4299 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4302 /* Scan this bufferful from the end, comparing with
4303 the Emacs buffer. */
4306 /* Compare with same_at_start to avoid counting some buffer text
4307 as matching both at the file's beginning and at the end. */
4308 while (bufpos
> 0 && same_at_end
> same_at_start
4309 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4310 same_at_end
--, bufpos
--;
4312 /* Extend the end of non-matching text area to multibyte
4313 character boundary. */
4314 if (! NILP (current_buffer
->enable_multibyte_characters
))
4315 while (same_at_end
< ZV_BYTE
4316 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4319 /* Don't try to reuse the same piece of text twice. */
4320 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4322 same_at_end
+= overlap
;
4324 /* If display currently starts at beginning of line,
4325 keep it that way. */
4326 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4327 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4329 /* Replace the chars that we need to replace,
4330 and update INSERTED to equal the number of bytes
4331 we are taking from the file. */
4332 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4334 if (same_at_end
!= same_at_start
)
4336 del_range_byte (same_at_start
, same_at_end
, 0);
4338 same_at_start
= GPT_BYTE
;
4342 temp
= BYTE_TO_CHAR (same_at_start
);
4344 /* Insert from the file at the proper position. */
4345 SET_PT_BOTH (temp
, same_at_start
);
4346 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4348 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4349 coding_restore_composition (&coding
, Fcurrent_buffer ());
4350 coding_free_composition_data (&coding
);
4352 /* Set `inserted' to the number of inserted characters. */
4353 inserted
= PT
- temp
;
4355 xfree (conversion_buffer
);
4364 register Lisp_Object temp
;
4366 total
= XINT (end
) - XINT (beg
);
4368 /* Make sure point-max won't overflow after this insertion. */
4369 XSETINT (temp
, total
);
4370 if (total
!= XINT (temp
))
4371 error ("Maximum buffer size exceeded");
4374 /* For a special file, all we can do is guess. */
4375 total
= READ_BUF_SIZE
;
4377 if (NILP (visit
) && total
> 0)
4378 prepare_to_modify_buffer (PT
, PT
, NULL
);
4381 if (GAP_SIZE
< total
)
4382 make_gap (total
- GAP_SIZE
);
4384 if (XINT (beg
) != 0 || !NILP (replace
))
4386 if (lseek (fd
, XINT (beg
), 0) < 0)
4387 report_file_error ("Setting file position",
4388 Fcons (orig_filename
, Qnil
));
4391 /* In the following loop, HOW_MUCH contains the total bytes read so
4392 far for a regular file, and not changed for a special file. But,
4393 before exiting the loop, it is set to a negative value if I/O
4397 /* Total bytes inserted. */
4400 /* Here, we don't do code conversion in the loop. It is done by
4401 code_convert_region after all data are read into the buffer. */
4403 int gap_size
= GAP_SIZE
;
4405 while (how_much
< total
)
4407 /* try is reserved in some compilers (Microsoft C) */
4408 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4415 /* Maybe make more room. */
4416 if (gap_size
< trytry
)
4418 make_gap (total
- gap_size
);
4419 gap_size
= GAP_SIZE
;
4422 /* Read from the file, capturing `quit'. When an
4423 error occurs, end the loop, and arrange for a quit
4424 to be signaled after decoding the text we read. */
4425 non_regular_fd
= fd
;
4426 non_regular_inserted
= inserted
;
4427 non_regular_nbytes
= trytry
;
4428 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4429 read_non_regular_quit
);
4440 /* Allow quitting out of the actual I/O. We don't make text
4441 part of the buffer until all the reading is done, so a C-g
4442 here doesn't do any harm. */
4445 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4457 /* For a regular file, where TOTAL is the real size,
4458 count HOW_MUCH to compare with it.
4459 For a special file, where TOTAL is just a buffer size,
4460 so don't bother counting in HOW_MUCH.
4461 (INSERTED is where we count the number of characters inserted.) */
4468 /* Make the text read part of the buffer. */
4469 GAP_SIZE
-= inserted
;
4471 GPT_BYTE
+= inserted
;
4473 ZV_BYTE
+= inserted
;
4478 /* Put an anchor to ensure multi-byte form ends at gap. */
4483 /* Discard the unwind protect for closing the file. */
4487 error ("IO error reading %s: %s",
4488 SDATA (orig_filename
), emacs_strerror (errno
));
4492 if (! coding_system_decided
)
4494 /* The coding system is not yet decided. Decide it by an
4495 optimized method for handling `coding:' tag.
4497 Note that we can get here only if the buffer was empty
4498 before the insertion. */
4502 if (!NILP (Vcoding_system_for_read
))
4503 val
= Vcoding_system_for_read
;
4506 /* Since we are sure that the current buffer was empty
4507 before the insertion, we can toggle
4508 enable-multibyte-characters directly here without taking
4509 care of marker adjustment and byte combining problem. By
4510 this way, we can run Lisp program safely before decoding
4511 the inserted text. */
4512 Lisp_Object unwind_data
;
4513 int count
= SPECPDL_INDEX ();
4515 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4516 Fcons (current_buffer
->undo_list
,
4517 Fcurrent_buffer ()));
4518 current_buffer
->enable_multibyte_characters
= Qnil
;
4519 current_buffer
->undo_list
= Qt
;
4520 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4522 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4524 val
= call2 (Vset_auto_coding_function
,
4525 filename
, make_number (inserted
));
4530 /* If the coding system is not yet decided, check
4531 file-coding-system-alist. */
4532 Lisp_Object args
[6], coding_systems
;
4534 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4535 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4536 coding_systems
= Ffind_operation_coding_system (6, args
);
4537 if (CONSP (coding_systems
))
4538 val
= XCAR (coding_systems
);
4541 unbind_to (count
, Qnil
);
4542 inserted
= Z_BYTE
- BEG_BYTE
;
4545 /* The following kludgy code is to avoid some compiler bug.
4547 setup_coding_system (val, &coding);
4550 struct coding_system temp_coding
;
4551 setup_coding_system (val
, &temp_coding
);
4552 bcopy (&temp_coding
, &coding
, sizeof coding
);
4554 /* Ensure we set Vlast_coding_system_used. */
4555 set_coding_system
= 1;
4557 if (NILP (current_buffer
->enable_multibyte_characters
)
4559 /* We must suppress all character code conversion except for
4560 end-of-line conversion. */
4561 setup_raw_text_coding_system (&coding
);
4562 coding
.src_multibyte
= 0;
4563 coding
.dst_multibyte
4564 = !NILP (current_buffer
->enable_multibyte_characters
);
4568 /* Can't do this if part of the buffer might be preserved. */
4570 && (coding
.type
== coding_type_no_conversion
4571 || coding
.type
== coding_type_raw_text
))
4573 /* Visiting a file with these coding system makes the buffer
4575 current_buffer
->enable_multibyte_characters
= Qnil
;
4576 coding
.dst_multibyte
= 0;
4579 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4581 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4583 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4585 inserted
= coding
.produced_char
;
4588 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4592 /* Now INSERTED is measured in characters. */
4595 /* Use the conversion type to determine buffer-file-type
4596 (find-buffer-file-type is now used to help determine the
4598 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4599 || coding
.eol_type
== CODING_EOL_LF
)
4600 && ! CODING_REQUIRE_DECODING (&coding
))
4601 current_buffer
->buffer_file_type
= Qt
;
4603 current_buffer
->buffer_file_type
= Qnil
;
4610 if (!EQ (current_buffer
->undo_list
, Qt
))
4611 current_buffer
->undo_list
= Qnil
;
4613 stat (SDATA (filename
), &st
);
4618 current_buffer
->modtime
= st
.st_mtime
;
4619 current_buffer
->filename
= orig_filename
;
4622 SAVE_MODIFF
= MODIFF
;
4623 current_buffer
->auto_save_modified
= MODIFF
;
4624 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4625 #ifdef CLASH_DETECTION
4628 if (!NILP (current_buffer
->file_truename
))
4629 unlock_file (current_buffer
->file_truename
);
4630 unlock_file (filename
);
4632 #endif /* CLASH_DETECTION */
4634 Fsignal (Qfile_error
,
4635 Fcons (build_string ("not a regular file"),
4636 Fcons (orig_filename
, Qnil
)));
4639 if (set_coding_system
)
4640 Vlast_coding_system_used
= coding
.symbol
;
4642 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4644 insval
= call1 (Qafter_insert_file_set_coding
, make_number (inserted
));
4645 if (! NILP (insval
))
4647 CHECK_NUMBER (insval
);
4648 inserted
= XFASTINT (insval
);
4652 /* Decode file format */
4655 int empty_undo_list_p
= 0;
4657 /* If we're anyway going to discard undo information, don't
4658 record it in the first place. The buffer's undo list at this
4659 point is either nil or t when visiting a file. */
4662 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4663 current_buffer
->undo_list
= Qt
;
4666 insval
= call3 (Qformat_decode
,
4667 Qnil
, make_number (inserted
), visit
);
4668 CHECK_NUMBER (insval
);
4669 inserted
= XFASTINT (insval
);
4672 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4675 /* Call after-change hooks for the inserted text, aside from the case
4676 of normal visiting (not with REPLACE), which is done in a new buffer
4677 "before" the buffer is changed. */
4678 if (inserted
> 0 && total
> 0
4679 && (NILP (visit
) || !NILP (replace
)))
4681 signal_after_change (PT
, 0, inserted
);
4682 update_compositions (PT
, PT
, CHECK_BORDER
);
4685 p
= Vafter_insert_file_functions
;
4688 insval
= call1 (XCAR (p
), make_number (inserted
));
4691 CHECK_NUMBER (insval
);
4692 inserted
= XFASTINT (insval
);
4699 && current_buffer
->modtime
== -1)
4701 /* If visiting nonexistent file, return nil. */
4702 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4706 Fsignal (Qquit
, Qnil
);
4708 /* ??? Retval needs to be dealt with in all cases consistently. */
4710 val
= Fcons (orig_filename
,
4711 Fcons (make_number (inserted
),
4714 RETURN_UNGCPRO (unbind_to (count
, val
));
4717 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4718 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4719 Lisp_Object
, Lisp_Object
));
4721 /* If build_annotations switched buffers, switch back to BUF.
4722 Kill the temporary buffer that was selected in the meantime.
4724 Since this kill only the last temporary buffer, some buffers remain
4725 not killed if build_annotations switched buffers more than once.
4729 build_annotations_unwind (buf
)
4734 if (XBUFFER (buf
) == current_buffer
)
4736 tembuf
= Fcurrent_buffer ();
4738 Fkill_buffer (tembuf
);
4742 /* Decide the coding-system to encode the data with. */
4745 choose_write_coding_system (start
, end
, filename
,
4746 append
, visit
, lockname
, coding
)
4747 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4748 struct coding_system
*coding
;
4753 && NILP (Fstring_equal (current_buffer
->filename
,
4754 current_buffer
->auto_save_file_name
)))
4756 /* We use emacs-mule for auto saving... */
4757 setup_coding_system (Qemacs_mule
, coding
);
4758 /* ... but with the special flag to indicate not to strip off
4759 leading code of eight-bit-control chars. */
4761 goto done_setup_coding
;
4763 else if (!NILP (Vcoding_system_for_write
))
4765 val
= Vcoding_system_for_write
;
4766 if (coding_system_require_warning
4767 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4768 /* Confirm that VAL can surely encode the current region. */
4769 val
= call5 (Vselect_safe_coding_system_function
,
4770 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4775 /* If the variable `buffer-file-coding-system' is set locally,
4776 it means that the file was read with some kind of code
4777 conversion or the variable is explicitly set by users. We
4778 had better write it out with the same coding system even if
4779 `enable-multibyte-characters' is nil.
4781 If it is not set locally, we anyway have to convert EOL
4782 format if the default value of `buffer-file-coding-system'
4783 tells that it is not Unix-like (LF only) format. */
4784 int using_default_coding
= 0;
4785 int force_raw_text
= 0;
4787 val
= current_buffer
->buffer_file_coding_system
;
4789 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4792 if (NILP (current_buffer
->enable_multibyte_characters
))
4798 /* Check file-coding-system-alist. */
4799 Lisp_Object args
[7], coding_systems
;
4801 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4802 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4804 coding_systems
= Ffind_operation_coding_system (7, args
);
4805 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4806 val
= XCDR (coding_systems
);
4810 && !NILP (current_buffer
->buffer_file_coding_system
))
4812 /* If we still have not decided a coding system, use the
4813 default value of buffer-file-coding-system. */
4814 val
= current_buffer
->buffer_file_coding_system
;
4815 using_default_coding
= 1;
4819 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4820 /* Confirm that VAL can surely encode the current region. */
4821 val
= call5 (Vselect_safe_coding_system_function
,
4822 start
, end
, val
, Qnil
, filename
);
4824 setup_coding_system (Fcheck_coding_system (val
), coding
);
4825 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4826 && !using_default_coding
)
4828 if (! EQ (default_buffer_file_coding
.symbol
,
4829 buffer_defaults
.buffer_file_coding_system
))
4830 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4831 &default_buffer_file_coding
);
4832 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4834 Lisp_Object subsidiaries
;
4836 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4837 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4838 if (VECTORP (subsidiaries
)
4839 && XVECTOR (subsidiaries
)->size
== 3)
4841 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4846 setup_raw_text_coding_system (coding
);
4847 goto done_setup_coding
;
4850 setup_coding_system (Fcheck_coding_system (val
), coding
);
4853 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4854 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4857 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4858 "r\nFWrite region to file: \ni\ni\ni\np",
4859 doc
: /* Write current region into specified file.
4860 When called from a program, requires three arguments:
4861 START, END and FILENAME. START and END are normally buffer positions
4862 specifying the part of the buffer to write.
4863 If START is nil, that means to use the entire buffer contents.
4864 If START is a string, then output that string to the file
4865 instead of any buffer contents; END is ignored.
4867 Optional fourth argument APPEND if non-nil means
4868 append to existing file contents (if any). If it is an integer,
4869 seek to that offset in the file before writing.
4870 Optional fifth argument VISIT, if t or a string, means
4871 set the last-save-file-modtime of buffer to this file's modtime
4872 and mark buffer not modified.
4873 If VISIT is a string, it is a second file name;
4874 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4875 VISIT is also the file name to lock and unlock for clash detection.
4876 If VISIT is neither t nor nil nor a string,
4877 that means do not display the \"Wrote file\" message.
4878 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4879 use for locking and unlocking, overriding FILENAME and VISIT.
4880 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4881 for an existing file with the same name. If MUSTBENEW is `excl',
4882 that means to get an error if the file already exists; never overwrite.
4883 If MUSTBENEW is neither nil nor `excl', that means ask for
4884 confirmation before overwriting, but do go ahead and overwrite the file
4885 if the user confirms.
4887 This does code conversion according to the value of
4888 `coding-system-for-write', `buffer-file-coding-system', or
4889 `file-coding-system-alist', and sets the variable
4890 `last-coding-system-used' to the coding system actually used. */)
4891 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4892 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4897 const unsigned char *fn
;
4900 int count
= SPECPDL_INDEX ();
4903 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4905 Lisp_Object handler
;
4906 Lisp_Object visit_file
;
4907 Lisp_Object annotations
;
4908 Lisp_Object encoded_filename
;
4909 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4910 int quietly
= !NILP (visit
);
4911 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4912 struct buffer
*given_buffer
;
4914 int buffer_file_type
= O_BINARY
;
4916 struct coding_system coding
;
4918 if (current_buffer
->base_buffer
&& visiting
)
4919 error ("Cannot do file visiting in an indirect buffer");
4921 if (!NILP (start
) && !STRINGP (start
))
4922 validate_region (&start
, &end
);
4924 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4926 filename
= Fexpand_file_name (filename
, Qnil
);
4928 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4929 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4931 if (STRINGP (visit
))
4932 visit_file
= Fexpand_file_name (visit
, Qnil
);
4934 visit_file
= filename
;
4936 if (NILP (lockname
))
4937 lockname
= visit_file
;
4941 /* If the file name has special constructs in it,
4942 call the corresponding file handler. */
4943 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4944 /* If FILENAME has no handler, see if VISIT has one. */
4945 if (NILP (handler
) && STRINGP (visit
))
4946 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4948 if (!NILP (handler
))
4951 val
= call6 (handler
, Qwrite_region
, start
, end
,
4952 filename
, append
, visit
);
4956 SAVE_MODIFF
= MODIFF
;
4957 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4958 current_buffer
->filename
= visit_file
;
4964 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4966 /* Special kludge to simplify auto-saving. */
4969 XSETFASTINT (start
, BEG
);
4970 XSETFASTINT (end
, Z
);
4974 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4975 count1
= SPECPDL_INDEX ();
4977 given_buffer
= current_buffer
;
4979 if (!STRINGP (start
))
4981 annotations
= build_annotations (start
, end
);
4983 if (current_buffer
!= given_buffer
)
4985 XSETFASTINT (start
, BEGV
);
4986 XSETFASTINT (end
, ZV
);
4992 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4994 /* Decide the coding-system to encode the data with.
4995 We used to make this choice before calling build_annotations, but that
4996 leads to problems when a write-annotate-function takes care of
4997 unsavable chars (as was the case with X-Symbol). */
4998 choose_write_coding_system (start
, end
, filename
,
4999 append
, visit
, lockname
, &coding
);
5000 Vlast_coding_system_used
= coding
.symbol
;
5002 given_buffer
= current_buffer
;
5003 if (! STRINGP (start
))
5005 annotations
= build_annotations_2 (start
, end
,
5006 coding
.pre_write_conversion
, annotations
);
5007 if (current_buffer
!= given_buffer
)
5009 XSETFASTINT (start
, BEGV
);
5010 XSETFASTINT (end
, ZV
);
5014 #ifdef CLASH_DETECTION
5017 #if 0 /* This causes trouble for GNUS. */
5018 /* If we've locked this file for some other buffer,
5019 query before proceeding. */
5020 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5021 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5024 lock_file (lockname
);
5026 #endif /* CLASH_DETECTION */
5028 encoded_filename
= ENCODE_FILE (filename
);
5030 fn
= SDATA (encoded_filename
);
5034 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5035 #else /* not DOS_NT */
5036 desc
= emacs_open (fn
, O_WRONLY
, 0);
5037 #endif /* not DOS_NT */
5039 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5041 if (auto_saving
) /* Overwrite any previous version of autosave file */
5043 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5044 desc
= emacs_open (fn
, O_RDWR
, 0);
5046 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5047 ? SDATA (current_buffer
->filename
) : 0,
5050 else /* Write to temporary name and rename if no errors */
5052 Lisp_Object temp_name
;
5053 temp_name
= Ffile_name_directory (filename
);
5055 if (!NILP (temp_name
))
5057 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5058 build_string ("$$SAVE$$")));
5059 fname
= SDATA (filename
);
5060 fn
= SDATA (temp_name
);
5061 desc
= creat_copy_attrs (fname
, fn
);
5064 /* If we can't open the temporary file, try creating a new
5065 version of the original file. VMS "creat" creates a
5066 new version rather than truncating an existing file. */
5069 desc
= creat (fn
, 0666);
5070 #if 0 /* This can clobber an existing file and fail to replace it,
5071 if the user runs out of space. */
5074 /* We can't make a new version;
5075 try to truncate and rewrite existing version if any. */
5077 desc
= emacs_open (fn
, O_RDWR
, 0);
5083 desc
= creat (fn
, 0666);
5087 desc
= emacs_open (fn
,
5088 O_WRONLY
| O_CREAT
| buffer_file_type
5089 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5090 S_IREAD
| S_IWRITE
);
5091 #else /* not DOS_NT */
5092 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5093 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5094 auto_saving
? auto_save_mode_bits
: 0666);
5095 #endif /* not DOS_NT */
5096 #endif /* not VMS */
5100 #ifdef CLASH_DETECTION
5102 if (!auto_saving
) unlock_file (lockname
);
5104 #endif /* CLASH_DETECTION */
5106 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5109 record_unwind_protect (close_file_unwind
, make_number (desc
));
5111 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5115 if (NUMBERP (append
))
5116 ret
= lseek (desc
, XINT (append
), 1);
5118 ret
= lseek (desc
, 0, 2);
5121 #ifdef CLASH_DETECTION
5122 if (!auto_saving
) unlock_file (lockname
);
5123 #endif /* CLASH_DETECTION */
5125 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5133 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5134 * if we do writes that don't end with a carriage return. Furthermore
5135 * it cannot handle writes of more then 16K. The modified
5136 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5137 * this EXCEPT for the last record (iff it doesn't end with a carriage
5138 * return). This implies that if your buffer doesn't end with a carriage
5139 * return, you get one free... tough. However it also means that if
5140 * we make two calls to sys_write (a la the following code) you can
5141 * get one at the gap as well. The easiest way to fix this (honest)
5142 * is to move the gap to the next newline (or the end of the buffer).
5147 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5148 move_gap (find_next_newline (GPT
, 1));
5150 /* Whether VMS or not, we must move the gap to the next of newline
5151 when we must put designation sequences at beginning of line. */
5152 if (INTEGERP (start
)
5153 && coding
.type
== coding_type_iso2022
5154 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5155 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5157 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5158 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5159 move_gap_both (PT
, PT_BYTE
);
5160 SET_PT_BOTH (opoint
, opoint_byte
);
5167 if (STRINGP (start
))
5169 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5170 &annotations
, &coding
);
5173 else if (XINT (start
) != XINT (end
))
5175 tem
= CHAR_TO_BYTE (XINT (start
));
5177 if (XINT (start
) < GPT
)
5179 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5180 min (GPT
, XINT (end
)) - XINT (start
),
5181 &annotations
, &coding
);
5185 if (XINT (end
) > GPT
&& !failure
)
5187 tem
= max (XINT (start
), GPT
);
5188 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5189 &annotations
, &coding
);
5195 /* If file was empty, still need to write the annotations */
5196 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5197 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5201 if (CODING_REQUIRE_FLUSHING (&coding
)
5202 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5205 /* We have to flush out a data. */
5206 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5207 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5214 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5215 Disk full in NFS may be reported here. */
5216 /* mib says that closing the file will try to write as fast as NFS can do
5217 it, and that means the fsync here is not crucial for autosave files. */
5218 if (!auto_saving
&& fsync (desc
) < 0)
5220 /* If fsync fails with EINTR, don't treat that as serious. */
5222 failure
= 1, save_errno
= errno
;
5226 /* Spurious "file has changed on disk" warnings have been
5227 observed on Suns as well.
5228 It seems that `close' can change the modtime, under nfs.
5230 (This has supposedly been fixed in Sunos 4,
5231 but who knows about all the other machines with NFS?) */
5234 /* On VMS and APOLLO, must do the stat after the close
5235 since closing changes the modtime. */
5238 /* Recall that #if defined does not work on VMS. */
5245 /* NFS can report a write failure now. */
5246 if (emacs_close (desc
) < 0)
5247 failure
= 1, save_errno
= errno
;
5250 /* If we wrote to a temporary name and had no errors, rename to real name. */
5254 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5262 /* Discard the unwind protect for close_file_unwind. */
5263 specpdl_ptr
= specpdl
+ count1
;
5264 /* Restore the original current buffer. */
5265 visit_file
= unbind_to (count
, visit_file
);
5267 #ifdef CLASH_DETECTION
5269 unlock_file (lockname
);
5270 #endif /* CLASH_DETECTION */
5272 /* Do this before reporting IO error
5273 to avoid a "file has changed on disk" warning on
5274 next attempt to save. */
5276 current_buffer
->modtime
= st
.st_mtime
;
5279 error ("IO error writing %s: %s", SDATA (filename
),
5280 emacs_strerror (save_errno
));
5284 SAVE_MODIFF
= MODIFF
;
5285 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5286 current_buffer
->filename
= visit_file
;
5287 update_mode_lines
++;
5292 && ! NILP (Fstring_equal (current_buffer
->filename
,
5293 current_buffer
->auto_save_file_name
)))
5294 SAVE_MODIFF
= MODIFF
;
5300 message_with_string ((INTEGERP (append
)
5310 Lisp_Object
merge ();
5312 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5313 doc
: /* Return t if (car A) is numerically less than (car B). */)
5317 return Flss (Fcar (a
), Fcar (b
));
5320 /* Build the complete list of annotations appropriate for writing out
5321 the text between START and END, by calling all the functions in
5322 write-region-annotate-functions and merging the lists they return.
5323 If one of these functions switches to a different buffer, we assume
5324 that buffer contains altered text. Therefore, the caller must
5325 make sure to restore the current buffer in all cases,
5326 as save-excursion would do. */
5329 build_annotations (start
, end
)
5330 Lisp_Object start
, end
;
5332 Lisp_Object annotations
;
5334 struct gcpro gcpro1
, gcpro2
;
5335 Lisp_Object original_buffer
;
5336 int i
, used_global
= 0;
5338 XSETBUFFER (original_buffer
, current_buffer
);
5341 p
= Vwrite_region_annotate_functions
;
5342 GCPRO2 (annotations
, p
);
5345 struct buffer
*given_buffer
= current_buffer
;
5346 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5347 { /* Use the global value of the hook. */
5350 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5352 p
= Fappend (2, arg
);
5355 Vwrite_region_annotations_so_far
= annotations
;
5356 res
= call2 (XCAR (p
), start
, end
);
5357 /* If the function makes a different buffer current,
5358 assume that means this buffer contains altered text to be output.
5359 Reset START and END from the buffer bounds
5360 and discard all previous annotations because they should have
5361 been dealt with by this function. */
5362 if (current_buffer
!= given_buffer
)
5364 XSETFASTINT (start
, BEGV
);
5365 XSETFASTINT (end
, ZV
);
5368 Flength (res
); /* Check basic validity of return value */
5369 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5373 /* Now do the same for annotation functions implied by the file-format */
5374 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5375 p
= current_buffer
->auto_save_file_format
;
5377 p
= current_buffer
->file_format
;
5378 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5380 struct buffer
*given_buffer
= current_buffer
;
5382 Vwrite_region_annotations_so_far
= annotations
;
5384 /* Value is either a list of annotations or nil if the function
5385 has written annotations to a temporary buffer, which is now
5387 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5388 original_buffer
, make_number (i
));
5389 if (current_buffer
!= given_buffer
)
5391 XSETFASTINT (start
, BEGV
);
5392 XSETFASTINT (end
, ZV
);
5397 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5405 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5406 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5408 struct gcpro gcpro1
;
5411 GCPRO1 (annotations
);
5412 /* At last, do the same for the function PRE_WRITE_CONVERSION
5413 implied by the current coding-system. */
5414 if (!NILP (pre_write_conversion
))
5416 struct buffer
*given_buffer
= current_buffer
;
5417 Vwrite_region_annotations_so_far
= annotations
;
5418 res
= call2 (pre_write_conversion
, start
, end
);
5420 annotations
= (current_buffer
!= given_buffer
5422 : merge (annotations
, res
, Qcar_less_than_car
));
5429 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5430 If STRING is nil, POS is the character position in the current buffer.
5431 Intersperse with them the annotations from *ANNOT
5432 which fall within the range of POS to POS + NCHARS,
5433 each at its appropriate position.
5435 We modify *ANNOT by discarding elements as we use them up.
5437 The return value is negative in case of system call failure. */
5440 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5443 register int nchars
;
5446 struct coding_system
*coding
;
5450 int lastpos
= pos
+ nchars
;
5452 while (NILP (*annot
) || CONSP (*annot
))
5454 tem
= Fcar_safe (Fcar (*annot
));
5457 nextpos
= XFASTINT (tem
);
5459 /* If there are no more annotations in this range,
5460 output the rest of the range all at once. */
5461 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5462 return e_write (desc
, string
, pos
, lastpos
, coding
);
5464 /* Output buffer text up to the next annotation's position. */
5467 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5471 /* Output the annotation. */
5472 tem
= Fcdr (Fcar (*annot
));
5475 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5478 *annot
= Fcdr (*annot
);
5483 #ifndef WRITE_BUF_SIZE
5484 #define WRITE_BUF_SIZE (16 * 1024)
5487 /* Write text in the range START and END into descriptor DESC,
5488 encoding them with coding system CODING. If STRING is nil, START
5489 and END are character positions of the current buffer, else they
5490 are indexes to the string STRING. */
5493 e_write (desc
, string
, start
, end
, coding
)
5497 struct coding_system
*coding
;
5499 register char *addr
;
5500 register int nbytes
;
5501 char buf
[WRITE_BUF_SIZE
];
5505 coding
->composing
= COMPOSITION_DISABLED
;
5506 if (coding
->composing
!= COMPOSITION_DISABLED
)
5507 coding_save_composition (coding
, start
, end
, string
);
5509 if (STRINGP (string
))
5511 addr
= SDATA (string
);
5512 nbytes
= SBYTES (string
);
5513 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5515 else if (start
< end
)
5517 /* It is assured that the gap is not in the range START and END-1. */
5518 addr
= CHAR_POS_ADDR (start
);
5519 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5520 coding
->src_multibyte
5521 = !NILP (current_buffer
->enable_multibyte_characters
);
5527 coding
->src_multibyte
= 1;
5530 /* We used to have a code for handling selective display here. But,
5531 now it is handled within encode_coding. */
5536 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5537 if (coding
->produced
> 0)
5539 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5540 if (coding
->produced
)
5546 nbytes
-= coding
->consumed
;
5547 addr
+= coding
->consumed
;
5548 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5551 /* The source text ends by an incomplete multibyte form.
5552 There's no way other than write it out as is. */
5553 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5562 start
+= coding
->consumed_char
;
5563 if (coding
->cmp_data
)
5564 coding_adjust_composition_offset (coding
, start
);
5567 if (coding
->cmp_data
)
5568 coding_free_composition_data (coding
);
5573 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5574 Sverify_visited_file_modtime
, 1, 1, 0,
5575 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5576 This means that the file has not been changed since it was visited or saved.
5577 See Info node `(elisp)Modification Time' for more details. */)
5583 Lisp_Object handler
;
5584 Lisp_Object filename
;
5589 if (!STRINGP (b
->filename
)) return Qt
;
5590 if (b
->modtime
== 0) return Qt
;
5592 /* If the file name has special constructs in it,
5593 call the corresponding file handler. */
5594 handler
= Ffind_file_name_handler (b
->filename
,
5595 Qverify_visited_file_modtime
);
5596 if (!NILP (handler
))
5597 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5599 filename
= ENCODE_FILE (b
->filename
);
5601 if (stat (SDATA (filename
), &st
) < 0)
5603 /* If the file doesn't exist now and didn't exist before,
5604 we say that it isn't modified, provided the error is a tame one. */
5605 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5610 if (st
.st_mtime
== b
->modtime
5611 /* If both are positive, accept them if they are off by one second. */
5612 || (st
.st_mtime
> 0 && b
->modtime
> 0
5613 && (st
.st_mtime
== b
->modtime
+ 1
5614 || st
.st_mtime
== b
->modtime
- 1)))
5619 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5620 Sclear_visited_file_modtime
, 0, 0, 0,
5621 doc
: /* Clear out records of last mod time of visited file.
5622 Next attempt to save will certainly not complain of a discrepancy. */)
5625 current_buffer
->modtime
= 0;
5629 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5630 Svisited_file_modtime
, 0, 0, 0,
5631 doc
: /* Return the current buffer's recorded visited file modification time.
5632 The value is a list of the form (HIGH LOW), like the time values
5633 that `file-attributes' returns. If the current buffer has no recorded
5634 file modification time, this function returns 0.
5635 See Info node `(elisp)Modification Time' for more details. */)
5639 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5641 return list2 (XCAR (tcons
), XCDR (tcons
));
5645 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5646 Sset_visited_file_modtime
, 0, 1, 0,
5647 doc
: /* Update buffer's recorded modification time from the visited file's time.
5648 Useful if the buffer was not read from the file normally
5649 or if the file itself has been changed for some known benign reason.
5650 An argument specifies the modification time value to use
5651 \(instead of that of the visited file), in the form of a list
5652 \(HIGH . LOW) or (HIGH LOW). */)
5654 Lisp_Object time_list
;
5656 if (!NILP (time_list
))
5657 current_buffer
->modtime
= cons_to_long (time_list
);
5660 register Lisp_Object filename
;
5662 Lisp_Object handler
;
5664 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5666 /* If the file name has special constructs in it,
5667 call the corresponding file handler. */
5668 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5669 if (!NILP (handler
))
5670 /* The handler can find the file name the same way we did. */
5671 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5673 filename
= ENCODE_FILE (filename
);
5675 if (stat (SDATA (filename
), &st
) >= 0)
5676 current_buffer
->modtime
= st
.st_mtime
;
5683 auto_save_error (error
)
5686 Lisp_Object args
[3], msg
;
5688 struct gcpro gcpro1
;
5690 ring_bell (XFRAME (selected_frame
));
5692 args
[0] = build_string ("Auto-saving %s: %s");
5693 args
[1] = current_buffer
->name
;
5694 args
[2] = Ferror_message_string (error
);
5695 msg
= Fformat (3, args
);
5697 nbytes
= SBYTES (msg
);
5699 for (i
= 0; i
< 3; ++i
)
5702 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5704 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5705 Fsleep_for (make_number (1), Qnil
);
5717 /* Get visited file's mode to become the auto save file's mode. */
5718 if (! NILP (current_buffer
->filename
)
5719 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5720 /* But make sure we can overwrite it later! */
5721 auto_save_mode_bits
= st
.st_mode
| 0600;
5723 auto_save_mode_bits
= 0666;
5726 Fwrite_region (Qnil
, Qnil
,
5727 current_buffer
->auto_save_file_name
,
5728 Qnil
, Qlambda
, Qnil
, Qnil
);
5732 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5737 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5738 | XFASTINT (XCDR (stream
))));
5743 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5746 minibuffer_auto_raise
= XINT (value
);
5751 do_auto_save_make_dir (dir
)
5754 return call2 (Qmake_directory
, dir
, Qt
);
5758 do_auto_save_eh (ignore
)
5764 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5765 doc
: /* Auto-save all buffers that need it.
5766 This is all buffers that have auto-saving enabled
5767 and are changed since last auto-saved.
5768 Auto-saving writes the buffer into a file
5769 so that your editing is not lost if the system crashes.
5770 This file is not the file you visited; that changes only when you save.
5771 Normally we run the normal hook `auto-save-hook' before saving.
5773 A non-nil NO-MESSAGE argument means do not print any message if successful.
5774 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5775 (no_message
, current_only
)
5776 Lisp_Object no_message
, current_only
;
5778 struct buffer
*old
= current_buffer
, *b
;
5779 Lisp_Object tail
, buf
;
5781 int do_handled_files
;
5784 Lisp_Object lispstream
;
5785 int count
= SPECPDL_INDEX ();
5786 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5787 int old_message_p
= 0;
5788 struct gcpro gcpro1
, gcpro2
;
5790 if (max_specpdl_size
< specpdl_size
+ 40)
5791 max_specpdl_size
= specpdl_size
+ 40;
5796 if (NILP (no_message
))
5798 old_message_p
= push_message ();
5799 record_unwind_protect (pop_message_unwind
, Qnil
);
5802 /* Ordinarily don't quit within this function,
5803 but don't make it impossible to quit (in case we get hung in I/O). */
5807 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5808 point to non-strings reached from Vbuffer_alist. */
5810 if (!NILP (Vrun_hooks
))
5811 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5813 if (STRINGP (Vauto_save_list_file_name
))
5815 Lisp_Object listfile
;
5817 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5819 /* Don't try to create the directory when shutting down Emacs,
5820 because creating the directory might signal an error, and
5821 that would leave Emacs in a strange state. */
5822 if (!NILP (Vrun_hooks
))
5826 GCPRO2 (dir
, listfile
);
5827 dir
= Ffile_name_directory (listfile
);
5828 if (NILP (Ffile_directory_p (dir
)))
5829 internal_condition_case_1 (do_auto_save_make_dir
,
5830 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5835 stream
= fopen (SDATA (listfile
), "w");
5838 /* Arrange to close that file whether or not we get an error.
5839 Also reset auto_saving to 0. */
5840 lispstream
= Fcons (Qnil
, Qnil
);
5841 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5842 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5853 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5854 record_unwind_protect (do_auto_save_unwind_1
,
5855 make_number (minibuffer_auto_raise
));
5856 minibuffer_auto_raise
= 0;
5859 /* On first pass, save all files that don't have handlers.
5860 On second pass, save all files that do have handlers.
5862 If Emacs is crashing, the handlers may tweak what is causing
5863 Emacs to crash in the first place, and it would be a shame if
5864 Emacs failed to autosave perfectly ordinary files because it
5865 couldn't handle some ange-ftp'd file. */
5867 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5868 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5870 buf
= XCDR (XCAR (tail
));
5873 /* Record all the buffers that have auto save mode
5874 in the special file that lists them. For each of these buffers,
5875 Record visited name (if any) and auto save name. */
5876 if (STRINGP (b
->auto_save_file_name
)
5877 && stream
!= NULL
&& do_handled_files
== 0)
5879 if (!NILP (b
->filename
))
5881 fwrite (SDATA (b
->filename
), 1,
5882 SBYTES (b
->filename
), stream
);
5884 putc ('\n', stream
);
5885 fwrite (SDATA (b
->auto_save_file_name
), 1,
5886 SBYTES (b
->auto_save_file_name
), stream
);
5887 putc ('\n', stream
);
5890 if (!NILP (current_only
)
5891 && b
!= current_buffer
)
5894 /* Don't auto-save indirect buffers.
5895 The base buffer takes care of it. */
5899 /* Check for auto save enabled
5900 and file changed since last auto save
5901 and file changed since last real save. */
5902 if (STRINGP (b
->auto_save_file_name
)
5903 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5904 && b
->auto_save_modified
< BUF_MODIFF (b
)
5905 /* -1 means we've turned off autosaving for a while--see below. */
5906 && XINT (b
->save_length
) >= 0
5907 && (do_handled_files
5908 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5911 EMACS_TIME before_time
, after_time
;
5913 EMACS_GET_TIME (before_time
);
5915 /* If we had a failure, don't try again for 20 minutes. */
5916 if (b
->auto_save_failure_time
>= 0
5917 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5920 if ((XFASTINT (b
->save_length
) * 10
5921 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5922 /* A short file is likely to change a large fraction;
5923 spare the user annoying messages. */
5924 && XFASTINT (b
->save_length
) > 5000
5925 /* These messages are frequent and annoying for `*mail*'. */
5926 && !EQ (b
->filename
, Qnil
)
5927 && NILP (no_message
))
5929 /* It has shrunk too much; turn off auto-saving here. */
5930 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5931 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5933 minibuffer_auto_raise
= 0;
5934 /* Turn off auto-saving until there's a real save,
5935 and prevent any more warnings. */
5936 XSETINT (b
->save_length
, -1);
5937 Fsleep_for (make_number (1), Qnil
);
5940 set_buffer_internal (b
);
5941 if (!auto_saved
&& NILP (no_message
))
5942 message1 ("Auto-saving...");
5943 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5945 b
->auto_save_modified
= BUF_MODIFF (b
);
5946 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5947 set_buffer_internal (old
);
5949 EMACS_GET_TIME (after_time
);
5951 /* If auto-save took more than 60 seconds,
5952 assume it was an NFS failure that got a timeout. */
5953 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5954 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5958 /* Prevent another auto save till enough input events come in. */
5959 record_auto_save ();
5961 if (auto_saved
&& NILP (no_message
))
5965 /* If we are going to restore an old message,
5966 give time to read ours. */
5967 sit_for (1, 0, 0, 0, 0);
5971 /* If we displayed a message and then restored a state
5972 with no message, leave a "done" message on the screen. */
5973 message1 ("Auto-saving...done");
5978 /* This restores the message-stack status. */
5979 unbind_to (count
, Qnil
);
5983 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5984 Sset_buffer_auto_saved
, 0, 0, 0,
5985 doc
: /* Mark current buffer as auto-saved with its current text.
5986 No auto-save file will be written until the buffer changes again. */)
5989 current_buffer
->auto_save_modified
= MODIFF
;
5990 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5991 current_buffer
->auto_save_failure_time
= -1;
5995 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5996 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5997 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6000 current_buffer
->auto_save_failure_time
= -1;
6004 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6006 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
6009 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6012 /* Reading and completing file names */
6013 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6015 /* In the string VAL, change each $ to $$ and return the result. */
6018 double_dollars (val
)
6021 register const unsigned char *old
;
6022 register unsigned char *new;
6026 osize
= SBYTES (val
);
6028 /* Count the number of $ characters. */
6029 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6030 if (*old
++ == '$') count
++;
6034 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6037 for (n
= osize
; n
> 0; n
--)
6051 read_file_name_cleanup (arg
)
6054 return (current_buffer
->directory
= arg
);
6057 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6059 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6060 (string
, dir
, action
)
6061 Lisp_Object string
, dir
, action
;
6062 /* action is nil for complete, t for return list of completions,
6063 lambda for verify final value */
6065 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6067 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6069 CHECK_STRING (string
);
6076 /* No need to protect ACTION--we only compare it with t and nil. */
6077 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6079 if (SCHARS (string
) == 0)
6081 if (EQ (action
, Qlambda
))
6089 orig_string
= string
;
6090 string
= Fsubstitute_in_file_name (string
);
6091 changed
= NILP (Fstring_equal (string
, orig_string
));
6092 name
= Ffile_name_nondirectory (string
);
6093 val
= Ffile_name_directory (string
);
6095 realdir
= Fexpand_file_name (val
, realdir
);
6100 specdir
= Ffile_name_directory (string
);
6101 val
= Ffile_name_completion (name
, realdir
);
6106 return double_dollars (string
);
6110 if (!NILP (specdir
))
6111 val
= concat2 (specdir
, val
);
6113 return double_dollars (val
);
6116 #endif /* not VMS */
6120 if (EQ (action
, Qt
))
6122 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6126 if (NILP (Vread_file_name_predicate
)
6127 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6131 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6133 /* Brute-force speed up for directory checking:
6134 Discard strings which don't end in a slash. */
6135 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6137 Lisp_Object tem
= XCAR (all
);
6139 if (STRINGP (tem
) &&
6140 (len
= SCHARS (tem
), len
> 0) &&
6141 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6142 comp
= Fcons (tem
, comp
);
6148 /* Must do it the hard (and slow) way. */
6149 GCPRO3 (all
, comp
, specdir
);
6150 count
= SPECPDL_INDEX ();
6151 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6152 current_buffer
->directory
= realdir
;
6153 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6154 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6155 comp
= Fcons (XCAR (all
), comp
);
6156 unbind_to (count
, Qnil
);
6159 return Fnreverse (comp
);
6162 /* Only other case actually used is ACTION = lambda */
6164 /* Supposedly this helps commands such as `cd' that read directory names,
6165 but can someone explain how it helps them? -- RMS */
6166 if (SCHARS (name
) == 0)
6169 string
= Fexpand_file_name (string
, dir
);
6170 if (!NILP (Vread_file_name_predicate
))
6171 return call1 (Vread_file_name_predicate
, string
);
6172 return Ffile_exists_p (string
);
6175 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6176 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6177 Value is not expanded---you must call `expand-file-name' yourself.
6178 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6179 the same non-empty string that was inserted by this function.
6180 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6181 except that if INITIAL is specified, that combined with DIR is used.)
6182 If the user exits with an empty minibuffer, this function returns
6183 an empty string. (This can only happen if the user erased the
6184 pre-inserted contents or if `insert-default-directory' is nil.)
6185 Fourth arg MUSTMATCH non-nil means require existing file's name.
6186 Non-nil and non-t means also require confirmation after completion.
6187 Fifth arg INITIAL specifies text to start with.
6188 If optional sixth arg PREDICATE is non-nil, possible completions and
6189 the resulting file name must satisfy (funcall PREDICATE NAME).
6190 DIR should be an absolute directory name. It defaults to the value of
6191 `default-directory'.
6193 If this command was invoked with the mouse, use a file dialog box if
6194 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6195 provides a file dialog box.
6197 See also `read-file-name-completion-ignore-case'
6198 and `read-file-name-function'. */)
6199 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6200 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6202 Lisp_Object val
, insdef
, tem
;
6203 struct gcpro gcpro1
, gcpro2
;
6204 register char *homedir
;
6205 Lisp_Object decoded_homedir
;
6206 int replace_in_history
= 0;
6207 int add_to_history
= 0;
6211 dir
= current_buffer
->directory
;
6212 if (NILP (Ffile_name_absolute_p (dir
)))
6213 dir
= Fexpand_file_name (dir
, Qnil
);
6214 if (NILP (default_filename
))
6217 ? Fexpand_file_name (initial
, dir
)
6218 : current_buffer
->filename
);
6220 /* If dir starts with user's homedir, change that to ~. */
6221 homedir
= (char *) egetenv ("HOME");
6223 /* homedir can be NULL in temacs, since Vprocess_environment is not
6224 yet set up. We shouldn't crash in that case. */
6227 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6228 CORRECT_DIR_SEPS (homedir
);
6233 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6236 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6237 SBYTES (decoded_homedir
))
6238 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6240 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6241 dir
= concat2 (build_string ("~"), dir
);
6243 /* Likewise for default_filename. */
6245 && STRINGP (default_filename
)
6246 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6247 SBYTES (decoded_homedir
))
6248 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6251 = Fsubstring (default_filename
,
6252 make_number (SCHARS (decoded_homedir
)), Qnil
);
6253 default_filename
= concat2 (build_string ("~"), default_filename
);
6255 if (!NILP (default_filename
))
6257 CHECK_STRING (default_filename
);
6258 default_filename
= double_dollars (default_filename
);
6261 if (insert_default_directory
&& STRINGP (dir
))
6264 if (!NILP (initial
))
6266 Lisp_Object args
[2], pos
;
6270 insdef
= Fconcat (2, args
);
6271 pos
= make_number (SCHARS (double_dollars (dir
)));
6272 insdef
= Fcons (double_dollars (insdef
), pos
);
6275 insdef
= double_dollars (insdef
);
6277 else if (STRINGP (initial
))
6278 insdef
= Fcons (double_dollars (initial
), make_number (0));
6282 if (!NILP (Vread_file_name_function
))
6284 Lisp_Object args
[7];
6286 GCPRO2 (insdef
, default_filename
);
6287 args
[0] = Vread_file_name_function
;
6290 args
[3] = default_filename
;
6291 args
[4] = mustmatch
;
6293 args
[6] = predicate
;
6294 RETURN_UNGCPRO (Ffuncall (7, args
));
6297 count
= SPECPDL_INDEX ();
6298 specbind (intern ("completion-ignore-case"),
6299 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6300 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6301 specbind (intern ("read-file-name-predicate"),
6302 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6304 GCPRO2 (insdef
, default_filename
);
6306 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (TARGET_API_MAC_CARBON)
6307 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6312 /* If DIR contains a file name, split it. */
6314 file
= Ffile_name_nondirectory (dir
);
6315 if (SCHARS (file
) && NILP (default_filename
))
6317 default_filename
= file
;
6318 dir
= Ffile_name_directory (dir
);
6320 if (!NILP(default_filename
))
6321 default_filename
= Fexpand_file_name (default_filename
, dir
);
6322 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6327 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6328 dir
, mustmatch
, insdef
,
6329 Qfile_name_history
, default_filename
, Qnil
);
6331 tem
= Fsymbol_value (Qfile_name_history
);
6332 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6333 replace_in_history
= 1;
6335 /* If Fcompleting_read returned the inserted default string itself
6336 (rather than a new string with the same contents),
6337 it has to mean that the user typed RET with the minibuffer empty.
6338 In that case, we really want to return ""
6339 so that commands such as set-visited-file-name can distinguish. */
6340 if (EQ (val
, default_filename
))
6342 /* In this case, Fcompleting_read has not added an element
6343 to the history. Maybe we should. */
6344 if (! replace_in_history
)
6350 unbind_to (count
, Qnil
);
6353 error ("No file name specified");
6355 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6357 if (!NILP (tem
) && !NILP (default_filename
))
6358 val
= default_filename
;
6359 val
= Fsubstitute_in_file_name (val
);
6361 if (replace_in_history
)
6362 /* Replace what Fcompleting_read added to the history
6363 with what we will actually return. */
6364 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6365 else if (add_to_history
)
6367 /* Add the value to the history--but not if it matches
6368 the last value already there. */
6369 Lisp_Object val1
= double_dollars (val
);
6370 tem
= Fsymbol_value (Qfile_name_history
);
6371 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6372 Fset (Qfile_name_history
,
6383 /* Must be set before any path manipulation is performed. */
6384 XSETFASTINT (Vdirectory_sep_char
, '/');
6391 Qexpand_file_name
= intern ("expand-file-name");
6392 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6393 Qdirectory_file_name
= intern ("directory-file-name");
6394 Qfile_name_directory
= intern ("file-name-directory");
6395 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6396 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6397 Qfile_name_as_directory
= intern ("file-name-as-directory");
6398 Qcopy_file
= intern ("copy-file");
6399 Qmake_directory_internal
= intern ("make-directory-internal");
6400 Qmake_directory
= intern ("make-directory");
6401 Qdelete_directory
= intern ("delete-directory");
6402 Qdelete_file
= intern ("delete-file");
6403 Qrename_file
= intern ("rename-file");
6404 Qadd_name_to_file
= intern ("add-name-to-file");
6405 Qmake_symbolic_link
= intern ("make-symbolic-link");
6406 Qfile_exists_p
= intern ("file-exists-p");
6407 Qfile_executable_p
= intern ("file-executable-p");
6408 Qfile_readable_p
= intern ("file-readable-p");
6409 Qfile_writable_p
= intern ("file-writable-p");
6410 Qfile_symlink_p
= intern ("file-symlink-p");
6411 Qaccess_file
= intern ("access-file");
6412 Qfile_directory_p
= intern ("file-directory-p");
6413 Qfile_regular_p
= intern ("file-regular-p");
6414 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6415 Qfile_modes
= intern ("file-modes");
6416 Qset_file_modes
= intern ("set-file-modes");
6417 Qset_file_times
= intern ("set-file-times");
6418 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6419 Qinsert_file_contents
= intern ("insert-file-contents");
6420 Qwrite_region
= intern ("write-region");
6421 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6422 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6423 Qauto_save_coding
= intern ("auto-save-coding");
6425 staticpro (&Qexpand_file_name
);
6426 staticpro (&Qsubstitute_in_file_name
);
6427 staticpro (&Qdirectory_file_name
);
6428 staticpro (&Qfile_name_directory
);
6429 staticpro (&Qfile_name_nondirectory
);
6430 staticpro (&Qunhandled_file_name_directory
);
6431 staticpro (&Qfile_name_as_directory
);
6432 staticpro (&Qcopy_file
);
6433 staticpro (&Qmake_directory_internal
);
6434 staticpro (&Qmake_directory
);
6435 staticpro (&Qdelete_directory
);
6436 staticpro (&Qdelete_file
);
6437 staticpro (&Qrename_file
);
6438 staticpro (&Qadd_name_to_file
);
6439 staticpro (&Qmake_symbolic_link
);
6440 staticpro (&Qfile_exists_p
);
6441 staticpro (&Qfile_executable_p
);
6442 staticpro (&Qfile_readable_p
);
6443 staticpro (&Qfile_writable_p
);
6444 staticpro (&Qaccess_file
);
6445 staticpro (&Qfile_symlink_p
);
6446 staticpro (&Qfile_directory_p
);
6447 staticpro (&Qfile_regular_p
);
6448 staticpro (&Qfile_accessible_directory_p
);
6449 staticpro (&Qfile_modes
);
6450 staticpro (&Qset_file_modes
);
6451 staticpro (&Qset_file_times
);
6452 staticpro (&Qfile_newer_than_file_p
);
6453 staticpro (&Qinsert_file_contents
);
6454 staticpro (&Qwrite_region
);
6455 staticpro (&Qverify_visited_file_modtime
);
6456 staticpro (&Qset_visited_file_modtime
);
6457 staticpro (&Qauto_save_coding
);
6459 Qfile_name_history
= intern ("file-name-history");
6460 Fset (Qfile_name_history
, Qnil
);
6461 staticpro (&Qfile_name_history
);
6463 Qfile_error
= intern ("file-error");
6464 staticpro (&Qfile_error
);
6465 Qfile_already_exists
= intern ("file-already-exists");
6466 staticpro (&Qfile_already_exists
);
6467 Qfile_date_error
= intern ("file-date-error");
6468 staticpro (&Qfile_date_error
);
6469 Qexcl
= intern ("excl");
6473 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6474 staticpro (&Qfind_buffer_file_type
);
6477 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6478 doc
: /* *Coding system for encoding file names.
6479 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6480 Vfile_name_coding_system
= Qnil
;
6482 DEFVAR_LISP ("default-file-name-coding-system",
6483 &Vdefault_file_name_coding_system
,
6484 doc
: /* Default coding system for encoding file names.
6485 This variable is used only when `file-name-coding-system' is nil.
6487 This variable is set/changed by the command `set-language-environment'.
6488 User should not set this variable manually,
6489 instead use `file-name-coding-system' to get a constant encoding
6490 of file names regardless of the current language environment. */);
6491 Vdefault_file_name_coding_system
= Qnil
;
6493 Qformat_decode
= intern ("format-decode");
6494 staticpro (&Qformat_decode
);
6495 Qformat_annotate_function
= intern ("format-annotate-function");
6496 staticpro (&Qformat_annotate_function
);
6497 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6498 staticpro (&Qafter_insert_file_set_coding
);
6500 Qcar_less_than_car
= intern ("car-less-than-car");
6501 staticpro (&Qcar_less_than_car
);
6503 Fput (Qfile_error
, Qerror_conditions
,
6504 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6505 Fput (Qfile_error
, Qerror_message
,
6506 build_string ("File error"));
6508 Fput (Qfile_already_exists
, Qerror_conditions
,
6509 Fcons (Qfile_already_exists
,
6510 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6511 Fput (Qfile_already_exists
, Qerror_message
,
6512 build_string ("File already exists"));
6514 Fput (Qfile_date_error
, Qerror_conditions
,
6515 Fcons (Qfile_date_error
,
6516 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6517 Fput (Qfile_date_error
, Qerror_message
,
6518 build_string ("Cannot set file date"));
6520 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6521 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6522 Vread_file_name_function
= Qnil
;
6524 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6525 doc
: /* Current predicate used by `read-file-name-internal'. */);
6526 Vread_file_name_predicate
= Qnil
;
6528 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6529 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6530 #if defined VMS || defined DOS_NT || defined MAC_OS
6531 read_file_name_completion_ignore_case
= 1;
6533 read_file_name_completion_ignore_case
= 0;
6536 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6537 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6538 If the initial minibuffer contents are non-empty, you can usually
6539 request a default filename by typing RETURN without editing. For some
6540 commands, exiting with an empty minibuffer has a special meaning,
6541 such as making the current buffer visit no file in the case of
6542 `set-visited-file-name'.
6543 If this variable is non-nil, the minibuffer contents are always
6544 initially non-empty and typing RETURN without editing will fetch the
6545 default name, if one is provided. Note however that this default name
6546 is not necessarily the name originally inserted in the minibuffer, if
6547 that is just the default directory.
6548 If this variable is nil, the minibuffer often starts out empty. In
6549 that case you may have to explicitly fetch the next history element to
6550 request the default name. */);
6551 insert_default_directory
= 1;
6553 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6554 doc
: /* *Non-nil means write new files with record format `stmlf'.
6555 nil means use format `var'. This variable is meaningful only on VMS. */);
6556 vms_stmlf_recfm
= 0;
6558 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6559 doc
: /* Directory separator character for built-in functions that return file names.
6560 The value is always ?/. Don't use this variable, just use `/'. */);
6562 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6563 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6564 If a file name matches REGEXP, then all I/O on that file is done by calling
6567 The first argument given to HANDLER is the name of the I/O primitive
6568 to be handled; the remaining arguments are the arguments that were
6569 passed to that primitive. For example, if you do
6570 (file-exists-p FILENAME)
6571 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6572 (funcall HANDLER 'file-exists-p FILENAME)
6573 The function `find-file-name-handler' checks this list for a handler
6574 for its argument. */);
6575 Vfile_name_handler_alist
= Qnil
;
6577 DEFVAR_LISP ("set-auto-coding-function",
6578 &Vset_auto_coding_function
,
6579 doc
: /* If non-nil, a function to call to decide a coding system of file.
6580 Two arguments are passed to this function: the file name
6581 and the length of a file contents following the point.
6582 This function should return a coding system to decode the file contents.
6583 It should check the file name against `auto-coding-alist'.
6584 If no coding system is decided, it should check a coding system
6585 specified in the heading lines with the format:
6586 -*- ... coding: CODING-SYSTEM; ... -*-
6587 or local variable spec of the tailing lines with `coding:' tag. */);
6588 Vset_auto_coding_function
= Qnil
;
6590 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6591 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6592 Each is passed one argument, the number of characters inserted.
6593 It should return the new character count, and leave point the same.
6594 If `insert-file-contents' is intercepted by a handler from
6595 `file-name-handler-alist', that handler is responsible for calling the
6596 functions in `after-insert-file-functions' if appropriate. */);
6597 Vafter_insert_file_functions
= Qnil
;
6599 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6600 doc
: /* A list of functions to be called at the start of `write-region'.
6601 Each is passed two arguments, START and END as for `write-region'.
6602 These are usually two numbers but not always; see the documentation
6603 for `write-region'. The function should return a list of pairs
6604 of the form (POSITION . STRING), consisting of strings to be effectively
6605 inserted at the specified positions of the file being written (1 means to
6606 insert before the first byte written). The POSITIONs must be sorted into
6607 increasing order. If there are several functions in the list, the several
6608 lists are merged destructively. Alternatively, the function can return
6609 with a different buffer current; in that case it should pay attention
6610 to the annotations returned by previous functions and listed in
6611 `write-region-annotations-so-far'.*/);
6612 Vwrite_region_annotate_functions
= Qnil
;
6613 staticpro (&Qwrite_region_annotate_functions
);
6614 Qwrite_region_annotate_functions
6615 = intern ("write-region-annotate-functions");
6617 DEFVAR_LISP ("write-region-annotations-so-far",
6618 &Vwrite_region_annotations_so_far
,
6619 doc
: /* When an annotation function is called, this holds the previous annotations.
6620 These are the annotations made by other annotation functions
6621 that were already called. See also `write-region-annotate-functions'. */);
6622 Vwrite_region_annotations_so_far
= Qnil
;
6624 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6625 doc
: /* A list of file name handlers that temporarily should not be used.
6626 This applies only to the operation `inhibit-file-name-operation'. */);
6627 Vinhibit_file_name_handlers
= Qnil
;
6629 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6630 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6631 Vinhibit_file_name_operation
= Qnil
;
6633 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6634 doc
: /* File name in which we write a list of all auto save file names.
6635 This variable is initialized automatically from `auto-save-list-file-prefix'
6636 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6637 a non-nil value. */);
6638 Vauto_save_list_file_name
= Qnil
;
6640 defsubr (&Sfind_file_name_handler
);
6641 defsubr (&Sfile_name_directory
);
6642 defsubr (&Sfile_name_nondirectory
);
6643 defsubr (&Sunhandled_file_name_directory
);
6644 defsubr (&Sfile_name_as_directory
);
6645 defsubr (&Sdirectory_file_name
);
6646 defsubr (&Smake_temp_name
);
6647 defsubr (&Sexpand_file_name
);
6648 defsubr (&Ssubstitute_in_file_name
);
6649 defsubr (&Scopy_file
);
6650 defsubr (&Smake_directory_internal
);
6651 defsubr (&Sdelete_directory
);
6652 defsubr (&Sdelete_file
);
6653 defsubr (&Srename_file
);
6654 defsubr (&Sadd_name_to_file
);
6656 defsubr (&Smake_symbolic_link
);
6657 #endif /* S_IFLNK */
6659 defsubr (&Sdefine_logical_name
);
6662 defsubr (&Ssysnetunam
);
6663 #endif /* HPUX_NET */
6664 defsubr (&Sfile_name_absolute_p
);
6665 defsubr (&Sfile_exists_p
);
6666 defsubr (&Sfile_executable_p
);
6667 defsubr (&Sfile_readable_p
);
6668 defsubr (&Sfile_writable_p
);
6669 defsubr (&Saccess_file
);
6670 defsubr (&Sfile_symlink_p
);
6671 defsubr (&Sfile_directory_p
);
6672 defsubr (&Sfile_accessible_directory_p
);
6673 defsubr (&Sfile_regular_p
);
6674 defsubr (&Sfile_modes
);
6675 defsubr (&Sset_file_modes
);
6676 defsubr (&Sset_file_times
);
6677 defsubr (&Sset_default_file_modes
);
6678 defsubr (&Sdefault_file_modes
);
6679 defsubr (&Sfile_newer_than_file_p
);
6680 defsubr (&Sinsert_file_contents
);
6681 defsubr (&Swrite_region
);
6682 defsubr (&Scar_less_than_car
);
6683 defsubr (&Sverify_visited_file_modtime
);
6684 defsubr (&Sclear_visited_file_modtime
);
6685 defsubr (&Svisited_file_modtime
);
6686 defsubr (&Sset_visited_file_modtime
);
6687 defsubr (&Sdo_auto_save
);
6688 defsubr (&Sset_buffer_auto_saved
);
6689 defsubr (&Sclear_buffer_auto_save_failure
);
6690 defsubr (&Srecent_auto_save_p
);
6692 defsubr (&Sread_file_name_internal
);
6693 defsubr (&Sread_file_name
);
6696 defsubr (&Sunix_sync
);
6700 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6701 (do not change this comment) */