1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000,01,03,2004
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
29 #include <sys/types.h>
36 #if !defined (S_ISLNK) && defined (S_IFLNK)
37 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
40 #if !defined (S_ISFIFO) && defined (S_IFIFO)
41 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
44 #if !defined (S_ISREG) && defined (S_IFREG)
45 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
76 #include "intervals.h"
82 #include "dispextern.h"
89 #endif /* not WINDOWSNT */
93 #include <sys/param.h>
101 #define CORRECT_DIR_SEPS(s) \
102 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
103 else unixtodos_filename (s); \
105 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
106 redirector allows the six letters between 'Z' and 'a' as well. */
108 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
111 #define IS_DRIVE(x) isalpha (x)
113 /* Need to lower-case the drive letter, or else expanded
114 filenames will sometimes compare inequal, because
115 `expand-file-name' doesn't always down-case the drive letter. */
116 #define DRIVE_LETTER(x) (tolower (x))
137 #include "commands.h"
138 extern int use_dialog_box
;
139 extern int use_file_dialog
;
153 /* Nonzero during writing of auto-save files */
156 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
157 a new file with the same mode as the original */
158 int auto_save_mode_bits
;
160 /* The symbol bound to coding-system-for-read when
161 insert-file-contents is called for recovering a file. This is not
162 an actual coding system name, but just an indicator to tell
163 insert-file-contents to use `emacs-mule' with a special flag for
164 auto saving and recovering a file. */
165 Lisp_Object Qauto_save_coding
;
167 /* Coding system for file names, or nil if none. */
168 Lisp_Object Vfile_name_coding_system
;
170 /* Coding system for file names used only when
171 Vfile_name_coding_system is nil. */
172 Lisp_Object Vdefault_file_name_coding_system
;
174 /* Alist of elements (REGEXP . HANDLER) for file names
175 whose I/O is done with a special handler. */
176 Lisp_Object Vfile_name_handler_alist
;
178 /* Format for auto-save files */
179 Lisp_Object Vauto_save_file_format
;
181 /* Lisp functions for translating file formats */
182 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
184 /* Function to be called to decide a coding system of a reading file. */
185 Lisp_Object Vset_auto_coding_function
;
187 /* Functions to be called to process text properties in inserted file. */
188 Lisp_Object Vafter_insert_file_functions
;
190 /* Lisp function for setting buffer-file-coding-system and the
191 multibyteness of the current buffer after inserting a file. */
192 Lisp_Object Qafter_insert_file_set_coding
;
194 /* Functions to be called to create text property annotations for file. */
195 Lisp_Object Vwrite_region_annotate_functions
;
196 Lisp_Object Qwrite_region_annotate_functions
;
198 /* During build_annotations, each time an annotation function is called,
199 this holds the annotations made by the previous functions. */
200 Lisp_Object Vwrite_region_annotations_so_far
;
202 /* File name in which we write a list of all our auto save files. */
203 Lisp_Object Vauto_save_list_file_name
;
205 /* Function to call to read a file name. */
206 Lisp_Object Vread_file_name_function
;
208 /* Current predicate used by read_file_name_internal. */
209 Lisp_Object Vread_file_name_predicate
;
211 /* Nonzero means completion ignores case when reading file name. */
212 int read_file_name_completion_ignore_case
;
214 /* Nonzero means, when reading a filename in the minibuffer,
215 start out by inserting the default directory into the minibuffer. */
216 int insert_default_directory
;
218 /* On VMS, nonzero means write new files with record format stmlf.
219 Zero means use var format. */
222 /* On NT, specifies the directory separator character, used (eg.) when
223 expanding file names. This can be bound to / or \. */
224 Lisp_Object Vdirectory_sep_char
;
226 extern Lisp_Object Vuser_login_name
;
229 extern Lisp_Object Vw32_get_true_file_attributes
;
232 extern int minibuf_level
;
234 extern int minibuffer_auto_raise
;
236 /* These variables describe handlers that have "already" had a chance
237 to handle the current operation.
239 Vinhibit_file_name_handlers is a list of file name handlers.
240 Vinhibit_file_name_operation is the operation being handled.
241 If we try to handle that operation, we ignore those handlers. */
243 static Lisp_Object Vinhibit_file_name_handlers
;
244 static Lisp_Object Vinhibit_file_name_operation
;
246 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
248 Lisp_Object Qfile_name_history
;
250 Lisp_Object Qcar_less_than_car
;
252 static int a_write
P_ ((int, Lisp_Object
, int, int,
253 Lisp_Object
*, struct coding_system
*));
254 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
258 report_file_error (string
, data
)
262 Lisp_Object errstring
;
265 synchronize_system_messages_locale ();
266 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
267 Vlocale_coding_system
, 0);
273 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
276 /* System error messages are capitalized. Downcase the initial
277 unless it is followed by a slash. */
278 if (SREF (errstring
, 1) != '/')
279 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
281 Fsignal (Qfile_error
,
282 Fcons (build_string (string
), Fcons (errstring
, data
)));
287 close_file_unwind (fd
)
290 emacs_close (XFASTINT (fd
));
294 /* Restore point, having saved it as a marker. */
297 restore_point_unwind (location
)
298 Lisp_Object location
;
300 Fgoto_char (location
);
301 Fset_marker (location
, Qnil
, Qnil
);
305 Lisp_Object Qexpand_file_name
;
306 Lisp_Object Qsubstitute_in_file_name
;
307 Lisp_Object Qdirectory_file_name
;
308 Lisp_Object Qfile_name_directory
;
309 Lisp_Object Qfile_name_nondirectory
;
310 Lisp_Object Qunhandled_file_name_directory
;
311 Lisp_Object Qfile_name_as_directory
;
312 Lisp_Object Qcopy_file
;
313 Lisp_Object Qmake_directory_internal
;
314 Lisp_Object Qmake_directory
;
315 Lisp_Object Qdelete_directory
;
316 Lisp_Object Qdelete_file
;
317 Lisp_Object Qrename_file
;
318 Lisp_Object Qadd_name_to_file
;
319 Lisp_Object Qmake_symbolic_link
;
320 Lisp_Object Qfile_exists_p
;
321 Lisp_Object Qfile_executable_p
;
322 Lisp_Object Qfile_readable_p
;
323 Lisp_Object Qfile_writable_p
;
324 Lisp_Object Qfile_symlink_p
;
325 Lisp_Object Qaccess_file
;
326 Lisp_Object Qfile_directory_p
;
327 Lisp_Object Qfile_regular_p
;
328 Lisp_Object Qfile_accessible_directory_p
;
329 Lisp_Object Qfile_modes
;
330 Lisp_Object Qset_file_modes
;
331 Lisp_Object Qset_file_times
;
332 Lisp_Object Qfile_newer_than_file_p
;
333 Lisp_Object Qinsert_file_contents
;
334 Lisp_Object Qwrite_region
;
335 Lisp_Object Qverify_visited_file_modtime
;
336 Lisp_Object Qset_visited_file_modtime
;
338 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
339 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
340 Otherwise, return nil.
341 A file name is handled if one of the regular expressions in
342 `file-name-handler-alist' matches it.
344 If OPERATION equals `inhibit-file-name-operation', then we ignore
345 any handlers that are members of `inhibit-file-name-handlers',
346 but we still do run any other handlers. This lets handlers
347 use the standard functions without calling themselves recursively. */)
348 (filename
, operation
)
349 Lisp_Object filename
, operation
;
351 /* This function must not munge the match data. */
352 Lisp_Object chain
, inhibited_handlers
, result
;
356 CHECK_STRING (filename
);
358 if (EQ (operation
, Vinhibit_file_name_operation
))
359 inhibited_handlers
= Vinhibit_file_name_handlers
;
361 inhibited_handlers
= Qnil
;
363 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
364 chain
= XCDR (chain
))
374 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
376 Lisp_Object handler
, tem
;
378 handler
= XCDR (elt
);
379 tem
= Fmemq (handler
, inhibited_handlers
);
393 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
395 doc
: /* Return the directory component in file name FILENAME.
396 Return nil if FILENAME does not include a directory.
397 Otherwise return a directory spec.
398 Given a Unix syntax file name, returns a string ending in slash;
399 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
401 Lisp_Object filename
;
404 register const unsigned char *beg
;
406 register unsigned char *beg
;
408 register const unsigned char *p
;
411 CHECK_STRING (filename
);
413 /* If the file name has special constructs in it,
414 call the corresponding file handler. */
415 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
417 return call2 (handler
, Qfile_name_directory
, filename
);
419 #ifdef FILE_SYSTEM_CASE
420 filename
= FILE_SYSTEM_CASE (filename
);
422 beg
= SDATA (filename
);
424 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
426 p
= beg
+ SBYTES (filename
);
428 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
430 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
433 /* only recognise drive specifier at the beginning */
435 /* handle the "/:d:foo" and "/:foo" cases correctly */
436 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
437 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
444 /* Expansion of "c:" to drive and default directory. */
447 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
448 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
449 unsigned char *r
= res
;
451 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
453 strncpy (res
, beg
, 2);
458 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
460 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
463 p
= beg
+ strlen (beg
);
466 CORRECT_DIR_SEPS (beg
);
469 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
472 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
473 Sfile_name_nondirectory
, 1, 1, 0,
474 doc
: /* Return file name FILENAME sans its directory.
475 For example, in a Unix-syntax file name,
476 this is everything after the last slash,
477 or the entire name if it contains no slash. */)
479 Lisp_Object filename
;
481 register const unsigned char *beg
, *p
, *end
;
484 CHECK_STRING (filename
);
486 /* If the file name has special constructs in it,
487 call the corresponding file handler. */
488 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
490 return call2 (handler
, Qfile_name_nondirectory
, filename
);
492 beg
= SDATA (filename
);
493 end
= p
= beg
+ SBYTES (filename
);
495 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
497 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
500 /* only recognise drive specifier at beginning */
502 /* handle the "/:d:foo" case correctly */
503 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
508 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
511 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
512 Sunhandled_file_name_directory
, 1, 1, 0,
513 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
514 A `directly usable' directory name is one that may be used without the
515 intervention of any file handler.
516 If FILENAME is a directly usable file itself, return
517 \(file-name-directory FILENAME).
518 The `call-process' and `start-process' functions use this function to
519 get a current directory to run processes in. */)
521 Lisp_Object filename
;
525 /* If the file name has special constructs in it,
526 call the corresponding file handler. */
527 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
529 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
531 return Ffile_name_directory (filename
);
536 file_name_as_directory (out
, in
)
539 int size
= strlen (in
) - 1;
552 /* Is it already a directory string? */
553 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
555 /* Is it a VMS directory file name? If so, hack VMS syntax. */
556 else if (! index (in
, '/')
557 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
558 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
559 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
560 || ! strncmp (&in
[size
- 5], ".dir", 4))
561 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
562 && in
[size
] == '1')))
564 register char *p
, *dot
;
568 dir:x.dir --> dir:[x]
569 dir:[x]y.dir --> dir:[x.y] */
571 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
574 strncpy (out
, in
, p
- in
);
593 dot
= index (p
, '.');
596 /* blindly remove any extension */
597 size
= strlen (out
) + (dot
- p
);
598 strncat (out
, p
, dot
- p
);
609 /* For Unix syntax, Append a slash if necessary */
610 if (!IS_DIRECTORY_SEP (out
[size
]))
612 /* Cannot use DIRECTORY_SEP, which could have any value */
614 out
[size
+ 2] = '\0';
617 CORRECT_DIR_SEPS (out
);
623 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
624 Sfile_name_as_directory
, 1, 1, 0,
625 doc
: /* Return a string representing the file name FILE interpreted as a directory.
626 This operation exists because a directory is also a file, but its name as
627 a directory is different from its name as a file.
628 The result can be used as the value of `default-directory'
629 or passed as second argument to `expand-file-name'.
630 For a Unix-syntax file name, just appends a slash.
631 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
642 /* If the file name has special constructs in it,
643 call the corresponding file handler. */
644 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
646 return call2 (handler
, Qfile_name_as_directory
, file
);
648 buf
= (char *) alloca (SBYTES (file
) + 10);
649 file_name_as_directory (buf
, SDATA (file
));
650 return make_specified_string (buf
, -1, strlen (buf
),
651 STRING_MULTIBYTE (file
));
655 * Convert from directory name to filename.
657 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
658 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
659 * On UNIX, it's simple: just make sure there isn't a terminating /
661 * Value is nonzero if the string output is different from the input.
665 directory_file_name (src
, dst
)
673 struct FAB fab
= cc$rms_fab
;
674 struct NAM nam
= cc$rms_nam
;
675 char esa
[NAM$C_MAXRSS
];
680 if (! index (src
, '/')
681 && (src
[slen
- 1] == ']'
682 || src
[slen
- 1] == ':'
683 || src
[slen
- 1] == '>'))
685 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
687 fab
.fab$b_fns
= slen
;
688 fab
.fab$l_nam
= &nam
;
689 fab
.fab$l_fop
= FAB$M_NAM
;
692 nam
.nam$b_ess
= sizeof esa
;
693 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
695 /* We call SYS$PARSE to handle such things as [--] for us. */
696 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
698 slen
= nam
.nam$b_esl
;
699 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
704 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
706 /* what about when we have logical_name:???? */
707 if (src
[slen
- 1] == ':')
708 { /* Xlate logical name and see what we get */
709 ptr
= strcpy (dst
, src
); /* upper case for getenv */
712 if ('a' <= *ptr
&& *ptr
<= 'z')
716 dst
[slen
- 1] = 0; /* remove colon */
717 if (!(src
= egetenv (dst
)))
719 /* should we jump to the beginning of this procedure?
720 Good points: allows us to use logical names that xlate
722 Bad points: can be a problem if we just translated to a device
724 For now, I'll punt and always expect VMS names, and hope for
727 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
728 { /* no recursion here! */
734 { /* not a directory spec */
739 bracket
= src
[slen
- 1];
741 /* If bracket is ']' or '>', bracket - 2 is the corresponding
743 ptr
= index (src
, bracket
- 2);
745 { /* no opening bracket */
749 if (!(rptr
= rindex (src
, '.')))
752 strncpy (dst
, src
, slen
);
756 dst
[slen
++] = bracket
;
761 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
762 then translate the device and recurse. */
763 if (dst
[slen
- 1] == ':'
764 && dst
[slen
- 2] != ':' /* skip decnet nodes */
765 && strcmp (src
+ slen
, "[000000]") == 0)
767 dst
[slen
- 1] = '\0';
768 if ((ptr
= egetenv (dst
))
769 && (rlen
= strlen (ptr
) - 1) > 0
770 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
771 && ptr
[rlen
- 1] == '.')
773 char * buf
= (char *) alloca (strlen (ptr
) + 1);
777 return directory_file_name (buf
, dst
);
782 strcat (dst
, "[000000]");
786 rlen
= strlen (rptr
) - 1;
787 strncat (dst
, rptr
, rlen
);
788 dst
[slen
+ rlen
] = '\0';
789 strcat (dst
, ".DIR.1");
793 /* Process as Unix format: just remove any final slash.
794 But leave "/" unchanged; do not change it to "". */
797 /* Handle // as root for apollo's. */
798 if ((slen
> 2 && dst
[slen
- 1] == '/')
799 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
803 && IS_DIRECTORY_SEP (dst
[slen
- 1])
805 && !IS_ANY_SEP (dst
[slen
- 2])
811 CORRECT_DIR_SEPS (dst
);
816 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
818 doc
: /* Returns the file name of the directory named DIRECTORY.
819 This is the name of the file that holds the data for the directory DIRECTORY.
820 This operation exists because a directory is also a file, but its name as
821 a directory is different from its name as a file.
822 In Unix-syntax, this function just removes the final slash.
823 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
824 it returns a file name such as \"[X]Y.DIR.1\". */)
826 Lisp_Object directory
;
831 CHECK_STRING (directory
);
833 if (NILP (directory
))
836 /* If the file name has special constructs in it,
837 call the corresponding file handler. */
838 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
840 return call2 (handler
, Qdirectory_file_name
, directory
);
843 /* 20 extra chars is insufficient for VMS, since we might perform a
844 logical name translation. an equivalence string can be up to 255
845 chars long, so grab that much extra space... - sss */
846 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
848 buf
= (char *) alloca (SBYTES (directory
) + 20);
850 directory_file_name (SDATA (directory
), buf
);
851 return make_specified_string (buf
, -1, strlen (buf
),
852 STRING_MULTIBYTE (directory
));
855 static char make_temp_name_tbl
[64] =
857 'A','B','C','D','E','F','G','H',
858 'I','J','K','L','M','N','O','P',
859 'Q','R','S','T','U','V','W','X',
860 'Y','Z','a','b','c','d','e','f',
861 'g','h','i','j','k','l','m','n',
862 'o','p','q','r','s','t','u','v',
863 'w','x','y','z','0','1','2','3',
864 '4','5','6','7','8','9','-','_'
867 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
869 /* Value is a temporary file name starting with PREFIX, a string.
871 The Emacs process number forms part of the result, so there is
872 no danger of generating a name being used by another process.
873 In addition, this function makes an attempt to choose a name
874 which has no existing file. To make this work, PREFIX should be
875 an absolute file name.
877 BASE64_P non-zero means add the pid as 3 characters in base64
878 encoding. In this case, 6 characters will be added to PREFIX to
879 form the file name. Otherwise, if Emacs is running on a system
880 with long file names, add the pid as a decimal number.
882 This function signals an error if no unique file name could be
886 make_temp_name (prefix
, base64_p
)
893 unsigned char *p
, *data
;
897 CHECK_STRING (prefix
);
899 /* VAL is created by adding 6 characters to PREFIX. The first
900 three are the PID of this process, in base 64, and the second
901 three are incremented if the file already exists. This ensures
902 262144 unique file names per PID per PREFIX. */
904 pid
= (int) getpid ();
908 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
909 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
910 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
915 #ifdef HAVE_LONG_FILE_NAMES
916 sprintf (pidbuf
, "%d", pid
);
917 pidlen
= strlen (pidbuf
);
919 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
920 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
921 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
926 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
927 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
928 if (!STRING_MULTIBYTE (prefix
))
929 STRING_SET_UNIBYTE (val
);
931 bcopy(SDATA (prefix
), data
, len
);
934 bcopy (pidbuf
, p
, pidlen
);
937 /* Here we try to minimize useless stat'ing when this function is
938 invoked many times successively with the same PREFIX. We achieve
939 this by initializing count to a random value, and incrementing it
942 We don't want make-temp-name to be called while dumping,
943 because then make_temp_name_count_initialized_p would get set
944 and then make_temp_name_count would not be set when Emacs starts. */
946 if (!make_temp_name_count_initialized_p
)
948 make_temp_name_count
= (unsigned) time (NULL
);
949 make_temp_name_count_initialized_p
= 1;
955 unsigned num
= make_temp_name_count
;
957 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
958 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
959 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
961 /* Poor man's congruential RN generator. Replace with
962 ++make_temp_name_count for debugging. */
963 make_temp_name_count
+= 25229;
964 make_temp_name_count
%= 225307;
966 if (stat (data
, &ignored
) < 0)
968 /* We want to return only if errno is ENOENT. */
972 /* The error here is dubious, but there is little else we
973 can do. The alternatives are to return nil, which is
974 as bad as (and in many cases worse than) throwing the
975 error, or to ignore the error, which will likely result
976 in looping through 225307 stat's, which is not only
977 dog-slow, but also useless since it will fallback to
978 the errow below, anyway. */
979 report_file_error ("Cannot create temporary name for prefix",
980 Fcons (prefix
, Qnil
));
985 error ("Cannot create temporary name for prefix `%s'",
991 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
992 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
993 The Emacs process number forms part of the result,
994 so there is no danger of generating a name being used by another process.
996 In addition, this function makes an attempt to choose a name
997 which has no existing file. To make this work,
998 PREFIX should be an absolute file name.
1000 There is a race condition between calling `make-temp-name' and creating the
1001 file which opens all kinds of security holes. For that reason, you should
1002 probably use `make-temp-file' instead, except in three circumstances:
1004 * If you are creating the file in the user's home directory.
1005 * If you are creating a directory rather than an ordinary file.
1006 * If you are taking special precautions as `make-temp-file' does. */)
1010 return make_temp_name (prefix
, 0);
1015 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1016 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1017 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1018 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1019 the current buffer's value of default-directory is used.
1020 File name components that are `.' are removed, and
1021 so are file name components followed by `..', along with the `..' itself;
1022 note that these simplifications are done without checking the resulting
1023 file names in the file system.
1024 An initial `~/' expands to your home directory.
1025 An initial `~USER/' expands to USER's home directory.
1026 See also the function `substitute-in-file-name'. */)
1027 (name
, default_directory
)
1028 Lisp_Object name
, default_directory
;
1032 register unsigned char *newdir
, *p
, *o
;
1034 unsigned char *target
;
1037 unsigned char * colon
= 0;
1038 unsigned char * close
= 0;
1039 unsigned char * slash
= 0;
1040 unsigned char * brack
= 0;
1041 int lbrack
= 0, rbrack
= 0;
1046 int collapse_newdir
= 1;
1050 Lisp_Object handler
, result
;
1052 CHECK_STRING (name
);
1054 /* If the file name has special constructs in it,
1055 call the corresponding file handler. */
1056 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1057 if (!NILP (handler
))
1058 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1060 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1061 if (NILP (default_directory
))
1062 default_directory
= current_buffer
->directory
;
1063 if (! STRINGP (default_directory
))
1066 /* "/" is not considered a root directory on DOS_NT, so using "/"
1067 here causes an infinite recursion in, e.g., the following:
1069 (let (default-directory)
1070 (expand-file-name "a"))
1072 To avoid this, we set default_directory to the root of the
1074 extern char *emacs_root_dir (void);
1076 default_directory
= build_string (emacs_root_dir ());
1078 default_directory
= build_string ("/");
1082 if (!NILP (default_directory
))
1084 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1085 if (!NILP (handler
))
1086 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1089 o
= SDATA (default_directory
);
1091 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1092 It would be better to do this down below where we actually use
1093 default_directory. Unfortunately, calling Fexpand_file_name recursively
1094 could invoke GC, and the strings might be relocated. This would
1095 be annoying because we have pointers into strings lying around
1096 that would need adjusting, and people would add new pointers to
1097 the code and forget to adjust them, resulting in intermittent bugs.
1098 Putting this call here avoids all that crud.
1100 The EQ test avoids infinite recursion. */
1101 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1102 /* Save time in some common cases - as long as default_directory
1103 is not relative, it can be canonicalized with name below (if it
1104 is needed at all) without requiring it to be expanded now. */
1106 /* Detect MSDOS file names with drive specifiers. */
1107 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1109 /* Detect Windows file names in UNC format. */
1110 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1112 #else /* not DOS_NT */
1113 /* Detect Unix absolute file names (/... alone is not absolute on
1115 && ! (IS_DIRECTORY_SEP (o
[0]))
1116 #endif /* not DOS_NT */
1119 struct gcpro gcpro1
;
1122 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1127 /* Filenames on VMS are always upper case. */
1128 name
= Fupcase (name
);
1130 #ifdef FILE_SYSTEM_CASE
1131 name
= FILE_SYSTEM_CASE (name
);
1137 /* We will force directory separators to be either all \ or /, so make
1138 a local copy to modify, even if there ends up being no change. */
1139 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1141 /* Note if special escape prefix is present, but remove for now. */
1142 if (nm
[0] == '/' && nm
[1] == ':')
1148 /* Find and remove drive specifier if present; this makes nm absolute
1149 even if the rest of the name appears to be relative. Only look for
1150 drive specifier at the beginning. */
1151 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1158 /* If we see "c://somedir", we want to strip the first slash after the
1159 colon when stripping the drive letter. Otherwise, this expands to
1161 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1163 #endif /* WINDOWSNT */
1167 /* Discard any previous drive specifier if nm is now in UNC format. */
1168 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1174 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1175 none are found, we can probably return right away. We will avoid
1176 allocating a new string if name is already fully expanded. */
1178 IS_DIRECTORY_SEP (nm
[0])
1180 && drive
&& !is_escaped
1183 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1190 /* If it turns out that the filename we want to return is just a
1191 suffix of FILENAME, we don't need to go through and edit
1192 things; we just need to construct a new string using data
1193 starting at the middle of FILENAME. If we set lose to a
1194 non-zero value, that means we've discovered that we can't do
1201 /* Since we know the name is absolute, we can assume that each
1202 element starts with a "/". */
1204 /* "." and ".." are hairy. */
1205 if (IS_DIRECTORY_SEP (p
[0])
1207 && (IS_DIRECTORY_SEP (p
[2])
1209 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1212 /* We want to replace multiple `/' in a row with a single
1215 && IS_DIRECTORY_SEP (p
[0])
1216 && IS_DIRECTORY_SEP (p
[1]))
1223 /* if dev:[dir]/, move nm to / */
1224 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1225 nm
= (brack
? brack
+ 1 : colon
+ 1);
1226 lbrack
= rbrack
= 0;
1234 /* VMS pre V4.4,convert '-'s in filenames. */
1235 if (lbrack
== rbrack
)
1237 if (dots
< 2) /* this is to allow negative version numbers */
1242 if (lbrack
> rbrack
&&
1243 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1244 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1250 /* count open brackets, reset close bracket pointer */
1251 if (p
[0] == '[' || p
[0] == '<')
1252 lbrack
++, brack
= 0;
1253 /* count close brackets, set close bracket pointer */
1254 if (p
[0] == ']' || p
[0] == '>')
1255 rbrack
++, brack
= p
;
1256 /* detect ][ or >< */
1257 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1259 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1260 nm
= p
+ 1, lose
= 1;
1261 if (p
[0] == ':' && (colon
|| slash
))
1262 /* if dev1:[dir]dev2:, move nm to dev2: */
1268 /* if /name/dev:, move nm to dev: */
1271 /* if node::dev:, move colon following dev */
1272 else if (colon
&& colon
[-1] == ':')
1274 /* if dev1:dev2:, move nm to dev2: */
1275 else if (colon
&& colon
[-1] != ':')
1280 if (p
[0] == ':' && !colon
)
1286 if (lbrack
== rbrack
)
1289 else if (p
[0] == '.')
1297 if (index (nm
, '/'))
1299 nm
= sys_translate_unix (nm
);
1300 return make_specified_string (nm
, -1, strlen (nm
),
1301 STRING_MULTIBYTE (name
));
1305 /* Make sure directories are all separated with / or \ as
1306 desired, but avoid allocation of a new string when not
1308 CORRECT_DIR_SEPS (nm
);
1310 if (IS_DIRECTORY_SEP (nm
[1]))
1312 if (strcmp (nm
, SDATA (name
)) != 0)
1313 name
= make_specified_string (nm
, -1, strlen (nm
),
1314 STRING_MULTIBYTE (name
));
1318 /* drive must be set, so this is okay */
1319 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1323 name
= make_specified_string (nm
, -1, p
- nm
,
1324 STRING_MULTIBYTE (name
));
1325 temp
[0] = DRIVE_LETTER (drive
);
1326 name
= concat2 (build_string (temp
), name
);
1329 #else /* not DOS_NT */
1330 if (nm
== SDATA (name
))
1332 return make_specified_string (nm
, -1, strlen (nm
),
1333 STRING_MULTIBYTE (name
));
1334 #endif /* not DOS_NT */
1338 /* At this point, nm might or might not be an absolute file name. We
1339 need to expand ~ or ~user if present, otherwise prefix nm with
1340 default_directory if nm is not absolute, and finally collapse /./
1341 and /foo/../ sequences.
1343 We set newdir to be the appropriate prefix if one is needed:
1344 - the relevant user directory if nm starts with ~ or ~user
1345 - the specified drive's working dir (DOS/NT only) if nm does not
1347 - the value of default_directory.
1349 Note that these prefixes are not guaranteed to be absolute (except
1350 for the working dir of a drive). Therefore, to ensure we always
1351 return an absolute name, if the final prefix is not absolute we
1352 append it to the current working directory. */
1356 if (nm
[0] == '~') /* prefix ~ */
1358 if (IS_DIRECTORY_SEP (nm
[1])
1362 || nm
[1] == 0) /* ~ by itself */
1364 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1365 newdir
= (unsigned char *) "";
1368 collapse_newdir
= 0;
1371 nm
++; /* Don't leave the slash in nm. */
1374 else /* ~user/filename */
1376 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1381 o
= (unsigned char *) alloca (p
- nm
+ 1);
1382 bcopy ((char *) nm
, o
, p
- nm
);
1385 pw
= (struct passwd
*) getpwnam (o
+ 1);
1388 newdir
= (unsigned char *) pw
-> pw_dir
;
1390 nm
= p
+ 1; /* skip the terminator */
1394 collapse_newdir
= 0;
1399 /* If we don't find a user of that name, leave the name
1400 unchanged; don't move nm forward to p. */
1405 /* On DOS and Windows, nm is absolute if a drive name was specified;
1406 use the drive's current directory as the prefix if needed. */
1407 if (!newdir
&& drive
)
1409 /* Get default directory if needed to make nm absolute. */
1410 if (!IS_DIRECTORY_SEP (nm
[0]))
1412 newdir
= alloca (MAXPATHLEN
+ 1);
1413 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1418 /* Either nm starts with /, or drive isn't mounted. */
1419 newdir
= alloca (4);
1420 newdir
[0] = DRIVE_LETTER (drive
);
1428 /* Finally, if no prefix has been specified and nm is not absolute,
1429 then it must be expanded relative to default_directory. */
1433 /* /... alone is not absolute on DOS and Windows. */
1434 && !IS_DIRECTORY_SEP (nm
[0])
1437 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1444 newdir
= SDATA (default_directory
);
1446 /* Note if special escape prefix is present, but remove for now. */
1447 if (newdir
[0] == '/' && newdir
[1] == ':')
1458 /* First ensure newdir is an absolute name. */
1460 /* Detect MSDOS file names with drive specifiers. */
1461 ! (IS_DRIVE (newdir
[0])
1462 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1464 /* Detect Windows file names in UNC format. */
1465 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1469 /* Effectively, let newdir be (expand-file-name newdir cwd).
1470 Because of the admonition against calling expand-file-name
1471 when we have pointers into lisp strings, we accomplish this
1472 indirectly by prepending newdir to nm if necessary, and using
1473 cwd (or the wd of newdir's drive) as the new newdir. */
1475 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1480 if (!IS_DIRECTORY_SEP (nm
[0]))
1482 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1483 file_name_as_directory (tmp
, newdir
);
1487 newdir
= alloca (MAXPATHLEN
+ 1);
1490 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1497 /* Strip off drive name from prefix, if present. */
1498 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1504 /* Keep only a prefix from newdir if nm starts with slash
1505 (//server/share for UNC, nothing otherwise). */
1506 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1509 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1511 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1513 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1515 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1527 /* Get rid of any slash at the end of newdir, unless newdir is
1528 just / or // (an incomplete UNC name). */
1529 length
= strlen (newdir
);
1530 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1532 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1536 unsigned char *temp
= (unsigned char *) alloca (length
);
1537 bcopy (newdir
, temp
, length
- 1);
1538 temp
[length
- 1] = 0;
1546 /* Now concatenate the directory and name to new space in the stack frame */
1547 tlen
+= strlen (nm
) + 1;
1549 /* Reserve space for drive specifier and escape prefix, since either
1550 or both may need to be inserted. (The Microsoft x86 compiler
1551 produces incorrect code if the following two lines are combined.) */
1552 target
= (unsigned char *) alloca (tlen
+ 4);
1554 #else /* not DOS_NT */
1555 target
= (unsigned char *) alloca (tlen
);
1556 #endif /* not DOS_NT */
1562 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1565 /* If newdir is effectively "C:/", then the drive letter will have
1566 been stripped and newdir will be "/". Concatenating with an
1567 absolute directory in nm produces "//", which will then be
1568 incorrectly treated as a network share. Ignore newdir in
1569 this case (keeping the drive letter). */
1570 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1571 && newdir
[1] == '\0'))
1573 strcpy (target
, newdir
);
1577 file_name_as_directory (target
, newdir
);
1580 strcat (target
, nm
);
1582 if (index (target
, '/'))
1583 strcpy (target
, sys_translate_unix (target
));
1586 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1588 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1597 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1603 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1604 /* brackets are offset from each other by 2 */
1607 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1608 /* convert [foo][bar] to [bar] */
1609 while (o
[-1] != '[' && o
[-1] != '<')
1611 else if (*p
== '-' && *o
!= '.')
1614 else if (p
[0] == '-' && o
[-1] == '.' &&
1615 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1616 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1620 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1621 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1623 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1625 /* else [foo.-] ==> [-] */
1631 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1632 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1638 if (!IS_DIRECTORY_SEP (*p
))
1642 else if (IS_DIRECTORY_SEP (p
[0])
1644 && (IS_DIRECTORY_SEP (p
[2])
1647 /* If "/." is the entire filename, keep the "/". Otherwise,
1648 just delete the whole "/.". */
1649 if (o
== target
&& p
[2] == '\0')
1653 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1654 /* `/../' is the "superroot" on certain file systems. */
1656 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1658 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1660 /* Keep initial / only if this is the whole name. */
1661 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1666 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1668 /* Collapse multiple `/' in a row. */
1670 while (IS_DIRECTORY_SEP (*p
))
1677 #endif /* not VMS */
1681 /* At last, set drive name. */
1683 /* Except for network file name. */
1684 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1685 #endif /* WINDOWSNT */
1687 if (!drive
) abort ();
1689 target
[0] = DRIVE_LETTER (drive
);
1692 /* Reinsert the escape prefix if required. */
1699 CORRECT_DIR_SEPS (target
);
1702 result
= make_specified_string (target
, -1, o
- target
,
1703 STRING_MULTIBYTE (name
));
1705 /* Again look to see if the file name has special constructs in it
1706 and perhaps call the corresponding file handler. This is needed
1707 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1708 the ".." component gives us "/user@host:/bar/../baz" which needs
1709 to be expanded again. */
1710 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1711 if (!NILP (handler
))
1712 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1718 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1719 This is the old version of expand-file-name, before it was thoroughly
1720 rewritten for Emacs 10.31. We leave this version here commented-out,
1721 because the code is very complex and likely to have subtle bugs. If
1722 bugs _are_ found, it might be of interest to look at the old code and
1723 see what did it do in the relevant situation.
1725 Don't remove this code: it's true that it will be accessible via CVS,
1726 but a few years from deletion, people will forget it is there. */
1728 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1729 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1730 "Convert FILENAME to absolute, and canonicalize it.\n\
1731 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1732 (does not start with slash); if DEFAULT is nil or missing,\n\
1733 the current buffer's value of default-directory is used.\n\
1734 Filenames containing `.' or `..' as components are simplified;\n\
1735 initial `~/' expands to your home directory.\n\
1736 See also the function `substitute-in-file-name'.")
1738 Lisp_Object name
, defalt
;
1742 register unsigned char *newdir
, *p
, *o
;
1744 unsigned char *target
;
1748 unsigned char * colon
= 0;
1749 unsigned char * close
= 0;
1750 unsigned char * slash
= 0;
1751 unsigned char * brack
= 0;
1752 int lbrack
= 0, rbrack
= 0;
1756 CHECK_STRING (name
);
1759 /* Filenames on VMS are always upper case. */
1760 name
= Fupcase (name
);
1765 /* If nm is absolute, flush ...// and detect /./ and /../.
1766 If no /./ or /../ we can return right away. */
1778 if (p
[0] == '/' && p
[1] == '/'
1780 /* // at start of filename is meaningful on Apollo system. */
1785 if (p
[0] == '/' && p
[1] == '~')
1786 nm
= p
+ 1, lose
= 1;
1787 if (p
[0] == '/' && p
[1] == '.'
1788 && (p
[2] == '/' || p
[2] == 0
1789 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1795 /* if dev:[dir]/, move nm to / */
1796 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1797 nm
= (brack
? brack
+ 1 : colon
+ 1);
1798 lbrack
= rbrack
= 0;
1806 /* VMS pre V4.4,convert '-'s in filenames. */
1807 if (lbrack
== rbrack
)
1809 if (dots
< 2) /* this is to allow negative version numbers */
1814 if (lbrack
> rbrack
&&
1815 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1816 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1822 /* count open brackets, reset close bracket pointer */
1823 if (p
[0] == '[' || p
[0] == '<')
1824 lbrack
++, brack
= 0;
1825 /* count close brackets, set close bracket pointer */
1826 if (p
[0] == ']' || p
[0] == '>')
1827 rbrack
++, brack
= p
;
1828 /* detect ][ or >< */
1829 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1831 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1832 nm
= p
+ 1, lose
= 1;
1833 if (p
[0] == ':' && (colon
|| slash
))
1834 /* if dev1:[dir]dev2:, move nm to dev2: */
1840 /* If /name/dev:, move nm to dev: */
1843 /* If node::dev:, move colon following dev */
1844 else if (colon
&& colon
[-1] == ':')
1846 /* If dev1:dev2:, move nm to dev2: */
1847 else if (colon
&& colon
[-1] != ':')
1852 if (p
[0] == ':' && !colon
)
1858 if (lbrack
== rbrack
)
1861 else if (p
[0] == '.')
1869 if (index (nm
, '/'))
1870 return build_string (sys_translate_unix (nm
));
1872 if (nm
== SDATA (name
))
1874 return build_string (nm
);
1878 /* Now determine directory to start with and put it in NEWDIR */
1882 if (nm
[0] == '~') /* prefix ~ */
1887 || nm
[1] == 0)/* ~/filename */
1889 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1890 newdir
= (unsigned char *) "";
1893 nm
++; /* Don't leave the slash in nm. */
1896 else /* ~user/filename */
1898 /* Get past ~ to user */
1899 unsigned char *user
= nm
+ 1;
1900 /* Find end of name. */
1901 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1902 int len
= ptr
? ptr
- user
: strlen (user
);
1904 unsigned char *ptr1
= index (user
, ':');
1905 if (ptr1
!= 0 && ptr1
- user
< len
)
1908 /* Copy the user name into temp storage. */
1909 o
= (unsigned char *) alloca (len
+ 1);
1910 bcopy ((char *) user
, o
, len
);
1913 /* Look up the user name. */
1914 pw
= (struct passwd
*) getpwnam (o
+ 1);
1916 error ("\"%s\" isn't a registered user", o
+ 1);
1918 newdir
= (unsigned char *) pw
->pw_dir
;
1920 /* Discard the user name from NM. */
1927 #endif /* not VMS */
1931 defalt
= current_buffer
->directory
;
1932 CHECK_STRING (defalt
);
1933 newdir
= SDATA (defalt
);
1936 /* Now concatenate the directory and name to new space in the stack frame */
1938 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1939 target
= (unsigned char *) alloca (tlen
);
1945 if (nm
[0] == 0 || nm
[0] == '/')
1946 strcpy (target
, newdir
);
1949 file_name_as_directory (target
, newdir
);
1952 strcat (target
, nm
);
1954 if (index (target
, '/'))
1955 strcpy (target
, sys_translate_unix (target
));
1958 /* Now canonicalize by removing /. and /foo/.. if they appear */
1966 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1972 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1973 /* brackets are offset from each other by 2 */
1976 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1977 /* convert [foo][bar] to [bar] */
1978 while (o
[-1] != '[' && o
[-1] != '<')
1980 else if (*p
== '-' && *o
!= '.')
1983 else if (p
[0] == '-' && o
[-1] == '.' &&
1984 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1985 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1989 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1990 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1992 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1994 /* else [foo.-] ==> [-] */
2000 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
2001 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2011 else if (!strncmp (p
, "//", 2)
2013 /* // at start of filename is meaningful in Apollo system. */
2021 else if (p
[0] == '/' && p
[1] == '.' &&
2022 (p
[2] == '/' || p
[2] == 0))
2024 else if (!strncmp (p
, "/..", 3)
2025 /* `/../' is the "superroot" on certain file systems. */
2027 && (p
[3] == '/' || p
[3] == 0))
2029 while (o
!= target
&& *--o
!= '/')
2032 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2036 if (o
== target
&& *o
== '/')
2044 #endif /* not VMS */
2047 return make_string (target
, o
- target
);
2051 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2052 Ssubstitute_in_file_name
, 1, 1, 0,
2053 doc
: /* Substitute environment variables referred to in FILENAME.
2054 `$FOO' where FOO is an environment variable name means to substitute
2055 the value of that variable. The variable name should be terminated
2056 with a character not a letter, digit or underscore; otherwise, enclose
2057 the entire variable name in braces.
2058 If `/~' appears, all of FILENAME through that `/' is discarded.
2060 On VMS, `$' substitution is not done; this function does little and only
2061 duplicates what `expand-file-name' does. */)
2063 Lisp_Object filename
;
2067 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2068 unsigned char *target
= NULL
;
2070 int substituted
= 0;
2073 Lisp_Object handler
;
2075 CHECK_STRING (filename
);
2077 /* If the file name has special constructs in it,
2078 call the corresponding file handler. */
2079 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2080 if (!NILP (handler
))
2081 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2083 nm
= SDATA (filename
);
2085 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2086 CORRECT_DIR_SEPS (nm
);
2087 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2089 endp
= nm
+ SBYTES (filename
);
2091 /* If /~ or // appears, discard everything through first slash. */
2093 for (p
= nm
; p
!= endp
; p
++)
2096 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2097 /* // at start of file name is meaningful in Apollo,
2098 WindowsNT and Cygwin systems. */
2099 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2100 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2101 || IS_DIRECTORY_SEP (p
[0])
2102 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2107 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2109 || IS_DIRECTORY_SEP (p
[-1])))
2111 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2116 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2118 o
= (unsigned char *) alloca (s
- p
+ 1);
2119 bcopy ((char *) p
, o
, s
- p
);
2122 pw
= (struct passwd
*) getpwnam (o
+ 1);
2124 /* If we have ~/ or ~user and `user' exists, discard
2125 everything up to ~. But if `user' does not exist, leave
2126 ~user alone, it might be a literal file name. */
2127 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2134 /* see comment in expand-file-name about drive specifiers */
2135 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2136 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2145 return make_specified_string (nm
, -1, strlen (nm
),
2146 STRING_MULTIBYTE (filename
));
2149 /* See if any variables are substituted into the string
2150 and find the total length of their values in `total' */
2152 for (p
= nm
; p
!= endp
;)
2162 /* "$$" means a single "$" */
2171 while (p
!= endp
&& *p
!= '}') p
++;
2172 if (*p
!= '}') goto missingclose
;
2178 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2182 /* Copy out the variable name */
2183 target
= (unsigned char *) alloca (s
- o
+ 1);
2184 strncpy (target
, o
, s
- o
);
2187 strupr (target
); /* $home == $HOME etc. */
2190 /* Get variable value */
2191 o
= (unsigned char *) egetenv (target
);
2194 total
+= strlen (o
);
2204 /* If substitution required, recopy the string and do it */
2205 /* Make space in stack frame for the new copy */
2206 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2209 /* Copy the rest of the name through, replacing $ constructs with values */
2226 while (p
!= endp
&& *p
!= '}') p
++;
2227 if (*p
!= '}') goto missingclose
;
2233 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2237 /* Copy out the variable name */
2238 target
= (unsigned char *) alloca (s
- o
+ 1);
2239 strncpy (target
, o
, s
- o
);
2242 strupr (target
); /* $home == $HOME etc. */
2245 /* Get variable value */
2246 o
= (unsigned char *) egetenv (target
);
2250 strcpy (x
, target
); x
+= strlen (target
);
2252 else if (STRING_MULTIBYTE (filename
))
2254 /* If the original string is multibyte,
2255 convert what we substitute into multibyte. */
2258 int c
= unibyte_char_to_multibyte (*o
++);
2259 x
+= CHAR_STRING (c
, x
);
2271 /* If /~ or // appears, discard everything through first slash. */
2273 for (p
= xnm
; p
!= x
; p
++)
2275 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2276 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2277 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2278 || IS_DIRECTORY_SEP (p
[0])
2279 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2281 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2284 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2285 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2289 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2292 error ("Bad format environment-variable substitution");
2294 error ("Missing \"}\" in environment-variable substitution");
2296 error ("Substituting nonexistent environment variable \"%s\"", target
);
2299 #endif /* not VMS */
2303 /* A slightly faster and more convenient way to get
2304 (directory-file-name (expand-file-name FOO)). */
2307 expand_and_dir_to_file (filename
, defdir
)
2308 Lisp_Object filename
, defdir
;
2310 register Lisp_Object absname
;
2312 absname
= Fexpand_file_name (filename
, defdir
);
2315 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2316 if (c
== ':' || c
== ']' || c
== '>')
2317 absname
= Fdirectory_file_name (absname
);
2320 /* Remove final slash, if any (unless this is the root dir).
2321 stat behaves differently depending! */
2322 if (SCHARS (absname
) > 1
2323 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2324 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2325 /* We cannot take shortcuts; they might be wrong for magic file names. */
2326 absname
= Fdirectory_file_name (absname
);
2331 /* Signal an error if the file ABSNAME already exists.
2332 If INTERACTIVE is nonzero, ask the user whether to proceed,
2333 and bypass the error if the user says to go ahead.
2334 QUERYSTRING is a name for the action that is being considered
2337 *STATPTR is used to store the stat information if the file exists.
2338 If the file does not exist, STATPTR->st_mode is set to 0.
2339 If STATPTR is null, we don't store into it.
2341 If QUICK is nonzero, we ask for y or n, not yes or no. */
2344 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2345 Lisp_Object absname
;
2346 unsigned char *querystring
;
2348 struct stat
*statptr
;
2351 register Lisp_Object tem
, encoded_filename
;
2352 struct stat statbuf
;
2353 struct gcpro gcpro1
;
2355 encoded_filename
= ENCODE_FILE (absname
);
2357 /* stat is a good way to tell whether the file exists,
2358 regardless of what access permissions it has. */
2359 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2362 Fsignal (Qfile_already_exists
,
2363 Fcons (build_string ("File already exists"),
2364 Fcons (absname
, Qnil
)));
2366 tem
= format2 ("File %s already exists; %s anyway? ",
2367 absname
, build_string (querystring
));
2369 tem
= Fy_or_n_p (tem
);
2371 tem
= do_yes_or_no_p (tem
);
2374 Fsignal (Qfile_already_exists
,
2375 Fcons (build_string ("File already exists"),
2376 Fcons (absname
, Qnil
)));
2383 statptr
->st_mode
= 0;
2388 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2389 "fCopy file: \nFCopy %s to file: \np\nP",
2390 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2391 If NEWNAME names a directory, copy FILE there.
2392 Signals a `file-already-exists' error if file NEWNAME already exists,
2393 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2394 A number as third arg means request confirmation if NEWNAME already exists.
2395 This is what happens in interactive use with M-x.
2396 Fourth arg KEEP-TIME non-nil means give the new file the same
2397 last-modified time as the old one. (This works on only some systems.)
2398 A prefix arg makes KEEP-TIME non-nil.
2399 Also set the file modes of the target file to match the source file. */)
2400 (file
, newname
, ok_if_already_exists
, keep_time
)
2401 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2404 char buf
[16 * 1024];
2405 struct stat st
, out_st
;
2406 Lisp_Object handler
;
2407 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2408 int count
= SPECPDL_INDEX ();
2409 int input_file_statable_p
;
2410 Lisp_Object encoded_file
, encoded_newname
;
2412 encoded_file
= encoded_newname
= Qnil
;
2413 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2414 CHECK_STRING (file
);
2415 CHECK_STRING (newname
);
2417 if (!NILP (Ffile_directory_p (newname
)))
2418 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2420 newname
= Fexpand_file_name (newname
, Qnil
);
2422 file
= Fexpand_file_name (file
, Qnil
);
2424 /* If the input file name has special constructs in it,
2425 call the corresponding file handler. */
2426 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2427 /* Likewise for output file name. */
2429 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2430 if (!NILP (handler
))
2431 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2432 ok_if_already_exists
, keep_time
));
2434 encoded_file
= ENCODE_FILE (file
);
2435 encoded_newname
= ENCODE_FILE (newname
);
2437 if (NILP (ok_if_already_exists
)
2438 || INTEGERP (ok_if_already_exists
))
2439 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2440 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2441 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2445 if (!CopyFile (SDATA (encoded_file
),
2446 SDATA (encoded_newname
),
2448 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2449 /* CopyFile retains the timestamp by default. */
2450 else if (NILP (keep_time
))
2456 EMACS_GET_TIME (now
);
2457 filename
= SDATA (encoded_newname
);
2459 /* Ensure file is writable while its modified time is set. */
2460 attributes
= GetFileAttributes (filename
);
2461 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2462 if (set_file_times (filename
, now
, now
))
2464 /* Restore original attributes. */
2465 SetFileAttributes (filename
, attributes
);
2466 Fsignal (Qfile_date_error
,
2467 Fcons (build_string ("Cannot set file date"),
2468 Fcons (newname
, Qnil
)));
2470 /* Restore original attributes. */
2471 SetFileAttributes (filename
, attributes
);
2473 #else /* not WINDOWSNT */
2475 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2479 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2481 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2483 /* We can only copy regular files and symbolic links. Other files are not
2485 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2487 #if !defined (DOS_NT) || __DJGPP__ > 1
2488 if (out_st
.st_mode
!= 0
2489 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2492 report_file_error ("Input and output files are the same",
2493 Fcons (file
, Fcons (newname
, Qnil
)));
2497 #if defined (S_ISREG) && defined (S_ISLNK)
2498 if (input_file_statable_p
)
2500 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2502 #if defined (EISDIR)
2503 /* Get a better looking error message. */
2506 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2509 #endif /* S_ISREG && S_ISLNK */
2512 /* Create the copy file with the same record format as the input file */
2513 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2516 /* System's default file type was set to binary by _fmode in emacs.c. */
2517 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2518 #else /* not MSDOS */
2519 ofd
= creat (SDATA (encoded_newname
), 0666);
2520 #endif /* not MSDOS */
2523 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2525 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2529 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2530 if (emacs_write (ofd
, buf
, n
) != n
)
2531 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2534 /* Closing the output clobbers the file times on some systems. */
2535 if (emacs_close (ofd
) < 0)
2536 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2538 if (input_file_statable_p
)
2540 if (!NILP (keep_time
))
2542 EMACS_TIME atime
, mtime
;
2543 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2544 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2545 if (set_file_times (SDATA (encoded_newname
),
2547 Fsignal (Qfile_date_error
,
2548 Fcons (build_string ("Cannot set file date"),
2549 Fcons (newname
, Qnil
)));
2552 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2554 #if defined (__DJGPP__) && __DJGPP__ > 1
2555 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2556 and if it can't, it tells so. Otherwise, under MSDOS we usually
2557 get only the READ bit, which will make the copied file read-only,
2558 so it's better not to chmod at all. */
2559 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2560 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2561 #endif /* DJGPP version 2 or newer */
2566 #endif /* WINDOWSNT */
2568 /* Discard the unwind protects. */
2569 specpdl_ptr
= specpdl
+ count
;
2575 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2576 Smake_directory_internal
, 1, 1, 0,
2577 doc
: /* Create a new directory named DIRECTORY. */)
2579 Lisp_Object directory
;
2581 const unsigned char *dir
;
2582 Lisp_Object handler
;
2583 Lisp_Object encoded_dir
;
2585 CHECK_STRING (directory
);
2586 directory
= Fexpand_file_name (directory
, Qnil
);
2588 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2589 if (!NILP (handler
))
2590 return call2 (handler
, Qmake_directory_internal
, directory
);
2592 encoded_dir
= ENCODE_FILE (directory
);
2594 dir
= SDATA (encoded_dir
);
2597 if (mkdir (dir
) != 0)
2599 if (mkdir (dir
, 0777) != 0)
2601 report_file_error ("Creating directory", Flist (1, &directory
));
2606 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2607 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2609 Lisp_Object directory
;
2611 const unsigned char *dir
;
2612 Lisp_Object handler
;
2613 Lisp_Object encoded_dir
;
2615 CHECK_STRING (directory
);
2616 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2618 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2619 if (!NILP (handler
))
2620 return call2 (handler
, Qdelete_directory
, directory
);
2622 encoded_dir
= ENCODE_FILE (directory
);
2624 dir
= SDATA (encoded_dir
);
2626 if (rmdir (dir
) != 0)
2627 report_file_error ("Removing directory", Flist (1, &directory
));
2632 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2633 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2634 If file has multiple names, it continues to exist with the other names. */)
2636 Lisp_Object filename
;
2638 Lisp_Object handler
;
2639 Lisp_Object encoded_file
;
2640 struct gcpro gcpro1
;
2643 if (!NILP (Ffile_directory_p (filename
))
2644 && NILP (Ffile_symlink_p (filename
)))
2645 Fsignal (Qfile_error
,
2646 Fcons (build_string ("Removing old name: is a directory"),
2647 Fcons (filename
, Qnil
)));
2649 filename
= Fexpand_file_name (filename
, Qnil
);
2651 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2652 if (!NILP (handler
))
2653 return call2 (handler
, Qdelete_file
, filename
);
2655 encoded_file
= ENCODE_FILE (filename
);
2657 if (0 > unlink (SDATA (encoded_file
)))
2658 report_file_error ("Removing old name", Flist (1, &filename
));
2663 internal_delete_file_1 (ignore
)
2669 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2672 internal_delete_file (filename
)
2673 Lisp_Object filename
;
2675 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2676 Qt
, internal_delete_file_1
));
2679 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2680 "fRename file: \nFRename %s to file: \np",
2681 doc
: /* Rename FILE as NEWNAME. Both args strings.
2682 If file has names other than FILE, it continues to have those names.
2683 Signals a `file-already-exists' error if a file NEWNAME already exists
2684 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2685 A number as third arg means request confirmation if NEWNAME already exists.
2686 This is what happens in interactive use with M-x. */)
2687 (file
, newname
, ok_if_already_exists
)
2688 Lisp_Object file
, newname
, ok_if_already_exists
;
2691 Lisp_Object args
[2];
2693 Lisp_Object handler
;
2694 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2695 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2697 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2698 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2699 CHECK_STRING (file
);
2700 CHECK_STRING (newname
);
2701 file
= Fexpand_file_name (file
, Qnil
);
2702 newname
= Fexpand_file_name (newname
, Qnil
);
2704 /* If the file name has special constructs in it,
2705 call the corresponding file handler. */
2706 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2708 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2709 if (!NILP (handler
))
2710 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2711 file
, newname
, ok_if_already_exists
));
2713 encoded_file
= ENCODE_FILE (file
);
2714 encoded_newname
= ENCODE_FILE (newname
);
2717 /* If the file names are identical but for the case, don't ask for
2718 confirmation: they simply want to change the letter-case of the
2720 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2722 if (NILP (ok_if_already_exists
)
2723 || INTEGERP (ok_if_already_exists
))
2724 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2725 INTEGERP (ok_if_already_exists
), 0, 0);
2727 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2729 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2730 || 0 > unlink (SDATA (encoded_file
)))
2736 symlink_target
= Ffile_symlink_p (file
);
2737 if (! NILP (symlink_target
))
2738 Fmake_symbolic_link (symlink_target
, newname
,
2739 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2742 Fcopy_file (file
, newname
,
2743 /* We have already prompted if it was an integer,
2744 so don't have copy-file prompt again. */
2745 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2746 Fdelete_file (file
);
2753 report_file_error ("Renaming", Flist (2, args
));
2756 report_file_error ("Renaming", Flist (2, &file
));
2763 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2764 "fAdd name to file: \nFName to add to %s: \np",
2765 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2766 Signals a `file-already-exists' error if a file NEWNAME already exists
2767 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2768 A number as third arg means request confirmation if NEWNAME already exists.
2769 This is what happens in interactive use with M-x. */)
2770 (file
, newname
, ok_if_already_exists
)
2771 Lisp_Object file
, newname
, ok_if_already_exists
;
2774 Lisp_Object args
[2];
2776 Lisp_Object handler
;
2777 Lisp_Object encoded_file
, encoded_newname
;
2778 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2780 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2781 encoded_file
= encoded_newname
= Qnil
;
2782 CHECK_STRING (file
);
2783 CHECK_STRING (newname
);
2784 file
= Fexpand_file_name (file
, Qnil
);
2785 newname
= Fexpand_file_name (newname
, Qnil
);
2787 /* If the file name has special constructs in it,
2788 call the corresponding file handler. */
2789 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2790 if (!NILP (handler
))
2791 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2792 newname
, ok_if_already_exists
));
2794 /* If the new name has special constructs in it,
2795 call the corresponding file handler. */
2796 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2797 if (!NILP (handler
))
2798 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2799 newname
, ok_if_already_exists
));
2801 encoded_file
= ENCODE_FILE (file
);
2802 encoded_newname
= ENCODE_FILE (newname
);
2804 if (NILP (ok_if_already_exists
)
2805 || INTEGERP (ok_if_already_exists
))
2806 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2807 INTEGERP (ok_if_already_exists
), 0, 0);
2809 unlink (SDATA (newname
));
2810 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2815 report_file_error ("Adding new name", Flist (2, args
));
2817 report_file_error ("Adding new name", Flist (2, &file
));
2826 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2827 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2828 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2829 Signals a `file-already-exists' error if a file LINKNAME already exists
2830 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2831 A number as third arg means request confirmation if LINKNAME already exists.
2832 This happens for interactive use with M-x. */)
2833 (filename
, linkname
, ok_if_already_exists
)
2834 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2837 Lisp_Object args
[2];
2839 Lisp_Object handler
;
2840 Lisp_Object encoded_filename
, encoded_linkname
;
2841 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2843 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2844 encoded_filename
= encoded_linkname
= Qnil
;
2845 CHECK_STRING (filename
);
2846 CHECK_STRING (linkname
);
2847 /* If the link target has a ~, we must expand it to get
2848 a truly valid file name. Otherwise, do not expand;
2849 we want to permit links to relative file names. */
2850 if (SREF (filename
, 0) == '~')
2851 filename
= Fexpand_file_name (filename
, Qnil
);
2852 linkname
= Fexpand_file_name (linkname
, Qnil
);
2854 /* If the file name has special constructs in it,
2855 call the corresponding file handler. */
2856 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2857 if (!NILP (handler
))
2858 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2859 linkname
, ok_if_already_exists
));
2861 /* If the new link name has special constructs in it,
2862 call the corresponding file handler. */
2863 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2864 if (!NILP (handler
))
2865 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2866 linkname
, ok_if_already_exists
));
2868 encoded_filename
= ENCODE_FILE (filename
);
2869 encoded_linkname
= ENCODE_FILE (linkname
);
2871 if (NILP (ok_if_already_exists
)
2872 || INTEGERP (ok_if_already_exists
))
2873 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2874 INTEGERP (ok_if_already_exists
), 0, 0);
2875 if (0 > symlink (SDATA (encoded_filename
),
2876 SDATA (encoded_linkname
)))
2878 /* If we didn't complain already, silently delete existing file. */
2879 if (errno
== EEXIST
)
2881 unlink (SDATA (encoded_linkname
));
2882 if (0 <= symlink (SDATA (encoded_filename
),
2883 SDATA (encoded_linkname
)))
2893 report_file_error ("Making symbolic link", Flist (2, args
));
2895 report_file_error ("Making symbolic link", Flist (2, &filename
));
2901 #endif /* S_IFLNK */
2905 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2906 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2907 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2908 If STRING is nil or a null string, the logical name NAME is deleted. */)
2913 CHECK_STRING (name
);
2915 delete_logical_name (SDATA (name
));
2918 CHECK_STRING (string
);
2920 if (SCHARS (string
) == 0)
2921 delete_logical_name (SDATA (name
));
2923 define_logical_name (SDATA (name
), SDATA (string
));
2932 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2933 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2935 Lisp_Object path
, login
;
2939 CHECK_STRING (path
);
2940 CHECK_STRING (login
);
2942 netresult
= netunam (SDATA (path
), SDATA (login
));
2944 if (netresult
== -1)
2949 #endif /* HPUX_NET */
2951 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2953 doc
: /* Return t if file FILENAME specifies an absolute file name.
2954 On Unix, this is a name starting with a `/' or a `~'. */)
2956 Lisp_Object filename
;
2958 const unsigned char *ptr
;
2960 CHECK_STRING (filename
);
2961 ptr
= SDATA (filename
);
2962 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2964 /* ??? This criterion is probably wrong for '<'. */
2965 || index (ptr
, ':') || index (ptr
, '<')
2966 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2970 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2978 /* Return nonzero if file FILENAME exists and can be executed. */
2981 check_executable (filename
)
2985 int len
= strlen (filename
);
2988 if (stat (filename
, &st
) < 0)
2990 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2991 return ((st
.st_mode
& S_IEXEC
) != 0);
2993 return (S_ISREG (st
.st_mode
)
2995 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2996 || stricmp (suffix
, ".exe") == 0
2997 || stricmp (suffix
, ".bat") == 0)
2998 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2999 #endif /* not WINDOWSNT */
3000 #else /* not DOS_NT */
3001 #ifdef HAVE_EUIDACCESS
3002 return (euidaccess (filename
, 1) >= 0);
3004 /* Access isn't quite right because it uses the real uid
3005 and we really want to test with the effective uid.
3006 But Unix doesn't give us a right way to do it. */
3007 return (access (filename
, 1) >= 0);
3009 #endif /* not DOS_NT */
3012 /* Return nonzero if file FILENAME exists and can be written. */
3015 check_writable (filename
)
3020 if (stat (filename
, &st
) < 0)
3022 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3023 #else /* not MSDOS */
3024 #ifdef HAVE_EUIDACCESS
3025 return (euidaccess (filename
, 2) >= 0);
3027 /* Access isn't quite right because it uses the real uid
3028 and we really want to test with the effective uid.
3029 But Unix doesn't give us a right way to do it.
3030 Opening with O_WRONLY could work for an ordinary file,
3031 but would lose for directories. */
3032 return (access (filename
, 2) >= 0);
3034 #endif /* not MSDOS */
3037 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3038 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3039 See also `file-readable-p' and `file-attributes'. */)
3041 Lisp_Object filename
;
3043 Lisp_Object absname
;
3044 Lisp_Object handler
;
3045 struct stat statbuf
;
3047 CHECK_STRING (filename
);
3048 absname
= Fexpand_file_name (filename
, Qnil
);
3050 /* If the file name has special constructs in it,
3051 call the corresponding file handler. */
3052 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3053 if (!NILP (handler
))
3054 return call2 (handler
, Qfile_exists_p
, absname
);
3056 absname
= ENCODE_FILE (absname
);
3058 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3061 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3062 doc
: /* Return t if FILENAME can be executed by you.
3063 For a directory, this means you can access files in that directory. */)
3065 Lisp_Object filename
;
3067 Lisp_Object absname
;
3068 Lisp_Object handler
;
3070 CHECK_STRING (filename
);
3071 absname
= Fexpand_file_name (filename
, Qnil
);
3073 /* If the file name has special constructs in it,
3074 call the corresponding file handler. */
3075 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3076 if (!NILP (handler
))
3077 return call2 (handler
, Qfile_executable_p
, absname
);
3079 absname
= ENCODE_FILE (absname
);
3081 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3084 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3085 doc
: /* Return t if file FILENAME exists and you can read it.
3086 See also `file-exists-p' and `file-attributes'. */)
3088 Lisp_Object filename
;
3090 Lisp_Object absname
;
3091 Lisp_Object handler
;
3094 struct stat statbuf
;
3096 CHECK_STRING (filename
);
3097 absname
= Fexpand_file_name (filename
, Qnil
);
3099 /* If the file name has special constructs in it,
3100 call the corresponding file handler. */
3101 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3102 if (!NILP (handler
))
3103 return call2 (handler
, Qfile_readable_p
, absname
);
3105 absname
= ENCODE_FILE (absname
);
3107 #if defined(DOS_NT) || defined(macintosh)
3108 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3110 if (access (SDATA (absname
), 0) == 0)
3113 #else /* not DOS_NT and not macintosh */
3115 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3116 /* Opening a fifo without O_NONBLOCK can wait.
3117 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3118 except in the case of a fifo, on a system which handles it. */
3119 desc
= stat (SDATA (absname
), &statbuf
);
3122 if (S_ISFIFO (statbuf
.st_mode
))
3123 flags
|= O_NONBLOCK
;
3125 desc
= emacs_open (SDATA (absname
), flags
, 0);
3130 #endif /* not DOS_NT and not macintosh */
3133 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3135 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3136 doc
: /* Return t if file FILENAME can be written or created by you. */)
3138 Lisp_Object filename
;
3140 Lisp_Object absname
, dir
, encoded
;
3141 Lisp_Object handler
;
3142 struct stat statbuf
;
3144 CHECK_STRING (filename
);
3145 absname
= Fexpand_file_name (filename
, Qnil
);
3147 /* If the file name has special constructs in it,
3148 call the corresponding file handler. */
3149 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3150 if (!NILP (handler
))
3151 return call2 (handler
, Qfile_writable_p
, absname
);
3153 encoded
= ENCODE_FILE (absname
);
3154 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3155 return (check_writable (SDATA (encoded
))
3158 dir
= Ffile_name_directory (absname
);
3161 dir
= Fdirectory_file_name (dir
);
3165 dir
= Fdirectory_file_name (dir
);
3168 dir
= ENCODE_FILE (dir
);
3170 /* The read-only attribute of the parent directory doesn't affect
3171 whether a file or directory can be created within it. Some day we
3172 should check ACLs though, which do affect this. */
3173 if (stat (SDATA (dir
), &statbuf
) < 0)
3175 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3177 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3182 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3183 doc
: /* Access file FILENAME, and get an error if that does not work.
3184 The second argument STRING is used in the error message.
3185 If there is no error, we return nil. */)
3187 Lisp_Object filename
, string
;
3189 Lisp_Object handler
, encoded_filename
, absname
;
3192 CHECK_STRING (filename
);
3193 absname
= Fexpand_file_name (filename
, Qnil
);
3195 CHECK_STRING (string
);
3197 /* If the file name has special constructs in it,
3198 call the corresponding file handler. */
3199 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3200 if (!NILP (handler
))
3201 return call3 (handler
, Qaccess_file
, absname
, string
);
3203 encoded_filename
= ENCODE_FILE (absname
);
3205 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3207 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3213 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3214 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3215 The value is the link target, as a string.
3216 Otherwise returns nil. */)
3218 Lisp_Object filename
;
3220 Lisp_Object handler
;
3222 CHECK_STRING (filename
);
3223 filename
= Fexpand_file_name (filename
, Qnil
);
3225 /* If the file name has special constructs in it,
3226 call the corresponding file handler. */
3227 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3228 if (!NILP (handler
))
3229 return call2 (handler
, Qfile_symlink_p
, filename
);
3238 filename
= ENCODE_FILE (filename
);
3245 buf
= (char *) xrealloc (buf
, bufsize
);
3246 bzero (buf
, bufsize
);
3249 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3253 /* HP-UX reports ERANGE if buffer is too small. */
3254 if (errno
== ERANGE
)
3264 while (valsize
>= bufsize
);
3266 val
= make_string (buf
, valsize
);
3267 if (buf
[0] == '/' && index (buf
, ':'))
3268 val
= concat2 (build_string ("/:"), val
);
3270 val
= DECODE_FILE (val
);
3273 #else /* not S_IFLNK */
3275 #endif /* not S_IFLNK */
3278 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3279 doc
: /* Return t if FILENAME names an existing directory.
3280 Symbolic links to directories count as directories.
3281 See `file-symlink-p' to distinguish symlinks. */)
3283 Lisp_Object filename
;
3285 register Lisp_Object absname
;
3287 Lisp_Object handler
;
3289 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3291 /* If the file name has special constructs in it,
3292 call the corresponding file handler. */
3293 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3294 if (!NILP (handler
))
3295 return call2 (handler
, Qfile_directory_p
, absname
);
3297 absname
= ENCODE_FILE (absname
);
3299 if (stat (SDATA (absname
), &st
) < 0)
3301 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3304 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3305 doc
: /* Return t if file FILENAME names a directory you can open.
3306 For the value to be t, FILENAME must specify the name of a directory as a file,
3307 and the directory must allow you to open files in it. In order to use a
3308 directory as a buffer's current directory, this predicate must return true.
3309 A directory name spec may be given instead; then the value is t
3310 if the directory so specified exists and really is a readable and
3311 searchable directory. */)
3313 Lisp_Object filename
;
3315 Lisp_Object handler
;
3317 struct gcpro gcpro1
;
3319 /* If the file name has special constructs in it,
3320 call the corresponding file handler. */
3321 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3322 if (!NILP (handler
))
3323 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3326 tem
= (NILP (Ffile_directory_p (filename
))
3327 || NILP (Ffile_executable_p (filename
)));
3329 return tem
? Qnil
: Qt
;
3332 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3333 doc
: /* Return t if file FILENAME is the name of a regular file.
3334 This is the sort of file that holds an ordinary stream of data bytes. */)
3336 Lisp_Object filename
;
3338 register Lisp_Object absname
;
3340 Lisp_Object handler
;
3342 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3344 /* If the file name has special constructs in it,
3345 call the corresponding file handler. */
3346 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3347 if (!NILP (handler
))
3348 return call2 (handler
, Qfile_regular_p
, absname
);
3350 absname
= ENCODE_FILE (absname
);
3355 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3357 /* Tell stat to use expensive method to get accurate info. */
3358 Vw32_get_true_file_attributes
= Qt
;
3359 result
= stat (SDATA (absname
), &st
);
3360 Vw32_get_true_file_attributes
= tem
;
3364 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3367 if (stat (SDATA (absname
), &st
) < 0)
3369 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3373 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3374 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
3376 Lisp_Object filename
;
3378 Lisp_Object absname
;
3380 Lisp_Object handler
;
3382 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3384 /* If the file name has special constructs in it,
3385 call the corresponding file handler. */
3386 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3387 if (!NILP (handler
))
3388 return call2 (handler
, Qfile_modes
, absname
);
3390 absname
= ENCODE_FILE (absname
);
3392 if (stat (SDATA (absname
), &st
) < 0)
3394 #if defined (MSDOS) && __DJGPP__ < 2
3395 if (check_executable (SDATA (absname
)))
3396 st
.st_mode
|= S_IEXEC
;
3397 #endif /* MSDOS && __DJGPP__ < 2 */
3399 return make_number (st
.st_mode
& 07777);
3402 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3403 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3404 Only the 12 low bits of MODE are used. */)
3406 Lisp_Object filename
, mode
;
3408 Lisp_Object absname
, encoded_absname
;
3409 Lisp_Object handler
;
3411 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3412 CHECK_NUMBER (mode
);
3414 /* If the file name has special constructs in it,
3415 call the corresponding file handler. */
3416 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3417 if (!NILP (handler
))
3418 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3420 encoded_absname
= ENCODE_FILE (absname
);
3422 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3423 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3428 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3429 doc
: /* Set the file permission bits for newly created files.
3430 The argument MODE should be an integer; only the low 9 bits are used.
3431 This setting is inherited by subprocesses. */)
3435 CHECK_NUMBER (mode
);
3437 umask ((~ XINT (mode
)) & 0777);
3442 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3443 doc
: /* Return the default file protection for created files.
3444 The value is an integer. */)
3450 realmask
= umask (0);
3453 XSETINT (value
, (~ realmask
) & 0777);
3457 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3459 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3460 doc
: /* Set times of file FILENAME to TIME.
3461 Set both access and modification times.
3462 Return t on success, else nil.
3463 Use the current time if TIME is nil. TIME is in the format of
3466 Lisp_Object filename
, time
;
3468 Lisp_Object absname
, encoded_absname
;
3469 Lisp_Object handler
;
3473 if (! lisp_time_argument (time
, &sec
, &usec
))
3474 error ("Invalid time specification");
3476 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3478 /* If the file name has special constructs in it,
3479 call the corresponding file handler. */
3480 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3481 if (!NILP (handler
))
3482 return call3 (handler
, Qset_file_times
, absname
, time
);
3484 encoded_absname
= ENCODE_FILE (absname
);
3489 EMACS_SET_SECS (t
, sec
);
3490 EMACS_SET_USECS (t
, usec
);
3492 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3497 /* Setting times on a directory always fails. */
3498 if (stat (SDATA (encoded_absname
), &st
) == 0
3499 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3502 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3515 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3516 doc
: /* Tell Unix to finish all pending disk updates. */)
3525 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3526 doc
: /* Return t if file FILE1 is newer than file FILE2.
3527 If FILE1 does not exist, the answer is nil;
3528 otherwise, if FILE2 does not exist, the answer is t. */)
3530 Lisp_Object file1
, file2
;
3532 Lisp_Object absname1
, absname2
;
3535 Lisp_Object handler
;
3536 struct gcpro gcpro1
, gcpro2
;
3538 CHECK_STRING (file1
);
3539 CHECK_STRING (file2
);
3542 GCPRO2 (absname1
, file2
);
3543 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3544 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3547 /* If the file name has special constructs in it,
3548 call the corresponding file handler. */
3549 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3551 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3552 if (!NILP (handler
))
3553 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3555 GCPRO2 (absname1
, absname2
);
3556 absname1
= ENCODE_FILE (absname1
);
3557 absname2
= ENCODE_FILE (absname2
);
3560 if (stat (SDATA (absname1
), &st
) < 0)
3563 mtime1
= st
.st_mtime
;
3565 if (stat (SDATA (absname2
), &st
) < 0)
3568 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3572 Lisp_Object Qfind_buffer_file_type
;
3575 #ifndef READ_BUF_SIZE
3576 #define READ_BUF_SIZE (64 << 10)
3579 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3581 /* This function is called after Lisp functions to decide a coding
3582 system are called, or when they cause an error. Before they are
3583 called, the current buffer is set unibyte and it contains only a
3584 newly inserted text (thus the buffer was empty before the
3587 The functions may set markers, overlays, text properties, or even
3588 alter the buffer contents, change the current buffer.
3590 Here, we reset all those changes by:
3591 o set back the current buffer.
3592 o move all markers and overlays to BEG.
3593 o remove all text properties.
3594 o set back the buffer multibyteness. */
3597 decide_coding_unwind (unwind_data
)
3598 Lisp_Object unwind_data
;
3600 Lisp_Object multibyte
, undo_list
, buffer
;
3602 multibyte
= XCAR (unwind_data
);
3603 unwind_data
= XCDR (unwind_data
);
3604 undo_list
= XCAR (unwind_data
);
3605 buffer
= XCDR (unwind_data
);
3607 if (current_buffer
!= XBUFFER (buffer
))
3608 set_buffer_internal (XBUFFER (buffer
));
3609 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3610 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3611 BUF_INTERVALS (current_buffer
) = 0;
3612 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3614 /* Now we are safe to change the buffer's multibyteness directly. */
3615 current_buffer
->enable_multibyte_characters
= multibyte
;
3616 current_buffer
->undo_list
= undo_list
;
3622 /* Used to pass values from insert-file-contents to read_non_regular. */
3624 static int non_regular_fd
;
3625 static int non_regular_inserted
;
3626 static int non_regular_nbytes
;
3629 /* Read from a non-regular file.
3630 Read non_regular_trytry bytes max from non_regular_fd.
3631 Non_regular_inserted specifies where to put the read bytes.
3632 Value is the number of bytes read. */
3641 nbytes
= emacs_read (non_regular_fd
,
3642 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3643 non_regular_nbytes
);
3645 return make_number (nbytes
);
3649 /* Condition-case handler used when reading from non-regular files
3650 in insert-file-contents. */
3653 read_non_regular_quit ()
3659 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3661 doc
: /* Insert contents of file FILENAME after point.
3662 Returns list of absolute file name and number of characters inserted.
3663 If second argument VISIT is non-nil, the buffer's visited filename
3664 and last save file modtime are set, and it is marked unmodified.
3665 If visiting and the file does not exist, visiting is completed
3666 before the error is signaled.
3667 The optional third and fourth arguments BEG and END
3668 specify what portion of the file to insert.
3669 These arguments count bytes in the file, not characters in the buffer.
3670 If VISIT is non-nil, BEG and END must be nil.
3672 If optional fifth argument REPLACE is non-nil,
3673 it means replace the current buffer contents (in the accessible portion)
3674 with the file contents. This is better than simply deleting and inserting
3675 the whole thing because (1) it preserves some marker positions
3676 and (2) it puts less data in the undo list.
3677 When REPLACE is non-nil, the value is the number of characters actually read,
3678 which is often less than the number of characters to be read.
3680 This does code conversion according to the value of
3681 `coding-system-for-read' or `file-coding-system-alist',
3682 and sets the variable `last-coding-system-used' to the coding system
3684 (filename
, visit
, beg
, end
, replace
)
3685 Lisp_Object filename
, visit
, beg
, end
, replace
;
3690 register int how_much
;
3691 register int unprocessed
;
3692 int count
= SPECPDL_INDEX ();
3693 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3694 Lisp_Object handler
, val
, insval
, orig_filename
;
3697 int not_regular
= 0;
3698 unsigned char read_buf
[READ_BUF_SIZE
];
3699 struct coding_system coding
;
3700 unsigned char buffer
[1 << 14];
3701 int replace_handled
= 0;
3702 int set_coding_system
= 0;
3703 int coding_system_decided
= 0;
3706 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3707 error ("Cannot do file visiting in an indirect buffer");
3709 if (!NILP (current_buffer
->read_only
))
3710 Fbarf_if_buffer_read_only ();
3714 orig_filename
= Qnil
;
3716 GCPRO4 (filename
, val
, p
, orig_filename
);
3718 CHECK_STRING (filename
);
3719 filename
= Fexpand_file_name (filename
, Qnil
);
3721 /* If the file name has special constructs in it,
3722 call the corresponding file handler. */
3723 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3724 if (!NILP (handler
))
3726 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3727 visit
, beg
, end
, replace
);
3728 if (CONSP (val
) && CONSP (XCDR (val
)))
3729 inserted
= XINT (XCAR (XCDR (val
)));
3733 orig_filename
= filename
;
3734 filename
= ENCODE_FILE (filename
);
3740 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3742 /* Tell stat to use expensive method to get accurate info. */
3743 Vw32_get_true_file_attributes
= Qt
;
3744 total
= stat (SDATA (filename
), &st
);
3745 Vw32_get_true_file_attributes
= tem
;
3750 if (stat (SDATA (filename
), &st
) < 0)
3752 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3753 || fstat (fd
, &st
) < 0)
3754 #endif /* not APOLLO */
3755 #endif /* WINDOWSNT */
3757 if (fd
>= 0) emacs_close (fd
);
3760 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3763 if (!NILP (Vcoding_system_for_read
))
3764 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3769 /* This code will need to be changed in order to work on named
3770 pipes, and it's probably just not worth it. So we should at
3771 least signal an error. */
3772 if (!S_ISREG (st
.st_mode
))
3779 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3780 Fsignal (Qfile_error
,
3781 Fcons (build_string ("not a regular file"),
3782 Fcons (orig_filename
, Qnil
)));
3787 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3790 /* Replacement should preserve point as it preserves markers. */
3791 if (!NILP (replace
))
3792 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3794 record_unwind_protect (close_file_unwind
, make_number (fd
));
3796 /* Supposedly happens on VMS. */
3797 /* Can happen on any platform that uses long as type of off_t, but allows
3798 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3799 give a message suitable for the latter case. */
3800 if (! not_regular
&& st
.st_size
< 0)
3801 error ("Maximum buffer size exceeded");
3803 /* Prevent redisplay optimizations. */
3804 current_buffer
->clip_changed
= 1;
3808 if (!NILP (beg
) || !NILP (end
))
3809 error ("Attempt to visit less than an entire file");
3810 if (BEG
< Z
&& NILP (replace
))
3811 error ("Cannot do file visiting in a non-empty buffer");
3817 XSETFASTINT (beg
, 0);
3825 XSETINT (end
, st
.st_size
);
3827 /* Arithmetic overflow can occur if an Emacs integer cannot
3828 represent the file size, or if the calculations below
3829 overflow. The calculations below double the file size
3830 twice, so check that it can be multiplied by 4 safely. */
3831 if (XINT (end
) != st
.st_size
3832 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3833 error ("Maximum buffer size exceeded");
3835 /* The file size returned from stat may be zero, but data
3836 may be readable nonetheless, for example when this is a
3837 file in the /proc filesystem. */
3838 if (st
.st_size
== 0)
3839 XSETINT (end
, READ_BUF_SIZE
);
3843 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3845 /* We use emacs-mule for auto saving... */
3846 setup_coding_system (Qemacs_mule
, &coding
);
3847 /* ... but with the special flag to indicate to read in a
3848 multibyte sequence for eight-bit-control char as is. */
3850 coding
.src_multibyte
= 0;
3851 coding
.dst_multibyte
3852 = !NILP (current_buffer
->enable_multibyte_characters
);
3853 coding
.eol_type
= CODING_EOL_LF
;
3854 coding_system_decided
= 1;
3858 /* Decide the coding system to use for reading the file now
3859 because we can't use an optimized method for handling
3860 `coding:' tag if the current buffer is not empty. */
3864 if (!NILP (Vcoding_system_for_read
))
3865 val
= Vcoding_system_for_read
;
3866 else if (! NILP (replace
))
3867 /* In REPLACE mode, we can use the same coding system
3868 that was used to visit the file. */
3869 val
= current_buffer
->buffer_file_coding_system
;
3872 /* Don't try looking inside a file for a coding system
3873 specification if it is not seekable. */
3874 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3876 /* Find a coding system specified in the heading two
3877 lines or in the tailing several lines of the file.
3878 We assume that the 1K-byte and 3K-byte for heading
3879 and tailing respectively are sufficient for this
3883 if (st
.st_size
<= (1024 * 4))
3884 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3887 nread
= emacs_read (fd
, read_buf
, 1024);
3890 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3891 report_file_error ("Setting file position",
3892 Fcons (orig_filename
, Qnil
));
3893 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3898 error ("IO error reading %s: %s",
3899 SDATA (orig_filename
), emacs_strerror (errno
));
3902 struct buffer
*prev
= current_buffer
;
3906 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3908 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3909 buf
= XBUFFER (buffer
);
3911 delete_all_overlays (buf
);
3912 buf
->directory
= current_buffer
->directory
;
3913 buf
->read_only
= Qnil
;
3914 buf
->filename
= Qnil
;
3915 buf
->undo_list
= Qt
;
3916 eassert (buf
->overlays_before
== NULL
);
3917 eassert (buf
->overlays_after
== NULL
);
3919 set_buffer_internal (buf
);
3921 buf
->enable_multibyte_characters
= Qnil
;
3923 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3924 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3925 val
= call2 (Vset_auto_coding_function
,
3926 filename
, make_number (nread
));
3927 set_buffer_internal (prev
);
3929 /* Discard the unwind protect for recovering the
3933 /* Rewind the file for the actual read done later. */
3934 if (lseek (fd
, 0, 0) < 0)
3935 report_file_error ("Setting file position",
3936 Fcons (orig_filename
, Qnil
));
3942 /* If we have not yet decided a coding system, check
3943 file-coding-system-alist. */
3944 Lisp_Object args
[6], coding_systems
;
3946 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3947 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3948 coding_systems
= Ffind_operation_coding_system (6, args
);
3949 if (CONSP (coding_systems
))
3950 val
= XCAR (coding_systems
);
3954 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3955 /* Ensure we set Vlast_coding_system_used. */
3956 set_coding_system
= 1;
3958 if (NILP (current_buffer
->enable_multibyte_characters
)
3960 /* We must suppress all character code conversion except for
3961 end-of-line conversion. */
3962 setup_raw_text_coding_system (&coding
);
3964 coding
.src_multibyte
= 0;
3965 coding
.dst_multibyte
3966 = !NILP (current_buffer
->enable_multibyte_characters
);
3967 coding_system_decided
= 1;
3970 /* If requested, replace the accessible part of the buffer
3971 with the file contents. Avoid replacing text at the
3972 beginning or end of the buffer that matches the file contents;
3973 that preserves markers pointing to the unchanged parts.
3975 Here we implement this feature in an optimized way
3976 for the case where code conversion is NOT needed.
3977 The following if-statement handles the case of conversion
3978 in a less optimal way.
3980 If the code conversion is "automatic" then we try using this
3981 method and hope for the best.
3982 But if we discover the need for conversion, we give up on this method
3983 and let the following if-statement handle the replace job. */
3986 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3988 /* same_at_start and same_at_end count bytes,
3989 because file access counts bytes
3990 and BEG and END count bytes. */
3991 int same_at_start
= BEGV_BYTE
;
3992 int same_at_end
= ZV_BYTE
;
3994 /* There is still a possibility we will find the need to do code
3995 conversion. If that happens, we set this variable to 1 to
3996 give up on handling REPLACE in the optimized way. */
3997 int giveup_match_end
= 0;
3999 if (XINT (beg
) != 0)
4001 if (lseek (fd
, XINT (beg
), 0) < 0)
4002 report_file_error ("Setting file position",
4003 Fcons (orig_filename
, Qnil
));
4008 /* Count how many chars at the start of the file
4009 match the text at the beginning of the buffer. */
4014 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4016 error ("IO error reading %s: %s",
4017 SDATA (orig_filename
), emacs_strerror (errno
));
4018 else if (nread
== 0)
4021 if (coding
.type
== coding_type_undecided
)
4022 detect_coding (&coding
, buffer
, nread
);
4023 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4024 /* We found that the file should be decoded somehow.
4025 Let's give up here. */
4027 giveup_match_end
= 1;
4031 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4032 detect_eol (&coding
, buffer
, nread
);
4033 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4034 && coding
.eol_type
!= CODING_EOL_LF
)
4035 /* We found that the format of eol should be decoded.
4036 Let's give up here. */
4038 giveup_match_end
= 1;
4043 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4044 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4045 same_at_start
++, bufpos
++;
4046 /* If we found a discrepancy, stop the scan.
4047 Otherwise loop around and scan the next bufferful. */
4048 if (bufpos
!= nread
)
4052 /* If the file matches the buffer completely,
4053 there's no need to replace anything. */
4054 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4058 /* Truncate the buffer to the size of the file. */
4059 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4064 /* Count how many chars at the end of the file
4065 match the text at the end of the buffer. But, if we have
4066 already found that decoding is necessary, don't waste time. */
4067 while (!giveup_match_end
)
4069 int total_read
, nread
, bufpos
, curpos
, trial
;
4071 /* At what file position are we now scanning? */
4072 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4073 /* If the entire file matches the buffer tail, stop the scan. */
4076 /* How much can we scan in the next step? */
4077 trial
= min (curpos
, sizeof buffer
);
4078 if (lseek (fd
, curpos
- trial
, 0) < 0)
4079 report_file_error ("Setting file position",
4080 Fcons (orig_filename
, Qnil
));
4082 total_read
= nread
= 0;
4083 while (total_read
< trial
)
4085 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4087 error ("IO error reading %s: %s",
4088 SDATA (orig_filename
), emacs_strerror (errno
));
4089 else if (nread
== 0)
4091 total_read
+= nread
;
4094 /* Scan this bufferful from the end, comparing with
4095 the Emacs buffer. */
4096 bufpos
= total_read
;
4098 /* Compare with same_at_start to avoid counting some buffer text
4099 as matching both at the file's beginning and at the end. */
4100 while (bufpos
> 0 && same_at_end
> same_at_start
4101 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4102 same_at_end
--, bufpos
--;
4104 /* If we found a discrepancy, stop the scan.
4105 Otherwise loop around and scan the preceding bufferful. */
4108 /* If this discrepancy is because of code conversion,
4109 we cannot use this method; giveup and try the other. */
4110 if (same_at_end
> same_at_start
4111 && FETCH_BYTE (same_at_end
- 1) >= 0200
4112 && ! NILP (current_buffer
->enable_multibyte_characters
)
4113 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4114 giveup_match_end
= 1;
4123 if (! giveup_match_end
)
4127 /* We win! We can handle REPLACE the optimized way. */
4129 /* Extend the start of non-matching text area to multibyte
4130 character boundary. */
4131 if (! NILP (current_buffer
->enable_multibyte_characters
))
4132 while (same_at_start
> BEGV_BYTE
4133 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4136 /* Extend the end of non-matching text area to multibyte
4137 character boundary. */
4138 if (! NILP (current_buffer
->enable_multibyte_characters
))
4139 while (same_at_end
< ZV_BYTE
4140 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4143 /* Don't try to reuse the same piece of text twice. */
4144 overlap
= (same_at_start
- BEGV_BYTE
4145 - (same_at_end
+ st
.st_size
- ZV
));
4147 same_at_end
+= overlap
;
4149 /* Arrange to read only the nonmatching middle part of the file. */
4150 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4151 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4153 del_range_byte (same_at_start
, same_at_end
, 0);
4154 /* Insert from the file at the proper position. */
4155 temp
= BYTE_TO_CHAR (same_at_start
);
4156 SET_PT_BOTH (temp
, same_at_start
);
4158 /* If display currently starts at beginning of line,
4159 keep it that way. */
4160 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4161 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4163 replace_handled
= 1;
4167 /* If requested, replace the accessible part of the buffer
4168 with the file contents. Avoid replacing text at the
4169 beginning or end of the buffer that matches the file contents;
4170 that preserves markers pointing to the unchanged parts.
4172 Here we implement this feature for the case where code conversion
4173 is needed, in a simple way that needs a lot of memory.
4174 The preceding if-statement handles the case of no conversion
4175 in a more optimized way. */
4176 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4178 int same_at_start
= BEGV_BYTE
;
4179 int same_at_end
= ZV_BYTE
;
4182 /* Make sure that the gap is large enough. */
4183 int bufsize
= 2 * st
.st_size
;
4184 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4187 /* First read the whole file, performing code conversion into
4188 CONVERSION_BUFFER. */
4190 if (lseek (fd
, XINT (beg
), 0) < 0)
4192 xfree (conversion_buffer
);
4193 report_file_error ("Setting file position",
4194 Fcons (orig_filename
, Qnil
));
4197 total
= st
.st_size
; /* Total bytes in the file. */
4198 how_much
= 0; /* Bytes read from file so far. */
4199 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4200 unprocessed
= 0; /* Bytes not processed in previous loop. */
4202 while (how_much
< total
)
4204 /* try is reserved in some compilers (Microsoft C) */
4205 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4206 unsigned char *destination
= read_buf
+ unprocessed
;
4209 /* Allow quitting out of the actual I/O. */
4212 this = emacs_read (fd
, destination
, trytry
);
4215 if (this < 0 || this + unprocessed
== 0)
4223 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4225 int require
, result
;
4227 this += unprocessed
;
4229 /* If we are using more space than estimated,
4230 make CONVERSION_BUFFER bigger. */
4231 require
= decoding_buffer_size (&coding
, this);
4232 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4234 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4235 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4238 /* Convert this batch with results in CONVERSION_BUFFER. */
4239 if (how_much
>= total
) /* This is the last block. */
4240 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4241 if (coding
.composing
!= COMPOSITION_DISABLED
)
4242 coding_allocate_composition_data (&coding
, BEGV
);
4243 result
= decode_coding (&coding
, read_buf
,
4244 conversion_buffer
+ inserted
,
4245 this, bufsize
- inserted
);
4247 /* Save for next iteration whatever we didn't convert. */
4248 unprocessed
= this - coding
.consumed
;
4249 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4250 if (!NILP (current_buffer
->enable_multibyte_characters
))
4251 this = coding
.produced
;
4253 this = str_as_unibyte (conversion_buffer
+ inserted
,
4260 /* At this point, INSERTED is how many characters (i.e. bytes)
4261 are present in CONVERSION_BUFFER.
4262 HOW_MUCH should equal TOTAL,
4263 or should be <= 0 if we couldn't read the file. */
4267 xfree (conversion_buffer
);
4270 error ("IO error reading %s: %s",
4271 SDATA (orig_filename
), emacs_strerror (errno
));
4272 else if (how_much
== -2)
4273 error ("maximum buffer size exceeded");
4276 /* Compare the beginning of the converted file
4277 with the buffer text. */
4280 while (bufpos
< inserted
&& same_at_start
< same_at_end
4281 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4282 same_at_start
++, bufpos
++;
4284 /* If the file matches the buffer completely,
4285 there's no need to replace anything. */
4287 if (bufpos
== inserted
)
4289 xfree (conversion_buffer
);
4292 /* Truncate the buffer to the size of the file. */
4293 del_range_byte (same_at_start
, same_at_end
, 0);
4298 /* Extend the start of non-matching text area to multibyte
4299 character boundary. */
4300 if (! NILP (current_buffer
->enable_multibyte_characters
))
4301 while (same_at_start
> BEGV_BYTE
4302 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4305 /* Scan this bufferful from the end, comparing with
4306 the Emacs buffer. */
4309 /* Compare with same_at_start to avoid counting some buffer text
4310 as matching both at the file's beginning and at the end. */
4311 while (bufpos
> 0 && same_at_end
> same_at_start
4312 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4313 same_at_end
--, bufpos
--;
4315 /* Extend the end of non-matching text area to multibyte
4316 character boundary. */
4317 if (! NILP (current_buffer
->enable_multibyte_characters
))
4318 while (same_at_end
< ZV_BYTE
4319 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4322 /* Don't try to reuse the same piece of text twice. */
4323 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4325 same_at_end
+= overlap
;
4327 /* If display currently starts at beginning of line,
4328 keep it that way. */
4329 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4330 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4332 /* Replace the chars that we need to replace,
4333 and update INSERTED to equal the number of bytes
4334 we are taking from the file. */
4335 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4337 if (same_at_end
!= same_at_start
)
4339 del_range_byte (same_at_start
, same_at_end
, 0);
4341 same_at_start
= GPT_BYTE
;
4345 temp
= BYTE_TO_CHAR (same_at_start
);
4347 /* Insert from the file at the proper position. */
4348 SET_PT_BOTH (temp
, same_at_start
);
4349 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
4351 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4352 coding_restore_composition (&coding
, Fcurrent_buffer ());
4353 coding_free_composition_data (&coding
);
4355 /* Set `inserted' to the number of inserted characters. */
4356 inserted
= PT
- temp
;
4358 xfree (conversion_buffer
);
4367 register Lisp_Object temp
;
4369 total
= XINT (end
) - XINT (beg
);
4371 /* Make sure point-max won't overflow after this insertion. */
4372 XSETINT (temp
, total
);
4373 if (total
!= XINT (temp
))
4374 error ("Maximum buffer size exceeded");
4377 /* For a special file, all we can do is guess. */
4378 total
= READ_BUF_SIZE
;
4380 if (NILP (visit
) && total
> 0)
4381 prepare_to_modify_buffer (PT
, PT
, NULL
);
4384 if (GAP_SIZE
< total
)
4385 make_gap (total
- GAP_SIZE
);
4387 if (XINT (beg
) != 0 || !NILP (replace
))
4389 if (lseek (fd
, XINT (beg
), 0) < 0)
4390 report_file_error ("Setting file position",
4391 Fcons (orig_filename
, Qnil
));
4394 /* In the following loop, HOW_MUCH contains the total bytes read so
4395 far for a regular file, and not changed for a special file. But,
4396 before exiting the loop, it is set to a negative value if I/O
4400 /* Total bytes inserted. */
4403 /* Here, we don't do code conversion in the loop. It is done by
4404 code_convert_region after all data are read into the buffer. */
4406 int gap_size
= GAP_SIZE
;
4408 while (how_much
< total
)
4410 /* try is reserved in some compilers (Microsoft C) */
4411 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4418 /* Maybe make more room. */
4419 if (gap_size
< trytry
)
4421 make_gap (total
- gap_size
);
4422 gap_size
= GAP_SIZE
;
4425 /* Read from the file, capturing `quit'. When an
4426 error occurs, end the loop, and arrange for a quit
4427 to be signaled after decoding the text we read. */
4428 non_regular_fd
= fd
;
4429 non_regular_inserted
= inserted
;
4430 non_regular_nbytes
= trytry
;
4431 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4432 read_non_regular_quit
);
4443 /* Allow quitting out of the actual I/O. We don't make text
4444 part of the buffer until all the reading is done, so a C-g
4445 here doesn't do any harm. */
4448 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4460 /* For a regular file, where TOTAL is the real size,
4461 count HOW_MUCH to compare with it.
4462 For a special file, where TOTAL is just a buffer size,
4463 so don't bother counting in HOW_MUCH.
4464 (INSERTED is where we count the number of characters inserted.) */
4471 /* Make the text read part of the buffer. */
4472 GAP_SIZE
-= inserted
;
4474 GPT_BYTE
+= inserted
;
4476 ZV_BYTE
+= inserted
;
4481 /* Put an anchor to ensure multi-byte form ends at gap. */
4486 /* Discard the unwind protect for closing the file. */
4490 error ("IO error reading %s: %s",
4491 SDATA (orig_filename
), emacs_strerror (errno
));
4495 if (! coding_system_decided
)
4497 /* The coding system is not yet decided. Decide it by an
4498 optimized method for handling `coding:' tag.
4500 Note that we can get here only if the buffer was empty
4501 before the insertion. */
4505 if (!NILP (Vcoding_system_for_read
))
4506 val
= Vcoding_system_for_read
;
4509 /* Since we are sure that the current buffer was empty
4510 before the insertion, we can toggle
4511 enable-multibyte-characters directly here without taking
4512 care of marker adjustment and byte combining problem. By
4513 this way, we can run Lisp program safely before decoding
4514 the inserted text. */
4515 Lisp_Object unwind_data
;
4516 int count
= SPECPDL_INDEX ();
4518 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4519 Fcons (current_buffer
->undo_list
,
4520 Fcurrent_buffer ()));
4521 current_buffer
->enable_multibyte_characters
= Qnil
;
4522 current_buffer
->undo_list
= Qt
;
4523 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4525 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4527 val
= call2 (Vset_auto_coding_function
,
4528 filename
, make_number (inserted
));
4533 /* If the coding system is not yet decided, check
4534 file-coding-system-alist. */
4535 Lisp_Object args
[6], coding_systems
;
4537 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4538 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4539 coding_systems
= Ffind_operation_coding_system (6, args
);
4540 if (CONSP (coding_systems
))
4541 val
= XCAR (coding_systems
);
4544 unbind_to (count
, Qnil
);
4545 inserted
= Z_BYTE
- BEG_BYTE
;
4548 /* The following kludgy code is to avoid some compiler bug.
4550 setup_coding_system (val, &coding);
4553 struct coding_system temp_coding
;
4554 setup_coding_system (val
, &temp_coding
);
4555 bcopy (&temp_coding
, &coding
, sizeof coding
);
4557 /* Ensure we set Vlast_coding_system_used. */
4558 set_coding_system
= 1;
4560 if (NILP (current_buffer
->enable_multibyte_characters
)
4562 /* We must suppress all character code conversion except for
4563 end-of-line conversion. */
4564 setup_raw_text_coding_system (&coding
);
4565 coding
.src_multibyte
= 0;
4566 coding
.dst_multibyte
4567 = !NILP (current_buffer
->enable_multibyte_characters
);
4571 /* Can't do this if part of the buffer might be preserved. */
4573 && (coding
.type
== coding_type_no_conversion
4574 || coding
.type
== coding_type_raw_text
))
4576 /* Visiting a file with these coding system makes the buffer
4578 current_buffer
->enable_multibyte_characters
= Qnil
;
4579 coding
.dst_multibyte
= 0;
4582 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4584 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4586 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4588 inserted
= coding
.produced_char
;
4591 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4595 /* Now INSERTED is measured in characters. */
4598 /* Use the conversion type to determine buffer-file-type
4599 (find-buffer-file-type is now used to help determine the
4601 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4602 || coding
.eol_type
== CODING_EOL_LF
)
4603 && ! CODING_REQUIRE_DECODING (&coding
))
4604 current_buffer
->buffer_file_type
= Qt
;
4606 current_buffer
->buffer_file_type
= Qnil
;
4613 if (!EQ (current_buffer
->undo_list
, Qt
))
4614 current_buffer
->undo_list
= Qnil
;
4616 stat (SDATA (filename
), &st
);
4621 current_buffer
->modtime
= st
.st_mtime
;
4622 current_buffer
->filename
= orig_filename
;
4625 SAVE_MODIFF
= MODIFF
;
4626 current_buffer
->auto_save_modified
= MODIFF
;
4627 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4628 #ifdef CLASH_DETECTION
4631 if (!NILP (current_buffer
->file_truename
))
4632 unlock_file (current_buffer
->file_truename
);
4633 unlock_file (filename
);
4635 #endif /* CLASH_DETECTION */
4637 Fsignal (Qfile_error
,
4638 Fcons (build_string ("not a regular file"),
4639 Fcons (orig_filename
, Qnil
)));
4642 if (set_coding_system
)
4643 Vlast_coding_system_used
= coding
.symbol
;
4645 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4647 insval
= call1 (Qafter_insert_file_set_coding
, make_number (inserted
));
4648 if (! NILP (insval
))
4650 CHECK_NUMBER (insval
);
4651 inserted
= XFASTINT (insval
);
4655 /* Decode file format */
4658 int empty_undo_list_p
= 0;
4660 /* If we're anyway going to discard undo information, don't
4661 record it in the first place. The buffer's undo list at this
4662 point is either nil or t when visiting a file. */
4665 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4666 current_buffer
->undo_list
= Qt
;
4669 insval
= call3 (Qformat_decode
,
4670 Qnil
, make_number (inserted
), visit
);
4671 CHECK_NUMBER (insval
);
4672 inserted
= XFASTINT (insval
);
4675 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4678 /* Call after-change hooks for the inserted text, aside from the case
4679 of normal visiting (not with REPLACE), which is done in a new buffer
4680 "before" the buffer is changed. */
4681 if (inserted
> 0 && total
> 0
4682 && (NILP (visit
) || !NILP (replace
)))
4684 signal_after_change (PT
, 0, inserted
);
4685 update_compositions (PT
, PT
, CHECK_BORDER
);
4688 p
= Vafter_insert_file_functions
;
4691 insval
= call1 (XCAR (p
), make_number (inserted
));
4694 CHECK_NUMBER (insval
);
4695 inserted
= XFASTINT (insval
);
4702 && current_buffer
->modtime
== -1)
4704 /* If visiting nonexistent file, return nil. */
4705 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4709 Fsignal (Qquit
, Qnil
);
4711 /* ??? Retval needs to be dealt with in all cases consistently. */
4713 val
= Fcons (orig_filename
,
4714 Fcons (make_number (inserted
),
4717 RETURN_UNGCPRO (unbind_to (count
, val
));
4720 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4721 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4722 Lisp_Object
, Lisp_Object
));
4724 /* If build_annotations switched buffers, switch back to BUF.
4725 Kill the temporary buffer that was selected in the meantime.
4727 Since this kill only the last temporary buffer, some buffers remain
4728 not killed if build_annotations switched buffers more than once.
4732 build_annotations_unwind (buf
)
4737 if (XBUFFER (buf
) == current_buffer
)
4739 tembuf
= Fcurrent_buffer ();
4741 Fkill_buffer (tembuf
);
4745 /* Decide the coding-system to encode the data with. */
4748 choose_write_coding_system (start
, end
, filename
,
4749 append
, visit
, lockname
, coding
)
4750 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4751 struct coding_system
*coding
;
4756 && NILP (Fstring_equal (current_buffer
->filename
,
4757 current_buffer
->auto_save_file_name
)))
4759 /* We use emacs-mule for auto saving... */
4760 setup_coding_system (Qemacs_mule
, coding
);
4761 /* ... but with the special flag to indicate not to strip off
4762 leading code of eight-bit-control chars. */
4764 goto done_setup_coding
;
4766 else if (!NILP (Vcoding_system_for_write
))
4768 val
= Vcoding_system_for_write
;
4769 if (coding_system_require_warning
4770 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4771 /* Confirm that VAL can surely encode the current region. */
4772 val
= call5 (Vselect_safe_coding_system_function
,
4773 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4778 /* If the variable `buffer-file-coding-system' is set locally,
4779 it means that the file was read with some kind of code
4780 conversion or the variable is explicitly set by users. We
4781 had better write it out with the same coding system even if
4782 `enable-multibyte-characters' is nil.
4784 If it is not set locally, we anyway have to convert EOL
4785 format if the default value of `buffer-file-coding-system'
4786 tells that it is not Unix-like (LF only) format. */
4787 int using_default_coding
= 0;
4788 int force_raw_text
= 0;
4790 val
= current_buffer
->buffer_file_coding_system
;
4792 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4795 if (NILP (current_buffer
->enable_multibyte_characters
))
4801 /* Check file-coding-system-alist. */
4802 Lisp_Object args
[7], coding_systems
;
4804 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4805 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4807 coding_systems
= Ffind_operation_coding_system (7, args
);
4808 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4809 val
= XCDR (coding_systems
);
4813 && !NILP (current_buffer
->buffer_file_coding_system
))
4815 /* If we still have not decided a coding system, use the
4816 default value of buffer-file-coding-system. */
4817 val
= current_buffer
->buffer_file_coding_system
;
4818 using_default_coding
= 1;
4822 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4823 /* Confirm that VAL can surely encode the current region. */
4824 val
= call5 (Vselect_safe_coding_system_function
,
4825 start
, end
, val
, Qnil
, filename
);
4827 setup_coding_system (Fcheck_coding_system (val
), coding
);
4828 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4829 && !using_default_coding
)
4831 if (! EQ (default_buffer_file_coding
.symbol
,
4832 buffer_defaults
.buffer_file_coding_system
))
4833 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4834 &default_buffer_file_coding
);
4835 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4837 Lisp_Object subsidiaries
;
4839 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4840 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4841 if (VECTORP (subsidiaries
)
4842 && XVECTOR (subsidiaries
)->size
== 3)
4844 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4849 setup_raw_text_coding_system (coding
);
4850 goto done_setup_coding
;
4853 setup_coding_system (Fcheck_coding_system (val
), coding
);
4856 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4857 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4860 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4861 "r\nFWrite region to file: \ni\ni\ni\np",
4862 doc
: /* Write current region into specified file.
4863 When called from a program, requires three arguments:
4864 START, END and FILENAME. START and END are normally buffer positions
4865 specifying the part of the buffer to write.
4866 If START is nil, that means to use the entire buffer contents.
4867 If START is a string, then output that string to the file
4868 instead of any buffer contents; END is ignored.
4870 Optional fourth argument APPEND if non-nil means
4871 append to existing file contents (if any). If it is an integer,
4872 seek to that offset in the file before writing.
4873 Optional fifth argument VISIT, if t or a string, means
4874 set the last-save-file-modtime of buffer to this file's modtime
4875 and mark buffer not modified.
4876 If VISIT is a string, it is a second file name;
4877 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4878 VISIT is also the file name to lock and unlock for clash detection.
4879 If VISIT is neither t nor nil nor a string,
4880 that means do not display the \"Wrote file\" message.
4881 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4882 use for locking and unlocking, overriding FILENAME and VISIT.
4883 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4884 for an existing file with the same name. If MUSTBENEW is `excl',
4885 that means to get an error if the file already exists; never overwrite.
4886 If MUSTBENEW is neither nil nor `excl', that means ask for
4887 confirmation before overwriting, but do go ahead and overwrite the file
4888 if the user confirms.
4890 This does code conversion according to the value of
4891 `coding-system-for-write', `buffer-file-coding-system', or
4892 `file-coding-system-alist', and sets the variable
4893 `last-coding-system-used' to the coding system actually used. */)
4894 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4895 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4900 const unsigned char *fn
;
4903 int count
= SPECPDL_INDEX ();
4906 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4908 Lisp_Object handler
;
4909 Lisp_Object visit_file
;
4910 Lisp_Object annotations
;
4911 Lisp_Object encoded_filename
;
4912 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4913 int quietly
= !NILP (visit
);
4914 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4915 struct buffer
*given_buffer
;
4917 int buffer_file_type
= O_BINARY
;
4919 struct coding_system coding
;
4921 if (current_buffer
->base_buffer
&& visiting
)
4922 error ("Cannot do file visiting in an indirect buffer");
4924 if (!NILP (start
) && !STRINGP (start
))
4925 validate_region (&start
, &end
);
4927 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4929 filename
= Fexpand_file_name (filename
, Qnil
);
4931 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4932 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4934 if (STRINGP (visit
))
4935 visit_file
= Fexpand_file_name (visit
, Qnil
);
4937 visit_file
= filename
;
4939 if (NILP (lockname
))
4940 lockname
= visit_file
;
4944 /* If the file name has special constructs in it,
4945 call the corresponding file handler. */
4946 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4947 /* If FILENAME has no handler, see if VISIT has one. */
4948 if (NILP (handler
) && STRINGP (visit
))
4949 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4951 if (!NILP (handler
))
4954 val
= call6 (handler
, Qwrite_region
, start
, end
,
4955 filename
, append
, visit
);
4959 SAVE_MODIFF
= MODIFF
;
4960 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4961 current_buffer
->filename
= visit_file
;
4967 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4969 /* Special kludge to simplify auto-saving. */
4972 XSETFASTINT (start
, BEG
);
4973 XSETFASTINT (end
, Z
);
4977 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4978 count1
= SPECPDL_INDEX ();
4980 given_buffer
= current_buffer
;
4982 if (!STRINGP (start
))
4984 annotations
= build_annotations (start
, end
);
4986 if (current_buffer
!= given_buffer
)
4988 XSETFASTINT (start
, BEGV
);
4989 XSETFASTINT (end
, ZV
);
4995 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4997 /* Decide the coding-system to encode the data with.
4998 We used to make this choice before calling build_annotations, but that
4999 leads to problems when a write-annotate-function takes care of
5000 unsavable chars (as was the case with X-Symbol). */
5001 choose_write_coding_system (start
, end
, filename
,
5002 append
, visit
, lockname
, &coding
);
5003 Vlast_coding_system_used
= coding
.symbol
;
5005 given_buffer
= current_buffer
;
5006 if (! STRINGP (start
))
5008 annotations
= build_annotations_2 (start
, end
,
5009 coding
.pre_write_conversion
, annotations
);
5010 if (current_buffer
!= given_buffer
)
5012 XSETFASTINT (start
, BEGV
);
5013 XSETFASTINT (end
, ZV
);
5017 #ifdef CLASH_DETECTION
5020 #if 0 /* This causes trouble for GNUS. */
5021 /* If we've locked this file for some other buffer,
5022 query before proceeding. */
5023 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5024 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5027 lock_file (lockname
);
5029 #endif /* CLASH_DETECTION */
5031 encoded_filename
= ENCODE_FILE (filename
);
5033 fn
= SDATA (encoded_filename
);
5037 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5038 #else /* not DOS_NT */
5039 desc
= emacs_open (fn
, O_WRONLY
, 0);
5040 #endif /* not DOS_NT */
5042 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5044 if (auto_saving
) /* Overwrite any previous version of autosave file */
5046 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5047 desc
= emacs_open (fn
, O_RDWR
, 0);
5049 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5050 ? SDATA (current_buffer
->filename
) : 0,
5053 else /* Write to temporary name and rename if no errors */
5055 Lisp_Object temp_name
;
5056 temp_name
= Ffile_name_directory (filename
);
5058 if (!NILP (temp_name
))
5060 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5061 build_string ("$$SAVE$$")));
5062 fname
= SDATA (filename
);
5063 fn
= SDATA (temp_name
);
5064 desc
= creat_copy_attrs (fname
, fn
);
5067 /* If we can't open the temporary file, try creating a new
5068 version of the original file. VMS "creat" creates a
5069 new version rather than truncating an existing file. */
5072 desc
= creat (fn
, 0666);
5073 #if 0 /* This can clobber an existing file and fail to replace it,
5074 if the user runs out of space. */
5077 /* We can't make a new version;
5078 try to truncate and rewrite existing version if any. */
5080 desc
= emacs_open (fn
, O_RDWR
, 0);
5086 desc
= creat (fn
, 0666);
5090 desc
= emacs_open (fn
,
5091 O_WRONLY
| O_CREAT
| buffer_file_type
5092 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5093 S_IREAD
| S_IWRITE
);
5094 #else /* not DOS_NT */
5095 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5096 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5097 auto_saving
? auto_save_mode_bits
: 0666);
5098 #endif /* not DOS_NT */
5099 #endif /* not VMS */
5103 #ifdef CLASH_DETECTION
5105 if (!auto_saving
) unlock_file (lockname
);
5107 #endif /* CLASH_DETECTION */
5109 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5112 record_unwind_protect (close_file_unwind
, make_number (desc
));
5114 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5118 if (NUMBERP (append
))
5119 ret
= lseek (desc
, XINT (append
), 1);
5121 ret
= lseek (desc
, 0, 2);
5124 #ifdef CLASH_DETECTION
5125 if (!auto_saving
) unlock_file (lockname
);
5126 #endif /* CLASH_DETECTION */
5128 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5136 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5137 * if we do writes that don't end with a carriage return. Furthermore
5138 * it cannot handle writes of more then 16K. The modified
5139 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5140 * this EXCEPT for the last record (iff it doesn't end with a carriage
5141 * return). This implies that if your buffer doesn't end with a carriage
5142 * return, you get one free... tough. However it also means that if
5143 * we make two calls to sys_write (a la the following code) you can
5144 * get one at the gap as well. The easiest way to fix this (honest)
5145 * is to move the gap to the next newline (or the end of the buffer).
5150 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5151 move_gap (find_next_newline (GPT
, 1));
5153 /* Whether VMS or not, we must move the gap to the next of newline
5154 when we must put designation sequences at beginning of line. */
5155 if (INTEGERP (start
)
5156 && coding
.type
== coding_type_iso2022
5157 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5158 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5160 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5161 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5162 move_gap_both (PT
, PT_BYTE
);
5163 SET_PT_BOTH (opoint
, opoint_byte
);
5170 if (STRINGP (start
))
5172 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5173 &annotations
, &coding
);
5176 else if (XINT (start
) != XINT (end
))
5178 tem
= CHAR_TO_BYTE (XINT (start
));
5180 if (XINT (start
) < GPT
)
5182 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5183 min (GPT
, XINT (end
)) - XINT (start
),
5184 &annotations
, &coding
);
5188 if (XINT (end
) > GPT
&& !failure
)
5190 tem
= max (XINT (start
), GPT
);
5191 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5192 &annotations
, &coding
);
5198 /* If file was empty, still need to write the annotations */
5199 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5200 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5204 if (CODING_REQUIRE_FLUSHING (&coding
)
5205 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5208 /* We have to flush out a data. */
5209 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5210 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5217 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5218 Disk full in NFS may be reported here. */
5219 /* mib says that closing the file will try to write as fast as NFS can do
5220 it, and that means the fsync here is not crucial for autosave files. */
5221 if (!auto_saving
&& fsync (desc
) < 0)
5223 /* If fsync fails with EINTR, don't treat that as serious. */
5225 failure
= 1, save_errno
= errno
;
5229 /* Spurious "file has changed on disk" warnings have been
5230 observed on Suns as well.
5231 It seems that `close' can change the modtime, under nfs.
5233 (This has supposedly been fixed in Sunos 4,
5234 but who knows about all the other machines with NFS?) */
5237 /* On VMS and APOLLO, must do the stat after the close
5238 since closing changes the modtime. */
5241 /* Recall that #if defined does not work on VMS. */
5248 /* NFS can report a write failure now. */
5249 if (emacs_close (desc
) < 0)
5250 failure
= 1, save_errno
= errno
;
5253 /* If we wrote to a temporary name and had no errors, rename to real name. */
5257 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5265 /* Discard the unwind protect for close_file_unwind. */
5266 specpdl_ptr
= specpdl
+ count1
;
5267 /* Restore the original current buffer. */
5268 visit_file
= unbind_to (count
, visit_file
);
5270 #ifdef CLASH_DETECTION
5272 unlock_file (lockname
);
5273 #endif /* CLASH_DETECTION */
5275 /* Do this before reporting IO error
5276 to avoid a "file has changed on disk" warning on
5277 next attempt to save. */
5279 current_buffer
->modtime
= st
.st_mtime
;
5282 error ("IO error writing %s: %s", SDATA (filename
),
5283 emacs_strerror (save_errno
));
5287 SAVE_MODIFF
= MODIFF
;
5288 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5289 current_buffer
->filename
= visit_file
;
5290 update_mode_lines
++;
5295 && ! NILP (Fstring_equal (current_buffer
->filename
,
5296 current_buffer
->auto_save_file_name
)))
5297 SAVE_MODIFF
= MODIFF
;
5303 message_with_string ((INTEGERP (append
)
5313 Lisp_Object
merge ();
5315 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5316 doc
: /* Return t if (car A) is numerically less than (car B). */)
5320 return Flss (Fcar (a
), Fcar (b
));
5323 /* Build the complete list of annotations appropriate for writing out
5324 the text between START and END, by calling all the functions in
5325 write-region-annotate-functions and merging the lists they return.
5326 If one of these functions switches to a different buffer, we assume
5327 that buffer contains altered text. Therefore, the caller must
5328 make sure to restore the current buffer in all cases,
5329 as save-excursion would do. */
5332 build_annotations (start
, end
)
5333 Lisp_Object start
, end
;
5335 Lisp_Object annotations
;
5337 struct gcpro gcpro1
, gcpro2
;
5338 Lisp_Object original_buffer
;
5339 int i
, used_global
= 0;
5341 XSETBUFFER (original_buffer
, current_buffer
);
5344 p
= Vwrite_region_annotate_functions
;
5345 GCPRO2 (annotations
, p
);
5348 struct buffer
*given_buffer
= current_buffer
;
5349 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5350 { /* Use the global value of the hook. */
5353 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5355 p
= Fappend (2, arg
);
5358 Vwrite_region_annotations_so_far
= annotations
;
5359 res
= call2 (XCAR (p
), start
, end
);
5360 /* If the function makes a different buffer current,
5361 assume that means this buffer contains altered text to be output.
5362 Reset START and END from the buffer bounds
5363 and discard all previous annotations because they should have
5364 been dealt with by this function. */
5365 if (current_buffer
!= given_buffer
)
5367 XSETFASTINT (start
, BEGV
);
5368 XSETFASTINT (end
, ZV
);
5371 Flength (res
); /* Check basic validity of return value */
5372 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5376 /* Now do the same for annotation functions implied by the file-format */
5377 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5378 p
= Vauto_save_file_format
;
5380 p
= current_buffer
->file_format
;
5381 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5383 struct buffer
*given_buffer
= current_buffer
;
5385 Vwrite_region_annotations_so_far
= annotations
;
5387 /* Value is either a list of annotations or nil if the function
5388 has written annotations to a temporary buffer, which is now
5390 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5391 original_buffer
, make_number (i
));
5392 if (current_buffer
!= given_buffer
)
5394 XSETFASTINT (start
, BEGV
);
5395 XSETFASTINT (end
, ZV
);
5400 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5408 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5409 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5411 struct gcpro gcpro1
;
5414 GCPRO1 (annotations
);
5415 /* At last, do the same for the function PRE_WRITE_CONVERSION
5416 implied by the current coding-system. */
5417 if (!NILP (pre_write_conversion
))
5419 struct buffer
*given_buffer
= current_buffer
;
5420 Vwrite_region_annotations_so_far
= annotations
;
5421 res
= call2 (pre_write_conversion
, start
, end
);
5423 annotations
= (current_buffer
!= given_buffer
5425 : merge (annotations
, res
, Qcar_less_than_car
));
5432 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5433 If STRING is nil, POS is the character position in the current buffer.
5434 Intersperse with them the annotations from *ANNOT
5435 which fall within the range of POS to POS + NCHARS,
5436 each at its appropriate position.
5438 We modify *ANNOT by discarding elements as we use them up.
5440 The return value is negative in case of system call failure. */
5443 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5446 register int nchars
;
5449 struct coding_system
*coding
;
5453 int lastpos
= pos
+ nchars
;
5455 while (NILP (*annot
) || CONSP (*annot
))
5457 tem
= Fcar_safe (Fcar (*annot
));
5460 nextpos
= XFASTINT (tem
);
5462 /* If there are no more annotations in this range,
5463 output the rest of the range all at once. */
5464 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5465 return e_write (desc
, string
, pos
, lastpos
, coding
);
5467 /* Output buffer text up to the next annotation's position. */
5470 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5474 /* Output the annotation. */
5475 tem
= Fcdr (Fcar (*annot
));
5478 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5481 *annot
= Fcdr (*annot
);
5486 #ifndef WRITE_BUF_SIZE
5487 #define WRITE_BUF_SIZE (16 * 1024)
5490 /* Write text in the range START and END into descriptor DESC,
5491 encoding them with coding system CODING. If STRING is nil, START
5492 and END are character positions of the current buffer, else they
5493 are indexes to the string STRING. */
5496 e_write (desc
, string
, start
, end
, coding
)
5500 struct coding_system
*coding
;
5502 register char *addr
;
5503 register int nbytes
;
5504 char buf
[WRITE_BUF_SIZE
];
5508 coding
->composing
= COMPOSITION_DISABLED
;
5509 if (coding
->composing
!= COMPOSITION_DISABLED
)
5510 coding_save_composition (coding
, start
, end
, string
);
5512 if (STRINGP (string
))
5514 addr
= SDATA (string
);
5515 nbytes
= SBYTES (string
);
5516 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5518 else if (start
< end
)
5520 /* It is assured that the gap is not in the range START and END-1. */
5521 addr
= CHAR_POS_ADDR (start
);
5522 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5523 coding
->src_multibyte
5524 = !NILP (current_buffer
->enable_multibyte_characters
);
5530 coding
->src_multibyte
= 1;
5533 /* We used to have a code for handling selective display here. But,
5534 now it is handled within encode_coding. */
5539 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5540 if (coding
->produced
> 0)
5542 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5543 if (coding
->produced
)
5549 nbytes
-= coding
->consumed
;
5550 addr
+= coding
->consumed
;
5551 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5554 /* The source text ends by an incomplete multibyte form.
5555 There's no way other than write it out as is. */
5556 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5565 start
+= coding
->consumed_char
;
5566 if (coding
->cmp_data
)
5567 coding_adjust_composition_offset (coding
, start
);
5570 if (coding
->cmp_data
)
5571 coding_free_composition_data (coding
);
5576 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5577 Sverify_visited_file_modtime
, 1, 1, 0,
5578 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5579 This means that the file has not been changed since it was visited or saved.
5580 See Info node `(elisp)Modification Time' for more details. */)
5586 Lisp_Object handler
;
5587 Lisp_Object filename
;
5592 if (!STRINGP (b
->filename
)) return Qt
;
5593 if (b
->modtime
== 0) return Qt
;
5595 /* If the file name has special constructs in it,
5596 call the corresponding file handler. */
5597 handler
= Ffind_file_name_handler (b
->filename
,
5598 Qverify_visited_file_modtime
);
5599 if (!NILP (handler
))
5600 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5602 filename
= ENCODE_FILE (b
->filename
);
5604 if (stat (SDATA (filename
), &st
) < 0)
5606 /* If the file doesn't exist now and didn't exist before,
5607 we say that it isn't modified, provided the error is a tame one. */
5608 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5613 if (st
.st_mtime
== b
->modtime
5614 /* If both are positive, accept them if they are off by one second. */
5615 || (st
.st_mtime
> 0 && b
->modtime
> 0
5616 && (st
.st_mtime
== b
->modtime
+ 1
5617 || st
.st_mtime
== b
->modtime
- 1)))
5622 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5623 Sclear_visited_file_modtime
, 0, 0, 0,
5624 doc
: /* Clear out records of last mod time of visited file.
5625 Next attempt to save will certainly not complain of a discrepancy. */)
5628 current_buffer
->modtime
= 0;
5632 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5633 Svisited_file_modtime
, 0, 0, 0,
5634 doc
: /* Return the current buffer's recorded visited file modification time.
5635 The value is a list of the form (HIGH LOW), like the time values
5636 that `file-attributes' returns. If the current buffer has no recorded
5637 file modification time, this function returns 0.
5638 See Info node `(elisp)Modification Time' for more details. */)
5642 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5644 return list2 (XCAR (tcons
), XCDR (tcons
));
5648 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5649 Sset_visited_file_modtime
, 0, 1, 0,
5650 doc
: /* Update buffer's recorded modification time from the visited file's time.
5651 Useful if the buffer was not read from the file normally
5652 or if the file itself has been changed for some known benign reason.
5653 An argument specifies the modification time value to use
5654 \(instead of that of the visited file), in the form of a list
5655 \(HIGH . LOW) or (HIGH LOW). */)
5657 Lisp_Object time_list
;
5659 if (!NILP (time_list
))
5660 current_buffer
->modtime
= cons_to_long (time_list
);
5663 register Lisp_Object filename
;
5665 Lisp_Object handler
;
5667 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5669 /* If the file name has special constructs in it,
5670 call the corresponding file handler. */
5671 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5672 if (!NILP (handler
))
5673 /* The handler can find the file name the same way we did. */
5674 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5676 filename
= ENCODE_FILE (filename
);
5678 if (stat (SDATA (filename
), &st
) >= 0)
5679 current_buffer
->modtime
= st
.st_mtime
;
5686 auto_save_error (error
)
5689 Lisp_Object args
[3], msg
;
5691 struct gcpro gcpro1
;
5693 ring_bell (XFRAME (selected_frame
));
5695 args
[0] = build_string ("Auto-saving %s: %s");
5696 args
[1] = current_buffer
->name
;
5697 args
[2] = Ferror_message_string (error
);
5698 msg
= Fformat (3, args
);
5700 nbytes
= SBYTES (msg
);
5702 for (i
= 0; i
< 3; ++i
)
5705 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5707 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5708 Fsleep_for (make_number (1), Qnil
);
5720 /* Get visited file's mode to become the auto save file's mode. */
5721 if (! NILP (current_buffer
->filename
)
5722 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5723 /* But make sure we can overwrite it later! */
5724 auto_save_mode_bits
= st
.st_mode
| 0600;
5726 auto_save_mode_bits
= 0666;
5729 Fwrite_region (Qnil
, Qnil
,
5730 current_buffer
->auto_save_file_name
,
5731 Qnil
, Qlambda
, Qnil
, Qnil
);
5735 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5740 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5741 | XFASTINT (XCDR (stream
))));
5746 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5749 minibuffer_auto_raise
= XINT (value
);
5754 do_auto_save_make_dir (dir
)
5757 return call2 (Qmake_directory
, dir
, Qt
);
5761 do_auto_save_eh (ignore
)
5767 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5768 doc
: /* Auto-save all buffers that need it.
5769 This is all buffers that have auto-saving enabled
5770 and are changed since last auto-saved.
5771 Auto-saving writes the buffer into a file
5772 so that your editing is not lost if the system crashes.
5773 This file is not the file you visited; that changes only when you save.
5774 Normally we run the normal hook `auto-save-hook' before saving.
5776 A non-nil NO-MESSAGE argument means do not print any message if successful.
5777 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5778 (no_message
, current_only
)
5779 Lisp_Object no_message
, current_only
;
5781 struct buffer
*old
= current_buffer
, *b
;
5782 Lisp_Object tail
, buf
;
5784 int do_handled_files
;
5787 Lisp_Object lispstream
;
5788 int count
= SPECPDL_INDEX ();
5789 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5790 int old_message_p
= 0;
5791 struct gcpro gcpro1
, gcpro2
;
5793 if (max_specpdl_size
< specpdl_size
+ 40)
5794 max_specpdl_size
= specpdl_size
+ 40;
5799 if (NILP (no_message
))
5801 old_message_p
= push_message ();
5802 record_unwind_protect (pop_message_unwind
, Qnil
);
5805 /* Ordinarily don't quit within this function,
5806 but don't make it impossible to quit (in case we get hung in I/O). */
5810 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5811 point to non-strings reached from Vbuffer_alist. */
5813 if (!NILP (Vrun_hooks
))
5814 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5816 if (STRINGP (Vauto_save_list_file_name
))
5818 Lisp_Object listfile
;
5820 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5822 /* Don't try to create the directory when shutting down Emacs,
5823 because creating the directory might signal an error, and
5824 that would leave Emacs in a strange state. */
5825 if (!NILP (Vrun_hooks
))
5829 GCPRO2 (dir
, listfile
);
5830 dir
= Ffile_name_directory (listfile
);
5831 if (NILP (Ffile_directory_p (dir
)))
5832 internal_condition_case_1 (do_auto_save_make_dir
,
5833 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5838 stream
= fopen (SDATA (listfile
), "w");
5841 /* Arrange to close that file whether or not we get an error.
5842 Also reset auto_saving to 0. */
5843 lispstream
= Fcons (Qnil
, Qnil
);
5844 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5845 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5856 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5857 record_unwind_protect (do_auto_save_unwind_1
,
5858 make_number (minibuffer_auto_raise
));
5859 minibuffer_auto_raise
= 0;
5862 /* On first pass, save all files that don't have handlers.
5863 On second pass, save all files that do have handlers.
5865 If Emacs is crashing, the handlers may tweak what is causing
5866 Emacs to crash in the first place, and it would be a shame if
5867 Emacs failed to autosave perfectly ordinary files because it
5868 couldn't handle some ange-ftp'd file. */
5870 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5871 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5873 buf
= XCDR (XCAR (tail
));
5876 /* Record all the buffers that have auto save mode
5877 in the special file that lists them. For each of these buffers,
5878 Record visited name (if any) and auto save name. */
5879 if (STRINGP (b
->auto_save_file_name
)
5880 && stream
!= NULL
&& do_handled_files
== 0)
5882 if (!NILP (b
->filename
))
5884 fwrite (SDATA (b
->filename
), 1,
5885 SBYTES (b
->filename
), stream
);
5887 putc ('\n', stream
);
5888 fwrite (SDATA (b
->auto_save_file_name
), 1,
5889 SBYTES (b
->auto_save_file_name
), stream
);
5890 putc ('\n', stream
);
5893 if (!NILP (current_only
)
5894 && b
!= current_buffer
)
5897 /* Don't auto-save indirect buffers.
5898 The base buffer takes care of it. */
5902 /* Check for auto save enabled
5903 and file changed since last auto save
5904 and file changed since last real save. */
5905 if (STRINGP (b
->auto_save_file_name
)
5906 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5907 && b
->auto_save_modified
< BUF_MODIFF (b
)
5908 /* -1 means we've turned off autosaving for a while--see below. */
5909 && XINT (b
->save_length
) >= 0
5910 && (do_handled_files
5911 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5914 EMACS_TIME before_time
, after_time
;
5916 EMACS_GET_TIME (before_time
);
5918 /* If we had a failure, don't try again for 20 minutes. */
5919 if (b
->auto_save_failure_time
>= 0
5920 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5923 if ((XFASTINT (b
->save_length
) * 10
5924 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5925 /* A short file is likely to change a large fraction;
5926 spare the user annoying messages. */
5927 && XFASTINT (b
->save_length
) > 5000
5928 /* These messages are frequent and annoying for `*mail*'. */
5929 && !EQ (b
->filename
, Qnil
)
5930 && NILP (no_message
))
5932 /* It has shrunk too much; turn off auto-saving here. */
5933 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5934 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5936 minibuffer_auto_raise
= 0;
5937 /* Turn off auto-saving until there's a real save,
5938 and prevent any more warnings. */
5939 XSETINT (b
->save_length
, -1);
5940 Fsleep_for (make_number (1), Qnil
);
5943 set_buffer_internal (b
);
5944 if (!auto_saved
&& NILP (no_message
))
5945 message1 ("Auto-saving...");
5946 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5948 b
->auto_save_modified
= BUF_MODIFF (b
);
5949 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5950 set_buffer_internal (old
);
5952 EMACS_GET_TIME (after_time
);
5954 /* If auto-save took more than 60 seconds,
5955 assume it was an NFS failure that got a timeout. */
5956 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5957 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5961 /* Prevent another auto save till enough input events come in. */
5962 record_auto_save ();
5964 if (auto_saved
&& NILP (no_message
))
5968 /* If we are going to restore an old message,
5969 give time to read ours. */
5970 sit_for (1, 0, 0, 0, 0);
5974 /* If we displayed a message and then restored a state
5975 with no message, leave a "done" message on the screen. */
5976 message1 ("Auto-saving...done");
5981 /* This restores the message-stack status. */
5982 unbind_to (count
, Qnil
);
5986 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5987 Sset_buffer_auto_saved
, 0, 0, 0,
5988 doc
: /* Mark current buffer as auto-saved with its current text.
5989 No auto-save file will be written until the buffer changes again. */)
5992 current_buffer
->auto_save_modified
= MODIFF
;
5993 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5994 current_buffer
->auto_save_failure_time
= -1;
5998 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5999 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6000 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6003 current_buffer
->auto_save_failure_time
= -1;
6007 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6009 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
6012 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6015 /* Reading and completing file names */
6016 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6018 /* In the string VAL, change each $ to $$ and return the result. */
6021 double_dollars (val
)
6024 register const unsigned char *old
;
6025 register unsigned char *new;
6029 osize
= SBYTES (val
);
6031 /* Count the number of $ characters. */
6032 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6033 if (*old
++ == '$') count
++;
6037 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6040 for (n
= osize
; n
> 0; n
--)
6054 read_file_name_cleanup (arg
)
6057 return (current_buffer
->directory
= arg
);
6060 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6062 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6063 (string
, dir
, action
)
6064 Lisp_Object string
, dir
, action
;
6065 /* action is nil for complete, t for return list of completions,
6066 lambda for verify final value */
6068 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6070 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6072 CHECK_STRING (string
);
6079 /* No need to protect ACTION--we only compare it with t and nil. */
6080 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6082 if (SCHARS (string
) == 0)
6084 if (EQ (action
, Qlambda
))
6092 orig_string
= string
;
6093 string
= Fsubstitute_in_file_name (string
);
6094 changed
= NILP (Fstring_equal (string
, orig_string
));
6095 name
= Ffile_name_nondirectory (string
);
6096 val
= Ffile_name_directory (string
);
6098 realdir
= Fexpand_file_name (val
, realdir
);
6103 specdir
= Ffile_name_directory (string
);
6104 val
= Ffile_name_completion (name
, realdir
);
6109 return double_dollars (string
);
6113 if (!NILP (specdir
))
6114 val
= concat2 (specdir
, val
);
6116 return double_dollars (val
);
6119 #endif /* not VMS */
6123 if (EQ (action
, Qt
))
6125 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6129 if (NILP (Vread_file_name_predicate
)
6130 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6134 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6136 /* Brute-force speed up for directory checking:
6137 Discard strings which don't end in a slash. */
6138 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6140 Lisp_Object tem
= XCAR (all
);
6142 if (STRINGP (tem
) &&
6143 (len
= SCHARS (tem
), len
> 0) &&
6144 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6145 comp
= Fcons (tem
, comp
);
6151 /* Must do it the hard (and slow) way. */
6152 GCPRO3 (all
, comp
, specdir
);
6153 count
= SPECPDL_INDEX ();
6154 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6155 current_buffer
->directory
= realdir
;
6156 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6157 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6158 comp
= Fcons (XCAR (all
), comp
);
6159 unbind_to (count
, Qnil
);
6162 return Fnreverse (comp
);
6165 /* Only other case actually used is ACTION = lambda */
6167 /* Supposedly this helps commands such as `cd' that read directory names,
6168 but can someone explain how it helps them? -- RMS */
6169 if (SCHARS (name
) == 0)
6172 string
= Fexpand_file_name (string
, dir
);
6173 if (!NILP (Vread_file_name_predicate
))
6174 return call1 (Vread_file_name_predicate
, string
);
6175 return Ffile_exists_p (string
);
6178 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6179 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6180 Value is not expanded---you must call `expand-file-name' yourself.
6181 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6182 the same non-empty string that was inserted by this function.
6183 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6184 except that if INITIAL is specified, that combined with DIR is used.)
6185 If the user exits with an empty minibuffer, this function returns
6186 an empty string. (This can only happen if the user erased the
6187 pre-inserted contents or if `insert-default-directory' is nil.)
6188 Fourth arg MUSTMATCH non-nil means require existing file's name.
6189 Non-nil and non-t means also require confirmation after completion.
6190 Fifth arg INITIAL specifies text to start with.
6191 If optional sixth arg PREDICATE is non-nil, possible completions and
6192 the resulting file name must satisfy (funcall PREDICATE NAME).
6193 DIR should be an absolute directory name. It defaults to the value of
6194 `default-directory'.
6196 If this command was invoked with the mouse, use a file dialog box if
6197 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6198 provides a file dialog box.
6200 See also `read-file-name-completion-ignore-case'
6201 and `read-file-name-function'. */)
6202 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6203 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6205 Lisp_Object val
, insdef
, tem
;
6206 struct gcpro gcpro1
, gcpro2
;
6207 register char *homedir
;
6208 Lisp_Object decoded_homedir
;
6209 int replace_in_history
= 0;
6210 int add_to_history
= 0;
6214 dir
= current_buffer
->directory
;
6215 if (NILP (Ffile_name_absolute_p (dir
)))
6216 dir
= Fexpand_file_name (dir
, Qnil
);
6217 if (NILP (default_filename
))
6220 ? Fexpand_file_name (initial
, dir
)
6221 : current_buffer
->filename
);
6223 /* If dir starts with user's homedir, change that to ~. */
6224 homedir
= (char *) egetenv ("HOME");
6226 /* homedir can be NULL in temacs, since Vprocess_environment is not
6227 yet set up. We shouldn't crash in that case. */
6230 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6231 CORRECT_DIR_SEPS (homedir
);
6236 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6239 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6240 SBYTES (decoded_homedir
))
6241 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6243 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6244 dir
= concat2 (build_string ("~"), dir
);
6246 /* Likewise for default_filename. */
6248 && STRINGP (default_filename
)
6249 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6250 SBYTES (decoded_homedir
))
6251 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6254 = Fsubstring (default_filename
,
6255 make_number (SCHARS (decoded_homedir
)), Qnil
);
6256 default_filename
= concat2 (build_string ("~"), default_filename
);
6258 if (!NILP (default_filename
))
6260 CHECK_STRING (default_filename
);
6261 default_filename
= double_dollars (default_filename
);
6264 if (insert_default_directory
&& STRINGP (dir
))
6267 if (!NILP (initial
))
6269 Lisp_Object args
[2], pos
;
6273 insdef
= Fconcat (2, args
);
6274 pos
= make_number (SCHARS (double_dollars (dir
)));
6275 insdef
= Fcons (double_dollars (insdef
), pos
);
6278 insdef
= double_dollars (insdef
);
6280 else if (STRINGP (initial
))
6281 insdef
= Fcons (double_dollars (initial
), make_number (0));
6285 if (!NILP (Vread_file_name_function
))
6287 Lisp_Object args
[7];
6289 GCPRO2 (insdef
, default_filename
);
6290 args
[0] = Vread_file_name_function
;
6293 args
[3] = default_filename
;
6294 args
[4] = mustmatch
;
6296 args
[6] = predicate
;
6297 RETURN_UNGCPRO (Ffuncall (7, args
));
6300 count
= SPECPDL_INDEX ();
6301 specbind (intern ("completion-ignore-case"),
6302 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6303 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6304 specbind (intern ("read-file-name-predicate"),
6305 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6307 GCPRO2 (insdef
, default_filename
);
6309 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
6310 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6315 /* If DIR contains a file name, split it. */
6317 file
= Ffile_name_nondirectory (dir
);
6318 if (SCHARS (file
) && NILP (default_filename
))
6320 default_filename
= file
;
6321 dir
= Ffile_name_directory (dir
);
6323 if (!NILP(default_filename
))
6324 default_filename
= Fexpand_file_name (default_filename
, dir
);
6325 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6330 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6331 dir
, mustmatch
, insdef
,
6332 Qfile_name_history
, default_filename
, Qnil
);
6334 tem
= Fsymbol_value (Qfile_name_history
);
6335 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6336 replace_in_history
= 1;
6338 /* If Fcompleting_read returned the inserted default string itself
6339 (rather than a new string with the same contents),
6340 it has to mean that the user typed RET with the minibuffer empty.
6341 In that case, we really want to return ""
6342 so that commands such as set-visited-file-name can distinguish. */
6343 if (EQ (val
, default_filename
))
6345 /* In this case, Fcompleting_read has not added an element
6346 to the history. Maybe we should. */
6347 if (! replace_in_history
)
6353 unbind_to (count
, Qnil
);
6356 error ("No file name specified");
6358 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6360 if (!NILP (tem
) && !NILP (default_filename
))
6361 val
= default_filename
;
6362 val
= Fsubstitute_in_file_name (val
);
6364 if (replace_in_history
)
6365 /* Replace what Fcompleting_read added to the history
6366 with what we will actually return. */
6367 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6368 else if (add_to_history
)
6370 /* Add the value to the history--but not if it matches
6371 the last value already there. */
6372 Lisp_Object val1
= double_dollars (val
);
6373 tem
= Fsymbol_value (Qfile_name_history
);
6374 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6375 Fset (Qfile_name_history
,
6386 /* Must be set before any path manipulation is performed. */
6387 XSETFASTINT (Vdirectory_sep_char
, '/');
6394 Qexpand_file_name
= intern ("expand-file-name");
6395 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6396 Qdirectory_file_name
= intern ("directory-file-name");
6397 Qfile_name_directory
= intern ("file-name-directory");
6398 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6399 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6400 Qfile_name_as_directory
= intern ("file-name-as-directory");
6401 Qcopy_file
= intern ("copy-file");
6402 Qmake_directory_internal
= intern ("make-directory-internal");
6403 Qmake_directory
= intern ("make-directory");
6404 Qdelete_directory
= intern ("delete-directory");
6405 Qdelete_file
= intern ("delete-file");
6406 Qrename_file
= intern ("rename-file");
6407 Qadd_name_to_file
= intern ("add-name-to-file");
6408 Qmake_symbolic_link
= intern ("make-symbolic-link");
6409 Qfile_exists_p
= intern ("file-exists-p");
6410 Qfile_executable_p
= intern ("file-executable-p");
6411 Qfile_readable_p
= intern ("file-readable-p");
6412 Qfile_writable_p
= intern ("file-writable-p");
6413 Qfile_symlink_p
= intern ("file-symlink-p");
6414 Qaccess_file
= intern ("access-file");
6415 Qfile_directory_p
= intern ("file-directory-p");
6416 Qfile_regular_p
= intern ("file-regular-p");
6417 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6418 Qfile_modes
= intern ("file-modes");
6419 Qset_file_modes
= intern ("set-file-modes");
6420 Qset_file_times
= intern ("set-file-times");
6421 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6422 Qinsert_file_contents
= intern ("insert-file-contents");
6423 Qwrite_region
= intern ("write-region");
6424 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6425 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6426 Qauto_save_coding
= intern ("auto-save-coding");
6428 staticpro (&Qexpand_file_name
);
6429 staticpro (&Qsubstitute_in_file_name
);
6430 staticpro (&Qdirectory_file_name
);
6431 staticpro (&Qfile_name_directory
);
6432 staticpro (&Qfile_name_nondirectory
);
6433 staticpro (&Qunhandled_file_name_directory
);
6434 staticpro (&Qfile_name_as_directory
);
6435 staticpro (&Qcopy_file
);
6436 staticpro (&Qmake_directory_internal
);
6437 staticpro (&Qmake_directory
);
6438 staticpro (&Qdelete_directory
);
6439 staticpro (&Qdelete_file
);
6440 staticpro (&Qrename_file
);
6441 staticpro (&Qadd_name_to_file
);
6442 staticpro (&Qmake_symbolic_link
);
6443 staticpro (&Qfile_exists_p
);
6444 staticpro (&Qfile_executable_p
);
6445 staticpro (&Qfile_readable_p
);
6446 staticpro (&Qfile_writable_p
);
6447 staticpro (&Qaccess_file
);
6448 staticpro (&Qfile_symlink_p
);
6449 staticpro (&Qfile_directory_p
);
6450 staticpro (&Qfile_regular_p
);
6451 staticpro (&Qfile_accessible_directory_p
);
6452 staticpro (&Qfile_modes
);
6453 staticpro (&Qset_file_modes
);
6454 staticpro (&Qset_file_times
);
6455 staticpro (&Qfile_newer_than_file_p
);
6456 staticpro (&Qinsert_file_contents
);
6457 staticpro (&Qwrite_region
);
6458 staticpro (&Qverify_visited_file_modtime
);
6459 staticpro (&Qset_visited_file_modtime
);
6460 staticpro (&Qauto_save_coding
);
6462 Qfile_name_history
= intern ("file-name-history");
6463 Fset (Qfile_name_history
, Qnil
);
6464 staticpro (&Qfile_name_history
);
6466 Qfile_error
= intern ("file-error");
6467 staticpro (&Qfile_error
);
6468 Qfile_already_exists
= intern ("file-already-exists");
6469 staticpro (&Qfile_already_exists
);
6470 Qfile_date_error
= intern ("file-date-error");
6471 staticpro (&Qfile_date_error
);
6472 Qexcl
= intern ("excl");
6476 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6477 staticpro (&Qfind_buffer_file_type
);
6480 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6481 doc
: /* *Coding system for encoding file names.
6482 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6483 Vfile_name_coding_system
= Qnil
;
6485 DEFVAR_LISP ("default-file-name-coding-system",
6486 &Vdefault_file_name_coding_system
,
6487 doc
: /* Default coding system for encoding file names.
6488 This variable is used only when `file-name-coding-system' is nil.
6490 This variable is set/changed by the command `set-language-environment'.
6491 User should not set this variable manually,
6492 instead use `file-name-coding-system' to get a constant encoding
6493 of file names regardless of the current language environment. */);
6494 Vdefault_file_name_coding_system
= Qnil
;
6496 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6497 doc
: /* *Format in which to write auto-save files.
6498 Should be a list of symbols naming formats that are defined in `format-alist'.
6499 If it is t, which is the default, auto-save files are written in the
6500 same format as a regular save would use. */);
6501 Vauto_save_file_format
= Qt
;
6503 Qformat_decode
= intern ("format-decode");
6504 staticpro (&Qformat_decode
);
6505 Qformat_annotate_function
= intern ("format-annotate-function");
6506 staticpro (&Qformat_annotate_function
);
6507 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6508 staticpro (&Qafter_insert_file_set_coding
);
6510 Qcar_less_than_car
= intern ("car-less-than-car");
6511 staticpro (&Qcar_less_than_car
);
6513 Fput (Qfile_error
, Qerror_conditions
,
6514 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6515 Fput (Qfile_error
, Qerror_message
,
6516 build_string ("File error"));
6518 Fput (Qfile_already_exists
, Qerror_conditions
,
6519 Fcons (Qfile_already_exists
,
6520 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6521 Fput (Qfile_already_exists
, Qerror_message
,
6522 build_string ("File already exists"));
6524 Fput (Qfile_date_error
, Qerror_conditions
,
6525 Fcons (Qfile_date_error
,
6526 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6527 Fput (Qfile_date_error
, Qerror_message
,
6528 build_string ("Cannot set file date"));
6530 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6531 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6532 Vread_file_name_function
= Qnil
;
6534 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6535 doc
: /* Current predicate used by `read-file-name-internal'. */);
6536 Vread_file_name_predicate
= Qnil
;
6538 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6539 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6540 #if defined VMS || defined DOS_NT || defined MAC_OS
6541 read_file_name_completion_ignore_case
= 1;
6543 read_file_name_completion_ignore_case
= 0;
6546 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6547 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6548 If the initial minibuffer contents are non-empty, you can usually
6549 request a default filename by typing RETURN without editing. For some
6550 commands, exiting with an empty minibuffer has a special meaning,
6551 such as making the current buffer visit no file in the case of
6552 `set-visited-file-name'.
6553 If this variable is non-nil, the minibuffer contents are always
6554 initially non-empty and typing RETURN without editing will fetch the
6555 default name, if one is provided. Note however that this default name
6556 is not necessarily the name originally inserted in the minibuffer, if
6557 that is just the default directory.
6558 If this variable is nil, the minibuffer often starts out empty. In
6559 that case you may have to explicitly fetch the next history element to
6560 request the default name. */);
6561 insert_default_directory
= 1;
6563 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6564 doc
: /* *Non-nil means write new files with record format `stmlf'.
6565 nil means use format `var'. This variable is meaningful only on VMS. */);
6566 vms_stmlf_recfm
= 0;
6568 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6569 doc
: /* Directory separator character for built-in functions that return file names.
6570 The value is always ?/. Don't use this variable, just use `/'. */);
6572 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6573 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6574 If a file name matches REGEXP, then all I/O on that file is done by calling
6577 The first argument given to HANDLER is the name of the I/O primitive
6578 to be handled; the remaining arguments are the arguments that were
6579 passed to that primitive. For example, if you do
6580 (file-exists-p FILENAME)
6581 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6582 (funcall HANDLER 'file-exists-p FILENAME)
6583 The function `find-file-name-handler' checks this list for a handler
6584 for its argument. */);
6585 Vfile_name_handler_alist
= Qnil
;
6587 DEFVAR_LISP ("set-auto-coding-function",
6588 &Vset_auto_coding_function
,
6589 doc
: /* If non-nil, a function to call to decide a coding system of file.
6590 Two arguments are passed to this function: the file name
6591 and the length of a file contents following the point.
6592 This function should return a coding system to decode the file contents.
6593 It should check the file name against `auto-coding-alist'.
6594 If no coding system is decided, it should check a coding system
6595 specified in the heading lines with the format:
6596 -*- ... coding: CODING-SYSTEM; ... -*-
6597 or local variable spec of the tailing lines with `coding:' tag. */);
6598 Vset_auto_coding_function
= Qnil
;
6600 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6601 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6602 Each is passed one argument, the number of characters inserted.
6603 It should return the new character count, and leave point the same.
6604 If `insert-file-contents' is intercepted by a handler from
6605 `file-name-handler-alist', that handler is responsible for calling the
6606 functions in `after-insert-file-functions' if appropriate. */);
6607 Vafter_insert_file_functions
= Qnil
;
6609 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6610 doc
: /* A list of functions to be called at the start of `write-region'.
6611 Each is passed two arguments, START and END as for `write-region'.
6612 These are usually two numbers but not always; see the documentation
6613 for `write-region'. The function should return a list of pairs
6614 of the form (POSITION . STRING), consisting of strings to be effectively
6615 inserted at the specified positions of the file being written (1 means to
6616 insert before the first byte written). The POSITIONs must be sorted into
6617 increasing order. If there are several functions in the list, the several
6618 lists are merged destructively. Alternatively, the function can return
6619 with a different buffer current; in that case it should pay attention
6620 to the annotations returned by previous functions and listed in
6621 `write-region-annotations-so-far'.*/);
6622 Vwrite_region_annotate_functions
= Qnil
;
6623 staticpro (&Qwrite_region_annotate_functions
);
6624 Qwrite_region_annotate_functions
6625 = intern ("write-region-annotate-functions");
6627 DEFVAR_LISP ("write-region-annotations-so-far",
6628 &Vwrite_region_annotations_so_far
,
6629 doc
: /* When an annotation function is called, this holds the previous annotations.
6630 These are the annotations made by other annotation functions
6631 that were already called. See also `write-region-annotate-functions'. */);
6632 Vwrite_region_annotations_so_far
= Qnil
;
6634 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6635 doc
: /* A list of file name handlers that temporarily should not be used.
6636 This applies only to the operation `inhibit-file-name-operation'. */);
6637 Vinhibit_file_name_handlers
= Qnil
;
6639 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6640 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6641 Vinhibit_file_name_operation
= Qnil
;
6643 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6644 doc
: /* File name in which we write a list of all auto save file names.
6645 This variable is initialized automatically from `auto-save-list-file-prefix'
6646 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6647 a non-nil value. */);
6648 Vauto_save_list_file_name
= Qnil
;
6650 defsubr (&Sfind_file_name_handler
);
6651 defsubr (&Sfile_name_directory
);
6652 defsubr (&Sfile_name_nondirectory
);
6653 defsubr (&Sunhandled_file_name_directory
);
6654 defsubr (&Sfile_name_as_directory
);
6655 defsubr (&Sdirectory_file_name
);
6656 defsubr (&Smake_temp_name
);
6657 defsubr (&Sexpand_file_name
);
6658 defsubr (&Ssubstitute_in_file_name
);
6659 defsubr (&Scopy_file
);
6660 defsubr (&Smake_directory_internal
);
6661 defsubr (&Sdelete_directory
);
6662 defsubr (&Sdelete_file
);
6663 defsubr (&Srename_file
);
6664 defsubr (&Sadd_name_to_file
);
6666 defsubr (&Smake_symbolic_link
);
6667 #endif /* S_IFLNK */
6669 defsubr (&Sdefine_logical_name
);
6672 defsubr (&Ssysnetunam
);
6673 #endif /* HPUX_NET */
6674 defsubr (&Sfile_name_absolute_p
);
6675 defsubr (&Sfile_exists_p
);
6676 defsubr (&Sfile_executable_p
);
6677 defsubr (&Sfile_readable_p
);
6678 defsubr (&Sfile_writable_p
);
6679 defsubr (&Saccess_file
);
6680 defsubr (&Sfile_symlink_p
);
6681 defsubr (&Sfile_directory_p
);
6682 defsubr (&Sfile_accessible_directory_p
);
6683 defsubr (&Sfile_regular_p
);
6684 defsubr (&Sfile_modes
);
6685 defsubr (&Sset_file_modes
);
6686 defsubr (&Sset_file_times
);
6687 defsubr (&Sset_default_file_modes
);
6688 defsubr (&Sdefault_file_modes
);
6689 defsubr (&Sfile_newer_than_file_p
);
6690 defsubr (&Sinsert_file_contents
);
6691 defsubr (&Swrite_region
);
6692 defsubr (&Scar_less_than_car
);
6693 defsubr (&Sverify_visited_file_modtime
);
6694 defsubr (&Sclear_visited_file_modtime
);
6695 defsubr (&Svisited_file_modtime
);
6696 defsubr (&Sset_visited_file_modtime
);
6697 defsubr (&Sdo_auto_save
);
6698 defsubr (&Sset_buffer_auto_saved
);
6699 defsubr (&Sclear_buffer_auto_save_failure
);
6700 defsubr (&Srecent_auto_save_p
);
6702 defsubr (&Sread_file_name_internal
);
6703 defsubr (&Sread_file_name
);
6706 defsubr (&Sunix_sync
);
6710 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6711 (do not change this comment) */