1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000,01,2003
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
29 #include <sys/types.h>
36 #if !defined (S_ISLNK) && defined (S_IFLNK)
37 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
40 #if !defined (S_ISFIFO) && defined (S_IFIFO)
41 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
44 #if !defined (S_ISREG) && defined (S_IFREG)
45 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
76 #include "intervals.h"
82 #include "dispextern.h"
89 #endif /* not WINDOWSNT */
93 #include <sys/param.h>
101 #define CORRECT_DIR_SEPS(s) \
102 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
103 else unixtodos_filename (s); \
105 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
106 redirector allows the six letters between 'Z' and 'a' as well. */
108 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
111 #define IS_DRIVE(x) isalpha (x)
113 /* Need to lower-case the drive letter, or else expanded
114 filenames will sometimes compare inequal, because
115 `expand-file-name' doesn't always down-case the drive letter. */
116 #define DRIVE_LETTER(x) (tolower (x))
137 #include "commands.h"
138 extern int use_dialog_box
;
139 extern int use_file_dialog
;
153 /* Nonzero during writing of auto-save files */
156 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
157 a new file with the same mode as the original */
158 int auto_save_mode_bits
;
160 /* The symbol bound to coding-system-for-read when
161 insert-file-contents is called for recovering a file. This is not
162 an actual coding system name, but just an indicator to tell
163 insert-file-contents to use `emacs-mule' with a special flag for
164 auto saving and recovering a file. */
165 Lisp_Object Qauto_save_coding
;
167 /* Coding system for file names, or nil if none. */
168 Lisp_Object Vfile_name_coding_system
;
170 /* Coding system for file names used only when
171 Vfile_name_coding_system is nil. */
172 Lisp_Object Vdefault_file_name_coding_system
;
174 /* Alist of elements (REGEXP . HANDLER) for file names
175 whose I/O is done with a special handler. */
176 Lisp_Object Vfile_name_handler_alist
;
178 /* Format for auto-save files */
179 Lisp_Object Vauto_save_file_format
;
181 /* Lisp functions for translating file formats */
182 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
184 /* Function to be called to decide a coding system of a reading file. */
185 Lisp_Object Vset_auto_coding_function
;
187 /* Functions to be called to process text properties in inserted file. */
188 Lisp_Object Vafter_insert_file_functions
;
190 /* Lisp function for setting buffer-file-coding-system and the
191 multibyteness of the current buffer after inserting a file. */
192 Lisp_Object Qafter_insert_file_set_coding
;
194 /* Functions to be called to create text property annotations for file. */
195 Lisp_Object Vwrite_region_annotate_functions
;
196 Lisp_Object Qwrite_region_annotate_functions
;
198 /* During build_annotations, each time an annotation function is called,
199 this holds the annotations made by the previous functions. */
200 Lisp_Object Vwrite_region_annotations_so_far
;
202 /* File name in which we write a list of all our auto save files. */
203 Lisp_Object Vauto_save_list_file_name
;
205 /* Function to call to read a file name. */
206 Lisp_Object Vread_file_name_function
;
208 /* Current predicate used by read_file_name_internal. */
209 Lisp_Object Vread_file_name_predicate
;
211 /* Nonzero means, when reading a filename in the minibuffer,
212 start out by inserting the default directory into the minibuffer. */
213 int insert_default_directory
;
215 /* On VMS, nonzero means write new files with record format stmlf.
216 Zero means use var format. */
219 /* On NT, specifies the directory separator character, used (eg.) when
220 expanding file names. This can be bound to / or \. */
221 Lisp_Object Vdirectory_sep_char
;
223 extern Lisp_Object Vuser_login_name
;
226 extern Lisp_Object Vw32_get_true_file_attributes
;
229 extern int minibuf_level
;
231 extern int minibuffer_auto_raise
;
233 /* These variables describe handlers that have "already" had a chance
234 to handle the current operation.
236 Vinhibit_file_name_handlers is a list of file name handlers.
237 Vinhibit_file_name_operation is the operation being handled.
238 If we try to handle that operation, we ignore those handlers. */
240 static Lisp_Object Vinhibit_file_name_handlers
;
241 static Lisp_Object Vinhibit_file_name_operation
;
243 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
245 Lisp_Object Qfile_name_history
;
247 Lisp_Object Qcar_less_than_car
;
249 static int a_write
P_ ((int, Lisp_Object
, int, int,
250 Lisp_Object
*, struct coding_system
*));
251 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
255 report_file_error (string
, data
)
259 Lisp_Object errstring
;
262 synchronize_system_messages_locale ();
263 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
264 Vlocale_coding_system
, 0);
270 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
273 /* System error messages are capitalized. Downcase the initial
274 unless it is followed by a slash. */
275 if (SREF (errstring
, 1) != '/')
276 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
278 Fsignal (Qfile_error
,
279 Fcons (build_string (string
), Fcons (errstring
, data
)));
284 close_file_unwind (fd
)
287 emacs_close (XFASTINT (fd
));
291 /* Restore point, having saved it as a marker. */
294 restore_point_unwind (location
)
295 Lisp_Object location
;
297 Fgoto_char (location
);
298 Fset_marker (location
, Qnil
, Qnil
);
302 Lisp_Object Qexpand_file_name
;
303 Lisp_Object Qsubstitute_in_file_name
;
304 Lisp_Object Qdirectory_file_name
;
305 Lisp_Object Qfile_name_directory
;
306 Lisp_Object Qfile_name_nondirectory
;
307 Lisp_Object Qunhandled_file_name_directory
;
308 Lisp_Object Qfile_name_as_directory
;
309 Lisp_Object Qcopy_file
;
310 Lisp_Object Qmake_directory_internal
;
311 Lisp_Object Qmake_directory
;
312 Lisp_Object Qdelete_directory
;
313 Lisp_Object Qdelete_file
;
314 Lisp_Object Qrename_file
;
315 Lisp_Object Qadd_name_to_file
;
316 Lisp_Object Qmake_symbolic_link
;
317 Lisp_Object Qfile_exists_p
;
318 Lisp_Object Qfile_executable_p
;
319 Lisp_Object Qfile_readable_p
;
320 Lisp_Object Qfile_writable_p
;
321 Lisp_Object Qfile_symlink_p
;
322 Lisp_Object Qaccess_file
;
323 Lisp_Object Qfile_directory_p
;
324 Lisp_Object Qfile_regular_p
;
325 Lisp_Object Qfile_accessible_directory_p
;
326 Lisp_Object Qfile_modes
;
327 Lisp_Object Qset_file_modes
;
328 Lisp_Object Qfile_newer_than_file_p
;
329 Lisp_Object Qinsert_file_contents
;
330 Lisp_Object Qwrite_region
;
331 Lisp_Object Qverify_visited_file_modtime
;
332 Lisp_Object Qset_visited_file_modtime
;
334 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
335 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
336 Otherwise, return nil.
337 A file name is handled if one of the regular expressions in
338 `file-name-handler-alist' matches it.
340 If OPERATION equals `inhibit-file-name-operation', then we ignore
341 any handlers that are members of `inhibit-file-name-handlers',
342 but we still do run any other handlers. This lets handlers
343 use the standard functions without calling themselves recursively. */)
344 (filename
, operation
)
345 Lisp_Object filename
, operation
;
347 /* This function must not munge the match data. */
348 Lisp_Object chain
, inhibited_handlers
, result
;
352 CHECK_STRING (filename
);
354 if (EQ (operation
, Vinhibit_file_name_operation
))
355 inhibited_handlers
= Vinhibit_file_name_handlers
;
357 inhibited_handlers
= Qnil
;
359 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
360 chain
= XCDR (chain
))
370 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
372 Lisp_Object handler
, tem
;
374 handler
= XCDR (elt
);
375 tem
= Fmemq (handler
, inhibited_handlers
);
389 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
391 doc
: /* Return the directory component in file name FILENAME.
392 Return nil if FILENAME does not include a directory.
393 Otherwise return a directory spec.
394 Given a Unix syntax file name, returns a string ending in slash;
395 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
397 Lisp_Object filename
;
400 register const unsigned char *beg
;
402 register unsigned char *beg
;
404 register const unsigned char *p
;
407 CHECK_STRING (filename
);
409 /* If the file name has special constructs in it,
410 call the corresponding file handler. */
411 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
413 return call2 (handler
, Qfile_name_directory
, filename
);
415 #ifdef FILE_SYSTEM_CASE
416 filename
= FILE_SYSTEM_CASE (filename
);
418 beg
= SDATA (filename
);
420 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
422 p
= beg
+ SBYTES (filename
);
424 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
426 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
429 /* only recognise drive specifier at the beginning */
431 /* handle the "/:d:foo" and "/:foo" cases correctly */
432 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
433 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
440 /* Expansion of "c:" to drive and default directory. */
443 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
444 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
445 unsigned char *r
= res
;
447 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
449 strncpy (res
, beg
, 2);
454 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
456 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
459 p
= beg
+ strlen (beg
);
462 CORRECT_DIR_SEPS (beg
);
465 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
468 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
469 Sfile_name_nondirectory
, 1, 1, 0,
470 doc
: /* Return file name FILENAME sans its directory.
471 For example, in a Unix-syntax file name,
472 this is everything after the last slash,
473 or the entire name if it contains no slash. */)
475 Lisp_Object filename
;
477 register const unsigned char *beg
, *p
, *end
;
480 CHECK_STRING (filename
);
482 /* If the file name has special constructs in it,
483 call the corresponding file handler. */
484 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
486 return call2 (handler
, Qfile_name_nondirectory
, filename
);
488 beg
= SDATA (filename
);
489 end
= p
= beg
+ SBYTES (filename
);
491 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
493 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
496 /* only recognise drive specifier at beginning */
498 /* handle the "/:d:foo" case correctly */
499 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
504 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
507 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
508 Sunhandled_file_name_directory
, 1, 1, 0,
509 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
510 A `directly usable' directory name is one that may be used without the
511 intervention of any file handler.
512 If FILENAME is a directly usable file itself, return
513 \(file-name-directory FILENAME).
514 The `call-process' and `start-process' functions use this function to
515 get a current directory to run processes in. */)
517 Lisp_Object filename
;
521 /* If the file name has special constructs in it,
522 call the corresponding file handler. */
523 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
525 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
527 return Ffile_name_directory (filename
);
532 file_name_as_directory (out
, in
)
535 int size
= strlen (in
) - 1;
548 /* Is it already a directory string? */
549 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
551 /* Is it a VMS directory file name? If so, hack VMS syntax. */
552 else if (! index (in
, '/')
553 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
554 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
555 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
556 || ! strncmp (&in
[size
- 5], ".dir", 4))
557 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
558 && in
[size
] == '1')))
560 register char *p
, *dot
;
564 dir:x.dir --> dir:[x]
565 dir:[x]y.dir --> dir:[x.y] */
567 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
570 strncpy (out
, in
, p
- in
);
589 dot
= index (p
, '.');
592 /* blindly remove any extension */
593 size
= strlen (out
) + (dot
- p
);
594 strncat (out
, p
, dot
- p
);
605 /* For Unix syntax, Append a slash if necessary */
606 if (!IS_DIRECTORY_SEP (out
[size
]))
608 /* Cannot use DIRECTORY_SEP, which could have any value */
610 out
[size
+ 2] = '\0';
613 CORRECT_DIR_SEPS (out
);
619 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
620 Sfile_name_as_directory
, 1, 1, 0,
621 doc
: /* Return a string representing the file name FILE interpreted as a directory.
622 This operation exists because a directory is also a file, but its name as
623 a directory is different from its name as a file.
624 The result can be used as the value of `default-directory'
625 or passed as second argument to `expand-file-name'.
626 For a Unix-syntax file name, just appends a slash.
627 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
638 /* If the file name has special constructs in it,
639 call the corresponding file handler. */
640 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
642 return call2 (handler
, Qfile_name_as_directory
, file
);
644 buf
= (char *) alloca (SBYTES (file
) + 10);
645 file_name_as_directory (buf
, SDATA (file
));
646 return make_specified_string (buf
, -1, strlen (buf
),
647 STRING_MULTIBYTE (file
));
651 * Convert from directory name to filename.
653 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
654 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
655 * On UNIX, it's simple: just make sure there isn't a terminating /
657 * Value is nonzero if the string output is different from the input.
661 directory_file_name (src
, dst
)
669 struct FAB fab
= cc$rms_fab
;
670 struct NAM nam
= cc$rms_nam
;
671 char esa
[NAM$C_MAXRSS
];
676 if (! index (src
, '/')
677 && (src
[slen
- 1] == ']'
678 || src
[slen
- 1] == ':'
679 || src
[slen
- 1] == '>'))
681 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
683 fab
.fab$b_fns
= slen
;
684 fab
.fab$l_nam
= &nam
;
685 fab
.fab$l_fop
= FAB$M_NAM
;
688 nam
.nam$b_ess
= sizeof esa
;
689 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
691 /* We call SYS$PARSE to handle such things as [--] for us. */
692 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
694 slen
= nam
.nam$b_esl
;
695 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
700 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
702 /* what about when we have logical_name:???? */
703 if (src
[slen
- 1] == ':')
704 { /* Xlate logical name and see what we get */
705 ptr
= strcpy (dst
, src
); /* upper case for getenv */
708 if ('a' <= *ptr
&& *ptr
<= 'z')
712 dst
[slen
- 1] = 0; /* remove colon */
713 if (!(src
= egetenv (dst
)))
715 /* should we jump to the beginning of this procedure?
716 Good points: allows us to use logical names that xlate
718 Bad points: can be a problem if we just translated to a device
720 For now, I'll punt and always expect VMS names, and hope for
723 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
724 { /* no recursion here! */
730 { /* not a directory spec */
735 bracket
= src
[slen
- 1];
737 /* If bracket is ']' or '>', bracket - 2 is the corresponding
739 ptr
= index (src
, bracket
- 2);
741 { /* no opening bracket */
745 if (!(rptr
= rindex (src
, '.')))
748 strncpy (dst
, src
, slen
);
752 dst
[slen
++] = bracket
;
757 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
758 then translate the device and recurse. */
759 if (dst
[slen
- 1] == ':'
760 && dst
[slen
- 2] != ':' /* skip decnet nodes */
761 && strcmp (src
+ slen
, "[000000]") == 0)
763 dst
[slen
- 1] = '\0';
764 if ((ptr
= egetenv (dst
))
765 && (rlen
= strlen (ptr
) - 1) > 0
766 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
767 && ptr
[rlen
- 1] == '.')
769 char * buf
= (char *) alloca (strlen (ptr
) + 1);
773 return directory_file_name (buf
, dst
);
778 strcat (dst
, "[000000]");
782 rlen
= strlen (rptr
) - 1;
783 strncat (dst
, rptr
, rlen
);
784 dst
[slen
+ rlen
] = '\0';
785 strcat (dst
, ".DIR.1");
789 /* Process as Unix format: just remove any final slash.
790 But leave "/" unchanged; do not change it to "". */
793 /* Handle // as root for apollo's. */
794 if ((slen
> 2 && dst
[slen
- 1] == '/')
795 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
799 && IS_DIRECTORY_SEP (dst
[slen
- 1])
801 && !IS_ANY_SEP (dst
[slen
- 2])
807 CORRECT_DIR_SEPS (dst
);
812 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
814 doc
: /* Returns the file name of the directory named DIRECTORY.
815 This is the name of the file that holds the data for the directory DIRECTORY.
816 This operation exists because a directory is also a file, but its name as
817 a directory is different from its name as a file.
818 In Unix-syntax, this function just removes the final slash.
819 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
820 it returns a file name such as \"[X]Y.DIR.1\". */)
822 Lisp_Object directory
;
827 CHECK_STRING (directory
);
829 if (NILP (directory
))
832 /* If the file name has special constructs in it,
833 call the corresponding file handler. */
834 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
836 return call2 (handler
, Qdirectory_file_name
, directory
);
839 /* 20 extra chars is insufficient for VMS, since we might perform a
840 logical name translation. an equivalence string can be up to 255
841 chars long, so grab that much extra space... - sss */
842 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
844 buf
= (char *) alloca (SBYTES (directory
) + 20);
846 directory_file_name (SDATA (directory
), buf
);
847 return make_specified_string (buf
, -1, strlen (buf
),
848 STRING_MULTIBYTE (directory
));
851 static char make_temp_name_tbl
[64] =
853 'A','B','C','D','E','F','G','H',
854 'I','J','K','L','M','N','O','P',
855 'Q','R','S','T','U','V','W','X',
856 'Y','Z','a','b','c','d','e','f',
857 'g','h','i','j','k','l','m','n',
858 'o','p','q','r','s','t','u','v',
859 'w','x','y','z','0','1','2','3',
860 '4','5','6','7','8','9','-','_'
863 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
865 /* Value is a temporary file name starting with PREFIX, a string.
867 The Emacs process number forms part of the result, so there is
868 no danger of generating a name being used by another process.
869 In addition, this function makes an attempt to choose a name
870 which has no existing file. To make this work, PREFIX should be
871 an absolute file name.
873 BASE64_P non-zero means add the pid as 3 characters in base64
874 encoding. In this case, 6 characters will be added to PREFIX to
875 form the file name. Otherwise, if Emacs is running on a system
876 with long file names, add the pid as a decimal number.
878 This function signals an error if no unique file name could be
882 make_temp_name (prefix
, base64_p
)
889 unsigned char *p
, *data
;
893 CHECK_STRING (prefix
);
895 /* VAL is created by adding 6 characters to PREFIX. The first
896 three are the PID of this process, in base 64, and the second
897 three are incremented if the file already exists. This ensures
898 262144 unique file names per PID per PREFIX. */
900 pid
= (int) getpid ();
904 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
905 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
906 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
911 #ifdef HAVE_LONG_FILE_NAMES
912 sprintf (pidbuf
, "%d", pid
);
913 pidlen
= strlen (pidbuf
);
915 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
916 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
917 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
922 len
= SCHARS (prefix
);
923 val
= make_uninit_string (len
+ 3 + pidlen
);
925 bcopy(SDATA (prefix
), data
, len
);
928 bcopy (pidbuf
, p
, pidlen
);
931 /* Here we try to minimize useless stat'ing when this function is
932 invoked many times successively with the same PREFIX. We achieve
933 this by initializing count to a random value, and incrementing it
936 We don't want make-temp-name to be called while dumping,
937 because then make_temp_name_count_initialized_p would get set
938 and then make_temp_name_count would not be set when Emacs starts. */
940 if (!make_temp_name_count_initialized_p
)
942 make_temp_name_count
= (unsigned) time (NULL
);
943 make_temp_name_count_initialized_p
= 1;
949 unsigned num
= make_temp_name_count
;
951 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
952 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
953 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
955 /* Poor man's congruential RN generator. Replace with
956 ++make_temp_name_count for debugging. */
957 make_temp_name_count
+= 25229;
958 make_temp_name_count
%= 225307;
960 if (stat (data
, &ignored
) < 0)
962 /* We want to return only if errno is ENOENT. */
966 /* The error here is dubious, but there is little else we
967 can do. The alternatives are to return nil, which is
968 as bad as (and in many cases worse than) throwing the
969 error, or to ignore the error, which will likely result
970 in looping through 225307 stat's, which is not only
971 dog-slow, but also useless since it will fallback to
972 the errow below, anyway. */
973 report_file_error ("Cannot create temporary name for prefix",
974 Fcons (prefix
, Qnil
));
979 error ("Cannot create temporary name for prefix `%s'",
985 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
986 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
987 The Emacs process number forms part of the result,
988 so there is no danger of generating a name being used by another process.
990 In addition, this function makes an attempt to choose a name
991 which has no existing file. To make this work,
992 PREFIX should be an absolute file name.
994 There is a race condition between calling `make-temp-name' and creating the
995 file which opens all kinds of security holes. For that reason, you should
996 probably use `make-temp-file' instead, except in three circumstances:
998 * If you are creating the file in the user's home directory.
999 * If you are creating a directory rather than an ordinary file.
1000 * If you are taking special precautions as `make-temp-file' does. */)
1004 return make_temp_name (prefix
, 0);
1009 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1010 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1011 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1012 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1013 the current buffer's value of default-directory is used.
1014 File name components that are `.' are removed, and
1015 so are file name components followed by `..', along with the `..' itself;
1016 note that these simplifications are done without checking the resulting
1017 file names in the file system.
1018 An initial `~/' expands to your home directory.
1019 An initial `~USER/' expands to USER's home directory.
1020 See also the function `substitute-in-file-name'. */)
1021 (name
, default_directory
)
1022 Lisp_Object name
, default_directory
;
1026 register unsigned char *newdir
, *p
, *o
;
1028 unsigned char *target
;
1031 unsigned char * colon
= 0;
1032 unsigned char * close
= 0;
1033 unsigned char * slash
= 0;
1034 unsigned char * brack
= 0;
1035 int lbrack
= 0, rbrack
= 0;
1040 int collapse_newdir
= 1;
1044 Lisp_Object handler
, result
;
1046 CHECK_STRING (name
);
1048 /* If the file name has special constructs in it,
1049 call the corresponding file handler. */
1050 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1051 if (!NILP (handler
))
1052 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1054 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1055 if (NILP (default_directory
))
1056 default_directory
= current_buffer
->directory
;
1057 if (! STRINGP (default_directory
))
1060 /* "/" is not considered a root directory on DOS_NT, so using "/"
1061 here causes an infinite recursion in, e.g., the following:
1063 (let (default-directory)
1064 (expand-file-name "a"))
1066 To avoid this, we set default_directory to the root of the
1068 extern char *emacs_root_dir (void);
1070 default_directory
= build_string (emacs_root_dir ());
1072 default_directory
= build_string ("/");
1076 if (!NILP (default_directory
))
1078 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1079 if (!NILP (handler
))
1080 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1083 o
= SDATA (default_directory
);
1085 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1086 It would be better to do this down below where we actually use
1087 default_directory. Unfortunately, calling Fexpand_file_name recursively
1088 could invoke GC, and the strings might be relocated. This would
1089 be annoying because we have pointers into strings lying around
1090 that would need adjusting, and people would add new pointers to
1091 the code and forget to adjust them, resulting in intermittent bugs.
1092 Putting this call here avoids all that crud.
1094 The EQ test avoids infinite recursion. */
1095 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1096 /* Save time in some common cases - as long as default_directory
1097 is not relative, it can be canonicalized with name below (if it
1098 is needed at all) without requiring it to be expanded now. */
1100 /* Detect MSDOS file names with drive specifiers. */
1101 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1103 /* Detect Windows file names in UNC format. */
1104 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1106 #else /* not DOS_NT */
1107 /* Detect Unix absolute file names (/... alone is not absolute on
1109 && ! (IS_DIRECTORY_SEP (o
[0]))
1110 #endif /* not DOS_NT */
1113 struct gcpro gcpro1
;
1116 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1121 /* Filenames on VMS are always upper case. */
1122 name
= Fupcase (name
);
1124 #ifdef FILE_SYSTEM_CASE
1125 name
= FILE_SYSTEM_CASE (name
);
1131 /* We will force directory separators to be either all \ or /, so make
1132 a local copy to modify, even if there ends up being no change. */
1133 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1135 /* Note if special escape prefix is present, but remove for now. */
1136 if (nm
[0] == '/' && nm
[1] == ':')
1142 /* Find and remove drive specifier if present; this makes nm absolute
1143 even if the rest of the name appears to be relative. Only look for
1144 drive specifier at the beginning. */
1145 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1152 /* If we see "c://somedir", we want to strip the first slash after the
1153 colon when stripping the drive letter. Otherwise, this expands to
1155 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1157 #endif /* WINDOWSNT */
1161 /* Discard any previous drive specifier if nm is now in UNC format. */
1162 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1168 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1169 none are found, we can probably return right away. We will avoid
1170 allocating a new string if name is already fully expanded. */
1172 IS_DIRECTORY_SEP (nm
[0])
1174 && drive
&& !is_escaped
1177 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1184 /* If it turns out that the filename we want to return is just a
1185 suffix of FILENAME, we don't need to go through and edit
1186 things; we just need to construct a new string using data
1187 starting at the middle of FILENAME. If we set lose to a
1188 non-zero value, that means we've discovered that we can't do
1195 /* Since we know the name is absolute, we can assume that each
1196 element starts with a "/". */
1198 /* "." and ".." are hairy. */
1199 if (IS_DIRECTORY_SEP (p
[0])
1201 && (IS_DIRECTORY_SEP (p
[2])
1203 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1206 /* We want to replace multiple `/' in a row with a single
1209 && IS_DIRECTORY_SEP (p
[0])
1210 && IS_DIRECTORY_SEP (p
[1]))
1217 /* if dev:[dir]/, move nm to / */
1218 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1219 nm
= (brack
? brack
+ 1 : colon
+ 1);
1220 lbrack
= rbrack
= 0;
1228 /* VMS pre V4.4,convert '-'s in filenames. */
1229 if (lbrack
== rbrack
)
1231 if (dots
< 2) /* this is to allow negative version numbers */
1236 if (lbrack
> rbrack
&&
1237 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1238 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1244 /* count open brackets, reset close bracket pointer */
1245 if (p
[0] == '[' || p
[0] == '<')
1246 lbrack
++, brack
= 0;
1247 /* count close brackets, set close bracket pointer */
1248 if (p
[0] == ']' || p
[0] == '>')
1249 rbrack
++, brack
= p
;
1250 /* detect ][ or >< */
1251 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1253 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1254 nm
= p
+ 1, lose
= 1;
1255 if (p
[0] == ':' && (colon
|| slash
))
1256 /* if dev1:[dir]dev2:, move nm to dev2: */
1262 /* if /name/dev:, move nm to dev: */
1265 /* if node::dev:, move colon following dev */
1266 else if (colon
&& colon
[-1] == ':')
1268 /* if dev1:dev2:, move nm to dev2: */
1269 else if (colon
&& colon
[-1] != ':')
1274 if (p
[0] == ':' && !colon
)
1280 if (lbrack
== rbrack
)
1283 else if (p
[0] == '.')
1291 if (index (nm
, '/'))
1293 nm
= sys_translate_unix (nm
);
1294 return make_specified_string (nm
, -1, strlen (nm
),
1295 STRING_MULTIBYTE (name
));
1299 /* Make sure directories are all separated with / or \ as
1300 desired, but avoid allocation of a new string when not
1302 CORRECT_DIR_SEPS (nm
);
1304 if (IS_DIRECTORY_SEP (nm
[1]))
1306 if (strcmp (nm
, SDATA (name
)) != 0)
1307 name
= make_specified_string (nm
, -1, strlen (nm
),
1308 STRING_MULTIBYTE (name
));
1312 /* drive must be set, so this is okay */
1313 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1317 name
= make_specified_string (nm
, -1, p
- nm
,
1318 STRING_MULTIBYTE (name
));
1319 temp
[0] = DRIVE_LETTER (drive
);
1320 name
= concat2 (build_string (temp
), name
);
1323 #else /* not DOS_NT */
1324 if (nm
== SDATA (name
))
1326 return make_specified_string (nm
, -1, strlen (nm
),
1327 STRING_MULTIBYTE (name
));
1328 #endif /* not DOS_NT */
1332 /* At this point, nm might or might not be an absolute file name. We
1333 need to expand ~ or ~user if present, otherwise prefix nm with
1334 default_directory if nm is not absolute, and finally collapse /./
1335 and /foo/../ sequences.
1337 We set newdir to be the appropriate prefix if one is needed:
1338 - the relevant user directory if nm starts with ~ or ~user
1339 - the specified drive's working dir (DOS/NT only) if nm does not
1341 - the value of default_directory.
1343 Note that these prefixes are not guaranteed to be absolute (except
1344 for the working dir of a drive). Therefore, to ensure we always
1345 return an absolute name, if the final prefix is not absolute we
1346 append it to the current working directory. */
1350 if (nm
[0] == '~') /* prefix ~ */
1352 if (IS_DIRECTORY_SEP (nm
[1])
1356 || nm
[1] == 0) /* ~ by itself */
1358 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1359 newdir
= (unsigned char *) "";
1362 collapse_newdir
= 0;
1365 nm
++; /* Don't leave the slash in nm. */
1368 else /* ~user/filename */
1370 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1375 o
= (unsigned char *) alloca (p
- nm
+ 1);
1376 bcopy ((char *) nm
, o
, p
- nm
);
1379 pw
= (struct passwd
*) getpwnam (o
+ 1);
1382 newdir
= (unsigned char *) pw
-> pw_dir
;
1384 nm
= p
+ 1; /* skip the terminator */
1388 collapse_newdir
= 0;
1393 /* If we don't find a user of that name, leave the name
1394 unchanged; don't move nm forward to p. */
1399 /* On DOS and Windows, nm is absolute if a drive name was specified;
1400 use the drive's current directory as the prefix if needed. */
1401 if (!newdir
&& drive
)
1403 /* Get default directory if needed to make nm absolute. */
1404 if (!IS_DIRECTORY_SEP (nm
[0]))
1406 newdir
= alloca (MAXPATHLEN
+ 1);
1407 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1412 /* Either nm starts with /, or drive isn't mounted. */
1413 newdir
= alloca (4);
1414 newdir
[0] = DRIVE_LETTER (drive
);
1422 /* Finally, if no prefix has been specified and nm is not absolute,
1423 then it must be expanded relative to default_directory. */
1427 /* /... alone is not absolute on DOS and Windows. */
1428 && !IS_DIRECTORY_SEP (nm
[0])
1431 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1438 newdir
= SDATA (default_directory
);
1440 /* Note if special escape prefix is present, but remove for now. */
1441 if (newdir
[0] == '/' && newdir
[1] == ':')
1452 /* First ensure newdir is an absolute name. */
1454 /* Detect MSDOS file names with drive specifiers. */
1455 ! (IS_DRIVE (newdir
[0])
1456 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1458 /* Detect Windows file names in UNC format. */
1459 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1463 /* Effectively, let newdir be (expand-file-name newdir cwd).
1464 Because of the admonition against calling expand-file-name
1465 when we have pointers into lisp strings, we accomplish this
1466 indirectly by prepending newdir to nm if necessary, and using
1467 cwd (or the wd of newdir's drive) as the new newdir. */
1469 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1474 if (!IS_DIRECTORY_SEP (nm
[0]))
1476 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1477 file_name_as_directory (tmp
, newdir
);
1481 newdir
= alloca (MAXPATHLEN
+ 1);
1484 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1491 /* Strip off drive name from prefix, if present. */
1492 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1498 /* Keep only a prefix from newdir if nm starts with slash
1499 (//server/share for UNC, nothing otherwise). */
1500 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1503 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1505 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1507 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1509 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1521 /* Get rid of any slash at the end of newdir, unless newdir is
1522 just / or // (an incomplete UNC name). */
1523 length
= strlen (newdir
);
1524 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1526 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1530 unsigned char *temp
= (unsigned char *) alloca (length
);
1531 bcopy (newdir
, temp
, length
- 1);
1532 temp
[length
- 1] = 0;
1540 /* Now concatenate the directory and name to new space in the stack frame */
1541 tlen
+= strlen (nm
) + 1;
1543 /* Reserve space for drive specifier and escape prefix, since either
1544 or both may need to be inserted. (The Microsoft x86 compiler
1545 produces incorrect code if the following two lines are combined.) */
1546 target
= (unsigned char *) alloca (tlen
+ 4);
1548 #else /* not DOS_NT */
1549 target
= (unsigned char *) alloca (tlen
);
1550 #endif /* not DOS_NT */
1556 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1559 /* If newdir is effectively "C:/", then the drive letter will have
1560 been stripped and newdir will be "/". Concatenating with an
1561 absolute directory in nm produces "//", which will then be
1562 incorrectly treated as a network share. Ignore newdir in
1563 this case (keeping the drive letter). */
1564 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1565 && newdir
[1] == '\0'))
1567 strcpy (target
, newdir
);
1571 file_name_as_directory (target
, newdir
);
1574 strcat (target
, nm
);
1576 if (index (target
, '/'))
1577 strcpy (target
, sys_translate_unix (target
));
1580 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1582 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1591 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1597 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1598 /* brackets are offset from each other by 2 */
1601 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1602 /* convert [foo][bar] to [bar] */
1603 while (o
[-1] != '[' && o
[-1] != '<')
1605 else if (*p
== '-' && *o
!= '.')
1608 else if (p
[0] == '-' && o
[-1] == '.' &&
1609 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1610 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1614 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1615 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1617 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1619 /* else [foo.-] ==> [-] */
1625 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1626 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1632 if (!IS_DIRECTORY_SEP (*p
))
1636 else if (IS_DIRECTORY_SEP (p
[0])
1638 && (IS_DIRECTORY_SEP (p
[2])
1641 /* If "/." is the entire filename, keep the "/". Otherwise,
1642 just delete the whole "/.". */
1643 if (o
== target
&& p
[2] == '\0')
1647 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1648 /* `/../' is the "superroot" on certain file systems. */
1650 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1652 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1654 /* Keep initial / only if this is the whole name. */
1655 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1660 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1662 /* Collapse multiple `/' in a row. */
1664 while (IS_DIRECTORY_SEP (*p
))
1671 #endif /* not VMS */
1675 /* At last, set drive name. */
1677 /* Except for network file name. */
1678 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1679 #endif /* WINDOWSNT */
1681 if (!drive
) abort ();
1683 target
[0] = DRIVE_LETTER (drive
);
1686 /* Reinsert the escape prefix if required. */
1693 CORRECT_DIR_SEPS (target
);
1696 result
= make_specified_string (target
, -1, o
- target
,
1697 STRING_MULTIBYTE (name
));
1699 /* Again look to see if the file name has special constructs in it
1700 and perhaps call the corresponding file handler. This is needed
1701 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1702 the ".." component gives us "/user@host:/bar/../baz" which needs
1703 to be expanded again. */
1704 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1705 if (!NILP (handler
))
1706 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1712 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1713 This is the old version of expand-file-name, before it was thoroughly
1714 rewritten for Emacs 10.31. We leave this version here commented-out,
1715 because the code is very complex and likely to have subtle bugs. If
1716 bugs _are_ found, it might be of interest to look at the old code and
1717 see what did it do in the relevant situation.
1719 Don't remove this code: it's true that it will be accessible via CVS,
1720 but a few years from deletion, people will forget it is there. */
1722 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1723 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1724 "Convert FILENAME to absolute, and canonicalize it.\n\
1725 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1726 (does not start with slash); if DEFAULT is nil or missing,\n\
1727 the current buffer's value of default-directory is used.\n\
1728 Filenames containing `.' or `..' as components are simplified;\n\
1729 initial `~/' expands to your home directory.\n\
1730 See also the function `substitute-in-file-name'.")
1732 Lisp_Object name
, defalt
;
1736 register unsigned char *newdir
, *p
, *o
;
1738 unsigned char *target
;
1742 unsigned char * colon
= 0;
1743 unsigned char * close
= 0;
1744 unsigned char * slash
= 0;
1745 unsigned char * brack
= 0;
1746 int lbrack
= 0, rbrack
= 0;
1750 CHECK_STRING (name
);
1753 /* Filenames on VMS are always upper case. */
1754 name
= Fupcase (name
);
1759 /* If nm is absolute, flush ...// and detect /./ and /../.
1760 If no /./ or /../ we can return right away. */
1772 if (p
[0] == '/' && p
[1] == '/'
1774 /* // at start of filename is meaningful on Apollo system. */
1779 if (p
[0] == '/' && p
[1] == '~')
1780 nm
= p
+ 1, lose
= 1;
1781 if (p
[0] == '/' && p
[1] == '.'
1782 && (p
[2] == '/' || p
[2] == 0
1783 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1789 /* if dev:[dir]/, move nm to / */
1790 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1791 nm
= (brack
? brack
+ 1 : colon
+ 1);
1792 lbrack
= rbrack
= 0;
1800 /* VMS pre V4.4,convert '-'s in filenames. */
1801 if (lbrack
== rbrack
)
1803 if (dots
< 2) /* this is to allow negative version numbers */
1808 if (lbrack
> rbrack
&&
1809 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1810 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1816 /* count open brackets, reset close bracket pointer */
1817 if (p
[0] == '[' || p
[0] == '<')
1818 lbrack
++, brack
= 0;
1819 /* count close brackets, set close bracket pointer */
1820 if (p
[0] == ']' || p
[0] == '>')
1821 rbrack
++, brack
= p
;
1822 /* detect ][ or >< */
1823 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1825 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1826 nm
= p
+ 1, lose
= 1;
1827 if (p
[0] == ':' && (colon
|| slash
))
1828 /* if dev1:[dir]dev2:, move nm to dev2: */
1834 /* If /name/dev:, move nm to dev: */
1837 /* If node::dev:, move colon following dev */
1838 else if (colon
&& colon
[-1] == ':')
1840 /* If dev1:dev2:, move nm to dev2: */
1841 else if (colon
&& colon
[-1] != ':')
1846 if (p
[0] == ':' && !colon
)
1852 if (lbrack
== rbrack
)
1855 else if (p
[0] == '.')
1863 if (index (nm
, '/'))
1864 return build_string (sys_translate_unix (nm
));
1866 if (nm
== SDATA (name
))
1868 return build_string (nm
);
1872 /* Now determine directory to start with and put it in NEWDIR */
1876 if (nm
[0] == '~') /* prefix ~ */
1881 || nm
[1] == 0)/* ~/filename */
1883 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1884 newdir
= (unsigned char *) "";
1887 nm
++; /* Don't leave the slash in nm. */
1890 else /* ~user/filename */
1892 /* Get past ~ to user */
1893 unsigned char *user
= nm
+ 1;
1894 /* Find end of name. */
1895 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1896 int len
= ptr
? ptr
- user
: strlen (user
);
1898 unsigned char *ptr1
= index (user
, ':');
1899 if (ptr1
!= 0 && ptr1
- user
< len
)
1902 /* Copy the user name into temp storage. */
1903 o
= (unsigned char *) alloca (len
+ 1);
1904 bcopy ((char *) user
, o
, len
);
1907 /* Look up the user name. */
1908 pw
= (struct passwd
*) getpwnam (o
+ 1);
1910 error ("\"%s\" isn't a registered user", o
+ 1);
1912 newdir
= (unsigned char *) pw
->pw_dir
;
1914 /* Discard the user name from NM. */
1921 #endif /* not VMS */
1925 defalt
= current_buffer
->directory
;
1926 CHECK_STRING (defalt
);
1927 newdir
= SDATA (defalt
);
1930 /* Now concatenate the directory and name to new space in the stack frame */
1932 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1933 target
= (unsigned char *) alloca (tlen
);
1939 if (nm
[0] == 0 || nm
[0] == '/')
1940 strcpy (target
, newdir
);
1943 file_name_as_directory (target
, newdir
);
1946 strcat (target
, nm
);
1948 if (index (target
, '/'))
1949 strcpy (target
, sys_translate_unix (target
));
1952 /* Now canonicalize by removing /. and /foo/.. if they appear */
1960 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1966 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1967 /* brackets are offset from each other by 2 */
1970 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1971 /* convert [foo][bar] to [bar] */
1972 while (o
[-1] != '[' && o
[-1] != '<')
1974 else if (*p
== '-' && *o
!= '.')
1977 else if (p
[0] == '-' && o
[-1] == '.' &&
1978 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1979 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1983 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1984 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1986 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1988 /* else [foo.-] ==> [-] */
1994 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1995 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2005 else if (!strncmp (p
, "//", 2)
2007 /* // at start of filename is meaningful in Apollo system. */
2015 else if (p
[0] == '/' && p
[1] == '.' &&
2016 (p
[2] == '/' || p
[2] == 0))
2018 else if (!strncmp (p
, "/..", 3)
2019 /* `/../' is the "superroot" on certain file systems. */
2021 && (p
[3] == '/' || p
[3] == 0))
2023 while (o
!= target
&& *--o
!= '/')
2026 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2030 if (o
== target
&& *o
== '/')
2038 #endif /* not VMS */
2041 return make_string (target
, o
- target
);
2045 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2046 Ssubstitute_in_file_name
, 1, 1, 0,
2047 doc
: /* Substitute environment variables referred to in FILENAME.
2048 `$FOO' where FOO is an environment variable name means to substitute
2049 the value of that variable. The variable name should be terminated
2050 with a character not a letter, digit or underscore; otherwise, enclose
2051 the entire variable name in braces.
2052 If `/~' appears, all of FILENAME through that `/' is discarded.
2054 On VMS, `$' substitution is not done; this function does little and only
2055 duplicates what `expand-file-name' does. */)
2057 Lisp_Object filename
;
2061 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2062 unsigned char *target
= NULL
;
2064 int substituted
= 0;
2067 Lisp_Object handler
;
2069 CHECK_STRING (filename
);
2071 /* If the file name has special constructs in it,
2072 call the corresponding file handler. */
2073 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2074 if (!NILP (handler
))
2075 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2077 nm
= SDATA (filename
);
2079 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2080 CORRECT_DIR_SEPS (nm
);
2081 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2083 endp
= nm
+ SBYTES (filename
);
2085 /* If /~ or // appears, discard everything through first slash. */
2087 for (p
= nm
; p
!= endp
; p
++)
2090 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2091 /* // at start of file name is meaningful in Apollo,
2092 WindowsNT and Cygwin systems. */
2093 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2094 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2095 || IS_DIRECTORY_SEP (p
[0])
2096 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2101 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2103 || IS_DIRECTORY_SEP (p
[-1])))
2105 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2110 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2112 o
= (unsigned char *) alloca (s
- p
+ 1);
2113 bcopy ((char *) p
, o
, s
- p
);
2116 pw
= (struct passwd
*) getpwnam (o
+ 1);
2118 /* If we have ~/ or ~user and `user' exists, discard
2119 everything up to ~. But if `user' does not exist, leave
2120 ~user alone, it might be a literal file name. */
2121 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2128 /* see comment in expand-file-name about drive specifiers */
2129 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2130 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2139 return make_specified_string (nm
, -1, strlen (nm
),
2140 STRING_MULTIBYTE (filename
));
2143 /* See if any variables are substituted into the string
2144 and find the total length of their values in `total' */
2146 for (p
= nm
; p
!= endp
;)
2156 /* "$$" means a single "$" */
2165 while (p
!= endp
&& *p
!= '}') p
++;
2166 if (*p
!= '}') goto missingclose
;
2172 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2176 /* Copy out the variable name */
2177 target
= (unsigned char *) alloca (s
- o
+ 1);
2178 strncpy (target
, o
, s
- o
);
2181 strupr (target
); /* $home == $HOME etc. */
2184 /* Get variable value */
2185 o
= (unsigned char *) egetenv (target
);
2188 total
+= strlen (o
);
2198 /* If substitution required, recopy the string and do it */
2199 /* Make space in stack frame for the new copy */
2200 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2203 /* Copy the rest of the name through, replacing $ constructs with values */
2220 while (p
!= endp
&& *p
!= '}') p
++;
2221 if (*p
!= '}') goto missingclose
;
2227 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2231 /* Copy out the variable name */
2232 target
= (unsigned char *) alloca (s
- o
+ 1);
2233 strncpy (target
, o
, s
- o
);
2236 strupr (target
); /* $home == $HOME etc. */
2239 /* Get variable value */
2240 o
= (unsigned char *) egetenv (target
);
2244 strcpy (x
, target
); x
+= strlen (target
);
2246 else if (STRING_MULTIBYTE (filename
))
2248 /* If the original string is multibyte,
2249 convert what we substitute into multibyte. */
2252 int c
= unibyte_char_to_multibyte (*o
++);
2253 x
+= CHAR_STRING (c
, x
);
2265 /* If /~ or // appears, discard everything through first slash. */
2267 for (p
= xnm
; p
!= x
; p
++)
2269 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2270 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2271 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2272 || IS_DIRECTORY_SEP (p
[0])
2273 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2275 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2278 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2279 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2283 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2286 error ("Bad format environment-variable substitution");
2288 error ("Missing \"}\" in environment-variable substitution");
2290 error ("Substituting nonexistent environment variable \"%s\"", target
);
2293 #endif /* not VMS */
2297 /* A slightly faster and more convenient way to get
2298 (directory-file-name (expand-file-name FOO)). */
2301 expand_and_dir_to_file (filename
, defdir
)
2302 Lisp_Object filename
, defdir
;
2304 register Lisp_Object absname
;
2306 absname
= Fexpand_file_name (filename
, defdir
);
2309 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2310 if (c
== ':' || c
== ']' || c
== '>')
2311 absname
= Fdirectory_file_name (absname
);
2314 /* Remove final slash, if any (unless this is the root dir).
2315 stat behaves differently depending! */
2316 if (SCHARS (absname
) > 1
2317 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2318 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2319 /* We cannot take shortcuts; they might be wrong for magic file names. */
2320 absname
= Fdirectory_file_name (absname
);
2325 /* Signal an error if the file ABSNAME already exists.
2326 If INTERACTIVE is nonzero, ask the user whether to proceed,
2327 and bypass the error if the user says to go ahead.
2328 QUERYSTRING is a name for the action that is being considered
2331 *STATPTR is used to store the stat information if the file exists.
2332 If the file does not exist, STATPTR->st_mode is set to 0.
2333 If STATPTR is null, we don't store into it.
2335 If QUICK is nonzero, we ask for y or n, not yes or no. */
2338 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2339 Lisp_Object absname
;
2340 unsigned char *querystring
;
2342 struct stat
*statptr
;
2345 register Lisp_Object tem
, encoded_filename
;
2346 struct stat statbuf
;
2347 struct gcpro gcpro1
;
2349 encoded_filename
= ENCODE_FILE (absname
);
2351 /* stat is a good way to tell whether the file exists,
2352 regardless of what access permissions it has. */
2353 if (stat (SDATA (encoded_filename
), &statbuf
) >= 0)
2356 Fsignal (Qfile_already_exists
,
2357 Fcons (build_string ("File already exists"),
2358 Fcons (absname
, Qnil
)));
2360 tem
= format2 ("File %s already exists; %s anyway? ",
2361 absname
, build_string (querystring
));
2363 tem
= Fy_or_n_p (tem
);
2365 tem
= do_yes_or_no_p (tem
);
2368 Fsignal (Qfile_already_exists
,
2369 Fcons (build_string ("File already exists"),
2370 Fcons (absname
, Qnil
)));
2377 statptr
->st_mode
= 0;
2382 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2383 "fCopy file: \nFCopy %s to file: \np\nP",
2384 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2385 If NEWNAME names a directory, copy FILE there.
2386 Signals a `file-already-exists' error if file NEWNAME already exists,
2387 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2388 A number as third arg means request confirmation if NEWNAME already exists.
2389 This is what happens in interactive use with M-x.
2390 Fourth arg KEEP-TIME non-nil means give the new file the same
2391 last-modified time as the old one. (This works on only some systems.)
2392 A prefix arg makes KEEP-TIME non-nil.
2393 Also set the file modes of the target file to match the source file. */)
2394 (file
, newname
, ok_if_already_exists
, keep_time
)
2395 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2398 char buf
[16 * 1024];
2399 struct stat st
, out_st
;
2400 Lisp_Object handler
;
2401 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2402 int count
= SPECPDL_INDEX ();
2403 int input_file_statable_p
;
2404 Lisp_Object encoded_file
, encoded_newname
;
2406 encoded_file
= encoded_newname
= Qnil
;
2407 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2408 CHECK_STRING (file
);
2409 CHECK_STRING (newname
);
2411 if (!NILP (Ffile_directory_p (newname
)))
2412 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2414 newname
= Fexpand_file_name (newname
, Qnil
);
2416 file
= Fexpand_file_name (file
, Qnil
);
2418 /* If the input file name has special constructs in it,
2419 call the corresponding file handler. */
2420 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2421 /* Likewise for output file name. */
2423 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2424 if (!NILP (handler
))
2425 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2426 ok_if_already_exists
, keep_time
));
2428 encoded_file
= ENCODE_FILE (file
);
2429 encoded_newname
= ENCODE_FILE (newname
);
2431 if (NILP (ok_if_already_exists
)
2432 || INTEGERP (ok_if_already_exists
))
2433 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2434 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2435 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2439 if (!CopyFile (SDATA (encoded_file
),
2440 SDATA (encoded_newname
),
2442 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2443 /* CopyFile retains the timestamp by default. */
2444 else if (NILP (keep_time
))
2450 EMACS_GET_TIME (now
);
2451 filename
= SDATA (encoded_newname
);
2453 /* Ensure file is writable while its modified time is set. */
2454 attributes
= GetFileAttributes (filename
);
2455 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2456 if (set_file_times (filename
, now
, now
))
2458 /* Restore original attributes. */
2459 SetFileAttributes (filename
, attributes
);
2460 Fsignal (Qfile_date_error
,
2461 Fcons (build_string ("Cannot set file date"),
2462 Fcons (newname
, Qnil
)));
2464 /* Restore original attributes. */
2465 SetFileAttributes (filename
, attributes
);
2467 #else /* not WINDOWSNT */
2469 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2473 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2475 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2477 /* We can only copy regular files and symbolic links. Other files are not
2479 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2481 #if !defined (DOS_NT) || __DJGPP__ > 1
2482 if (out_st
.st_mode
!= 0
2483 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2486 report_file_error ("Input and output files are the same",
2487 Fcons (file
, Fcons (newname
, Qnil
)));
2491 #if defined (S_ISREG) && defined (S_ISLNK)
2492 if (input_file_statable_p
)
2494 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2496 #if defined (EISDIR)
2497 /* Get a better looking error message. */
2500 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2503 #endif /* S_ISREG && S_ISLNK */
2506 /* Create the copy file with the same record format as the input file */
2507 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2510 /* System's default file type was set to binary by _fmode in emacs.c. */
2511 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2512 #else /* not MSDOS */
2513 ofd
= creat (SDATA (encoded_newname
), 0666);
2514 #endif /* not MSDOS */
2517 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2519 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2523 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2524 if (emacs_write (ofd
, buf
, n
) != n
)
2525 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2528 /* Closing the output clobbers the file times on some systems. */
2529 if (emacs_close (ofd
) < 0)
2530 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2532 if (input_file_statable_p
)
2534 if (!NILP (keep_time
))
2536 EMACS_TIME atime
, mtime
;
2537 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2538 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2539 if (set_file_times (SDATA (encoded_newname
),
2541 Fsignal (Qfile_date_error
,
2542 Fcons (build_string ("Cannot set file date"),
2543 Fcons (newname
, Qnil
)));
2546 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2548 #if defined (__DJGPP__) && __DJGPP__ > 1
2549 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2550 and if it can't, it tells so. Otherwise, under MSDOS we usually
2551 get only the READ bit, which will make the copied file read-only,
2552 so it's better not to chmod at all. */
2553 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2554 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2555 #endif /* DJGPP version 2 or newer */
2560 #endif /* WINDOWSNT */
2562 /* Discard the unwind protects. */
2563 specpdl_ptr
= specpdl
+ count
;
2569 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2570 Smake_directory_internal
, 1, 1, 0,
2571 doc
: /* Create a new directory named DIRECTORY. */)
2573 Lisp_Object directory
;
2575 const unsigned char *dir
;
2576 Lisp_Object handler
;
2577 Lisp_Object encoded_dir
;
2579 CHECK_STRING (directory
);
2580 directory
= Fexpand_file_name (directory
, Qnil
);
2582 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2583 if (!NILP (handler
))
2584 return call2 (handler
, Qmake_directory_internal
, directory
);
2586 encoded_dir
= ENCODE_FILE (directory
);
2588 dir
= SDATA (encoded_dir
);
2591 if (mkdir (dir
) != 0)
2593 if (mkdir (dir
, 0777) != 0)
2595 report_file_error ("Creating directory", Flist (1, &directory
));
2600 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2601 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2603 Lisp_Object directory
;
2605 const unsigned char *dir
;
2606 Lisp_Object handler
;
2607 Lisp_Object encoded_dir
;
2609 CHECK_STRING (directory
);
2610 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2612 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2613 if (!NILP (handler
))
2614 return call2 (handler
, Qdelete_directory
, directory
);
2616 encoded_dir
= ENCODE_FILE (directory
);
2618 dir
= SDATA (encoded_dir
);
2620 if (rmdir (dir
) != 0)
2621 report_file_error ("Removing directory", Flist (1, &directory
));
2626 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2627 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2628 If file has multiple names, it continues to exist with the other names. */)
2630 Lisp_Object filename
;
2632 Lisp_Object handler
;
2633 Lisp_Object encoded_file
;
2634 struct gcpro gcpro1
;
2637 if (!NILP (Ffile_directory_p (filename
))
2638 && NILP (Ffile_symlink_p (filename
)))
2639 Fsignal (Qfile_error
,
2640 Fcons (build_string ("Removing old name: is a directory"),
2641 Fcons (filename
, Qnil
)));
2643 filename
= Fexpand_file_name (filename
, Qnil
);
2645 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2646 if (!NILP (handler
))
2647 return call2 (handler
, Qdelete_file
, filename
);
2649 encoded_file
= ENCODE_FILE (filename
);
2651 if (0 > unlink (SDATA (encoded_file
)))
2652 report_file_error ("Removing old name", Flist (1, &filename
));
2657 internal_delete_file_1 (ignore
)
2663 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2666 internal_delete_file (filename
)
2667 Lisp_Object filename
;
2669 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2670 Qt
, internal_delete_file_1
));
2673 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2674 "fRename file: \nFRename %s to file: \np",
2675 doc
: /* Rename FILE as NEWNAME. Both args strings.
2676 If file has names other than FILE, it continues to have those names.
2677 Signals a `file-already-exists' error if a file NEWNAME already exists
2678 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2679 A number as third arg means request confirmation if NEWNAME already exists.
2680 This is what happens in interactive use with M-x. */)
2681 (file
, newname
, ok_if_already_exists
)
2682 Lisp_Object file
, newname
, ok_if_already_exists
;
2685 Lisp_Object args
[2];
2687 Lisp_Object handler
;
2688 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2689 Lisp_Object encoded_file
, encoded_newname
;
2691 encoded_file
= encoded_newname
= Qnil
;
2692 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2693 CHECK_STRING (file
);
2694 CHECK_STRING (newname
);
2695 file
= Fexpand_file_name (file
, Qnil
);
2696 newname
= Fexpand_file_name (newname
, Qnil
);
2698 /* If the file name has special constructs in it,
2699 call the corresponding file handler. */
2700 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2702 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2703 if (!NILP (handler
))
2704 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2705 file
, newname
, ok_if_already_exists
));
2707 encoded_file
= ENCODE_FILE (file
);
2708 encoded_newname
= ENCODE_FILE (newname
);
2711 /* If the file names are identical but for the case, don't ask for
2712 confirmation: they simply want to change the letter-case of the
2714 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2716 if (NILP (ok_if_already_exists
)
2717 || INTEGERP (ok_if_already_exists
))
2718 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2719 INTEGERP (ok_if_already_exists
), 0, 0);
2721 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2723 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2724 || 0 > unlink (SDATA (encoded_file
)))
2729 Fcopy_file (file
, newname
,
2730 /* We have already prompted if it was an integer,
2731 so don't have copy-file prompt again. */
2732 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2733 Fdelete_file (file
);
2740 report_file_error ("Renaming", Flist (2, args
));
2743 report_file_error ("Renaming", Flist (2, &file
));
2750 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2751 "fAdd name to file: \nFName to add to %s: \np",
2752 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2753 Signals a `file-already-exists' error if a file NEWNAME already exists
2754 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2755 A number as third arg means request confirmation if NEWNAME already exists.
2756 This is what happens in interactive use with M-x. */)
2757 (file
, newname
, ok_if_already_exists
)
2758 Lisp_Object file
, newname
, ok_if_already_exists
;
2761 Lisp_Object args
[2];
2763 Lisp_Object handler
;
2764 Lisp_Object encoded_file
, encoded_newname
;
2765 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2767 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2768 encoded_file
= encoded_newname
= Qnil
;
2769 CHECK_STRING (file
);
2770 CHECK_STRING (newname
);
2771 file
= Fexpand_file_name (file
, Qnil
);
2772 newname
= Fexpand_file_name (newname
, Qnil
);
2774 /* If the file name has special constructs in it,
2775 call the corresponding file handler. */
2776 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2777 if (!NILP (handler
))
2778 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2779 newname
, ok_if_already_exists
));
2781 /* If the new name has special constructs in it,
2782 call the corresponding file handler. */
2783 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2784 if (!NILP (handler
))
2785 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2786 newname
, ok_if_already_exists
));
2788 encoded_file
= ENCODE_FILE (file
);
2789 encoded_newname
= ENCODE_FILE (newname
);
2791 if (NILP (ok_if_already_exists
)
2792 || INTEGERP (ok_if_already_exists
))
2793 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2794 INTEGERP (ok_if_already_exists
), 0, 0);
2796 unlink (SDATA (newname
));
2797 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2802 report_file_error ("Adding new name", Flist (2, args
));
2804 report_file_error ("Adding new name", Flist (2, &file
));
2813 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2814 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2815 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2816 Signals a `file-already-exists' error if a file LINKNAME already exists
2817 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2818 A number as third arg means request confirmation if LINKNAME already exists.
2819 This happens for interactive use with M-x. */)
2820 (filename
, linkname
, ok_if_already_exists
)
2821 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2824 Lisp_Object args
[2];
2826 Lisp_Object handler
;
2827 Lisp_Object encoded_filename
, encoded_linkname
;
2828 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2830 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2831 encoded_filename
= encoded_linkname
= Qnil
;
2832 CHECK_STRING (filename
);
2833 CHECK_STRING (linkname
);
2834 /* If the link target has a ~, we must expand it to get
2835 a truly valid file name. Otherwise, do not expand;
2836 we want to permit links to relative file names. */
2837 if (SREF (filename
, 0) == '~')
2838 filename
= Fexpand_file_name (filename
, Qnil
);
2839 linkname
= Fexpand_file_name (linkname
, Qnil
);
2841 /* If the file name has special constructs in it,
2842 call the corresponding file handler. */
2843 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2844 if (!NILP (handler
))
2845 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2846 linkname
, ok_if_already_exists
));
2848 /* If the new link name has special constructs in it,
2849 call the corresponding file handler. */
2850 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2851 if (!NILP (handler
))
2852 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2853 linkname
, ok_if_already_exists
));
2855 encoded_filename
= ENCODE_FILE (filename
);
2856 encoded_linkname
= ENCODE_FILE (linkname
);
2858 if (NILP (ok_if_already_exists
)
2859 || INTEGERP (ok_if_already_exists
))
2860 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2861 INTEGERP (ok_if_already_exists
), 0, 0);
2862 if (0 > symlink (SDATA (encoded_filename
),
2863 SDATA (encoded_linkname
)))
2865 /* If we didn't complain already, silently delete existing file. */
2866 if (errno
== EEXIST
)
2868 unlink (SDATA (encoded_linkname
));
2869 if (0 <= symlink (SDATA (encoded_filename
),
2870 SDATA (encoded_linkname
)))
2880 report_file_error ("Making symbolic link", Flist (2, args
));
2882 report_file_error ("Making symbolic link", Flist (2, &filename
));
2888 #endif /* S_IFLNK */
2892 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2893 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2894 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2895 If STRING is nil or a null string, the logical name NAME is deleted. */)
2900 CHECK_STRING (name
);
2902 delete_logical_name (SDATA (name
));
2905 CHECK_STRING (string
);
2907 if (SCHARS (string
) == 0)
2908 delete_logical_name (SDATA (name
));
2910 define_logical_name (SDATA (name
), SDATA (string
));
2919 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2920 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2922 Lisp_Object path
, login
;
2926 CHECK_STRING (path
);
2927 CHECK_STRING (login
);
2929 netresult
= netunam (SDATA (path
), SDATA (login
));
2931 if (netresult
== -1)
2936 #endif /* HPUX_NET */
2938 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2940 doc
: /* Return t if file FILENAME specifies an absolute file name.
2941 On Unix, this is a name starting with a `/' or a `~'. */)
2943 Lisp_Object filename
;
2945 const unsigned char *ptr
;
2947 CHECK_STRING (filename
);
2948 ptr
= SDATA (filename
);
2949 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2951 /* ??? This criterion is probably wrong for '<'. */
2952 || index (ptr
, ':') || index (ptr
, '<')
2953 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2957 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2965 /* Return nonzero if file FILENAME exists and can be executed. */
2968 check_executable (filename
)
2972 int len
= strlen (filename
);
2975 if (stat (filename
, &st
) < 0)
2977 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2978 return ((st
.st_mode
& S_IEXEC
) != 0);
2980 return (S_ISREG (st
.st_mode
)
2982 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2983 || stricmp (suffix
, ".exe") == 0
2984 || stricmp (suffix
, ".bat") == 0)
2985 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2986 #endif /* not WINDOWSNT */
2987 #else /* not DOS_NT */
2988 #ifdef HAVE_EUIDACCESS
2989 return (euidaccess (filename
, 1) >= 0);
2991 /* Access isn't quite right because it uses the real uid
2992 and we really want to test with the effective uid.
2993 But Unix doesn't give us a right way to do it. */
2994 return (access (filename
, 1) >= 0);
2996 #endif /* not DOS_NT */
2999 /* Return nonzero if file FILENAME exists and can be written. */
3002 check_writable (filename
)
3007 if (stat (filename
, &st
) < 0)
3009 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3010 #else /* not MSDOS */
3011 #ifdef HAVE_EUIDACCESS
3012 return (euidaccess (filename
, 2) >= 0);
3014 /* Access isn't quite right because it uses the real uid
3015 and we really want to test with the effective uid.
3016 But Unix doesn't give us a right way to do it.
3017 Opening with O_WRONLY could work for an ordinary file,
3018 but would lose for directories. */
3019 return (access (filename
, 2) >= 0);
3021 #endif /* not MSDOS */
3024 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3025 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3026 See also `file-readable-p' and `file-attributes'. */)
3028 Lisp_Object filename
;
3030 Lisp_Object absname
;
3031 Lisp_Object handler
;
3032 struct stat statbuf
;
3034 CHECK_STRING (filename
);
3035 absname
= Fexpand_file_name (filename
, Qnil
);
3037 /* If the file name has special constructs in it,
3038 call the corresponding file handler. */
3039 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3040 if (!NILP (handler
))
3041 return call2 (handler
, Qfile_exists_p
, absname
);
3043 absname
= ENCODE_FILE (absname
);
3045 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3048 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3049 doc
: /* Return t if FILENAME can be executed by you.
3050 For a directory, this means you can access files in that directory. */)
3052 Lisp_Object filename
;
3054 Lisp_Object absname
;
3055 Lisp_Object handler
;
3057 CHECK_STRING (filename
);
3058 absname
= Fexpand_file_name (filename
, Qnil
);
3060 /* If the file name has special constructs in it,
3061 call the corresponding file handler. */
3062 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3063 if (!NILP (handler
))
3064 return call2 (handler
, Qfile_executable_p
, absname
);
3066 absname
= ENCODE_FILE (absname
);
3068 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3071 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3072 doc
: /* Return t if file FILENAME exists and you can read it.
3073 See also `file-exists-p' and `file-attributes'. */)
3075 Lisp_Object filename
;
3077 Lisp_Object absname
;
3078 Lisp_Object handler
;
3081 struct stat statbuf
;
3083 CHECK_STRING (filename
);
3084 absname
= Fexpand_file_name (filename
, Qnil
);
3086 /* If the file name has special constructs in it,
3087 call the corresponding file handler. */
3088 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3089 if (!NILP (handler
))
3090 return call2 (handler
, Qfile_readable_p
, absname
);
3092 absname
= ENCODE_FILE (absname
);
3094 #if defined(DOS_NT) || defined(macintosh)
3095 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3097 if (access (SDATA (absname
), 0) == 0)
3100 #else /* not DOS_NT and not macintosh */
3102 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3103 /* Opening a fifo without O_NONBLOCK can wait.
3104 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3105 except in the case of a fifo, on a system which handles it. */
3106 desc
= stat (SDATA (absname
), &statbuf
);
3109 if (S_ISFIFO (statbuf
.st_mode
))
3110 flags
|= O_NONBLOCK
;
3112 desc
= emacs_open (SDATA (absname
), flags
, 0);
3117 #endif /* not DOS_NT and not macintosh */
3120 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3122 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3123 doc
: /* Return t if file FILENAME can be written or created by you. */)
3125 Lisp_Object filename
;
3127 Lisp_Object absname
, dir
, encoded
;
3128 Lisp_Object handler
;
3129 struct stat statbuf
;
3131 CHECK_STRING (filename
);
3132 absname
= Fexpand_file_name (filename
, Qnil
);
3134 /* If the file name has special constructs in it,
3135 call the corresponding file handler. */
3136 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3137 if (!NILP (handler
))
3138 return call2 (handler
, Qfile_writable_p
, absname
);
3140 encoded
= ENCODE_FILE (absname
);
3141 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3142 return (check_writable (SDATA (encoded
))
3145 dir
= Ffile_name_directory (absname
);
3148 dir
= Fdirectory_file_name (dir
);
3152 dir
= Fdirectory_file_name (dir
);
3155 dir
= ENCODE_FILE (dir
);
3157 /* The read-only attribute of the parent directory doesn't affect
3158 whether a file or directory can be created within it. Some day we
3159 should check ACLs though, which do affect this. */
3160 if (stat (SDATA (dir
), &statbuf
) < 0)
3162 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3164 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3169 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3170 doc
: /* Access file FILENAME, and get an error if that does not work.
3171 The second argument STRING is used in the error message.
3172 If there is no error, we return nil. */)
3174 Lisp_Object filename
, string
;
3176 Lisp_Object handler
, encoded_filename
, absname
;
3179 CHECK_STRING (filename
);
3180 absname
= Fexpand_file_name (filename
, Qnil
);
3182 CHECK_STRING (string
);
3184 /* If the file name has special constructs in it,
3185 call the corresponding file handler. */
3186 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3187 if (!NILP (handler
))
3188 return call3 (handler
, Qaccess_file
, absname
, string
);
3190 encoded_filename
= ENCODE_FILE (absname
);
3192 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3194 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3200 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3201 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3202 The value is the link target, as a string.
3203 Otherwise returns nil. */)
3205 Lisp_Object filename
;
3207 Lisp_Object handler
;
3209 CHECK_STRING (filename
);
3210 filename
= Fexpand_file_name (filename
, Qnil
);
3212 /* If the file name has special constructs in it,
3213 call the corresponding file handler. */
3214 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3215 if (!NILP (handler
))
3216 return call2 (handler
, Qfile_symlink_p
, filename
);
3225 filename
= ENCODE_FILE (filename
);
3232 buf
= (char *) xrealloc (buf
, bufsize
);
3233 bzero (buf
, bufsize
);
3236 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3240 /* HP-UX reports ERANGE if buffer is too small. */
3241 if (errno
== ERANGE
)
3251 while (valsize
>= bufsize
);
3253 val
= make_string (buf
, valsize
);
3254 if (buf
[0] == '/' && index (buf
, ':'))
3255 val
= concat2 (build_string ("/:"), val
);
3257 val
= DECODE_FILE (val
);
3260 #else /* not S_IFLNK */
3262 #endif /* not S_IFLNK */
3265 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3266 doc
: /* Return t if FILENAME names an existing directory.
3267 Symbolic links to directories count as directories.
3268 See `file-symlink-p' to distinguish symlinks. */)
3270 Lisp_Object filename
;
3272 register Lisp_Object absname
;
3274 Lisp_Object handler
;
3276 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3278 /* If the file name has special constructs in it,
3279 call the corresponding file handler. */
3280 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3281 if (!NILP (handler
))
3282 return call2 (handler
, Qfile_directory_p
, absname
);
3284 absname
= ENCODE_FILE (absname
);
3286 if (stat (SDATA (absname
), &st
) < 0)
3288 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3291 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3292 doc
: /* Return t if file FILENAME names a directory you can open.
3293 For the value to be t, FILENAME must specify the name of a directory as a file,
3294 and the directory must allow you to open files in it. In order to use a
3295 directory as a buffer's current directory, this predicate must return true.
3296 A directory name spec may be given instead; then the value is t
3297 if the directory so specified exists and really is a readable and
3298 searchable directory. */)
3300 Lisp_Object filename
;
3302 Lisp_Object handler
;
3304 struct gcpro gcpro1
;
3306 /* If the file name has special constructs in it,
3307 call the corresponding file handler. */
3308 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3309 if (!NILP (handler
))
3310 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3313 tem
= (NILP (Ffile_directory_p (filename
))
3314 || NILP (Ffile_executable_p (filename
)));
3316 return tem
? Qnil
: Qt
;
3319 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3320 doc
: /* Return t if file FILENAME is the name of a regular file.
3321 This is the sort of file that holds an ordinary stream of data bytes. */)
3323 Lisp_Object filename
;
3325 register Lisp_Object absname
;
3327 Lisp_Object handler
;
3329 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3331 /* If the file name has special constructs in it,
3332 call the corresponding file handler. */
3333 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3334 if (!NILP (handler
))
3335 return call2 (handler
, Qfile_regular_p
, absname
);
3337 absname
= ENCODE_FILE (absname
);
3342 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3344 /* Tell stat to use expensive method to get accurate info. */
3345 Vw32_get_true_file_attributes
= Qt
;
3346 result
= stat (SDATA (absname
), &st
);
3347 Vw32_get_true_file_attributes
= tem
;
3351 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3354 if (stat (SDATA (absname
), &st
) < 0)
3356 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3360 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3361 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
3363 Lisp_Object filename
;
3365 Lisp_Object absname
;
3367 Lisp_Object handler
;
3369 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3371 /* If the file name has special constructs in it,
3372 call the corresponding file handler. */
3373 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3374 if (!NILP (handler
))
3375 return call2 (handler
, Qfile_modes
, absname
);
3377 absname
= ENCODE_FILE (absname
);
3379 if (stat (SDATA (absname
), &st
) < 0)
3381 #if defined (MSDOS) && __DJGPP__ < 2
3382 if (check_executable (SDATA (absname
)))
3383 st
.st_mode
|= S_IEXEC
;
3384 #endif /* MSDOS && __DJGPP__ < 2 */
3386 return make_number (st
.st_mode
& 07777);
3389 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3390 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3391 Only the 12 low bits of MODE are used. */)
3393 Lisp_Object filename
, mode
;
3395 Lisp_Object absname
, encoded_absname
;
3396 Lisp_Object handler
;
3398 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3399 CHECK_NUMBER (mode
);
3401 /* If the file name has special constructs in it,
3402 call the corresponding file handler. */
3403 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3404 if (!NILP (handler
))
3405 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3407 encoded_absname
= ENCODE_FILE (absname
);
3409 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3410 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3415 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3416 doc
: /* Set the file permission bits for newly created files.
3417 The argument MODE should be an integer; only the low 9 bits are used.
3418 This setting is inherited by subprocesses. */)
3422 CHECK_NUMBER (mode
);
3424 umask ((~ XINT (mode
)) & 0777);
3429 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3430 doc
: /* Return the default file protection for created files.
3431 The value is an integer. */)
3437 realmask
= umask (0);
3440 XSETINT (value
, (~ realmask
) & 0777);
3450 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3451 doc
: /* Tell Unix to finish all pending disk updates. */)
3460 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3461 doc
: /* Return t if file FILE1 is newer than file FILE2.
3462 If FILE1 does not exist, the answer is nil;
3463 otherwise, if FILE2 does not exist, the answer is t. */)
3465 Lisp_Object file1
, file2
;
3467 Lisp_Object absname1
, absname2
;
3470 Lisp_Object handler
;
3471 struct gcpro gcpro1
, gcpro2
;
3473 CHECK_STRING (file1
);
3474 CHECK_STRING (file2
);
3477 GCPRO2 (absname1
, file2
);
3478 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3479 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3482 /* If the file name has special constructs in it,
3483 call the corresponding file handler. */
3484 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3486 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3487 if (!NILP (handler
))
3488 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3490 GCPRO2 (absname1
, absname2
);
3491 absname1
= ENCODE_FILE (absname1
);
3492 absname2
= ENCODE_FILE (absname2
);
3495 if (stat (SDATA (absname1
), &st
) < 0)
3498 mtime1
= st
.st_mtime
;
3500 if (stat (SDATA (absname2
), &st
) < 0)
3503 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3507 Lisp_Object Qfind_buffer_file_type
;
3510 #ifndef READ_BUF_SIZE
3511 #define READ_BUF_SIZE (64 << 10)
3514 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3516 /* This function is called after Lisp functions to decide a coding
3517 system are called, or when they cause an error. Before they are
3518 called, the current buffer is set unibyte and it contains only a
3519 newly inserted text (thus the buffer was empty before the
3522 The functions may set markers, overlays, text properties, or even
3523 alter the buffer contents, change the current buffer.
3525 Here, we reset all those changes by:
3526 o set back the current buffer.
3527 o move all markers and overlays to BEG.
3528 o remove all text properties.
3529 o set back the buffer multibyteness. */
3532 decide_coding_unwind (unwind_data
)
3533 Lisp_Object unwind_data
;
3535 Lisp_Object multibyte
, undo_list
, buffer
;
3537 multibyte
= XCAR (unwind_data
);
3538 unwind_data
= XCDR (unwind_data
);
3539 undo_list
= XCAR (unwind_data
);
3540 buffer
= XCDR (unwind_data
);
3542 if (current_buffer
!= XBUFFER (buffer
))
3543 set_buffer_internal (XBUFFER (buffer
));
3544 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3545 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3546 BUF_INTERVALS (current_buffer
) = 0;
3547 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3549 /* Now we are safe to change the buffer's multibyteness directly. */
3550 current_buffer
->enable_multibyte_characters
= multibyte
;
3551 current_buffer
->undo_list
= undo_list
;
3557 /* Used to pass values from insert-file-contents to read_non_regular. */
3559 static int non_regular_fd
;
3560 static int non_regular_inserted
;
3561 static int non_regular_nbytes
;
3564 /* Read from a non-regular file.
3565 Read non_regular_trytry bytes max from non_regular_fd.
3566 Non_regular_inserted specifies where to put the read bytes.
3567 Value is the number of bytes read. */
3576 nbytes
= emacs_read (non_regular_fd
,
3577 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3578 non_regular_nbytes
);
3580 return make_number (nbytes
);
3584 /* Condition-case handler used when reading from non-regular files
3585 in insert-file-contents. */
3588 read_non_regular_quit ()
3594 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3596 doc
: /* Insert contents of file FILENAME after point.
3597 Returns list of absolute file name and number of characters inserted.
3598 If second argument VISIT is non-nil, the buffer's visited filename
3599 and last save file modtime are set, and it is marked unmodified.
3600 If visiting and the file does not exist, visiting is completed
3601 before the error is signaled.
3602 The optional third and fourth arguments BEG and END
3603 specify what portion of the file to insert.
3604 These arguments count bytes in the file, not characters in the buffer.
3605 If VISIT is non-nil, BEG and END must be nil.
3607 If optional fifth argument REPLACE is non-nil,
3608 it means replace the current buffer contents (in the accessible portion)
3609 with the file contents. This is better than simply deleting and inserting
3610 the whole thing because (1) it preserves some marker positions
3611 and (2) it puts less data in the undo list.
3612 When REPLACE is non-nil, the value is the number of characters actually read,
3613 which is often less than the number of characters to be read.
3615 This does code conversion according to the value of
3616 `coding-system-for-read' or `file-coding-system-alist',
3617 and sets the variable `last-coding-system-used' to the coding system
3619 (filename
, visit
, beg
, end
, replace
)
3620 Lisp_Object filename
, visit
, beg
, end
, replace
;
3625 register int how_much
;
3626 register int unprocessed
;
3627 int count
= SPECPDL_INDEX ();
3628 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3629 Lisp_Object handler
, val
, insval
, orig_filename
;
3632 int not_regular
= 0;
3633 unsigned char read_buf
[READ_BUF_SIZE
];
3634 struct coding_system coding
;
3635 unsigned char buffer
[1 << 14];
3636 int replace_handled
= 0;
3637 int set_coding_system
= 0;
3638 int coding_system_decided
= 0;
3641 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3642 error ("Cannot do file visiting in an indirect buffer");
3644 if (!NILP (current_buffer
->read_only
))
3645 Fbarf_if_buffer_read_only ();
3649 orig_filename
= Qnil
;
3651 GCPRO4 (filename
, val
, p
, orig_filename
);
3653 CHECK_STRING (filename
);
3654 filename
= Fexpand_file_name (filename
, Qnil
);
3656 /* If the file name has special constructs in it,
3657 call the corresponding file handler. */
3658 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3659 if (!NILP (handler
))
3661 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3662 visit
, beg
, end
, replace
);
3663 if (CONSP (val
) && CONSP (XCDR (val
)))
3664 inserted
= XINT (XCAR (XCDR (val
)));
3668 orig_filename
= filename
;
3669 filename
= ENCODE_FILE (filename
);
3675 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3677 /* Tell stat to use expensive method to get accurate info. */
3678 Vw32_get_true_file_attributes
= Qt
;
3679 total
= stat (SDATA (filename
), &st
);
3680 Vw32_get_true_file_attributes
= tem
;
3685 if (stat (SDATA (filename
), &st
) < 0)
3687 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3688 || fstat (fd
, &st
) < 0)
3689 #endif /* not APOLLO */
3690 #endif /* WINDOWSNT */
3692 if (fd
>= 0) emacs_close (fd
);
3695 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3698 if (!NILP (Vcoding_system_for_read
))
3699 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3704 /* This code will need to be changed in order to work on named
3705 pipes, and it's probably just not worth it. So we should at
3706 least signal an error. */
3707 if (!S_ISREG (st
.st_mode
))
3714 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3715 Fsignal (Qfile_error
,
3716 Fcons (build_string ("not a regular file"),
3717 Fcons (orig_filename
, Qnil
)));
3722 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3725 /* Replacement should preserve point as it preserves markers. */
3726 if (!NILP (replace
))
3727 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3729 record_unwind_protect (close_file_unwind
, make_number (fd
));
3731 /* Supposedly happens on VMS. */
3732 /* Can happen on any platform that uses long as type of off_t, but allows
3733 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3734 give a message suitable for the latter case. */
3735 if (! not_regular
&& st
.st_size
< 0)
3736 error ("Maximum buffer size exceeded");
3738 /* Prevent redisplay optimizations. */
3739 current_buffer
->clip_changed
= 1;
3743 if (!NILP (beg
) || !NILP (end
))
3744 error ("Attempt to visit less than an entire file");
3745 if (BEG
< Z
&& NILP (replace
))
3746 error ("Cannot do file visiting in a non-empty buffer");
3752 XSETFASTINT (beg
, 0);
3760 XSETINT (end
, st
.st_size
);
3762 /* Arithmetic overflow can occur if an Emacs integer cannot
3763 represent the file size, or if the calculations below
3764 overflow. The calculations below double the file size
3765 twice, so check that it can be multiplied by 4 safely. */
3766 if (XINT (end
) != st
.st_size
3767 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3768 error ("Maximum buffer size exceeded");
3770 /* The file size returned from stat may be zero, but data
3771 may be readable nonetheless, for example when this is a
3772 file in the /proc filesystem. */
3773 if (st
.st_size
== 0)
3774 XSETINT (end
, READ_BUF_SIZE
);
3778 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3780 /* We use emacs-mule for auto saving... */
3781 setup_coding_system (Qemacs_mule
, &coding
);
3782 /* ... but with the special flag to indicate to read in a
3783 multibyte sequence for eight-bit-control char as is. */
3785 coding
.src_multibyte
= 0;
3786 coding
.dst_multibyte
3787 = !NILP (current_buffer
->enable_multibyte_characters
);
3788 coding
.eol_type
= CODING_EOL_LF
;
3789 coding_system_decided
= 1;
3793 /* Decide the coding system to use for reading the file now
3794 because we can't use an optimized method for handling
3795 `coding:' tag if the current buffer is not empty. */
3799 if (!NILP (Vcoding_system_for_read
))
3800 val
= Vcoding_system_for_read
;
3801 else if (! NILP (replace
))
3802 /* In REPLACE mode, we can use the same coding system
3803 that was used to visit the file. */
3804 val
= current_buffer
->buffer_file_coding_system
;
3807 /* Don't try looking inside a file for a coding system
3808 specification if it is not seekable. */
3809 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3811 /* Find a coding system specified in the heading two
3812 lines or in the tailing several lines of the file.
3813 We assume that the 1K-byte and 3K-byte for heading
3814 and tailing respectively are sufficient for this
3818 if (st
.st_size
<= (1024 * 4))
3819 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3822 nread
= emacs_read (fd
, read_buf
, 1024);
3825 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3826 report_file_error ("Setting file position",
3827 Fcons (orig_filename
, Qnil
));
3828 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3833 error ("IO error reading %s: %s",
3834 SDATA (orig_filename
), emacs_strerror (errno
));
3837 struct buffer
*prev
= current_buffer
;
3841 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3843 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3844 buf
= XBUFFER (buffer
);
3846 delete_all_overlays (buf
);
3847 buf
->directory
= current_buffer
->directory
;
3848 buf
->read_only
= Qnil
;
3849 buf
->filename
= Qnil
;
3850 buf
->undo_list
= Qt
;
3851 eassert (buf
->overlays_before
== NULL
);
3852 eassert (buf
->overlays_after
== NULL
);
3854 set_buffer_internal (buf
);
3856 buf
->enable_multibyte_characters
= Qnil
;
3858 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3859 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3860 val
= call2 (Vset_auto_coding_function
,
3861 filename
, make_number (nread
));
3862 set_buffer_internal (prev
);
3864 /* Discard the unwind protect for recovering the
3868 /* Rewind the file for the actual read done later. */
3869 if (lseek (fd
, 0, 0) < 0)
3870 report_file_error ("Setting file position",
3871 Fcons (orig_filename
, Qnil
));
3877 /* If we have not yet decided a coding system, check
3878 file-coding-system-alist. */
3879 Lisp_Object args
[6], coding_systems
;
3881 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3882 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3883 coding_systems
= Ffind_operation_coding_system (6, args
);
3884 if (CONSP (coding_systems
))
3885 val
= XCAR (coding_systems
);
3889 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3890 /* Ensure we set Vlast_coding_system_used. */
3891 set_coding_system
= 1;
3893 if (NILP (current_buffer
->enable_multibyte_characters
)
3895 /* We must suppress all character code conversion except for
3896 end-of-line conversion. */
3897 setup_raw_text_coding_system (&coding
);
3899 coding
.src_multibyte
= 0;
3900 coding
.dst_multibyte
3901 = !NILP (current_buffer
->enable_multibyte_characters
);
3902 coding_system_decided
= 1;
3905 /* If requested, replace the accessible part of the buffer
3906 with the file contents. Avoid replacing text at the
3907 beginning or end of the buffer that matches the file contents;
3908 that preserves markers pointing to the unchanged parts.
3910 Here we implement this feature in an optimized way
3911 for the case where code conversion is NOT needed.
3912 The following if-statement handles the case of conversion
3913 in a less optimal way.
3915 If the code conversion is "automatic" then we try using this
3916 method and hope for the best.
3917 But if we discover the need for conversion, we give up on this method
3918 and let the following if-statement handle the replace job. */
3921 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3923 /* same_at_start and same_at_end count bytes,
3924 because file access counts bytes
3925 and BEG and END count bytes. */
3926 int same_at_start
= BEGV_BYTE
;
3927 int same_at_end
= ZV_BYTE
;
3929 /* There is still a possibility we will find the need to do code
3930 conversion. If that happens, we set this variable to 1 to
3931 give up on handling REPLACE in the optimized way. */
3932 int giveup_match_end
= 0;
3934 if (XINT (beg
) != 0)
3936 if (lseek (fd
, XINT (beg
), 0) < 0)
3937 report_file_error ("Setting file position",
3938 Fcons (orig_filename
, Qnil
));
3943 /* Count how many chars at the start of the file
3944 match the text at the beginning of the buffer. */
3949 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3951 error ("IO error reading %s: %s",
3952 SDATA (orig_filename
), emacs_strerror (errno
));
3953 else if (nread
== 0)
3956 if (coding
.type
== coding_type_undecided
)
3957 detect_coding (&coding
, buffer
, nread
);
3958 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
3959 /* We found that the file should be decoded somehow.
3960 Let's give up here. */
3962 giveup_match_end
= 1;
3966 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3967 detect_eol (&coding
, buffer
, nread
);
3968 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3969 && coding
.eol_type
!= CODING_EOL_LF
)
3970 /* We found that the format of eol should be decoded.
3971 Let's give up here. */
3973 giveup_match_end
= 1;
3978 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3979 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3980 same_at_start
++, bufpos
++;
3981 /* If we found a discrepancy, stop the scan.
3982 Otherwise loop around and scan the next bufferful. */
3983 if (bufpos
!= nread
)
3987 /* If the file matches the buffer completely,
3988 there's no need to replace anything. */
3989 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3993 /* Truncate the buffer to the size of the file. */
3994 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3999 /* Count how many chars at the end of the file
4000 match the text at the end of the buffer. But, if we have
4001 already found that decoding is necessary, don't waste time. */
4002 while (!giveup_match_end
)
4004 int total_read
, nread
, bufpos
, curpos
, trial
;
4006 /* At what file position are we now scanning? */
4007 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4008 /* If the entire file matches the buffer tail, stop the scan. */
4011 /* How much can we scan in the next step? */
4012 trial
= min (curpos
, sizeof buffer
);
4013 if (lseek (fd
, curpos
- trial
, 0) < 0)
4014 report_file_error ("Setting file position",
4015 Fcons (orig_filename
, Qnil
));
4017 total_read
= nread
= 0;
4018 while (total_read
< trial
)
4020 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4022 error ("IO error reading %s: %s",
4023 SDATA (orig_filename
), emacs_strerror (errno
));
4024 else if (nread
== 0)
4026 total_read
+= nread
;
4029 /* Scan this bufferful from the end, comparing with
4030 the Emacs buffer. */
4031 bufpos
= total_read
;
4033 /* Compare with same_at_start to avoid counting some buffer text
4034 as matching both at the file's beginning and at the end. */
4035 while (bufpos
> 0 && same_at_end
> same_at_start
4036 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4037 same_at_end
--, bufpos
--;
4039 /* If we found a discrepancy, stop the scan.
4040 Otherwise loop around and scan the preceding bufferful. */
4043 /* If this discrepancy is because of code conversion,
4044 we cannot use this method; giveup and try the other. */
4045 if (same_at_end
> same_at_start
4046 && FETCH_BYTE (same_at_end
- 1) >= 0200
4047 && ! NILP (current_buffer
->enable_multibyte_characters
)
4048 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4049 giveup_match_end
= 1;
4058 if (! giveup_match_end
)
4062 /* We win! We can handle REPLACE the optimized way. */
4064 /* Extend the start of non-matching text area to multibyte
4065 character boundary. */
4066 if (! NILP (current_buffer
->enable_multibyte_characters
))
4067 while (same_at_start
> BEGV_BYTE
4068 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4071 /* Extend the end of non-matching text area to multibyte
4072 character boundary. */
4073 if (! NILP (current_buffer
->enable_multibyte_characters
))
4074 while (same_at_end
< ZV_BYTE
4075 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4078 /* Don't try to reuse the same piece of text twice. */
4079 overlap
= (same_at_start
- BEGV_BYTE
4080 - (same_at_end
+ st
.st_size
- ZV
));
4082 same_at_end
+= overlap
;
4084 /* Arrange to read only the nonmatching middle part of the file. */
4085 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4086 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4088 del_range_byte (same_at_start
, same_at_end
, 0);
4089 /* Insert from the file at the proper position. */
4090 temp
= BYTE_TO_CHAR (same_at_start
);
4091 SET_PT_BOTH (temp
, same_at_start
);
4093 /* If display currently starts at beginning of line,
4094 keep it that way. */
4095 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4096 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4098 replace_handled
= 1;
4102 /* If requested, replace the accessible part of the buffer
4103 with the file contents. Avoid replacing text at the
4104 beginning or end of the buffer that matches the file contents;
4105 that preserves markers pointing to the unchanged parts.
4107 Here we implement this feature for the case where code conversion
4108 is needed, in a simple way that needs a lot of memory.
4109 The preceding if-statement handles the case of no conversion
4110 in a more optimized way. */
4111 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4113 int same_at_start
= BEGV_BYTE
;
4114 int same_at_end
= ZV_BYTE
;
4117 /* Make sure that the gap is large enough. */
4118 int bufsize
= 2 * st
.st_size
;
4119 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4122 /* First read the whole file, performing code conversion into
4123 CONVERSION_BUFFER. */
4125 if (lseek (fd
, XINT (beg
), 0) < 0)
4127 xfree (conversion_buffer
);
4128 report_file_error ("Setting file position",
4129 Fcons (orig_filename
, Qnil
));
4132 total
= st
.st_size
; /* Total bytes in the file. */
4133 how_much
= 0; /* Bytes read from file so far. */
4134 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4135 unprocessed
= 0; /* Bytes not processed in previous loop. */
4137 while (how_much
< total
)
4139 /* try is reserved in some compilers (Microsoft C) */
4140 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4141 unsigned char *destination
= read_buf
+ unprocessed
;
4144 /* Allow quitting out of the actual I/O. */
4147 this = emacs_read (fd
, destination
, trytry
);
4150 if (this < 0 || this + unprocessed
== 0)
4158 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4160 int require
, result
;
4162 this += unprocessed
;
4164 /* If we are using more space than estimated,
4165 make CONVERSION_BUFFER bigger. */
4166 require
= decoding_buffer_size (&coding
, this);
4167 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4169 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4170 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4173 /* Convert this batch with results in CONVERSION_BUFFER. */
4174 if (how_much
>= total
) /* This is the last block. */
4175 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4176 if (coding
.composing
!= COMPOSITION_DISABLED
)
4177 coding_allocate_composition_data (&coding
, BEGV
);
4178 result
= decode_coding (&coding
, read_buf
,
4179 conversion_buffer
+ inserted
,
4180 this, bufsize
- inserted
);
4182 /* Save for next iteration whatever we didn't convert. */
4183 unprocessed
= this - coding
.consumed
;
4184 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4185 if (!NILP (current_buffer
->enable_multibyte_characters
))
4186 this = coding
.produced
;
4188 this = str_as_unibyte (conversion_buffer
+ inserted
,
4195 /* At this point, INSERTED is how many characters (i.e. bytes)
4196 are present in CONVERSION_BUFFER.
4197 HOW_MUCH should equal TOTAL,
4198 or should be <= 0 if we couldn't read the file. */
4202 xfree (conversion_buffer
);
4205 error ("IO error reading %s: %s",
4206 SDATA (orig_filename
), emacs_strerror (errno
));
4207 else if (how_much
== -2)
4208 error ("maximum buffer size exceeded");
4211 /* Compare the beginning of the converted file
4212 with the buffer text. */
4215 while (bufpos
< inserted
&& same_at_start
< same_at_end
4216 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4217 same_at_start
++, bufpos
++;
4219 /* If the file matches the buffer completely,
4220 there's no need to replace anything. */
4222 if (bufpos
== inserted
)
4224 xfree (conversion_buffer
);
4227 /* Truncate the buffer to the size of the file. */
4228 del_range_byte (same_at_start
, same_at_end
, 0);
4233 /* Extend the start of non-matching text area to multibyte
4234 character boundary. */
4235 if (! NILP (current_buffer
->enable_multibyte_characters
))
4236 while (same_at_start
> BEGV_BYTE
4237 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4240 /* Scan this bufferful from the end, comparing with
4241 the Emacs buffer. */
4244 /* Compare with same_at_start to avoid counting some buffer text
4245 as matching both at the file's beginning and at the end. */
4246 while (bufpos
> 0 && same_at_end
> same_at_start
4247 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4248 same_at_end
--, bufpos
--;
4250 /* Extend the end of non-matching text area to multibyte
4251 character boundary. */
4252 if (! NILP (current_buffer
->enable_multibyte_characters
))
4253 while (same_at_end
< ZV_BYTE
4254 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4257 /* Don't try to reuse the same piece of text twice. */
4258 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4260 same_at_end
+= overlap
;
4262 /* If display currently starts at beginning of line,
4263 keep it that way. */
4264 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4265 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4267 /* Replace the chars that we need to replace,
4268 and update INSERTED to equal the number of bytes
4269 we are taking from the file. */
4270 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4272 if (same_at_end
!= same_at_start
)
4274 del_range_byte (same_at_start
, same_at_end
, 0);
4276 same_at_start
= GPT_BYTE
;
4280 temp
= BYTE_TO_CHAR (same_at_start
);
4282 /* Insert from the file at the proper position. */
4283 SET_PT_BOTH (temp
, same_at_start
);
4284 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
4286 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4287 coding_restore_composition (&coding
, Fcurrent_buffer ());
4288 coding_free_composition_data (&coding
);
4290 /* Set `inserted' to the number of inserted characters. */
4291 inserted
= PT
- temp
;
4293 xfree (conversion_buffer
);
4302 register Lisp_Object temp
;
4304 total
= XINT (end
) - XINT (beg
);
4306 /* Make sure point-max won't overflow after this insertion. */
4307 XSETINT (temp
, total
);
4308 if (total
!= XINT (temp
))
4309 error ("Maximum buffer size exceeded");
4312 /* For a special file, all we can do is guess. */
4313 total
= READ_BUF_SIZE
;
4315 if (NILP (visit
) && total
> 0)
4316 prepare_to_modify_buffer (PT
, PT
, NULL
);
4319 if (GAP_SIZE
< total
)
4320 make_gap (total
- GAP_SIZE
);
4322 if (XINT (beg
) != 0 || !NILP (replace
))
4324 if (lseek (fd
, XINT (beg
), 0) < 0)
4325 report_file_error ("Setting file position",
4326 Fcons (orig_filename
, Qnil
));
4329 /* In the following loop, HOW_MUCH contains the total bytes read so
4330 far for a regular file, and not changed for a special file. But,
4331 before exiting the loop, it is set to a negative value if I/O
4335 /* Total bytes inserted. */
4338 /* Here, we don't do code conversion in the loop. It is done by
4339 code_convert_region after all data are read into the buffer. */
4341 int gap_size
= GAP_SIZE
;
4343 while (how_much
< total
)
4345 /* try is reserved in some compilers (Microsoft C) */
4346 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4353 /* Maybe make more room. */
4354 if (gap_size
< trytry
)
4356 make_gap (total
- gap_size
);
4357 gap_size
= GAP_SIZE
;
4360 /* Read from the file, capturing `quit'. When an
4361 error occurs, end the loop, and arrange for a quit
4362 to be signaled after decoding the text we read. */
4363 non_regular_fd
= fd
;
4364 non_regular_inserted
= inserted
;
4365 non_regular_nbytes
= trytry
;
4366 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4367 read_non_regular_quit
);
4378 /* Allow quitting out of the actual I/O. We don't make text
4379 part of the buffer until all the reading is done, so a C-g
4380 here doesn't do any harm. */
4383 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4395 /* For a regular file, where TOTAL is the real size,
4396 count HOW_MUCH to compare with it.
4397 For a special file, where TOTAL is just a buffer size,
4398 so don't bother counting in HOW_MUCH.
4399 (INSERTED is where we count the number of characters inserted.) */
4406 /* Make the text read part of the buffer. */
4407 GAP_SIZE
-= inserted
;
4409 GPT_BYTE
+= inserted
;
4411 ZV_BYTE
+= inserted
;
4416 /* Put an anchor to ensure multi-byte form ends at gap. */
4421 /* Discard the unwind protect for closing the file. */
4425 error ("IO error reading %s: %s",
4426 SDATA (orig_filename
), emacs_strerror (errno
));
4430 if (! coding_system_decided
)
4432 /* The coding system is not yet decided. Decide it by an
4433 optimized method for handling `coding:' tag.
4435 Note that we can get here only if the buffer was empty
4436 before the insertion. */
4440 if (!NILP (Vcoding_system_for_read
))
4441 val
= Vcoding_system_for_read
;
4444 /* Since we are sure that the current buffer was empty
4445 before the insertion, we can toggle
4446 enable-multibyte-characters directly here without taking
4447 care of marker adjustment and byte combining problem. By
4448 this way, we can run Lisp program safely before decoding
4449 the inserted text. */
4450 Lisp_Object unwind_data
;
4451 int count
= SPECPDL_INDEX ();
4453 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4454 Fcons (current_buffer
->undo_list
,
4455 Fcurrent_buffer ()));
4456 current_buffer
->enable_multibyte_characters
= Qnil
;
4457 current_buffer
->undo_list
= Qt
;
4458 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4460 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4462 val
= call2 (Vset_auto_coding_function
,
4463 filename
, make_number (inserted
));
4468 /* If the coding system is not yet decided, check
4469 file-coding-system-alist. */
4470 Lisp_Object args
[6], coding_systems
;
4472 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4473 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4474 coding_systems
= Ffind_operation_coding_system (6, args
);
4475 if (CONSP (coding_systems
))
4476 val
= XCAR (coding_systems
);
4479 unbind_to (count
, Qnil
);
4480 inserted
= Z_BYTE
- BEG_BYTE
;
4483 /* The following kludgy code is to avoid some compiler bug.
4485 setup_coding_system (val, &coding);
4488 struct coding_system temp_coding
;
4489 setup_coding_system (val
, &temp_coding
);
4490 bcopy (&temp_coding
, &coding
, sizeof coding
);
4492 /* Ensure we set Vlast_coding_system_used. */
4493 set_coding_system
= 1;
4495 if (NILP (current_buffer
->enable_multibyte_characters
)
4497 /* We must suppress all character code conversion except for
4498 end-of-line conversion. */
4499 setup_raw_text_coding_system (&coding
);
4500 coding
.src_multibyte
= 0;
4501 coding
.dst_multibyte
4502 = !NILP (current_buffer
->enable_multibyte_characters
);
4506 /* Can't do this if part of the buffer might be preserved. */
4508 && (coding
.type
== coding_type_no_conversion
4509 || coding
.type
== coding_type_raw_text
))
4511 /* Visiting a file with these coding system makes the buffer
4513 current_buffer
->enable_multibyte_characters
= Qnil
;
4514 coding
.dst_multibyte
= 0;
4517 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4519 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4521 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4523 inserted
= coding
.produced_char
;
4526 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4530 /* Now INSERTED is measured in characters. */
4533 /* Use the conversion type to determine buffer-file-type
4534 (find-buffer-file-type is now used to help determine the
4536 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4537 || coding
.eol_type
== CODING_EOL_LF
)
4538 && ! CODING_REQUIRE_DECODING (&coding
))
4539 current_buffer
->buffer_file_type
= Qt
;
4541 current_buffer
->buffer_file_type
= Qnil
;
4548 if (!EQ (current_buffer
->undo_list
, Qt
))
4549 current_buffer
->undo_list
= Qnil
;
4551 stat (SDATA (filename
), &st
);
4556 current_buffer
->modtime
= st
.st_mtime
;
4557 current_buffer
->filename
= orig_filename
;
4560 SAVE_MODIFF
= MODIFF
;
4561 current_buffer
->auto_save_modified
= MODIFF
;
4562 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4563 #ifdef CLASH_DETECTION
4566 if (!NILP (current_buffer
->file_truename
))
4567 unlock_file (current_buffer
->file_truename
);
4568 unlock_file (filename
);
4570 #endif /* CLASH_DETECTION */
4572 Fsignal (Qfile_error
,
4573 Fcons (build_string ("not a regular file"),
4574 Fcons (orig_filename
, Qnil
)));
4577 if (set_coding_system
)
4578 Vlast_coding_system_used
= coding
.symbol
;
4580 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4582 insval
= call1 (Qafter_insert_file_set_coding
, make_number (inserted
));
4583 if (! NILP (insval
))
4585 CHECK_NUMBER (insval
);
4586 inserted
= XFASTINT (insval
);
4590 /* Decode file format */
4593 int empty_undo_list_p
= 0;
4595 /* If we're anyway going to discard undo information, don't
4596 record it in the first place. The buffer's undo list at this
4597 point is either nil or t when visiting a file. */
4600 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4601 current_buffer
->undo_list
= Qt
;
4604 insval
= call3 (Qformat_decode
,
4605 Qnil
, make_number (inserted
), visit
);
4606 CHECK_NUMBER (insval
);
4607 inserted
= XFASTINT (insval
);
4610 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4613 /* Call after-change hooks for the inserted text, aside from the case
4614 of normal visiting (not with REPLACE), which is done in a new buffer
4615 "before" the buffer is changed. */
4616 if (inserted
> 0 && total
> 0
4617 && (NILP (visit
) || !NILP (replace
)))
4619 signal_after_change (PT
, 0, inserted
);
4620 update_compositions (PT
, PT
, CHECK_BORDER
);
4623 p
= Vafter_insert_file_functions
;
4626 insval
= call1 (XCAR (p
), make_number (inserted
));
4629 CHECK_NUMBER (insval
);
4630 inserted
= XFASTINT (insval
);
4637 && current_buffer
->modtime
== -1)
4639 /* If visiting nonexistent file, return nil. */
4640 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4644 Fsignal (Qquit
, Qnil
);
4646 /* ??? Retval needs to be dealt with in all cases consistently. */
4648 val
= Fcons (orig_filename
,
4649 Fcons (make_number (inserted
),
4652 RETURN_UNGCPRO (unbind_to (count
, val
));
4655 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4656 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4657 Lisp_Object
, Lisp_Object
));
4659 /* If build_annotations switched buffers, switch back to BUF.
4660 Kill the temporary buffer that was selected in the meantime.
4662 Since this kill only the last temporary buffer, some buffers remain
4663 not killed if build_annotations switched buffers more than once.
4667 build_annotations_unwind (buf
)
4672 if (XBUFFER (buf
) == current_buffer
)
4674 tembuf
= Fcurrent_buffer ();
4676 Fkill_buffer (tembuf
);
4680 /* Decide the coding-system to encode the data with. */
4683 choose_write_coding_system (start
, end
, filename
,
4684 append
, visit
, lockname
, coding
)
4685 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4686 struct coding_system
*coding
;
4691 && NILP (Fstring_equal (current_buffer
->filename
,
4692 current_buffer
->auto_save_file_name
)))
4694 /* We use emacs-mule for auto saving... */
4695 setup_coding_system (Qemacs_mule
, coding
);
4696 /* ... but with the special flag to indicate not to strip off
4697 leading code of eight-bit-control chars. */
4699 goto done_setup_coding
;
4701 else if (!NILP (Vcoding_system_for_write
))
4703 val
= Vcoding_system_for_write
;
4704 if (coding_system_require_warning
4705 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4706 /* Confirm that VAL can surely encode the current region. */
4707 val
= call5 (Vselect_safe_coding_system_function
,
4708 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4713 /* If the variable `buffer-file-coding-system' is set locally,
4714 it means that the file was read with some kind of code
4715 conversion or the variable is explicitly set by users. We
4716 had better write it out with the same coding system even if
4717 `enable-multibyte-characters' is nil.
4719 If it is not set locally, we anyway have to convert EOL
4720 format if the default value of `buffer-file-coding-system'
4721 tells that it is not Unix-like (LF only) format. */
4722 int using_default_coding
= 0;
4723 int force_raw_text
= 0;
4725 val
= current_buffer
->buffer_file_coding_system
;
4727 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4730 if (NILP (current_buffer
->enable_multibyte_characters
))
4736 /* Check file-coding-system-alist. */
4737 Lisp_Object args
[7], coding_systems
;
4739 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4740 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4742 coding_systems
= Ffind_operation_coding_system (7, args
);
4743 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4744 val
= XCDR (coding_systems
);
4748 && !NILP (current_buffer
->buffer_file_coding_system
))
4750 /* If we still have not decided a coding system, use the
4751 default value of buffer-file-coding-system. */
4752 val
= current_buffer
->buffer_file_coding_system
;
4753 using_default_coding
= 1;
4757 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4758 /* Confirm that VAL can surely encode the current region. */
4759 val
= call5 (Vselect_safe_coding_system_function
,
4760 start
, end
, val
, Qnil
, filename
);
4762 setup_coding_system (Fcheck_coding_system (val
), coding
);
4763 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4764 && !using_default_coding
)
4766 if (! EQ (default_buffer_file_coding
.symbol
,
4767 buffer_defaults
.buffer_file_coding_system
))
4768 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4769 &default_buffer_file_coding
);
4770 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4772 Lisp_Object subsidiaries
;
4774 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4775 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4776 if (VECTORP (subsidiaries
)
4777 && XVECTOR (subsidiaries
)->size
== 3)
4779 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4784 setup_raw_text_coding_system (coding
);
4785 goto done_setup_coding
;
4788 setup_coding_system (Fcheck_coding_system (val
), coding
);
4791 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4792 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4795 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4796 "r\nFWrite region to file: \ni\ni\ni\np",
4797 doc
: /* Write current region into specified file.
4798 When called from a program, requires three arguments:
4799 START, END and FILENAME. START and END are normally buffer positions
4800 specifying the part of the buffer to write.
4801 If START is nil, that means to use the entire buffer contents.
4802 If START is a string, then output that string to the file
4803 instead of any buffer contents; END is ignored.
4805 Optional fourth argument APPEND if non-nil means
4806 append to existing file contents (if any). If it is an integer,
4807 seek to that offset in the file before writing.
4808 Optional fifth argument VISIT if t means
4809 set the last-save-file-modtime of buffer to this file's modtime
4810 and mark buffer not modified.
4811 If VISIT is a string, it is a second file name;
4812 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4813 VISIT is also the file name to lock and unlock for clash detection.
4814 If VISIT is neither t nor nil nor a string,
4815 that means do not display the \"Wrote file\" message.
4816 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4817 use for locking and unlocking, overriding FILENAME and VISIT.
4818 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4819 for an existing file with the same name. If MUSTBENEW is `excl',
4820 that means to get an error if the file already exists; never overwrite.
4821 If MUSTBENEW is neither nil nor `excl', that means ask for
4822 confirmation before overwriting, but do go ahead and overwrite the file
4823 if the user confirms.
4825 This does code conversion according to the value of
4826 `coding-system-for-write', `buffer-file-coding-system', or
4827 `file-coding-system-alist', and sets the variable
4828 `last-coding-system-used' to the coding system actually used. */)
4829 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4830 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4835 const unsigned char *fn
;
4838 int count
= SPECPDL_INDEX ();
4841 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4843 Lisp_Object handler
;
4844 Lisp_Object visit_file
;
4845 Lisp_Object annotations
;
4846 Lisp_Object encoded_filename
;
4847 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4848 int quietly
= !NILP (visit
);
4849 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4850 struct buffer
*given_buffer
;
4852 int buffer_file_type
= O_BINARY
;
4854 struct coding_system coding
;
4856 if (current_buffer
->base_buffer
&& visiting
)
4857 error ("Cannot do file visiting in an indirect buffer");
4859 if (!NILP (start
) && !STRINGP (start
))
4860 validate_region (&start
, &end
);
4862 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4864 filename
= Fexpand_file_name (filename
, Qnil
);
4866 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4867 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4869 if (STRINGP (visit
))
4870 visit_file
= Fexpand_file_name (visit
, Qnil
);
4872 visit_file
= filename
;
4874 if (NILP (lockname
))
4875 lockname
= visit_file
;
4879 /* If the file name has special constructs in it,
4880 call the corresponding file handler. */
4881 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4882 /* If FILENAME has no handler, see if VISIT has one. */
4883 if (NILP (handler
) && STRINGP (visit
))
4884 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4886 if (!NILP (handler
))
4889 val
= call6 (handler
, Qwrite_region
, start
, end
,
4890 filename
, append
, visit
);
4894 SAVE_MODIFF
= MODIFF
;
4895 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4896 current_buffer
->filename
= visit_file
;
4902 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4904 /* Special kludge to simplify auto-saving. */
4907 XSETFASTINT (start
, BEG
);
4908 XSETFASTINT (end
, Z
);
4912 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4913 count1
= SPECPDL_INDEX ();
4915 given_buffer
= current_buffer
;
4917 if (!STRINGP (start
))
4919 annotations
= build_annotations (start
, end
);
4921 if (current_buffer
!= given_buffer
)
4923 XSETFASTINT (start
, BEGV
);
4924 XSETFASTINT (end
, ZV
);
4930 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4932 /* Decide the coding-system to encode the data with.
4933 We used to make this choice before calling build_annotations, but that
4934 leads to problems when a write-annotate-function takes care of
4935 unsavable chars (as was the case with X-Symbol). */
4936 choose_write_coding_system (start
, end
, filename
,
4937 append
, visit
, lockname
, &coding
);
4938 Vlast_coding_system_used
= coding
.symbol
;
4940 given_buffer
= current_buffer
;
4941 if (! STRINGP (start
))
4943 annotations
= build_annotations_2 (start
, end
,
4944 coding
.pre_write_conversion
, annotations
);
4945 if (current_buffer
!= given_buffer
)
4947 XSETFASTINT (start
, BEGV
);
4948 XSETFASTINT (end
, ZV
);
4952 #ifdef CLASH_DETECTION
4955 #if 0 /* This causes trouble for GNUS. */
4956 /* If we've locked this file for some other buffer,
4957 query before proceeding. */
4958 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4959 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4962 lock_file (lockname
);
4964 #endif /* CLASH_DETECTION */
4966 encoded_filename
= ENCODE_FILE (filename
);
4968 fn
= SDATA (encoded_filename
);
4972 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4973 #else /* not DOS_NT */
4974 desc
= emacs_open (fn
, O_WRONLY
, 0);
4975 #endif /* not DOS_NT */
4977 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4979 if (auto_saving
) /* Overwrite any previous version of autosave file */
4981 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4982 desc
= emacs_open (fn
, O_RDWR
, 0);
4984 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4985 ? SDATA (current_buffer
->filename
) : 0,
4988 else /* Write to temporary name and rename if no errors */
4990 Lisp_Object temp_name
;
4991 temp_name
= Ffile_name_directory (filename
);
4993 if (!NILP (temp_name
))
4995 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4996 build_string ("$$SAVE$$")));
4997 fname
= SDATA (filename
);
4998 fn
= SDATA (temp_name
);
4999 desc
= creat_copy_attrs (fname
, fn
);
5002 /* If we can't open the temporary file, try creating a new
5003 version of the original file. VMS "creat" creates a
5004 new version rather than truncating an existing file. */
5007 desc
= creat (fn
, 0666);
5008 #if 0 /* This can clobber an existing file and fail to replace it,
5009 if the user runs out of space. */
5012 /* We can't make a new version;
5013 try to truncate and rewrite existing version if any. */
5015 desc
= emacs_open (fn
, O_RDWR
, 0);
5021 desc
= creat (fn
, 0666);
5025 desc
= emacs_open (fn
,
5026 O_WRONLY
| O_CREAT
| buffer_file_type
5027 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5028 S_IREAD
| S_IWRITE
);
5029 #else /* not DOS_NT */
5030 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5031 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5032 auto_saving
? auto_save_mode_bits
: 0666);
5033 #endif /* not DOS_NT */
5034 #endif /* not VMS */
5038 #ifdef CLASH_DETECTION
5040 if (!auto_saving
) unlock_file (lockname
);
5042 #endif /* CLASH_DETECTION */
5044 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5047 record_unwind_protect (close_file_unwind
, make_number (desc
));
5049 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5053 if (NUMBERP (append
))
5054 ret
= lseek (desc
, XINT (append
), 1);
5056 ret
= lseek (desc
, 0, 2);
5059 #ifdef CLASH_DETECTION
5060 if (!auto_saving
) unlock_file (lockname
);
5061 #endif /* CLASH_DETECTION */
5063 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5071 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5072 * if we do writes that don't end with a carriage return. Furthermore
5073 * it cannot handle writes of more then 16K. The modified
5074 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5075 * this EXCEPT for the last record (iff it doesn't end with a carriage
5076 * return). This implies that if your buffer doesn't end with a carriage
5077 * return, you get one free... tough. However it also means that if
5078 * we make two calls to sys_write (a la the following code) you can
5079 * get one at the gap as well. The easiest way to fix this (honest)
5080 * is to move the gap to the next newline (or the end of the buffer).
5085 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5086 move_gap (find_next_newline (GPT
, 1));
5088 /* Whether VMS or not, we must move the gap to the next of newline
5089 when we must put designation sequences at beginning of line. */
5090 if (INTEGERP (start
)
5091 && coding
.type
== coding_type_iso2022
5092 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5093 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5095 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5096 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5097 move_gap_both (PT
, PT_BYTE
);
5098 SET_PT_BOTH (opoint
, opoint_byte
);
5105 if (STRINGP (start
))
5107 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5108 &annotations
, &coding
);
5111 else if (XINT (start
) != XINT (end
))
5113 tem
= CHAR_TO_BYTE (XINT (start
));
5115 if (XINT (start
) < GPT
)
5117 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5118 min (GPT
, XINT (end
)) - XINT (start
),
5119 &annotations
, &coding
);
5123 if (XINT (end
) > GPT
&& !failure
)
5125 tem
= max (XINT (start
), GPT
);
5126 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5127 &annotations
, &coding
);
5133 /* If file was empty, still need to write the annotations */
5134 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5135 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5139 if (CODING_REQUIRE_FLUSHING (&coding
)
5140 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5143 /* We have to flush out a data. */
5144 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5145 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5152 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5153 Disk full in NFS may be reported here. */
5154 /* mib says that closing the file will try to write as fast as NFS can do
5155 it, and that means the fsync here is not crucial for autosave files. */
5156 if (!auto_saving
&& fsync (desc
) < 0)
5158 /* If fsync fails with EINTR, don't treat that as serious. */
5160 failure
= 1, save_errno
= errno
;
5164 /* Spurious "file has changed on disk" warnings have been
5165 observed on Suns as well.
5166 It seems that `close' can change the modtime, under nfs.
5168 (This has supposedly been fixed in Sunos 4,
5169 but who knows about all the other machines with NFS?) */
5172 /* On VMS and APOLLO, must do the stat after the close
5173 since closing changes the modtime. */
5176 /* Recall that #if defined does not work on VMS. */
5183 /* NFS can report a write failure now. */
5184 if (emacs_close (desc
) < 0)
5185 failure
= 1, save_errno
= errno
;
5188 /* If we wrote to a temporary name and had no errors, rename to real name. */
5192 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5200 /* Discard the unwind protect for close_file_unwind. */
5201 specpdl_ptr
= specpdl
+ count1
;
5202 /* Restore the original current buffer. */
5203 visit_file
= unbind_to (count
, visit_file
);
5205 #ifdef CLASH_DETECTION
5207 unlock_file (lockname
);
5208 #endif /* CLASH_DETECTION */
5210 /* Do this before reporting IO error
5211 to avoid a "file has changed on disk" warning on
5212 next attempt to save. */
5214 current_buffer
->modtime
= st
.st_mtime
;
5217 error ("IO error writing %s: %s", SDATA (filename
),
5218 emacs_strerror (save_errno
));
5222 SAVE_MODIFF
= MODIFF
;
5223 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5224 current_buffer
->filename
= visit_file
;
5225 update_mode_lines
++;
5230 && ! NILP (Fstring_equal (current_buffer
->filename
,
5231 current_buffer
->auto_save_file_name
)))
5232 SAVE_MODIFF
= MODIFF
;
5238 message_with_string ((INTEGERP (append
)
5248 Lisp_Object
merge ();
5250 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5251 doc
: /* Return t if (car A) is numerically less than (car B). */)
5255 return Flss (Fcar (a
), Fcar (b
));
5258 /* Build the complete list of annotations appropriate for writing out
5259 the text between START and END, by calling all the functions in
5260 write-region-annotate-functions and merging the lists they return.
5261 If one of these functions switches to a different buffer, we assume
5262 that buffer contains altered text. Therefore, the caller must
5263 make sure to restore the current buffer in all cases,
5264 as save-excursion would do. */
5267 build_annotations (start
, end
)
5268 Lisp_Object start
, end
;
5270 Lisp_Object annotations
;
5272 struct gcpro gcpro1
, gcpro2
;
5273 Lisp_Object original_buffer
;
5274 int i
, used_global
= 0;
5276 XSETBUFFER (original_buffer
, current_buffer
);
5279 p
= Vwrite_region_annotate_functions
;
5280 GCPRO2 (annotations
, p
);
5283 struct buffer
*given_buffer
= current_buffer
;
5284 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5285 { /* Use the global value of the hook. */
5288 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5290 p
= Fappend (2, arg
);
5293 Vwrite_region_annotations_so_far
= annotations
;
5294 res
= call2 (XCAR (p
), start
, end
);
5295 /* If the function makes a different buffer current,
5296 assume that means this buffer contains altered text to be output.
5297 Reset START and END from the buffer bounds
5298 and discard all previous annotations because they should have
5299 been dealt with by this function. */
5300 if (current_buffer
!= given_buffer
)
5302 XSETFASTINT (start
, BEGV
);
5303 XSETFASTINT (end
, ZV
);
5306 Flength (res
); /* Check basic validity of return value */
5307 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5311 /* Now do the same for annotation functions implied by the file-format */
5312 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5313 p
= Vauto_save_file_format
;
5315 p
= current_buffer
->file_format
;
5316 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5318 struct buffer
*given_buffer
= current_buffer
;
5320 Vwrite_region_annotations_so_far
= annotations
;
5322 /* Value is either a list of annotations or nil if the function
5323 has written annotations to a temporary buffer, which is now
5325 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5326 original_buffer
, make_number (i
));
5327 if (current_buffer
!= given_buffer
)
5329 XSETFASTINT (start
, BEGV
);
5330 XSETFASTINT (end
, ZV
);
5335 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5343 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5344 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5346 struct gcpro gcpro1
;
5349 GCPRO1 (annotations
);
5350 /* At last, do the same for the function PRE_WRITE_CONVERSION
5351 implied by the current coding-system. */
5352 if (!NILP (pre_write_conversion
))
5354 struct buffer
*given_buffer
= current_buffer
;
5355 Vwrite_region_annotations_so_far
= annotations
;
5356 res
= call2 (pre_write_conversion
, start
, end
);
5358 annotations
= (current_buffer
!= given_buffer
5360 : merge (annotations
, res
, Qcar_less_than_car
));
5367 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5368 If STRING is nil, POS is the character position in the current buffer.
5369 Intersperse with them the annotations from *ANNOT
5370 which fall within the range of POS to POS + NCHARS,
5371 each at its appropriate position.
5373 We modify *ANNOT by discarding elements as we use them up.
5375 The return value is negative in case of system call failure. */
5378 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5381 register int nchars
;
5384 struct coding_system
*coding
;
5388 int lastpos
= pos
+ nchars
;
5390 while (NILP (*annot
) || CONSP (*annot
))
5392 tem
= Fcar_safe (Fcar (*annot
));
5395 nextpos
= XFASTINT (tem
);
5397 /* If there are no more annotations in this range,
5398 output the rest of the range all at once. */
5399 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5400 return e_write (desc
, string
, pos
, lastpos
, coding
);
5402 /* Output buffer text up to the next annotation's position. */
5405 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5409 /* Output the annotation. */
5410 tem
= Fcdr (Fcar (*annot
));
5413 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5416 *annot
= Fcdr (*annot
);
5421 #ifndef WRITE_BUF_SIZE
5422 #define WRITE_BUF_SIZE (16 * 1024)
5425 /* Write text in the range START and END into descriptor DESC,
5426 encoding them with coding system CODING. If STRING is nil, START
5427 and END are character positions of the current buffer, else they
5428 are indexes to the string STRING. */
5431 e_write (desc
, string
, start
, end
, coding
)
5435 struct coding_system
*coding
;
5437 register char *addr
;
5438 register int nbytes
;
5439 char buf
[WRITE_BUF_SIZE
];
5443 coding
->composing
= COMPOSITION_DISABLED
;
5444 if (coding
->composing
!= COMPOSITION_DISABLED
)
5445 coding_save_composition (coding
, start
, end
, string
);
5447 if (STRINGP (string
))
5449 addr
= SDATA (string
);
5450 nbytes
= SBYTES (string
);
5451 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5453 else if (start
< end
)
5455 /* It is assured that the gap is not in the range START and END-1. */
5456 addr
= CHAR_POS_ADDR (start
);
5457 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5458 coding
->src_multibyte
5459 = !NILP (current_buffer
->enable_multibyte_characters
);
5465 coding
->src_multibyte
= 1;
5468 /* We used to have a code for handling selective display here. But,
5469 now it is handled within encode_coding. */
5474 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5475 if (coding
->produced
> 0)
5477 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5478 if (coding
->produced
)
5484 nbytes
-= coding
->consumed
;
5485 addr
+= coding
->consumed
;
5486 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5489 /* The source text ends by an incomplete multibyte form.
5490 There's no way other than write it out as is. */
5491 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5500 start
+= coding
->consumed_char
;
5501 if (coding
->cmp_data
)
5502 coding_adjust_composition_offset (coding
, start
);
5505 if (coding
->cmp_data
)
5506 coding_free_composition_data (coding
);
5511 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5512 Sverify_visited_file_modtime
, 1, 1, 0,
5513 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5514 This means that the file has not been changed since it was visited or saved.
5515 See Info node `(elisp)Modification Time' for more details. */)
5521 Lisp_Object handler
;
5522 Lisp_Object filename
;
5527 if (!STRINGP (b
->filename
)) return Qt
;
5528 if (b
->modtime
== 0) return Qt
;
5530 /* If the file name has special constructs in it,
5531 call the corresponding file handler. */
5532 handler
= Ffind_file_name_handler (b
->filename
,
5533 Qverify_visited_file_modtime
);
5534 if (!NILP (handler
))
5535 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5537 filename
= ENCODE_FILE (b
->filename
);
5539 if (stat (SDATA (filename
), &st
) < 0)
5541 /* If the file doesn't exist now and didn't exist before,
5542 we say that it isn't modified, provided the error is a tame one. */
5543 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5548 if (st
.st_mtime
== b
->modtime
5549 /* If both are positive, accept them if they are off by one second. */
5550 || (st
.st_mtime
> 0 && b
->modtime
> 0
5551 && (st
.st_mtime
== b
->modtime
+ 1
5552 || st
.st_mtime
== b
->modtime
- 1)))
5557 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5558 Sclear_visited_file_modtime
, 0, 0, 0,
5559 doc
: /* Clear out records of last mod time of visited file.
5560 Next attempt to save will certainly not complain of a discrepancy. */)
5563 current_buffer
->modtime
= 0;
5567 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5568 Svisited_file_modtime
, 0, 0, 0,
5569 doc
: /* Return the current buffer's recorded visited file modification time.
5570 The value is a list of the form (HIGH . LOW), like the time values
5571 that `file-attributes' returns. If the current buffer has no recorded
5572 file modification time, this function returns 0.
5573 See Info node `(elisp)Modification Time' for more details. */)
5576 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5579 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5580 Sset_visited_file_modtime
, 0, 1, 0,
5581 doc
: /* Update buffer's recorded modification time from the visited file's time.
5582 Useful if the buffer was not read from the file normally
5583 or if the file itself has been changed for some known benign reason.
5584 An argument specifies the modification time value to use
5585 \(instead of that of the visited file), in the form of a list
5586 \(HIGH . LOW) or (HIGH LOW). */)
5588 Lisp_Object time_list
;
5590 if (!NILP (time_list
))
5591 current_buffer
->modtime
= cons_to_long (time_list
);
5594 register Lisp_Object filename
;
5596 Lisp_Object handler
;
5598 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5600 /* If the file name has special constructs in it,
5601 call the corresponding file handler. */
5602 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5603 if (!NILP (handler
))
5604 /* The handler can find the file name the same way we did. */
5605 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5607 filename
= ENCODE_FILE (filename
);
5609 if (stat (SDATA (filename
), &st
) >= 0)
5610 current_buffer
->modtime
= st
.st_mtime
;
5617 auto_save_error (error
)
5620 Lisp_Object args
[3], msg
;
5622 struct gcpro gcpro1
;
5624 ring_bell (XFRAME (selected_frame
));
5626 args
[0] = build_string ("Auto-saving %s: %s");
5627 args
[1] = current_buffer
->name
;
5628 args
[2] = Ferror_message_string (error
);
5629 msg
= Fformat (3, args
);
5631 nbytes
= SBYTES (msg
);
5633 for (i
= 0; i
< 3; ++i
)
5636 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5638 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5639 Fsleep_for (make_number (1), Qnil
);
5651 /* Get visited file's mode to become the auto save file's mode. */
5652 if (! NILP (current_buffer
->filename
)
5653 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5654 /* But make sure we can overwrite it later! */
5655 auto_save_mode_bits
= st
.st_mode
| 0600;
5657 auto_save_mode_bits
= 0666;
5660 Fwrite_region (Qnil
, Qnil
,
5661 current_buffer
->auto_save_file_name
,
5662 Qnil
, Qlambda
, Qnil
, Qnil
);
5666 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5671 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5672 | XFASTINT (XCDR (stream
))));
5677 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5680 minibuffer_auto_raise
= XINT (value
);
5685 do_auto_save_make_dir (dir
)
5688 return call2 (Qmake_directory
, dir
, Qt
);
5692 do_auto_save_eh (ignore
)
5698 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5699 doc
: /* Auto-save all buffers that need it.
5700 This is all buffers that have auto-saving enabled
5701 and are changed since last auto-saved.
5702 Auto-saving writes the buffer into a file
5703 so that your editing is not lost if the system crashes.
5704 This file is not the file you visited; that changes only when you save.
5705 Normally we run the normal hook `auto-save-hook' before saving.
5707 A non-nil NO-MESSAGE argument means do not print any message if successful.
5708 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5709 (no_message
, current_only
)
5710 Lisp_Object no_message
, current_only
;
5712 struct buffer
*old
= current_buffer
, *b
;
5713 Lisp_Object tail
, buf
;
5715 int do_handled_files
;
5718 Lisp_Object lispstream
;
5719 int count
= SPECPDL_INDEX ();
5720 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5721 int old_message_p
= 0;
5722 struct gcpro gcpro1
, gcpro2
;
5724 if (max_specpdl_size
< specpdl_size
+ 40)
5725 max_specpdl_size
= specpdl_size
+ 40;
5730 if (NILP (no_message
))
5732 old_message_p
= push_message ();
5733 record_unwind_protect (pop_message_unwind
, Qnil
);
5736 /* Ordinarily don't quit within this function,
5737 but don't make it impossible to quit (in case we get hung in I/O). */
5741 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5742 point to non-strings reached from Vbuffer_alist. */
5744 if (!NILP (Vrun_hooks
))
5745 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5747 if (STRINGP (Vauto_save_list_file_name
))
5749 Lisp_Object listfile
;
5751 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5753 /* Don't try to create the directory when shutting down Emacs,
5754 because creating the directory might signal an error, and
5755 that would leave Emacs in a strange state. */
5756 if (!NILP (Vrun_hooks
))
5760 GCPRO2 (dir
, listfile
);
5761 dir
= Ffile_name_directory (listfile
);
5762 if (NILP (Ffile_directory_p (dir
)))
5763 internal_condition_case_1 (do_auto_save_make_dir
,
5764 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5769 stream
= fopen (SDATA (listfile
), "w");
5772 /* Arrange to close that file whether or not we get an error.
5773 Also reset auto_saving to 0. */
5774 lispstream
= Fcons (Qnil
, Qnil
);
5775 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5776 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5787 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5788 record_unwind_protect (do_auto_save_unwind_1
,
5789 make_number (minibuffer_auto_raise
));
5790 minibuffer_auto_raise
= 0;
5793 /* On first pass, save all files that don't have handlers.
5794 On second pass, save all files that do have handlers.
5796 If Emacs is crashing, the handlers may tweak what is causing
5797 Emacs to crash in the first place, and it would be a shame if
5798 Emacs failed to autosave perfectly ordinary files because it
5799 couldn't handle some ange-ftp'd file. */
5801 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5802 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5804 buf
= XCDR (XCAR (tail
));
5807 /* Record all the buffers that have auto save mode
5808 in the special file that lists them. For each of these buffers,
5809 Record visited name (if any) and auto save name. */
5810 if (STRINGP (b
->auto_save_file_name
)
5811 && stream
!= NULL
&& do_handled_files
== 0)
5813 if (!NILP (b
->filename
))
5815 fwrite (SDATA (b
->filename
), 1,
5816 SBYTES (b
->filename
), stream
);
5818 putc ('\n', stream
);
5819 fwrite (SDATA (b
->auto_save_file_name
), 1,
5820 SBYTES (b
->auto_save_file_name
), stream
);
5821 putc ('\n', stream
);
5824 if (!NILP (current_only
)
5825 && b
!= current_buffer
)
5828 /* Don't auto-save indirect buffers.
5829 The base buffer takes care of it. */
5833 /* Check for auto save enabled
5834 and file changed since last auto save
5835 and file changed since last real save. */
5836 if (STRINGP (b
->auto_save_file_name
)
5837 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5838 && b
->auto_save_modified
< BUF_MODIFF (b
)
5839 /* -1 means we've turned off autosaving for a while--see below. */
5840 && XINT (b
->save_length
) >= 0
5841 && (do_handled_files
5842 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5845 EMACS_TIME before_time
, after_time
;
5847 EMACS_GET_TIME (before_time
);
5849 /* If we had a failure, don't try again for 20 minutes. */
5850 if (b
->auto_save_failure_time
>= 0
5851 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5854 if ((XFASTINT (b
->save_length
) * 10
5855 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5856 /* A short file is likely to change a large fraction;
5857 spare the user annoying messages. */
5858 && XFASTINT (b
->save_length
) > 5000
5859 /* These messages are frequent and annoying for `*mail*'. */
5860 && !EQ (b
->filename
, Qnil
)
5861 && NILP (no_message
))
5863 /* It has shrunk too much; turn off auto-saving here. */
5864 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5865 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5867 minibuffer_auto_raise
= 0;
5868 /* Turn off auto-saving until there's a real save,
5869 and prevent any more warnings. */
5870 XSETINT (b
->save_length
, -1);
5871 Fsleep_for (make_number (1), Qnil
);
5874 set_buffer_internal (b
);
5875 if (!auto_saved
&& NILP (no_message
))
5876 message1 ("Auto-saving...");
5877 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5879 b
->auto_save_modified
= BUF_MODIFF (b
);
5880 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5881 set_buffer_internal (old
);
5883 EMACS_GET_TIME (after_time
);
5885 /* If auto-save took more than 60 seconds,
5886 assume it was an NFS failure that got a timeout. */
5887 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5888 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5892 /* Prevent another auto save till enough input events come in. */
5893 record_auto_save ();
5895 if (auto_saved
&& NILP (no_message
))
5899 /* If we are going to restore an old message,
5900 give time to read ours. */
5901 sit_for (1, 0, 0, 0, 0);
5905 /* If we displayed a message and then restored a state
5906 with no message, leave a "done" message on the screen. */
5907 message1 ("Auto-saving...done");
5912 /* This restores the message-stack status. */
5913 unbind_to (count
, Qnil
);
5917 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5918 Sset_buffer_auto_saved
, 0, 0, 0,
5919 doc
: /* Mark current buffer as auto-saved with its current text.
5920 No auto-save file will be written until the buffer changes again. */)
5923 current_buffer
->auto_save_modified
= MODIFF
;
5924 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5925 current_buffer
->auto_save_failure_time
= -1;
5929 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5930 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5931 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5934 current_buffer
->auto_save_failure_time
= -1;
5938 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5940 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
5943 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5946 /* Reading and completing file names */
5947 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5949 /* In the string VAL, change each $ to $$ and return the result. */
5952 double_dollars (val
)
5955 register const unsigned char *old
;
5956 register unsigned char *new;
5960 osize
= SBYTES (val
);
5962 /* Count the number of $ characters. */
5963 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
5964 if (*old
++ == '$') count
++;
5968 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
5971 for (n
= osize
; n
> 0; n
--)
5985 read_file_name_cleanup (arg
)
5988 return (current_buffer
->directory
= arg
);
5991 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5993 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
5994 (string
, dir
, action
)
5995 Lisp_Object string
, dir
, action
;
5996 /* action is nil for complete, t for return list of completions,
5997 lambda for verify final value */
5999 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6001 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6003 CHECK_STRING (string
);
6010 /* No need to protect ACTION--we only compare it with t and nil. */
6011 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6013 if (SCHARS (string
) == 0)
6015 if (EQ (action
, Qlambda
))
6023 orig_string
= string
;
6024 string
= Fsubstitute_in_file_name (string
);
6025 changed
= NILP (Fstring_equal (string
, orig_string
));
6026 name
= Ffile_name_nondirectory (string
);
6027 val
= Ffile_name_directory (string
);
6029 realdir
= Fexpand_file_name (val
, realdir
);
6034 specdir
= Ffile_name_directory (string
);
6035 val
= Ffile_name_completion (name
, realdir
);
6040 return double_dollars (string
);
6044 if (!NILP (specdir
))
6045 val
= concat2 (specdir
, val
);
6047 return double_dollars (val
);
6050 #endif /* not VMS */
6054 if (EQ (action
, Qt
))
6056 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6060 if (NILP (Vread_file_name_predicate
)
6061 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6065 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6067 /* Brute-force speed up for directory checking:
6068 Discard strings which don't end in a slash. */
6069 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6071 Lisp_Object tem
= XCAR (all
);
6073 if (STRINGP (tem
) &&
6074 (len
= SCHARS (tem
), len
> 0) &&
6075 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6076 comp
= Fcons (tem
, comp
);
6082 /* Must do it the hard (and slow) way. */
6083 GCPRO3 (all
, comp
, specdir
);
6084 count
= SPECPDL_INDEX ();
6085 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6086 current_buffer
->directory
= realdir
;
6087 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6088 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6089 comp
= Fcons (XCAR (all
), comp
);
6090 unbind_to (count
, Qnil
);
6093 return Fnreverse (comp
);
6096 /* Only other case actually used is ACTION = lambda */
6098 /* Supposedly this helps commands such as `cd' that read directory names,
6099 but can someone explain how it helps them? -- RMS */
6100 if (SCHARS (name
) == 0)
6103 string
= Fexpand_file_name (string
, dir
);
6104 if (!NILP (Vread_file_name_predicate
))
6105 return call1 (Vread_file_name_predicate
, string
);
6106 return Ffile_exists_p (string
);
6109 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6110 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6111 Value is not expanded---you must call `expand-file-name' yourself.
6112 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6113 the same non-empty string that was inserted by this function.
6114 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6115 except that if INITIAL is specified, that combined with DIR is used.)
6116 If the user exits with an empty minibuffer, this function returns
6117 an empty string. (This can only happen if the user erased the
6118 pre-inserted contents or if `insert-default-directory' is nil.)
6119 Fourth arg MUSTMATCH non-nil means require existing file's name.
6120 Non-nil and non-t means also require confirmation after completion.
6121 Fifth arg INITIAL specifies text to start with.
6122 If optional sixth arg PREDICATE is non-nil, possible completions and
6123 the resulting file name must satisfy (funcall PREDICATE NAME).
6124 DIR should be an absolute directory name. It defaults to the value of
6125 `default-directory'.
6127 If this command was invoked with the mouse, use a file dialog box if
6128 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6129 provides a file dialog box. */)
6130 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6131 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6133 Lisp_Object val
, insdef
, tem
;
6134 struct gcpro gcpro1
, gcpro2
;
6135 register char *homedir
;
6136 Lisp_Object decoded_homedir
;
6137 int replace_in_history
= 0;
6138 int add_to_history
= 0;
6142 dir
= current_buffer
->directory
;
6143 if (NILP (default_filename
))
6144 default_filename
= !NILP (initial
)
6145 ? Fexpand_file_name (initial
, dir
)
6146 : current_buffer
->filename
;
6148 /* If dir starts with user's homedir, change that to ~. */
6149 homedir
= (char *) egetenv ("HOME");
6151 /* homedir can be NULL in temacs, since Vprocess_environment is not
6152 yet set up. We shouldn't crash in that case. */
6155 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6156 CORRECT_DIR_SEPS (homedir
);
6161 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6164 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6165 SBYTES (decoded_homedir
))
6166 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6168 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6169 dir
= concat2 (build_string ("~"), dir
);
6171 /* Likewise for default_filename. */
6173 && STRINGP (default_filename
)
6174 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6175 SBYTES (decoded_homedir
))
6176 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6179 = Fsubstring (default_filename
,
6180 make_number (SCHARS (decoded_homedir
)), Qnil
);
6181 default_filename
= concat2 (build_string ("~"), default_filename
);
6183 if (!NILP (default_filename
))
6185 CHECK_STRING (default_filename
);
6186 default_filename
= double_dollars (default_filename
);
6189 if (insert_default_directory
&& STRINGP (dir
))
6192 if (!NILP (initial
))
6194 Lisp_Object args
[2], pos
;
6198 insdef
= Fconcat (2, args
);
6199 pos
= make_number (SCHARS (double_dollars (dir
)));
6200 insdef
= Fcons (double_dollars (insdef
), pos
);
6203 insdef
= double_dollars (insdef
);
6205 else if (STRINGP (initial
))
6206 insdef
= Fcons (double_dollars (initial
), make_number (0));
6210 if (!NILP (Vread_file_name_function
))
6212 Lisp_Object args
[7];
6214 GCPRO2 (insdef
, default_filename
);
6215 args
[0] = Vread_file_name_function
;
6218 args
[3] = default_filename
;
6219 args
[4] = mustmatch
;
6221 args
[6] = predicate
;
6222 RETURN_UNGCPRO (Ffuncall (7, args
));
6225 count
= SPECPDL_INDEX ();
6226 #if defined VMS || defined DOS_NT || defined MAC_OSX
6227 specbind (intern ("completion-ignore-case"), Qt
);
6230 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6231 specbind (intern ("read-file-name-predicate"),
6232 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6234 GCPRO2 (insdef
, default_filename
);
6236 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
6237 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6242 /* If DIR contains a file name, split it. */
6244 file
= Ffile_name_nondirectory (dir
);
6245 if (SCHARS (file
) && NILP (default_filename
))
6247 default_filename
= file
;
6248 dir
= Ffile_name_directory (dir
);
6250 if (!NILP(default_filename
))
6251 default_filename
= Fexpand_file_name (default_filename
, dir
);
6252 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6257 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6258 dir
, mustmatch
, insdef
,
6259 Qfile_name_history
, default_filename
, Qnil
);
6261 tem
= Fsymbol_value (Qfile_name_history
);
6262 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6263 replace_in_history
= 1;
6265 /* If Fcompleting_read returned the inserted default string itself
6266 (rather than a new string with the same contents),
6267 it has to mean that the user typed RET with the minibuffer empty.
6268 In that case, we really want to return ""
6269 so that commands such as set-visited-file-name can distinguish. */
6270 if (EQ (val
, default_filename
))
6272 /* In this case, Fcompleting_read has not added an element
6273 to the history. Maybe we should. */
6274 if (! replace_in_history
)
6280 unbind_to (count
, Qnil
);
6283 error ("No file name specified");
6285 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6287 if (!NILP (tem
) && !NILP (default_filename
))
6288 val
= default_filename
;
6289 val
= Fsubstitute_in_file_name (val
);
6291 if (replace_in_history
)
6292 /* Replace what Fcompleting_read added to the history
6293 with what we will actually return. */
6294 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6295 else if (add_to_history
)
6297 /* Add the value to the history--but not if it matches
6298 the last value already there. */
6299 Lisp_Object val1
= double_dollars (val
);
6300 tem
= Fsymbol_value (Qfile_name_history
);
6301 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6302 Fset (Qfile_name_history
,
6313 /* Must be set before any path manipulation is performed. */
6314 XSETFASTINT (Vdirectory_sep_char
, '/');
6321 Qexpand_file_name
= intern ("expand-file-name");
6322 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6323 Qdirectory_file_name
= intern ("directory-file-name");
6324 Qfile_name_directory
= intern ("file-name-directory");
6325 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6326 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6327 Qfile_name_as_directory
= intern ("file-name-as-directory");
6328 Qcopy_file
= intern ("copy-file");
6329 Qmake_directory_internal
= intern ("make-directory-internal");
6330 Qmake_directory
= intern ("make-directory");
6331 Qdelete_directory
= intern ("delete-directory");
6332 Qdelete_file
= intern ("delete-file");
6333 Qrename_file
= intern ("rename-file");
6334 Qadd_name_to_file
= intern ("add-name-to-file");
6335 Qmake_symbolic_link
= intern ("make-symbolic-link");
6336 Qfile_exists_p
= intern ("file-exists-p");
6337 Qfile_executable_p
= intern ("file-executable-p");
6338 Qfile_readable_p
= intern ("file-readable-p");
6339 Qfile_writable_p
= intern ("file-writable-p");
6340 Qfile_symlink_p
= intern ("file-symlink-p");
6341 Qaccess_file
= intern ("access-file");
6342 Qfile_directory_p
= intern ("file-directory-p");
6343 Qfile_regular_p
= intern ("file-regular-p");
6344 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6345 Qfile_modes
= intern ("file-modes");
6346 Qset_file_modes
= intern ("set-file-modes");
6347 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6348 Qinsert_file_contents
= intern ("insert-file-contents");
6349 Qwrite_region
= intern ("write-region");
6350 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6351 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6352 Qauto_save_coding
= intern ("auto-save-coding");
6354 staticpro (&Qexpand_file_name
);
6355 staticpro (&Qsubstitute_in_file_name
);
6356 staticpro (&Qdirectory_file_name
);
6357 staticpro (&Qfile_name_directory
);
6358 staticpro (&Qfile_name_nondirectory
);
6359 staticpro (&Qunhandled_file_name_directory
);
6360 staticpro (&Qfile_name_as_directory
);
6361 staticpro (&Qcopy_file
);
6362 staticpro (&Qmake_directory_internal
);
6363 staticpro (&Qmake_directory
);
6364 staticpro (&Qdelete_directory
);
6365 staticpro (&Qdelete_file
);
6366 staticpro (&Qrename_file
);
6367 staticpro (&Qadd_name_to_file
);
6368 staticpro (&Qmake_symbolic_link
);
6369 staticpro (&Qfile_exists_p
);
6370 staticpro (&Qfile_executable_p
);
6371 staticpro (&Qfile_readable_p
);
6372 staticpro (&Qfile_writable_p
);
6373 staticpro (&Qaccess_file
);
6374 staticpro (&Qfile_symlink_p
);
6375 staticpro (&Qfile_directory_p
);
6376 staticpro (&Qfile_regular_p
);
6377 staticpro (&Qfile_accessible_directory_p
);
6378 staticpro (&Qfile_modes
);
6379 staticpro (&Qset_file_modes
);
6380 staticpro (&Qfile_newer_than_file_p
);
6381 staticpro (&Qinsert_file_contents
);
6382 staticpro (&Qwrite_region
);
6383 staticpro (&Qverify_visited_file_modtime
);
6384 staticpro (&Qset_visited_file_modtime
);
6385 staticpro (&Qauto_save_coding
);
6387 Qfile_name_history
= intern ("file-name-history");
6388 Fset (Qfile_name_history
, Qnil
);
6389 staticpro (&Qfile_name_history
);
6391 Qfile_error
= intern ("file-error");
6392 staticpro (&Qfile_error
);
6393 Qfile_already_exists
= intern ("file-already-exists");
6394 staticpro (&Qfile_already_exists
);
6395 Qfile_date_error
= intern ("file-date-error");
6396 staticpro (&Qfile_date_error
);
6397 Qexcl
= intern ("excl");
6401 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6402 staticpro (&Qfind_buffer_file_type
);
6405 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6406 doc
: /* *Coding system for encoding file names.
6407 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6408 Vfile_name_coding_system
= Qnil
;
6410 DEFVAR_LISP ("default-file-name-coding-system",
6411 &Vdefault_file_name_coding_system
,
6412 doc
: /* Default coding system for encoding file names.
6413 This variable is used only when `file-name-coding-system' is nil.
6415 This variable is set/changed by the command `set-language-environment'.
6416 User should not set this variable manually,
6417 instead use `file-name-coding-system' to get a constant encoding
6418 of file names regardless of the current language environment. */);
6419 Vdefault_file_name_coding_system
= Qnil
;
6421 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6422 doc
: /* *Format in which to write auto-save files.
6423 Should be a list of symbols naming formats that are defined in `format-alist'.
6424 If it is t, which is the default, auto-save files are written in the
6425 same format as a regular save would use. */);
6426 Vauto_save_file_format
= Qt
;
6428 Qformat_decode
= intern ("format-decode");
6429 staticpro (&Qformat_decode
);
6430 Qformat_annotate_function
= intern ("format-annotate-function");
6431 staticpro (&Qformat_annotate_function
);
6432 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6433 staticpro (&Qafter_insert_file_set_coding
);
6435 Qcar_less_than_car
= intern ("car-less-than-car");
6436 staticpro (&Qcar_less_than_car
);
6438 Fput (Qfile_error
, Qerror_conditions
,
6439 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6440 Fput (Qfile_error
, Qerror_message
,
6441 build_string ("File error"));
6443 Fput (Qfile_already_exists
, Qerror_conditions
,
6444 Fcons (Qfile_already_exists
,
6445 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6446 Fput (Qfile_already_exists
, Qerror_message
,
6447 build_string ("File already exists"));
6449 Fput (Qfile_date_error
, Qerror_conditions
,
6450 Fcons (Qfile_date_error
,
6451 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6452 Fput (Qfile_date_error
, Qerror_message
,
6453 build_string ("Cannot set file date"));
6455 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6456 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6457 Vread_file_name_function
= Qnil
;
6459 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6460 doc
: /* Current predicate used by `read-file-name-internal'. */);
6461 Vread_file_name_predicate
= Qnil
;
6463 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6464 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6465 If the initial minibuffer contents are non-empty, you can usually
6466 request a default filename by typing RETURN without editing. For some
6467 commands, exiting with an empty minibuffer has a special meaning,
6468 such as making the current buffer visit no file in the case of
6469 `set-visited-file-name'.
6470 If this variable is non-nil, the minibuffer contents are always
6471 initially non-empty and typing RETURN without editing will fetch the
6472 default name, if one is provided. Note however that this default name
6473 is not necessarily the name originally inserted in the minibuffer, if
6474 that is just the default directory.
6475 If this variable is nil, the minibuffer often starts out empty. In
6476 that case you may have to explicitly fetch the next history element to
6477 request the default name. */);
6478 insert_default_directory
= 1;
6480 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6481 doc
: /* *Non-nil means write new files with record format `stmlf'.
6482 nil means use format `var'. This variable is meaningful only on VMS. */);
6483 vms_stmlf_recfm
= 0;
6485 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6486 doc
: /* Directory separator character for built-in functions that return file names.
6487 The value is always ?/. Don't use this variable, just use `/'. */);
6489 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6490 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6491 If a file name matches REGEXP, then all I/O on that file is done by calling
6494 The first argument given to HANDLER is the name of the I/O primitive
6495 to be handled; the remaining arguments are the arguments that were
6496 passed to that primitive. For example, if you do
6497 (file-exists-p FILENAME)
6498 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6499 (funcall HANDLER 'file-exists-p FILENAME)
6500 The function `find-file-name-handler' checks this list for a handler
6501 for its argument. */);
6502 Vfile_name_handler_alist
= Qnil
;
6504 DEFVAR_LISP ("set-auto-coding-function",
6505 &Vset_auto_coding_function
,
6506 doc
: /* If non-nil, a function to call to decide a coding system of file.
6507 Two arguments are passed to this function: the file name
6508 and the length of a file contents following the point.
6509 This function should return a coding system to decode the file contents.
6510 It should check the file name against `auto-coding-alist'.
6511 If no coding system is decided, it should check a coding system
6512 specified in the heading lines with the format:
6513 -*- ... coding: CODING-SYSTEM; ... -*-
6514 or local variable spec of the tailing lines with `coding:' tag. */);
6515 Vset_auto_coding_function
= Qnil
;
6517 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6518 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6519 Each is passed one argument, the number of characters inserted.
6520 It should return the new character count, and leave point the same.
6521 If `insert-file-contents' is intercepted by a handler from
6522 `file-name-handler-alist', that handler is responsible for calling the
6523 functions in `after-insert-file-functions' if appropriate. */);
6524 Vafter_insert_file_functions
= Qnil
;
6526 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6527 doc
: /* A list of functions to be called at the start of `write-region'.
6528 Each is passed two arguments, START and END as for `write-region'.
6529 These are usually two numbers but not always; see the documentation
6530 for `write-region'. The function should return a list of pairs
6531 of the form (POSITION . STRING), consisting of strings to be effectively
6532 inserted at the specified positions of the file being written (1 means to
6533 insert before the first byte written). The POSITIONs must be sorted into
6534 increasing order. If there are several functions in the list, the several
6535 lists are merged destructively. Alternatively, the function can return
6536 with a different buffer current; in that case it should pay attention
6537 to the annotations returned by previous functions and listed in
6538 `write-region-annotations-so-far'.*/);
6539 Vwrite_region_annotate_functions
= Qnil
;
6540 staticpro (&Qwrite_region_annotate_functions
);
6541 Qwrite_region_annotate_functions
6542 = intern ("write-region-annotate-functions");
6544 DEFVAR_LISP ("write-region-annotations-so-far",
6545 &Vwrite_region_annotations_so_far
,
6546 doc
: /* When an annotation function is called, this holds the previous annotations.
6547 These are the annotations made by other annotation functions
6548 that were already called. See also `write-region-annotate-functions'. */);
6549 Vwrite_region_annotations_so_far
= Qnil
;
6551 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6552 doc
: /* A list of file name handlers that temporarily should not be used.
6553 This applies only to the operation `inhibit-file-name-operation'. */);
6554 Vinhibit_file_name_handlers
= Qnil
;
6556 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6557 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6558 Vinhibit_file_name_operation
= Qnil
;
6560 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6561 doc
: /* File name in which we write a list of all auto save file names.
6562 This variable is initialized automatically from `auto-save-list-file-prefix'
6563 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6564 a non-nil value. */);
6565 Vauto_save_list_file_name
= Qnil
;
6567 defsubr (&Sfind_file_name_handler
);
6568 defsubr (&Sfile_name_directory
);
6569 defsubr (&Sfile_name_nondirectory
);
6570 defsubr (&Sunhandled_file_name_directory
);
6571 defsubr (&Sfile_name_as_directory
);
6572 defsubr (&Sdirectory_file_name
);
6573 defsubr (&Smake_temp_name
);
6574 defsubr (&Sexpand_file_name
);
6575 defsubr (&Ssubstitute_in_file_name
);
6576 defsubr (&Scopy_file
);
6577 defsubr (&Smake_directory_internal
);
6578 defsubr (&Sdelete_directory
);
6579 defsubr (&Sdelete_file
);
6580 defsubr (&Srename_file
);
6581 defsubr (&Sadd_name_to_file
);
6583 defsubr (&Smake_symbolic_link
);
6584 #endif /* S_IFLNK */
6586 defsubr (&Sdefine_logical_name
);
6589 defsubr (&Ssysnetunam
);
6590 #endif /* HPUX_NET */
6591 defsubr (&Sfile_name_absolute_p
);
6592 defsubr (&Sfile_exists_p
);
6593 defsubr (&Sfile_executable_p
);
6594 defsubr (&Sfile_readable_p
);
6595 defsubr (&Sfile_writable_p
);
6596 defsubr (&Saccess_file
);
6597 defsubr (&Sfile_symlink_p
);
6598 defsubr (&Sfile_directory_p
);
6599 defsubr (&Sfile_accessible_directory_p
);
6600 defsubr (&Sfile_regular_p
);
6601 defsubr (&Sfile_modes
);
6602 defsubr (&Sset_file_modes
);
6603 defsubr (&Sset_default_file_modes
);
6604 defsubr (&Sdefault_file_modes
);
6605 defsubr (&Sfile_newer_than_file_p
);
6606 defsubr (&Sinsert_file_contents
);
6607 defsubr (&Swrite_region
);
6608 defsubr (&Scar_less_than_car
);
6609 defsubr (&Sverify_visited_file_modtime
);
6610 defsubr (&Sclear_visited_file_modtime
);
6611 defsubr (&Svisited_file_modtime
);
6612 defsubr (&Sset_visited_file_modtime
);
6613 defsubr (&Sdo_auto_save
);
6614 defsubr (&Sset_buffer_auto_saved
);
6615 defsubr (&Sclear_buffer_auto_save_failure
);
6616 defsubr (&Srecent_auto_save_p
);
6618 defsubr (&Sread_file_name_internal
);
6619 defsubr (&Sread_file_name
);
6622 defsubr (&Sunix_sync
);
6626 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6627 (do not change this comment) */