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"
87 #endif /* not WINDOWSNT */
91 #include <sys/param.h>
99 #define CORRECT_DIR_SEPS(s) \
100 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
101 else unixtodos_filename (s); \
103 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
104 redirector allows the six letters between 'Z' and 'a' as well. */
106 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
109 #define IS_DRIVE(x) isalpha (x)
111 /* Need to lower-case the drive letter, or else expanded
112 filenames will sometimes compare inequal, because
113 `expand-file-name' doesn't always down-case the drive letter. */
114 #define DRIVE_LETTER(x) (tolower (x))
135 #include "commands.h"
136 extern int use_dialog_box
;
137 extern int use_file_dialog
;
151 /* Nonzero during writing of auto-save files */
154 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
155 a new file with the same mode as the original */
156 int auto_save_mode_bits
;
158 /* The symbol bound to coding-system-for-read when
159 insert-file-contents is called for recovering a file. This is not
160 an actual coding system name, but just an indicator to tell
161 insert-file-contents to use `emacs-mule' with a special flag for
162 auto saving and recovering a file. */
163 Lisp_Object Qauto_save_coding
;
165 /* Coding system for file names, or nil if none. */
166 Lisp_Object Vfile_name_coding_system
;
168 /* Coding system for file names used only when
169 Vfile_name_coding_system is nil. */
170 Lisp_Object Vdefault_file_name_coding_system
;
172 /* Alist of elements (REGEXP . HANDLER) for file names
173 whose I/O is done with a special handler. */
174 Lisp_Object Vfile_name_handler_alist
;
176 /* Format for auto-save files */
177 Lisp_Object Vauto_save_file_format
;
179 /* Lisp functions for translating file formats */
180 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
182 /* Function to be called to decide a coding system of a reading file. */
183 Lisp_Object Vset_auto_coding_function
;
185 /* Functions to be called to process text properties in inserted file. */
186 Lisp_Object Vafter_insert_file_functions
;
188 /* Lisp function for setting buffer-file-coding-system and the
189 multibyteness of the current buffer after inserting a file. */
190 Lisp_Object Qafter_insert_file_set_coding
;
192 /* Functions to be called to create text property annotations for file. */
193 Lisp_Object Vwrite_region_annotate_functions
;
194 Lisp_Object Qwrite_region_annotate_functions
;
196 /* During build_annotations, each time an annotation function is called,
197 this holds the annotations made by the previous functions. */
198 Lisp_Object Vwrite_region_annotations_so_far
;
200 /* File name in which we write a list of all our auto save files. */
201 Lisp_Object Vauto_save_list_file_name
;
203 /* Function to call to read a file name. */
204 Lisp_Object Vread_file_name_function
;
206 /* Current predicate used by read_file_name_internal. */
207 Lisp_Object Vread_file_name_predicate
;
209 /* Nonzero means completion ignores case when reading file name. */
210 int read_file_name_completion_ignore_case
;
212 /* Nonzero means, when reading a filename in the minibuffer,
213 start out by inserting the default directory into the minibuffer. */
214 int insert_default_directory
;
216 /* On VMS, nonzero means write new files with record format stmlf.
217 Zero means use var format. */
220 /* On NT, specifies the directory separator character, used (eg.) when
221 expanding file names. This can be bound to / or \. */
222 Lisp_Object Vdirectory_sep_char
;
224 extern Lisp_Object Vuser_login_name
;
227 extern Lisp_Object Vw32_get_true_file_attributes
;
230 extern int minibuf_level
;
232 extern int minibuffer_auto_raise
;
234 /* These variables describe handlers that have "already" had a chance
235 to handle the current operation.
237 Vinhibit_file_name_handlers is a list of file name handlers.
238 Vinhibit_file_name_operation is the operation being handled.
239 If we try to handle that operation, we ignore those handlers. */
241 static Lisp_Object Vinhibit_file_name_handlers
;
242 static Lisp_Object Vinhibit_file_name_operation
;
244 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
246 Lisp_Object Qfile_name_history
;
248 Lisp_Object Qcar_less_than_car
;
250 static int a_write
P_ ((int, Lisp_Object
, int, int,
251 Lisp_Object
*, struct coding_system
*));
252 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
256 report_file_error (string
, data
)
260 Lisp_Object errstring
;
263 synchronize_system_messages_locale ();
264 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
265 Vlocale_coding_system
, 0);
271 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
274 /* System error messages are capitalized. Downcase the initial
275 unless it is followed by a slash. */
276 if (SREF (errstring
, 1) != '/')
277 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
279 Fsignal (Qfile_error
,
280 Fcons (build_string (string
), Fcons (errstring
, data
)));
285 close_file_unwind (fd
)
288 emacs_close (XFASTINT (fd
));
292 /* Restore point, having saved it as a marker. */
295 restore_point_unwind (location
)
296 Lisp_Object location
;
298 Fgoto_char (location
);
299 Fset_marker (location
, Qnil
, Qnil
);
303 Lisp_Object Qexpand_file_name
;
304 Lisp_Object Qsubstitute_in_file_name
;
305 Lisp_Object Qdirectory_file_name
;
306 Lisp_Object Qfile_name_directory
;
307 Lisp_Object Qfile_name_nondirectory
;
308 Lisp_Object Qunhandled_file_name_directory
;
309 Lisp_Object Qfile_name_as_directory
;
310 Lisp_Object Qcopy_file
;
311 Lisp_Object Qmake_directory_internal
;
312 Lisp_Object Qmake_directory
;
313 Lisp_Object Qdelete_directory
;
314 Lisp_Object Qdelete_file
;
315 Lisp_Object Qrename_file
;
316 Lisp_Object Qadd_name_to_file
;
317 Lisp_Object Qmake_symbolic_link
;
318 Lisp_Object Qfile_exists_p
;
319 Lisp_Object Qfile_executable_p
;
320 Lisp_Object Qfile_readable_p
;
321 Lisp_Object Qfile_writable_p
;
322 Lisp_Object Qfile_symlink_p
;
323 Lisp_Object Qaccess_file
;
324 Lisp_Object Qfile_directory_p
;
325 Lisp_Object Qfile_regular_p
;
326 Lisp_Object Qfile_accessible_directory_p
;
327 Lisp_Object Qfile_modes
;
328 Lisp_Object Qset_file_modes
;
329 Lisp_Object Qset_file_times
;
330 Lisp_Object Qfile_newer_than_file_p
;
331 Lisp_Object Qinsert_file_contents
;
332 Lisp_Object Qwrite_region
;
333 Lisp_Object Qverify_visited_file_modtime
;
334 Lisp_Object Qset_visited_file_modtime
;
336 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
337 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
338 Otherwise, return nil.
339 A file name is handled if one of the regular expressions in
340 `file-name-handler-alist' matches it.
342 If OPERATION equals `inhibit-file-name-operation', then we ignore
343 any handlers that are members of `inhibit-file-name-handlers',
344 but we still do run any other handlers. This lets handlers
345 use the standard functions without calling themselves recursively. */)
346 (filename
, operation
)
347 Lisp_Object filename
, operation
;
349 /* This function must not munge the match data. */
350 Lisp_Object chain
, inhibited_handlers
, result
;
354 CHECK_STRING (filename
);
356 if (EQ (operation
, Vinhibit_file_name_operation
))
357 inhibited_handlers
= Vinhibit_file_name_handlers
;
359 inhibited_handlers
= Qnil
;
361 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
362 chain
= XCDR (chain
))
372 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
374 Lisp_Object handler
, tem
;
376 handler
= XCDR (elt
);
377 tem
= Fmemq (handler
, inhibited_handlers
);
391 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
393 doc
: /* Return the directory component in file name FILENAME.
394 Return nil if FILENAME does not include a directory.
395 Otherwise return a directory spec.
396 Given a Unix syntax file name, returns a string ending in slash;
397 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
399 Lisp_Object filename
;
402 register const unsigned char *beg
;
404 register unsigned char *beg
;
406 register const unsigned char *p
;
409 CHECK_STRING (filename
);
411 /* If the file name has special constructs in it,
412 call the corresponding file handler. */
413 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
415 return call2 (handler
, Qfile_name_directory
, filename
);
417 #ifdef FILE_SYSTEM_CASE
418 filename
= FILE_SYSTEM_CASE (filename
);
420 beg
= SDATA (filename
);
422 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
424 p
= beg
+ SBYTES (filename
);
426 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
428 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
431 /* only recognise drive specifier at the beginning */
433 /* handle the "/:d:foo" and "/:foo" cases correctly */
434 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
435 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
442 /* Expansion of "c:" to drive and default directory. */
445 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
446 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
447 unsigned char *r
= res
;
449 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
451 strncpy (res
, beg
, 2);
456 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
458 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
461 p
= beg
+ strlen (beg
);
464 CORRECT_DIR_SEPS (beg
);
467 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
470 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
471 Sfile_name_nondirectory
, 1, 1, 0,
472 doc
: /* Return file name FILENAME sans its directory.
473 For example, in a Unix-syntax file name,
474 this is everything after the last slash,
475 or the entire name if it contains no slash. */)
477 Lisp_Object filename
;
479 register const unsigned char *beg
, *p
, *end
;
482 CHECK_STRING (filename
);
484 /* If the file name has special constructs in it,
485 call the corresponding file handler. */
486 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
488 return call2 (handler
, Qfile_name_nondirectory
, filename
);
490 beg
= SDATA (filename
);
491 end
= p
= beg
+ SBYTES (filename
);
493 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
495 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
498 /* only recognise drive specifier at beginning */
500 /* handle the "/:d:foo" case correctly */
501 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
506 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
509 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
510 Sunhandled_file_name_directory
, 1, 1, 0,
511 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
512 A `directly usable' directory name is one that may be used without the
513 intervention of any file handler.
514 If FILENAME is a directly usable file itself, return
515 \(file-name-directory FILENAME).
516 The `call-process' and `start-process' functions use this function to
517 get a current directory to run processes in. */)
519 Lisp_Object filename
;
523 /* If the file name has special constructs in it,
524 call the corresponding file handler. */
525 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
527 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
529 return Ffile_name_directory (filename
);
534 file_name_as_directory (out
, in
)
537 int size
= strlen (in
) - 1;
550 /* Is it already a directory string? */
551 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
553 /* Is it a VMS directory file name? If so, hack VMS syntax. */
554 else if (! index (in
, '/')
555 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
556 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
557 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
558 || ! strncmp (&in
[size
- 5], ".dir", 4))
559 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
560 && in
[size
] == '1')))
562 register char *p
, *dot
;
566 dir:x.dir --> dir:[x]
567 dir:[x]y.dir --> dir:[x.y] */
569 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
572 strncpy (out
, in
, p
- in
);
591 dot
= index (p
, '.');
594 /* blindly remove any extension */
595 size
= strlen (out
) + (dot
- p
);
596 strncat (out
, p
, dot
- p
);
607 /* For Unix syntax, Append a slash if necessary */
608 if (!IS_DIRECTORY_SEP (out
[size
]))
610 /* Cannot use DIRECTORY_SEP, which could have any value */
612 out
[size
+ 2] = '\0';
615 CORRECT_DIR_SEPS (out
);
621 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
622 Sfile_name_as_directory
, 1, 1, 0,
623 doc
: /* Return a string representing the file name FILE interpreted as a directory.
624 This operation exists because a directory is also a file, but its name as
625 a directory is different from its name as a file.
626 The result can be used as the value of `default-directory'
627 or passed as second argument to `expand-file-name'.
628 For a Unix-syntax file name, just appends a slash.
629 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
640 /* If the file name has special constructs in it,
641 call the corresponding file handler. */
642 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
644 return call2 (handler
, Qfile_name_as_directory
, file
);
646 buf
= (char *) alloca (SBYTES (file
) + 10);
647 file_name_as_directory (buf
, SDATA (file
));
648 return make_specified_string (buf
, -1, strlen (buf
),
649 STRING_MULTIBYTE (file
));
653 * Convert from directory name to filename.
655 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
656 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
657 * On UNIX, it's simple: just make sure there isn't a terminating /
659 * Value is nonzero if the string output is different from the input.
663 directory_file_name (src
, dst
)
671 struct FAB fab
= cc$rms_fab
;
672 struct NAM nam
= cc$rms_nam
;
673 char esa
[NAM$C_MAXRSS
];
678 if (! index (src
, '/')
679 && (src
[slen
- 1] == ']'
680 || src
[slen
- 1] == ':'
681 || src
[slen
- 1] == '>'))
683 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
685 fab
.fab$b_fns
= slen
;
686 fab
.fab$l_nam
= &nam
;
687 fab
.fab$l_fop
= FAB$M_NAM
;
690 nam
.nam$b_ess
= sizeof esa
;
691 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
693 /* We call SYS$PARSE to handle such things as [--] for us. */
694 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
696 slen
= nam
.nam$b_esl
;
697 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
702 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
704 /* what about when we have logical_name:???? */
705 if (src
[slen
- 1] == ':')
706 { /* Xlate logical name and see what we get */
707 ptr
= strcpy (dst
, src
); /* upper case for getenv */
710 if ('a' <= *ptr
&& *ptr
<= 'z')
714 dst
[slen
- 1] = 0; /* remove colon */
715 if (!(src
= egetenv (dst
)))
717 /* should we jump to the beginning of this procedure?
718 Good points: allows us to use logical names that xlate
720 Bad points: can be a problem if we just translated to a device
722 For now, I'll punt and always expect VMS names, and hope for
725 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
726 { /* no recursion here! */
732 { /* not a directory spec */
737 bracket
= src
[slen
- 1];
739 /* If bracket is ']' or '>', bracket - 2 is the corresponding
741 ptr
= index (src
, bracket
- 2);
743 { /* no opening bracket */
747 if (!(rptr
= rindex (src
, '.')))
750 strncpy (dst
, src
, slen
);
754 dst
[slen
++] = bracket
;
759 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
760 then translate the device and recurse. */
761 if (dst
[slen
- 1] == ':'
762 && dst
[slen
- 2] != ':' /* skip decnet nodes */
763 && strcmp (src
+ slen
, "[000000]") == 0)
765 dst
[slen
- 1] = '\0';
766 if ((ptr
= egetenv (dst
))
767 && (rlen
= strlen (ptr
) - 1) > 0
768 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
769 && ptr
[rlen
- 1] == '.')
771 char * buf
= (char *) alloca (strlen (ptr
) + 1);
775 return directory_file_name (buf
, dst
);
780 strcat (dst
, "[000000]");
784 rlen
= strlen (rptr
) - 1;
785 strncat (dst
, rptr
, rlen
);
786 dst
[slen
+ rlen
] = '\0';
787 strcat (dst
, ".DIR.1");
791 /* Process as Unix format: just remove any final slash.
792 But leave "/" unchanged; do not change it to "". */
795 /* Handle // as root for apollo's. */
796 if ((slen
> 2 && dst
[slen
- 1] == '/')
797 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
801 && IS_DIRECTORY_SEP (dst
[slen
- 1])
803 && !IS_ANY_SEP (dst
[slen
- 2])
809 CORRECT_DIR_SEPS (dst
);
814 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
816 doc
: /* Returns the file name of the directory named DIRECTORY.
817 This is the name of the file that holds the data for the directory DIRECTORY.
818 This operation exists because a directory is also a file, but its name as
819 a directory is different from its name as a file.
820 In Unix-syntax, this function just removes the final slash.
821 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
822 it returns a file name such as \"[X]Y.DIR.1\". */)
824 Lisp_Object directory
;
829 CHECK_STRING (directory
);
831 if (NILP (directory
))
834 /* If the file name has special constructs in it,
835 call the corresponding file handler. */
836 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
838 return call2 (handler
, Qdirectory_file_name
, directory
);
841 /* 20 extra chars is insufficient for VMS, since we might perform a
842 logical name translation. an equivalence string can be up to 255
843 chars long, so grab that much extra space... - sss */
844 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
846 buf
= (char *) alloca (SBYTES (directory
) + 20);
848 directory_file_name (SDATA (directory
), buf
);
849 return make_specified_string (buf
, -1, strlen (buf
),
850 STRING_MULTIBYTE (directory
));
853 static char make_temp_name_tbl
[64] =
855 'A','B','C','D','E','F','G','H',
856 'I','J','K','L','M','N','O','P',
857 'Q','R','S','T','U','V','W','X',
858 'Y','Z','a','b','c','d','e','f',
859 'g','h','i','j','k','l','m','n',
860 'o','p','q','r','s','t','u','v',
861 'w','x','y','z','0','1','2','3',
862 '4','5','6','7','8','9','-','_'
865 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
867 /* Value is a temporary file name starting with PREFIX, a string.
869 The Emacs process number forms part of the result, so there is
870 no danger of generating a name being used by another process.
871 In addition, this function makes an attempt to choose a name
872 which has no existing file. To make this work, PREFIX should be
873 an absolute file name.
875 BASE64_P non-zero means add the pid as 3 characters in base64
876 encoding. In this case, 6 characters will be added to PREFIX to
877 form the file name. Otherwise, if Emacs is running on a system
878 with long file names, add the pid as a decimal number.
880 This function signals an error if no unique file name could be
884 make_temp_name (prefix
, base64_p
)
891 unsigned char *p
, *data
;
895 CHECK_STRING (prefix
);
897 /* VAL is created by adding 6 characters to PREFIX. The first
898 three are the PID of this process, in base 64, and the second
899 three are incremented if the file already exists. This ensures
900 262144 unique file names per PID per PREFIX. */
902 pid
= (int) getpid ();
906 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
907 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
908 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
913 #ifdef HAVE_LONG_FILE_NAMES
914 sprintf (pidbuf
, "%d", pid
);
915 pidlen
= strlen (pidbuf
);
917 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
918 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
919 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
924 len
= SCHARS (prefix
);
925 val
= make_uninit_string (len
+ 3 + pidlen
);
927 bcopy(SDATA (prefix
), data
, len
);
930 bcopy (pidbuf
, p
, pidlen
);
933 /* Here we try to minimize useless stat'ing when this function is
934 invoked many times successively with the same PREFIX. We achieve
935 this by initializing count to a random value, and incrementing it
938 We don't want make-temp-name to be called while dumping,
939 because then make_temp_name_count_initialized_p would get set
940 and then make_temp_name_count would not be set when Emacs starts. */
942 if (!make_temp_name_count_initialized_p
)
944 make_temp_name_count
= (unsigned) time (NULL
);
945 make_temp_name_count_initialized_p
= 1;
951 unsigned num
= make_temp_name_count
;
953 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
954 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
955 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
957 /* Poor man's congruential RN generator. Replace with
958 ++make_temp_name_count for debugging. */
959 make_temp_name_count
+= 25229;
960 make_temp_name_count
%= 225307;
962 if (stat (data
, &ignored
) < 0)
964 /* We want to return only if errno is ENOENT. */
968 /* The error here is dubious, but there is little else we
969 can do. The alternatives are to return nil, which is
970 as bad as (and in many cases worse than) throwing the
971 error, or to ignore the error, which will likely result
972 in looping through 225307 stat's, which is not only
973 dog-slow, but also useless since it will fallback to
974 the errow below, anyway. */
975 report_file_error ("Cannot create temporary name for prefix",
976 Fcons (prefix
, Qnil
));
981 error ("Cannot create temporary name for prefix `%s'",
987 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
988 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
989 The Emacs process number forms part of the result,
990 so there is no danger of generating a name being used by another process.
992 In addition, this function makes an attempt to choose a name
993 which has no existing file. To make this work,
994 PREFIX should be an absolute file name.
996 There is a race condition between calling `make-temp-name' and creating the
997 file which opens all kinds of security holes. For that reason, you should
998 probably use `make-temp-file' instead, except in three circumstances:
1000 * If you are creating the file in the user's home directory.
1001 * If you are creating a directory rather than an ordinary file.
1002 * If you are taking special precautions as `make-temp-file' does. */)
1006 return make_temp_name (prefix
, 0);
1011 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1012 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1013 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1014 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1015 the current buffer's value of default-directory is used.
1016 File name components that are `.' are removed, and
1017 so are file name components followed by `..', along with the `..' itself;
1018 note that these simplifications are done without checking the resulting
1019 file names in the file system.
1020 An initial `~/' expands to your home directory.
1021 An initial `~USER/' expands to USER's home directory.
1022 See also the function `substitute-in-file-name'. */)
1023 (name
, default_directory
)
1024 Lisp_Object name
, default_directory
;
1028 register unsigned char *newdir
, *p
, *o
;
1030 unsigned char *target
;
1033 unsigned char * colon
= 0;
1034 unsigned char * close
= 0;
1035 unsigned char * slash
= 0;
1036 unsigned char * brack
= 0;
1037 int lbrack
= 0, rbrack
= 0;
1042 int collapse_newdir
= 1;
1046 Lisp_Object handler
, result
;
1048 CHECK_STRING (name
);
1050 /* If the file name has special constructs in it,
1051 call the corresponding file handler. */
1052 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1053 if (!NILP (handler
))
1054 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1056 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1057 if (NILP (default_directory
))
1058 default_directory
= current_buffer
->directory
;
1059 if (! STRINGP (default_directory
))
1062 /* "/" is not considered a root directory on DOS_NT, so using "/"
1063 here causes an infinite recursion in, e.g., the following:
1065 (let (default-directory)
1066 (expand-file-name "a"))
1068 To avoid this, we set default_directory to the root of the
1070 extern char *emacs_root_dir (void);
1072 default_directory
= build_string (emacs_root_dir ());
1074 default_directory
= build_string ("/");
1078 if (!NILP (default_directory
))
1080 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1081 if (!NILP (handler
))
1082 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1085 o
= SDATA (default_directory
);
1087 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1088 It would be better to do this down below where we actually use
1089 default_directory. Unfortunately, calling Fexpand_file_name recursively
1090 could invoke GC, and the strings might be relocated. This would
1091 be annoying because we have pointers into strings lying around
1092 that would need adjusting, and people would add new pointers to
1093 the code and forget to adjust them, resulting in intermittent bugs.
1094 Putting this call here avoids all that crud.
1096 The EQ test avoids infinite recursion. */
1097 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1098 /* Save time in some common cases - as long as default_directory
1099 is not relative, it can be canonicalized with name below (if it
1100 is needed at all) without requiring it to be expanded now. */
1102 /* Detect MSDOS file names with drive specifiers. */
1103 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1105 /* Detect Windows file names in UNC format. */
1106 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1108 #else /* not DOS_NT */
1109 /* Detect Unix absolute file names (/... alone is not absolute on
1111 && ! (IS_DIRECTORY_SEP (o
[0]))
1112 #endif /* not DOS_NT */
1115 struct gcpro gcpro1
;
1118 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1123 /* Filenames on VMS are always upper case. */
1124 name
= Fupcase (name
);
1126 #ifdef FILE_SYSTEM_CASE
1127 name
= FILE_SYSTEM_CASE (name
);
1133 /* We will force directory separators to be either all \ or /, so make
1134 a local copy to modify, even if there ends up being no change. */
1135 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1137 /* Note if special escape prefix is present, but remove for now. */
1138 if (nm
[0] == '/' && nm
[1] == ':')
1144 /* Find and remove drive specifier if present; this makes nm absolute
1145 even if the rest of the name appears to be relative. Only look for
1146 drive specifier at the beginning. */
1147 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1154 /* If we see "c://somedir", we want to strip the first slash after the
1155 colon when stripping the drive letter. Otherwise, this expands to
1157 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1159 #endif /* WINDOWSNT */
1163 /* Discard any previous drive specifier if nm is now in UNC format. */
1164 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1170 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1171 none are found, we can probably return right away. We will avoid
1172 allocating a new string if name is already fully expanded. */
1174 IS_DIRECTORY_SEP (nm
[0])
1176 && drive
&& !is_escaped
1179 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1186 /* If it turns out that the filename we want to return is just a
1187 suffix of FILENAME, we don't need to go through and edit
1188 things; we just need to construct a new string using data
1189 starting at the middle of FILENAME. If we set lose to a
1190 non-zero value, that means we've discovered that we can't do
1197 /* Since we know the name is absolute, we can assume that each
1198 element starts with a "/". */
1200 /* "." and ".." are hairy. */
1201 if (IS_DIRECTORY_SEP (p
[0])
1203 && (IS_DIRECTORY_SEP (p
[2])
1205 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1208 /* We want to replace multiple `/' in a row with a single
1211 && IS_DIRECTORY_SEP (p
[0])
1212 && IS_DIRECTORY_SEP (p
[1]))
1219 /* if dev:[dir]/, move nm to / */
1220 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1221 nm
= (brack
? brack
+ 1 : colon
+ 1);
1222 lbrack
= rbrack
= 0;
1230 /* VMS pre V4.4,convert '-'s in filenames. */
1231 if (lbrack
== rbrack
)
1233 if (dots
< 2) /* this is to allow negative version numbers */
1238 if (lbrack
> rbrack
&&
1239 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1240 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1246 /* count open brackets, reset close bracket pointer */
1247 if (p
[0] == '[' || p
[0] == '<')
1248 lbrack
++, brack
= 0;
1249 /* count close brackets, set close bracket pointer */
1250 if (p
[0] == ']' || p
[0] == '>')
1251 rbrack
++, brack
= p
;
1252 /* detect ][ or >< */
1253 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1255 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1256 nm
= p
+ 1, lose
= 1;
1257 if (p
[0] == ':' && (colon
|| slash
))
1258 /* if dev1:[dir]dev2:, move nm to dev2: */
1264 /* if /name/dev:, move nm to dev: */
1267 /* if node::dev:, move colon following dev */
1268 else if (colon
&& colon
[-1] == ':')
1270 /* if dev1:dev2:, move nm to dev2: */
1271 else if (colon
&& colon
[-1] != ':')
1276 if (p
[0] == ':' && !colon
)
1282 if (lbrack
== rbrack
)
1285 else if (p
[0] == '.')
1293 if (index (nm
, '/'))
1295 nm
= sys_translate_unix (nm
);
1296 return make_specified_string (nm
, -1, strlen (nm
),
1297 STRING_MULTIBYTE (name
));
1301 /* Make sure directories are all separated with / or \ as
1302 desired, but avoid allocation of a new string when not
1304 CORRECT_DIR_SEPS (nm
);
1306 if (IS_DIRECTORY_SEP (nm
[1]))
1308 if (strcmp (nm
, SDATA (name
)) != 0)
1309 name
= make_specified_string (nm
, -1, strlen (nm
),
1310 STRING_MULTIBYTE (name
));
1314 /* drive must be set, so this is okay */
1315 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1319 name
= make_specified_string (nm
, -1, p
- nm
,
1320 STRING_MULTIBYTE (name
));
1321 temp
[0] = DRIVE_LETTER (drive
);
1322 name
= concat2 (build_string (temp
), name
);
1325 #else /* not DOS_NT */
1326 if (nm
== SDATA (name
))
1328 return make_specified_string (nm
, -1, strlen (nm
),
1329 STRING_MULTIBYTE (name
));
1330 #endif /* not DOS_NT */
1334 /* At this point, nm might or might not be an absolute file name. We
1335 need to expand ~ or ~user if present, otherwise prefix nm with
1336 default_directory if nm is not absolute, and finally collapse /./
1337 and /foo/../ sequences.
1339 We set newdir to be the appropriate prefix if one is needed:
1340 - the relevant user directory if nm starts with ~ or ~user
1341 - the specified drive's working dir (DOS/NT only) if nm does not
1343 - the value of default_directory.
1345 Note that these prefixes are not guaranteed to be absolute (except
1346 for the working dir of a drive). Therefore, to ensure we always
1347 return an absolute name, if the final prefix is not absolute we
1348 append it to the current working directory. */
1352 if (nm
[0] == '~') /* prefix ~ */
1354 if (IS_DIRECTORY_SEP (nm
[1])
1358 || nm
[1] == 0) /* ~ by itself */
1360 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1361 newdir
= (unsigned char *) "";
1364 collapse_newdir
= 0;
1367 nm
++; /* Don't leave the slash in nm. */
1370 else /* ~user/filename */
1372 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1377 o
= (unsigned char *) alloca (p
- nm
+ 1);
1378 bcopy ((char *) nm
, o
, p
- nm
);
1381 pw
= (struct passwd
*) getpwnam (o
+ 1);
1384 newdir
= (unsigned char *) pw
-> pw_dir
;
1386 nm
= p
+ 1; /* skip the terminator */
1390 collapse_newdir
= 0;
1395 /* If we don't find a user of that name, leave the name
1396 unchanged; don't move nm forward to p. */
1401 /* On DOS and Windows, nm is absolute if a drive name was specified;
1402 use the drive's current directory as the prefix if needed. */
1403 if (!newdir
&& drive
)
1405 /* Get default directory if needed to make nm absolute. */
1406 if (!IS_DIRECTORY_SEP (nm
[0]))
1408 newdir
= alloca (MAXPATHLEN
+ 1);
1409 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1414 /* Either nm starts with /, or drive isn't mounted. */
1415 newdir
= alloca (4);
1416 newdir
[0] = DRIVE_LETTER (drive
);
1424 /* Finally, if no prefix has been specified and nm is not absolute,
1425 then it must be expanded relative to default_directory. */
1429 /* /... alone is not absolute on DOS and Windows. */
1430 && !IS_DIRECTORY_SEP (nm
[0])
1433 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1440 newdir
= SDATA (default_directory
);
1442 /* Note if special escape prefix is present, but remove for now. */
1443 if (newdir
[0] == '/' && newdir
[1] == ':')
1454 /* First ensure newdir is an absolute name. */
1456 /* Detect MSDOS file names with drive specifiers. */
1457 ! (IS_DRIVE (newdir
[0])
1458 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1460 /* Detect Windows file names in UNC format. */
1461 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1465 /* Effectively, let newdir be (expand-file-name newdir cwd).
1466 Because of the admonition against calling expand-file-name
1467 when we have pointers into lisp strings, we accomplish this
1468 indirectly by prepending newdir to nm if necessary, and using
1469 cwd (or the wd of newdir's drive) as the new newdir. */
1471 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1476 if (!IS_DIRECTORY_SEP (nm
[0]))
1478 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1479 file_name_as_directory (tmp
, newdir
);
1483 newdir
= alloca (MAXPATHLEN
+ 1);
1486 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1493 /* Strip off drive name from prefix, if present. */
1494 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1500 /* Keep only a prefix from newdir if nm starts with slash
1501 (//server/share for UNC, nothing otherwise). */
1502 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1505 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1507 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1509 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1511 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1523 /* Get rid of any slash at the end of newdir, unless newdir is
1524 just / or // (an incomplete UNC name). */
1525 length
= strlen (newdir
);
1526 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1528 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1532 unsigned char *temp
= (unsigned char *) alloca (length
);
1533 bcopy (newdir
, temp
, length
- 1);
1534 temp
[length
- 1] = 0;
1542 /* Now concatenate the directory and name to new space in the stack frame */
1543 tlen
+= strlen (nm
) + 1;
1545 /* Reserve space for drive specifier and escape prefix, since either
1546 or both may need to be inserted. (The Microsoft x86 compiler
1547 produces incorrect code if the following two lines are combined.) */
1548 target
= (unsigned char *) alloca (tlen
+ 4);
1550 #else /* not DOS_NT */
1551 target
= (unsigned char *) alloca (tlen
);
1552 #endif /* not DOS_NT */
1558 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1561 /* If newdir is effectively "C:/", then the drive letter will have
1562 been stripped and newdir will be "/". Concatenating with an
1563 absolute directory in nm produces "//", which will then be
1564 incorrectly treated as a network share. Ignore newdir in
1565 this case (keeping the drive letter). */
1566 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1567 && newdir
[1] == '\0'))
1569 strcpy (target
, newdir
);
1573 file_name_as_directory (target
, newdir
);
1576 strcat (target
, nm
);
1578 if (index (target
, '/'))
1579 strcpy (target
, sys_translate_unix (target
));
1582 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1584 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1593 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1599 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1600 /* brackets are offset from each other by 2 */
1603 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1604 /* convert [foo][bar] to [bar] */
1605 while (o
[-1] != '[' && o
[-1] != '<')
1607 else if (*p
== '-' && *o
!= '.')
1610 else if (p
[0] == '-' && o
[-1] == '.' &&
1611 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1612 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1616 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1617 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1619 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1621 /* else [foo.-] ==> [-] */
1627 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1628 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1634 if (!IS_DIRECTORY_SEP (*p
))
1638 else if (IS_DIRECTORY_SEP (p
[0])
1640 && (IS_DIRECTORY_SEP (p
[2])
1643 /* If "/." is the entire filename, keep the "/". Otherwise,
1644 just delete the whole "/.". */
1645 if (o
== target
&& p
[2] == '\0')
1649 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1650 /* `/../' is the "superroot" on certain file systems. */
1652 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1654 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1656 /* Keep initial / only if this is the whole name. */
1657 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1662 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1664 /* Collapse multiple `/' in a row. */
1666 while (IS_DIRECTORY_SEP (*p
))
1673 #endif /* not VMS */
1677 /* At last, set drive name. */
1679 /* Except for network file name. */
1680 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1681 #endif /* WINDOWSNT */
1683 if (!drive
) abort ();
1685 target
[0] = DRIVE_LETTER (drive
);
1688 /* Reinsert the escape prefix if required. */
1695 CORRECT_DIR_SEPS (target
);
1698 result
= make_specified_string (target
, -1, o
- target
,
1699 STRING_MULTIBYTE (name
));
1701 /* Again look to see if the file name has special constructs in it
1702 and perhaps call the corresponding file handler. This is needed
1703 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1704 the ".." component gives us "/user@host:/bar/../baz" which needs
1705 to be expanded again. */
1706 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1707 if (!NILP (handler
))
1708 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1714 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1715 This is the old version of expand-file-name, before it was thoroughly
1716 rewritten for Emacs 10.31. We leave this version here commented-out,
1717 because the code is very complex and likely to have subtle bugs. If
1718 bugs _are_ found, it might be of interest to look at the old code and
1719 see what did it do in the relevant situation.
1721 Don't remove this code: it's true that it will be accessible via CVS,
1722 but a few years from deletion, people will forget it is there. */
1724 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1725 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1726 "Convert FILENAME to absolute, and canonicalize it.\n\
1727 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1728 (does not start with slash); if DEFAULT is nil or missing,\n\
1729 the current buffer's value of default-directory is used.\n\
1730 Filenames containing `.' or `..' as components are simplified;\n\
1731 initial `~/' expands to your home directory.\n\
1732 See also the function `substitute-in-file-name'.")
1734 Lisp_Object name
, defalt
;
1738 register unsigned char *newdir
, *p
, *o
;
1740 unsigned char *target
;
1744 unsigned char * colon
= 0;
1745 unsigned char * close
= 0;
1746 unsigned char * slash
= 0;
1747 unsigned char * brack
= 0;
1748 int lbrack
= 0, rbrack
= 0;
1752 CHECK_STRING (name
);
1755 /* Filenames on VMS are always upper case. */
1756 name
= Fupcase (name
);
1761 /* If nm is absolute, flush ...// and detect /./ and /../.
1762 If no /./ or /../ we can return right away. */
1774 if (p
[0] == '/' && p
[1] == '/'
1776 /* // at start of filename is meaningful on Apollo system. */
1781 if (p
[0] == '/' && p
[1] == '~')
1782 nm
= p
+ 1, lose
= 1;
1783 if (p
[0] == '/' && p
[1] == '.'
1784 && (p
[2] == '/' || p
[2] == 0
1785 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1791 /* if dev:[dir]/, move nm to / */
1792 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1793 nm
= (brack
? brack
+ 1 : colon
+ 1);
1794 lbrack
= rbrack
= 0;
1802 /* VMS pre V4.4,convert '-'s in filenames. */
1803 if (lbrack
== rbrack
)
1805 if (dots
< 2) /* this is to allow negative version numbers */
1810 if (lbrack
> rbrack
&&
1811 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1812 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1818 /* count open brackets, reset close bracket pointer */
1819 if (p
[0] == '[' || p
[0] == '<')
1820 lbrack
++, brack
= 0;
1821 /* count close brackets, set close bracket pointer */
1822 if (p
[0] == ']' || p
[0] == '>')
1823 rbrack
++, brack
= p
;
1824 /* detect ][ or >< */
1825 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1827 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1828 nm
= p
+ 1, lose
= 1;
1829 if (p
[0] == ':' && (colon
|| slash
))
1830 /* if dev1:[dir]dev2:, move nm to dev2: */
1836 /* If /name/dev:, move nm to dev: */
1839 /* If node::dev:, move colon following dev */
1840 else if (colon
&& colon
[-1] == ':')
1842 /* If dev1:dev2:, move nm to dev2: */
1843 else if (colon
&& colon
[-1] != ':')
1848 if (p
[0] == ':' && !colon
)
1854 if (lbrack
== rbrack
)
1857 else if (p
[0] == '.')
1865 if (index (nm
, '/'))
1866 return build_string (sys_translate_unix (nm
));
1868 if (nm
== SDATA (name
))
1870 return build_string (nm
);
1874 /* Now determine directory to start with and put it in NEWDIR */
1878 if (nm
[0] == '~') /* prefix ~ */
1883 || nm
[1] == 0)/* ~/filename */
1885 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1886 newdir
= (unsigned char *) "";
1889 nm
++; /* Don't leave the slash in nm. */
1892 else /* ~user/filename */
1894 /* Get past ~ to user */
1895 unsigned char *user
= nm
+ 1;
1896 /* Find end of name. */
1897 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1898 int len
= ptr
? ptr
- user
: strlen (user
);
1900 unsigned char *ptr1
= index (user
, ':');
1901 if (ptr1
!= 0 && ptr1
- user
< len
)
1904 /* Copy the user name into temp storage. */
1905 o
= (unsigned char *) alloca (len
+ 1);
1906 bcopy ((char *) user
, o
, len
);
1909 /* Look up the user name. */
1910 pw
= (struct passwd
*) getpwnam (o
+ 1);
1912 error ("\"%s\" isn't a registered user", o
+ 1);
1914 newdir
= (unsigned char *) pw
->pw_dir
;
1916 /* Discard the user name from NM. */
1923 #endif /* not VMS */
1927 defalt
= current_buffer
->directory
;
1928 CHECK_STRING (defalt
);
1929 newdir
= SDATA (defalt
);
1932 /* Now concatenate the directory and name to new space in the stack frame */
1934 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1935 target
= (unsigned char *) alloca (tlen
);
1941 if (nm
[0] == 0 || nm
[0] == '/')
1942 strcpy (target
, newdir
);
1945 file_name_as_directory (target
, newdir
);
1948 strcat (target
, nm
);
1950 if (index (target
, '/'))
1951 strcpy (target
, sys_translate_unix (target
));
1954 /* Now canonicalize by removing /. and /foo/.. if they appear */
1962 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1968 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1969 /* brackets are offset from each other by 2 */
1972 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1973 /* convert [foo][bar] to [bar] */
1974 while (o
[-1] != '[' && o
[-1] != '<')
1976 else if (*p
== '-' && *o
!= '.')
1979 else if (p
[0] == '-' && o
[-1] == '.' &&
1980 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1981 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1985 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1986 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1988 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1990 /* else [foo.-] ==> [-] */
1996 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1997 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2007 else if (!strncmp (p
, "//", 2)
2009 /* // at start of filename is meaningful in Apollo system. */
2017 else if (p
[0] == '/' && p
[1] == '.' &&
2018 (p
[2] == '/' || p
[2] == 0))
2020 else if (!strncmp (p
, "/..", 3)
2021 /* `/../' is the "superroot" on certain file systems. */
2023 && (p
[3] == '/' || p
[3] == 0))
2025 while (o
!= target
&& *--o
!= '/')
2028 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2032 if (o
== target
&& *o
== '/')
2040 #endif /* not VMS */
2043 return make_string (target
, o
- target
);
2047 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2048 Ssubstitute_in_file_name
, 1, 1, 0,
2049 doc
: /* Substitute environment variables referred to in FILENAME.
2050 `$FOO' where FOO is an environment variable name means to substitute
2051 the value of that variable. The variable name should be terminated
2052 with a character not a letter, digit or underscore; otherwise, enclose
2053 the entire variable name in braces.
2054 If `/~' appears, all of FILENAME through that `/' is discarded.
2056 On VMS, `$' substitution is not done; this function does little and only
2057 duplicates what `expand-file-name' does. */)
2059 Lisp_Object filename
;
2063 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2064 unsigned char *target
= NULL
;
2066 int substituted
= 0;
2069 Lisp_Object handler
;
2071 CHECK_STRING (filename
);
2073 /* If the file name has special constructs in it,
2074 call the corresponding file handler. */
2075 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2076 if (!NILP (handler
))
2077 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2079 nm
= SDATA (filename
);
2081 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2082 CORRECT_DIR_SEPS (nm
);
2083 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2085 endp
= nm
+ SBYTES (filename
);
2087 /* If /~ or // appears, discard everything through first slash. */
2089 for (p
= nm
; p
!= endp
; p
++)
2092 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2093 /* // at start of file name is meaningful in Apollo,
2094 WindowsNT and Cygwin systems. */
2095 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2096 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2097 || IS_DIRECTORY_SEP (p
[0])
2098 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2103 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2105 || IS_DIRECTORY_SEP (p
[-1])))
2107 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2112 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2114 o
= (unsigned char *) alloca (s
- p
+ 1);
2115 bcopy ((char *) p
, o
, s
- p
);
2118 pw
= (struct passwd
*) getpwnam (o
+ 1);
2120 /* If we have ~/ or ~user and `user' exists, discard
2121 everything up to ~. But if `user' does not exist, leave
2122 ~user alone, it might be a literal file name. */
2123 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2130 /* see comment in expand-file-name about drive specifiers */
2131 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2132 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2141 return make_specified_string (nm
, -1, strlen (nm
),
2142 STRING_MULTIBYTE (filename
));
2145 /* See if any variables are substituted into the string
2146 and find the total length of their values in `total' */
2148 for (p
= nm
; p
!= endp
;)
2158 /* "$$" means a single "$" */
2167 while (p
!= endp
&& *p
!= '}') p
++;
2168 if (*p
!= '}') goto missingclose
;
2174 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2178 /* Copy out the variable name */
2179 target
= (unsigned char *) alloca (s
- o
+ 1);
2180 strncpy (target
, o
, s
- o
);
2183 strupr (target
); /* $home == $HOME etc. */
2186 /* Get variable value */
2187 o
= (unsigned char *) egetenv (target
);
2190 total
+= strlen (o
);
2200 /* If substitution required, recopy the string and do it */
2201 /* Make space in stack frame for the new copy */
2202 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2205 /* Copy the rest of the name through, replacing $ constructs with values */
2222 while (p
!= endp
&& *p
!= '}') p
++;
2223 if (*p
!= '}') goto missingclose
;
2229 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2233 /* Copy out the variable name */
2234 target
= (unsigned char *) alloca (s
- o
+ 1);
2235 strncpy (target
, o
, s
- o
);
2238 strupr (target
); /* $home == $HOME etc. */
2241 /* Get variable value */
2242 o
= (unsigned char *) egetenv (target
);
2246 strcpy (x
, target
); x
+= strlen (target
);
2248 else if (STRING_MULTIBYTE (filename
))
2250 /* If the original string is multibyte,
2251 convert what we substitute into multibyte. */
2254 int c
= unibyte_char_to_multibyte (*o
++);
2255 x
+= CHAR_STRING (c
, x
);
2267 /* If /~ or // appears, discard everything through first slash. */
2269 for (p
= xnm
; p
!= x
; p
++)
2271 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2272 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2273 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2274 || IS_DIRECTORY_SEP (p
[0])
2275 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2277 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2280 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2281 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2285 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2288 error ("Bad format environment-variable substitution");
2290 error ("Missing \"}\" in environment-variable substitution");
2292 error ("Substituting nonexistent environment variable \"%s\"", target
);
2295 #endif /* not VMS */
2299 /* A slightly faster and more convenient way to get
2300 (directory-file-name (expand-file-name FOO)). */
2303 expand_and_dir_to_file (filename
, defdir
)
2304 Lisp_Object filename
, defdir
;
2306 register Lisp_Object absname
;
2308 absname
= Fexpand_file_name (filename
, defdir
);
2311 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2312 if (c
== ':' || c
== ']' || c
== '>')
2313 absname
= Fdirectory_file_name (absname
);
2316 /* Remove final slash, if any (unless this is the root dir).
2317 stat behaves differently depending! */
2318 if (SCHARS (absname
) > 1
2319 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2320 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2321 /* We cannot take shortcuts; they might be wrong for magic file names. */
2322 absname
= Fdirectory_file_name (absname
);
2327 /* Signal an error if the file ABSNAME already exists.
2328 If INTERACTIVE is nonzero, ask the user whether to proceed,
2329 and bypass the error if the user says to go ahead.
2330 QUERYSTRING is a name for the action that is being considered
2333 *STATPTR is used to store the stat information if the file exists.
2334 If the file does not exist, STATPTR->st_mode is set to 0.
2335 If STATPTR is null, we don't store into it.
2337 If QUICK is nonzero, we ask for y or n, not yes or no. */
2340 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2341 Lisp_Object absname
;
2342 unsigned char *querystring
;
2344 struct stat
*statptr
;
2347 register Lisp_Object tem
, encoded_filename
;
2348 struct stat statbuf
;
2349 struct gcpro gcpro1
;
2351 encoded_filename
= ENCODE_FILE (absname
);
2353 /* stat is a good way to tell whether the file exists,
2354 regardless of what access permissions it has. */
2355 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2358 Fsignal (Qfile_already_exists
,
2359 Fcons (build_string ("File already exists"),
2360 Fcons (absname
, Qnil
)));
2362 tem
= format2 ("File %s already exists; %s anyway? ",
2363 absname
, build_string (querystring
));
2365 tem
= Fy_or_n_p (tem
);
2367 tem
= do_yes_or_no_p (tem
);
2370 Fsignal (Qfile_already_exists
,
2371 Fcons (build_string ("File already exists"),
2372 Fcons (absname
, Qnil
)));
2379 statptr
->st_mode
= 0;
2384 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2385 "fCopy file: \nFCopy %s to file: \np\nP",
2386 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2387 If NEWNAME names a directory, copy FILE there.
2388 Signals a `file-already-exists' error if file NEWNAME already exists,
2389 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2390 A number as third arg means request confirmation if NEWNAME already exists.
2391 This is what happens in interactive use with M-x.
2392 Fourth arg KEEP-TIME non-nil means give the new file the same
2393 last-modified time as the old one. (This works on only some systems.)
2394 A prefix arg makes KEEP-TIME non-nil.
2395 Also set the file modes of the target file to match the source file. */)
2396 (file
, newname
, ok_if_already_exists
, keep_time
)
2397 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2400 char buf
[16 * 1024];
2401 struct stat st
, out_st
;
2402 Lisp_Object handler
;
2403 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2404 int count
= SPECPDL_INDEX ();
2405 int input_file_statable_p
;
2406 Lisp_Object encoded_file
, encoded_newname
;
2408 encoded_file
= encoded_newname
= Qnil
;
2409 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2410 CHECK_STRING (file
);
2411 CHECK_STRING (newname
);
2413 if (!NILP (Ffile_directory_p (newname
)))
2414 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2416 newname
= Fexpand_file_name (newname
, Qnil
);
2418 file
= Fexpand_file_name (file
, Qnil
);
2420 /* If the input file name has special constructs in it,
2421 call the corresponding file handler. */
2422 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2423 /* Likewise for output file name. */
2425 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2426 if (!NILP (handler
))
2427 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2428 ok_if_already_exists
, keep_time
));
2430 encoded_file
= ENCODE_FILE (file
);
2431 encoded_newname
= ENCODE_FILE (newname
);
2433 if (NILP (ok_if_already_exists
)
2434 || INTEGERP (ok_if_already_exists
))
2435 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2436 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2437 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2441 if (!CopyFile (SDATA (encoded_file
),
2442 SDATA (encoded_newname
),
2444 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2445 /* CopyFile retains the timestamp by default. */
2446 else if (NILP (keep_time
))
2452 EMACS_GET_TIME (now
);
2453 filename
= SDATA (encoded_newname
);
2455 /* Ensure file is writable while its modified time is set. */
2456 attributes
= GetFileAttributes (filename
);
2457 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2458 if (set_file_times (filename
, now
, now
))
2460 /* Restore original attributes. */
2461 SetFileAttributes (filename
, attributes
);
2462 Fsignal (Qfile_date_error
,
2463 Fcons (build_string ("Cannot set file date"),
2464 Fcons (newname
, Qnil
)));
2466 /* Restore original attributes. */
2467 SetFileAttributes (filename
, attributes
);
2469 #else /* not WINDOWSNT */
2471 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2475 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2477 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2479 /* We can only copy regular files and symbolic links. Other files are not
2481 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2483 #if !defined (DOS_NT) || __DJGPP__ > 1
2484 if (out_st
.st_mode
!= 0
2485 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2488 report_file_error ("Input and output files are the same",
2489 Fcons (file
, Fcons (newname
, Qnil
)));
2493 #if defined (S_ISREG) && defined (S_ISLNK)
2494 if (input_file_statable_p
)
2496 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2498 #if defined (EISDIR)
2499 /* Get a better looking error message. */
2502 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2505 #endif /* S_ISREG && S_ISLNK */
2508 /* Create the copy file with the same record format as the input file */
2509 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2512 /* System's default file type was set to binary by _fmode in emacs.c. */
2513 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2514 #else /* not MSDOS */
2515 ofd
= creat (SDATA (encoded_newname
), 0666);
2516 #endif /* not MSDOS */
2519 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2521 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2525 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2526 if (emacs_write (ofd
, buf
, n
) != n
)
2527 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2530 /* Closing the output clobbers the file times on some systems. */
2531 if (emacs_close (ofd
) < 0)
2532 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2534 if (input_file_statable_p
)
2536 if (!NILP (keep_time
))
2538 EMACS_TIME atime
, mtime
;
2539 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2540 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2541 if (set_file_times (SDATA (encoded_newname
),
2543 Fsignal (Qfile_date_error
,
2544 Fcons (build_string ("Cannot set file date"),
2545 Fcons (newname
, Qnil
)));
2548 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2550 #if defined (__DJGPP__) && __DJGPP__ > 1
2551 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2552 and if it can't, it tells so. Otherwise, under MSDOS we usually
2553 get only the READ bit, which will make the copied file read-only,
2554 so it's better not to chmod at all. */
2555 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2556 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2557 #endif /* DJGPP version 2 or newer */
2562 #endif /* WINDOWSNT */
2564 /* Discard the unwind protects. */
2565 specpdl_ptr
= specpdl
+ count
;
2571 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2572 Smake_directory_internal
, 1, 1, 0,
2573 doc
: /* Create a new directory named DIRECTORY. */)
2575 Lisp_Object directory
;
2577 const unsigned char *dir
;
2578 Lisp_Object handler
;
2579 Lisp_Object encoded_dir
;
2581 CHECK_STRING (directory
);
2582 directory
= Fexpand_file_name (directory
, Qnil
);
2584 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2585 if (!NILP (handler
))
2586 return call2 (handler
, Qmake_directory_internal
, directory
);
2588 encoded_dir
= ENCODE_FILE (directory
);
2590 dir
= SDATA (encoded_dir
);
2593 if (mkdir (dir
) != 0)
2595 if (mkdir (dir
, 0777) != 0)
2597 report_file_error ("Creating directory", Flist (1, &directory
));
2602 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2603 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2605 Lisp_Object directory
;
2607 const unsigned char *dir
;
2608 Lisp_Object handler
;
2609 Lisp_Object encoded_dir
;
2611 CHECK_STRING (directory
);
2612 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2614 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2615 if (!NILP (handler
))
2616 return call2 (handler
, Qdelete_directory
, directory
);
2618 encoded_dir
= ENCODE_FILE (directory
);
2620 dir
= SDATA (encoded_dir
);
2622 if (rmdir (dir
) != 0)
2623 report_file_error ("Removing directory", Flist (1, &directory
));
2628 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2629 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2630 If file has multiple names, it continues to exist with the other names. */)
2632 Lisp_Object filename
;
2634 Lisp_Object handler
;
2635 Lisp_Object encoded_file
;
2636 struct gcpro gcpro1
;
2639 if (!NILP (Ffile_directory_p (filename
))
2640 && NILP (Ffile_symlink_p (filename
)))
2641 Fsignal (Qfile_error
,
2642 Fcons (build_string ("Removing old name: is a directory"),
2643 Fcons (filename
, Qnil
)));
2645 filename
= Fexpand_file_name (filename
, Qnil
);
2647 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2648 if (!NILP (handler
))
2649 return call2 (handler
, Qdelete_file
, filename
);
2651 encoded_file
= ENCODE_FILE (filename
);
2653 if (0 > unlink (SDATA (encoded_file
)))
2654 report_file_error ("Removing old name", Flist (1, &filename
));
2659 internal_delete_file_1 (ignore
)
2665 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2668 internal_delete_file (filename
)
2669 Lisp_Object filename
;
2671 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2672 Qt
, internal_delete_file_1
));
2675 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2676 "fRename file: \nFRename %s to file: \np",
2677 doc
: /* Rename FILE as NEWNAME. Both args strings.
2678 If file has names other than FILE, it continues to have those names.
2679 Signals a `file-already-exists' error if a file NEWNAME already exists
2680 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2681 A number as third arg means request confirmation if NEWNAME already exists.
2682 This is what happens in interactive use with M-x. */)
2683 (file
, newname
, ok_if_already_exists
)
2684 Lisp_Object file
, newname
, ok_if_already_exists
;
2687 Lisp_Object args
[2];
2689 Lisp_Object handler
;
2690 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2691 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2693 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2694 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2695 CHECK_STRING (file
);
2696 CHECK_STRING (newname
);
2697 file
= Fexpand_file_name (file
, Qnil
);
2698 newname
= Fexpand_file_name (newname
, Qnil
);
2700 /* If the file name has special constructs in it,
2701 call the corresponding file handler. */
2702 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2704 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2705 if (!NILP (handler
))
2706 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2707 file
, newname
, ok_if_already_exists
));
2709 encoded_file
= ENCODE_FILE (file
);
2710 encoded_newname
= ENCODE_FILE (newname
);
2713 /* If the file names are identical but for the case, don't ask for
2714 confirmation: they simply want to change the letter-case of the
2716 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2718 if (NILP (ok_if_already_exists
)
2719 || INTEGERP (ok_if_already_exists
))
2720 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2721 INTEGERP (ok_if_already_exists
), 0, 0);
2723 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2725 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2726 || 0 > unlink (SDATA (encoded_file
)))
2732 symlink_target
= Ffile_symlink_p (file
);
2733 if (! NILP (symlink_target
))
2734 Fmake_symbolic_link (symlink_target
, newname
,
2735 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2738 Fcopy_file (file
, newname
,
2739 /* We have already prompted if it was an integer,
2740 so don't have copy-file prompt again. */
2741 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2742 Fdelete_file (file
);
2749 report_file_error ("Renaming", Flist (2, args
));
2752 report_file_error ("Renaming", Flist (2, &file
));
2759 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2760 "fAdd name to file: \nFName to add to %s: \np",
2761 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2762 Signals a `file-already-exists' error if a file NEWNAME already exists
2763 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2764 A number as third arg means request confirmation if NEWNAME already exists.
2765 This is what happens in interactive use with M-x. */)
2766 (file
, newname
, ok_if_already_exists
)
2767 Lisp_Object file
, newname
, ok_if_already_exists
;
2770 Lisp_Object args
[2];
2772 Lisp_Object handler
;
2773 Lisp_Object encoded_file
, encoded_newname
;
2774 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2776 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2777 encoded_file
= encoded_newname
= Qnil
;
2778 CHECK_STRING (file
);
2779 CHECK_STRING (newname
);
2780 file
= Fexpand_file_name (file
, Qnil
);
2781 newname
= Fexpand_file_name (newname
, Qnil
);
2783 /* If the file name has special constructs in it,
2784 call the corresponding file handler. */
2785 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2786 if (!NILP (handler
))
2787 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2788 newname
, ok_if_already_exists
));
2790 /* If the new name has special constructs in it,
2791 call the corresponding file handler. */
2792 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2793 if (!NILP (handler
))
2794 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2795 newname
, ok_if_already_exists
));
2797 encoded_file
= ENCODE_FILE (file
);
2798 encoded_newname
= ENCODE_FILE (newname
);
2800 if (NILP (ok_if_already_exists
)
2801 || INTEGERP (ok_if_already_exists
))
2802 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2803 INTEGERP (ok_if_already_exists
), 0, 0);
2805 unlink (SDATA (newname
));
2806 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2811 report_file_error ("Adding new name", Flist (2, args
));
2813 report_file_error ("Adding new name", Flist (2, &file
));
2822 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2823 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2824 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2825 Signals a `file-already-exists' error if a file LINKNAME already exists
2826 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2827 A number as third arg means request confirmation if LINKNAME already exists.
2828 This happens for interactive use with M-x. */)
2829 (filename
, linkname
, ok_if_already_exists
)
2830 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2833 Lisp_Object args
[2];
2835 Lisp_Object handler
;
2836 Lisp_Object encoded_filename
, encoded_linkname
;
2837 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2839 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2840 encoded_filename
= encoded_linkname
= Qnil
;
2841 CHECK_STRING (filename
);
2842 CHECK_STRING (linkname
);
2843 /* If the link target has a ~, we must expand it to get
2844 a truly valid file name. Otherwise, do not expand;
2845 we want to permit links to relative file names. */
2846 if (SREF (filename
, 0) == '~')
2847 filename
= Fexpand_file_name (filename
, Qnil
);
2848 linkname
= Fexpand_file_name (linkname
, Qnil
);
2850 /* If the file name has special constructs in it,
2851 call the corresponding file handler. */
2852 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2853 if (!NILP (handler
))
2854 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2855 linkname
, ok_if_already_exists
));
2857 /* If the new link name has special constructs in it,
2858 call the corresponding file handler. */
2859 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2860 if (!NILP (handler
))
2861 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2862 linkname
, ok_if_already_exists
));
2864 encoded_filename
= ENCODE_FILE (filename
);
2865 encoded_linkname
= ENCODE_FILE (linkname
);
2867 if (NILP (ok_if_already_exists
)
2868 || INTEGERP (ok_if_already_exists
))
2869 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2870 INTEGERP (ok_if_already_exists
), 0, 0);
2871 if (0 > symlink (SDATA (encoded_filename
),
2872 SDATA (encoded_linkname
)))
2874 /* If we didn't complain already, silently delete existing file. */
2875 if (errno
== EEXIST
)
2877 unlink (SDATA (encoded_linkname
));
2878 if (0 <= symlink (SDATA (encoded_filename
),
2879 SDATA (encoded_linkname
)))
2889 report_file_error ("Making symbolic link", Flist (2, args
));
2891 report_file_error ("Making symbolic link", Flist (2, &filename
));
2897 #endif /* S_IFLNK */
2901 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2902 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2903 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2904 If STRING is nil or a null string, the logical name NAME is deleted. */)
2909 CHECK_STRING (name
);
2911 delete_logical_name (SDATA (name
));
2914 CHECK_STRING (string
);
2916 if (SCHARS (string
) == 0)
2917 delete_logical_name (SDATA (name
));
2919 define_logical_name (SDATA (name
), SDATA (string
));
2928 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2929 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2931 Lisp_Object path
, login
;
2935 CHECK_STRING (path
);
2936 CHECK_STRING (login
);
2938 netresult
= netunam (SDATA (path
), SDATA (login
));
2940 if (netresult
== -1)
2945 #endif /* HPUX_NET */
2947 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2949 doc
: /* Return t if file FILENAME specifies an absolute file name.
2950 On Unix, this is a name starting with a `/' or a `~'. */)
2952 Lisp_Object filename
;
2954 const unsigned char *ptr
;
2956 CHECK_STRING (filename
);
2957 ptr
= SDATA (filename
);
2958 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2960 /* ??? This criterion is probably wrong for '<'. */
2961 || index (ptr
, ':') || index (ptr
, '<')
2962 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2966 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2974 /* Return nonzero if file FILENAME exists and can be executed. */
2977 check_executable (filename
)
2981 int len
= strlen (filename
);
2984 if (stat (filename
, &st
) < 0)
2986 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2987 return ((st
.st_mode
& S_IEXEC
) != 0);
2989 return (S_ISREG (st
.st_mode
)
2991 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2992 || stricmp (suffix
, ".exe") == 0
2993 || stricmp (suffix
, ".bat") == 0)
2994 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2995 #endif /* not WINDOWSNT */
2996 #else /* not DOS_NT */
2997 #ifdef HAVE_EUIDACCESS
2998 return (euidaccess (filename
, 1) >= 0);
3000 /* Access isn't quite right because it uses the real uid
3001 and we really want to test with the effective uid.
3002 But Unix doesn't give us a right way to do it. */
3003 return (access (filename
, 1) >= 0);
3005 #endif /* not DOS_NT */
3008 /* Return nonzero if file FILENAME exists and can be written. */
3011 check_writable (filename
)
3016 if (stat (filename
, &st
) < 0)
3018 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3019 #else /* not MSDOS */
3020 #ifdef HAVE_EUIDACCESS
3021 return (euidaccess (filename
, 2) >= 0);
3023 /* Access isn't quite right because it uses the real uid
3024 and we really want to test with the effective uid.
3025 But Unix doesn't give us a right way to do it.
3026 Opening with O_WRONLY could work for an ordinary file,
3027 but would lose for directories. */
3028 return (access (filename
, 2) >= 0);
3030 #endif /* not MSDOS */
3033 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3034 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3035 See also `file-readable-p' and `file-attributes'. */)
3037 Lisp_Object filename
;
3039 Lisp_Object absname
;
3040 Lisp_Object handler
;
3041 struct stat statbuf
;
3043 CHECK_STRING (filename
);
3044 absname
= Fexpand_file_name (filename
, Qnil
);
3046 /* If the file name has special constructs in it,
3047 call the corresponding file handler. */
3048 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3049 if (!NILP (handler
))
3050 return call2 (handler
, Qfile_exists_p
, absname
);
3052 absname
= ENCODE_FILE (absname
);
3054 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3057 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3058 doc
: /* Return t if FILENAME can be executed by you.
3059 For a directory, this means you can access files in that directory. */)
3061 Lisp_Object filename
;
3063 Lisp_Object absname
;
3064 Lisp_Object handler
;
3066 CHECK_STRING (filename
);
3067 absname
= Fexpand_file_name (filename
, Qnil
);
3069 /* If the file name has special constructs in it,
3070 call the corresponding file handler. */
3071 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3072 if (!NILP (handler
))
3073 return call2 (handler
, Qfile_executable_p
, absname
);
3075 absname
= ENCODE_FILE (absname
);
3077 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3080 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3081 doc
: /* Return t if file FILENAME exists and you can read it.
3082 See also `file-exists-p' and `file-attributes'. */)
3084 Lisp_Object filename
;
3086 Lisp_Object absname
;
3087 Lisp_Object handler
;
3090 struct stat statbuf
;
3092 CHECK_STRING (filename
);
3093 absname
= Fexpand_file_name (filename
, Qnil
);
3095 /* If the file name has special constructs in it,
3096 call the corresponding file handler. */
3097 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3098 if (!NILP (handler
))
3099 return call2 (handler
, Qfile_readable_p
, absname
);
3101 absname
= ENCODE_FILE (absname
);
3103 #if defined(DOS_NT) || defined(macintosh)
3104 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3106 if (access (SDATA (absname
), 0) == 0)
3109 #else /* not DOS_NT and not macintosh */
3111 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3112 /* Opening a fifo without O_NONBLOCK can wait.
3113 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3114 except in the case of a fifo, on a system which handles it. */
3115 desc
= stat (SDATA (absname
), &statbuf
);
3118 if (S_ISFIFO (statbuf
.st_mode
))
3119 flags
|= O_NONBLOCK
;
3121 desc
= emacs_open (SDATA (absname
), flags
, 0);
3126 #endif /* not DOS_NT and not macintosh */
3129 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3131 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3132 doc
: /* Return t if file FILENAME can be written or created by you. */)
3134 Lisp_Object filename
;
3136 Lisp_Object absname
, dir
, encoded
;
3137 Lisp_Object handler
;
3138 struct stat statbuf
;
3140 CHECK_STRING (filename
);
3141 absname
= Fexpand_file_name (filename
, Qnil
);
3143 /* If the file name has special constructs in it,
3144 call the corresponding file handler. */
3145 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3146 if (!NILP (handler
))
3147 return call2 (handler
, Qfile_writable_p
, absname
);
3149 encoded
= ENCODE_FILE (absname
);
3150 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3151 return (check_writable (SDATA (encoded
))
3154 dir
= Ffile_name_directory (absname
);
3157 dir
= Fdirectory_file_name (dir
);
3161 dir
= Fdirectory_file_name (dir
);
3164 dir
= ENCODE_FILE (dir
);
3166 /* The read-only attribute of the parent directory doesn't affect
3167 whether a file or directory can be created within it. Some day we
3168 should check ACLs though, which do affect this. */
3169 if (stat (SDATA (dir
), &statbuf
) < 0)
3171 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3173 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3178 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3179 doc
: /* Access file FILENAME, and get an error if that does not work.
3180 The second argument STRING is used in the error message.
3181 If there is no error, we return nil. */)
3183 Lisp_Object filename
, string
;
3185 Lisp_Object handler
, encoded_filename
, absname
;
3188 CHECK_STRING (filename
);
3189 absname
= Fexpand_file_name (filename
, Qnil
);
3191 CHECK_STRING (string
);
3193 /* If the file name has special constructs in it,
3194 call the corresponding file handler. */
3195 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3196 if (!NILP (handler
))
3197 return call3 (handler
, Qaccess_file
, absname
, string
);
3199 encoded_filename
= ENCODE_FILE (absname
);
3201 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3203 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3209 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3210 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3211 The value is the link target, as a string.
3212 Otherwise returns nil. */)
3214 Lisp_Object filename
;
3216 Lisp_Object handler
;
3218 CHECK_STRING (filename
);
3219 filename
= Fexpand_file_name (filename
, Qnil
);
3221 /* If the file name has special constructs in it,
3222 call the corresponding file handler. */
3223 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3224 if (!NILP (handler
))
3225 return call2 (handler
, Qfile_symlink_p
, filename
);
3234 filename
= ENCODE_FILE (filename
);
3241 buf
= (char *) xrealloc (buf
, bufsize
);
3242 bzero (buf
, bufsize
);
3245 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3249 /* HP-UX reports ERANGE if buffer is too small. */
3250 if (errno
== ERANGE
)
3260 while (valsize
>= bufsize
);
3262 val
= make_string (buf
, valsize
);
3263 if (buf
[0] == '/' && index (buf
, ':'))
3264 val
= concat2 (build_string ("/:"), val
);
3266 val
= DECODE_FILE (val
);
3269 #else /* not S_IFLNK */
3271 #endif /* not S_IFLNK */
3274 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3275 doc
: /* Return t if FILENAME names an existing directory.
3276 Symbolic links to directories count as directories.
3277 See `file-symlink-p' to distinguish symlinks. */)
3279 Lisp_Object filename
;
3281 register Lisp_Object absname
;
3283 Lisp_Object handler
;
3285 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3287 /* If the file name has special constructs in it,
3288 call the corresponding file handler. */
3289 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3290 if (!NILP (handler
))
3291 return call2 (handler
, Qfile_directory_p
, absname
);
3293 absname
= ENCODE_FILE (absname
);
3295 if (stat (SDATA (absname
), &st
) < 0)
3297 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3300 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3301 doc
: /* Return t if file FILENAME names a directory you can open.
3302 For the value to be t, FILENAME must specify the name of a directory as a file,
3303 and the directory must allow you to open files in it. In order to use a
3304 directory as a buffer's current directory, this predicate must return true.
3305 A directory name spec may be given instead; then the value is t
3306 if the directory so specified exists and really is a readable and
3307 searchable directory. */)
3309 Lisp_Object filename
;
3311 Lisp_Object handler
;
3313 struct gcpro gcpro1
;
3315 /* If the file name has special constructs in it,
3316 call the corresponding file handler. */
3317 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3318 if (!NILP (handler
))
3319 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3322 tem
= (NILP (Ffile_directory_p (filename
))
3323 || NILP (Ffile_executable_p (filename
)));
3325 return tem
? Qnil
: Qt
;
3328 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3329 doc
: /* Return t if file FILENAME is the name of a regular file.
3330 This is the sort of file that holds an ordinary stream of data bytes. */)
3332 Lisp_Object filename
;
3334 register Lisp_Object absname
;
3336 Lisp_Object handler
;
3338 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3340 /* If the file name has special constructs in it,
3341 call the corresponding file handler. */
3342 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3343 if (!NILP (handler
))
3344 return call2 (handler
, Qfile_regular_p
, absname
);
3346 absname
= ENCODE_FILE (absname
);
3351 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3353 /* Tell stat to use expensive method to get accurate info. */
3354 Vw32_get_true_file_attributes
= Qt
;
3355 result
= stat (SDATA (absname
), &st
);
3356 Vw32_get_true_file_attributes
= tem
;
3360 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3363 if (stat (SDATA (absname
), &st
) < 0)
3365 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3369 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3370 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
3372 Lisp_Object filename
;
3374 Lisp_Object absname
;
3376 Lisp_Object handler
;
3378 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3380 /* If the file name has special constructs in it,
3381 call the corresponding file handler. */
3382 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3383 if (!NILP (handler
))
3384 return call2 (handler
, Qfile_modes
, absname
);
3386 absname
= ENCODE_FILE (absname
);
3388 if (stat (SDATA (absname
), &st
) < 0)
3390 #if defined (MSDOS) && __DJGPP__ < 2
3391 if (check_executable (SDATA (absname
)))
3392 st
.st_mode
|= S_IEXEC
;
3393 #endif /* MSDOS && __DJGPP__ < 2 */
3395 return make_number (st
.st_mode
& 07777);
3398 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3399 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3400 Only the 12 low bits of MODE are used. */)
3402 Lisp_Object filename
, mode
;
3404 Lisp_Object absname
, encoded_absname
;
3405 Lisp_Object handler
;
3407 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3408 CHECK_NUMBER (mode
);
3410 /* If the file name has special constructs in it,
3411 call the corresponding file handler. */
3412 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3413 if (!NILP (handler
))
3414 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3416 encoded_absname
= ENCODE_FILE (absname
);
3418 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3419 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3424 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3425 doc
: /* Set the file permission bits for newly created files.
3426 The argument MODE should be an integer; only the low 9 bits are used.
3427 This setting is inherited by subprocesses. */)
3431 CHECK_NUMBER (mode
);
3433 umask ((~ XINT (mode
)) & 0777);
3438 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3439 doc
: /* Return the default file protection for created files.
3440 The value is an integer. */)
3446 realmask
= umask (0);
3449 XSETINT (value
, (~ realmask
) & 0777);
3453 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3455 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3456 doc
: /* Set times of file FILENAME to TIME.
3457 Set both access and modification times.
3458 Return t on success, else nil.
3459 Use the current time if TIME is nil. TIME is in the format of
3462 Lisp_Object filename
, time
;
3464 Lisp_Object absname
, encoded_absname
;
3465 Lisp_Object handler
;
3469 if (! lisp_time_argument (time
, &sec
, &usec
))
3470 error ("Invalid time specification");
3472 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3474 /* If the file name has special constructs in it,
3475 call the corresponding file handler. */
3476 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3477 if (!NILP (handler
))
3478 return call3 (handler
, Qset_file_times
, absname
, time
);
3480 encoded_absname
= ENCODE_FILE (absname
);
3485 EMACS_SET_SECS (t
, sec
);
3486 EMACS_SET_USECS (t
, usec
);
3488 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3493 /* Setting times on a directory always fails. */
3494 if (stat (SDATA (encoded_absname
), &st
) == 0
3495 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3498 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3511 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3512 doc
: /* Tell Unix to finish all pending disk updates. */)
3521 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3522 doc
: /* Return t if file FILE1 is newer than file FILE2.
3523 If FILE1 does not exist, the answer is nil;
3524 otherwise, if FILE2 does not exist, the answer is t. */)
3526 Lisp_Object file1
, file2
;
3528 Lisp_Object absname1
, absname2
;
3531 Lisp_Object handler
;
3532 struct gcpro gcpro1
, gcpro2
;
3534 CHECK_STRING (file1
);
3535 CHECK_STRING (file2
);
3538 GCPRO2 (absname1
, file2
);
3539 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3540 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3543 /* If the file name has special constructs in it,
3544 call the corresponding file handler. */
3545 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3547 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3548 if (!NILP (handler
))
3549 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3551 GCPRO2 (absname1
, absname2
);
3552 absname1
= ENCODE_FILE (absname1
);
3553 absname2
= ENCODE_FILE (absname2
);
3556 if (stat (SDATA (absname1
), &st
) < 0)
3559 mtime1
= st
.st_mtime
;
3561 if (stat (SDATA (absname2
), &st
) < 0)
3564 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3568 Lisp_Object Qfind_buffer_file_type
;
3571 #ifndef READ_BUF_SIZE
3572 #define READ_BUF_SIZE (64 << 10)
3575 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3577 /* This function is called after Lisp functions to decide a coding
3578 system are called, or when they cause an error. Before they are
3579 called, the current buffer is set unibyte and it contains only a
3580 newly inserted text (thus the buffer was empty before the
3583 The functions may set markers, overlays, text properties, or even
3584 alter the buffer contents, change the current buffer.
3586 Here, we reset all those changes by:
3587 o set back the current buffer.
3588 o move all markers and overlays to BEG.
3589 o remove all text properties.
3590 o set back the buffer multibyteness. */
3593 decide_coding_unwind (unwind_data
)
3594 Lisp_Object unwind_data
;
3596 Lisp_Object multibyte
, undo_list
, buffer
;
3598 multibyte
= XCAR (unwind_data
);
3599 unwind_data
= XCDR (unwind_data
);
3600 undo_list
= XCAR (unwind_data
);
3601 buffer
= XCDR (unwind_data
);
3603 if (current_buffer
!= XBUFFER (buffer
))
3604 set_buffer_internal (XBUFFER (buffer
));
3605 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3606 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3607 BUF_INTERVALS (current_buffer
) = 0;
3608 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3610 /* Now we are safe to change the buffer's multibyteness directly. */
3611 current_buffer
->enable_multibyte_characters
= multibyte
;
3612 current_buffer
->undo_list
= undo_list
;
3618 /* Used to pass values from insert-file-contents to read_non_regular. */
3620 static int non_regular_fd
;
3621 static int non_regular_inserted
;
3622 static int non_regular_nbytes
;
3625 /* Read from a non-regular file.
3626 Read non_regular_trytry bytes max from non_regular_fd.
3627 Non_regular_inserted specifies where to put the read bytes.
3628 Value is the number of bytes read. */
3637 nbytes
= emacs_read (non_regular_fd
,
3638 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3639 non_regular_nbytes
);
3641 return make_number (nbytes
);
3645 /* Condition-case handler used when reading from non-regular files
3646 in insert-file-contents. */
3649 read_non_regular_quit ()
3655 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3657 doc
: /* Insert contents of file FILENAME after point.
3658 Returns list of absolute file name and number of characters inserted.
3659 If second argument VISIT is non-nil, the buffer's visited filename
3660 and last save file modtime are set, and it is marked unmodified.
3661 If visiting and the file does not exist, visiting is completed
3662 before the error is signaled.
3663 The optional third and fourth arguments BEG and END
3664 specify what portion of the file to insert.
3665 These arguments count bytes in the file, not characters in the buffer.
3666 If VISIT is non-nil, BEG and END must be nil.
3668 If optional fifth argument REPLACE is non-nil,
3669 it means replace the current buffer contents (in the accessible portion)
3670 with the file contents. This is better than simply deleting and inserting
3671 the whole thing because (1) it preserves some marker positions
3672 and (2) it puts less data in the undo list.
3673 When REPLACE is non-nil, the value is the number of characters actually read,
3674 which is often less than the number of characters to be read.
3676 This does code conversion according to the value of
3677 `coding-system-for-read' or `file-coding-system-alist',
3678 and sets the variable `last-coding-system-used' to the coding system
3680 (filename
, visit
, beg
, end
, replace
)
3681 Lisp_Object filename
, visit
, beg
, end
, replace
;
3686 register int how_much
;
3687 register int unprocessed
;
3688 int count
= SPECPDL_INDEX ();
3689 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3690 Lisp_Object handler
, val
, insval
, orig_filename
;
3693 int not_regular
= 0;
3694 unsigned char read_buf
[READ_BUF_SIZE
];
3695 struct coding_system coding
;
3696 unsigned char buffer
[1 << 14];
3697 int replace_handled
= 0;
3698 int set_coding_system
= 0;
3699 int coding_system_decided
= 0;
3702 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3703 error ("Cannot do file visiting in an indirect buffer");
3705 if (!NILP (current_buffer
->read_only
))
3706 Fbarf_if_buffer_read_only ();
3710 orig_filename
= Qnil
;
3712 GCPRO4 (filename
, val
, p
, orig_filename
);
3714 CHECK_STRING (filename
);
3715 filename
= Fexpand_file_name (filename
, Qnil
);
3717 /* If the file name has special constructs in it,
3718 call the corresponding file handler. */
3719 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3720 if (!NILP (handler
))
3722 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3723 visit
, beg
, end
, replace
);
3724 if (CONSP (val
) && CONSP (XCDR (val
)))
3725 inserted
= XINT (XCAR (XCDR (val
)));
3729 orig_filename
= filename
;
3730 filename
= ENCODE_FILE (filename
);
3736 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3738 /* Tell stat to use expensive method to get accurate info. */
3739 Vw32_get_true_file_attributes
= Qt
;
3740 total
= stat (SDATA (filename
), &st
);
3741 Vw32_get_true_file_attributes
= tem
;
3746 if (stat (SDATA (filename
), &st
) < 0)
3748 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3749 || fstat (fd
, &st
) < 0)
3750 #endif /* not APOLLO */
3751 #endif /* WINDOWSNT */
3753 if (fd
>= 0) emacs_close (fd
);
3756 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3759 if (!NILP (Vcoding_system_for_read
))
3760 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3765 /* This code will need to be changed in order to work on named
3766 pipes, and it's probably just not worth it. So we should at
3767 least signal an error. */
3768 if (!S_ISREG (st
.st_mode
))
3775 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3776 Fsignal (Qfile_error
,
3777 Fcons (build_string ("not a regular file"),
3778 Fcons (orig_filename
, Qnil
)));
3783 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3786 /* Replacement should preserve point as it preserves markers. */
3787 if (!NILP (replace
))
3788 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3790 record_unwind_protect (close_file_unwind
, make_number (fd
));
3792 /* Supposedly happens on VMS. */
3793 /* Can happen on any platform that uses long as type of off_t, but allows
3794 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3795 give a message suitable for the latter case. */
3796 if (! not_regular
&& st
.st_size
< 0)
3797 error ("Maximum buffer size exceeded");
3799 /* Prevent redisplay optimizations. */
3800 current_buffer
->clip_changed
= 1;
3804 if (!NILP (beg
) || !NILP (end
))
3805 error ("Attempt to visit less than an entire file");
3806 if (BEG
< Z
&& NILP (replace
))
3807 error ("Cannot do file visiting in a non-empty buffer");
3813 XSETFASTINT (beg
, 0);
3821 XSETINT (end
, st
.st_size
);
3823 /* Arithmetic overflow can occur if an Emacs integer cannot
3824 represent the file size, or if the calculations below
3825 overflow. The calculations below double the file size
3826 twice, so check that it can be multiplied by 4 safely. */
3827 if (XINT (end
) != st
.st_size
3828 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3829 error ("Maximum buffer size exceeded");
3831 /* The file size returned from stat may be zero, but data
3832 may be readable nonetheless, for example when this is a
3833 file in the /proc filesystem. */
3834 if (st
.st_size
== 0)
3835 XSETINT (end
, READ_BUF_SIZE
);
3839 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3841 /* We use emacs-mule for auto saving... */
3842 setup_coding_system (Qemacs_mule
, &coding
);
3843 /* ... but with the special flag to indicate to read in a
3844 multibyte sequence for eight-bit-control char as is. */
3846 coding
.src_multibyte
= 0;
3847 coding
.dst_multibyte
3848 = !NILP (current_buffer
->enable_multibyte_characters
);
3849 coding
.eol_type
= CODING_EOL_LF
;
3850 coding_system_decided
= 1;
3854 /* Decide the coding system to use for reading the file now
3855 because we can't use an optimized method for handling
3856 `coding:' tag if the current buffer is not empty. */
3860 if (!NILP (Vcoding_system_for_read
))
3861 val
= Vcoding_system_for_read
;
3862 else if (! NILP (replace
))
3863 /* In REPLACE mode, we can use the same coding system
3864 that was used to visit the file. */
3865 val
= current_buffer
->buffer_file_coding_system
;
3868 /* Don't try looking inside a file for a coding system
3869 specification if it is not seekable. */
3870 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3872 /* Find a coding system specified in the heading two
3873 lines or in the tailing several lines of the file.
3874 We assume that the 1K-byte and 3K-byte for heading
3875 and tailing respectively are sufficient for this
3879 if (st
.st_size
<= (1024 * 4))
3880 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3883 nread
= emacs_read (fd
, read_buf
, 1024);
3886 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3887 report_file_error ("Setting file position",
3888 Fcons (orig_filename
, Qnil
));
3889 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3894 error ("IO error reading %s: %s",
3895 SDATA (orig_filename
), emacs_strerror (errno
));
3898 struct buffer
*prev
= current_buffer
;
3902 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3904 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3905 buf
= XBUFFER (buffer
);
3907 delete_all_overlays (buf
);
3908 buf
->directory
= current_buffer
->directory
;
3909 buf
->read_only
= Qnil
;
3910 buf
->filename
= Qnil
;
3911 buf
->undo_list
= Qt
;
3912 eassert (buf
->overlays_before
== NULL
);
3913 eassert (buf
->overlays_after
== NULL
);
3915 set_buffer_internal (buf
);
3917 buf
->enable_multibyte_characters
= Qnil
;
3919 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3920 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3921 val
= call2 (Vset_auto_coding_function
,
3922 filename
, make_number (nread
));
3923 set_buffer_internal (prev
);
3925 /* Discard the unwind protect for recovering the
3929 /* Rewind the file for the actual read done later. */
3930 if (lseek (fd
, 0, 0) < 0)
3931 report_file_error ("Setting file position",
3932 Fcons (orig_filename
, Qnil
));
3938 /* If we have not yet decided a coding system, check
3939 file-coding-system-alist. */
3940 Lisp_Object args
[6], coding_systems
;
3942 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3943 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3944 coding_systems
= Ffind_operation_coding_system (6, args
);
3945 if (CONSP (coding_systems
))
3946 val
= XCAR (coding_systems
);
3950 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3951 /* Ensure we set Vlast_coding_system_used. */
3952 set_coding_system
= 1;
3954 if (NILP (current_buffer
->enable_multibyte_characters
)
3956 /* We must suppress all character code conversion except for
3957 end-of-line conversion. */
3958 setup_raw_text_coding_system (&coding
);
3960 coding
.src_multibyte
= 0;
3961 coding
.dst_multibyte
3962 = !NILP (current_buffer
->enable_multibyte_characters
);
3963 coding_system_decided
= 1;
3966 /* If requested, replace the accessible part of the buffer
3967 with the file contents. Avoid replacing text at the
3968 beginning or end of the buffer that matches the file contents;
3969 that preserves markers pointing to the unchanged parts.
3971 Here we implement this feature in an optimized way
3972 for the case where code conversion is NOT needed.
3973 The following if-statement handles the case of conversion
3974 in a less optimal way.
3976 If the code conversion is "automatic" then we try using this
3977 method and hope for the best.
3978 But if we discover the need for conversion, we give up on this method
3979 and let the following if-statement handle the replace job. */
3982 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3984 /* same_at_start and same_at_end count bytes,
3985 because file access counts bytes
3986 and BEG and END count bytes. */
3987 int same_at_start
= BEGV_BYTE
;
3988 int same_at_end
= ZV_BYTE
;
3990 /* There is still a possibility we will find the need to do code
3991 conversion. If that happens, we set this variable to 1 to
3992 give up on handling REPLACE in the optimized way. */
3993 int giveup_match_end
= 0;
3995 if (XINT (beg
) != 0)
3997 if (lseek (fd
, XINT (beg
), 0) < 0)
3998 report_file_error ("Setting file position",
3999 Fcons (orig_filename
, Qnil
));
4004 /* Count how many chars at the start of the file
4005 match the text at the beginning of the buffer. */
4010 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4012 error ("IO error reading %s: %s",
4013 SDATA (orig_filename
), emacs_strerror (errno
));
4014 else if (nread
== 0)
4017 if (coding
.type
== coding_type_undecided
)
4018 detect_coding (&coding
, buffer
, nread
);
4019 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4020 /* We found that the file should be decoded somehow.
4021 Let's give up here. */
4023 giveup_match_end
= 1;
4027 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4028 detect_eol (&coding
, buffer
, nread
);
4029 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4030 && coding
.eol_type
!= CODING_EOL_LF
)
4031 /* We found that the format of eol should be decoded.
4032 Let's give up here. */
4034 giveup_match_end
= 1;
4039 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4040 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4041 same_at_start
++, bufpos
++;
4042 /* If we found a discrepancy, stop the scan.
4043 Otherwise loop around and scan the next bufferful. */
4044 if (bufpos
!= nread
)
4048 /* If the file matches the buffer completely,
4049 there's no need to replace anything. */
4050 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4054 /* Truncate the buffer to the size of the file. */
4055 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4060 /* Count how many chars at the end of the file
4061 match the text at the end of the buffer. But, if we have
4062 already found that decoding is necessary, don't waste time. */
4063 while (!giveup_match_end
)
4065 int total_read
, nread
, bufpos
, curpos
, trial
;
4067 /* At what file position are we now scanning? */
4068 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4069 /* If the entire file matches the buffer tail, stop the scan. */
4072 /* How much can we scan in the next step? */
4073 trial
= min (curpos
, sizeof buffer
);
4074 if (lseek (fd
, curpos
- trial
, 0) < 0)
4075 report_file_error ("Setting file position",
4076 Fcons (orig_filename
, Qnil
));
4078 total_read
= nread
= 0;
4079 while (total_read
< trial
)
4081 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4083 error ("IO error reading %s: %s",
4084 SDATA (orig_filename
), emacs_strerror (errno
));
4085 else if (nread
== 0)
4087 total_read
+= nread
;
4090 /* Scan this bufferful from the end, comparing with
4091 the Emacs buffer. */
4092 bufpos
= total_read
;
4094 /* Compare with same_at_start to avoid counting some buffer text
4095 as matching both at the file's beginning and at the end. */
4096 while (bufpos
> 0 && same_at_end
> same_at_start
4097 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4098 same_at_end
--, bufpos
--;
4100 /* If we found a discrepancy, stop the scan.
4101 Otherwise loop around and scan the preceding bufferful. */
4104 /* If this discrepancy is because of code conversion,
4105 we cannot use this method; giveup and try the other. */
4106 if (same_at_end
> same_at_start
4107 && FETCH_BYTE (same_at_end
- 1) >= 0200
4108 && ! NILP (current_buffer
->enable_multibyte_characters
)
4109 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4110 giveup_match_end
= 1;
4119 if (! giveup_match_end
)
4123 /* We win! We can handle REPLACE the optimized way. */
4125 /* Extend the start of non-matching text area to multibyte
4126 character boundary. */
4127 if (! NILP (current_buffer
->enable_multibyte_characters
))
4128 while (same_at_start
> BEGV_BYTE
4129 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4132 /* Extend the end of non-matching text area to multibyte
4133 character boundary. */
4134 if (! NILP (current_buffer
->enable_multibyte_characters
))
4135 while (same_at_end
< ZV_BYTE
4136 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4139 /* Don't try to reuse the same piece of text twice. */
4140 overlap
= (same_at_start
- BEGV_BYTE
4141 - (same_at_end
+ st
.st_size
- ZV
));
4143 same_at_end
+= overlap
;
4145 /* Arrange to read only the nonmatching middle part of the file. */
4146 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4147 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4149 del_range_byte (same_at_start
, same_at_end
, 0);
4150 /* Insert from the file at the proper position. */
4151 temp
= BYTE_TO_CHAR (same_at_start
);
4152 SET_PT_BOTH (temp
, same_at_start
);
4154 /* If display currently starts at beginning of line,
4155 keep it that way. */
4156 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4157 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4159 replace_handled
= 1;
4163 /* If requested, replace the accessible part of the buffer
4164 with the file contents. Avoid replacing text at the
4165 beginning or end of the buffer that matches the file contents;
4166 that preserves markers pointing to the unchanged parts.
4168 Here we implement this feature for the case where code conversion
4169 is needed, in a simple way that needs a lot of memory.
4170 The preceding if-statement handles the case of no conversion
4171 in a more optimized way. */
4172 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4174 int same_at_start
= BEGV_BYTE
;
4175 int same_at_end
= ZV_BYTE
;
4178 /* Make sure that the gap is large enough. */
4179 int bufsize
= 2 * st
.st_size
;
4180 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4183 /* First read the whole file, performing code conversion into
4184 CONVERSION_BUFFER. */
4186 if (lseek (fd
, XINT (beg
), 0) < 0)
4188 xfree (conversion_buffer
);
4189 report_file_error ("Setting file position",
4190 Fcons (orig_filename
, Qnil
));
4193 total
= st
.st_size
; /* Total bytes in the file. */
4194 how_much
= 0; /* Bytes read from file so far. */
4195 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4196 unprocessed
= 0; /* Bytes not processed in previous loop. */
4198 while (how_much
< total
)
4200 /* try is reserved in some compilers (Microsoft C) */
4201 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4202 unsigned char *destination
= read_buf
+ unprocessed
;
4205 /* Allow quitting out of the actual I/O. */
4208 this = emacs_read (fd
, destination
, trytry
);
4211 if (this < 0 || this + unprocessed
== 0)
4219 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4221 int require
, result
;
4223 this += unprocessed
;
4225 /* If we are using more space than estimated,
4226 make CONVERSION_BUFFER bigger. */
4227 require
= decoding_buffer_size (&coding
, this);
4228 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4230 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4231 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4234 /* Convert this batch with results in CONVERSION_BUFFER. */
4235 if (how_much
>= total
) /* This is the last block. */
4236 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4237 if (coding
.composing
!= COMPOSITION_DISABLED
)
4238 coding_allocate_composition_data (&coding
, BEGV
);
4239 result
= decode_coding (&coding
, read_buf
,
4240 conversion_buffer
+ inserted
,
4241 this, bufsize
- inserted
);
4243 /* Save for next iteration whatever we didn't convert. */
4244 unprocessed
= this - coding
.consumed
;
4245 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4246 if (!NILP (current_buffer
->enable_multibyte_characters
))
4247 this = coding
.produced
;
4249 this = str_as_unibyte (conversion_buffer
+ inserted
,
4256 /* At this point, INSERTED is how many characters (i.e. bytes)
4257 are present in CONVERSION_BUFFER.
4258 HOW_MUCH should equal TOTAL,
4259 or should be <= 0 if we couldn't read the file. */
4263 xfree (conversion_buffer
);
4266 error ("IO error reading %s: %s",
4267 SDATA (orig_filename
), emacs_strerror (errno
));
4268 else if (how_much
== -2)
4269 error ("maximum buffer size exceeded");
4272 /* Compare the beginning of the converted file
4273 with the buffer text. */
4276 while (bufpos
< inserted
&& same_at_start
< same_at_end
4277 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4278 same_at_start
++, bufpos
++;
4280 /* If the file matches the buffer completely,
4281 there's no need to replace anything. */
4283 if (bufpos
== inserted
)
4285 xfree (conversion_buffer
);
4288 /* Truncate the buffer to the size of the file. */
4289 del_range_byte (same_at_start
, same_at_end
, 0);
4294 /* Extend the start of non-matching text area to multibyte
4295 character boundary. */
4296 if (! NILP (current_buffer
->enable_multibyte_characters
))
4297 while (same_at_start
> BEGV_BYTE
4298 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4301 /* Scan this bufferful from the end, comparing with
4302 the Emacs buffer. */
4305 /* Compare with same_at_start to avoid counting some buffer text
4306 as matching both at the file's beginning and at the end. */
4307 while (bufpos
> 0 && same_at_end
> same_at_start
4308 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4309 same_at_end
--, bufpos
--;
4311 /* Extend the end of non-matching text area to multibyte
4312 character boundary. */
4313 if (! NILP (current_buffer
->enable_multibyte_characters
))
4314 while (same_at_end
< ZV_BYTE
4315 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4318 /* Don't try to reuse the same piece of text twice. */
4319 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4321 same_at_end
+= overlap
;
4323 /* If display currently starts at beginning of line,
4324 keep it that way. */
4325 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4326 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4328 /* Replace the chars that we need to replace,
4329 and update INSERTED to equal the number of bytes
4330 we are taking from the file. */
4331 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4333 if (same_at_end
!= same_at_start
)
4335 del_range_byte (same_at_start
, same_at_end
, 0);
4337 same_at_start
= GPT_BYTE
;
4341 temp
= BYTE_TO_CHAR (same_at_start
);
4343 /* Insert from the file at the proper position. */
4344 SET_PT_BOTH (temp
, same_at_start
);
4345 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
4347 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4348 coding_restore_composition (&coding
, Fcurrent_buffer ());
4349 coding_free_composition_data (&coding
);
4351 /* Set `inserted' to the number of inserted characters. */
4352 inserted
= PT
- temp
;
4354 xfree (conversion_buffer
);
4363 register Lisp_Object temp
;
4365 total
= XINT (end
) - XINT (beg
);
4367 /* Make sure point-max won't overflow after this insertion. */
4368 XSETINT (temp
, total
);
4369 if (total
!= XINT (temp
))
4370 error ("Maximum buffer size exceeded");
4373 /* For a special file, all we can do is guess. */
4374 total
= READ_BUF_SIZE
;
4376 if (NILP (visit
) && total
> 0)
4377 prepare_to_modify_buffer (PT
, PT
, NULL
);
4380 if (GAP_SIZE
< total
)
4381 make_gap (total
- GAP_SIZE
);
4383 if (XINT (beg
) != 0 || !NILP (replace
))
4385 if (lseek (fd
, XINT (beg
), 0) < 0)
4386 report_file_error ("Setting file position",
4387 Fcons (orig_filename
, Qnil
));
4390 /* In the following loop, HOW_MUCH contains the total bytes read so
4391 far for a regular file, and not changed for a special file. But,
4392 before exiting the loop, it is set to a negative value if I/O
4396 /* Total bytes inserted. */
4399 /* Here, we don't do code conversion in the loop. It is done by
4400 code_convert_region after all data are read into the buffer. */
4402 int gap_size
= GAP_SIZE
;
4404 while (how_much
< total
)
4406 /* try is reserved in some compilers (Microsoft C) */
4407 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4414 /* Maybe make more room. */
4415 if (gap_size
< trytry
)
4417 make_gap (total
- gap_size
);
4418 gap_size
= GAP_SIZE
;
4421 /* Read from the file, capturing `quit'. When an
4422 error occurs, end the loop, and arrange for a quit
4423 to be signaled after decoding the text we read. */
4424 non_regular_fd
= fd
;
4425 non_regular_inserted
= inserted
;
4426 non_regular_nbytes
= trytry
;
4427 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4428 read_non_regular_quit
);
4439 /* Allow quitting out of the actual I/O. We don't make text
4440 part of the buffer until all the reading is done, so a C-g
4441 here doesn't do any harm. */
4444 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4456 /* For a regular file, where TOTAL is the real size,
4457 count HOW_MUCH to compare with it.
4458 For a special file, where TOTAL is just a buffer size,
4459 so don't bother counting in HOW_MUCH.
4460 (INSERTED is where we count the number of characters inserted.) */
4467 /* Make the text read part of the buffer. */
4468 GAP_SIZE
-= inserted
;
4470 GPT_BYTE
+= inserted
;
4472 ZV_BYTE
+= inserted
;
4477 /* Put an anchor to ensure multi-byte form ends at gap. */
4482 /* Discard the unwind protect for closing the file. */
4486 error ("IO error reading %s: %s",
4487 SDATA (orig_filename
), emacs_strerror (errno
));
4491 if (! coding_system_decided
)
4493 /* The coding system is not yet decided. Decide it by an
4494 optimized method for handling `coding:' tag.
4496 Note that we can get here only if the buffer was empty
4497 before the insertion. */
4501 if (!NILP (Vcoding_system_for_read
))
4502 val
= Vcoding_system_for_read
;
4505 /* Since we are sure that the current buffer was empty
4506 before the insertion, we can toggle
4507 enable-multibyte-characters directly here without taking
4508 care of marker adjustment and byte combining problem. By
4509 this way, we can run Lisp program safely before decoding
4510 the inserted text. */
4511 Lisp_Object unwind_data
;
4512 int count
= SPECPDL_INDEX ();
4514 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4515 Fcons (current_buffer
->undo_list
,
4516 Fcurrent_buffer ()));
4517 current_buffer
->enable_multibyte_characters
= Qnil
;
4518 current_buffer
->undo_list
= Qt
;
4519 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4521 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4523 val
= call2 (Vset_auto_coding_function
,
4524 filename
, make_number (inserted
));
4529 /* If the coding system is not yet decided, check
4530 file-coding-system-alist. */
4531 Lisp_Object args
[6], coding_systems
;
4533 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4534 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4535 coding_systems
= Ffind_operation_coding_system (6, args
);
4536 if (CONSP (coding_systems
))
4537 val
= XCAR (coding_systems
);
4540 unbind_to (count
, Qnil
);
4541 inserted
= Z_BYTE
- BEG_BYTE
;
4544 /* The following kludgy code is to avoid some compiler bug.
4546 setup_coding_system (val, &coding);
4549 struct coding_system temp_coding
;
4550 setup_coding_system (val
, &temp_coding
);
4551 bcopy (&temp_coding
, &coding
, sizeof coding
);
4553 /* Ensure we set Vlast_coding_system_used. */
4554 set_coding_system
= 1;
4556 if (NILP (current_buffer
->enable_multibyte_characters
)
4558 /* We must suppress all character code conversion except for
4559 end-of-line conversion. */
4560 setup_raw_text_coding_system (&coding
);
4561 coding
.src_multibyte
= 0;
4562 coding
.dst_multibyte
4563 = !NILP (current_buffer
->enable_multibyte_characters
);
4567 /* Can't do this if part of the buffer might be preserved. */
4569 && (coding
.type
== coding_type_no_conversion
4570 || coding
.type
== coding_type_raw_text
))
4572 /* Visiting a file with these coding system makes the buffer
4574 current_buffer
->enable_multibyte_characters
= Qnil
;
4575 coding
.dst_multibyte
= 0;
4578 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4580 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4582 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4584 inserted
= coding
.produced_char
;
4587 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4591 /* Now INSERTED is measured in characters. */
4594 /* Use the conversion type to determine buffer-file-type
4595 (find-buffer-file-type is now used to help determine the
4597 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4598 || coding
.eol_type
== CODING_EOL_LF
)
4599 && ! CODING_REQUIRE_DECODING (&coding
))
4600 current_buffer
->buffer_file_type
= Qt
;
4602 current_buffer
->buffer_file_type
= Qnil
;
4609 if (!EQ (current_buffer
->undo_list
, Qt
))
4610 current_buffer
->undo_list
= Qnil
;
4612 stat (SDATA (filename
), &st
);
4617 current_buffer
->modtime
= st
.st_mtime
;
4618 current_buffer
->filename
= orig_filename
;
4621 SAVE_MODIFF
= MODIFF
;
4622 current_buffer
->auto_save_modified
= MODIFF
;
4623 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4624 #ifdef CLASH_DETECTION
4627 if (!NILP (current_buffer
->file_truename
))
4628 unlock_file (current_buffer
->file_truename
);
4629 unlock_file (filename
);
4631 #endif /* CLASH_DETECTION */
4633 Fsignal (Qfile_error
,
4634 Fcons (build_string ("not a regular file"),
4635 Fcons (orig_filename
, Qnil
)));
4638 if (set_coding_system
)
4639 Vlast_coding_system_used
= coding
.symbol
;
4641 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4643 insval
= call1 (Qafter_insert_file_set_coding
, make_number (inserted
));
4644 if (! NILP (insval
))
4646 CHECK_NUMBER (insval
);
4647 inserted
= XFASTINT (insval
);
4651 /* Decode file format */
4654 int empty_undo_list_p
= 0;
4656 /* If we're anyway going to discard undo information, don't
4657 record it in the first place. The buffer's undo list at this
4658 point is either nil or t when visiting a file. */
4661 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4662 current_buffer
->undo_list
= Qt
;
4665 insval
= call3 (Qformat_decode
,
4666 Qnil
, make_number (inserted
), visit
);
4667 CHECK_NUMBER (insval
);
4668 inserted
= XFASTINT (insval
);
4671 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4674 /* Call after-change hooks for the inserted text, aside from the case
4675 of normal visiting (not with REPLACE), which is done in a new buffer
4676 "before" the buffer is changed. */
4677 if (inserted
> 0 && total
> 0
4678 && (NILP (visit
) || !NILP (replace
)))
4680 signal_after_change (PT
, 0, inserted
);
4681 update_compositions (PT
, PT
, CHECK_BORDER
);
4684 p
= Vafter_insert_file_functions
;
4687 insval
= call1 (XCAR (p
), make_number (inserted
));
4690 CHECK_NUMBER (insval
);
4691 inserted
= XFASTINT (insval
);
4698 && current_buffer
->modtime
== -1)
4700 /* If visiting nonexistent file, return nil. */
4701 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4705 Fsignal (Qquit
, Qnil
);
4707 /* ??? Retval needs to be dealt with in all cases consistently. */
4709 val
= Fcons (orig_filename
,
4710 Fcons (make_number (inserted
),
4713 RETURN_UNGCPRO (unbind_to (count
, val
));
4716 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4717 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4718 Lisp_Object
, Lisp_Object
));
4720 /* If build_annotations switched buffers, switch back to BUF.
4721 Kill the temporary buffer that was selected in the meantime.
4723 Since this kill only the last temporary buffer, some buffers remain
4724 not killed if build_annotations switched buffers more than once.
4728 build_annotations_unwind (buf
)
4733 if (XBUFFER (buf
) == current_buffer
)
4735 tembuf
= Fcurrent_buffer ();
4737 Fkill_buffer (tembuf
);
4741 /* Decide the coding-system to encode the data with. */
4744 choose_write_coding_system (start
, end
, filename
,
4745 append
, visit
, lockname
, coding
)
4746 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4747 struct coding_system
*coding
;
4752 && NILP (Fstring_equal (current_buffer
->filename
,
4753 current_buffer
->auto_save_file_name
)))
4755 /* We use emacs-mule for auto saving... */
4756 setup_coding_system (Qemacs_mule
, coding
);
4757 /* ... but with the special flag to indicate not to strip off
4758 leading code of eight-bit-control chars. */
4760 goto done_setup_coding
;
4762 else if (!NILP (Vcoding_system_for_write
))
4764 val
= Vcoding_system_for_write
;
4765 if (coding_system_require_warning
4766 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4767 /* Confirm that VAL can surely encode the current region. */
4768 val
= call5 (Vselect_safe_coding_system_function
,
4769 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4774 /* If the variable `buffer-file-coding-system' is set locally,
4775 it means that the file was read with some kind of code
4776 conversion or the variable is explicitly set by users. We
4777 had better write it out with the same coding system even if
4778 `enable-multibyte-characters' is nil.
4780 If it is not set locally, we anyway have to convert EOL
4781 format if the default value of `buffer-file-coding-system'
4782 tells that it is not Unix-like (LF only) format. */
4783 int using_default_coding
= 0;
4784 int force_raw_text
= 0;
4786 val
= current_buffer
->buffer_file_coding_system
;
4788 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4791 if (NILP (current_buffer
->enable_multibyte_characters
))
4797 /* Check file-coding-system-alist. */
4798 Lisp_Object args
[7], coding_systems
;
4800 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4801 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4803 coding_systems
= Ffind_operation_coding_system (7, args
);
4804 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4805 val
= XCDR (coding_systems
);
4809 && !NILP (current_buffer
->buffer_file_coding_system
))
4811 /* If we still have not decided a coding system, use the
4812 default value of buffer-file-coding-system. */
4813 val
= current_buffer
->buffer_file_coding_system
;
4814 using_default_coding
= 1;
4818 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4819 /* Confirm that VAL can surely encode the current region. */
4820 val
= call5 (Vselect_safe_coding_system_function
,
4821 start
, end
, val
, Qnil
, filename
);
4823 setup_coding_system (Fcheck_coding_system (val
), coding
);
4824 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4825 && !using_default_coding
)
4827 if (! EQ (default_buffer_file_coding
.symbol
,
4828 buffer_defaults
.buffer_file_coding_system
))
4829 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4830 &default_buffer_file_coding
);
4831 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4833 Lisp_Object subsidiaries
;
4835 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4836 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4837 if (VECTORP (subsidiaries
)
4838 && XVECTOR (subsidiaries
)->size
== 3)
4840 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4845 setup_raw_text_coding_system (coding
);
4846 goto done_setup_coding
;
4849 setup_coding_system (Fcheck_coding_system (val
), coding
);
4852 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4853 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4856 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4857 "r\nFWrite region to file: \ni\ni\ni\np",
4858 doc
: /* Write current region into specified file.
4859 When called from a program, requires three arguments:
4860 START, END and FILENAME. START and END are normally buffer positions
4861 specifying the part of the buffer to write.
4862 If START is nil, that means to use the entire buffer contents.
4863 If START is a string, then output that string to the file
4864 instead of any buffer contents; END is ignored.
4866 Optional fourth argument APPEND if non-nil means
4867 append to existing file contents (if any). If it is an integer,
4868 seek to that offset in the file before writing.
4869 Optional fifth argument VISIT if t means
4870 set the last-save-file-modtime of buffer to this file's modtime
4871 and mark buffer not modified.
4872 If VISIT is a string, it is a second file name;
4873 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4874 VISIT is also the file name to lock and unlock for clash detection.
4875 If VISIT is neither t nor nil nor a string,
4876 that means do not display the \"Wrote file\" message.
4877 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4878 use for locking and unlocking, overriding FILENAME and VISIT.
4879 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4880 for an existing file with the same name. If MUSTBENEW is `excl',
4881 that means to get an error if the file already exists; never overwrite.
4882 If MUSTBENEW is neither nil nor `excl', that means ask for
4883 confirmation before overwriting, but do go ahead and overwrite the file
4884 if the user confirms.
4886 This does code conversion according to the value of
4887 `coding-system-for-write', `buffer-file-coding-system', or
4888 `file-coding-system-alist', and sets the variable
4889 `last-coding-system-used' to the coding system actually used. */)
4890 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4891 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4896 const unsigned char *fn
;
4899 int count
= SPECPDL_INDEX ();
4902 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4904 Lisp_Object handler
;
4905 Lisp_Object visit_file
;
4906 Lisp_Object annotations
;
4907 Lisp_Object encoded_filename
;
4908 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4909 int quietly
= !NILP (visit
);
4910 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4911 struct buffer
*given_buffer
;
4913 int buffer_file_type
= O_BINARY
;
4915 struct coding_system coding
;
4917 if (current_buffer
->base_buffer
&& visiting
)
4918 error ("Cannot do file visiting in an indirect buffer");
4920 if (!NILP (start
) && !STRINGP (start
))
4921 validate_region (&start
, &end
);
4923 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4925 filename
= Fexpand_file_name (filename
, Qnil
);
4927 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4928 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4930 if (STRINGP (visit
))
4931 visit_file
= Fexpand_file_name (visit
, Qnil
);
4933 visit_file
= filename
;
4935 if (NILP (lockname
))
4936 lockname
= visit_file
;
4940 /* If the file name has special constructs in it,
4941 call the corresponding file handler. */
4942 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4943 /* If FILENAME has no handler, see if VISIT has one. */
4944 if (NILP (handler
) && STRINGP (visit
))
4945 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4947 if (!NILP (handler
))
4950 val
= call6 (handler
, Qwrite_region
, start
, end
,
4951 filename
, append
, visit
);
4955 SAVE_MODIFF
= MODIFF
;
4956 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4957 current_buffer
->filename
= visit_file
;
4963 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4965 /* Special kludge to simplify auto-saving. */
4968 XSETFASTINT (start
, BEG
);
4969 XSETFASTINT (end
, Z
);
4973 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4974 count1
= SPECPDL_INDEX ();
4976 given_buffer
= current_buffer
;
4978 if (!STRINGP (start
))
4980 annotations
= build_annotations (start
, end
);
4982 if (current_buffer
!= given_buffer
)
4984 XSETFASTINT (start
, BEGV
);
4985 XSETFASTINT (end
, ZV
);
4991 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4993 /* Decide the coding-system to encode the data with.
4994 We used to make this choice before calling build_annotations, but that
4995 leads to problems when a write-annotate-function takes care of
4996 unsavable chars (as was the case with X-Symbol). */
4997 choose_write_coding_system (start
, end
, filename
,
4998 append
, visit
, lockname
, &coding
);
4999 Vlast_coding_system_used
= coding
.symbol
;
5001 given_buffer
= current_buffer
;
5002 if (! STRINGP (start
))
5004 annotations
= build_annotations_2 (start
, end
,
5005 coding
.pre_write_conversion
, annotations
);
5006 if (current_buffer
!= given_buffer
)
5008 XSETFASTINT (start
, BEGV
);
5009 XSETFASTINT (end
, ZV
);
5013 #ifdef CLASH_DETECTION
5016 #if 0 /* This causes trouble for GNUS. */
5017 /* If we've locked this file for some other buffer,
5018 query before proceeding. */
5019 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5020 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5023 lock_file (lockname
);
5025 #endif /* CLASH_DETECTION */
5027 encoded_filename
= ENCODE_FILE (filename
);
5029 fn
= SDATA (encoded_filename
);
5033 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5034 #else /* not DOS_NT */
5035 desc
= emacs_open (fn
, O_WRONLY
, 0);
5036 #endif /* not DOS_NT */
5038 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5040 if (auto_saving
) /* Overwrite any previous version of autosave file */
5042 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5043 desc
= emacs_open (fn
, O_RDWR
, 0);
5045 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5046 ? SDATA (current_buffer
->filename
) : 0,
5049 else /* Write to temporary name and rename if no errors */
5051 Lisp_Object temp_name
;
5052 temp_name
= Ffile_name_directory (filename
);
5054 if (!NILP (temp_name
))
5056 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5057 build_string ("$$SAVE$$")));
5058 fname
= SDATA (filename
);
5059 fn
= SDATA (temp_name
);
5060 desc
= creat_copy_attrs (fname
, fn
);
5063 /* If we can't open the temporary file, try creating a new
5064 version of the original file. VMS "creat" creates a
5065 new version rather than truncating an existing file. */
5068 desc
= creat (fn
, 0666);
5069 #if 0 /* This can clobber an existing file and fail to replace it,
5070 if the user runs out of space. */
5073 /* We can't make a new version;
5074 try to truncate and rewrite existing version if any. */
5076 desc
= emacs_open (fn
, O_RDWR
, 0);
5082 desc
= creat (fn
, 0666);
5086 desc
= emacs_open (fn
,
5087 O_WRONLY
| O_CREAT
| buffer_file_type
5088 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5089 S_IREAD
| S_IWRITE
);
5090 #else /* not DOS_NT */
5091 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5092 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5093 auto_saving
? auto_save_mode_bits
: 0666);
5094 #endif /* not DOS_NT */
5095 #endif /* not VMS */
5099 #ifdef CLASH_DETECTION
5101 if (!auto_saving
) unlock_file (lockname
);
5103 #endif /* CLASH_DETECTION */
5105 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5108 record_unwind_protect (close_file_unwind
, make_number (desc
));
5110 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5114 if (NUMBERP (append
))
5115 ret
= lseek (desc
, XINT (append
), 1);
5117 ret
= lseek (desc
, 0, 2);
5120 #ifdef CLASH_DETECTION
5121 if (!auto_saving
) unlock_file (lockname
);
5122 #endif /* CLASH_DETECTION */
5124 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5132 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5133 * if we do writes that don't end with a carriage return. Furthermore
5134 * it cannot handle writes of more then 16K. The modified
5135 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5136 * this EXCEPT for the last record (iff it doesn't end with a carriage
5137 * return). This implies that if your buffer doesn't end with a carriage
5138 * return, you get one free... tough. However it also means that if
5139 * we make two calls to sys_write (a la the following code) you can
5140 * get one at the gap as well. The easiest way to fix this (honest)
5141 * is to move the gap to the next newline (or the end of the buffer).
5146 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5147 move_gap (find_next_newline (GPT
, 1));
5149 /* Whether VMS or not, we must move the gap to the next of newline
5150 when we must put designation sequences at beginning of line. */
5151 if (INTEGERP (start
)
5152 && coding
.type
== coding_type_iso2022
5153 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5154 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5156 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5157 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5158 move_gap_both (PT
, PT_BYTE
);
5159 SET_PT_BOTH (opoint
, opoint_byte
);
5166 if (STRINGP (start
))
5168 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5169 &annotations
, &coding
);
5172 else if (XINT (start
) != XINT (end
))
5174 tem
= CHAR_TO_BYTE (XINT (start
));
5176 if (XINT (start
) < GPT
)
5178 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5179 min (GPT
, XINT (end
)) - XINT (start
),
5180 &annotations
, &coding
);
5184 if (XINT (end
) > GPT
&& !failure
)
5186 tem
= max (XINT (start
), GPT
);
5187 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5188 &annotations
, &coding
);
5194 /* If file was empty, still need to write the annotations */
5195 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5196 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5200 if (CODING_REQUIRE_FLUSHING (&coding
)
5201 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5204 /* We have to flush out a data. */
5205 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5206 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5213 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5214 Disk full in NFS may be reported here. */
5215 /* mib says that closing the file will try to write as fast as NFS can do
5216 it, and that means the fsync here is not crucial for autosave files. */
5217 if (!auto_saving
&& fsync (desc
) < 0)
5219 /* If fsync fails with EINTR, don't treat that as serious. */
5221 failure
= 1, save_errno
= errno
;
5225 /* Spurious "file has changed on disk" warnings have been
5226 observed on Suns as well.
5227 It seems that `close' can change the modtime, under nfs.
5229 (This has supposedly been fixed in Sunos 4,
5230 but who knows about all the other machines with NFS?) */
5233 /* On VMS and APOLLO, must do the stat after the close
5234 since closing changes the modtime. */
5237 /* Recall that #if defined does not work on VMS. */
5244 /* NFS can report a write failure now. */
5245 if (emacs_close (desc
) < 0)
5246 failure
= 1, save_errno
= errno
;
5249 /* If we wrote to a temporary name and had no errors, rename to real name. */
5253 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5261 /* Discard the unwind protect for close_file_unwind. */
5262 specpdl_ptr
= specpdl
+ count1
;
5263 /* Restore the original current buffer. */
5264 visit_file
= unbind_to (count
, visit_file
);
5266 #ifdef CLASH_DETECTION
5268 unlock_file (lockname
);
5269 #endif /* CLASH_DETECTION */
5271 /* Do this before reporting IO error
5272 to avoid a "file has changed on disk" warning on
5273 next attempt to save. */
5275 current_buffer
->modtime
= st
.st_mtime
;
5278 error ("IO error writing %s: %s", SDATA (filename
),
5279 emacs_strerror (save_errno
));
5283 SAVE_MODIFF
= MODIFF
;
5284 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5285 current_buffer
->filename
= visit_file
;
5286 update_mode_lines
++;
5291 && ! NILP (Fstring_equal (current_buffer
->filename
,
5292 current_buffer
->auto_save_file_name
)))
5293 SAVE_MODIFF
= MODIFF
;
5299 message_with_string ((INTEGERP (append
)
5309 Lisp_Object
merge ();
5311 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5312 doc
: /* Return t if (car A) is numerically less than (car B). */)
5316 return Flss (Fcar (a
), Fcar (b
));
5319 /* Build the complete list of annotations appropriate for writing out
5320 the text between START and END, by calling all the functions in
5321 write-region-annotate-functions and merging the lists they return.
5322 If one of these functions switches to a different buffer, we assume
5323 that buffer contains altered text. Therefore, the caller must
5324 make sure to restore the current buffer in all cases,
5325 as save-excursion would do. */
5328 build_annotations (start
, end
)
5329 Lisp_Object start
, end
;
5331 Lisp_Object annotations
;
5333 struct gcpro gcpro1
, gcpro2
;
5334 Lisp_Object original_buffer
;
5335 int i
, used_global
= 0;
5337 XSETBUFFER (original_buffer
, current_buffer
);
5340 p
= Vwrite_region_annotate_functions
;
5341 GCPRO2 (annotations
, p
);
5344 struct buffer
*given_buffer
= current_buffer
;
5345 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5346 { /* Use the global value of the hook. */
5349 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5351 p
= Fappend (2, arg
);
5354 Vwrite_region_annotations_so_far
= annotations
;
5355 res
= call2 (XCAR (p
), start
, end
);
5356 /* If the function makes a different buffer current,
5357 assume that means this buffer contains altered text to be output.
5358 Reset START and END from the buffer bounds
5359 and discard all previous annotations because they should have
5360 been dealt with by this function. */
5361 if (current_buffer
!= given_buffer
)
5363 XSETFASTINT (start
, BEGV
);
5364 XSETFASTINT (end
, ZV
);
5367 Flength (res
); /* Check basic validity of return value */
5368 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5372 /* Now do the same for annotation functions implied by the file-format */
5373 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5374 p
= Vauto_save_file_format
;
5376 p
= current_buffer
->file_format
;
5377 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5379 struct buffer
*given_buffer
= current_buffer
;
5381 Vwrite_region_annotations_so_far
= annotations
;
5383 /* Value is either a list of annotations or nil if the function
5384 has written annotations to a temporary buffer, which is now
5386 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5387 original_buffer
, make_number (i
));
5388 if (current_buffer
!= given_buffer
)
5390 XSETFASTINT (start
, BEGV
);
5391 XSETFASTINT (end
, ZV
);
5396 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5404 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5405 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5407 struct gcpro gcpro1
;
5410 GCPRO1 (annotations
);
5411 /* At last, do the same for the function PRE_WRITE_CONVERSION
5412 implied by the current coding-system. */
5413 if (!NILP (pre_write_conversion
))
5415 struct buffer
*given_buffer
= current_buffer
;
5416 Vwrite_region_annotations_so_far
= annotations
;
5417 res
= call2 (pre_write_conversion
, start
, end
);
5419 annotations
= (current_buffer
!= given_buffer
5421 : merge (annotations
, res
, Qcar_less_than_car
));
5428 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5429 If STRING is nil, POS is the character position in the current buffer.
5430 Intersperse with them the annotations from *ANNOT
5431 which fall within the range of POS to POS + NCHARS,
5432 each at its appropriate position.
5434 We modify *ANNOT by discarding elements as we use them up.
5436 The return value is negative in case of system call failure. */
5439 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5442 register int nchars
;
5445 struct coding_system
*coding
;
5449 int lastpos
= pos
+ nchars
;
5451 while (NILP (*annot
) || CONSP (*annot
))
5453 tem
= Fcar_safe (Fcar (*annot
));
5456 nextpos
= XFASTINT (tem
);
5458 /* If there are no more annotations in this range,
5459 output the rest of the range all at once. */
5460 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5461 return e_write (desc
, string
, pos
, lastpos
, coding
);
5463 /* Output buffer text up to the next annotation's position. */
5466 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5470 /* Output the annotation. */
5471 tem
= Fcdr (Fcar (*annot
));
5474 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5477 *annot
= Fcdr (*annot
);
5482 #ifndef WRITE_BUF_SIZE
5483 #define WRITE_BUF_SIZE (16 * 1024)
5486 /* Write text in the range START and END into descriptor DESC,
5487 encoding them with coding system CODING. If STRING is nil, START
5488 and END are character positions of the current buffer, else they
5489 are indexes to the string STRING. */
5492 e_write (desc
, string
, start
, end
, coding
)
5496 struct coding_system
*coding
;
5498 register char *addr
;
5499 register int nbytes
;
5500 char buf
[WRITE_BUF_SIZE
];
5504 coding
->composing
= COMPOSITION_DISABLED
;
5505 if (coding
->composing
!= COMPOSITION_DISABLED
)
5506 coding_save_composition (coding
, start
, end
, string
);
5508 if (STRINGP (string
))
5510 addr
= SDATA (string
);
5511 nbytes
= SBYTES (string
);
5512 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5514 else if (start
< end
)
5516 /* It is assured that the gap is not in the range START and END-1. */
5517 addr
= CHAR_POS_ADDR (start
);
5518 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5519 coding
->src_multibyte
5520 = !NILP (current_buffer
->enable_multibyte_characters
);
5526 coding
->src_multibyte
= 1;
5529 /* We used to have a code for handling selective display here. But,
5530 now it is handled within encode_coding. */
5535 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5536 if (coding
->produced
> 0)
5538 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5539 if (coding
->produced
)
5545 nbytes
-= coding
->consumed
;
5546 addr
+= coding
->consumed
;
5547 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5550 /* The source text ends by an incomplete multibyte form.
5551 There's no way other than write it out as is. */
5552 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5561 start
+= coding
->consumed_char
;
5562 if (coding
->cmp_data
)
5563 coding_adjust_composition_offset (coding
, start
);
5566 if (coding
->cmp_data
)
5567 coding_free_composition_data (coding
);
5572 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5573 Sverify_visited_file_modtime
, 1, 1, 0,
5574 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5575 This means that the file has not been changed since it was visited or saved.
5576 See Info node `(elisp)Modification Time' for more details. */)
5582 Lisp_Object handler
;
5583 Lisp_Object filename
;
5588 if (!STRINGP (b
->filename
)) return Qt
;
5589 if (b
->modtime
== 0) return Qt
;
5591 /* If the file name has special constructs in it,
5592 call the corresponding file handler. */
5593 handler
= Ffind_file_name_handler (b
->filename
,
5594 Qverify_visited_file_modtime
);
5595 if (!NILP (handler
))
5596 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5598 filename
= ENCODE_FILE (b
->filename
);
5600 if (stat (SDATA (filename
), &st
) < 0)
5602 /* If the file doesn't exist now and didn't exist before,
5603 we say that it isn't modified, provided the error is a tame one. */
5604 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5609 if (st
.st_mtime
== b
->modtime
5610 /* If both are positive, accept them if they are off by one second. */
5611 || (st
.st_mtime
> 0 && b
->modtime
> 0
5612 && (st
.st_mtime
== b
->modtime
+ 1
5613 || st
.st_mtime
== b
->modtime
- 1)))
5618 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5619 Sclear_visited_file_modtime
, 0, 0, 0,
5620 doc
: /* Clear out records of last mod time of visited file.
5621 Next attempt to save will certainly not complain of a discrepancy. */)
5624 current_buffer
->modtime
= 0;
5628 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5629 Svisited_file_modtime
, 0, 0, 0,
5630 doc
: /* Return the current buffer's recorded visited file modification time.
5631 The value is a list of the form (HIGH LOW), like the time values
5632 that `file-attributes' returns. If the current buffer has no recorded
5633 file modification time, this function returns 0.
5634 See Info node `(elisp)Modification Time' for more details. */)
5638 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5640 return list2 (XCAR (tcons
), XCDR (tcons
));
5644 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5645 Sset_visited_file_modtime
, 0, 1, 0,
5646 doc
: /* Update buffer's recorded modification time from the visited file's time.
5647 Useful if the buffer was not read from the file normally
5648 or if the file itself has been changed for some known benign reason.
5649 An argument specifies the modification time value to use
5650 \(instead of that of the visited file), in the form of a list
5651 \(HIGH . LOW) or (HIGH LOW). */)
5653 Lisp_Object time_list
;
5655 if (!NILP (time_list
))
5656 current_buffer
->modtime
= cons_to_long (time_list
);
5659 register Lisp_Object filename
;
5661 Lisp_Object handler
;
5663 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5665 /* If the file name has special constructs in it,
5666 call the corresponding file handler. */
5667 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5668 if (!NILP (handler
))
5669 /* The handler can find the file name the same way we did. */
5670 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5672 filename
= ENCODE_FILE (filename
);
5674 if (stat (SDATA (filename
), &st
) >= 0)
5675 current_buffer
->modtime
= st
.st_mtime
;
5682 auto_save_error (error
)
5685 Lisp_Object args
[3], msg
;
5687 struct gcpro gcpro1
;
5691 args
[0] = build_string ("Auto-saving %s: %s");
5692 args
[1] = current_buffer
->name
;
5693 args
[2] = Ferror_message_string (error
);
5694 msg
= Fformat (3, args
);
5696 nbytes
= SBYTES (msg
);
5698 for (i
= 0; i
< 3; ++i
)
5701 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5703 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5704 Fsleep_for (make_number (1), Qnil
);
5716 /* Get visited file's mode to become the auto save file's mode. */
5717 if (! NILP (current_buffer
->filename
)
5718 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5719 /* But make sure we can overwrite it later! */
5720 auto_save_mode_bits
= st
.st_mode
| 0600;
5722 auto_save_mode_bits
= 0666;
5725 Fwrite_region (Qnil
, Qnil
,
5726 current_buffer
->auto_save_file_name
,
5727 Qnil
, Qlambda
, Qnil
, Qnil
);
5731 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5736 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5737 | XFASTINT (XCDR (stream
))));
5742 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5745 minibuffer_auto_raise
= XINT (value
);
5750 do_auto_save_make_dir (dir
)
5753 return call2 (Qmake_directory
, dir
, Qt
);
5757 do_auto_save_eh (ignore
)
5763 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5764 doc
: /* Auto-save all buffers that need it.
5765 This is all buffers that have auto-saving enabled
5766 and are changed since last auto-saved.
5767 Auto-saving writes the buffer into a file
5768 so that your editing is not lost if the system crashes.
5769 This file is not the file you visited; that changes only when you save.
5770 Normally we run the normal hook `auto-save-hook' before saving.
5772 A non-nil NO-MESSAGE argument means do not print any message if successful.
5773 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5774 (no_message
, current_only
)
5775 Lisp_Object no_message
, current_only
;
5777 struct buffer
*old
= current_buffer
, *b
;
5778 Lisp_Object tail
, buf
;
5780 int do_handled_files
;
5783 Lisp_Object lispstream
;
5784 int count
= SPECPDL_INDEX ();
5785 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5786 int old_message_p
= 0;
5787 struct gcpro gcpro1
, gcpro2
;
5789 if (max_specpdl_size
< specpdl_size
+ 40)
5790 max_specpdl_size
= specpdl_size
+ 40;
5795 if (NILP (no_message
))
5797 old_message_p
= push_message ();
5798 record_unwind_protect (pop_message_unwind
, Qnil
);
5801 /* Ordinarily don't quit within this function,
5802 but don't make it impossible to quit (in case we get hung in I/O). */
5806 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5807 point to non-strings reached from Vbuffer_alist. */
5809 if (!NILP (Vrun_hooks
))
5810 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5812 if (STRINGP (Vauto_save_list_file_name
))
5814 Lisp_Object listfile
;
5816 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5818 /* Don't try to create the directory when shutting down Emacs,
5819 because creating the directory might signal an error, and
5820 that would leave Emacs in a strange state. */
5821 if (!NILP (Vrun_hooks
))
5825 GCPRO2 (dir
, listfile
);
5826 dir
= Ffile_name_directory (listfile
);
5827 if (NILP (Ffile_directory_p (dir
)))
5828 internal_condition_case_1 (do_auto_save_make_dir
,
5829 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5834 stream
= fopen (SDATA (listfile
), "w");
5837 /* Arrange to close that file whether or not we get an error.
5838 Also reset auto_saving to 0. */
5839 lispstream
= Fcons (Qnil
, Qnil
);
5840 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5841 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5852 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5853 record_unwind_protect (do_auto_save_unwind_1
,
5854 make_number (minibuffer_auto_raise
));
5855 minibuffer_auto_raise
= 0;
5858 /* On first pass, save all files that don't have handlers.
5859 On second pass, save all files that do have handlers.
5861 If Emacs is crashing, the handlers may tweak what is causing
5862 Emacs to crash in the first place, and it would be a shame if
5863 Emacs failed to autosave perfectly ordinary files because it
5864 couldn't handle some ange-ftp'd file. */
5866 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5867 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5869 buf
= XCDR (XCAR (tail
));
5872 /* Record all the buffers that have auto save mode
5873 in the special file that lists them. For each of these buffers,
5874 Record visited name (if any) and auto save name. */
5875 if (STRINGP (b
->auto_save_file_name
)
5876 && stream
!= NULL
&& do_handled_files
== 0)
5878 if (!NILP (b
->filename
))
5880 fwrite (SDATA (b
->filename
), 1,
5881 SBYTES (b
->filename
), stream
);
5883 putc ('\n', stream
);
5884 fwrite (SDATA (b
->auto_save_file_name
), 1,
5885 SBYTES (b
->auto_save_file_name
), stream
);
5886 putc ('\n', stream
);
5889 if (!NILP (current_only
)
5890 && b
!= current_buffer
)
5893 /* Don't auto-save indirect buffers.
5894 The base buffer takes care of it. */
5898 /* Check for auto save enabled
5899 and file changed since last auto save
5900 and file changed since last real save. */
5901 if (STRINGP (b
->auto_save_file_name
)
5902 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5903 && b
->auto_save_modified
< BUF_MODIFF (b
)
5904 /* -1 means we've turned off autosaving for a while--see below. */
5905 && XINT (b
->save_length
) >= 0
5906 && (do_handled_files
5907 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5910 EMACS_TIME before_time
, after_time
;
5912 EMACS_GET_TIME (before_time
);
5914 /* If we had a failure, don't try again for 20 minutes. */
5915 if (b
->auto_save_failure_time
>= 0
5916 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5919 if ((XFASTINT (b
->save_length
) * 10
5920 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5921 /* A short file is likely to change a large fraction;
5922 spare the user annoying messages. */
5923 && XFASTINT (b
->save_length
) > 5000
5924 /* These messages are frequent and annoying for `*mail*'. */
5925 && !EQ (b
->filename
, Qnil
)
5926 && NILP (no_message
))
5928 /* It has shrunk too much; turn off auto-saving here. */
5929 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5930 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5932 minibuffer_auto_raise
= 0;
5933 /* Turn off auto-saving until there's a real save,
5934 and prevent any more warnings. */
5935 XSETINT (b
->save_length
, -1);
5936 Fsleep_for (make_number (1), Qnil
);
5939 set_buffer_internal (b
);
5940 if (!auto_saved
&& NILP (no_message
))
5941 message1 ("Auto-saving...");
5942 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5944 b
->auto_save_modified
= BUF_MODIFF (b
);
5945 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5946 set_buffer_internal (old
);
5948 EMACS_GET_TIME (after_time
);
5950 /* If auto-save took more than 60 seconds,
5951 assume it was an NFS failure that got a timeout. */
5952 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5953 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5957 /* Prevent another auto save till enough input events come in. */
5958 record_auto_save ();
5960 if (auto_saved
&& NILP (no_message
))
5964 /* If we are going to restore an old message,
5965 give time to read ours. */
5966 sit_for (1, 0, 0, 0, 0);
5970 /* If we displayed a message and then restored a state
5971 with no message, leave a "done" message on the screen. */
5972 message1 ("Auto-saving...done");
5977 /* This restores the message-stack status. */
5978 unbind_to (count
, Qnil
);
5982 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5983 Sset_buffer_auto_saved
, 0, 0, 0,
5984 doc
: /* Mark current buffer as auto-saved with its current text.
5985 No auto-save file will be written until the buffer changes again. */)
5988 current_buffer
->auto_save_modified
= MODIFF
;
5989 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5990 current_buffer
->auto_save_failure_time
= -1;
5994 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5995 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5996 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5999 current_buffer
->auto_save_failure_time
= -1;
6003 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6005 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
6008 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6011 /* Reading and completing file names */
6012 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6014 /* In the string VAL, change each $ to $$ and return the result. */
6017 double_dollars (val
)
6020 register const unsigned char *old
;
6021 register unsigned char *new;
6025 osize
= SBYTES (val
);
6027 /* Count the number of $ characters. */
6028 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6029 if (*old
++ == '$') count
++;
6033 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6036 for (n
= osize
; n
> 0; n
--)
6050 read_file_name_cleanup (arg
)
6053 return (current_buffer
->directory
= arg
);
6056 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6058 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6059 (string
, dir
, action
)
6060 Lisp_Object string
, dir
, action
;
6061 /* action is nil for complete, t for return list of completions,
6062 lambda for verify final value */
6064 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6066 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6068 CHECK_STRING (string
);
6075 /* No need to protect ACTION--we only compare it with t and nil. */
6076 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6078 if (SCHARS (string
) == 0)
6080 if (EQ (action
, Qlambda
))
6088 orig_string
= string
;
6089 string
= Fsubstitute_in_file_name (string
);
6090 changed
= NILP (Fstring_equal (string
, orig_string
));
6091 name
= Ffile_name_nondirectory (string
);
6092 val
= Ffile_name_directory (string
);
6094 realdir
= Fexpand_file_name (val
, realdir
);
6099 specdir
= Ffile_name_directory (string
);
6100 val
= Ffile_name_completion (name
, realdir
);
6105 return double_dollars (string
);
6109 if (!NILP (specdir
))
6110 val
= concat2 (specdir
, val
);
6112 return double_dollars (val
);
6115 #endif /* not VMS */
6119 if (EQ (action
, Qt
))
6121 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6125 if (NILP (Vread_file_name_predicate
)
6126 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6130 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6132 /* Brute-force speed up for directory checking:
6133 Discard strings which don't end in a slash. */
6134 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6136 Lisp_Object tem
= XCAR (all
);
6138 if (STRINGP (tem
) &&
6139 (len
= SCHARS (tem
), len
> 0) &&
6140 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6141 comp
= Fcons (tem
, comp
);
6147 /* Must do it the hard (and slow) way. */
6148 GCPRO3 (all
, comp
, specdir
);
6149 count
= SPECPDL_INDEX ();
6150 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6151 current_buffer
->directory
= realdir
;
6152 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6153 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6154 comp
= Fcons (XCAR (all
), comp
);
6155 unbind_to (count
, Qnil
);
6158 return Fnreverse (comp
);
6161 /* Only other case actually used is ACTION = lambda */
6163 /* Supposedly this helps commands such as `cd' that read directory names,
6164 but can someone explain how it helps them? -- RMS */
6165 if (SCHARS (name
) == 0)
6168 string
= Fexpand_file_name (string
, dir
);
6169 if (!NILP (Vread_file_name_predicate
))
6170 return call1 (Vread_file_name_predicate
, string
);
6171 return Ffile_exists_p (string
);
6174 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6175 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6176 Value is not expanded---you must call `expand-file-name' yourself.
6177 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6178 the same non-empty string that was inserted by this function.
6179 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6180 except that if INITIAL is specified, that combined with DIR is used.)
6181 If the user exits with an empty minibuffer, this function returns
6182 an empty string. (This can only happen if the user erased the
6183 pre-inserted contents or if `insert-default-directory' is nil.)
6184 Fourth arg MUSTMATCH non-nil means require existing file's name.
6185 Non-nil and non-t means also require confirmation after completion.
6186 Fifth arg INITIAL specifies text to start with.
6187 If optional sixth arg PREDICATE is non-nil, possible completions and
6188 the resulting file name must satisfy (funcall PREDICATE NAME).
6189 DIR should be an absolute directory name. It defaults to the value of
6190 `default-directory'.
6192 If this command was invoked with the mouse, use a file dialog box if
6193 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6194 provides a file dialog box. */)
6195 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6196 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6198 Lisp_Object val
, insdef
, tem
;
6199 struct gcpro gcpro1
, gcpro2
;
6200 register char *homedir
;
6201 Lisp_Object decoded_homedir
;
6202 int replace_in_history
= 0;
6203 int add_to_history
= 0;
6207 dir
= current_buffer
->directory
;
6208 if (NILP (Ffile_name_absolute_p (dir
)))
6209 dir
= Fexpand_file_name (dir
, Qnil
);
6210 if (NILP (default_filename
))
6213 ? Fexpand_file_name (initial
, dir
)
6214 : current_buffer
->filename
);
6216 /* If dir starts with user's homedir, change that to ~. */
6217 homedir
= (char *) egetenv ("HOME");
6219 /* homedir can be NULL in temacs, since Vprocess_environment is not
6220 yet set up. We shouldn't crash in that case. */
6223 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6224 CORRECT_DIR_SEPS (homedir
);
6229 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6232 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6233 SBYTES (decoded_homedir
))
6234 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6236 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6237 dir
= concat2 (build_string ("~"), dir
);
6239 /* Likewise for default_filename. */
6241 && STRINGP (default_filename
)
6242 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6243 SBYTES (decoded_homedir
))
6244 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6247 = Fsubstring (default_filename
,
6248 make_number (SCHARS (decoded_homedir
)), Qnil
);
6249 default_filename
= concat2 (build_string ("~"), default_filename
);
6251 if (!NILP (default_filename
))
6253 CHECK_STRING (default_filename
);
6254 default_filename
= double_dollars (default_filename
);
6257 if (insert_default_directory
&& STRINGP (dir
))
6260 if (!NILP (initial
))
6262 Lisp_Object args
[2], pos
;
6266 insdef
= Fconcat (2, args
);
6267 pos
= make_number (SCHARS (double_dollars (dir
)));
6268 insdef
= Fcons (double_dollars (insdef
), pos
);
6271 insdef
= double_dollars (insdef
);
6273 else if (STRINGP (initial
))
6274 insdef
= Fcons (double_dollars (initial
), make_number (0));
6278 if (!NILP (Vread_file_name_function
))
6280 Lisp_Object args
[7];
6282 GCPRO2 (insdef
, default_filename
);
6283 args
[0] = Vread_file_name_function
;
6286 args
[3] = default_filename
;
6287 args
[4] = mustmatch
;
6289 args
[6] = predicate
;
6290 RETURN_UNGCPRO (Ffuncall (7, args
));
6293 count
= SPECPDL_INDEX ();
6294 specbind (intern ("completion-ignore-case"),
6295 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6296 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6297 specbind (intern ("read-file-name-predicate"),
6298 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6300 GCPRO2 (insdef
, default_filename
);
6302 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
6303 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6308 /* If DIR contains a file name, split it. */
6310 file
= Ffile_name_nondirectory (dir
);
6311 if (SCHARS (file
) && NILP (default_filename
))
6313 default_filename
= file
;
6314 dir
= Ffile_name_directory (dir
);
6316 if (!NILP(default_filename
))
6317 default_filename
= Fexpand_file_name (default_filename
, dir
);
6318 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6323 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6324 dir
, mustmatch
, insdef
,
6325 Qfile_name_history
, default_filename
, Qnil
);
6327 tem
= Fsymbol_value (Qfile_name_history
);
6328 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6329 replace_in_history
= 1;
6331 /* If Fcompleting_read returned the inserted default string itself
6332 (rather than a new string with the same contents),
6333 it has to mean that the user typed RET with the minibuffer empty.
6334 In that case, we really want to return ""
6335 so that commands such as set-visited-file-name can distinguish. */
6336 if (EQ (val
, default_filename
))
6338 /* In this case, Fcompleting_read has not added an element
6339 to the history. Maybe we should. */
6340 if (! replace_in_history
)
6346 unbind_to (count
, Qnil
);
6349 error ("No file name specified");
6351 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6353 if (!NILP (tem
) && !NILP (default_filename
))
6354 val
= default_filename
;
6355 val
= Fsubstitute_in_file_name (val
);
6357 if (replace_in_history
)
6358 /* Replace what Fcompleting_read added to the history
6359 with what we will actually return. */
6360 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6361 else if (add_to_history
)
6363 /* Add the value to the history--but not if it matches
6364 the last value already there. */
6365 Lisp_Object val1
= double_dollars (val
);
6366 tem
= Fsymbol_value (Qfile_name_history
);
6367 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6368 Fset (Qfile_name_history
,
6379 /* Must be set before any path manipulation is performed. */
6380 XSETFASTINT (Vdirectory_sep_char
, '/');
6387 Qexpand_file_name
= intern ("expand-file-name");
6388 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6389 Qdirectory_file_name
= intern ("directory-file-name");
6390 Qfile_name_directory
= intern ("file-name-directory");
6391 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6392 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6393 Qfile_name_as_directory
= intern ("file-name-as-directory");
6394 Qcopy_file
= intern ("copy-file");
6395 Qmake_directory_internal
= intern ("make-directory-internal");
6396 Qmake_directory
= intern ("make-directory");
6397 Qdelete_directory
= intern ("delete-directory");
6398 Qdelete_file
= intern ("delete-file");
6399 Qrename_file
= intern ("rename-file");
6400 Qadd_name_to_file
= intern ("add-name-to-file");
6401 Qmake_symbolic_link
= intern ("make-symbolic-link");
6402 Qfile_exists_p
= intern ("file-exists-p");
6403 Qfile_executable_p
= intern ("file-executable-p");
6404 Qfile_readable_p
= intern ("file-readable-p");
6405 Qfile_writable_p
= intern ("file-writable-p");
6406 Qfile_symlink_p
= intern ("file-symlink-p");
6407 Qaccess_file
= intern ("access-file");
6408 Qfile_directory_p
= intern ("file-directory-p");
6409 Qfile_regular_p
= intern ("file-regular-p");
6410 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6411 Qfile_modes
= intern ("file-modes");
6412 Qset_file_modes
= intern ("set-file-modes");
6413 Qset_file_times
= intern ("set-file-times");
6414 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6415 Qinsert_file_contents
= intern ("insert-file-contents");
6416 Qwrite_region
= intern ("write-region");
6417 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6418 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6419 Qauto_save_coding
= intern ("auto-save-coding");
6421 staticpro (&Qexpand_file_name
);
6422 staticpro (&Qsubstitute_in_file_name
);
6423 staticpro (&Qdirectory_file_name
);
6424 staticpro (&Qfile_name_directory
);
6425 staticpro (&Qfile_name_nondirectory
);
6426 staticpro (&Qunhandled_file_name_directory
);
6427 staticpro (&Qfile_name_as_directory
);
6428 staticpro (&Qcopy_file
);
6429 staticpro (&Qmake_directory_internal
);
6430 staticpro (&Qmake_directory
);
6431 staticpro (&Qdelete_directory
);
6432 staticpro (&Qdelete_file
);
6433 staticpro (&Qrename_file
);
6434 staticpro (&Qadd_name_to_file
);
6435 staticpro (&Qmake_symbolic_link
);
6436 staticpro (&Qfile_exists_p
);
6437 staticpro (&Qfile_executable_p
);
6438 staticpro (&Qfile_readable_p
);
6439 staticpro (&Qfile_writable_p
);
6440 staticpro (&Qaccess_file
);
6441 staticpro (&Qfile_symlink_p
);
6442 staticpro (&Qfile_directory_p
);
6443 staticpro (&Qfile_regular_p
);
6444 staticpro (&Qfile_accessible_directory_p
);
6445 staticpro (&Qfile_modes
);
6446 staticpro (&Qset_file_modes
);
6447 staticpro (&Qset_file_times
);
6448 staticpro (&Qfile_newer_than_file_p
);
6449 staticpro (&Qinsert_file_contents
);
6450 staticpro (&Qwrite_region
);
6451 staticpro (&Qverify_visited_file_modtime
);
6452 staticpro (&Qset_visited_file_modtime
);
6453 staticpro (&Qauto_save_coding
);
6455 Qfile_name_history
= intern ("file-name-history");
6456 Fset (Qfile_name_history
, Qnil
);
6457 staticpro (&Qfile_name_history
);
6459 Qfile_error
= intern ("file-error");
6460 staticpro (&Qfile_error
);
6461 Qfile_already_exists
= intern ("file-already-exists");
6462 staticpro (&Qfile_already_exists
);
6463 Qfile_date_error
= intern ("file-date-error");
6464 staticpro (&Qfile_date_error
);
6465 Qexcl
= intern ("excl");
6469 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6470 staticpro (&Qfind_buffer_file_type
);
6473 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6474 doc
: /* *Coding system for encoding file names.
6475 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6476 Vfile_name_coding_system
= Qnil
;
6478 DEFVAR_LISP ("default-file-name-coding-system",
6479 &Vdefault_file_name_coding_system
,
6480 doc
: /* Default coding system for encoding file names.
6481 This variable is used only when `file-name-coding-system' is nil.
6483 This variable is set/changed by the command `set-language-environment'.
6484 User should not set this variable manually,
6485 instead use `file-name-coding-system' to get a constant encoding
6486 of file names regardless of the current language environment. */);
6487 Vdefault_file_name_coding_system
= Qnil
;
6489 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6490 doc
: /* *Format in which to write auto-save files.
6491 Should be a list of symbols naming formats that are defined in `format-alist'.
6492 If it is t, which is the default, auto-save files are written in the
6493 same format as a regular save would use. */);
6494 Vauto_save_file_format
= Qt
;
6496 Qformat_decode
= intern ("format-decode");
6497 staticpro (&Qformat_decode
);
6498 Qformat_annotate_function
= intern ("format-annotate-function");
6499 staticpro (&Qformat_annotate_function
);
6500 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6501 staticpro (&Qafter_insert_file_set_coding
);
6503 Qcar_less_than_car
= intern ("car-less-than-car");
6504 staticpro (&Qcar_less_than_car
);
6506 Fput (Qfile_error
, Qerror_conditions
,
6507 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6508 Fput (Qfile_error
, Qerror_message
,
6509 build_string ("File error"));
6511 Fput (Qfile_already_exists
, Qerror_conditions
,
6512 Fcons (Qfile_already_exists
,
6513 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6514 Fput (Qfile_already_exists
, Qerror_message
,
6515 build_string ("File already exists"));
6517 Fput (Qfile_date_error
, Qerror_conditions
,
6518 Fcons (Qfile_date_error
,
6519 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6520 Fput (Qfile_date_error
, Qerror_message
,
6521 build_string ("Cannot set file date"));
6523 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6524 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6525 Vread_file_name_function
= Qnil
;
6527 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6528 doc
: /* Current predicate used by `read-file-name-internal'. */);
6529 Vread_file_name_predicate
= Qnil
;
6531 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6532 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6533 #if defined VMS || defined DOS_NT || defined MAC_OS
6534 read_file_name_completion_ignore_case
= 1;
6536 read_file_name_completion_ignore_case
= 0;
6539 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6540 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6541 If the initial minibuffer contents are non-empty, you can usually
6542 request a default filename by typing RETURN without editing. For some
6543 commands, exiting with an empty minibuffer has a special meaning,
6544 such as making the current buffer visit no file in the case of
6545 `set-visited-file-name'.
6546 If this variable is non-nil, the minibuffer contents are always
6547 initially non-empty and typing RETURN without editing will fetch the
6548 default name, if one is provided. Note however that this default name
6549 is not necessarily the name originally inserted in the minibuffer, if
6550 that is just the default directory.
6551 If this variable is nil, the minibuffer often starts out empty. In
6552 that case you may have to explicitly fetch the next history element to
6553 request the default name. */);
6554 insert_default_directory
= 1;
6556 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6557 doc
: /* *Non-nil means write new files with record format `stmlf'.
6558 nil means use format `var'. This variable is meaningful only on VMS. */);
6559 vms_stmlf_recfm
= 0;
6561 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6562 doc
: /* Directory separator character for built-in functions that return file names.
6563 The value is always ?/. Don't use this variable, just use `/'. */);
6565 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6566 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6567 If a file name matches REGEXP, then all I/O on that file is done by calling
6570 The first argument given to HANDLER is the name of the I/O primitive
6571 to be handled; the remaining arguments are the arguments that were
6572 passed to that primitive. For example, if you do
6573 (file-exists-p FILENAME)
6574 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6575 (funcall HANDLER 'file-exists-p FILENAME)
6576 The function `find-file-name-handler' checks this list for a handler
6577 for its argument. */);
6578 Vfile_name_handler_alist
= Qnil
;
6580 DEFVAR_LISP ("set-auto-coding-function",
6581 &Vset_auto_coding_function
,
6582 doc
: /* If non-nil, a function to call to decide a coding system of file.
6583 Two arguments are passed to this function: the file name
6584 and the length of a file contents following the point.
6585 This function should return a coding system to decode the file contents.
6586 It should check the file name against `auto-coding-alist'.
6587 If no coding system is decided, it should check a coding system
6588 specified in the heading lines with the format:
6589 -*- ... coding: CODING-SYSTEM; ... -*-
6590 or local variable spec of the tailing lines with `coding:' tag. */);
6591 Vset_auto_coding_function
= Qnil
;
6593 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6594 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6595 Each is passed one argument, the number of characters inserted.
6596 It should return the new character count, and leave point the same.
6597 If `insert-file-contents' is intercepted by a handler from
6598 `file-name-handler-alist', that handler is responsible for calling the
6599 functions in `after-insert-file-functions' if appropriate. */);
6600 Vafter_insert_file_functions
= Qnil
;
6602 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6603 doc
: /* A list of functions to be called at the start of `write-region'.
6604 Each is passed two arguments, START and END as for `write-region'.
6605 These are usually two numbers but not always; see the documentation
6606 for `write-region'. The function should return a list of pairs
6607 of the form (POSITION . STRING), consisting of strings to be effectively
6608 inserted at the specified positions of the file being written (1 means to
6609 insert before the first byte written). The POSITIONs must be sorted into
6610 increasing order. If there are several functions in the list, the several
6611 lists are merged destructively. Alternatively, the function can return
6612 with a different buffer current; in that case it should pay attention
6613 to the annotations returned by previous functions and listed in
6614 `write-region-annotations-so-far'.*/);
6615 Vwrite_region_annotate_functions
= Qnil
;
6616 staticpro (&Qwrite_region_annotate_functions
);
6617 Qwrite_region_annotate_functions
6618 = intern ("write-region-annotate-functions");
6620 DEFVAR_LISP ("write-region-annotations-so-far",
6621 &Vwrite_region_annotations_so_far
,
6622 doc
: /* When an annotation function is called, this holds the previous annotations.
6623 These are the annotations made by other annotation functions
6624 that were already called. See also `write-region-annotate-functions'. */);
6625 Vwrite_region_annotations_so_far
= Qnil
;
6627 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6628 doc
: /* A list of file name handlers that temporarily should not be used.
6629 This applies only to the operation `inhibit-file-name-operation'. */);
6630 Vinhibit_file_name_handlers
= Qnil
;
6632 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6633 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6634 Vinhibit_file_name_operation
= Qnil
;
6636 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6637 doc
: /* File name in which we write a list of all auto save file names.
6638 This variable is initialized automatically from `auto-save-list-file-prefix'
6639 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6640 a non-nil value. */);
6641 Vauto_save_list_file_name
= Qnil
;
6643 defsubr (&Sfind_file_name_handler
);
6644 defsubr (&Sfile_name_directory
);
6645 defsubr (&Sfile_name_nondirectory
);
6646 defsubr (&Sunhandled_file_name_directory
);
6647 defsubr (&Sfile_name_as_directory
);
6648 defsubr (&Sdirectory_file_name
);
6649 defsubr (&Smake_temp_name
);
6650 defsubr (&Sexpand_file_name
);
6651 defsubr (&Ssubstitute_in_file_name
);
6652 defsubr (&Scopy_file
);
6653 defsubr (&Smake_directory_internal
);
6654 defsubr (&Sdelete_directory
);
6655 defsubr (&Sdelete_file
);
6656 defsubr (&Srename_file
);
6657 defsubr (&Sadd_name_to_file
);
6659 defsubr (&Smake_symbolic_link
);
6660 #endif /* S_IFLNK */
6662 defsubr (&Sdefine_logical_name
);
6665 defsubr (&Ssysnetunam
);
6666 #endif /* HPUX_NET */
6667 defsubr (&Sfile_name_absolute_p
);
6668 defsubr (&Sfile_exists_p
);
6669 defsubr (&Sfile_executable_p
);
6670 defsubr (&Sfile_readable_p
);
6671 defsubr (&Sfile_writable_p
);
6672 defsubr (&Saccess_file
);
6673 defsubr (&Sfile_symlink_p
);
6674 defsubr (&Sfile_directory_p
);
6675 defsubr (&Sfile_accessible_directory_p
);
6676 defsubr (&Sfile_regular_p
);
6677 defsubr (&Sfile_modes
);
6678 defsubr (&Sset_file_modes
);
6679 defsubr (&Sset_file_times
);
6680 defsubr (&Sset_default_file_modes
);
6681 defsubr (&Sdefault_file_modes
);
6682 defsubr (&Sfile_newer_than_file_p
);
6683 defsubr (&Sinsert_file_contents
);
6684 defsubr (&Swrite_region
);
6685 defsubr (&Scar_less_than_car
);
6686 defsubr (&Sverify_visited_file_modtime
);
6687 defsubr (&Sclear_visited_file_modtime
);
6688 defsubr (&Svisited_file_modtime
);
6689 defsubr (&Sset_visited_file_modtime
);
6690 defsubr (&Sdo_auto_save
);
6691 defsubr (&Sset_buffer_auto_saved
);
6692 defsubr (&Sclear_buffer_auto_save_failure
);
6693 defsubr (&Srecent_auto_save_p
);
6695 defsubr (&Sread_file_name_internal
);
6696 defsubr (&Sread_file_name
);
6699 defsubr (&Sunix_sync
);
6703 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6704 (do not change this comment) */