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
= SBYTES (prefix
); clen
= SCHARS (prefix
);
925 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
926 if (!STRING_MULTIBYTE (prefix
))
927 STRING_SET_UNIBYTE (val
);
929 bcopy(SDATA (prefix
), data
, len
);
932 bcopy (pidbuf
, p
, pidlen
);
935 /* Here we try to minimize useless stat'ing when this function is
936 invoked many times successively with the same PREFIX. We achieve
937 this by initializing count to a random value, and incrementing it
940 We don't want make-temp-name to be called while dumping,
941 because then make_temp_name_count_initialized_p would get set
942 and then make_temp_name_count would not be set when Emacs starts. */
944 if (!make_temp_name_count_initialized_p
)
946 make_temp_name_count
= (unsigned) time (NULL
);
947 make_temp_name_count_initialized_p
= 1;
953 unsigned num
= make_temp_name_count
;
955 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
956 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
957 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
959 /* Poor man's congruential RN generator. Replace with
960 ++make_temp_name_count for debugging. */
961 make_temp_name_count
+= 25229;
962 make_temp_name_count
%= 225307;
964 if (stat (data
, &ignored
) < 0)
966 /* We want to return only if errno is ENOENT. */
970 /* The error here is dubious, but there is little else we
971 can do. The alternatives are to return nil, which is
972 as bad as (and in many cases worse than) throwing the
973 error, or to ignore the error, which will likely result
974 in looping through 225307 stat's, which is not only
975 dog-slow, but also useless since it will fallback to
976 the errow below, anyway. */
977 report_file_error ("Cannot create temporary name for prefix",
978 Fcons (prefix
, Qnil
));
983 error ("Cannot create temporary name for prefix `%s'",
989 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
990 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
991 The Emacs process number forms part of the result,
992 so there is no danger of generating a name being used by another process.
994 In addition, this function makes an attempt to choose a name
995 which has no existing file. To make this work,
996 PREFIX should be an absolute file name.
998 There is a race condition between calling `make-temp-name' and creating the
999 file which opens all kinds of security holes. For that reason, you should
1000 probably use `make-temp-file' instead, except in three circumstances:
1002 * If you are creating the file in the user's home directory.
1003 * If you are creating a directory rather than an ordinary file.
1004 * If you are taking special precautions as `make-temp-file' does. */)
1008 return make_temp_name (prefix
, 0);
1013 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1014 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1015 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1016 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1017 the current buffer's value of default-directory is used.
1018 File name components that are `.' are removed, and
1019 so are file name components followed by `..', along with the `..' itself;
1020 note that these simplifications are done without checking the resulting
1021 file names in the file system.
1022 An initial `~/' expands to your home directory.
1023 An initial `~USER/' expands to USER's home directory.
1024 See also the function `substitute-in-file-name'. */)
1025 (name
, default_directory
)
1026 Lisp_Object name
, default_directory
;
1030 register unsigned char *newdir
, *p
, *o
;
1032 unsigned char *target
;
1035 unsigned char * colon
= 0;
1036 unsigned char * close
= 0;
1037 unsigned char * slash
= 0;
1038 unsigned char * brack
= 0;
1039 int lbrack
= 0, rbrack
= 0;
1044 int collapse_newdir
= 1;
1048 Lisp_Object handler
, result
;
1050 CHECK_STRING (name
);
1052 /* If the file name has special constructs in it,
1053 call the corresponding file handler. */
1054 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1055 if (!NILP (handler
))
1056 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1058 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1059 if (NILP (default_directory
))
1060 default_directory
= current_buffer
->directory
;
1061 if (! STRINGP (default_directory
))
1064 /* "/" is not considered a root directory on DOS_NT, so using "/"
1065 here causes an infinite recursion in, e.g., the following:
1067 (let (default-directory)
1068 (expand-file-name "a"))
1070 To avoid this, we set default_directory to the root of the
1072 extern char *emacs_root_dir (void);
1074 default_directory
= build_string (emacs_root_dir ());
1076 default_directory
= build_string ("/");
1080 if (!NILP (default_directory
))
1082 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1083 if (!NILP (handler
))
1084 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1087 o
= SDATA (default_directory
);
1089 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1090 It would be better to do this down below where we actually use
1091 default_directory. Unfortunately, calling Fexpand_file_name recursively
1092 could invoke GC, and the strings might be relocated. This would
1093 be annoying because we have pointers into strings lying around
1094 that would need adjusting, and people would add new pointers to
1095 the code and forget to adjust them, resulting in intermittent bugs.
1096 Putting this call here avoids all that crud.
1098 The EQ test avoids infinite recursion. */
1099 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1100 /* Save time in some common cases - as long as default_directory
1101 is not relative, it can be canonicalized with name below (if it
1102 is needed at all) without requiring it to be expanded now. */
1104 /* Detect MSDOS file names with drive specifiers. */
1105 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1107 /* Detect Windows file names in UNC format. */
1108 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1110 #else /* not DOS_NT */
1111 /* Detect Unix absolute file names (/... alone is not absolute on
1113 && ! (IS_DIRECTORY_SEP (o
[0]))
1114 #endif /* not DOS_NT */
1117 struct gcpro gcpro1
;
1120 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1125 /* Filenames on VMS are always upper case. */
1126 name
= Fupcase (name
);
1128 #ifdef FILE_SYSTEM_CASE
1129 name
= FILE_SYSTEM_CASE (name
);
1135 /* We will force directory separators to be either all \ or /, so make
1136 a local copy to modify, even if there ends up being no change. */
1137 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1139 /* Note if special escape prefix is present, but remove for now. */
1140 if (nm
[0] == '/' && nm
[1] == ':')
1146 /* Find and remove drive specifier if present; this makes nm absolute
1147 even if the rest of the name appears to be relative. Only look for
1148 drive specifier at the beginning. */
1149 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1156 /* If we see "c://somedir", we want to strip the first slash after the
1157 colon when stripping the drive letter. Otherwise, this expands to
1159 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1161 #endif /* WINDOWSNT */
1165 /* Discard any previous drive specifier if nm is now in UNC format. */
1166 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1172 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1173 none are found, we can probably return right away. We will avoid
1174 allocating a new string if name is already fully expanded. */
1176 IS_DIRECTORY_SEP (nm
[0])
1178 && drive
&& !is_escaped
1181 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1188 /* If it turns out that the filename we want to return is just a
1189 suffix of FILENAME, we don't need to go through and edit
1190 things; we just need to construct a new string using data
1191 starting at the middle of FILENAME. If we set lose to a
1192 non-zero value, that means we've discovered that we can't do
1199 /* Since we know the name is absolute, we can assume that each
1200 element starts with a "/". */
1202 /* "." and ".." are hairy. */
1203 if (IS_DIRECTORY_SEP (p
[0])
1205 && (IS_DIRECTORY_SEP (p
[2])
1207 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1210 /* We want to replace multiple `/' in a row with a single
1213 && IS_DIRECTORY_SEP (p
[0])
1214 && IS_DIRECTORY_SEP (p
[1]))
1221 /* if dev:[dir]/, move nm to / */
1222 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1223 nm
= (brack
? brack
+ 1 : colon
+ 1);
1224 lbrack
= rbrack
= 0;
1232 /* VMS pre V4.4,convert '-'s in filenames. */
1233 if (lbrack
== rbrack
)
1235 if (dots
< 2) /* this is to allow negative version numbers */
1240 if (lbrack
> rbrack
&&
1241 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1242 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1248 /* count open brackets, reset close bracket pointer */
1249 if (p
[0] == '[' || p
[0] == '<')
1250 lbrack
++, brack
= 0;
1251 /* count close brackets, set close bracket pointer */
1252 if (p
[0] == ']' || p
[0] == '>')
1253 rbrack
++, brack
= p
;
1254 /* detect ][ or >< */
1255 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1257 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1258 nm
= p
+ 1, lose
= 1;
1259 if (p
[0] == ':' && (colon
|| slash
))
1260 /* if dev1:[dir]dev2:, move nm to dev2: */
1266 /* if /name/dev:, move nm to dev: */
1269 /* if node::dev:, move colon following dev */
1270 else if (colon
&& colon
[-1] == ':')
1272 /* if dev1:dev2:, move nm to dev2: */
1273 else if (colon
&& colon
[-1] != ':')
1278 if (p
[0] == ':' && !colon
)
1284 if (lbrack
== rbrack
)
1287 else if (p
[0] == '.')
1295 if (index (nm
, '/'))
1297 nm
= sys_translate_unix (nm
);
1298 return make_specified_string (nm
, -1, strlen (nm
),
1299 STRING_MULTIBYTE (name
));
1303 /* Make sure directories are all separated with / or \ as
1304 desired, but avoid allocation of a new string when not
1306 CORRECT_DIR_SEPS (nm
);
1308 if (IS_DIRECTORY_SEP (nm
[1]))
1310 if (strcmp (nm
, SDATA (name
)) != 0)
1311 name
= make_specified_string (nm
, -1, strlen (nm
),
1312 STRING_MULTIBYTE (name
));
1316 /* drive must be set, so this is okay */
1317 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1321 name
= make_specified_string (nm
, -1, p
- nm
,
1322 STRING_MULTIBYTE (name
));
1323 temp
[0] = DRIVE_LETTER (drive
);
1324 name
= concat2 (build_string (temp
), name
);
1327 #else /* not DOS_NT */
1328 if (nm
== SDATA (name
))
1330 return make_specified_string (nm
, -1, strlen (nm
),
1331 STRING_MULTIBYTE (name
));
1332 #endif /* not DOS_NT */
1336 /* At this point, nm might or might not be an absolute file name. We
1337 need to expand ~ or ~user if present, otherwise prefix nm with
1338 default_directory if nm is not absolute, and finally collapse /./
1339 and /foo/../ sequences.
1341 We set newdir to be the appropriate prefix if one is needed:
1342 - the relevant user directory if nm starts with ~ or ~user
1343 - the specified drive's working dir (DOS/NT only) if nm does not
1345 - the value of default_directory.
1347 Note that these prefixes are not guaranteed to be absolute (except
1348 for the working dir of a drive). Therefore, to ensure we always
1349 return an absolute name, if the final prefix is not absolute we
1350 append it to the current working directory. */
1354 if (nm
[0] == '~') /* prefix ~ */
1356 if (IS_DIRECTORY_SEP (nm
[1])
1360 || nm
[1] == 0) /* ~ by itself */
1362 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1363 newdir
= (unsigned char *) "";
1366 collapse_newdir
= 0;
1369 nm
++; /* Don't leave the slash in nm. */
1372 else /* ~user/filename */
1374 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1379 o
= (unsigned char *) alloca (p
- nm
+ 1);
1380 bcopy ((char *) nm
, o
, p
- nm
);
1383 pw
= (struct passwd
*) getpwnam (o
+ 1);
1386 newdir
= (unsigned char *) pw
-> pw_dir
;
1388 nm
= p
+ 1; /* skip the terminator */
1392 collapse_newdir
= 0;
1397 /* If we don't find a user of that name, leave the name
1398 unchanged; don't move nm forward to p. */
1403 /* On DOS and Windows, nm is absolute if a drive name was specified;
1404 use the drive's current directory as the prefix if needed. */
1405 if (!newdir
&& drive
)
1407 /* Get default directory if needed to make nm absolute. */
1408 if (!IS_DIRECTORY_SEP (nm
[0]))
1410 newdir
= alloca (MAXPATHLEN
+ 1);
1411 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1416 /* Either nm starts with /, or drive isn't mounted. */
1417 newdir
= alloca (4);
1418 newdir
[0] = DRIVE_LETTER (drive
);
1426 /* Finally, if no prefix has been specified and nm is not absolute,
1427 then it must be expanded relative to default_directory. */
1431 /* /... alone is not absolute on DOS and Windows. */
1432 && !IS_DIRECTORY_SEP (nm
[0])
1435 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1442 newdir
= SDATA (default_directory
);
1444 /* Note if special escape prefix is present, but remove for now. */
1445 if (newdir
[0] == '/' && newdir
[1] == ':')
1456 /* First ensure newdir is an absolute name. */
1458 /* Detect MSDOS file names with drive specifiers. */
1459 ! (IS_DRIVE (newdir
[0])
1460 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1462 /* Detect Windows file names in UNC format. */
1463 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1467 /* Effectively, let newdir be (expand-file-name newdir cwd).
1468 Because of the admonition against calling expand-file-name
1469 when we have pointers into lisp strings, we accomplish this
1470 indirectly by prepending newdir to nm if necessary, and using
1471 cwd (or the wd of newdir's drive) as the new newdir. */
1473 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1478 if (!IS_DIRECTORY_SEP (nm
[0]))
1480 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1481 file_name_as_directory (tmp
, newdir
);
1485 newdir
= alloca (MAXPATHLEN
+ 1);
1488 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1495 /* Strip off drive name from prefix, if present. */
1496 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1502 /* Keep only a prefix from newdir if nm starts with slash
1503 (//server/share for UNC, nothing otherwise). */
1504 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1507 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1509 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1511 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1513 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1525 /* Get rid of any slash at the end of newdir, unless newdir is
1526 just / or // (an incomplete UNC name). */
1527 length
= strlen (newdir
);
1528 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1530 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1534 unsigned char *temp
= (unsigned char *) alloca (length
);
1535 bcopy (newdir
, temp
, length
- 1);
1536 temp
[length
- 1] = 0;
1544 /* Now concatenate the directory and name to new space in the stack frame */
1545 tlen
+= strlen (nm
) + 1;
1547 /* Reserve space for drive specifier and escape prefix, since either
1548 or both may need to be inserted. (The Microsoft x86 compiler
1549 produces incorrect code if the following two lines are combined.) */
1550 target
= (unsigned char *) alloca (tlen
+ 4);
1552 #else /* not DOS_NT */
1553 target
= (unsigned char *) alloca (tlen
);
1554 #endif /* not DOS_NT */
1560 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1563 /* If newdir is effectively "C:/", then the drive letter will have
1564 been stripped and newdir will be "/". Concatenating with an
1565 absolute directory in nm produces "//", which will then be
1566 incorrectly treated as a network share. Ignore newdir in
1567 this case (keeping the drive letter). */
1568 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1569 && newdir
[1] == '\0'))
1571 strcpy (target
, newdir
);
1575 file_name_as_directory (target
, newdir
);
1578 strcat (target
, nm
);
1580 if (index (target
, '/'))
1581 strcpy (target
, sys_translate_unix (target
));
1584 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1586 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1595 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1601 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1602 /* brackets are offset from each other by 2 */
1605 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1606 /* convert [foo][bar] to [bar] */
1607 while (o
[-1] != '[' && o
[-1] != '<')
1609 else if (*p
== '-' && *o
!= '.')
1612 else if (p
[0] == '-' && o
[-1] == '.' &&
1613 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1614 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1618 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1619 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1621 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1623 /* else [foo.-] ==> [-] */
1629 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1630 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1636 if (!IS_DIRECTORY_SEP (*p
))
1640 else if (IS_DIRECTORY_SEP (p
[0])
1642 && (IS_DIRECTORY_SEP (p
[2])
1645 /* If "/." is the entire filename, keep the "/". Otherwise,
1646 just delete the whole "/.". */
1647 if (o
== target
&& p
[2] == '\0')
1651 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1652 /* `/../' is the "superroot" on certain file systems. */
1654 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1656 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1658 /* Keep initial / only if this is the whole name. */
1659 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1664 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1666 /* Collapse multiple `/' in a row. */
1668 while (IS_DIRECTORY_SEP (*p
))
1675 #endif /* not VMS */
1679 /* At last, set drive name. */
1681 /* Except for network file name. */
1682 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1683 #endif /* WINDOWSNT */
1685 if (!drive
) abort ();
1687 target
[0] = DRIVE_LETTER (drive
);
1690 /* Reinsert the escape prefix if required. */
1697 CORRECT_DIR_SEPS (target
);
1700 result
= make_specified_string (target
, -1, o
- target
,
1701 STRING_MULTIBYTE (name
));
1703 /* Again look to see if the file name has special constructs in it
1704 and perhaps call the corresponding file handler. This is needed
1705 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1706 the ".." component gives us "/user@host:/bar/../baz" which needs
1707 to be expanded again. */
1708 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1709 if (!NILP (handler
))
1710 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1716 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1717 This is the old version of expand-file-name, before it was thoroughly
1718 rewritten for Emacs 10.31. We leave this version here commented-out,
1719 because the code is very complex and likely to have subtle bugs. If
1720 bugs _are_ found, it might be of interest to look at the old code and
1721 see what did it do in the relevant situation.
1723 Don't remove this code: it's true that it will be accessible via CVS,
1724 but a few years from deletion, people will forget it is there. */
1726 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1727 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1728 "Convert FILENAME to absolute, and canonicalize it.\n\
1729 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1730 (does not start with slash); if DEFAULT is nil or missing,\n\
1731 the current buffer's value of default-directory is used.\n\
1732 Filenames containing `.' or `..' as components are simplified;\n\
1733 initial `~/' expands to your home directory.\n\
1734 See also the function `substitute-in-file-name'.")
1736 Lisp_Object name
, defalt
;
1740 register unsigned char *newdir
, *p
, *o
;
1742 unsigned char *target
;
1746 unsigned char * colon
= 0;
1747 unsigned char * close
= 0;
1748 unsigned char * slash
= 0;
1749 unsigned char * brack
= 0;
1750 int lbrack
= 0, rbrack
= 0;
1754 CHECK_STRING (name
);
1757 /* Filenames on VMS are always upper case. */
1758 name
= Fupcase (name
);
1763 /* If nm is absolute, flush ...// and detect /./ and /../.
1764 If no /./ or /../ we can return right away. */
1776 if (p
[0] == '/' && p
[1] == '/'
1778 /* // at start of filename is meaningful on Apollo system. */
1783 if (p
[0] == '/' && p
[1] == '~')
1784 nm
= p
+ 1, lose
= 1;
1785 if (p
[0] == '/' && p
[1] == '.'
1786 && (p
[2] == '/' || p
[2] == 0
1787 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1793 /* if dev:[dir]/, move nm to / */
1794 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1795 nm
= (brack
? brack
+ 1 : colon
+ 1);
1796 lbrack
= rbrack
= 0;
1804 /* VMS pre V4.4,convert '-'s in filenames. */
1805 if (lbrack
== rbrack
)
1807 if (dots
< 2) /* this is to allow negative version numbers */
1812 if (lbrack
> rbrack
&&
1813 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1814 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1820 /* count open brackets, reset close bracket pointer */
1821 if (p
[0] == '[' || p
[0] == '<')
1822 lbrack
++, brack
= 0;
1823 /* count close brackets, set close bracket pointer */
1824 if (p
[0] == ']' || p
[0] == '>')
1825 rbrack
++, brack
= p
;
1826 /* detect ][ or >< */
1827 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1829 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1830 nm
= p
+ 1, lose
= 1;
1831 if (p
[0] == ':' && (colon
|| slash
))
1832 /* if dev1:[dir]dev2:, move nm to dev2: */
1838 /* If /name/dev:, move nm to dev: */
1841 /* If node::dev:, move colon following dev */
1842 else if (colon
&& colon
[-1] == ':')
1844 /* If dev1:dev2:, move nm to dev2: */
1845 else if (colon
&& colon
[-1] != ':')
1850 if (p
[0] == ':' && !colon
)
1856 if (lbrack
== rbrack
)
1859 else if (p
[0] == '.')
1867 if (index (nm
, '/'))
1868 return build_string (sys_translate_unix (nm
));
1870 if (nm
== SDATA (name
))
1872 return build_string (nm
);
1876 /* Now determine directory to start with and put it in NEWDIR */
1880 if (nm
[0] == '~') /* prefix ~ */
1885 || nm
[1] == 0)/* ~/filename */
1887 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1888 newdir
= (unsigned char *) "";
1891 nm
++; /* Don't leave the slash in nm. */
1894 else /* ~user/filename */
1896 /* Get past ~ to user */
1897 unsigned char *user
= nm
+ 1;
1898 /* Find end of name. */
1899 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1900 int len
= ptr
? ptr
- user
: strlen (user
);
1902 unsigned char *ptr1
= index (user
, ':');
1903 if (ptr1
!= 0 && ptr1
- user
< len
)
1906 /* Copy the user name into temp storage. */
1907 o
= (unsigned char *) alloca (len
+ 1);
1908 bcopy ((char *) user
, o
, len
);
1911 /* Look up the user name. */
1912 pw
= (struct passwd
*) getpwnam (o
+ 1);
1914 error ("\"%s\" isn't a registered user", o
+ 1);
1916 newdir
= (unsigned char *) pw
->pw_dir
;
1918 /* Discard the user name from NM. */
1925 #endif /* not VMS */
1929 defalt
= current_buffer
->directory
;
1930 CHECK_STRING (defalt
);
1931 newdir
= SDATA (defalt
);
1934 /* Now concatenate the directory and name to new space in the stack frame */
1936 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1937 target
= (unsigned char *) alloca (tlen
);
1943 if (nm
[0] == 0 || nm
[0] == '/')
1944 strcpy (target
, newdir
);
1947 file_name_as_directory (target
, newdir
);
1950 strcat (target
, nm
);
1952 if (index (target
, '/'))
1953 strcpy (target
, sys_translate_unix (target
));
1956 /* Now canonicalize by removing /. and /foo/.. if they appear */
1964 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1970 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1971 /* brackets are offset from each other by 2 */
1974 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1975 /* convert [foo][bar] to [bar] */
1976 while (o
[-1] != '[' && o
[-1] != '<')
1978 else if (*p
== '-' && *o
!= '.')
1981 else if (p
[0] == '-' && o
[-1] == '.' &&
1982 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1983 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1987 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1988 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1990 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1992 /* else [foo.-] ==> [-] */
1998 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1999 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2009 else if (!strncmp (p
, "//", 2)
2011 /* // at start of filename is meaningful in Apollo system. */
2019 else if (p
[0] == '/' && p
[1] == '.' &&
2020 (p
[2] == '/' || p
[2] == 0))
2022 else if (!strncmp (p
, "/..", 3)
2023 /* `/../' is the "superroot" on certain file systems. */
2025 && (p
[3] == '/' || p
[3] == 0))
2027 while (o
!= target
&& *--o
!= '/')
2030 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2034 if (o
== target
&& *o
== '/')
2042 #endif /* not VMS */
2045 return make_string (target
, o
- target
);
2049 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2050 Ssubstitute_in_file_name
, 1, 1, 0,
2051 doc
: /* Substitute environment variables referred to in FILENAME.
2052 `$FOO' where FOO is an environment variable name means to substitute
2053 the value of that variable. The variable name should be terminated
2054 with a character not a letter, digit or underscore; otherwise, enclose
2055 the entire variable name in braces.
2056 If `/~' appears, all of FILENAME through that `/' is discarded.
2058 On VMS, `$' substitution is not done; this function does little and only
2059 duplicates what `expand-file-name' does. */)
2061 Lisp_Object filename
;
2065 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2066 unsigned char *target
= NULL
;
2068 int substituted
= 0;
2071 Lisp_Object handler
;
2073 CHECK_STRING (filename
);
2075 /* If the file name has special constructs in it,
2076 call the corresponding file handler. */
2077 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2078 if (!NILP (handler
))
2079 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2081 nm
= SDATA (filename
);
2083 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2084 CORRECT_DIR_SEPS (nm
);
2085 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2087 endp
= nm
+ SBYTES (filename
);
2089 /* If /~ or // appears, discard everything through first slash. */
2091 for (p
= nm
; p
!= endp
; p
++)
2094 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2095 /* // at start of file name is meaningful in Apollo,
2096 WindowsNT and Cygwin systems. */
2097 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2098 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2099 || IS_DIRECTORY_SEP (p
[0])
2100 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2105 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2107 || IS_DIRECTORY_SEP (p
[-1])))
2109 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2114 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2116 o
= (unsigned char *) alloca (s
- p
+ 1);
2117 bcopy ((char *) p
, o
, s
- p
);
2120 pw
= (struct passwd
*) getpwnam (o
+ 1);
2122 /* If we have ~/ or ~user and `user' exists, discard
2123 everything up to ~. But if `user' does not exist, leave
2124 ~user alone, it might be a literal file name. */
2125 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2132 /* see comment in expand-file-name about drive specifiers */
2133 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2134 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2143 return make_specified_string (nm
, -1, strlen (nm
),
2144 STRING_MULTIBYTE (filename
));
2147 /* See if any variables are substituted into the string
2148 and find the total length of their values in `total' */
2150 for (p
= nm
; p
!= endp
;)
2160 /* "$$" means a single "$" */
2169 while (p
!= endp
&& *p
!= '}') p
++;
2170 if (*p
!= '}') goto missingclose
;
2176 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2180 /* Copy out the variable name */
2181 target
= (unsigned char *) alloca (s
- o
+ 1);
2182 strncpy (target
, o
, s
- o
);
2185 strupr (target
); /* $home == $HOME etc. */
2188 /* Get variable value */
2189 o
= (unsigned char *) egetenv (target
);
2192 total
+= strlen (o
);
2202 /* If substitution required, recopy the string and do it */
2203 /* Make space in stack frame for the new copy */
2204 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2207 /* Copy the rest of the name through, replacing $ constructs with values */
2224 while (p
!= endp
&& *p
!= '}') p
++;
2225 if (*p
!= '}') goto missingclose
;
2231 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2235 /* Copy out the variable name */
2236 target
= (unsigned char *) alloca (s
- o
+ 1);
2237 strncpy (target
, o
, s
- o
);
2240 strupr (target
); /* $home == $HOME etc. */
2243 /* Get variable value */
2244 o
= (unsigned char *) egetenv (target
);
2248 strcpy (x
, target
); x
+= strlen (target
);
2250 else if (STRING_MULTIBYTE (filename
))
2252 /* If the original string is multibyte,
2253 convert what we substitute into multibyte. */
2256 int c
= unibyte_char_to_multibyte (*o
++);
2257 x
+= CHAR_STRING (c
, x
);
2269 /* If /~ or // appears, discard everything through first slash. */
2271 for (p
= xnm
; p
!= x
; p
++)
2273 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2274 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2275 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2276 || IS_DIRECTORY_SEP (p
[0])
2277 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2279 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2282 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2283 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2287 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2290 error ("Bad format environment-variable substitution");
2292 error ("Missing \"}\" in environment-variable substitution");
2294 error ("Substituting nonexistent environment variable \"%s\"", target
);
2297 #endif /* not VMS */
2301 /* A slightly faster and more convenient way to get
2302 (directory-file-name (expand-file-name FOO)). */
2305 expand_and_dir_to_file (filename
, defdir
)
2306 Lisp_Object filename
, defdir
;
2308 register Lisp_Object absname
;
2310 absname
= Fexpand_file_name (filename
, defdir
);
2313 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2314 if (c
== ':' || c
== ']' || c
== '>')
2315 absname
= Fdirectory_file_name (absname
);
2318 /* Remove final slash, if any (unless this is the root dir).
2319 stat behaves differently depending! */
2320 if (SCHARS (absname
) > 1
2321 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2322 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2323 /* We cannot take shortcuts; they might be wrong for magic file names. */
2324 absname
= Fdirectory_file_name (absname
);
2329 /* Signal an error if the file ABSNAME already exists.
2330 If INTERACTIVE is nonzero, ask the user whether to proceed,
2331 and bypass the error if the user says to go ahead.
2332 QUERYSTRING is a name for the action that is being considered
2335 *STATPTR is used to store the stat information if the file exists.
2336 If the file does not exist, STATPTR->st_mode is set to 0.
2337 If STATPTR is null, we don't store into it.
2339 If QUICK is nonzero, we ask for y or n, not yes or no. */
2342 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2343 Lisp_Object absname
;
2344 unsigned char *querystring
;
2346 struct stat
*statptr
;
2349 register Lisp_Object tem
, encoded_filename
;
2350 struct stat statbuf
;
2351 struct gcpro gcpro1
;
2353 encoded_filename
= ENCODE_FILE (absname
);
2355 /* stat is a good way to tell whether the file exists,
2356 regardless of what access permissions it has. */
2357 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2360 Fsignal (Qfile_already_exists
,
2361 Fcons (build_string ("File already exists"),
2362 Fcons (absname
, Qnil
)));
2364 tem
= format2 ("File %s already exists; %s anyway? ",
2365 absname
, build_string (querystring
));
2367 tem
= Fy_or_n_p (tem
);
2369 tem
= do_yes_or_no_p (tem
);
2372 Fsignal (Qfile_already_exists
,
2373 Fcons (build_string ("File already exists"),
2374 Fcons (absname
, Qnil
)));
2381 statptr
->st_mode
= 0;
2386 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2387 "fCopy file: \nFCopy %s to file: \np\nP",
2388 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2389 If NEWNAME names a directory, copy FILE there.
2390 Signals a `file-already-exists' error if file NEWNAME already exists,
2391 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2392 A number as third arg means request confirmation if NEWNAME already exists.
2393 This is what happens in interactive use with M-x.
2394 Fourth arg KEEP-TIME non-nil means give the new file the same
2395 last-modified time as the old one. (This works on only some systems.)
2396 A prefix arg makes KEEP-TIME non-nil.
2397 Also set the file modes of the target file to match the source file. */)
2398 (file
, newname
, ok_if_already_exists
, keep_time
)
2399 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2402 char buf
[16 * 1024];
2403 struct stat st
, out_st
;
2404 Lisp_Object handler
;
2405 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2406 int count
= SPECPDL_INDEX ();
2407 int input_file_statable_p
;
2408 Lisp_Object encoded_file
, encoded_newname
;
2410 encoded_file
= encoded_newname
= Qnil
;
2411 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2412 CHECK_STRING (file
);
2413 CHECK_STRING (newname
);
2415 if (!NILP (Ffile_directory_p (newname
)))
2416 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2418 newname
= Fexpand_file_name (newname
, Qnil
);
2420 file
= Fexpand_file_name (file
, Qnil
);
2422 /* If the input file name has special constructs in it,
2423 call the corresponding file handler. */
2424 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2425 /* Likewise for output file name. */
2427 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2428 if (!NILP (handler
))
2429 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2430 ok_if_already_exists
, keep_time
));
2432 encoded_file
= ENCODE_FILE (file
);
2433 encoded_newname
= ENCODE_FILE (newname
);
2435 if (NILP (ok_if_already_exists
)
2436 || INTEGERP (ok_if_already_exists
))
2437 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2438 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2439 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2443 if (!CopyFile (SDATA (encoded_file
),
2444 SDATA (encoded_newname
),
2446 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2447 /* CopyFile retains the timestamp by default. */
2448 else if (NILP (keep_time
))
2454 EMACS_GET_TIME (now
);
2455 filename
= SDATA (encoded_newname
);
2457 /* Ensure file is writable while its modified time is set. */
2458 attributes
= GetFileAttributes (filename
);
2459 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2460 if (set_file_times (filename
, now
, now
))
2462 /* Restore original attributes. */
2463 SetFileAttributes (filename
, attributes
);
2464 Fsignal (Qfile_date_error
,
2465 Fcons (build_string ("Cannot set file date"),
2466 Fcons (newname
, Qnil
)));
2468 /* Restore original attributes. */
2469 SetFileAttributes (filename
, attributes
);
2471 #else /* not WINDOWSNT */
2473 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2477 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2479 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2481 /* We can only copy regular files and symbolic links. Other files are not
2483 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2485 #if !defined (DOS_NT) || __DJGPP__ > 1
2486 if (out_st
.st_mode
!= 0
2487 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2490 report_file_error ("Input and output files are the same",
2491 Fcons (file
, Fcons (newname
, Qnil
)));
2495 #if defined (S_ISREG) && defined (S_ISLNK)
2496 if (input_file_statable_p
)
2498 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2500 #if defined (EISDIR)
2501 /* Get a better looking error message. */
2504 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2507 #endif /* S_ISREG && S_ISLNK */
2510 /* Create the copy file with the same record format as the input file */
2511 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2514 /* System's default file type was set to binary by _fmode in emacs.c. */
2515 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2516 #else /* not MSDOS */
2517 ofd
= creat (SDATA (encoded_newname
), 0666);
2518 #endif /* not MSDOS */
2521 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2523 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2527 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2528 if (emacs_write (ofd
, buf
, n
) != n
)
2529 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2532 /* Closing the output clobbers the file times on some systems. */
2533 if (emacs_close (ofd
) < 0)
2534 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2536 if (input_file_statable_p
)
2538 if (!NILP (keep_time
))
2540 EMACS_TIME atime
, mtime
;
2541 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2542 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2543 if (set_file_times (SDATA (encoded_newname
),
2545 Fsignal (Qfile_date_error
,
2546 Fcons (build_string ("Cannot set file date"),
2547 Fcons (newname
, Qnil
)));
2550 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2552 #if defined (__DJGPP__) && __DJGPP__ > 1
2553 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2554 and if it can't, it tells so. Otherwise, under MSDOS we usually
2555 get only the READ bit, which will make the copied file read-only,
2556 so it's better not to chmod at all. */
2557 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2558 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2559 #endif /* DJGPP version 2 or newer */
2564 #endif /* WINDOWSNT */
2566 /* Discard the unwind protects. */
2567 specpdl_ptr
= specpdl
+ count
;
2573 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2574 Smake_directory_internal
, 1, 1, 0,
2575 doc
: /* Create a new directory named DIRECTORY. */)
2577 Lisp_Object directory
;
2579 const unsigned char *dir
;
2580 Lisp_Object handler
;
2581 Lisp_Object encoded_dir
;
2583 CHECK_STRING (directory
);
2584 directory
= Fexpand_file_name (directory
, Qnil
);
2586 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2587 if (!NILP (handler
))
2588 return call2 (handler
, Qmake_directory_internal
, directory
);
2590 encoded_dir
= ENCODE_FILE (directory
);
2592 dir
= SDATA (encoded_dir
);
2595 if (mkdir (dir
) != 0)
2597 if (mkdir (dir
, 0777) != 0)
2599 report_file_error ("Creating directory", Flist (1, &directory
));
2604 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2605 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2607 Lisp_Object directory
;
2609 const unsigned char *dir
;
2610 Lisp_Object handler
;
2611 Lisp_Object encoded_dir
;
2613 CHECK_STRING (directory
);
2614 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2616 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2617 if (!NILP (handler
))
2618 return call2 (handler
, Qdelete_directory
, directory
);
2620 encoded_dir
= ENCODE_FILE (directory
);
2622 dir
= SDATA (encoded_dir
);
2624 if (rmdir (dir
) != 0)
2625 report_file_error ("Removing directory", Flist (1, &directory
));
2630 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2631 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2632 If file has multiple names, it continues to exist with the other names. */)
2634 Lisp_Object filename
;
2636 Lisp_Object handler
;
2637 Lisp_Object encoded_file
;
2638 struct gcpro gcpro1
;
2641 if (!NILP (Ffile_directory_p (filename
))
2642 && NILP (Ffile_symlink_p (filename
)))
2643 Fsignal (Qfile_error
,
2644 Fcons (build_string ("Removing old name: is a directory"),
2645 Fcons (filename
, Qnil
)));
2647 filename
= Fexpand_file_name (filename
, Qnil
);
2649 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2650 if (!NILP (handler
))
2651 return call2 (handler
, Qdelete_file
, filename
);
2653 encoded_file
= ENCODE_FILE (filename
);
2655 if (0 > unlink (SDATA (encoded_file
)))
2656 report_file_error ("Removing old name", Flist (1, &filename
));
2661 internal_delete_file_1 (ignore
)
2667 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2670 internal_delete_file (filename
)
2671 Lisp_Object filename
;
2673 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2674 Qt
, internal_delete_file_1
));
2677 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2678 "fRename file: \nFRename %s to file: \np",
2679 doc
: /* Rename FILE as NEWNAME. Both args strings.
2680 If file has names other than FILE, it continues to have those names.
2681 Signals a `file-already-exists' error if a file NEWNAME already exists
2682 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2683 A number as third arg means request confirmation if NEWNAME already exists.
2684 This is what happens in interactive use with M-x. */)
2685 (file
, newname
, ok_if_already_exists
)
2686 Lisp_Object file
, newname
, ok_if_already_exists
;
2689 Lisp_Object args
[2];
2691 Lisp_Object handler
;
2692 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2693 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2695 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2696 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2697 CHECK_STRING (file
);
2698 CHECK_STRING (newname
);
2699 file
= Fexpand_file_name (file
, Qnil
);
2700 newname
= Fexpand_file_name (newname
, Qnil
);
2702 /* If the file name has special constructs in it,
2703 call the corresponding file handler. */
2704 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2706 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2707 if (!NILP (handler
))
2708 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2709 file
, newname
, ok_if_already_exists
));
2711 encoded_file
= ENCODE_FILE (file
);
2712 encoded_newname
= ENCODE_FILE (newname
);
2715 /* If the file names are identical but for the case, don't ask for
2716 confirmation: they simply want to change the letter-case of the
2718 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2720 if (NILP (ok_if_already_exists
)
2721 || INTEGERP (ok_if_already_exists
))
2722 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2723 INTEGERP (ok_if_already_exists
), 0, 0);
2725 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2727 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2728 || 0 > unlink (SDATA (encoded_file
)))
2734 symlink_target
= Ffile_symlink_p (file
);
2735 if (! NILP (symlink_target
))
2736 Fmake_symbolic_link (symlink_target
, newname
,
2737 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2740 Fcopy_file (file
, newname
,
2741 /* We have already prompted if it was an integer,
2742 so don't have copy-file prompt again. */
2743 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2744 Fdelete_file (file
);
2751 report_file_error ("Renaming", Flist (2, args
));
2754 report_file_error ("Renaming", Flist (2, &file
));
2761 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2762 "fAdd name to file: \nFName to add to %s: \np",
2763 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2764 Signals a `file-already-exists' error if a file NEWNAME already exists
2765 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2766 A number as third arg means request confirmation if NEWNAME already exists.
2767 This is what happens in interactive use with M-x. */)
2768 (file
, newname
, ok_if_already_exists
)
2769 Lisp_Object file
, newname
, ok_if_already_exists
;
2772 Lisp_Object args
[2];
2774 Lisp_Object handler
;
2775 Lisp_Object encoded_file
, encoded_newname
;
2776 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2778 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2779 encoded_file
= encoded_newname
= Qnil
;
2780 CHECK_STRING (file
);
2781 CHECK_STRING (newname
);
2782 file
= Fexpand_file_name (file
, Qnil
);
2783 newname
= Fexpand_file_name (newname
, Qnil
);
2785 /* If the file name has special constructs in it,
2786 call the corresponding file handler. */
2787 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2788 if (!NILP (handler
))
2789 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2790 newname
, ok_if_already_exists
));
2792 /* If the new name has special constructs in it,
2793 call the corresponding file handler. */
2794 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2795 if (!NILP (handler
))
2796 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2797 newname
, ok_if_already_exists
));
2799 encoded_file
= ENCODE_FILE (file
);
2800 encoded_newname
= ENCODE_FILE (newname
);
2802 if (NILP (ok_if_already_exists
)
2803 || INTEGERP (ok_if_already_exists
))
2804 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2805 INTEGERP (ok_if_already_exists
), 0, 0);
2807 unlink (SDATA (newname
));
2808 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2813 report_file_error ("Adding new name", Flist (2, args
));
2815 report_file_error ("Adding new name", Flist (2, &file
));
2824 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2825 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2826 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2827 Signals a `file-already-exists' error if a file LINKNAME already exists
2828 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2829 A number as third arg means request confirmation if LINKNAME already exists.
2830 This happens for interactive use with M-x. */)
2831 (filename
, linkname
, ok_if_already_exists
)
2832 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2835 Lisp_Object args
[2];
2837 Lisp_Object handler
;
2838 Lisp_Object encoded_filename
, encoded_linkname
;
2839 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2841 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2842 encoded_filename
= encoded_linkname
= Qnil
;
2843 CHECK_STRING (filename
);
2844 CHECK_STRING (linkname
);
2845 /* If the link target has a ~, we must expand it to get
2846 a truly valid file name. Otherwise, do not expand;
2847 we want to permit links to relative file names. */
2848 if (SREF (filename
, 0) == '~')
2849 filename
= Fexpand_file_name (filename
, Qnil
);
2850 linkname
= Fexpand_file_name (linkname
, Qnil
);
2852 /* If the file name has special constructs in it,
2853 call the corresponding file handler. */
2854 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2855 if (!NILP (handler
))
2856 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2857 linkname
, ok_if_already_exists
));
2859 /* If the new link name has special constructs in it,
2860 call the corresponding file handler. */
2861 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2862 if (!NILP (handler
))
2863 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2864 linkname
, ok_if_already_exists
));
2866 encoded_filename
= ENCODE_FILE (filename
);
2867 encoded_linkname
= ENCODE_FILE (linkname
);
2869 if (NILP (ok_if_already_exists
)
2870 || INTEGERP (ok_if_already_exists
))
2871 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2872 INTEGERP (ok_if_already_exists
), 0, 0);
2873 if (0 > symlink (SDATA (encoded_filename
),
2874 SDATA (encoded_linkname
)))
2876 /* If we didn't complain already, silently delete existing file. */
2877 if (errno
== EEXIST
)
2879 unlink (SDATA (encoded_linkname
));
2880 if (0 <= symlink (SDATA (encoded_filename
),
2881 SDATA (encoded_linkname
)))
2891 report_file_error ("Making symbolic link", Flist (2, args
));
2893 report_file_error ("Making symbolic link", Flist (2, &filename
));
2899 #endif /* S_IFLNK */
2903 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2904 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2905 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2906 If STRING is nil or a null string, the logical name NAME is deleted. */)
2911 CHECK_STRING (name
);
2913 delete_logical_name (SDATA (name
));
2916 CHECK_STRING (string
);
2918 if (SCHARS (string
) == 0)
2919 delete_logical_name (SDATA (name
));
2921 define_logical_name (SDATA (name
), SDATA (string
));
2930 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2931 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2933 Lisp_Object path
, login
;
2937 CHECK_STRING (path
);
2938 CHECK_STRING (login
);
2940 netresult
= netunam (SDATA (path
), SDATA (login
));
2942 if (netresult
== -1)
2947 #endif /* HPUX_NET */
2949 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2951 doc
: /* Return t if file FILENAME specifies an absolute file name.
2952 On Unix, this is a name starting with a `/' or a `~'. */)
2954 Lisp_Object filename
;
2956 const unsigned char *ptr
;
2958 CHECK_STRING (filename
);
2959 ptr
= SDATA (filename
);
2960 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2962 /* ??? This criterion is probably wrong for '<'. */
2963 || index (ptr
, ':') || index (ptr
, '<')
2964 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2968 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2976 /* Return nonzero if file FILENAME exists and can be executed. */
2979 check_executable (filename
)
2983 int len
= strlen (filename
);
2986 if (stat (filename
, &st
) < 0)
2988 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2989 return ((st
.st_mode
& S_IEXEC
) != 0);
2991 return (S_ISREG (st
.st_mode
)
2993 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2994 || stricmp (suffix
, ".exe") == 0
2995 || stricmp (suffix
, ".bat") == 0)
2996 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2997 #endif /* not WINDOWSNT */
2998 #else /* not DOS_NT */
2999 #ifdef HAVE_EUIDACCESS
3000 return (euidaccess (filename
, 1) >= 0);
3002 /* Access isn't quite right because it uses the real uid
3003 and we really want to test with the effective uid.
3004 But Unix doesn't give us a right way to do it. */
3005 return (access (filename
, 1) >= 0);
3007 #endif /* not DOS_NT */
3010 /* Return nonzero if file FILENAME exists and can be written. */
3013 check_writable (filename
)
3018 if (stat (filename
, &st
) < 0)
3020 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3021 #else /* not MSDOS */
3022 #ifdef HAVE_EUIDACCESS
3023 return (euidaccess (filename
, 2) >= 0);
3025 /* Access isn't quite right because it uses the real uid
3026 and we really want to test with the effective uid.
3027 But Unix doesn't give us a right way to do it.
3028 Opening with O_WRONLY could work for an ordinary file,
3029 but would lose for directories. */
3030 return (access (filename
, 2) >= 0);
3032 #endif /* not MSDOS */
3035 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3036 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3037 See also `file-readable-p' and `file-attributes'. */)
3039 Lisp_Object filename
;
3041 Lisp_Object absname
;
3042 Lisp_Object handler
;
3043 struct stat statbuf
;
3045 CHECK_STRING (filename
);
3046 absname
= Fexpand_file_name (filename
, Qnil
);
3048 /* If the file name has special constructs in it,
3049 call the corresponding file handler. */
3050 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3051 if (!NILP (handler
))
3052 return call2 (handler
, Qfile_exists_p
, absname
);
3054 absname
= ENCODE_FILE (absname
);
3056 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3059 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3060 doc
: /* Return t if FILENAME can be executed by you.
3061 For a directory, this means you can access files in that directory. */)
3063 Lisp_Object filename
;
3065 Lisp_Object absname
;
3066 Lisp_Object handler
;
3068 CHECK_STRING (filename
);
3069 absname
= Fexpand_file_name (filename
, Qnil
);
3071 /* If the file name has special constructs in it,
3072 call the corresponding file handler. */
3073 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3074 if (!NILP (handler
))
3075 return call2 (handler
, Qfile_executable_p
, absname
);
3077 absname
= ENCODE_FILE (absname
);
3079 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3082 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3083 doc
: /* Return t if file FILENAME exists and you can read it.
3084 See also `file-exists-p' and `file-attributes'. */)
3086 Lisp_Object filename
;
3088 Lisp_Object absname
;
3089 Lisp_Object handler
;
3092 struct stat statbuf
;
3094 CHECK_STRING (filename
);
3095 absname
= Fexpand_file_name (filename
, Qnil
);
3097 /* If the file name has special constructs in it,
3098 call the corresponding file handler. */
3099 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3100 if (!NILP (handler
))
3101 return call2 (handler
, Qfile_readable_p
, absname
);
3103 absname
= ENCODE_FILE (absname
);
3105 #if defined(DOS_NT) || defined(macintosh)
3106 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3108 if (access (SDATA (absname
), 0) == 0)
3111 #else /* not DOS_NT and not macintosh */
3113 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3114 /* Opening a fifo without O_NONBLOCK can wait.
3115 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3116 except in the case of a fifo, on a system which handles it. */
3117 desc
= stat (SDATA (absname
), &statbuf
);
3120 if (S_ISFIFO (statbuf
.st_mode
))
3121 flags
|= O_NONBLOCK
;
3123 desc
= emacs_open (SDATA (absname
), flags
, 0);
3128 #endif /* not DOS_NT and not macintosh */
3131 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3133 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3134 doc
: /* Return t if file FILENAME can be written or created by you. */)
3136 Lisp_Object filename
;
3138 Lisp_Object absname
, dir
, encoded
;
3139 Lisp_Object handler
;
3140 struct stat statbuf
;
3142 CHECK_STRING (filename
);
3143 absname
= Fexpand_file_name (filename
, Qnil
);
3145 /* If the file name has special constructs in it,
3146 call the corresponding file handler. */
3147 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3148 if (!NILP (handler
))
3149 return call2 (handler
, Qfile_writable_p
, absname
);
3151 encoded
= ENCODE_FILE (absname
);
3152 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3153 return (check_writable (SDATA (encoded
))
3156 dir
= Ffile_name_directory (absname
);
3159 dir
= Fdirectory_file_name (dir
);
3163 dir
= Fdirectory_file_name (dir
);
3166 dir
= ENCODE_FILE (dir
);
3168 /* The read-only attribute of the parent directory doesn't affect
3169 whether a file or directory can be created within it. Some day we
3170 should check ACLs though, which do affect this. */
3171 if (stat (SDATA (dir
), &statbuf
) < 0)
3173 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3175 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3180 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3181 doc
: /* Access file FILENAME, and get an error if that does not work.
3182 The second argument STRING is used in the error message.
3183 If there is no error, we return nil. */)
3185 Lisp_Object filename
, string
;
3187 Lisp_Object handler
, encoded_filename
, absname
;
3190 CHECK_STRING (filename
);
3191 absname
= Fexpand_file_name (filename
, Qnil
);
3193 CHECK_STRING (string
);
3195 /* If the file name has special constructs in it,
3196 call the corresponding file handler. */
3197 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3198 if (!NILP (handler
))
3199 return call3 (handler
, Qaccess_file
, absname
, string
);
3201 encoded_filename
= ENCODE_FILE (absname
);
3203 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3205 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3211 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3212 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3213 The value is the link target, as a string.
3214 Otherwise returns nil. */)
3216 Lisp_Object filename
;
3218 Lisp_Object handler
;
3220 CHECK_STRING (filename
);
3221 filename
= Fexpand_file_name (filename
, Qnil
);
3223 /* If the file name has special constructs in it,
3224 call the corresponding file handler. */
3225 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3226 if (!NILP (handler
))
3227 return call2 (handler
, Qfile_symlink_p
, filename
);
3236 filename
= ENCODE_FILE (filename
);
3243 buf
= (char *) xrealloc (buf
, bufsize
);
3244 bzero (buf
, bufsize
);
3247 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3251 /* HP-UX reports ERANGE if buffer is too small. */
3252 if (errno
== ERANGE
)
3262 while (valsize
>= bufsize
);
3264 val
= make_string (buf
, valsize
);
3265 if (buf
[0] == '/' && index (buf
, ':'))
3266 val
= concat2 (build_string ("/:"), val
);
3268 val
= DECODE_FILE (val
);
3271 #else /* not S_IFLNK */
3273 #endif /* not S_IFLNK */
3276 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3277 doc
: /* Return t if FILENAME names an existing directory.
3278 Symbolic links to directories count as directories.
3279 See `file-symlink-p' to distinguish symlinks. */)
3281 Lisp_Object filename
;
3283 register Lisp_Object absname
;
3285 Lisp_Object handler
;
3287 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3289 /* If the file name has special constructs in it,
3290 call the corresponding file handler. */
3291 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3292 if (!NILP (handler
))
3293 return call2 (handler
, Qfile_directory_p
, absname
);
3295 absname
= ENCODE_FILE (absname
);
3297 if (stat (SDATA (absname
), &st
) < 0)
3299 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3302 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3303 doc
: /* Return t if file FILENAME names a directory you can open.
3304 For the value to be t, FILENAME must specify the name of a directory as a file,
3305 and the directory must allow you to open files in it. In order to use a
3306 directory as a buffer's current directory, this predicate must return true.
3307 A directory name spec may be given instead; then the value is t
3308 if the directory so specified exists and really is a readable and
3309 searchable directory. */)
3311 Lisp_Object filename
;
3313 Lisp_Object handler
;
3315 struct gcpro gcpro1
;
3317 /* If the file name has special constructs in it,
3318 call the corresponding file handler. */
3319 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3320 if (!NILP (handler
))
3321 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3324 tem
= (NILP (Ffile_directory_p (filename
))
3325 || NILP (Ffile_executable_p (filename
)));
3327 return tem
? Qnil
: Qt
;
3330 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3331 doc
: /* Return t if file FILENAME is the name of a regular file.
3332 This is the sort of file that holds an ordinary stream of data bytes. */)
3334 Lisp_Object filename
;
3336 register Lisp_Object absname
;
3338 Lisp_Object handler
;
3340 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3342 /* If the file name has special constructs in it,
3343 call the corresponding file handler. */
3344 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3345 if (!NILP (handler
))
3346 return call2 (handler
, Qfile_regular_p
, absname
);
3348 absname
= ENCODE_FILE (absname
);
3353 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3355 /* Tell stat to use expensive method to get accurate info. */
3356 Vw32_get_true_file_attributes
= Qt
;
3357 result
= stat (SDATA (absname
), &st
);
3358 Vw32_get_true_file_attributes
= tem
;
3362 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3365 if (stat (SDATA (absname
), &st
) < 0)
3367 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3371 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3372 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
3374 Lisp_Object filename
;
3376 Lisp_Object absname
;
3378 Lisp_Object handler
;
3380 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3382 /* If the file name has special constructs in it,
3383 call the corresponding file handler. */
3384 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3385 if (!NILP (handler
))
3386 return call2 (handler
, Qfile_modes
, absname
);
3388 absname
= ENCODE_FILE (absname
);
3390 if (stat (SDATA (absname
), &st
) < 0)
3392 #if defined (MSDOS) && __DJGPP__ < 2
3393 if (check_executable (SDATA (absname
)))
3394 st
.st_mode
|= S_IEXEC
;
3395 #endif /* MSDOS && __DJGPP__ < 2 */
3397 return make_number (st
.st_mode
& 07777);
3400 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3401 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3402 Only the 12 low bits of MODE are used. */)
3404 Lisp_Object filename
, mode
;
3406 Lisp_Object absname
, encoded_absname
;
3407 Lisp_Object handler
;
3409 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3410 CHECK_NUMBER (mode
);
3412 /* If the file name has special constructs in it,
3413 call the corresponding file handler. */
3414 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3415 if (!NILP (handler
))
3416 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3418 encoded_absname
= ENCODE_FILE (absname
);
3420 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3421 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3426 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3427 doc
: /* Set the file permission bits for newly created files.
3428 The argument MODE should be an integer; only the low 9 bits are used.
3429 This setting is inherited by subprocesses. */)
3433 CHECK_NUMBER (mode
);
3435 umask ((~ XINT (mode
)) & 0777);
3440 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3441 doc
: /* Return the default file protection for created files.
3442 The value is an integer. */)
3448 realmask
= umask (0);
3451 XSETINT (value
, (~ realmask
) & 0777);
3455 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3457 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3458 doc
: /* Set times of file FILENAME to TIME.
3459 Set both access and modification times.
3460 Return t on success, else nil.
3461 Use the current time if TIME is nil. TIME is in the format of
3464 Lisp_Object filename
, time
;
3466 Lisp_Object absname
, encoded_absname
;
3467 Lisp_Object handler
;
3471 if (! lisp_time_argument (time
, &sec
, &usec
))
3472 error ("Invalid time specification");
3474 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3476 /* If the file name has special constructs in it,
3477 call the corresponding file handler. */
3478 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3479 if (!NILP (handler
))
3480 return call3 (handler
, Qset_file_times
, absname
, time
);
3482 encoded_absname
= ENCODE_FILE (absname
);
3487 EMACS_SET_SECS (t
, sec
);
3488 EMACS_SET_USECS (t
, usec
);
3490 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3495 /* Setting times on a directory always fails. */
3496 if (stat (SDATA (encoded_absname
), &st
) == 0
3497 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3500 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3513 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3514 doc
: /* Tell Unix to finish all pending disk updates. */)
3523 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3524 doc
: /* Return t if file FILE1 is newer than file FILE2.
3525 If FILE1 does not exist, the answer is nil;
3526 otherwise, if FILE2 does not exist, the answer is t. */)
3528 Lisp_Object file1
, file2
;
3530 Lisp_Object absname1
, absname2
;
3533 Lisp_Object handler
;
3534 struct gcpro gcpro1
, gcpro2
;
3536 CHECK_STRING (file1
);
3537 CHECK_STRING (file2
);
3540 GCPRO2 (absname1
, file2
);
3541 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3542 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3545 /* If the file name has special constructs in it,
3546 call the corresponding file handler. */
3547 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3549 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3550 if (!NILP (handler
))
3551 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3553 GCPRO2 (absname1
, absname2
);
3554 absname1
= ENCODE_FILE (absname1
);
3555 absname2
= ENCODE_FILE (absname2
);
3558 if (stat (SDATA (absname1
), &st
) < 0)
3561 mtime1
= st
.st_mtime
;
3563 if (stat (SDATA (absname2
), &st
) < 0)
3566 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3570 Lisp_Object Qfind_buffer_file_type
;
3573 #ifndef READ_BUF_SIZE
3574 #define READ_BUF_SIZE (64 << 10)
3577 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3579 /* This function is called after Lisp functions to decide a coding
3580 system are called, or when they cause an error. Before they are
3581 called, the current buffer is set unibyte and it contains only a
3582 newly inserted text (thus the buffer was empty before the
3585 The functions may set markers, overlays, text properties, or even
3586 alter the buffer contents, change the current buffer.
3588 Here, we reset all those changes by:
3589 o set back the current buffer.
3590 o move all markers and overlays to BEG.
3591 o remove all text properties.
3592 o set back the buffer multibyteness. */
3595 decide_coding_unwind (unwind_data
)
3596 Lisp_Object unwind_data
;
3598 Lisp_Object multibyte
, undo_list
, buffer
;
3600 multibyte
= XCAR (unwind_data
);
3601 unwind_data
= XCDR (unwind_data
);
3602 undo_list
= XCAR (unwind_data
);
3603 buffer
= XCDR (unwind_data
);
3605 if (current_buffer
!= XBUFFER (buffer
))
3606 set_buffer_internal (XBUFFER (buffer
));
3607 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3608 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3609 BUF_INTERVALS (current_buffer
) = 0;
3610 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3612 /* Now we are safe to change the buffer's multibyteness directly. */
3613 current_buffer
->enable_multibyte_characters
= multibyte
;
3614 current_buffer
->undo_list
= undo_list
;
3620 /* Used to pass values from insert-file-contents to read_non_regular. */
3622 static int non_regular_fd
;
3623 static int non_regular_inserted
;
3624 static int non_regular_nbytes
;
3627 /* Read from a non-regular file.
3628 Read non_regular_trytry bytes max from non_regular_fd.
3629 Non_regular_inserted specifies where to put the read bytes.
3630 Value is the number of bytes read. */
3639 nbytes
= emacs_read (non_regular_fd
,
3640 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3641 non_regular_nbytes
);
3643 return make_number (nbytes
);
3647 /* Condition-case handler used when reading from non-regular files
3648 in insert-file-contents. */
3651 read_non_regular_quit ()
3657 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3659 doc
: /* Insert contents of file FILENAME after point.
3660 Returns list of absolute file name and number of characters inserted.
3661 If second argument VISIT is non-nil, the buffer's visited filename
3662 and last save file modtime are set, and it is marked unmodified.
3663 If visiting and the file does not exist, visiting is completed
3664 before the error is signaled.
3665 The optional third and fourth arguments BEG and END
3666 specify what portion of the file to insert.
3667 These arguments count bytes in the file, not characters in the buffer.
3668 If VISIT is non-nil, BEG and END must be nil.
3670 If optional fifth argument REPLACE is non-nil,
3671 it means replace the current buffer contents (in the accessible portion)
3672 with the file contents. This is better than simply deleting and inserting
3673 the whole thing because (1) it preserves some marker positions
3674 and (2) it puts less data in the undo list.
3675 When REPLACE is non-nil, the value is the number of characters actually read,
3676 which is often less than the number of characters to be read.
3678 This does code conversion according to the value of
3679 `coding-system-for-read' or `file-coding-system-alist',
3680 and sets the variable `last-coding-system-used' to the coding system
3682 (filename
, visit
, beg
, end
, replace
)
3683 Lisp_Object filename
, visit
, beg
, end
, replace
;
3688 register int how_much
;
3689 register int unprocessed
;
3690 int count
= SPECPDL_INDEX ();
3691 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3692 Lisp_Object handler
, val
, insval
, orig_filename
;
3695 int not_regular
= 0;
3696 unsigned char read_buf
[READ_BUF_SIZE
];
3697 struct coding_system coding
;
3698 unsigned char buffer
[1 << 14];
3699 int replace_handled
= 0;
3700 int set_coding_system
= 0;
3701 int coding_system_decided
= 0;
3704 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3705 error ("Cannot do file visiting in an indirect buffer");
3707 if (!NILP (current_buffer
->read_only
))
3708 Fbarf_if_buffer_read_only ();
3712 orig_filename
= Qnil
;
3714 GCPRO4 (filename
, val
, p
, orig_filename
);
3716 CHECK_STRING (filename
);
3717 filename
= Fexpand_file_name (filename
, Qnil
);
3719 /* If the file name has special constructs in it,
3720 call the corresponding file handler. */
3721 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3722 if (!NILP (handler
))
3724 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3725 visit
, beg
, end
, replace
);
3726 if (CONSP (val
) && CONSP (XCDR (val
)))
3727 inserted
= XINT (XCAR (XCDR (val
)));
3731 orig_filename
= filename
;
3732 filename
= ENCODE_FILE (filename
);
3738 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3740 /* Tell stat to use expensive method to get accurate info. */
3741 Vw32_get_true_file_attributes
= Qt
;
3742 total
= stat (SDATA (filename
), &st
);
3743 Vw32_get_true_file_attributes
= tem
;
3748 if (stat (SDATA (filename
), &st
) < 0)
3750 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3751 || fstat (fd
, &st
) < 0)
3752 #endif /* not APOLLO */
3753 #endif /* WINDOWSNT */
3755 if (fd
>= 0) emacs_close (fd
);
3758 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3761 if (!NILP (Vcoding_system_for_read
))
3762 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3767 /* This code will need to be changed in order to work on named
3768 pipes, and it's probably just not worth it. So we should at
3769 least signal an error. */
3770 if (!S_ISREG (st
.st_mode
))
3777 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3778 Fsignal (Qfile_error
,
3779 Fcons (build_string ("not a regular file"),
3780 Fcons (orig_filename
, Qnil
)));
3785 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3788 /* Replacement should preserve point as it preserves markers. */
3789 if (!NILP (replace
))
3790 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3792 record_unwind_protect (close_file_unwind
, make_number (fd
));
3794 /* Supposedly happens on VMS. */
3795 /* Can happen on any platform that uses long as type of off_t, but allows
3796 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3797 give a message suitable for the latter case. */
3798 if (! not_regular
&& st
.st_size
< 0)
3799 error ("Maximum buffer size exceeded");
3801 /* Prevent redisplay optimizations. */
3802 current_buffer
->clip_changed
= 1;
3806 if (!NILP (beg
) || !NILP (end
))
3807 error ("Attempt to visit less than an entire file");
3808 if (BEG
< Z
&& NILP (replace
))
3809 error ("Cannot do file visiting in a non-empty buffer");
3815 XSETFASTINT (beg
, 0);
3823 XSETINT (end
, st
.st_size
);
3825 /* Arithmetic overflow can occur if an Emacs integer cannot
3826 represent the file size, or if the calculations below
3827 overflow. The calculations below double the file size
3828 twice, so check that it can be multiplied by 4 safely. */
3829 if (XINT (end
) != st
.st_size
3830 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3831 error ("Maximum buffer size exceeded");
3833 /* The file size returned from stat may be zero, but data
3834 may be readable nonetheless, for example when this is a
3835 file in the /proc filesystem. */
3836 if (st
.st_size
== 0)
3837 XSETINT (end
, READ_BUF_SIZE
);
3841 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3843 /* We use emacs-mule for auto saving... */
3844 setup_coding_system (Qemacs_mule
, &coding
);
3845 /* ... but with the special flag to indicate to read in a
3846 multibyte sequence for eight-bit-control char as is. */
3848 coding
.src_multibyte
= 0;
3849 coding
.dst_multibyte
3850 = !NILP (current_buffer
->enable_multibyte_characters
);
3851 coding
.eol_type
= CODING_EOL_LF
;
3852 coding_system_decided
= 1;
3856 /* Decide the coding system to use for reading the file now
3857 because we can't use an optimized method for handling
3858 `coding:' tag if the current buffer is not empty. */
3862 if (!NILP (Vcoding_system_for_read
))
3863 val
= Vcoding_system_for_read
;
3864 else if (! NILP (replace
))
3865 /* In REPLACE mode, we can use the same coding system
3866 that was used to visit the file. */
3867 val
= current_buffer
->buffer_file_coding_system
;
3870 /* Don't try looking inside a file for a coding system
3871 specification if it is not seekable. */
3872 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3874 /* Find a coding system specified in the heading two
3875 lines or in the tailing several lines of the file.
3876 We assume that the 1K-byte and 3K-byte for heading
3877 and tailing respectively are sufficient for this
3881 if (st
.st_size
<= (1024 * 4))
3882 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3885 nread
= emacs_read (fd
, read_buf
, 1024);
3888 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3889 report_file_error ("Setting file position",
3890 Fcons (orig_filename
, Qnil
));
3891 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3896 error ("IO error reading %s: %s",
3897 SDATA (orig_filename
), emacs_strerror (errno
));
3900 struct buffer
*prev
= current_buffer
;
3904 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3906 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3907 buf
= XBUFFER (buffer
);
3909 delete_all_overlays (buf
);
3910 buf
->directory
= current_buffer
->directory
;
3911 buf
->read_only
= Qnil
;
3912 buf
->filename
= Qnil
;
3913 buf
->undo_list
= Qt
;
3914 eassert (buf
->overlays_before
== NULL
);
3915 eassert (buf
->overlays_after
== NULL
);
3917 set_buffer_internal (buf
);
3919 buf
->enable_multibyte_characters
= Qnil
;
3921 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3922 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3923 val
= call2 (Vset_auto_coding_function
,
3924 filename
, make_number (nread
));
3925 set_buffer_internal (prev
);
3927 /* Discard the unwind protect for recovering the
3931 /* Rewind the file for the actual read done later. */
3932 if (lseek (fd
, 0, 0) < 0)
3933 report_file_error ("Setting file position",
3934 Fcons (orig_filename
, Qnil
));
3940 /* If we have not yet decided a coding system, check
3941 file-coding-system-alist. */
3942 Lisp_Object args
[6], coding_systems
;
3944 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3945 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3946 coding_systems
= Ffind_operation_coding_system (6, args
);
3947 if (CONSP (coding_systems
))
3948 val
= XCAR (coding_systems
);
3952 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3953 /* Ensure we set Vlast_coding_system_used. */
3954 set_coding_system
= 1;
3956 if (NILP (current_buffer
->enable_multibyte_characters
)
3958 /* We must suppress all character code conversion except for
3959 end-of-line conversion. */
3960 setup_raw_text_coding_system (&coding
);
3962 coding
.src_multibyte
= 0;
3963 coding
.dst_multibyte
3964 = !NILP (current_buffer
->enable_multibyte_characters
);
3965 coding_system_decided
= 1;
3968 /* If requested, replace the accessible part of the buffer
3969 with the file contents. Avoid replacing text at the
3970 beginning or end of the buffer that matches the file contents;
3971 that preserves markers pointing to the unchanged parts.
3973 Here we implement this feature in an optimized way
3974 for the case where code conversion is NOT needed.
3975 The following if-statement handles the case of conversion
3976 in a less optimal way.
3978 If the code conversion is "automatic" then we try using this
3979 method and hope for the best.
3980 But if we discover the need for conversion, we give up on this method
3981 and let the following if-statement handle the replace job. */
3984 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3986 /* same_at_start and same_at_end count bytes,
3987 because file access counts bytes
3988 and BEG and END count bytes. */
3989 int same_at_start
= BEGV_BYTE
;
3990 int same_at_end
= ZV_BYTE
;
3992 /* There is still a possibility we will find the need to do code
3993 conversion. If that happens, we set this variable to 1 to
3994 give up on handling REPLACE in the optimized way. */
3995 int giveup_match_end
= 0;
3997 if (XINT (beg
) != 0)
3999 if (lseek (fd
, XINT (beg
), 0) < 0)
4000 report_file_error ("Setting file position",
4001 Fcons (orig_filename
, Qnil
));
4006 /* Count how many chars at the start of the file
4007 match the text at the beginning of the buffer. */
4012 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4014 error ("IO error reading %s: %s",
4015 SDATA (orig_filename
), emacs_strerror (errno
));
4016 else if (nread
== 0)
4019 if (coding
.type
== coding_type_undecided
)
4020 detect_coding (&coding
, buffer
, nread
);
4021 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4022 /* We found that the file should be decoded somehow.
4023 Let's give up here. */
4025 giveup_match_end
= 1;
4029 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4030 detect_eol (&coding
, buffer
, nread
);
4031 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4032 && coding
.eol_type
!= CODING_EOL_LF
)
4033 /* We found that the format of eol should be decoded.
4034 Let's give up here. */
4036 giveup_match_end
= 1;
4041 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4042 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4043 same_at_start
++, bufpos
++;
4044 /* If we found a discrepancy, stop the scan.
4045 Otherwise loop around and scan the next bufferful. */
4046 if (bufpos
!= nread
)
4050 /* If the file matches the buffer completely,
4051 there's no need to replace anything. */
4052 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4056 /* Truncate the buffer to the size of the file. */
4057 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4062 /* Count how many chars at the end of the file
4063 match the text at the end of the buffer. But, if we have
4064 already found that decoding is necessary, don't waste time. */
4065 while (!giveup_match_end
)
4067 int total_read
, nread
, bufpos
, curpos
, trial
;
4069 /* At what file position are we now scanning? */
4070 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4071 /* If the entire file matches the buffer tail, stop the scan. */
4074 /* How much can we scan in the next step? */
4075 trial
= min (curpos
, sizeof buffer
);
4076 if (lseek (fd
, curpos
- trial
, 0) < 0)
4077 report_file_error ("Setting file position",
4078 Fcons (orig_filename
, Qnil
));
4080 total_read
= nread
= 0;
4081 while (total_read
< trial
)
4083 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4085 error ("IO error reading %s: %s",
4086 SDATA (orig_filename
), emacs_strerror (errno
));
4087 else if (nread
== 0)
4089 total_read
+= nread
;
4092 /* Scan this bufferful from the end, comparing with
4093 the Emacs buffer. */
4094 bufpos
= total_read
;
4096 /* Compare with same_at_start to avoid counting some buffer text
4097 as matching both at the file's beginning and at the end. */
4098 while (bufpos
> 0 && same_at_end
> same_at_start
4099 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4100 same_at_end
--, bufpos
--;
4102 /* If we found a discrepancy, stop the scan.
4103 Otherwise loop around and scan the preceding bufferful. */
4106 /* If this discrepancy is because of code conversion,
4107 we cannot use this method; giveup and try the other. */
4108 if (same_at_end
> same_at_start
4109 && FETCH_BYTE (same_at_end
- 1) >= 0200
4110 && ! NILP (current_buffer
->enable_multibyte_characters
)
4111 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4112 giveup_match_end
= 1;
4121 if (! giveup_match_end
)
4125 /* We win! We can handle REPLACE the optimized way. */
4127 /* Extend the start of non-matching text area to multibyte
4128 character boundary. */
4129 if (! NILP (current_buffer
->enable_multibyte_characters
))
4130 while (same_at_start
> BEGV_BYTE
4131 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4134 /* Extend the end of non-matching text area to multibyte
4135 character boundary. */
4136 if (! NILP (current_buffer
->enable_multibyte_characters
))
4137 while (same_at_end
< ZV_BYTE
4138 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4141 /* Don't try to reuse the same piece of text twice. */
4142 overlap
= (same_at_start
- BEGV_BYTE
4143 - (same_at_end
+ st
.st_size
- ZV
));
4145 same_at_end
+= overlap
;
4147 /* Arrange to read only the nonmatching middle part of the file. */
4148 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4149 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4151 del_range_byte (same_at_start
, same_at_end
, 0);
4152 /* Insert from the file at the proper position. */
4153 temp
= BYTE_TO_CHAR (same_at_start
);
4154 SET_PT_BOTH (temp
, same_at_start
);
4156 /* If display currently starts at beginning of line,
4157 keep it that way. */
4158 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4159 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4161 replace_handled
= 1;
4165 /* If requested, replace the accessible part of the buffer
4166 with the file contents. Avoid replacing text at the
4167 beginning or end of the buffer that matches the file contents;
4168 that preserves markers pointing to the unchanged parts.
4170 Here we implement this feature for the case where code conversion
4171 is needed, in a simple way that needs a lot of memory.
4172 The preceding if-statement handles the case of no conversion
4173 in a more optimized way. */
4174 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4176 int same_at_start
= BEGV_BYTE
;
4177 int same_at_end
= ZV_BYTE
;
4180 /* Make sure that the gap is large enough. */
4181 int bufsize
= 2 * st
.st_size
;
4182 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4185 /* First read the whole file, performing code conversion into
4186 CONVERSION_BUFFER. */
4188 if (lseek (fd
, XINT (beg
), 0) < 0)
4190 xfree (conversion_buffer
);
4191 report_file_error ("Setting file position",
4192 Fcons (orig_filename
, Qnil
));
4195 total
= st
.st_size
; /* Total bytes in the file. */
4196 how_much
= 0; /* Bytes read from file so far. */
4197 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4198 unprocessed
= 0; /* Bytes not processed in previous loop. */
4200 while (how_much
< total
)
4202 /* try is reserved in some compilers (Microsoft C) */
4203 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4204 unsigned char *destination
= read_buf
+ unprocessed
;
4207 /* Allow quitting out of the actual I/O. */
4210 this = emacs_read (fd
, destination
, trytry
);
4213 if (this < 0 || this + unprocessed
== 0)
4221 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4223 int require
, result
;
4225 this += unprocessed
;
4227 /* If we are using more space than estimated,
4228 make CONVERSION_BUFFER bigger. */
4229 require
= decoding_buffer_size (&coding
, this);
4230 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4232 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4233 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4236 /* Convert this batch with results in CONVERSION_BUFFER. */
4237 if (how_much
>= total
) /* This is the last block. */
4238 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4239 if (coding
.composing
!= COMPOSITION_DISABLED
)
4240 coding_allocate_composition_data (&coding
, BEGV
);
4241 result
= decode_coding (&coding
, read_buf
,
4242 conversion_buffer
+ inserted
,
4243 this, bufsize
- inserted
);
4245 /* Save for next iteration whatever we didn't convert. */
4246 unprocessed
= this - coding
.consumed
;
4247 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4248 if (!NILP (current_buffer
->enable_multibyte_characters
))
4249 this = coding
.produced
;
4251 this = str_as_unibyte (conversion_buffer
+ inserted
,
4258 /* At this point, INSERTED is how many characters (i.e. bytes)
4259 are present in CONVERSION_BUFFER.
4260 HOW_MUCH should equal TOTAL,
4261 or should be <= 0 if we couldn't read the file. */
4265 xfree (conversion_buffer
);
4268 error ("IO error reading %s: %s",
4269 SDATA (orig_filename
), emacs_strerror (errno
));
4270 else if (how_much
== -2)
4271 error ("maximum buffer size exceeded");
4274 /* Compare the beginning of the converted file
4275 with the buffer text. */
4278 while (bufpos
< inserted
&& same_at_start
< same_at_end
4279 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4280 same_at_start
++, bufpos
++;
4282 /* If the file matches the buffer completely,
4283 there's no need to replace anything. */
4285 if (bufpos
== inserted
)
4287 xfree (conversion_buffer
);
4290 /* Truncate the buffer to the size of the file. */
4291 del_range_byte (same_at_start
, same_at_end
, 0);
4296 /* Extend the start of non-matching text area to multibyte
4297 character boundary. */
4298 if (! NILP (current_buffer
->enable_multibyte_characters
))
4299 while (same_at_start
> BEGV_BYTE
4300 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4303 /* Scan this bufferful from the end, comparing with
4304 the Emacs buffer. */
4307 /* Compare with same_at_start to avoid counting some buffer text
4308 as matching both at the file's beginning and at the end. */
4309 while (bufpos
> 0 && same_at_end
> same_at_start
4310 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4311 same_at_end
--, bufpos
--;
4313 /* Extend the end of non-matching text area to multibyte
4314 character boundary. */
4315 if (! NILP (current_buffer
->enable_multibyte_characters
))
4316 while (same_at_end
< ZV_BYTE
4317 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4320 /* Don't try to reuse the same piece of text twice. */
4321 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4323 same_at_end
+= overlap
;
4325 /* If display currently starts at beginning of line,
4326 keep it that way. */
4327 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4328 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4330 /* Replace the chars that we need to replace,
4331 and update INSERTED to equal the number of bytes
4332 we are taking from the file. */
4333 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4335 if (same_at_end
!= same_at_start
)
4337 del_range_byte (same_at_start
, same_at_end
, 0);
4339 same_at_start
= GPT_BYTE
;
4343 temp
= BYTE_TO_CHAR (same_at_start
);
4345 /* Insert from the file at the proper position. */
4346 SET_PT_BOTH (temp
, same_at_start
);
4347 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
4349 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4350 coding_restore_composition (&coding
, Fcurrent_buffer ());
4351 coding_free_composition_data (&coding
);
4353 /* Set `inserted' to the number of inserted characters. */
4354 inserted
= PT
- temp
;
4356 xfree (conversion_buffer
);
4365 register Lisp_Object temp
;
4367 total
= XINT (end
) - XINT (beg
);
4369 /* Make sure point-max won't overflow after this insertion. */
4370 XSETINT (temp
, total
);
4371 if (total
!= XINT (temp
))
4372 error ("Maximum buffer size exceeded");
4375 /* For a special file, all we can do is guess. */
4376 total
= READ_BUF_SIZE
;
4378 if (NILP (visit
) && total
> 0)
4379 prepare_to_modify_buffer (PT
, PT
, NULL
);
4382 if (GAP_SIZE
< total
)
4383 make_gap (total
- GAP_SIZE
);
4385 if (XINT (beg
) != 0 || !NILP (replace
))
4387 if (lseek (fd
, XINT (beg
), 0) < 0)
4388 report_file_error ("Setting file position",
4389 Fcons (orig_filename
, Qnil
));
4392 /* In the following loop, HOW_MUCH contains the total bytes read so
4393 far for a regular file, and not changed for a special file. But,
4394 before exiting the loop, it is set to a negative value if I/O
4398 /* Total bytes inserted. */
4401 /* Here, we don't do code conversion in the loop. It is done by
4402 code_convert_region after all data are read into the buffer. */
4404 int gap_size
= GAP_SIZE
;
4406 while (how_much
< total
)
4408 /* try is reserved in some compilers (Microsoft C) */
4409 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4416 /* Maybe make more room. */
4417 if (gap_size
< trytry
)
4419 make_gap (total
- gap_size
);
4420 gap_size
= GAP_SIZE
;
4423 /* Read from the file, capturing `quit'. When an
4424 error occurs, end the loop, and arrange for a quit
4425 to be signaled after decoding the text we read. */
4426 non_regular_fd
= fd
;
4427 non_regular_inserted
= inserted
;
4428 non_regular_nbytes
= trytry
;
4429 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4430 read_non_regular_quit
);
4441 /* Allow quitting out of the actual I/O. We don't make text
4442 part of the buffer until all the reading is done, so a C-g
4443 here doesn't do any harm. */
4446 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4458 /* For a regular file, where TOTAL is the real size,
4459 count HOW_MUCH to compare with it.
4460 For a special file, where TOTAL is just a buffer size,
4461 so don't bother counting in HOW_MUCH.
4462 (INSERTED is where we count the number of characters inserted.) */
4469 /* Make the text read part of the buffer. */
4470 GAP_SIZE
-= inserted
;
4472 GPT_BYTE
+= inserted
;
4474 ZV_BYTE
+= inserted
;
4479 /* Put an anchor to ensure multi-byte form ends at gap. */
4484 /* Discard the unwind protect for closing the file. */
4488 error ("IO error reading %s: %s",
4489 SDATA (orig_filename
), emacs_strerror (errno
));
4493 if (! coding_system_decided
)
4495 /* The coding system is not yet decided. Decide it by an
4496 optimized method for handling `coding:' tag.
4498 Note that we can get here only if the buffer was empty
4499 before the insertion. */
4503 if (!NILP (Vcoding_system_for_read
))
4504 val
= Vcoding_system_for_read
;
4507 /* Since we are sure that the current buffer was empty
4508 before the insertion, we can toggle
4509 enable-multibyte-characters directly here without taking
4510 care of marker adjustment and byte combining problem. By
4511 this way, we can run Lisp program safely before decoding
4512 the inserted text. */
4513 Lisp_Object unwind_data
;
4514 int count
= SPECPDL_INDEX ();
4516 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4517 Fcons (current_buffer
->undo_list
,
4518 Fcurrent_buffer ()));
4519 current_buffer
->enable_multibyte_characters
= Qnil
;
4520 current_buffer
->undo_list
= Qt
;
4521 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4523 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4525 val
= call2 (Vset_auto_coding_function
,
4526 filename
, make_number (inserted
));
4531 /* If the coding system is not yet decided, check
4532 file-coding-system-alist. */
4533 Lisp_Object args
[6], coding_systems
;
4535 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4536 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4537 coding_systems
= Ffind_operation_coding_system (6, args
);
4538 if (CONSP (coding_systems
))
4539 val
= XCAR (coding_systems
);
4542 unbind_to (count
, Qnil
);
4543 inserted
= Z_BYTE
- BEG_BYTE
;
4546 /* The following kludgy code is to avoid some compiler bug.
4548 setup_coding_system (val, &coding);
4551 struct coding_system temp_coding
;
4552 setup_coding_system (val
, &temp_coding
);
4553 bcopy (&temp_coding
, &coding
, sizeof coding
);
4555 /* Ensure we set Vlast_coding_system_used. */
4556 set_coding_system
= 1;
4558 if (NILP (current_buffer
->enable_multibyte_characters
)
4560 /* We must suppress all character code conversion except for
4561 end-of-line conversion. */
4562 setup_raw_text_coding_system (&coding
);
4563 coding
.src_multibyte
= 0;
4564 coding
.dst_multibyte
4565 = !NILP (current_buffer
->enable_multibyte_characters
);
4569 /* Can't do this if part of the buffer might be preserved. */
4571 && (coding
.type
== coding_type_no_conversion
4572 || coding
.type
== coding_type_raw_text
))
4574 /* Visiting a file with these coding system makes the buffer
4576 current_buffer
->enable_multibyte_characters
= Qnil
;
4577 coding
.dst_multibyte
= 0;
4580 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4582 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4584 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4586 inserted
= coding
.produced_char
;
4589 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4593 /* Now INSERTED is measured in characters. */
4596 /* Use the conversion type to determine buffer-file-type
4597 (find-buffer-file-type is now used to help determine the
4599 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4600 || coding
.eol_type
== CODING_EOL_LF
)
4601 && ! CODING_REQUIRE_DECODING (&coding
))
4602 current_buffer
->buffer_file_type
= Qt
;
4604 current_buffer
->buffer_file_type
= Qnil
;
4611 if (!EQ (current_buffer
->undo_list
, Qt
))
4612 current_buffer
->undo_list
= Qnil
;
4614 stat (SDATA (filename
), &st
);
4619 current_buffer
->modtime
= st
.st_mtime
;
4620 current_buffer
->filename
= orig_filename
;
4623 SAVE_MODIFF
= MODIFF
;
4624 current_buffer
->auto_save_modified
= MODIFF
;
4625 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4626 #ifdef CLASH_DETECTION
4629 if (!NILP (current_buffer
->file_truename
))
4630 unlock_file (current_buffer
->file_truename
);
4631 unlock_file (filename
);
4633 #endif /* CLASH_DETECTION */
4635 Fsignal (Qfile_error
,
4636 Fcons (build_string ("not a regular file"),
4637 Fcons (orig_filename
, Qnil
)));
4640 if (set_coding_system
)
4641 Vlast_coding_system_used
= coding
.symbol
;
4643 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4645 insval
= call1 (Qafter_insert_file_set_coding
, make_number (inserted
));
4646 if (! NILP (insval
))
4648 CHECK_NUMBER (insval
);
4649 inserted
= XFASTINT (insval
);
4653 /* Decode file format */
4656 int empty_undo_list_p
= 0;
4658 /* If we're anyway going to discard undo information, don't
4659 record it in the first place. The buffer's undo list at this
4660 point is either nil or t when visiting a file. */
4663 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4664 current_buffer
->undo_list
= Qt
;
4667 insval
= call3 (Qformat_decode
,
4668 Qnil
, make_number (inserted
), visit
);
4669 CHECK_NUMBER (insval
);
4670 inserted
= XFASTINT (insval
);
4673 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4676 /* Call after-change hooks for the inserted text, aside from the case
4677 of normal visiting (not with REPLACE), which is done in a new buffer
4678 "before" the buffer is changed. */
4679 if (inserted
> 0 && total
> 0
4680 && (NILP (visit
) || !NILP (replace
)))
4682 signal_after_change (PT
, 0, inserted
);
4683 update_compositions (PT
, PT
, CHECK_BORDER
);
4686 p
= Vafter_insert_file_functions
;
4689 insval
= call1 (XCAR (p
), make_number (inserted
));
4692 CHECK_NUMBER (insval
);
4693 inserted
= XFASTINT (insval
);
4700 && current_buffer
->modtime
== -1)
4702 /* If visiting nonexistent file, return nil. */
4703 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4707 Fsignal (Qquit
, Qnil
);
4709 /* ??? Retval needs to be dealt with in all cases consistently. */
4711 val
= Fcons (orig_filename
,
4712 Fcons (make_number (inserted
),
4715 RETURN_UNGCPRO (unbind_to (count
, val
));
4718 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4719 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4720 Lisp_Object
, Lisp_Object
));
4722 /* If build_annotations switched buffers, switch back to BUF.
4723 Kill the temporary buffer that was selected in the meantime.
4725 Since this kill only the last temporary buffer, some buffers remain
4726 not killed if build_annotations switched buffers more than once.
4730 build_annotations_unwind (buf
)
4735 if (XBUFFER (buf
) == current_buffer
)
4737 tembuf
= Fcurrent_buffer ();
4739 Fkill_buffer (tembuf
);
4743 /* Decide the coding-system to encode the data with. */
4746 choose_write_coding_system (start
, end
, filename
,
4747 append
, visit
, lockname
, coding
)
4748 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4749 struct coding_system
*coding
;
4754 && NILP (Fstring_equal (current_buffer
->filename
,
4755 current_buffer
->auto_save_file_name
)))
4757 /* We use emacs-mule for auto saving... */
4758 setup_coding_system (Qemacs_mule
, coding
);
4759 /* ... but with the special flag to indicate not to strip off
4760 leading code of eight-bit-control chars. */
4762 goto done_setup_coding
;
4764 else if (!NILP (Vcoding_system_for_write
))
4766 val
= Vcoding_system_for_write
;
4767 if (coding_system_require_warning
4768 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4769 /* Confirm that VAL can surely encode the current region. */
4770 val
= call5 (Vselect_safe_coding_system_function
,
4771 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4776 /* If the variable `buffer-file-coding-system' is set locally,
4777 it means that the file was read with some kind of code
4778 conversion or the variable is explicitly set by users. We
4779 had better write it out with the same coding system even if
4780 `enable-multibyte-characters' is nil.
4782 If it is not set locally, we anyway have to convert EOL
4783 format if the default value of `buffer-file-coding-system'
4784 tells that it is not Unix-like (LF only) format. */
4785 int using_default_coding
= 0;
4786 int force_raw_text
= 0;
4788 val
= current_buffer
->buffer_file_coding_system
;
4790 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4793 if (NILP (current_buffer
->enable_multibyte_characters
))
4799 /* Check file-coding-system-alist. */
4800 Lisp_Object args
[7], coding_systems
;
4802 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4803 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4805 coding_systems
= Ffind_operation_coding_system (7, args
);
4806 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4807 val
= XCDR (coding_systems
);
4811 && !NILP (current_buffer
->buffer_file_coding_system
))
4813 /* If we still have not decided a coding system, use the
4814 default value of buffer-file-coding-system. */
4815 val
= current_buffer
->buffer_file_coding_system
;
4816 using_default_coding
= 1;
4820 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4821 /* Confirm that VAL can surely encode the current region. */
4822 val
= call5 (Vselect_safe_coding_system_function
,
4823 start
, end
, val
, Qnil
, filename
);
4825 setup_coding_system (Fcheck_coding_system (val
), coding
);
4826 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4827 && !using_default_coding
)
4829 if (! EQ (default_buffer_file_coding
.symbol
,
4830 buffer_defaults
.buffer_file_coding_system
))
4831 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4832 &default_buffer_file_coding
);
4833 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4835 Lisp_Object subsidiaries
;
4837 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4838 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4839 if (VECTORP (subsidiaries
)
4840 && XVECTOR (subsidiaries
)->size
== 3)
4842 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4847 setup_raw_text_coding_system (coding
);
4848 goto done_setup_coding
;
4851 setup_coding_system (Fcheck_coding_system (val
), coding
);
4854 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4855 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4858 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4859 "r\nFWrite region to file: \ni\ni\ni\np",
4860 doc
: /* Write current region into specified file.
4861 When called from a program, requires three arguments:
4862 START, END and FILENAME. START and END are normally buffer positions
4863 specifying the part of the buffer to write.
4864 If START is nil, that means to use the entire buffer contents.
4865 If START is a string, then output that string to the file
4866 instead of any buffer contents; END is ignored.
4868 Optional fourth argument APPEND if non-nil means
4869 append to existing file contents (if any). If it is an integer,
4870 seek to that offset in the file before writing.
4871 Optional fifth argument VISIT, if t or a string, means
4872 set the last-save-file-modtime of buffer to this file's modtime
4873 and mark buffer not modified.
4874 If VISIT is a string, it is a second file name;
4875 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4876 VISIT is also the file name to lock and unlock for clash detection.
4877 If VISIT is neither t nor nil nor a string,
4878 that means do not display the \"Wrote file\" message.
4879 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4880 use for locking and unlocking, overriding FILENAME and VISIT.
4881 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4882 for an existing file with the same name. If MUSTBENEW is `excl',
4883 that means to get an error if the file already exists; never overwrite.
4884 If MUSTBENEW is neither nil nor `excl', that means ask for
4885 confirmation before overwriting, but do go ahead and overwrite the file
4886 if the user confirms.
4888 This does code conversion according to the value of
4889 `coding-system-for-write', `buffer-file-coding-system', or
4890 `file-coding-system-alist', and sets the variable
4891 `last-coding-system-used' to the coding system actually used. */)
4892 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4893 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4898 const unsigned char *fn
;
4901 int count
= SPECPDL_INDEX ();
4904 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4906 Lisp_Object handler
;
4907 Lisp_Object visit_file
;
4908 Lisp_Object annotations
;
4909 Lisp_Object encoded_filename
;
4910 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4911 int quietly
= !NILP (visit
);
4912 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4913 struct buffer
*given_buffer
;
4915 int buffer_file_type
= O_BINARY
;
4917 struct coding_system coding
;
4919 if (current_buffer
->base_buffer
&& visiting
)
4920 error ("Cannot do file visiting in an indirect buffer");
4922 if (!NILP (start
) && !STRINGP (start
))
4923 validate_region (&start
, &end
);
4925 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4927 filename
= Fexpand_file_name (filename
, Qnil
);
4929 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4930 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4932 if (STRINGP (visit
))
4933 visit_file
= Fexpand_file_name (visit
, Qnil
);
4935 visit_file
= filename
;
4937 if (NILP (lockname
))
4938 lockname
= visit_file
;
4942 /* If the file name has special constructs in it,
4943 call the corresponding file handler. */
4944 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4945 /* If FILENAME has no handler, see if VISIT has one. */
4946 if (NILP (handler
) && STRINGP (visit
))
4947 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4949 if (!NILP (handler
))
4952 val
= call6 (handler
, Qwrite_region
, start
, end
,
4953 filename
, append
, visit
);
4957 SAVE_MODIFF
= MODIFF
;
4958 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4959 current_buffer
->filename
= visit_file
;
4965 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4967 /* Special kludge to simplify auto-saving. */
4970 XSETFASTINT (start
, BEG
);
4971 XSETFASTINT (end
, Z
);
4975 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4976 count1
= SPECPDL_INDEX ();
4978 given_buffer
= current_buffer
;
4980 if (!STRINGP (start
))
4982 annotations
= build_annotations (start
, end
);
4984 if (current_buffer
!= given_buffer
)
4986 XSETFASTINT (start
, BEGV
);
4987 XSETFASTINT (end
, ZV
);
4993 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4995 /* Decide the coding-system to encode the data with.
4996 We used to make this choice before calling build_annotations, but that
4997 leads to problems when a write-annotate-function takes care of
4998 unsavable chars (as was the case with X-Symbol). */
4999 choose_write_coding_system (start
, end
, filename
,
5000 append
, visit
, lockname
, &coding
);
5001 Vlast_coding_system_used
= coding
.symbol
;
5003 given_buffer
= current_buffer
;
5004 if (! STRINGP (start
))
5006 annotations
= build_annotations_2 (start
, end
,
5007 coding
.pre_write_conversion
, annotations
);
5008 if (current_buffer
!= given_buffer
)
5010 XSETFASTINT (start
, BEGV
);
5011 XSETFASTINT (end
, ZV
);
5015 #ifdef CLASH_DETECTION
5018 #if 0 /* This causes trouble for GNUS. */
5019 /* If we've locked this file for some other buffer,
5020 query before proceeding. */
5021 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5022 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5025 lock_file (lockname
);
5027 #endif /* CLASH_DETECTION */
5029 encoded_filename
= ENCODE_FILE (filename
);
5031 fn
= SDATA (encoded_filename
);
5035 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5036 #else /* not DOS_NT */
5037 desc
= emacs_open (fn
, O_WRONLY
, 0);
5038 #endif /* not DOS_NT */
5040 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5042 if (auto_saving
) /* Overwrite any previous version of autosave file */
5044 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5045 desc
= emacs_open (fn
, O_RDWR
, 0);
5047 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5048 ? SDATA (current_buffer
->filename
) : 0,
5051 else /* Write to temporary name and rename if no errors */
5053 Lisp_Object temp_name
;
5054 temp_name
= Ffile_name_directory (filename
);
5056 if (!NILP (temp_name
))
5058 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5059 build_string ("$$SAVE$$")));
5060 fname
= SDATA (filename
);
5061 fn
= SDATA (temp_name
);
5062 desc
= creat_copy_attrs (fname
, fn
);
5065 /* If we can't open the temporary file, try creating a new
5066 version of the original file. VMS "creat" creates a
5067 new version rather than truncating an existing file. */
5070 desc
= creat (fn
, 0666);
5071 #if 0 /* This can clobber an existing file and fail to replace it,
5072 if the user runs out of space. */
5075 /* We can't make a new version;
5076 try to truncate and rewrite existing version if any. */
5078 desc
= emacs_open (fn
, O_RDWR
, 0);
5084 desc
= creat (fn
, 0666);
5088 desc
= emacs_open (fn
,
5089 O_WRONLY
| O_CREAT
| buffer_file_type
5090 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5091 S_IREAD
| S_IWRITE
);
5092 #else /* not DOS_NT */
5093 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5094 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5095 auto_saving
? auto_save_mode_bits
: 0666);
5096 #endif /* not DOS_NT */
5097 #endif /* not VMS */
5101 #ifdef CLASH_DETECTION
5103 if (!auto_saving
) unlock_file (lockname
);
5105 #endif /* CLASH_DETECTION */
5107 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5110 record_unwind_protect (close_file_unwind
, make_number (desc
));
5112 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5116 if (NUMBERP (append
))
5117 ret
= lseek (desc
, XINT (append
), 1);
5119 ret
= lseek (desc
, 0, 2);
5122 #ifdef CLASH_DETECTION
5123 if (!auto_saving
) unlock_file (lockname
);
5124 #endif /* CLASH_DETECTION */
5126 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5134 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5135 * if we do writes that don't end with a carriage return. Furthermore
5136 * it cannot handle writes of more then 16K. The modified
5137 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5138 * this EXCEPT for the last record (iff it doesn't end with a carriage
5139 * return). This implies that if your buffer doesn't end with a carriage
5140 * return, you get one free... tough. However it also means that if
5141 * we make two calls to sys_write (a la the following code) you can
5142 * get one at the gap as well. The easiest way to fix this (honest)
5143 * is to move the gap to the next newline (or the end of the buffer).
5148 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5149 move_gap (find_next_newline (GPT
, 1));
5151 /* Whether VMS or not, we must move the gap to the next of newline
5152 when we must put designation sequences at beginning of line. */
5153 if (INTEGERP (start
)
5154 && coding
.type
== coding_type_iso2022
5155 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5156 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5158 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5159 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5160 move_gap_both (PT
, PT_BYTE
);
5161 SET_PT_BOTH (opoint
, opoint_byte
);
5168 if (STRINGP (start
))
5170 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5171 &annotations
, &coding
);
5174 else if (XINT (start
) != XINT (end
))
5176 tem
= CHAR_TO_BYTE (XINT (start
));
5178 if (XINT (start
) < GPT
)
5180 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5181 min (GPT
, XINT (end
)) - XINT (start
),
5182 &annotations
, &coding
);
5186 if (XINT (end
) > GPT
&& !failure
)
5188 tem
= max (XINT (start
), GPT
);
5189 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5190 &annotations
, &coding
);
5196 /* If file was empty, still need to write the annotations */
5197 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5198 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5202 if (CODING_REQUIRE_FLUSHING (&coding
)
5203 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5206 /* We have to flush out a data. */
5207 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5208 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5215 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5216 Disk full in NFS may be reported here. */
5217 /* mib says that closing the file will try to write as fast as NFS can do
5218 it, and that means the fsync here is not crucial for autosave files. */
5219 if (!auto_saving
&& fsync (desc
) < 0)
5221 /* If fsync fails with EINTR, don't treat that as serious. */
5223 failure
= 1, save_errno
= errno
;
5227 /* Spurious "file has changed on disk" warnings have been
5228 observed on Suns as well.
5229 It seems that `close' can change the modtime, under nfs.
5231 (This has supposedly been fixed in Sunos 4,
5232 but who knows about all the other machines with NFS?) */
5235 /* On VMS and APOLLO, must do the stat after the close
5236 since closing changes the modtime. */
5239 /* Recall that #if defined does not work on VMS. */
5246 /* NFS can report a write failure now. */
5247 if (emacs_close (desc
) < 0)
5248 failure
= 1, save_errno
= errno
;
5251 /* If we wrote to a temporary name and had no errors, rename to real name. */
5255 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5263 /* Discard the unwind protect for close_file_unwind. */
5264 specpdl_ptr
= specpdl
+ count1
;
5265 /* Restore the original current buffer. */
5266 visit_file
= unbind_to (count
, visit_file
);
5268 #ifdef CLASH_DETECTION
5270 unlock_file (lockname
);
5271 #endif /* CLASH_DETECTION */
5273 /* Do this before reporting IO error
5274 to avoid a "file has changed on disk" warning on
5275 next attempt to save. */
5277 current_buffer
->modtime
= st
.st_mtime
;
5280 error ("IO error writing %s: %s", SDATA (filename
),
5281 emacs_strerror (save_errno
));
5285 SAVE_MODIFF
= MODIFF
;
5286 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5287 current_buffer
->filename
= visit_file
;
5288 update_mode_lines
++;
5293 && ! NILP (Fstring_equal (current_buffer
->filename
,
5294 current_buffer
->auto_save_file_name
)))
5295 SAVE_MODIFF
= MODIFF
;
5301 message_with_string ((INTEGERP (append
)
5311 Lisp_Object
merge ();
5313 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5314 doc
: /* Return t if (car A) is numerically less than (car B). */)
5318 return Flss (Fcar (a
), Fcar (b
));
5321 /* Build the complete list of annotations appropriate for writing out
5322 the text between START and END, by calling all the functions in
5323 write-region-annotate-functions and merging the lists they return.
5324 If one of these functions switches to a different buffer, we assume
5325 that buffer contains altered text. Therefore, the caller must
5326 make sure to restore the current buffer in all cases,
5327 as save-excursion would do. */
5330 build_annotations (start
, end
)
5331 Lisp_Object start
, end
;
5333 Lisp_Object annotations
;
5335 struct gcpro gcpro1
, gcpro2
;
5336 Lisp_Object original_buffer
;
5337 int i
, used_global
= 0;
5339 XSETBUFFER (original_buffer
, current_buffer
);
5342 p
= Vwrite_region_annotate_functions
;
5343 GCPRO2 (annotations
, p
);
5346 struct buffer
*given_buffer
= current_buffer
;
5347 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5348 { /* Use the global value of the hook. */
5351 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5353 p
= Fappend (2, arg
);
5356 Vwrite_region_annotations_so_far
= annotations
;
5357 res
= call2 (XCAR (p
), start
, end
);
5358 /* If the function makes a different buffer current,
5359 assume that means this buffer contains altered text to be output.
5360 Reset START and END from the buffer bounds
5361 and discard all previous annotations because they should have
5362 been dealt with by this function. */
5363 if (current_buffer
!= given_buffer
)
5365 XSETFASTINT (start
, BEGV
);
5366 XSETFASTINT (end
, ZV
);
5369 Flength (res
); /* Check basic validity of return value */
5370 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5374 /* Now do the same for annotation functions implied by the file-format */
5375 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5376 p
= Vauto_save_file_format
;
5378 p
= current_buffer
->file_format
;
5379 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5381 struct buffer
*given_buffer
= current_buffer
;
5383 Vwrite_region_annotations_so_far
= annotations
;
5385 /* Value is either a list of annotations or nil if the function
5386 has written annotations to a temporary buffer, which is now
5388 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5389 original_buffer
, make_number (i
));
5390 if (current_buffer
!= given_buffer
)
5392 XSETFASTINT (start
, BEGV
);
5393 XSETFASTINT (end
, ZV
);
5398 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5406 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5407 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5409 struct gcpro gcpro1
;
5412 GCPRO1 (annotations
);
5413 /* At last, do the same for the function PRE_WRITE_CONVERSION
5414 implied by the current coding-system. */
5415 if (!NILP (pre_write_conversion
))
5417 struct buffer
*given_buffer
= current_buffer
;
5418 Vwrite_region_annotations_so_far
= annotations
;
5419 res
= call2 (pre_write_conversion
, start
, end
);
5421 annotations
= (current_buffer
!= given_buffer
5423 : merge (annotations
, res
, Qcar_less_than_car
));
5430 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5431 If STRING is nil, POS is the character position in the current buffer.
5432 Intersperse with them the annotations from *ANNOT
5433 which fall within the range of POS to POS + NCHARS,
5434 each at its appropriate position.
5436 We modify *ANNOT by discarding elements as we use them up.
5438 The return value is negative in case of system call failure. */
5441 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5444 register int nchars
;
5447 struct coding_system
*coding
;
5451 int lastpos
= pos
+ nchars
;
5453 while (NILP (*annot
) || CONSP (*annot
))
5455 tem
= Fcar_safe (Fcar (*annot
));
5458 nextpos
= XFASTINT (tem
);
5460 /* If there are no more annotations in this range,
5461 output the rest of the range all at once. */
5462 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5463 return e_write (desc
, string
, pos
, lastpos
, coding
);
5465 /* Output buffer text up to the next annotation's position. */
5468 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5472 /* Output the annotation. */
5473 tem
= Fcdr (Fcar (*annot
));
5476 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5479 *annot
= Fcdr (*annot
);
5484 #ifndef WRITE_BUF_SIZE
5485 #define WRITE_BUF_SIZE (16 * 1024)
5488 /* Write text in the range START and END into descriptor DESC,
5489 encoding them with coding system CODING. If STRING is nil, START
5490 and END are character positions of the current buffer, else they
5491 are indexes to the string STRING. */
5494 e_write (desc
, string
, start
, end
, coding
)
5498 struct coding_system
*coding
;
5500 register char *addr
;
5501 register int nbytes
;
5502 char buf
[WRITE_BUF_SIZE
];
5506 coding
->composing
= COMPOSITION_DISABLED
;
5507 if (coding
->composing
!= COMPOSITION_DISABLED
)
5508 coding_save_composition (coding
, start
, end
, string
);
5510 if (STRINGP (string
))
5512 addr
= SDATA (string
);
5513 nbytes
= SBYTES (string
);
5514 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5516 else if (start
< end
)
5518 /* It is assured that the gap is not in the range START and END-1. */
5519 addr
= CHAR_POS_ADDR (start
);
5520 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5521 coding
->src_multibyte
5522 = !NILP (current_buffer
->enable_multibyte_characters
);
5528 coding
->src_multibyte
= 1;
5531 /* We used to have a code for handling selective display here. But,
5532 now it is handled within encode_coding. */
5537 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5538 if (coding
->produced
> 0)
5540 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5541 if (coding
->produced
)
5547 nbytes
-= coding
->consumed
;
5548 addr
+= coding
->consumed
;
5549 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5552 /* The source text ends by an incomplete multibyte form.
5553 There's no way other than write it out as is. */
5554 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5563 start
+= coding
->consumed_char
;
5564 if (coding
->cmp_data
)
5565 coding_adjust_composition_offset (coding
, start
);
5568 if (coding
->cmp_data
)
5569 coding_free_composition_data (coding
);
5574 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5575 Sverify_visited_file_modtime
, 1, 1, 0,
5576 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5577 This means that the file has not been changed since it was visited or saved.
5578 See Info node `(elisp)Modification Time' for more details. */)
5584 Lisp_Object handler
;
5585 Lisp_Object filename
;
5590 if (!STRINGP (b
->filename
)) return Qt
;
5591 if (b
->modtime
== 0) return Qt
;
5593 /* If the file name has special constructs in it,
5594 call the corresponding file handler. */
5595 handler
= Ffind_file_name_handler (b
->filename
,
5596 Qverify_visited_file_modtime
);
5597 if (!NILP (handler
))
5598 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5600 filename
= ENCODE_FILE (b
->filename
);
5602 if (stat (SDATA (filename
), &st
) < 0)
5604 /* If the file doesn't exist now and didn't exist before,
5605 we say that it isn't modified, provided the error is a tame one. */
5606 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5611 if (st
.st_mtime
== b
->modtime
5612 /* If both are positive, accept them if they are off by one second. */
5613 || (st
.st_mtime
> 0 && b
->modtime
> 0
5614 && (st
.st_mtime
== b
->modtime
+ 1
5615 || st
.st_mtime
== b
->modtime
- 1)))
5620 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5621 Sclear_visited_file_modtime
, 0, 0, 0,
5622 doc
: /* Clear out records of last mod time of visited file.
5623 Next attempt to save will certainly not complain of a discrepancy. */)
5626 current_buffer
->modtime
= 0;
5630 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5631 Svisited_file_modtime
, 0, 0, 0,
5632 doc
: /* Return the current buffer's recorded visited file modification time.
5633 The value is a list of the form (HIGH LOW), like the time values
5634 that `file-attributes' returns. If the current buffer has no recorded
5635 file modification time, this function returns 0.
5636 See Info node `(elisp)Modification Time' for more details. */)
5640 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5642 return list2 (XCAR (tcons
), XCDR (tcons
));
5646 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5647 Sset_visited_file_modtime
, 0, 1, 0,
5648 doc
: /* Update buffer's recorded modification time from the visited file's time.
5649 Useful if the buffer was not read from the file normally
5650 or if the file itself has been changed for some known benign reason.
5651 An argument specifies the modification time value to use
5652 \(instead of that of the visited file), in the form of a list
5653 \(HIGH . LOW) or (HIGH LOW). */)
5655 Lisp_Object time_list
;
5657 if (!NILP (time_list
))
5658 current_buffer
->modtime
= cons_to_long (time_list
);
5661 register Lisp_Object filename
;
5663 Lisp_Object handler
;
5665 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5667 /* If the file name has special constructs in it,
5668 call the corresponding file handler. */
5669 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5670 if (!NILP (handler
))
5671 /* The handler can find the file name the same way we did. */
5672 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5674 filename
= ENCODE_FILE (filename
);
5676 if (stat (SDATA (filename
), &st
) >= 0)
5677 current_buffer
->modtime
= st
.st_mtime
;
5684 auto_save_error (error
)
5687 Lisp_Object args
[3], msg
;
5689 struct gcpro gcpro1
;
5693 args
[0] = build_string ("Auto-saving %s: %s");
5694 args
[1] = current_buffer
->name
;
5695 args
[2] = Ferror_message_string (error
);
5696 msg
= Fformat (3, args
);
5698 nbytes
= SBYTES (msg
);
5700 for (i
= 0; i
< 3; ++i
)
5703 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5705 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5706 Fsleep_for (make_number (1), Qnil
);
5718 /* Get visited file's mode to become the auto save file's mode. */
5719 if (! NILP (current_buffer
->filename
)
5720 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5721 /* But make sure we can overwrite it later! */
5722 auto_save_mode_bits
= st
.st_mode
| 0600;
5724 auto_save_mode_bits
= 0666;
5727 Fwrite_region (Qnil
, Qnil
,
5728 current_buffer
->auto_save_file_name
,
5729 Qnil
, Qlambda
, Qnil
, Qnil
);
5733 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5738 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5739 | XFASTINT (XCDR (stream
))));
5744 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5747 minibuffer_auto_raise
= XINT (value
);
5752 do_auto_save_make_dir (dir
)
5755 return call2 (Qmake_directory
, dir
, Qt
);
5759 do_auto_save_eh (ignore
)
5765 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5766 doc
: /* Auto-save all buffers that need it.
5767 This is all buffers that have auto-saving enabled
5768 and are changed since last auto-saved.
5769 Auto-saving writes the buffer into a file
5770 so that your editing is not lost if the system crashes.
5771 This file is not the file you visited; that changes only when you save.
5772 Normally we run the normal hook `auto-save-hook' before saving.
5774 A non-nil NO-MESSAGE argument means do not print any message if successful.
5775 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5776 (no_message
, current_only
)
5777 Lisp_Object no_message
, current_only
;
5779 struct buffer
*old
= current_buffer
, *b
;
5780 Lisp_Object tail
, buf
;
5782 int do_handled_files
;
5785 Lisp_Object lispstream
;
5786 int count
= SPECPDL_INDEX ();
5787 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5788 int old_message_p
= 0;
5789 struct gcpro gcpro1
, gcpro2
;
5791 if (max_specpdl_size
< specpdl_size
+ 40)
5792 max_specpdl_size
= specpdl_size
+ 40;
5797 if (NILP (no_message
))
5799 old_message_p
= push_message ();
5800 record_unwind_protect (pop_message_unwind
, Qnil
);
5803 /* Ordinarily don't quit within this function,
5804 but don't make it impossible to quit (in case we get hung in I/O). */
5808 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5809 point to non-strings reached from Vbuffer_alist. */
5811 if (!NILP (Vrun_hooks
))
5812 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5814 if (STRINGP (Vauto_save_list_file_name
))
5816 Lisp_Object listfile
;
5818 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5820 /* Don't try to create the directory when shutting down Emacs,
5821 because creating the directory might signal an error, and
5822 that would leave Emacs in a strange state. */
5823 if (!NILP (Vrun_hooks
))
5827 GCPRO2 (dir
, listfile
);
5828 dir
= Ffile_name_directory (listfile
);
5829 if (NILP (Ffile_directory_p (dir
)))
5830 internal_condition_case_1 (do_auto_save_make_dir
,
5831 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5836 stream
= fopen (SDATA (listfile
), "w");
5839 /* Arrange to close that file whether or not we get an error.
5840 Also reset auto_saving to 0. */
5841 lispstream
= Fcons (Qnil
, Qnil
);
5842 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5843 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5854 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5855 record_unwind_protect (do_auto_save_unwind_1
,
5856 make_number (minibuffer_auto_raise
));
5857 minibuffer_auto_raise
= 0;
5860 /* On first pass, save all files that don't have handlers.
5861 On second pass, save all files that do have handlers.
5863 If Emacs is crashing, the handlers may tweak what is causing
5864 Emacs to crash in the first place, and it would be a shame if
5865 Emacs failed to autosave perfectly ordinary files because it
5866 couldn't handle some ange-ftp'd file. */
5868 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5869 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5871 buf
= XCDR (XCAR (tail
));
5874 /* Record all the buffers that have auto save mode
5875 in the special file that lists them. For each of these buffers,
5876 Record visited name (if any) and auto save name. */
5877 if (STRINGP (b
->auto_save_file_name
)
5878 && stream
!= NULL
&& do_handled_files
== 0)
5880 if (!NILP (b
->filename
))
5882 fwrite (SDATA (b
->filename
), 1,
5883 SBYTES (b
->filename
), stream
);
5885 putc ('\n', stream
);
5886 fwrite (SDATA (b
->auto_save_file_name
), 1,
5887 SBYTES (b
->auto_save_file_name
), stream
);
5888 putc ('\n', stream
);
5891 if (!NILP (current_only
)
5892 && b
!= current_buffer
)
5895 /* Don't auto-save indirect buffers.
5896 The base buffer takes care of it. */
5900 /* Check for auto save enabled
5901 and file changed since last auto save
5902 and file changed since last real save. */
5903 if (STRINGP (b
->auto_save_file_name
)
5904 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5905 && b
->auto_save_modified
< BUF_MODIFF (b
)
5906 /* -1 means we've turned off autosaving for a while--see below. */
5907 && XINT (b
->save_length
) >= 0
5908 && (do_handled_files
5909 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5912 EMACS_TIME before_time
, after_time
;
5914 EMACS_GET_TIME (before_time
);
5916 /* If we had a failure, don't try again for 20 minutes. */
5917 if (b
->auto_save_failure_time
>= 0
5918 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5921 if ((XFASTINT (b
->save_length
) * 10
5922 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5923 /* A short file is likely to change a large fraction;
5924 spare the user annoying messages. */
5925 && XFASTINT (b
->save_length
) > 5000
5926 /* These messages are frequent and annoying for `*mail*'. */
5927 && !EQ (b
->filename
, Qnil
)
5928 && NILP (no_message
))
5930 /* It has shrunk too much; turn off auto-saving here. */
5931 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5932 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5934 minibuffer_auto_raise
= 0;
5935 /* Turn off auto-saving until there's a real save,
5936 and prevent any more warnings. */
5937 XSETINT (b
->save_length
, -1);
5938 Fsleep_for (make_number (1), Qnil
);
5941 set_buffer_internal (b
);
5942 if (!auto_saved
&& NILP (no_message
))
5943 message1 ("Auto-saving...");
5944 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5946 b
->auto_save_modified
= BUF_MODIFF (b
);
5947 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5948 set_buffer_internal (old
);
5950 EMACS_GET_TIME (after_time
);
5952 /* If auto-save took more than 60 seconds,
5953 assume it was an NFS failure that got a timeout. */
5954 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5955 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5959 /* Prevent another auto save till enough input events come in. */
5960 record_auto_save ();
5962 if (auto_saved
&& NILP (no_message
))
5966 /* If we are going to restore an old message,
5967 give time to read ours. */
5968 sit_for (1, 0, 0, 0, 0);
5972 /* If we displayed a message and then restored a state
5973 with no message, leave a "done" message on the screen. */
5974 message1 ("Auto-saving...done");
5979 /* This restores the message-stack status. */
5980 unbind_to (count
, Qnil
);
5984 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5985 Sset_buffer_auto_saved
, 0, 0, 0,
5986 doc
: /* Mark current buffer as auto-saved with its current text.
5987 No auto-save file will be written until the buffer changes again. */)
5990 current_buffer
->auto_save_modified
= MODIFF
;
5991 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5992 current_buffer
->auto_save_failure_time
= -1;
5996 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5997 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5998 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6001 current_buffer
->auto_save_failure_time
= -1;
6005 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6007 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
6010 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6013 /* Reading and completing file names */
6014 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6016 /* In the string VAL, change each $ to $$ and return the result. */
6019 double_dollars (val
)
6022 register const unsigned char *old
;
6023 register unsigned char *new;
6027 osize
= SBYTES (val
);
6029 /* Count the number of $ characters. */
6030 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6031 if (*old
++ == '$') count
++;
6035 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6038 for (n
= osize
; n
> 0; n
--)
6052 read_file_name_cleanup (arg
)
6055 return (current_buffer
->directory
= arg
);
6058 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6060 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6061 (string
, dir
, action
)
6062 Lisp_Object string
, dir
, action
;
6063 /* action is nil for complete, t for return list of completions,
6064 lambda for verify final value */
6066 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6068 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6070 CHECK_STRING (string
);
6077 /* No need to protect ACTION--we only compare it with t and nil. */
6078 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6080 if (SCHARS (string
) == 0)
6082 if (EQ (action
, Qlambda
))
6090 orig_string
= string
;
6091 string
= Fsubstitute_in_file_name (string
);
6092 changed
= NILP (Fstring_equal (string
, orig_string
));
6093 name
= Ffile_name_nondirectory (string
);
6094 val
= Ffile_name_directory (string
);
6096 realdir
= Fexpand_file_name (val
, realdir
);
6101 specdir
= Ffile_name_directory (string
);
6102 val
= Ffile_name_completion (name
, realdir
);
6107 return double_dollars (string
);
6111 if (!NILP (specdir
))
6112 val
= concat2 (specdir
, val
);
6114 return double_dollars (val
);
6117 #endif /* not VMS */
6121 if (EQ (action
, Qt
))
6123 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6127 if (NILP (Vread_file_name_predicate
)
6128 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6132 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6134 /* Brute-force speed up for directory checking:
6135 Discard strings which don't end in a slash. */
6136 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6138 Lisp_Object tem
= XCAR (all
);
6140 if (STRINGP (tem
) &&
6141 (len
= SCHARS (tem
), len
> 0) &&
6142 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6143 comp
= Fcons (tem
, comp
);
6149 /* Must do it the hard (and slow) way. */
6150 GCPRO3 (all
, comp
, specdir
);
6151 count
= SPECPDL_INDEX ();
6152 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6153 current_buffer
->directory
= realdir
;
6154 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6155 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6156 comp
= Fcons (XCAR (all
), comp
);
6157 unbind_to (count
, Qnil
);
6160 return Fnreverse (comp
);
6163 /* Only other case actually used is ACTION = lambda */
6165 /* Supposedly this helps commands such as `cd' that read directory names,
6166 but can someone explain how it helps them? -- RMS */
6167 if (SCHARS (name
) == 0)
6170 string
= Fexpand_file_name (string
, dir
);
6171 if (!NILP (Vread_file_name_predicate
))
6172 return call1 (Vread_file_name_predicate
, string
);
6173 return Ffile_exists_p (string
);
6176 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6177 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6178 Value is not expanded---you must call `expand-file-name' yourself.
6179 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6180 the same non-empty string that was inserted by this function.
6181 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6182 except that if INITIAL is specified, that combined with DIR is used.)
6183 If the user exits with an empty minibuffer, this function returns
6184 an empty string. (This can only happen if the user erased the
6185 pre-inserted contents or if `insert-default-directory' is nil.)
6186 Fourth arg MUSTMATCH non-nil means require existing file's name.
6187 Non-nil and non-t means also require confirmation after completion.
6188 Fifth arg INITIAL specifies text to start with.
6189 If optional sixth arg PREDICATE is non-nil, possible completions and
6190 the resulting file name must satisfy (funcall PREDICATE NAME).
6191 DIR should be an absolute directory name. It defaults to the value of
6192 `default-directory'.
6194 If this command was invoked with the mouse, use a file dialog box if
6195 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6196 provides a file dialog box. */)
6197 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6198 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6200 Lisp_Object val
, insdef
, tem
;
6201 struct gcpro gcpro1
, gcpro2
;
6202 register char *homedir
;
6203 Lisp_Object decoded_homedir
;
6204 int replace_in_history
= 0;
6205 int add_to_history
= 0;
6209 dir
= current_buffer
->directory
;
6210 if (NILP (Ffile_name_absolute_p (dir
)))
6211 dir
= Fexpand_file_name (dir
, Qnil
);
6212 if (NILP (default_filename
))
6215 ? Fexpand_file_name (initial
, dir
)
6216 : current_buffer
->filename
);
6218 /* If dir starts with user's homedir, change that to ~. */
6219 homedir
= (char *) egetenv ("HOME");
6221 /* homedir can be NULL in temacs, since Vprocess_environment is not
6222 yet set up. We shouldn't crash in that case. */
6225 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6226 CORRECT_DIR_SEPS (homedir
);
6231 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6234 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6235 SBYTES (decoded_homedir
))
6236 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6238 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6239 dir
= concat2 (build_string ("~"), dir
);
6241 /* Likewise for default_filename. */
6243 && STRINGP (default_filename
)
6244 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6245 SBYTES (decoded_homedir
))
6246 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6249 = Fsubstring (default_filename
,
6250 make_number (SCHARS (decoded_homedir
)), Qnil
);
6251 default_filename
= concat2 (build_string ("~"), default_filename
);
6253 if (!NILP (default_filename
))
6255 CHECK_STRING (default_filename
);
6256 default_filename
= double_dollars (default_filename
);
6259 if (insert_default_directory
&& STRINGP (dir
))
6262 if (!NILP (initial
))
6264 Lisp_Object args
[2], pos
;
6268 insdef
= Fconcat (2, args
);
6269 pos
= make_number (SCHARS (double_dollars (dir
)));
6270 insdef
= Fcons (double_dollars (insdef
), pos
);
6273 insdef
= double_dollars (insdef
);
6275 else if (STRINGP (initial
))
6276 insdef
= Fcons (double_dollars (initial
), make_number (0));
6280 if (!NILP (Vread_file_name_function
))
6282 Lisp_Object args
[7];
6284 GCPRO2 (insdef
, default_filename
);
6285 args
[0] = Vread_file_name_function
;
6288 args
[3] = default_filename
;
6289 args
[4] = mustmatch
;
6291 args
[6] = predicate
;
6292 RETURN_UNGCPRO (Ffuncall (7, args
));
6295 count
= SPECPDL_INDEX ();
6296 specbind (intern ("completion-ignore-case"),
6297 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6298 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6299 specbind (intern ("read-file-name-predicate"),
6300 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6302 GCPRO2 (insdef
, default_filename
);
6304 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
6305 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6310 /* If DIR contains a file name, split it. */
6312 file
= Ffile_name_nondirectory (dir
);
6313 if (SCHARS (file
) && NILP (default_filename
))
6315 default_filename
= file
;
6316 dir
= Ffile_name_directory (dir
);
6318 if (!NILP(default_filename
))
6319 default_filename
= Fexpand_file_name (default_filename
, dir
);
6320 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6325 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6326 dir
, mustmatch
, insdef
,
6327 Qfile_name_history
, default_filename
, Qnil
);
6329 tem
= Fsymbol_value (Qfile_name_history
);
6330 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6331 replace_in_history
= 1;
6333 /* If Fcompleting_read returned the inserted default string itself
6334 (rather than a new string with the same contents),
6335 it has to mean that the user typed RET with the minibuffer empty.
6336 In that case, we really want to return ""
6337 so that commands such as set-visited-file-name can distinguish. */
6338 if (EQ (val
, default_filename
))
6340 /* In this case, Fcompleting_read has not added an element
6341 to the history. Maybe we should. */
6342 if (! replace_in_history
)
6348 unbind_to (count
, Qnil
);
6351 error ("No file name specified");
6353 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6355 if (!NILP (tem
) && !NILP (default_filename
))
6356 val
= default_filename
;
6357 val
= Fsubstitute_in_file_name (val
);
6359 if (replace_in_history
)
6360 /* Replace what Fcompleting_read added to the history
6361 with what we will actually return. */
6362 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6363 else if (add_to_history
)
6365 /* Add the value to the history--but not if it matches
6366 the last value already there. */
6367 Lisp_Object val1
= double_dollars (val
);
6368 tem
= Fsymbol_value (Qfile_name_history
);
6369 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6370 Fset (Qfile_name_history
,
6381 /* Must be set before any path manipulation is performed. */
6382 XSETFASTINT (Vdirectory_sep_char
, '/');
6389 Qexpand_file_name
= intern ("expand-file-name");
6390 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6391 Qdirectory_file_name
= intern ("directory-file-name");
6392 Qfile_name_directory
= intern ("file-name-directory");
6393 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6394 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6395 Qfile_name_as_directory
= intern ("file-name-as-directory");
6396 Qcopy_file
= intern ("copy-file");
6397 Qmake_directory_internal
= intern ("make-directory-internal");
6398 Qmake_directory
= intern ("make-directory");
6399 Qdelete_directory
= intern ("delete-directory");
6400 Qdelete_file
= intern ("delete-file");
6401 Qrename_file
= intern ("rename-file");
6402 Qadd_name_to_file
= intern ("add-name-to-file");
6403 Qmake_symbolic_link
= intern ("make-symbolic-link");
6404 Qfile_exists_p
= intern ("file-exists-p");
6405 Qfile_executable_p
= intern ("file-executable-p");
6406 Qfile_readable_p
= intern ("file-readable-p");
6407 Qfile_writable_p
= intern ("file-writable-p");
6408 Qfile_symlink_p
= intern ("file-symlink-p");
6409 Qaccess_file
= intern ("access-file");
6410 Qfile_directory_p
= intern ("file-directory-p");
6411 Qfile_regular_p
= intern ("file-regular-p");
6412 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6413 Qfile_modes
= intern ("file-modes");
6414 Qset_file_modes
= intern ("set-file-modes");
6415 Qset_file_times
= intern ("set-file-times");
6416 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6417 Qinsert_file_contents
= intern ("insert-file-contents");
6418 Qwrite_region
= intern ("write-region");
6419 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6420 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6421 Qauto_save_coding
= intern ("auto-save-coding");
6423 staticpro (&Qexpand_file_name
);
6424 staticpro (&Qsubstitute_in_file_name
);
6425 staticpro (&Qdirectory_file_name
);
6426 staticpro (&Qfile_name_directory
);
6427 staticpro (&Qfile_name_nondirectory
);
6428 staticpro (&Qunhandled_file_name_directory
);
6429 staticpro (&Qfile_name_as_directory
);
6430 staticpro (&Qcopy_file
);
6431 staticpro (&Qmake_directory_internal
);
6432 staticpro (&Qmake_directory
);
6433 staticpro (&Qdelete_directory
);
6434 staticpro (&Qdelete_file
);
6435 staticpro (&Qrename_file
);
6436 staticpro (&Qadd_name_to_file
);
6437 staticpro (&Qmake_symbolic_link
);
6438 staticpro (&Qfile_exists_p
);
6439 staticpro (&Qfile_executable_p
);
6440 staticpro (&Qfile_readable_p
);
6441 staticpro (&Qfile_writable_p
);
6442 staticpro (&Qaccess_file
);
6443 staticpro (&Qfile_symlink_p
);
6444 staticpro (&Qfile_directory_p
);
6445 staticpro (&Qfile_regular_p
);
6446 staticpro (&Qfile_accessible_directory_p
);
6447 staticpro (&Qfile_modes
);
6448 staticpro (&Qset_file_modes
);
6449 staticpro (&Qset_file_times
);
6450 staticpro (&Qfile_newer_than_file_p
);
6451 staticpro (&Qinsert_file_contents
);
6452 staticpro (&Qwrite_region
);
6453 staticpro (&Qverify_visited_file_modtime
);
6454 staticpro (&Qset_visited_file_modtime
);
6455 staticpro (&Qauto_save_coding
);
6457 Qfile_name_history
= intern ("file-name-history");
6458 Fset (Qfile_name_history
, Qnil
);
6459 staticpro (&Qfile_name_history
);
6461 Qfile_error
= intern ("file-error");
6462 staticpro (&Qfile_error
);
6463 Qfile_already_exists
= intern ("file-already-exists");
6464 staticpro (&Qfile_already_exists
);
6465 Qfile_date_error
= intern ("file-date-error");
6466 staticpro (&Qfile_date_error
);
6467 Qexcl
= intern ("excl");
6471 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6472 staticpro (&Qfind_buffer_file_type
);
6475 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6476 doc
: /* *Coding system for encoding file names.
6477 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6478 Vfile_name_coding_system
= Qnil
;
6480 DEFVAR_LISP ("default-file-name-coding-system",
6481 &Vdefault_file_name_coding_system
,
6482 doc
: /* Default coding system for encoding file names.
6483 This variable is used only when `file-name-coding-system' is nil.
6485 This variable is set/changed by the command `set-language-environment'.
6486 User should not set this variable manually,
6487 instead use `file-name-coding-system' to get a constant encoding
6488 of file names regardless of the current language environment. */);
6489 Vdefault_file_name_coding_system
= Qnil
;
6491 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6492 doc
: /* *Format in which to write auto-save files.
6493 Should be a list of symbols naming formats that are defined in `format-alist'.
6494 If it is t, which is the default, auto-save files are written in the
6495 same format as a regular save would use. */);
6496 Vauto_save_file_format
= Qt
;
6498 Qformat_decode
= intern ("format-decode");
6499 staticpro (&Qformat_decode
);
6500 Qformat_annotate_function
= intern ("format-annotate-function");
6501 staticpro (&Qformat_annotate_function
);
6502 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6503 staticpro (&Qafter_insert_file_set_coding
);
6505 Qcar_less_than_car
= intern ("car-less-than-car");
6506 staticpro (&Qcar_less_than_car
);
6508 Fput (Qfile_error
, Qerror_conditions
,
6509 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6510 Fput (Qfile_error
, Qerror_message
,
6511 build_string ("File error"));
6513 Fput (Qfile_already_exists
, Qerror_conditions
,
6514 Fcons (Qfile_already_exists
,
6515 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6516 Fput (Qfile_already_exists
, Qerror_message
,
6517 build_string ("File already exists"));
6519 Fput (Qfile_date_error
, Qerror_conditions
,
6520 Fcons (Qfile_date_error
,
6521 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6522 Fput (Qfile_date_error
, Qerror_message
,
6523 build_string ("Cannot set file date"));
6525 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6526 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6527 Vread_file_name_function
= Qnil
;
6529 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6530 doc
: /* Current predicate used by `read-file-name-internal'. */);
6531 Vread_file_name_predicate
= Qnil
;
6533 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6534 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6535 #if defined VMS || defined DOS_NT || defined MAC_OS
6536 read_file_name_completion_ignore_case
= 1;
6538 read_file_name_completion_ignore_case
= 0;
6541 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6542 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6543 If the initial minibuffer contents are non-empty, you can usually
6544 request a default filename by typing RETURN without editing. For some
6545 commands, exiting with an empty minibuffer has a special meaning,
6546 such as making the current buffer visit no file in the case of
6547 `set-visited-file-name'.
6548 If this variable is non-nil, the minibuffer contents are always
6549 initially non-empty and typing RETURN without editing will fetch the
6550 default name, if one is provided. Note however that this default name
6551 is not necessarily the name originally inserted in the minibuffer, if
6552 that is just the default directory.
6553 If this variable is nil, the minibuffer often starts out empty. In
6554 that case you may have to explicitly fetch the next history element to
6555 request the default name. */);
6556 insert_default_directory
= 1;
6558 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6559 doc
: /* *Non-nil means write new files with record format `stmlf'.
6560 nil means use format `var'. This variable is meaningful only on VMS. */);
6561 vms_stmlf_recfm
= 0;
6563 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6564 doc
: /* Directory separator character for built-in functions that return file names.
6565 The value is always ?/. Don't use this variable, just use `/'. */);
6567 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6568 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6569 If a file name matches REGEXP, then all I/O on that file is done by calling
6572 The first argument given to HANDLER is the name of the I/O primitive
6573 to be handled; the remaining arguments are the arguments that were
6574 passed to that primitive. For example, if you do
6575 (file-exists-p FILENAME)
6576 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6577 (funcall HANDLER 'file-exists-p FILENAME)
6578 The function `find-file-name-handler' checks this list for a handler
6579 for its argument. */);
6580 Vfile_name_handler_alist
= Qnil
;
6582 DEFVAR_LISP ("set-auto-coding-function",
6583 &Vset_auto_coding_function
,
6584 doc
: /* If non-nil, a function to call to decide a coding system of file.
6585 Two arguments are passed to this function: the file name
6586 and the length of a file contents following the point.
6587 This function should return a coding system to decode the file contents.
6588 It should check the file name against `auto-coding-alist'.
6589 If no coding system is decided, it should check a coding system
6590 specified in the heading lines with the format:
6591 -*- ... coding: CODING-SYSTEM; ... -*-
6592 or local variable spec of the tailing lines with `coding:' tag. */);
6593 Vset_auto_coding_function
= Qnil
;
6595 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6596 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6597 Each is passed one argument, the number of characters inserted.
6598 It should return the new character count, and leave point the same.
6599 If `insert-file-contents' is intercepted by a handler from
6600 `file-name-handler-alist', that handler is responsible for calling the
6601 functions in `after-insert-file-functions' if appropriate. */);
6602 Vafter_insert_file_functions
= Qnil
;
6604 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6605 doc
: /* A list of functions to be called at the start of `write-region'.
6606 Each is passed two arguments, START and END as for `write-region'.
6607 These are usually two numbers but not always; see the documentation
6608 for `write-region'. The function should return a list of pairs
6609 of the form (POSITION . STRING), consisting of strings to be effectively
6610 inserted at the specified positions of the file being written (1 means to
6611 insert before the first byte written). The POSITIONs must be sorted into
6612 increasing order. If there are several functions in the list, the several
6613 lists are merged destructively. Alternatively, the function can return
6614 with a different buffer current; in that case it should pay attention
6615 to the annotations returned by previous functions and listed in
6616 `write-region-annotations-so-far'.*/);
6617 Vwrite_region_annotate_functions
= Qnil
;
6618 staticpro (&Qwrite_region_annotate_functions
);
6619 Qwrite_region_annotate_functions
6620 = intern ("write-region-annotate-functions");
6622 DEFVAR_LISP ("write-region-annotations-so-far",
6623 &Vwrite_region_annotations_so_far
,
6624 doc
: /* When an annotation function is called, this holds the previous annotations.
6625 These are the annotations made by other annotation functions
6626 that were already called. See also `write-region-annotate-functions'. */);
6627 Vwrite_region_annotations_so_far
= Qnil
;
6629 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6630 doc
: /* A list of file name handlers that temporarily should not be used.
6631 This applies only to the operation `inhibit-file-name-operation'. */);
6632 Vinhibit_file_name_handlers
= Qnil
;
6634 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6635 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6636 Vinhibit_file_name_operation
= Qnil
;
6638 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6639 doc
: /* File name in which we write a list of all auto save file names.
6640 This variable is initialized automatically from `auto-save-list-file-prefix'
6641 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6642 a non-nil value. */);
6643 Vauto_save_list_file_name
= Qnil
;
6645 defsubr (&Sfind_file_name_handler
);
6646 defsubr (&Sfile_name_directory
);
6647 defsubr (&Sfile_name_nondirectory
);
6648 defsubr (&Sunhandled_file_name_directory
);
6649 defsubr (&Sfile_name_as_directory
);
6650 defsubr (&Sdirectory_file_name
);
6651 defsubr (&Smake_temp_name
);
6652 defsubr (&Sexpand_file_name
);
6653 defsubr (&Ssubstitute_in_file_name
);
6654 defsubr (&Scopy_file
);
6655 defsubr (&Smake_directory_internal
);
6656 defsubr (&Sdelete_directory
);
6657 defsubr (&Sdelete_file
);
6658 defsubr (&Srename_file
);
6659 defsubr (&Sadd_name_to_file
);
6661 defsubr (&Smake_symbolic_link
);
6662 #endif /* S_IFLNK */
6664 defsubr (&Sdefine_logical_name
);
6667 defsubr (&Ssysnetunam
);
6668 #endif /* HPUX_NET */
6669 defsubr (&Sfile_name_absolute_p
);
6670 defsubr (&Sfile_exists_p
);
6671 defsubr (&Sfile_executable_p
);
6672 defsubr (&Sfile_readable_p
);
6673 defsubr (&Sfile_writable_p
);
6674 defsubr (&Saccess_file
);
6675 defsubr (&Sfile_symlink_p
);
6676 defsubr (&Sfile_directory_p
);
6677 defsubr (&Sfile_accessible_directory_p
);
6678 defsubr (&Sfile_regular_p
);
6679 defsubr (&Sfile_modes
);
6680 defsubr (&Sset_file_modes
);
6681 defsubr (&Sset_file_times
);
6682 defsubr (&Sset_default_file_modes
);
6683 defsubr (&Sdefault_file_modes
);
6684 defsubr (&Sfile_newer_than_file_p
);
6685 defsubr (&Sinsert_file_contents
);
6686 defsubr (&Swrite_region
);
6687 defsubr (&Scar_less_than_car
);
6688 defsubr (&Sverify_visited_file_modtime
);
6689 defsubr (&Sclear_visited_file_modtime
);
6690 defsubr (&Svisited_file_modtime
);
6691 defsubr (&Sset_visited_file_modtime
);
6692 defsubr (&Sdo_auto_save
);
6693 defsubr (&Sset_buffer_auto_saved
);
6694 defsubr (&Sclear_buffer_auto_save_failure
);
6695 defsubr (&Srecent_auto_save_p
);
6697 defsubr (&Sread_file_name_internal
);
6698 defsubr (&Sread_file_name
);
6701 defsubr (&Sunix_sync
);
6705 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6706 (do not change this comment) */