1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,97,1998 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
23 #if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX)
28 #include <sys/types.h>
35 #if !defined (S_ISLNK) && defined (S_IFLNK)
36 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
39 #if !defined (S_ISFIFO) && defined (S_IFIFO)
40 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
43 #if !defined (S_ISREG) && defined (S_IFREG)
44 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
68 extern char *strerror ();
85 #include "intervals.h"
96 #endif /* not WINDOWSNT */
100 #include <sys/param.h>
108 #define CORRECT_DIR_SEPS(s) \
109 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
110 else unixtodos_filename (s); \
112 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
113 redirector allows the six letters between 'Z' and 'a' as well. */
115 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
118 #define IS_DRIVE(x) isalpha (x)
120 /* Need to lower-case the drive letter, or else expanded
121 filenames will sometimes compare inequal, because
122 `expand-file-name' doesn't always down-case the drive letter. */
123 #define DRIVE_LETTER(x) (tolower (x))
152 #define min(a, b) ((a) < (b) ? (a) : (b))
153 #define max(a, b) ((a) > (b) ? (a) : (b))
155 /* Nonzero during writing of auto-save files */
158 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
159 a new file with the same mode as the original */
160 int auto_save_mode_bits
;
162 /* Coding system for file names, or nil if none. */
163 Lisp_Object Vfile_name_coding_system
;
165 /* Coding system for file names used only when
166 Vfile_name_coding_system is nil. */
167 Lisp_Object Vdefault_file_name_coding_system
;
169 /* Alist of elements (REGEXP . HANDLER) for file names
170 whose I/O is done with a special handler. */
171 Lisp_Object Vfile_name_handler_alist
;
173 /* Format for auto-save files */
174 Lisp_Object Vauto_save_file_format
;
176 /* Lisp functions for translating file formats */
177 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
179 /* Function to be called to decide a coding system of a reading file. */
180 Lisp_Object Vset_auto_coding_function
;
182 /* Functions to be called to process text properties in inserted file. */
183 Lisp_Object Vafter_insert_file_functions
;
185 /* Functions to be called to create text property annotations for file. */
186 Lisp_Object Vwrite_region_annotate_functions
;
188 /* During build_annotations, each time an annotation function is called,
189 this holds the annotations made by the previous functions. */
190 Lisp_Object Vwrite_region_annotations_so_far
;
192 /* File name in which we write a list of all our auto save files. */
193 Lisp_Object Vauto_save_list_file_name
;
195 /* Nonzero means, when reading a filename in the minibuffer,
196 start out by inserting the default directory into the minibuffer. */
197 int insert_default_directory
;
199 /* On VMS, nonzero means write new files with record format stmlf.
200 Zero means use var format. */
203 /* On NT, specifies the directory separator character, used (eg.) when
204 expanding file names. This can be bound to / or \. */
205 Lisp_Object Vdirectory_sep_char
;
207 extern Lisp_Object Vuser_login_name
;
209 extern int minibuf_level
;
211 extern int minibuffer_auto_raise
;
213 /* These variables describe handlers that have "already" had a chance
214 to handle the current operation.
216 Vinhibit_file_name_handlers is a list of file name handlers.
217 Vinhibit_file_name_operation is the operation being handled.
218 If we try to handle that operation, we ignore those handlers. */
220 static Lisp_Object Vinhibit_file_name_handlers
;
221 static Lisp_Object Vinhibit_file_name_operation
;
223 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
225 Lisp_Object Qfile_name_history
;
227 Lisp_Object Qcar_less_than_car
;
229 static int a_write
P_ ((int, char *, int, int,
230 Lisp_Object
*, struct coding_system
*));
231 static int e_write
P_ ((int, char *, int, struct coding_system
*));
234 report_file_error (string
, data
)
238 Lisp_Object errstring
;
240 errstring
= build_string (strerror (errno
));
242 /* System error messages are capitalized. Downcase the initial
243 unless it is followed by a slash. */
244 if (XSTRING (errstring
)->data
[1] != '/')
245 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
248 Fsignal (Qfile_error
,
249 Fcons (build_string (string
), Fcons (errstring
, data
)));
253 close_file_unwind (fd
)
256 close (XFASTINT (fd
));
260 /* Restore point, having saved it as a marker. */
263 restore_point_unwind (location
)
264 Lisp_Object location
;
266 Fgoto_char (location
);
267 Fset_marker (location
, Qnil
, Qnil
);
271 Lisp_Object Qexpand_file_name
;
272 Lisp_Object Qsubstitute_in_file_name
;
273 Lisp_Object Qdirectory_file_name
;
274 Lisp_Object Qfile_name_directory
;
275 Lisp_Object Qfile_name_nondirectory
;
276 Lisp_Object Qunhandled_file_name_directory
;
277 Lisp_Object Qfile_name_as_directory
;
278 Lisp_Object Qcopy_file
;
279 Lisp_Object Qmake_directory_internal
;
280 Lisp_Object Qdelete_directory
;
281 Lisp_Object Qdelete_file
;
282 Lisp_Object Qrename_file
;
283 Lisp_Object Qadd_name_to_file
;
284 Lisp_Object Qmake_symbolic_link
;
285 Lisp_Object Qfile_exists_p
;
286 Lisp_Object Qfile_executable_p
;
287 Lisp_Object Qfile_readable_p
;
288 Lisp_Object Qfile_writable_p
;
289 Lisp_Object Qfile_symlink_p
;
290 Lisp_Object Qaccess_file
;
291 Lisp_Object Qfile_directory_p
;
292 Lisp_Object Qfile_regular_p
;
293 Lisp_Object Qfile_accessible_directory_p
;
294 Lisp_Object Qfile_modes
;
295 Lisp_Object Qset_file_modes
;
296 Lisp_Object Qfile_newer_than_file_p
;
297 Lisp_Object Qinsert_file_contents
;
298 Lisp_Object Qwrite_region
;
299 Lisp_Object Qverify_visited_file_modtime
;
300 Lisp_Object Qset_visited_file_modtime
;
302 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
303 "Return FILENAME's handler function for OPERATION, if it has one.\n\
304 Otherwise, return nil.\n\
305 A file name is handled if one of the regular expressions in\n\
306 `file-name-handler-alist' matches it.\n\n\
307 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
308 any handlers that are members of `inhibit-file-name-handlers',\n\
309 but we still do run any other handlers. This lets handlers\n\
310 use the standard functions without calling themselves recursively.")
311 (filename
, operation
)
312 Lisp_Object filename
, operation
;
314 /* This function must not munge the match data. */
315 Lisp_Object chain
, inhibited_handlers
;
317 CHECK_STRING (filename
, 0);
319 if (EQ (operation
, Vinhibit_file_name_operation
))
320 inhibited_handlers
= Vinhibit_file_name_handlers
;
322 inhibited_handlers
= Qnil
;
324 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
325 chain
= XCONS (chain
)->cdr
)
328 elt
= XCONS (chain
)->car
;
332 string
= XCONS (elt
)->car
;
333 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
335 Lisp_Object handler
, tem
;
337 handler
= XCONS (elt
)->cdr
;
338 tem
= Fmemq (handler
, inhibited_handlers
);
349 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
351 "Return the directory component in file name FILENAME.\n\
352 Return nil if FILENAME does not include a directory.\n\
353 Otherwise return a directory spec.\n\
354 Given a Unix syntax file name, returns a string ending in slash;\n\
355 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
357 Lisp_Object filename
;
359 register unsigned char *beg
;
360 register unsigned char *p
;
363 CHECK_STRING (filename
, 0);
365 /* If the file name has special constructs in it,
366 call the corresponding file handler. */
367 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
369 return call2 (handler
, Qfile_name_directory
, filename
);
371 #ifdef FILE_SYSTEM_CASE
372 filename
= FILE_SYSTEM_CASE (filename
);
374 beg
= XSTRING (filename
)->data
;
376 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
378 p
= beg
+ STRING_BYTES (XSTRING (filename
));
380 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
382 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
385 /* only recognise drive specifier at the beginning */
387 /* handle the "/:d:foo" and "/:foo" cases correctly */
388 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
389 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
396 /* Expansion of "c:" to drive and default directory. */
399 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
400 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
401 unsigned char *r
= res
;
403 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
405 strncpy (res
, beg
, 2);
410 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
412 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
415 p
= beg
+ strlen (beg
);
418 CORRECT_DIR_SEPS (beg
);
421 if (STRING_MULTIBYTE (filename
))
422 return make_string (beg
, p
- beg
);
423 return make_unibyte_string (beg
, p
- beg
);
426 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
427 Sfile_name_nondirectory
, 1, 1, 0,
428 "Return file name FILENAME sans its directory.\n\
429 For example, in a Unix-syntax file name,\n\
430 this is everything after the last slash,\n\
431 or the entire name if it contains no slash.")
433 Lisp_Object filename
;
435 register unsigned char *beg
, *p
, *end
;
438 CHECK_STRING (filename
, 0);
440 /* If the file name has special constructs in it,
441 call the corresponding file handler. */
442 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
444 return call2 (handler
, Qfile_name_nondirectory
, filename
);
446 beg
= XSTRING (filename
)->data
;
447 end
= p
= beg
+ STRING_BYTES (XSTRING (filename
));
449 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
451 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
454 /* only recognise drive specifier at beginning */
456 /* handle the "/:d:foo" case correctly */
457 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
462 if (STRING_MULTIBYTE (filename
))
463 return make_string (p
, end
- p
);
464 return make_unibyte_string (p
, end
- p
);
467 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
468 Sunhandled_file_name_directory
, 1, 1, 0,
469 "Return a directly usable directory name somehow associated with FILENAME.\n\
470 A `directly usable' directory name is one that may be used without the\n\
471 intervention of any file handler.\n\
472 If FILENAME is a directly usable file itself, return\n\
473 \(file-name-directory FILENAME).\n\
474 The `call-process' and `start-process' functions use this function to\n\
475 get a current directory to run processes in.")
477 Lisp_Object filename
;
481 /* If the file name has special constructs in it,
482 call the corresponding file handler. */
483 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
485 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
487 return Ffile_name_directory (filename
);
492 file_name_as_directory (out
, in
)
495 int size
= strlen (in
) - 1;
508 /* Is it already a directory string? */
509 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
511 /* Is it a VMS directory file name? If so, hack VMS syntax. */
512 else if (! index (in
, '/')
513 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
514 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
515 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
516 || ! strncmp (&in
[size
- 5], ".dir", 4))
517 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
518 && in
[size
] == '1')))
520 register char *p
, *dot
;
524 dir:x.dir --> dir:[x]
525 dir:[x]y.dir --> dir:[x.y] */
527 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
530 strncpy (out
, in
, p
- in
);
549 dot
= index (p
, '.');
552 /* blindly remove any extension */
553 size
= strlen (out
) + (dot
- p
);
554 strncat (out
, p
, dot
- p
);
565 /* For Unix syntax, Append a slash if necessary */
566 if (!IS_DIRECTORY_SEP (out
[size
]))
568 out
[size
+ 1] = DIRECTORY_SEP
;
569 out
[size
+ 2] = '\0';
572 CORRECT_DIR_SEPS (out
);
578 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
579 Sfile_name_as_directory
, 1, 1, 0,
580 "Return a string representing file FILENAME interpreted as a directory.\n\
581 This operation exists because a directory is also a file, but its name as\n\
582 a directory is different from its name as a file.\n\
583 The result can be used as the value of `default-directory'\n\
584 or passed as second argument to `expand-file-name'.\n\
585 For a Unix-syntax file name, just appends a slash.\n\
586 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
593 CHECK_STRING (file
, 0);
597 /* If the file name has special constructs in it,
598 call the corresponding file handler. */
599 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
601 return call2 (handler
, Qfile_name_as_directory
, file
);
603 buf
= (char *) alloca (STRING_BYTES (XSTRING (file
)) + 10);
604 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
608 * Convert from directory name to filename.
610 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
611 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
612 * On UNIX, it's simple: just make sure there isn't a terminating /
614 * Value is nonzero if the string output is different from the input.
618 directory_file_name (src
, dst
)
626 struct FAB fab
= cc$rms_fab
;
627 struct NAM nam
= cc$rms_nam
;
628 char esa
[NAM$C_MAXRSS
];
633 if (! index (src
, '/')
634 && (src
[slen
- 1] == ']'
635 || src
[slen
- 1] == ':'
636 || src
[slen
- 1] == '>'))
638 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
640 fab
.fab$b_fns
= slen
;
641 fab
.fab$l_nam
= &nam
;
642 fab
.fab$l_fop
= FAB$M_NAM
;
645 nam
.nam$b_ess
= sizeof esa
;
646 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
648 /* We call SYS$PARSE to handle such things as [--] for us. */
649 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
651 slen
= nam
.nam$b_esl
;
652 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
657 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
659 /* what about when we have logical_name:???? */
660 if (src
[slen
- 1] == ':')
661 { /* Xlate logical name and see what we get */
662 ptr
= strcpy (dst
, src
); /* upper case for getenv */
665 if ('a' <= *ptr
&& *ptr
<= 'z')
669 dst
[slen
- 1] = 0; /* remove colon */
670 if (!(src
= egetenv (dst
)))
672 /* should we jump to the beginning of this procedure?
673 Good points: allows us to use logical names that xlate
675 Bad points: can be a problem if we just translated to a device
677 For now, I'll punt and always expect VMS names, and hope for
680 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
681 { /* no recursion here! */
687 { /* not a directory spec */
692 bracket
= src
[slen
- 1];
694 /* If bracket is ']' or '>', bracket - 2 is the corresponding
696 ptr
= index (src
, bracket
- 2);
698 { /* no opening bracket */
702 if (!(rptr
= rindex (src
, '.')))
705 strncpy (dst
, src
, slen
);
709 dst
[slen
++] = bracket
;
714 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
715 then translate the device and recurse. */
716 if (dst
[slen
- 1] == ':'
717 && dst
[slen
- 2] != ':' /* skip decnet nodes */
718 && strcmp (src
+ slen
, "[000000]") == 0)
720 dst
[slen
- 1] = '\0';
721 if ((ptr
= egetenv (dst
))
722 && (rlen
= strlen (ptr
) - 1) > 0
723 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
724 && ptr
[rlen
- 1] == '.')
726 char * buf
= (char *) alloca (strlen (ptr
) + 1);
730 return directory_file_name (buf
, dst
);
735 strcat (dst
, "[000000]");
739 rlen
= strlen (rptr
) - 1;
740 strncat (dst
, rptr
, rlen
);
741 dst
[slen
+ rlen
] = '\0';
742 strcat (dst
, ".DIR.1");
746 /* Process as Unix format: just remove any final slash.
747 But leave "/" unchanged; do not change it to "". */
750 /* Handle // as root for apollo's. */
751 if ((slen
> 2 && dst
[slen
- 1] == '/')
752 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
756 && IS_DIRECTORY_SEP (dst
[slen
- 1])
758 && !IS_ANY_SEP (dst
[slen
- 2])
764 CORRECT_DIR_SEPS (dst
);
769 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
771 "Returns the file name of the directory named DIRECTORY.\n\
772 This is the name of the file that holds the data for the directory DIRECTORY.\n\
773 This operation exists because a directory is also a file, but its name as\n\
774 a directory is different from its name as a file.\n\
775 In Unix-syntax, this function just removes the final slash.\n\
776 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
777 it returns a file name such as \"[X]Y.DIR.1\".")
779 Lisp_Object directory
;
784 CHECK_STRING (directory
, 0);
786 if (NILP (directory
))
789 /* If the file name has special constructs in it,
790 call the corresponding file handler. */
791 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
793 return call2 (handler
, Qdirectory_file_name
, directory
);
796 /* 20 extra chars is insufficient for VMS, since we might perform a
797 logical name translation. an equivalence string can be up to 255
798 chars long, so grab that much extra space... - sss */
799 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20 + 255);
801 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20);
803 directory_file_name (XSTRING (directory
)->data
, buf
);
804 return build_string (buf
);
807 static char make_temp_name_tbl
[64] =
809 'A','B','C','D','E','F','G','H',
810 'I','J','K','L','M','N','O','P',
811 'Q','R','S','T','U','V','W','X',
812 'Y','Z','a','b','c','d','e','f',
813 'g','h','i','j','k','l','m','n',
814 'o','p','q','r','s','t','u','v',
815 'w','x','y','z','0','1','2','3',
816 '4','5','6','7','8','9','-','_'
818 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
820 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
821 "Generate temporary file name (string) starting with PREFIX (a string).\n\
822 The Emacs process number forms part of the result,\n\
823 so there is no danger of generating a name being used by another process.\n\
825 In addition, this function makes an attempt to choose a name\n\
826 which has no existing file. To make this work,\n\
827 PREFIX should be an absolute file name.")
834 unsigned char *p
, *data
;
838 CHECK_STRING (prefix
, 0);
840 /* VAL is created by adding 6 characters to PREFIX. The first
841 three are the PID of this process, in base 64, and the second
842 three are incremented if the file already exists. This ensures
843 262144 unique file names per PID per PREFIX. */
845 pid
= (int) getpid ();
847 #ifdef HAVE_LONG_FILE_NAMES
848 sprintf (pidbuf
, "%d", pid
);
849 pidlen
= strlen (pidbuf
);
851 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
852 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
853 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
857 len
= XSTRING (prefix
)->size
;
858 val
= make_uninit_string (len
+ 3 + pidlen
);
859 data
= XSTRING (val
)->data
;
860 bcopy(XSTRING (prefix
)->data
, data
, len
);
863 bcopy (pidbuf
, p
, pidlen
);
866 /* Here we try to minimize useless stat'ing when this function is
867 invoked many times successively with the same PREFIX. We achieve
868 this by initializing count to a random value, and incrementing it
871 We don't want make-temp-name to be called while dumping,
872 because then make_temp_name_count_initialized_p would get set
873 and then make_temp_name_count would not be set when Emacs starts. */
875 if (!make_temp_name_count_initialized_p
)
877 make_temp_name_count
= (unsigned) time (NULL
);
878 make_temp_name_count_initialized_p
= 1;
884 unsigned num
= make_temp_name_count
;
886 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
887 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
888 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
890 /* Poor man's congruential RN generator. Replace with
891 ++make_temp_name_count for debugging. */
892 make_temp_name_count
+= 25229;
893 make_temp_name_count
%= 225307;
895 if (stat (data
, &ignored
) < 0)
897 /* We want to return only if errno is ENOENT. */
901 /* The error here is dubious, but there is little else we
902 can do. The alternatives are to return nil, which is
903 as bad as (and in many cases worse than) throwing the
904 error, or to ignore the error, which will likely result
905 in looping through 225307 stat's, which is not only
906 dog-slow, but also useless since it will fallback to
907 the errow below, anyway. */
908 report_file_error ("Cannot create temporary name for prefix `%s'",
909 Fcons (prefix
, Qnil
));
914 error ("Cannot create temporary name for prefix `%s'",
915 XSTRING (prefix
)->data
);
920 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
921 "Convert filename NAME to absolute, and canonicalize it.\n\
922 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
923 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
924 the current buffer's value of default-directory is used.\n\
925 File name components that are `.' are removed, and \n\
926 so are file name components followed by `..', along with the `..' itself;\n\
927 note that these simplifications are done without checking the resulting\n\
928 file names in the file system.\n\
929 An initial `~/' expands to your home directory.\n\
930 An initial `~USER/' expands to USER's home directory.\n\
931 See also the function `substitute-in-file-name'.")
932 (name
, default_directory
)
933 Lisp_Object name
, default_directory
;
937 register unsigned char *newdir
, *p
, *o
;
939 unsigned char *target
;
942 unsigned char * colon
= 0;
943 unsigned char * close
= 0;
944 unsigned char * slash
= 0;
945 unsigned char * brack
= 0;
946 int lbrack
= 0, rbrack
= 0;
951 int collapse_newdir
= 1;
957 CHECK_STRING (name
, 0);
959 /* If the file name has special constructs in it,
960 call the corresponding file handler. */
961 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
963 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
965 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
966 if (NILP (default_directory
))
967 default_directory
= current_buffer
->directory
;
968 if (! STRINGP (default_directory
))
969 default_directory
= build_string ("/");
971 if (!NILP (default_directory
))
973 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
975 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
978 o
= XSTRING (default_directory
)->data
;
980 /* Make sure DEFAULT_DIRECTORY is properly expanded.
981 It would be better to do this down below where we actually use
982 default_directory. Unfortunately, calling Fexpand_file_name recursively
983 could invoke GC, and the strings might be relocated. This would
984 be annoying because we have pointers into strings lying around
985 that would need adjusting, and people would add new pointers to
986 the code and forget to adjust them, resulting in intermittent bugs.
987 Putting this call here avoids all that crud.
989 The EQ test avoids infinite recursion. */
990 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
991 /* Save time in some common cases - as long as default_directory
992 is not relative, it can be canonicalized with name below (if it
993 is needed at all) without requiring it to be expanded now. */
995 /* Detect MSDOS file names with drive specifiers. */
996 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
998 /* Detect Windows file names in UNC format. */
999 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1001 #else /* not DOS_NT */
1002 /* Detect Unix absolute file names (/... alone is not absolute on
1004 && ! (IS_DIRECTORY_SEP (o
[0]))
1005 #endif /* not DOS_NT */
1008 struct gcpro gcpro1
;
1011 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1016 /* Filenames on VMS are always upper case. */
1017 name
= Fupcase (name
);
1019 #ifdef FILE_SYSTEM_CASE
1020 name
= FILE_SYSTEM_CASE (name
);
1023 nm
= XSTRING (name
)->data
;
1026 /* We will force directory separators to be either all \ or /, so make
1027 a local copy to modify, even if there ends up being no change. */
1028 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1030 /* Note if special escape prefix is present, but remove for now. */
1031 if (nm
[0] == '/' && nm
[1] == ':')
1037 /* Find and remove drive specifier if present; this makes nm absolute
1038 even if the rest of the name appears to be relative. Only look for
1039 drive specifier at the beginning. */
1040 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1047 /* If we see "c://somedir", we want to strip the first slash after the
1048 colon when stripping the drive letter. Otherwise, this expands to
1050 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1052 #endif /* WINDOWSNT */
1056 /* Discard any previous drive specifier if nm is now in UNC format. */
1057 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1063 /* If nm is absolute, look for /./ or /../ sequences; if none are
1064 found, we can probably return right away. We will avoid allocating
1065 a new string if name is already fully expanded. */
1067 IS_DIRECTORY_SEP (nm
[0])
1069 && drive
&& !is_escaped
1072 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1079 /* If it turns out that the filename we want to return is just a
1080 suffix of FILENAME, we don't need to go through and edit
1081 things; we just need to construct a new string using data
1082 starting at the middle of FILENAME. If we set lose to a
1083 non-zero value, that means we've discovered that we can't do
1090 /* Since we know the name is absolute, we can assume that each
1091 element starts with a "/". */
1093 /* "." and ".." are hairy. */
1094 if (IS_DIRECTORY_SEP (p
[0])
1096 && (IS_DIRECTORY_SEP (p
[2])
1098 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1105 /* if dev:[dir]/, move nm to / */
1106 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1107 nm
= (brack
? brack
+ 1 : colon
+ 1);
1108 lbrack
= rbrack
= 0;
1116 /* VMS pre V4.4,convert '-'s in filenames. */
1117 if (lbrack
== rbrack
)
1119 if (dots
< 2) /* this is to allow negative version numbers */
1124 if (lbrack
> rbrack
&&
1125 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1126 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1132 /* count open brackets, reset close bracket pointer */
1133 if (p
[0] == '[' || p
[0] == '<')
1134 lbrack
++, brack
= 0;
1135 /* count close brackets, set close bracket pointer */
1136 if (p
[0] == ']' || p
[0] == '>')
1137 rbrack
++, brack
= p
;
1138 /* detect ][ or >< */
1139 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1141 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1142 nm
= p
+ 1, lose
= 1;
1143 if (p
[0] == ':' && (colon
|| slash
))
1144 /* if dev1:[dir]dev2:, move nm to dev2: */
1150 /* if /name/dev:, move nm to dev: */
1153 /* if node::dev:, move colon following dev */
1154 else if (colon
&& colon
[-1] == ':')
1156 /* if dev1:dev2:, move nm to dev2: */
1157 else if (colon
&& colon
[-1] != ':')
1162 if (p
[0] == ':' && !colon
)
1168 if (lbrack
== rbrack
)
1171 else if (p
[0] == '.')
1179 if (index (nm
, '/'))
1180 return build_string (sys_translate_unix (nm
));
1183 /* Make sure directories are all separated with / or \ as
1184 desired, but avoid allocation of a new string when not
1186 CORRECT_DIR_SEPS (nm
);
1188 if (IS_DIRECTORY_SEP (nm
[1]))
1190 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1191 name
= build_string (nm
);
1195 /* drive must be set, so this is okay */
1196 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1198 name
= make_string (nm
- 2, p
- nm
+ 2);
1199 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1200 XSTRING (name
)->data
[1] = ':';
1203 #else /* not DOS_NT */
1204 if (nm
== XSTRING (name
)->data
)
1206 return build_string (nm
);
1207 #endif /* not DOS_NT */
1211 /* At this point, nm might or might not be an absolute file name. We
1212 need to expand ~ or ~user if present, otherwise prefix nm with
1213 default_directory if nm is not absolute, and finally collapse /./
1214 and /foo/../ sequences.
1216 We set newdir to be the appropriate prefix if one is needed:
1217 - the relevant user directory if nm starts with ~ or ~user
1218 - the specified drive's working dir (DOS/NT only) if nm does not
1220 - the value of default_directory.
1222 Note that these prefixes are not guaranteed to be absolute (except
1223 for the working dir of a drive). Therefore, to ensure we always
1224 return an absolute name, if the final prefix is not absolute we
1225 append it to the current working directory. */
1229 if (nm
[0] == '~') /* prefix ~ */
1231 if (IS_DIRECTORY_SEP (nm
[1])
1235 || nm
[1] == 0) /* ~ by itself */
1237 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1238 newdir
= (unsigned char *) "";
1241 collapse_newdir
= 0;
1244 nm
++; /* Don't leave the slash in nm. */
1247 else /* ~user/filename */
1249 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1254 o
= (unsigned char *) alloca (p
- nm
+ 1);
1255 bcopy ((char *) nm
, o
, p
- nm
);
1258 pw
= (struct passwd
*) getpwnam (o
+ 1);
1261 newdir
= (unsigned char *) pw
-> pw_dir
;
1263 nm
= p
+ 1; /* skip the terminator */
1267 collapse_newdir
= 0;
1272 /* If we don't find a user of that name, leave the name
1273 unchanged; don't move nm forward to p. */
1278 /* On DOS and Windows, nm is absolute if a drive name was specified;
1279 use the drive's current directory as the prefix if needed. */
1280 if (!newdir
&& drive
)
1282 /* Get default directory if needed to make nm absolute. */
1283 if (!IS_DIRECTORY_SEP (nm
[0]))
1285 newdir
= alloca (MAXPATHLEN
+ 1);
1286 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1291 /* Either nm starts with /, or drive isn't mounted. */
1292 newdir
= alloca (4);
1293 newdir
[0] = DRIVE_LETTER (drive
);
1301 /* Finally, if no prefix has been specified and nm is not absolute,
1302 then it must be expanded relative to default_directory. */
1306 /* /... alone is not absolute on DOS and Windows. */
1307 && !IS_DIRECTORY_SEP (nm
[0])
1310 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1317 newdir
= XSTRING (default_directory
)->data
;
1319 /* Note if special escape prefix is present, but remove for now. */
1320 if (newdir
[0] == '/' && newdir
[1] == ':')
1331 /* First ensure newdir is an absolute name. */
1333 /* Detect MSDOS file names with drive specifiers. */
1334 ! (IS_DRIVE (newdir
[0])
1335 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1337 /* Detect Windows file names in UNC format. */
1338 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1342 /* Effectively, let newdir be (expand-file-name newdir cwd).
1343 Because of the admonition against calling expand-file-name
1344 when we have pointers into lisp strings, we accomplish this
1345 indirectly by prepending newdir to nm if necessary, and using
1346 cwd (or the wd of newdir's drive) as the new newdir. */
1348 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1353 if (!IS_DIRECTORY_SEP (nm
[0]))
1355 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1356 file_name_as_directory (tmp
, newdir
);
1360 newdir
= alloca (MAXPATHLEN
+ 1);
1363 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1370 /* Strip off drive name from prefix, if present. */
1371 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1377 /* Keep only a prefix from newdir if nm starts with slash
1378 (//server/share for UNC, nothing otherwise). */
1379 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1382 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1384 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1386 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1388 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1400 /* Get rid of any slash at the end of newdir, unless newdir is
1401 just / or // (an incomplete UNC name). */
1402 length
= strlen (newdir
);
1403 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1405 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1409 unsigned char *temp
= (unsigned char *) alloca (length
);
1410 bcopy (newdir
, temp
, length
- 1);
1411 temp
[length
- 1] = 0;
1419 /* Now concatenate the directory and name to new space in the stack frame */
1420 tlen
+= strlen (nm
) + 1;
1422 /* Reserve space for drive specifier and escape prefix, since either
1423 or both may need to be inserted. (The Microsoft x86 compiler
1424 produces incorrect code if the following two lines are combined.) */
1425 target
= (unsigned char *) alloca (tlen
+ 4);
1427 #else /* not DOS_NT */
1428 target
= (unsigned char *) alloca (tlen
);
1429 #endif /* not DOS_NT */
1435 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1438 /* If newdir is effectively "C:/", then the drive letter will have
1439 been stripped and newdir will be "/". Concatenating with an
1440 absolute directory in nm produces "//", which will then be
1441 incorrectly treated as a network share. Ignore newdir in
1442 this case (keeping the drive letter). */
1443 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1444 && newdir
[1] == '\0'))
1446 strcpy (target
, newdir
);
1450 file_name_as_directory (target
, newdir
);
1453 strcat (target
, nm
);
1455 if (index (target
, '/'))
1456 strcpy (target
, sys_translate_unix (target
));
1459 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1461 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1469 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1475 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1476 /* brackets are offset from each other by 2 */
1479 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1480 /* convert [foo][bar] to [bar] */
1481 while (o
[-1] != '[' && o
[-1] != '<')
1483 else if (*p
== '-' && *o
!= '.')
1486 else if (p
[0] == '-' && o
[-1] == '.' &&
1487 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1488 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1492 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1493 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1495 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1497 /* else [foo.-] ==> [-] */
1503 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1504 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1510 if (!IS_DIRECTORY_SEP (*p
))
1514 else if (IS_DIRECTORY_SEP (p
[0])
1516 && (IS_DIRECTORY_SEP (p
[2])
1519 /* If "/." is the entire filename, keep the "/". Otherwise,
1520 just delete the whole "/.". */
1521 if (o
== target
&& p
[2] == '\0')
1525 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1526 /* `/../' is the "superroot" on certain file systems. */
1528 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1530 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1532 /* Keep initial / only if this is the whole name. */
1533 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1541 #endif /* not VMS */
1545 /* At last, set drive name. */
1547 /* Except for network file name. */
1548 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1549 #endif /* WINDOWSNT */
1551 if (!drive
) abort ();
1553 target
[0] = DRIVE_LETTER (drive
);
1556 /* Reinsert the escape prefix if required. */
1563 CORRECT_DIR_SEPS (target
);
1566 return make_string (target
, o
- target
);
1570 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1571 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1572 "Convert FILENAME to absolute, and canonicalize it.\n\
1573 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1574 (does not start with slash); if DEFAULT is nil or missing,\n\
1575 the current buffer's value of default-directory is used.\n\
1576 Filenames containing `.' or `..' as components are simplified;\n\
1577 initial `~/' expands to your home directory.\n\
1578 See also the function `substitute-in-file-name'.")
1580 Lisp_Object name
, defalt
;
1584 register unsigned char *newdir
, *p
, *o
;
1586 unsigned char *target
;
1590 unsigned char * colon
= 0;
1591 unsigned char * close
= 0;
1592 unsigned char * slash
= 0;
1593 unsigned char * brack
= 0;
1594 int lbrack
= 0, rbrack
= 0;
1598 CHECK_STRING (name
, 0);
1601 /* Filenames on VMS are always upper case. */
1602 name
= Fupcase (name
);
1605 nm
= XSTRING (name
)->data
;
1607 /* If nm is absolute, flush ...// and detect /./ and /../.
1608 If no /./ or /../ we can return right away. */
1620 if (p
[0] == '/' && p
[1] == '/'
1622 /* // at start of filename is meaningful on Apollo system. */
1627 if (p
[0] == '/' && p
[1] == '~')
1628 nm
= p
+ 1, lose
= 1;
1629 if (p
[0] == '/' && p
[1] == '.'
1630 && (p
[2] == '/' || p
[2] == 0
1631 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1637 /* if dev:[dir]/, move nm to / */
1638 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1639 nm
= (brack
? brack
+ 1 : colon
+ 1);
1640 lbrack
= rbrack
= 0;
1648 /* VMS pre V4.4,convert '-'s in filenames. */
1649 if (lbrack
== rbrack
)
1651 if (dots
< 2) /* this is to allow negative version numbers */
1656 if (lbrack
> rbrack
&&
1657 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1658 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1664 /* count open brackets, reset close bracket pointer */
1665 if (p
[0] == '[' || p
[0] == '<')
1666 lbrack
++, brack
= 0;
1667 /* count close brackets, set close bracket pointer */
1668 if (p
[0] == ']' || p
[0] == '>')
1669 rbrack
++, brack
= p
;
1670 /* detect ][ or >< */
1671 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1673 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1674 nm
= p
+ 1, lose
= 1;
1675 if (p
[0] == ':' && (colon
|| slash
))
1676 /* if dev1:[dir]dev2:, move nm to dev2: */
1682 /* If /name/dev:, move nm to dev: */
1685 /* If node::dev:, move colon following dev */
1686 else if (colon
&& colon
[-1] == ':')
1688 /* If dev1:dev2:, move nm to dev2: */
1689 else if (colon
&& colon
[-1] != ':')
1694 if (p
[0] == ':' && !colon
)
1700 if (lbrack
== rbrack
)
1703 else if (p
[0] == '.')
1711 if (index (nm
, '/'))
1712 return build_string (sys_translate_unix (nm
));
1714 if (nm
== XSTRING (name
)->data
)
1716 return build_string (nm
);
1720 /* Now determine directory to start with and put it in NEWDIR */
1724 if (nm
[0] == '~') /* prefix ~ */
1729 || nm
[1] == 0)/* ~/filename */
1731 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1732 newdir
= (unsigned char *) "";
1735 nm
++; /* Don't leave the slash in nm. */
1738 else /* ~user/filename */
1740 /* Get past ~ to user */
1741 unsigned char *user
= nm
+ 1;
1742 /* Find end of name. */
1743 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1744 int len
= ptr
? ptr
- user
: strlen (user
);
1746 unsigned char *ptr1
= index (user
, ':');
1747 if (ptr1
!= 0 && ptr1
- user
< len
)
1750 /* Copy the user name into temp storage. */
1751 o
= (unsigned char *) alloca (len
+ 1);
1752 bcopy ((char *) user
, o
, len
);
1755 /* Look up the user name. */
1756 pw
= (struct passwd
*) getpwnam (o
+ 1);
1758 error ("\"%s\" isn't a registered user", o
+ 1);
1760 newdir
= (unsigned char *) pw
->pw_dir
;
1762 /* Discard the user name from NM. */
1769 #endif /* not VMS */
1773 defalt
= current_buffer
->directory
;
1774 CHECK_STRING (defalt
, 1);
1775 newdir
= XSTRING (defalt
)->data
;
1778 /* Now concatenate the directory and name to new space in the stack frame */
1780 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1781 target
= (unsigned char *) alloca (tlen
);
1787 if (nm
[0] == 0 || nm
[0] == '/')
1788 strcpy (target
, newdir
);
1791 file_name_as_directory (target
, newdir
);
1794 strcat (target
, nm
);
1796 if (index (target
, '/'))
1797 strcpy (target
, sys_translate_unix (target
));
1800 /* Now canonicalize by removing /. and /foo/.. if they appear */
1808 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1814 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1815 /* brackets are offset from each other by 2 */
1818 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1819 /* convert [foo][bar] to [bar] */
1820 while (o
[-1] != '[' && o
[-1] != '<')
1822 else if (*p
== '-' && *o
!= '.')
1825 else if (p
[0] == '-' && o
[-1] == '.' &&
1826 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1827 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1831 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1832 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1834 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1836 /* else [foo.-] ==> [-] */
1842 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1843 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1853 else if (!strncmp (p
, "//", 2)
1855 /* // at start of filename is meaningful in Apollo system. */
1863 else if (p
[0] == '/' && p
[1] == '.' &&
1864 (p
[2] == '/' || p
[2] == 0))
1866 else if (!strncmp (p
, "/..", 3)
1867 /* `/../' is the "superroot" on certain file systems. */
1869 && (p
[3] == '/' || p
[3] == 0))
1871 while (o
!= target
&& *--o
!= '/')
1874 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1878 if (o
== target
&& *o
== '/')
1886 #endif /* not VMS */
1889 return make_string (target
, o
- target
);
1893 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1894 Ssubstitute_in_file_name
, 1, 1, 0,
1895 "Substitute environment variables referred to in FILENAME.\n\
1896 `$FOO' where FOO is an environment variable name means to substitute\n\
1897 the value of that variable. The variable name should be terminated\n\
1898 with a character not a letter, digit or underscore; otherwise, enclose\n\
1899 the entire variable name in braces.\n\
1900 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1901 On VMS, `$' substitution is not done; this function does little and only\n\
1902 duplicates what `expand-file-name' does.")
1904 Lisp_Object filename
;
1908 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1909 unsigned char *target
;
1911 int substituted
= 0;
1913 Lisp_Object handler
;
1915 CHECK_STRING (filename
, 0);
1917 /* If the file name has special constructs in it,
1918 call the corresponding file handler. */
1919 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1920 if (!NILP (handler
))
1921 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1923 nm
= XSTRING (filename
)->data
;
1925 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1926 CORRECT_DIR_SEPS (nm
);
1927 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1929 endp
= nm
+ STRING_BYTES (XSTRING (filename
));
1931 /* If /~ or // appears, discard everything through first slash. */
1933 for (p
= nm
; p
!= endp
; p
++)
1936 #if defined (APOLLO) || defined (WINDOWSNT)
1937 /* // at start of file name is meaningful in Apollo and
1938 WindowsNT systems. */
1939 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1940 #else /* not (APOLLO || WINDOWSNT) */
1941 || IS_DIRECTORY_SEP (p
[0])
1942 #endif /* not (APOLLO || WINDOWSNT) */
1947 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1949 || IS_DIRECTORY_SEP (p
[-1])))
1955 /* see comment in expand-file-name about drive specifiers */
1956 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1957 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1966 return build_string (nm
);
1969 /* See if any variables are substituted into the string
1970 and find the total length of their values in `total' */
1972 for (p
= nm
; p
!= endp
;)
1982 /* "$$" means a single "$" */
1991 while (p
!= endp
&& *p
!= '}') p
++;
1992 if (*p
!= '}') goto missingclose
;
1998 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2002 /* Copy out the variable name */
2003 target
= (unsigned char *) alloca (s
- o
+ 1);
2004 strncpy (target
, o
, s
- o
);
2007 strupr (target
); /* $home == $HOME etc. */
2010 /* Get variable value */
2011 o
= (unsigned char *) egetenv (target
);
2012 if (!o
) goto badvar
;
2013 total
+= strlen (o
);
2020 /* If substitution required, recopy the string and do it */
2021 /* Make space in stack frame for the new copy */
2022 xnm
= (unsigned char *) alloca (STRING_BYTES (XSTRING (filename
)) + total
+ 1);
2025 /* Copy the rest of the name through, replacing $ constructs with values */
2042 while (p
!= endp
&& *p
!= '}') p
++;
2043 if (*p
!= '}') goto missingclose
;
2049 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2053 /* Copy out the variable name */
2054 target
= (unsigned char *) alloca (s
- o
+ 1);
2055 strncpy (target
, o
, s
- o
);
2058 strupr (target
); /* $home == $HOME etc. */
2061 /* Get variable value */
2062 o
= (unsigned char *) egetenv (target
);
2066 if (STRING_MULTIBYTE (filename
))
2068 /* If the original string is multibyte,
2069 convert what we substitute into multibyte. */
2070 unsigned char workbuf
[4], *str
;
2076 c
= unibyte_char_to_multibyte (c
);
2077 if (! SINGLE_BYTE_CHAR_P (c
))
2079 len
= CHAR_STRING (c
, workbuf
, str
);
2080 bcopy (str
, x
, len
);
2096 /* If /~ or // appears, discard everything through first slash. */
2098 for (p
= xnm
; p
!= x
; p
++)
2100 #if defined (APOLLO) || defined (WINDOWSNT)
2101 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2102 #else /* not (APOLLO || WINDOWSNT) */
2103 || IS_DIRECTORY_SEP (p
[0])
2104 #endif /* not (APOLLO || WINDOWSNT) */
2106 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2109 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2110 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2114 if (STRING_MULTIBYTE (filename
))
2115 return make_string (xnm
, x
- xnm
);
2116 return make_unibyte_string (xnm
, x
- xnm
);
2119 error ("Bad format environment-variable substitution");
2121 error ("Missing \"}\" in environment-variable substitution");
2123 error ("Substituting nonexistent environment variable \"%s\"", target
);
2126 #endif /* not VMS */
2129 /* A slightly faster and more convenient way to get
2130 (directory-file-name (expand-file-name FOO)). */
2133 expand_and_dir_to_file (filename
, defdir
)
2134 Lisp_Object filename
, defdir
;
2136 register Lisp_Object absname
;
2138 absname
= Fexpand_file_name (filename
, defdir
);
2141 register int c
= XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1];
2142 if (c
== ':' || c
== ']' || c
== '>')
2143 absname
= Fdirectory_file_name (absname
);
2146 /* Remove final slash, if any (unless this is the root dir).
2147 stat behaves differently depending! */
2148 if (XSTRING (absname
)->size
> 1
2149 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1])
2150 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
))-2]))
2151 /* We cannot take shortcuts; they might be wrong for magic file names. */
2152 absname
= Fdirectory_file_name (absname
);
2157 /* Signal an error if the file ABSNAME already exists.
2158 If INTERACTIVE is nonzero, ask the user whether to proceed,
2159 and bypass the error if the user says to go ahead.
2160 QUERYSTRING is a name for the action that is being considered
2163 *STATPTR is used to store the stat information if the file exists.
2164 If the file does not exist, STATPTR->st_mode is set to 0.
2165 If STATPTR is null, we don't store into it.
2167 If QUICK is nonzero, we ask for y or n, not yes or no. */
2170 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2171 Lisp_Object absname
;
2172 unsigned char *querystring
;
2174 struct stat
*statptr
;
2177 register Lisp_Object tem
, encoded_filename
;
2178 struct stat statbuf
;
2179 struct gcpro gcpro1
;
2181 encoded_filename
= ENCODE_FILE (absname
);
2183 /* stat is a good way to tell whether the file exists,
2184 regardless of what access permissions it has. */
2185 if (stat (XSTRING (encoded_filename
)->data
, &statbuf
) >= 0)
2188 Fsignal (Qfile_already_exists
,
2189 Fcons (build_string ("File already exists"),
2190 Fcons (absname
, Qnil
)));
2192 tem
= format1 ("File %s already exists; %s anyway? ",
2193 XSTRING (absname
)->data
, querystring
);
2195 tem
= Fy_or_n_p (tem
);
2197 tem
= do_yes_or_no_p (tem
);
2200 Fsignal (Qfile_already_exists
,
2201 Fcons (build_string ("File already exists"),
2202 Fcons (absname
, Qnil
)));
2209 statptr
->st_mode
= 0;
2214 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2215 "fCopy file: \nFCopy %s to file: \np\nP",
2216 "Copy FILE to NEWNAME. Both args must be strings.\n\
2217 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2218 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2219 A number as third arg means request confirmation if NEWNAME already exists.\n\
2220 This is what happens in interactive use with M-x.\n\
2221 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2222 last-modified time as the old one. (This works on only some systems.)\n\
2223 A prefix arg makes KEEP-TIME non-nil.")
2224 (file
, newname
, ok_if_already_exists
, keep_date
)
2225 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2228 char buf
[16 * 1024];
2229 struct stat st
, out_st
;
2230 Lisp_Object handler
;
2231 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2232 int count
= specpdl_ptr
- specpdl
;
2233 int input_file_statable_p
;
2234 Lisp_Object encoded_file
, encoded_newname
;
2236 encoded_file
= encoded_newname
= Qnil
;
2237 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2238 CHECK_STRING (file
, 0);
2239 CHECK_STRING (newname
, 1);
2241 file
= Fexpand_file_name (file
, Qnil
);
2242 newname
= Fexpand_file_name (newname
, Qnil
);
2244 /* If the input file name has special constructs in it,
2245 call the corresponding file handler. */
2246 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2247 /* Likewise for output file name. */
2249 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2250 if (!NILP (handler
))
2251 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2252 ok_if_already_exists
, keep_date
));
2254 encoded_file
= ENCODE_FILE (file
);
2255 encoded_newname
= ENCODE_FILE (newname
);
2257 if (NILP (ok_if_already_exists
)
2258 || INTEGERP (ok_if_already_exists
))
2259 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2260 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2261 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2264 ifd
= open (XSTRING (encoded_file
)->data
, O_RDONLY
);
2266 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2268 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2270 /* We can only copy regular files and symbolic links. Other files are not
2272 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2274 #if !defined (DOS_NT) || __DJGPP__ > 1
2275 if (out_st
.st_mode
!= 0
2276 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2279 report_file_error ("Input and output files are the same",
2280 Fcons (file
, Fcons (newname
, Qnil
)));
2284 #if defined (S_ISREG) && defined (S_ISLNK)
2285 if (input_file_statable_p
)
2287 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2289 #if defined (EISDIR)
2290 /* Get a better looking error message. */
2293 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2296 #endif /* S_ISREG && S_ISLNK */
2299 /* Create the copy file with the same record format as the input file */
2300 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2303 /* System's default file type was set to binary by _fmode in emacs.c. */
2304 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2305 #else /* not MSDOS */
2306 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2307 #endif /* not MSDOS */
2310 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2312 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2316 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2317 if (write (ofd
, buf
, n
) != n
)
2318 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2321 /* Closing the output clobbers the file times on some systems. */
2322 if (close (ofd
) < 0)
2323 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2325 if (input_file_statable_p
)
2327 if (!NILP (keep_date
))
2329 EMACS_TIME atime
, mtime
;
2330 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2331 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2332 if (set_file_times (XSTRING (encoded_newname
)->data
,
2334 Fsignal (Qfile_date_error
,
2335 Fcons (build_string ("Cannot set file date"),
2336 Fcons (newname
, Qnil
)));
2339 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2341 #if defined (__DJGPP__) && __DJGPP__ > 1
2342 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2343 and if it can't, it tells so. Otherwise, under MSDOS we usually
2344 get only the READ bit, which will make the copied file read-only,
2345 so it's better not to chmod at all. */
2346 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2347 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2348 #endif /* DJGPP version 2 or newer */
2354 /* Discard the unwind protects. */
2355 specpdl_ptr
= specpdl
+ count
;
2361 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2362 Smake_directory_internal
, 1, 1, 0,
2363 "Create a new directory named DIRECTORY.")
2365 Lisp_Object directory
;
2368 Lisp_Object handler
;
2369 Lisp_Object encoded_dir
;
2371 CHECK_STRING (directory
, 0);
2372 directory
= Fexpand_file_name (directory
, Qnil
);
2374 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2375 if (!NILP (handler
))
2376 return call2 (handler
, Qmake_directory_internal
, directory
);
2378 encoded_dir
= ENCODE_FILE (directory
);
2380 dir
= XSTRING (encoded_dir
)->data
;
2383 if (mkdir (dir
) != 0)
2385 if (mkdir (dir
, 0777) != 0)
2387 report_file_error ("Creating directory", Flist (1, &directory
));
2392 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2393 "Delete the directory named DIRECTORY.")
2395 Lisp_Object directory
;
2398 Lisp_Object handler
;
2399 Lisp_Object encoded_dir
;
2401 CHECK_STRING (directory
, 0);
2402 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2404 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2405 if (!NILP (handler
))
2406 return call2 (handler
, Qdelete_directory
, directory
);
2408 encoded_dir
= ENCODE_FILE (directory
);
2410 dir
= XSTRING (encoded_dir
)->data
;
2412 if (rmdir (dir
) != 0)
2413 report_file_error ("Removing directory", Flist (1, &directory
));
2418 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2419 "Delete file named FILENAME.\n\
2420 If file has multiple names, it continues to exist with the other names.")
2422 Lisp_Object filename
;
2424 Lisp_Object handler
;
2425 Lisp_Object encoded_file
;
2427 CHECK_STRING (filename
, 0);
2428 filename
= Fexpand_file_name (filename
, Qnil
);
2430 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2431 if (!NILP (handler
))
2432 return call2 (handler
, Qdelete_file
, filename
);
2434 encoded_file
= ENCODE_FILE (filename
);
2436 if (0 > unlink (XSTRING (encoded_file
)->data
))
2437 report_file_error ("Removing old name", Flist (1, &filename
));
2442 internal_delete_file_1 (ignore
)
2448 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2451 internal_delete_file (filename
)
2452 Lisp_Object filename
;
2454 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2455 Qt
, internal_delete_file_1
));
2458 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2459 "fRename file: \nFRename %s to file: \np",
2460 "Rename FILE as NEWNAME. Both args strings.\n\
2461 If file has names other than FILE, it continues to have those names.\n\
2462 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2463 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2464 A number as third arg means request confirmation if NEWNAME already exists.\n\
2465 This is what happens in interactive use with M-x.")
2466 (file
, newname
, ok_if_already_exists
)
2467 Lisp_Object file
, newname
, ok_if_already_exists
;
2470 Lisp_Object args
[2];
2472 Lisp_Object handler
;
2473 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2474 Lisp_Object encoded_file
, encoded_newname
;
2476 encoded_file
= encoded_newname
= Qnil
;
2477 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2478 CHECK_STRING (file
, 0);
2479 CHECK_STRING (newname
, 1);
2480 file
= Fexpand_file_name (file
, Qnil
);
2481 newname
= Fexpand_file_name (newname
, Qnil
);
2483 /* If the file name has special constructs in it,
2484 call the corresponding file handler. */
2485 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2487 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2488 if (!NILP (handler
))
2489 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2490 file
, newname
, ok_if_already_exists
));
2492 encoded_file
= ENCODE_FILE (file
);
2493 encoded_newname
= ENCODE_FILE (newname
);
2495 if (NILP (ok_if_already_exists
)
2496 || INTEGERP (ok_if_already_exists
))
2497 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2498 INTEGERP (ok_if_already_exists
), 0, 0);
2500 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2502 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2503 || 0 > unlink (XSTRING (encoded_file
)->data
))
2508 Fcopy_file (file
, newname
,
2509 /* We have already prompted if it was an integer,
2510 so don't have copy-file prompt again. */
2511 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2512 Fdelete_file (file
);
2519 report_file_error ("Renaming", Flist (2, args
));
2522 report_file_error ("Renaming", Flist (2, &file
));
2529 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2530 "fAdd name to file: \nFName to add to %s: \np",
2531 "Give FILE additional name NEWNAME. Both args strings.\n\
2532 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2533 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2534 A number as third arg means request confirmation if NEWNAME already exists.\n\
2535 This is what happens in interactive use with M-x.")
2536 (file
, newname
, ok_if_already_exists
)
2537 Lisp_Object file
, newname
, ok_if_already_exists
;
2540 Lisp_Object args
[2];
2542 Lisp_Object handler
;
2543 Lisp_Object encoded_file
, encoded_newname
;
2544 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2546 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2547 encoded_file
= encoded_newname
= Qnil
;
2548 CHECK_STRING (file
, 0);
2549 CHECK_STRING (newname
, 1);
2550 file
= Fexpand_file_name (file
, Qnil
);
2551 newname
= Fexpand_file_name (newname
, Qnil
);
2553 /* If the file name has special constructs in it,
2554 call the corresponding file handler. */
2555 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2556 if (!NILP (handler
))
2557 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2558 newname
, ok_if_already_exists
));
2560 /* If the new name has special constructs in it,
2561 call the corresponding file handler. */
2562 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2563 if (!NILP (handler
))
2564 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2565 newname
, ok_if_already_exists
));
2567 encoded_file
= ENCODE_FILE (file
);
2568 encoded_newname
= ENCODE_FILE (newname
);
2570 if (NILP (ok_if_already_exists
)
2571 || INTEGERP (ok_if_already_exists
))
2572 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2573 INTEGERP (ok_if_already_exists
), 0, 0);
2575 unlink (XSTRING (newname
)->data
);
2576 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2581 report_file_error ("Adding new name", Flist (2, args
));
2583 report_file_error ("Adding new name", Flist (2, &file
));
2592 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2593 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2594 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2595 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2596 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2597 A number as third arg means request confirmation if LINKNAME already exists.\n\
2598 This happens for interactive use with M-x.")
2599 (filename
, linkname
, ok_if_already_exists
)
2600 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2603 Lisp_Object args
[2];
2605 Lisp_Object handler
;
2606 Lisp_Object encoded_filename
, encoded_linkname
;
2607 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2609 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2610 encoded_filename
= encoded_linkname
= Qnil
;
2611 CHECK_STRING (filename
, 0);
2612 CHECK_STRING (linkname
, 1);
2613 /* If the link target has a ~, we must expand it to get
2614 a truly valid file name. Otherwise, do not expand;
2615 we want to permit links to relative file names. */
2616 if (XSTRING (filename
)->data
[0] == '~')
2617 filename
= Fexpand_file_name (filename
, Qnil
);
2618 linkname
= Fexpand_file_name (linkname
, Qnil
);
2620 /* If the file name has special constructs in it,
2621 call the corresponding file handler. */
2622 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2623 if (!NILP (handler
))
2624 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2625 linkname
, ok_if_already_exists
));
2627 /* If the new link name has special constructs in it,
2628 call the corresponding file handler. */
2629 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2630 if (!NILP (handler
))
2631 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2632 linkname
, ok_if_already_exists
));
2634 encoded_filename
= ENCODE_FILE (filename
);
2635 encoded_linkname
= ENCODE_FILE (linkname
);
2637 if (NILP (ok_if_already_exists
)
2638 || INTEGERP (ok_if_already_exists
))
2639 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2640 INTEGERP (ok_if_already_exists
), 0, 0);
2641 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2642 XSTRING (encoded_linkname
)->data
))
2644 /* If we didn't complain already, silently delete existing file. */
2645 if (errno
== EEXIST
)
2647 unlink (XSTRING (encoded_linkname
)->data
);
2648 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2649 XSTRING (encoded_linkname
)->data
))
2659 report_file_error ("Making symbolic link", Flist (2, args
));
2661 report_file_error ("Making symbolic link", Flist (2, &filename
));
2667 #endif /* S_IFLNK */
2671 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2672 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2673 "Define the job-wide logical name NAME to have the value STRING.\n\
2674 If STRING is nil or a null string, the logical name NAME is deleted.")
2679 CHECK_STRING (name
, 0);
2681 delete_logical_name (XSTRING (name
)->data
);
2684 CHECK_STRING (string
, 1);
2686 if (XSTRING (string
)->size
== 0)
2687 delete_logical_name (XSTRING (name
)->data
);
2689 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2698 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2699 "Open a network connection to PATH using LOGIN as the login string.")
2701 Lisp_Object path
, login
;
2705 CHECK_STRING (path
, 0);
2706 CHECK_STRING (login
, 0);
2708 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2710 if (netresult
== -1)
2715 #endif /* HPUX_NET */
2717 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2719 "Return t if file FILENAME specifies an absolute file name.\n\
2720 On Unix, this is a name starting with a `/' or a `~'.")
2722 Lisp_Object filename
;
2726 CHECK_STRING (filename
, 0);
2727 ptr
= XSTRING (filename
)->data
;
2728 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2730 /* ??? This criterion is probably wrong for '<'. */
2731 || index (ptr
, ':') || index (ptr
, '<')
2732 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2736 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2744 /* Return nonzero if file FILENAME exists and can be executed. */
2747 check_executable (filename
)
2751 int len
= strlen (filename
);
2754 if (stat (filename
, &st
) < 0)
2756 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2757 return ((st
.st_mode
& S_IEXEC
) != 0);
2759 return (S_ISREG (st
.st_mode
)
2761 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2762 || stricmp (suffix
, ".exe") == 0
2763 || stricmp (suffix
, ".bat") == 0)
2764 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2765 #endif /* not WINDOWSNT */
2766 #else /* not DOS_NT */
2767 #ifdef HAVE_EUIDACCESS
2768 return (euidaccess (filename
, 1) >= 0);
2770 /* Access isn't quite right because it uses the real uid
2771 and we really want to test with the effective uid.
2772 But Unix doesn't give us a right way to do it. */
2773 return (access (filename
, 1) >= 0);
2775 #endif /* not DOS_NT */
2778 /* Return nonzero if file FILENAME exists and can be written. */
2781 check_writable (filename
)
2786 if (stat (filename
, &st
) < 0)
2788 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2789 #else /* not MSDOS */
2790 #ifdef HAVE_EUIDACCESS
2791 return (euidaccess (filename
, 2) >= 0);
2793 /* Access isn't quite right because it uses the real uid
2794 and we really want to test with the effective uid.
2795 But Unix doesn't give us a right way to do it.
2796 Opening with O_WRONLY could work for an ordinary file,
2797 but would lose for directories. */
2798 return (access (filename
, 2) >= 0);
2800 #endif /* not MSDOS */
2803 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2804 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2805 See also `file-readable-p' and `file-attributes'.")
2807 Lisp_Object filename
;
2809 Lisp_Object absname
;
2810 Lisp_Object handler
;
2811 struct stat statbuf
;
2813 CHECK_STRING (filename
, 0);
2814 absname
= Fexpand_file_name (filename
, Qnil
);
2816 /* If the file name has special constructs in it,
2817 call the corresponding file handler. */
2818 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2819 if (!NILP (handler
))
2820 return call2 (handler
, Qfile_exists_p
, absname
);
2822 absname
= ENCODE_FILE (absname
);
2824 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2827 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2828 "Return t if FILENAME can be executed by you.\n\
2829 For a directory, this means you can access files in that directory.")
2831 Lisp_Object filename
;
2834 Lisp_Object absname
;
2835 Lisp_Object handler
;
2837 CHECK_STRING (filename
, 0);
2838 absname
= Fexpand_file_name (filename
, Qnil
);
2840 /* If the file name has special constructs in it,
2841 call the corresponding file handler. */
2842 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2843 if (!NILP (handler
))
2844 return call2 (handler
, Qfile_executable_p
, absname
);
2846 absname
= ENCODE_FILE (absname
);
2848 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2851 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2852 "Return t if file FILENAME exists and you can read it.\n\
2853 See also `file-exists-p' and `file-attributes'.")
2855 Lisp_Object filename
;
2857 Lisp_Object absname
;
2858 Lisp_Object handler
;
2861 struct stat statbuf
;
2863 CHECK_STRING (filename
, 0);
2864 absname
= Fexpand_file_name (filename
, Qnil
);
2866 /* If the file name has special constructs in it,
2867 call the corresponding file handler. */
2868 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2869 if (!NILP (handler
))
2870 return call2 (handler
, Qfile_readable_p
, absname
);
2872 absname
= ENCODE_FILE (absname
);
2875 /* Under MS-DOS and Windows, open does not work for directories. */
2876 if (access (XSTRING (absname
)->data
, 0) == 0)
2879 #else /* not DOS_NT */
2881 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2882 /* Opening a fifo without O_NONBLOCK can wait.
2883 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2884 except in the case of a fifo, on a system which handles it. */
2885 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2888 if (S_ISFIFO (statbuf
.st_mode
))
2889 flags
|= O_NONBLOCK
;
2891 desc
= open (XSTRING (absname
)->data
, flags
);
2896 #endif /* not DOS_NT */
2899 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2901 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2902 "Return t if file FILENAME can be written or created by you.")
2904 Lisp_Object filename
;
2906 Lisp_Object absname
, dir
, encoded
;
2907 Lisp_Object handler
;
2908 struct stat statbuf
;
2910 CHECK_STRING (filename
, 0);
2911 absname
= Fexpand_file_name (filename
, Qnil
);
2913 /* If the file name has special constructs in it,
2914 call the corresponding file handler. */
2915 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2916 if (!NILP (handler
))
2917 return call2 (handler
, Qfile_writable_p
, absname
);
2919 encoded
= ENCODE_FILE (absname
);
2920 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
2921 return (check_writable (XSTRING (encoded
)->data
)
2924 dir
= Ffile_name_directory (absname
);
2927 dir
= Fdirectory_file_name (dir
);
2931 dir
= Fdirectory_file_name (dir
);
2934 dir
= ENCODE_FILE (dir
);
2935 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2939 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2940 "Access file FILENAME, and get an error if that does not work.\n\
2941 The second argument STRING is used in the error message.\n\
2942 If there is no error, we return nil.")
2944 Lisp_Object filename
, string
;
2946 Lisp_Object handler
, encoded_filename
;
2949 CHECK_STRING (filename
, 0);
2951 /* If the file name has special constructs in it,
2952 call the corresponding file handler. */
2953 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2954 if (!NILP (handler
))
2955 return call3 (handler
, Qaccess_file
, filename
, string
);
2957 encoded_filename
= ENCODE_FILE (filename
);
2959 fd
= open (XSTRING (encoded_filename
)->data
, O_RDONLY
);
2961 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2967 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2968 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2969 The value is the name of the file to which it is linked.\n\
2970 Otherwise returns nil.")
2972 Lisp_Object filename
;
2979 Lisp_Object handler
;
2981 CHECK_STRING (filename
, 0);
2982 filename
= Fexpand_file_name (filename
, Qnil
);
2984 /* If the file name has special constructs in it,
2985 call the corresponding file handler. */
2986 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2987 if (!NILP (handler
))
2988 return call2 (handler
, Qfile_symlink_p
, filename
);
2990 filename
= ENCODE_FILE (filename
);
2995 buf
= (char *) xmalloc (bufsize
);
2996 bzero (buf
, bufsize
);
2997 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2998 if (valsize
< bufsize
) break;
2999 /* Buffer was not long enough */
3008 val
= make_string (buf
, valsize
);
3010 val
= DECODE_FILE (val
);
3012 #else /* not S_IFLNK */
3014 #endif /* not S_IFLNK */
3017 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3018 "Return t if FILENAME names an existing directory.")
3020 Lisp_Object filename
;
3022 register Lisp_Object absname
;
3024 Lisp_Object handler
;
3026 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3028 /* If the file name has special constructs in it,
3029 call the corresponding file handler. */
3030 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3031 if (!NILP (handler
))
3032 return call2 (handler
, Qfile_directory_p
, absname
);
3034 absname
= ENCODE_FILE (absname
);
3036 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3038 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3041 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3042 "Return t if file FILENAME is the name of a directory as a file,\n\
3043 and files in that directory can be opened by you. In order to use a\n\
3044 directory as a buffer's current directory, this predicate must return true.\n\
3045 A directory name spec may be given instead; then the value is t\n\
3046 if the directory so specified exists and really is a readable and\n\
3047 searchable directory.")
3049 Lisp_Object filename
;
3051 Lisp_Object handler
;
3053 struct gcpro gcpro1
;
3055 /* If the file name has special constructs in it,
3056 call the corresponding file handler. */
3057 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3058 if (!NILP (handler
))
3059 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3061 /* It's an unlikely combination, but yes we really do need to gcpro:
3062 Suppose that file-accessible-directory-p has no handler, but
3063 file-directory-p does have a handler; this handler causes a GC which
3064 relocates the string in `filename'; and finally file-directory-p
3065 returns non-nil. Then we would end up passing a garbaged string
3066 to file-executable-p. */
3068 tem
= (NILP (Ffile_directory_p (filename
))
3069 || NILP (Ffile_executable_p (filename
)));
3071 return tem
? Qnil
: Qt
;
3074 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3075 "Return t if file FILENAME is the name of a regular file.\n\
3076 This is the sort of file that holds an ordinary stream of data bytes.")
3078 Lisp_Object filename
;
3080 register Lisp_Object absname
;
3082 Lisp_Object handler
;
3084 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3086 /* If the file name has special constructs in it,
3087 call the corresponding file handler. */
3088 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3089 if (!NILP (handler
))
3090 return call2 (handler
, Qfile_regular_p
, absname
);
3092 absname
= ENCODE_FILE (absname
);
3094 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3096 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3099 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3100 "Return mode bits of file named FILENAME, as an integer.")
3102 Lisp_Object filename
;
3104 Lisp_Object absname
;
3106 Lisp_Object handler
;
3108 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3110 /* If the file name has special constructs in it,
3111 call the corresponding file handler. */
3112 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3113 if (!NILP (handler
))
3114 return call2 (handler
, Qfile_modes
, absname
);
3116 absname
= ENCODE_FILE (absname
);
3118 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3120 #if defined (MSDOS) && __DJGPP__ < 2
3121 if (check_executable (XSTRING (absname
)->data
))
3122 st
.st_mode
|= S_IEXEC
;
3123 #endif /* MSDOS && __DJGPP__ < 2 */
3125 return make_number (st
.st_mode
& 07777);
3128 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3129 "Set mode bits of file named FILENAME to MODE (an integer).\n\
3130 Only the 12 low bits of MODE are used.")
3132 Lisp_Object filename
, mode
;
3134 Lisp_Object absname
, encoded_absname
;
3135 Lisp_Object handler
;
3137 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3138 CHECK_NUMBER (mode
, 1);
3140 /* If the file name has special constructs in it,
3141 call the corresponding file handler. */
3142 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3143 if (!NILP (handler
))
3144 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3146 encoded_absname
= ENCODE_FILE (absname
);
3148 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
3149 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3154 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3155 "Set the file permission bits for newly created files.\n\
3156 The argument MODE should be an integer; only the low 9 bits are used.\n\
3157 This setting is inherited by subprocesses.")
3161 CHECK_NUMBER (mode
, 0);
3163 umask ((~ XINT (mode
)) & 0777);
3168 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3169 "Return the default file protection for created files.\n\
3170 The value is an integer.")
3176 realmask
= umask (0);
3179 XSETINT (value
, (~ realmask
) & 0777);
3185 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3186 "Tell Unix to finish all pending disk updates.")
3195 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3196 "Return t if file FILE1 is newer than file FILE2.\n\
3197 If FILE1 does not exist, the answer is nil;\n\
3198 otherwise, if FILE2 does not exist, the answer is t.")
3200 Lisp_Object file1
, file2
;
3202 Lisp_Object absname1
, absname2
;
3205 Lisp_Object handler
;
3206 struct gcpro gcpro1
, gcpro2
;
3208 CHECK_STRING (file1
, 0);
3209 CHECK_STRING (file2
, 0);
3212 GCPRO2 (absname1
, file2
);
3213 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3214 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3217 /* If the file name has special constructs in it,
3218 call the corresponding file handler. */
3219 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3221 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3222 if (!NILP (handler
))
3223 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3225 GCPRO2 (absname1
, absname2
);
3226 absname1
= ENCODE_FILE (absname1
);
3227 absname2
= ENCODE_FILE (absname2
);
3230 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3233 mtime1
= st
.st_mtime
;
3235 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3238 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3242 Lisp_Object Qfind_buffer_file_type
;
3245 #ifndef READ_BUF_SIZE
3246 #define READ_BUF_SIZE (64 << 10)
3249 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3251 "Insert contents of file FILENAME after point.\n\
3252 Returns list of absolute file name and number of bytes inserted.\n\
3253 If second argument VISIT is non-nil, the buffer's visited filename\n\
3254 and last save file modtime are set, and it is marked unmodified.\n\
3255 If visiting and the file does not exist, visiting is completed\n\
3256 before the error is signaled.\n\
3257 The optional third and fourth arguments BEG and END\n\
3258 specify what portion of the file to insert.\n\
3259 These arguments count bytes in the file, not characters in the buffer.\n\
3260 If VISIT is non-nil, BEG and END must be nil.\n\
3262 If optional fifth argument REPLACE is non-nil,\n\
3263 it means replace the current buffer contents (in the accessible portion)\n\
3264 with the file contents. This is better than simply deleting and inserting\n\
3265 the whole thing because (1) it preserves some marker positions\n\
3266 and (2) it puts less data in the undo list.\n\
3267 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3268 which is often less than the number of characters to be read.\n\
3270 This does code conversion according to the value of\n\
3271 `coding-system-for-read' or `file-coding-system-alist',\n\
3272 and sets the variable `last-coding-system-used' to the coding system\n\
3274 (filename
, visit
, beg
, end
, replace
)
3275 Lisp_Object filename
, visit
, beg
, end
, replace
;
3280 register int how_much
;
3281 register int unprocessed
;
3282 int count
= specpdl_ptr
- specpdl
;
3283 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3284 Lisp_Object handler
, val
, insval
, orig_filename
;
3287 int not_regular
= 0;
3288 unsigned char read_buf
[READ_BUF_SIZE
];
3289 struct coding_system coding
;
3290 unsigned char buffer
[1 << 14];
3291 int replace_handled
= 0;
3292 int set_coding_system
= 0;
3294 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3295 error ("Cannot do file visiting in an indirect buffer");
3297 if (!NILP (current_buffer
->read_only
))
3298 Fbarf_if_buffer_read_only ();
3302 orig_filename
= Qnil
;
3304 GCPRO4 (filename
, val
, p
, orig_filename
);
3306 CHECK_STRING (filename
, 0);
3307 filename
= Fexpand_file_name (filename
, Qnil
);
3309 /* If the file name has special constructs in it,
3310 call the corresponding file handler. */
3311 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3312 if (!NILP (handler
))
3314 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3315 visit
, beg
, end
, replace
);
3319 orig_filename
= filename
;
3320 filename
= ENCODE_FILE (filename
);
3325 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3327 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3328 || fstat (fd
, &st
) < 0)
3329 #endif /* not APOLLO */
3331 if (fd
>= 0) close (fd
);
3334 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3337 if (!NILP (Vcoding_system_for_read
))
3338 current_buffer
->buffer_file_coding_system
= Vcoding_system_for_read
;
3343 /* This code will need to be changed in order to work on named
3344 pipes, and it's probably just not worth it. So we should at
3345 least signal an error. */
3346 if (!S_ISREG (st
.st_mode
))
3353 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3354 Fsignal (Qfile_error
,
3355 Fcons (build_string ("not a regular file"),
3356 Fcons (orig_filename
, Qnil
)));
3361 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3364 /* Replacement should preserve point as it preserves markers. */
3365 if (!NILP (replace
))
3366 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3368 record_unwind_protect (close_file_unwind
, make_number (fd
));
3370 /* Supposedly happens on VMS. */
3371 if (! not_regular
&& st
.st_size
< 0)
3372 error ("File size is negative");
3374 if (!NILP (beg
) || !NILP (end
))
3376 error ("Attempt to visit less than an entire file");
3379 CHECK_NUMBER (beg
, 0);
3381 XSETFASTINT (beg
, 0);
3384 CHECK_NUMBER (end
, 0);
3389 XSETINT (end
, st
.st_size
);
3390 if (XINT (end
) != st
.st_size
)
3391 error ("Maximum buffer size exceeded");
3395 /* Decide the coding-system of the file. */
3400 if (!NILP (Vcoding_system_for_read
))
3401 val
= Vcoding_system_for_read
;
3402 else if (! NILP (replace
))
3403 /* In REPLACE mode, we can use the same coding system
3404 that was used to visit the file. */
3405 val
= current_buffer
->buffer_file_coding_system
;
3406 else if (! not_regular
)
3408 /* Don't try looking inside a file for a coding system specification
3409 if it is not seekable. */
3410 if (! NILP (Vset_auto_coding_function
))
3412 /* Find a coding system specified in the heading two lines
3413 or in the tailing several lines of the file. We assume
3414 that the 1K-byte and 3K-byte for heading and tailing
3415 respectively are sufficient fot this purpose. */
3417 int beginning_of_end
, end_of_beginning
;
3419 if (st
.st_size
<= (1024 * 4))
3421 nread
= read (fd
, read_buf
, 1024 * 4);
3422 end_of_beginning
= nread
;
3423 beginning_of_end
= 0;
3427 nread
= read (fd
, read_buf
, 1024);
3428 end_of_beginning
= nread
;
3429 beginning_of_end
= nread
;
3432 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3433 report_file_error ("Setting file position",
3434 Fcons (orig_filename
, Qnil
));
3435 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3440 error ("IO error reading %s: %s",
3441 XSTRING (orig_filename
)->data
, strerror (errno
));
3445 int possible_spec
= 0;
3446 unsigned char *p
, *p1
;
3448 unsigned char *copy
= (unsigned char *) alloca (nread
+ 1);
3450 /* Make a copy of the contents of read_buf in COPY,
3451 and convert it to lower case so we can compare
3452 more efficiently. */
3453 bcopy (read_buf
, copy
, nread
);
3454 for (i
= 0; i
< nread
; i
++)
3455 copy
[i
] = DOWNCASE (copy
[i
]);
3456 /* Ensure various comparisons fail at end of data. */
3459 /* Now test quickly whether the file contains a -*- line. */
3461 while (*p
!= '\n' && p
- copy
< end_of_beginning
)
3463 if (copy
[0] == '#' && copy
[1] == '!')
3464 while (*p
!= '\n' && p
- copy
< end_of_beginning
)
3469 if (p1
[0] == '-' && p1
[1] == '*' && p1
[2] == '-')
3473 if (! bcmp ("coding:", p1
, 7))
3485 /* Test quickly whether the file
3486 contains a local variables list. */
3487 p
= ©
[nread
- 1];
3488 p1
= ©
[beginning_of_end
];
3491 if (p
[0] == '\n' && p
[1] == '\f')
3496 while (p1
- p
>= 16)
3498 if (! bcmp ("local variables:", p
, 16))
3509 /* Always make this a unibyte string
3510 because we have not yet decoded it. */
3511 tem
= make_unibyte_string (read_buf
, nread
);
3512 val
= call1 (Vset_auto_coding_function
, tem
);
3515 /* Rewind the file for the actual read done later. */
3516 if (lseek (fd
, 0, 0) < 0)
3517 report_file_error ("Setting file position",
3518 Fcons (orig_filename
, Qnil
));
3523 Lisp_Object args
[6], coding_systems
;
3525 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3526 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3527 coding_systems
= Ffind_operation_coding_system (6, args
);
3528 if (CONSP (coding_systems
))
3529 val
= XCONS (coding_systems
)->car
;
3533 if (NILP (Vcoding_system_for_read
)
3534 && NILP (current_buffer
->enable_multibyte_characters
))
3536 /* We must suppress all text conversion except for end-of-line
3538 struct coding_system coding_temp
;
3540 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
3541 setup_coding_system (Qraw_text
, &coding
);
3542 coding
.eol_type
= coding_temp
.eol_type
;
3545 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3547 /* Ensure we always set Vlast_coding_system_used. */
3548 set_coding_system
= 1;
3551 /* If requested, replace the accessible part of the buffer
3552 with the file contents. Avoid replacing text at the
3553 beginning or end of the buffer that matches the file contents;
3554 that preserves markers pointing to the unchanged parts.
3556 Here we implement this feature in an optimized way
3557 for the case where code conversion is NOT needed.
3558 The following if-statement handles the case of conversion
3559 in a less optimal way.
3561 If the code conversion is "automatic" then we try using this
3562 method and hope for the best.
3563 But if we discover the need for conversion, we give up on this method
3564 and let the following if-statement handle the replace job. */
3566 && ! CODING_REQUIRE_DECODING (&coding
)
3567 && (coding
.eol_type
== CODING_EOL_UNDECIDED
3568 || coding
.eol_type
== CODING_EOL_LF
))
3570 /* same_at_start and same_at_end count bytes,
3571 because file access counts bytes
3572 and BEG and END count bytes. */
3573 int same_at_start
= BEGV_BYTE
;
3574 int same_at_end
= ZV_BYTE
;
3576 /* There is still a possibility we will find the need to do code
3577 conversion. If that happens, we set this variable to 1 to
3578 give up on handling REPLACE in the optimized way. */
3579 int giveup_match_end
= 0;
3581 if (XINT (beg
) != 0)
3583 if (lseek (fd
, XINT (beg
), 0) < 0)
3584 report_file_error ("Setting file position",
3585 Fcons (orig_filename
, Qnil
));
3590 /* Count how many chars at the start of the file
3591 match the text at the beginning of the buffer. */
3596 nread
= read (fd
, buffer
, sizeof buffer
);
3598 error ("IO error reading %s: %s",
3599 XSTRING (orig_filename
)->data
, strerror (errno
));
3600 else if (nread
== 0)
3603 if (coding
.type
== coding_type_undecided
)
3604 detect_coding (&coding
, buffer
, nread
);
3605 if (CODING_REQUIRE_DECODING (&coding
))
3606 /* We found that the file should be decoded somehow.
3607 Let's give up here. */
3609 giveup_match_end
= 1;
3613 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3614 detect_eol (&coding
, buffer
, nread
);
3615 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3616 && coding
.eol_type
!= CODING_EOL_LF
)
3617 /* We found that the format of eol should be decoded.
3618 Let's give up here. */
3620 giveup_match_end
= 1;
3625 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3626 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3627 same_at_start
++, bufpos
++;
3628 /* If we found a discrepancy, stop the scan.
3629 Otherwise loop around and scan the next bufferful. */
3630 if (bufpos
!= nread
)
3634 /* If the file matches the buffer completely,
3635 there's no need to replace anything. */
3636 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3640 /* Truncate the buffer to the size of the file. */
3641 del_range_1 (same_at_start
, same_at_end
, 0);
3646 /* Count how many chars at the end of the file
3647 match the text at the end of the buffer. But, if we have
3648 already found that decoding is necessary, don't waste time. */
3649 while (!giveup_match_end
)
3651 int total_read
, nread
, bufpos
, curpos
, trial
;
3653 /* At what file position are we now scanning? */
3654 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3655 /* If the entire file matches the buffer tail, stop the scan. */
3658 /* How much can we scan in the next step? */
3659 trial
= min (curpos
, sizeof buffer
);
3660 if (lseek (fd
, curpos
- trial
, 0) < 0)
3661 report_file_error ("Setting file position",
3662 Fcons (orig_filename
, Qnil
));
3665 while (total_read
< trial
)
3667 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3669 error ("IO error reading %s: %s",
3670 XSTRING (orig_filename
)->data
, strerror (errno
));
3671 total_read
+= nread
;
3673 /* Scan this bufferful from the end, comparing with
3674 the Emacs buffer. */
3675 bufpos
= total_read
;
3676 /* Compare with same_at_start to avoid counting some buffer text
3677 as matching both at the file's beginning and at the end. */
3678 while (bufpos
> 0 && same_at_end
> same_at_start
3679 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3680 same_at_end
--, bufpos
--;
3682 /* If we found a discrepancy, stop the scan.
3683 Otherwise loop around and scan the preceding bufferful. */
3686 /* If this discrepancy is because of code conversion,
3687 we cannot use this method; giveup and try the other. */
3688 if (same_at_end
> same_at_start
3689 && FETCH_BYTE (same_at_end
- 1) >= 0200
3690 && ! NILP (current_buffer
->enable_multibyte_characters
)
3691 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3692 giveup_match_end
= 1;
3698 if (! giveup_match_end
)
3702 /* We win! We can handle REPLACE the optimized way. */
3704 /* Extends the end of non-matching text area to multibyte
3705 character boundary. */
3706 if (! NILP (current_buffer
->enable_multibyte_characters
))
3707 while (same_at_end
< ZV_BYTE
3708 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3711 /* Don't try to reuse the same piece of text twice. */
3712 overlap
= (same_at_start
- BEGV_BYTE
3713 - (same_at_end
+ st
.st_size
- ZV
));
3715 same_at_end
+= overlap
;
3717 /* Arrange to read only the nonmatching middle part of the file. */
3718 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3719 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3721 del_range_byte (same_at_start
, same_at_end
, 0);
3722 /* Insert from the file at the proper position. */
3723 temp
= BYTE_TO_CHAR (same_at_start
);
3724 SET_PT_BOTH (temp
, same_at_start
);
3726 /* If display currently starts at beginning of line,
3727 keep it that way. */
3728 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3729 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3731 replace_handled
= 1;
3735 /* If requested, replace the accessible part of the buffer
3736 with the file contents. Avoid replacing text at the
3737 beginning or end of the buffer that matches the file contents;
3738 that preserves markers pointing to the unchanged parts.
3740 Here we implement this feature for the case where code conversion
3741 is needed, in a simple way that needs a lot of memory.
3742 The preceding if-statement handles the case of no conversion
3743 in a more optimized way. */
3744 if (!NILP (replace
) && ! replace_handled
)
3746 int same_at_start
= BEGV_BYTE
;
3747 int same_at_end
= ZV_BYTE
;
3750 /* Make sure that the gap is large enough. */
3751 int bufsize
= 2 * st
.st_size
;
3752 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3755 /* First read the whole file, performing code conversion into
3756 CONVERSION_BUFFER. */
3758 if (lseek (fd
, XINT (beg
), 0) < 0)
3760 free (conversion_buffer
);
3761 report_file_error ("Setting file position",
3762 Fcons (orig_filename
, Qnil
));
3765 total
= st
.st_size
; /* Total bytes in the file. */
3766 how_much
= 0; /* Bytes read from file so far. */
3767 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3768 unprocessed
= 0; /* Bytes not processed in previous loop. */
3770 while (how_much
< total
)
3772 /* try is reserved in some compilers (Microsoft C) */
3773 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3774 unsigned char *destination
= read_buf
+ unprocessed
;
3777 /* Allow quitting out of the actual I/O. */
3780 this = read (fd
, destination
, trytry
);
3783 if (this < 0 || this + unprocessed
== 0)
3791 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3793 int require
, result
;
3795 this += unprocessed
;
3797 /* If we are using more space than estimated,
3798 make CONVERSION_BUFFER bigger. */
3799 require
= decoding_buffer_size (&coding
, this);
3800 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3802 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3803 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3806 /* Convert this batch with results in CONVERSION_BUFFER. */
3807 if (how_much
>= total
) /* This is the last block. */
3808 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3809 result
= decode_coding (&coding
, read_buf
,
3810 conversion_buffer
+ inserted
,
3811 this, bufsize
- inserted
);
3813 /* Save for next iteration whatever we didn't convert. */
3814 unprocessed
= this - coding
.consumed
;
3815 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
3816 this = coding
.produced
;
3822 /* At this point, INSERTED is how many characters (i.e. bytes)
3823 are present in CONVERSION_BUFFER.
3824 HOW_MUCH should equal TOTAL,
3825 or should be <= 0 if we couldn't read the file. */
3829 free (conversion_buffer
);
3832 error ("IO error reading %s: %s",
3833 XSTRING (orig_filename
)->data
, strerror (errno
));
3834 else if (how_much
== -2)
3835 error ("maximum buffer size exceeded");
3838 /* Compare the beginning of the converted file
3839 with the buffer text. */
3842 while (bufpos
< inserted
&& same_at_start
< same_at_end
3843 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3844 same_at_start
++, bufpos
++;
3846 /* If the file matches the buffer completely,
3847 there's no need to replace anything. */
3849 if (bufpos
== inserted
)
3851 free (conversion_buffer
);
3854 /* Truncate the buffer to the size of the file. */
3855 del_range_1 (same_at_start
, same_at_end
, 0);
3859 /* Scan this bufferful from the end, comparing with
3860 the Emacs buffer. */
3863 /* Compare with same_at_start to avoid counting some buffer text
3864 as matching both at the file's beginning and at the end. */
3865 while (bufpos
> 0 && same_at_end
> same_at_start
3866 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3867 same_at_end
--, bufpos
--;
3869 /* Don't try to reuse the same piece of text twice. */
3870 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3872 same_at_end
+= overlap
;
3874 /* If display currently starts at beginning of line,
3875 keep it that way. */
3876 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3877 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3879 /* Replace the chars that we need to replace,
3880 and update INSERTED to equal the number of bytes
3881 we are taking from the file. */
3882 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
3883 del_range_byte (same_at_start
, same_at_end
, 0);
3884 if (same_at_end
!= same_at_start
)
3885 SET_PT_BOTH (GPT
, GPT_BYTE
);
3888 /* Insert from the file at the proper position. */
3889 temp
= BYTE_TO_CHAR (same_at_start
);
3890 SET_PT_BOTH (temp
, same_at_start
);
3893 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
3896 free (conversion_buffer
);
3905 register Lisp_Object temp
;
3907 total
= XINT (end
) - XINT (beg
);
3909 /* Make sure point-max won't overflow after this insertion. */
3910 XSETINT (temp
, total
);
3911 if (total
!= XINT (temp
))
3912 error ("Maximum buffer size exceeded");
3915 /* For a special file, all we can do is guess. */
3916 total
= READ_BUF_SIZE
;
3918 if (NILP (visit
) && total
> 0)
3919 prepare_to_modify_buffer (PT
, PT
, NULL
);
3922 if (GAP_SIZE
< total
)
3923 make_gap (total
- GAP_SIZE
);
3925 if (XINT (beg
) != 0 || !NILP (replace
))
3927 if (lseek (fd
, XINT (beg
), 0) < 0)
3928 report_file_error ("Setting file position",
3929 Fcons (orig_filename
, Qnil
));
3932 /* In the following loop, HOW_MUCH contains the total bytes read so
3933 far for a regular file, and not changed for a special file. But,
3934 before exiting the loop, it is set to a negative value if I/O
3937 /* Total bytes inserted. */
3939 /* Here, we don't do code conversion in the loop. It is done by
3940 code_convert_region after all data are read into the buffer. */
3941 while (how_much
< total
)
3943 /* try is reserved in some compilers (Microsoft C) */
3944 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3947 /* For a special file, GAP_SIZE should be checked every time. */
3948 if (not_regular
&& GAP_SIZE
< trytry
)
3949 make_gap (total
- GAP_SIZE
);
3951 /* Allow quitting out of the actual I/O. */
3954 this = read (fd
, BYTE_POS_ADDR (PT_BYTE
+ inserted
- 1) + 1, trytry
);
3971 /* For a regular file, where TOTAL is the real size,
3972 count HOW_MUCH to compare with it.
3973 For a special file, where TOTAL is just a buffer size,
3974 so don't bother counting in HOW_MUCH.
3975 (INSERTED is where we count the number of characters inserted.) */
3982 /* Put an anchor to ensure multi-byte form ends at gap. */
3987 /* Discard the unwind protect for closing the file. */
3991 error ("IO error reading %s: %s",
3992 XSTRING (orig_filename
)->data
, strerror (errno
));
3996 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3998 /* Here, we don't have to consider byte combining (see the
3999 comment below) because code_convert_region takes care of
4001 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4003 inserted
= (NILP (current_buffer
->enable_multibyte_characters
)
4004 ? coding
.produced
: coding
.produced_char
);
4006 else if (!NILP (current_buffer
->enable_multibyte_characters
))
4008 int inserted_byte
= inserted
;
4010 /* There's a possibility that we must combine bytes at the
4011 head (resp. the tail) of the just inserted text with the
4012 bytes before (resp. after) the gap to form a single
4014 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
4015 adjust_after_insert (PT
, PT_BYTE
,
4016 PT
+ inserted_byte
, PT_BYTE
+ inserted_byte
,
4020 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4024 /* Use the conversion type to determine buffer-file-type
4025 (find-buffer-file-type is now used to help determine the
4027 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4028 || coding
.eol_type
== CODING_EOL_LF
)
4029 && ! CODING_REQUIRE_DECODING (&coding
))
4030 current_buffer
->buffer_file_type
= Qt
;
4032 current_buffer
->buffer_file_type
= Qnil
;
4041 if (!EQ (current_buffer
->undo_list
, Qt
))
4042 current_buffer
->undo_list
= Qnil
;
4044 stat (XSTRING (filename
)->data
, &st
);
4049 current_buffer
->modtime
= st
.st_mtime
;
4050 current_buffer
->filename
= orig_filename
;
4053 SAVE_MODIFF
= MODIFF
;
4054 current_buffer
->auto_save_modified
= MODIFF
;
4055 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4056 #ifdef CLASH_DETECTION
4059 if (!NILP (current_buffer
->file_truename
))
4060 unlock_file (current_buffer
->file_truename
);
4061 unlock_file (filename
);
4063 #endif /* CLASH_DETECTION */
4065 Fsignal (Qfile_error
,
4066 Fcons (build_string ("not a regular file"),
4067 Fcons (orig_filename
, Qnil
)));
4069 /* If visiting nonexistent file, return nil. */
4070 if (current_buffer
->modtime
== -1)
4071 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4074 /* Decode file format */
4077 insval
= call3 (Qformat_decode
,
4078 Qnil
, make_number (inserted
), visit
);
4079 CHECK_NUMBER (insval
, 0);
4080 inserted
= XFASTINT (insval
);
4083 /* Call after-change hooks for the inserted text, aside from the case
4084 of normal visiting (not with REPLACE), which is done in a new buffer
4085 "before" the buffer is changed. */
4086 if (inserted
> 0 && total
> 0
4087 && (NILP (visit
) || !NILP (replace
)))
4088 signal_after_change (PT
, 0, inserted
);
4090 if (set_coding_system
)
4091 Vlast_coding_system_used
= coding
.symbol
;
4095 p
= Vafter_insert_file_functions
;
4098 insval
= call1 (Fcar (p
), make_number (inserted
));
4101 CHECK_NUMBER (insval
, 0);
4102 inserted
= XFASTINT (insval
);
4109 /* ??? Retval needs to be dealt with in all cases consistently. */
4111 val
= Fcons (orig_filename
,
4112 Fcons (make_number (inserted
),
4115 RETURN_UNGCPRO (unbind_to (count
, val
));
4118 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
4121 /* If build_annotations switched buffers, switch back to BUF.
4122 Kill the temporary buffer that was selected in the meantime.
4124 Since this kill only the last temporary buffer, some buffers remain
4125 not killed if build_annotations switched buffers more than once.
4129 build_annotations_unwind (buf
)
4134 if (XBUFFER (buf
) == current_buffer
)
4136 tembuf
= Fcurrent_buffer ();
4138 Fkill_buffer (tembuf
);
4142 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4143 "r\nFWrite region to file: \ni\ni\ni\np",
4144 "Write current region into specified file.\n\
4145 When called from a program, takes three arguments:\n\
4146 START, END and FILENAME. START and END are buffer positions.\n\
4147 Optional fourth argument APPEND if non-nil means\n\
4148 append to existing file contents (if any).\n\
4149 Optional fifth argument VISIT if t means\n\
4150 set the last-save-file-modtime of buffer to this file's modtime\n\
4151 and mark buffer not modified.\n\
4152 If VISIT is a string, it is a second file name;\n\
4153 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
4154 VISIT is also the file name to lock and unlock for clash detection.\n\
4155 If VISIT is neither t nor nil nor a string,\n\
4156 that means do not print the \"Wrote file\" message.\n\
4157 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
4158 use for locking and unlocking, overriding FILENAME and VISIT.\n\
4159 The optional seventh arg CONFIRM, if non-nil, says ask for confirmation\n\
4160 before overwriting an existing file.\n\
4161 Kludgy feature: if START is a string, then that string is written\n\
4162 to the file, instead of any buffer contents, and END is ignored.\n\
4164 This does code conversion according to the value of\n\
4165 `coding-system-for-write', `buffer-file-coding-system', or\n\
4166 `file-coding-system-alist', and sets the variable\n\
4167 `last-coding-system-used' to the coding system actually used.")
4169 (start
, end
, filename
, append
, visit
, lockname
, confirm
)
4170 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, confirm
;
4178 int count
= specpdl_ptr
- specpdl
;
4181 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4183 Lisp_Object handler
;
4184 Lisp_Object visit_file
;
4185 Lisp_Object annotations
;
4186 Lisp_Object encoded_filename
;
4187 int visiting
, quietly
;
4188 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4189 struct buffer
*given_buffer
;
4191 int buffer_file_type
= O_BINARY
;
4193 struct coding_system coding
;
4195 if (current_buffer
->base_buffer
&& ! NILP (visit
))
4196 error ("Cannot do file visiting in an indirect buffer");
4198 if (!NILP (start
) && !STRINGP (start
))
4199 validate_region (&start
, &end
);
4201 GCPRO4 (start
, filename
, visit
, lockname
);
4203 /* Decide the coding-system to encode the data with. */
4209 else if (!NILP (Vcoding_system_for_write
))
4210 val
= Vcoding_system_for_write
;
4211 else if (NILP (current_buffer
->enable_multibyte_characters
))
4213 /* If the variable `buffer-file-coding-system' is set locally,
4214 it means that the file was read with some kind of code
4215 conversion or the varialbe is explicitely set by users. We
4216 had better write it out with the same coding system even if
4217 `enable-multibyte-characters' is nil.
4219 If it is not set locally, we anyway have to convert EOL
4220 format if the default value of `buffer-file-coding-system'
4221 tells that it is not Unix-like (LF only) format. */
4222 val
= current_buffer
->buffer_file_coding_system
;
4223 if (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4225 struct coding_system coding_temp
;
4227 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
4228 if (coding_temp
.eol_type
== CODING_EOL_CRLF
4229 || coding_temp
.eol_type
== CODING_EOL_CR
)
4231 setup_coding_system (Qraw_text
, &coding
);
4232 coding
.eol_type
= coding_temp
.eol_type
;
4233 goto done_setup_coding
;
4240 Lisp_Object args
[7], coding_systems
;
4242 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4243 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4245 coding_systems
= Ffind_operation_coding_system (7, args
);
4246 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
4247 ? XCONS (coding_systems
)->cdr
4248 : current_buffer
->buffer_file_coding_system
);
4249 /* Confirm that VAL can surely encode the current region. */
4250 if (!NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4251 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4253 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4256 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4257 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4260 Vlast_coding_system_used
= coding
.symbol
;
4262 filename
= Fexpand_file_name (filename
, Qnil
);
4264 if (! NILP (confirm
))
4265 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4267 if (STRINGP (visit
))
4268 visit_file
= Fexpand_file_name (visit
, Qnil
);
4270 visit_file
= filename
;
4273 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4274 quietly
= !NILP (visit
);
4278 if (NILP (lockname
))
4279 lockname
= visit_file
;
4281 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4283 /* If the file name has special constructs in it,
4284 call the corresponding file handler. */
4285 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4286 /* If FILENAME has no handler, see if VISIT has one. */
4287 if (NILP (handler
) && STRINGP (visit
))
4288 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4290 if (!NILP (handler
))
4293 val
= call6 (handler
, Qwrite_region
, start
, end
,
4294 filename
, append
, visit
);
4298 SAVE_MODIFF
= MODIFF
;
4299 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4300 current_buffer
->filename
= visit_file
;
4306 /* Special kludge to simplify auto-saving. */
4309 XSETFASTINT (start
, BEG
);
4310 XSETFASTINT (end
, Z
);
4313 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4314 count1
= specpdl_ptr
- specpdl
;
4316 given_buffer
= current_buffer
;
4317 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4318 if (current_buffer
!= given_buffer
)
4320 XSETFASTINT (start
, BEGV
);
4321 XSETFASTINT (end
, ZV
);
4324 #ifdef CLASH_DETECTION
4327 #if 0 /* This causes trouble for GNUS. */
4328 /* If we've locked this file for some other buffer,
4329 query before proceeding. */
4330 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4331 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4334 lock_file (lockname
);
4336 #endif /* CLASH_DETECTION */
4338 encoded_filename
= ENCODE_FILE (filename
);
4340 fn
= XSTRING (encoded_filename
)->data
;
4344 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4345 #else /* not DOS_NT */
4346 desc
= open (fn
, O_WRONLY
);
4347 #endif /* not DOS_NT */
4349 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4351 if (auto_saving
) /* Overwrite any previous version of autosave file */
4353 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4354 desc
= open (fn
, O_RDWR
);
4356 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4357 ? XSTRING (current_buffer
->filename
)->data
: 0,
4360 else /* Write to temporary name and rename if no errors */
4362 Lisp_Object temp_name
;
4363 temp_name
= Ffile_name_directory (filename
);
4365 if (!NILP (temp_name
))
4367 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4368 build_string ("$$SAVE$$")));
4369 fname
= XSTRING (filename
)->data
;
4370 fn
= XSTRING (temp_name
)->data
;
4371 desc
= creat_copy_attrs (fname
, fn
);
4374 /* If we can't open the temporary file, try creating a new
4375 version of the original file. VMS "creat" creates a
4376 new version rather than truncating an existing file. */
4379 desc
= creat (fn
, 0666);
4380 #if 0 /* This can clobber an existing file and fail to replace it,
4381 if the user runs out of space. */
4384 /* We can't make a new version;
4385 try to truncate and rewrite existing version if any. */
4387 desc
= open (fn
, O_RDWR
);
4393 desc
= creat (fn
, 0666);
4398 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4399 S_IREAD
| S_IWRITE
);
4400 #else /* not DOS_NT */
4401 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4402 #endif /* not DOS_NT */
4403 #endif /* not VMS */
4409 #ifdef CLASH_DETECTION
4411 if (!auto_saving
) unlock_file (lockname
);
4413 #endif /* CLASH_DETECTION */
4414 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4417 record_unwind_protect (close_file_unwind
, make_number (desc
));
4420 if (lseek (desc
, 0, 2) < 0)
4422 #ifdef CLASH_DETECTION
4423 if (!auto_saving
) unlock_file (lockname
);
4424 #endif /* CLASH_DETECTION */
4425 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4430 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4431 * if we do writes that don't end with a carriage return. Furthermore
4432 * it cannot handle writes of more then 16K. The modified
4433 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4434 * this EXCEPT for the last record (iff it doesn't end with a carriage
4435 * return). This implies that if your buffer doesn't end with a carriage
4436 * return, you get one free... tough. However it also means that if
4437 * we make two calls to sys_write (a la the following code) you can
4438 * get one at the gap as well. The easiest way to fix this (honest)
4439 * is to move the gap to the next newline (or the end of the buffer).
4444 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4445 move_gap (find_next_newline (GPT
, 1));
4447 /* Whether VMS or not, we must move the gap to the next of newline
4448 when we must put designation sequences at beginning of line. */
4449 if (INTEGERP (start
)
4450 && coding
.type
== coding_type_iso2022
4451 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4452 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4454 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4455 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4456 move_gap_both (PT
, PT_BYTE
);
4457 SET_PT_BOTH (opoint
, opoint_byte
);
4464 if (STRINGP (start
))
4466 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4467 STRING_BYTES (XSTRING (start
)), 0, &annotations
,
4471 else if (XINT (start
) != XINT (end
))
4473 register int end1
= CHAR_TO_BYTE (XINT (end
));
4475 tem
= CHAR_TO_BYTE (XINT (start
));
4477 if (XINT (start
) < GPT
)
4479 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
),
4480 min (GPT_BYTE
, end1
) - tem
, tem
, &annotations
,
4485 if (XINT (end
) > GPT
&& !failure
)
4487 tem
= max (tem
, GPT_BYTE
);
4488 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
), end1
- tem
,
4489 tem
, &annotations
, &coding
);
4495 /* If file was empty, still need to write the annotations */
4496 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4497 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4501 if (CODING_REQUIRE_FLUSHING (&coding
)
4502 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4505 /* We have to flush out a data. */
4506 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4507 failure
= 0 > e_write (desc
, "", 0, &coding
);
4514 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4515 Disk full in NFS may be reported here. */
4516 /* mib says that closing the file will try to write as fast as NFS can do
4517 it, and that means the fsync here is not crucial for autosave files. */
4518 if (!auto_saving
&& fsync (desc
) < 0)
4520 /* If fsync fails with EINTR, don't treat that as serious. */
4522 failure
= 1, save_errno
= errno
;
4526 /* Spurious "file has changed on disk" warnings have been
4527 observed on Suns as well.
4528 It seems that `close' can change the modtime, under nfs.
4530 (This has supposedly been fixed in Sunos 4,
4531 but who knows about all the other machines with NFS?) */
4534 /* On VMS and APOLLO, must do the stat after the close
4535 since closing changes the modtime. */
4538 /* Recall that #if defined does not work on VMS. */
4545 /* NFS can report a write failure now. */
4546 if (close (desc
) < 0)
4547 failure
= 1, save_errno
= errno
;
4550 /* If we wrote to a temporary name and had no errors, rename to real name. */
4554 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4562 /* Discard the unwind protect for close_file_unwind. */
4563 specpdl_ptr
= specpdl
+ count1
;
4564 /* Restore the original current buffer. */
4565 visit_file
= unbind_to (count
, visit_file
);
4567 #ifdef CLASH_DETECTION
4569 unlock_file (lockname
);
4570 #endif /* CLASH_DETECTION */
4572 /* Do this before reporting IO error
4573 to avoid a "file has changed on disk" warning on
4574 next attempt to save. */
4576 current_buffer
->modtime
= st
.st_mtime
;
4579 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4580 strerror (save_errno
));
4584 SAVE_MODIFF
= MODIFF
;
4585 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4586 current_buffer
->filename
= visit_file
;
4587 update_mode_lines
++;
4593 message_with_string ("Wrote %s", visit_file
, 1);
4598 Lisp_Object
merge ();
4600 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4601 "Return t if (car A) is numerically less than (car B).")
4605 return Flss (Fcar (a
), Fcar (b
));
4608 /* Build the complete list of annotations appropriate for writing out
4609 the text between START and END, by calling all the functions in
4610 write-region-annotate-functions and merging the lists they return.
4611 If one of these functions switches to a different buffer, we assume
4612 that buffer contains altered text. Therefore, the caller must
4613 make sure to restore the current buffer in all cases,
4614 as save-excursion would do. */
4617 build_annotations (start
, end
, pre_write_conversion
)
4618 Lisp_Object start
, end
, pre_write_conversion
;
4620 Lisp_Object annotations
;
4622 struct gcpro gcpro1
, gcpro2
;
4623 Lisp_Object original_buffer
;
4625 XSETBUFFER (original_buffer
, current_buffer
);
4628 p
= Vwrite_region_annotate_functions
;
4629 GCPRO2 (annotations
, p
);
4632 struct buffer
*given_buffer
= current_buffer
;
4633 Vwrite_region_annotations_so_far
= annotations
;
4634 res
= call2 (Fcar (p
), start
, end
);
4635 /* If the function makes a different buffer current,
4636 assume that means this buffer contains altered text to be output.
4637 Reset START and END from the buffer bounds
4638 and discard all previous annotations because they should have
4639 been dealt with by this function. */
4640 if (current_buffer
!= given_buffer
)
4642 XSETFASTINT (start
, BEGV
);
4643 XSETFASTINT (end
, ZV
);
4646 Flength (res
); /* Check basic validity of return value */
4647 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4651 /* Now do the same for annotation functions implied by the file-format */
4652 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4653 p
= Vauto_save_file_format
;
4655 p
= current_buffer
->file_format
;
4658 struct buffer
*given_buffer
= current_buffer
;
4659 Vwrite_region_annotations_so_far
= annotations
;
4660 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4662 if (current_buffer
!= given_buffer
)
4664 XSETFASTINT (start
, BEGV
);
4665 XSETFASTINT (end
, ZV
);
4669 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4673 /* At last, do the same for the function PRE_WRITE_CONVERSION
4674 implied by the current coding-system. */
4675 if (!NILP (pre_write_conversion
))
4677 struct buffer
*given_buffer
= current_buffer
;
4678 Vwrite_region_annotations_so_far
= annotations
;
4679 res
= call2 (pre_write_conversion
, start
, end
);
4681 annotations
= (current_buffer
!= given_buffer
4683 : merge (annotations
, res
, Qcar_less_than_car
));
4690 /* Write to descriptor DESC the NBYTES bytes starting at ADDR,
4691 assuming they start at byte position BYTEPOS in the buffer.
4692 Intersperse with them the annotations from *ANNOT
4693 which fall within the range of byte positions BYTEPOS to BYTEPOS + NBYTES,
4694 each at its appropriate position.
4696 We modify *ANNOT by discarding elements as we use them up.
4698 The return value is negative in case of system call failure. */
4701 a_write (desc
, addr
, nbytes
, bytepos
, annot
, coding
)
4703 register char *addr
;
4704 register int nbytes
;
4707 struct coding_system
*coding
;
4711 int lastpos
= bytepos
+ nbytes
;
4713 while (NILP (*annot
) || CONSP (*annot
))
4715 tem
= Fcar_safe (Fcar (*annot
));
4716 nextpos
= bytepos
- 1;
4718 nextpos
= CHAR_TO_BYTE (XFASTINT (tem
));
4720 /* If there are no more annotations in this range,
4721 output the rest of the range all at once. */
4722 if (! (nextpos
>= bytepos
&& nextpos
<= lastpos
))
4723 return e_write (desc
, addr
, lastpos
- bytepos
, coding
);
4725 /* Output buffer text up to the next annotation's position. */
4726 if (nextpos
> bytepos
)
4728 if (0 > e_write (desc
, addr
, nextpos
- bytepos
, coding
))
4730 addr
+= nextpos
- bytepos
;
4733 /* Output the annotation. */
4734 tem
= Fcdr (Fcar (*annot
));
4737 if (0 > e_write (desc
, XSTRING (tem
)->data
, STRING_BYTES (XSTRING (tem
)),
4741 *annot
= Fcdr (*annot
);
4746 #ifndef WRITE_BUF_SIZE
4747 #define WRITE_BUF_SIZE (16 * 1024)
4750 /* Write NBYTES bytes starting at ADDR into descriptor DESC,
4751 encoding them with coding system CODING. */
4754 e_write (desc
, addr
, nbytes
, coding
)
4756 register char *addr
;
4757 register int nbytes
;
4758 struct coding_system
*coding
;
4760 char buf
[WRITE_BUF_SIZE
];
4762 /* We used to have a code for handling selective display here. But,
4763 now it is handled within encode_coding. */
4766 encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
4767 nbytes
-= coding
->consumed
, addr
+= coding
->consumed
;
4768 if (coding
->produced
> 0)
4770 coding
->produced
-= write (desc
, buf
, coding
->produced
);
4771 if (coding
->produced
) return -1;
4779 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4780 Sverify_visited_file_modtime
, 1, 1, 0,
4781 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4782 This means that the file has not been changed since it was visited or saved.")
4788 Lisp_Object handler
;
4789 Lisp_Object filename
;
4791 CHECK_BUFFER (buf
, 0);
4794 if (!STRINGP (b
->filename
)) return Qt
;
4795 if (b
->modtime
== 0) return Qt
;
4797 /* If the file name has special constructs in it,
4798 call the corresponding file handler. */
4799 handler
= Ffind_file_name_handler (b
->filename
,
4800 Qverify_visited_file_modtime
);
4801 if (!NILP (handler
))
4802 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4804 filename
= ENCODE_FILE (b
->filename
);
4806 if (stat (XSTRING (filename
)->data
, &st
) < 0)
4808 /* If the file doesn't exist now and didn't exist before,
4809 we say that it isn't modified, provided the error is a tame one. */
4810 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4815 if (st
.st_mtime
== b
->modtime
4816 /* If both are positive, accept them if they are off by one second. */
4817 || (st
.st_mtime
> 0 && b
->modtime
> 0
4818 && (st
.st_mtime
== b
->modtime
+ 1
4819 || st
.st_mtime
== b
->modtime
- 1)))
4824 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4825 Sclear_visited_file_modtime
, 0, 0, 0,
4826 "Clear out records of last mod time of visited file.\n\
4827 Next attempt to save will certainly not complain of a discrepancy.")
4830 current_buffer
->modtime
= 0;
4834 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4835 Svisited_file_modtime
, 0, 0, 0,
4836 "Return the current buffer's recorded visited file modification time.\n\
4837 The value is a list of the form (HIGH . LOW), like the time values\n\
4838 that `file-attributes' returns.")
4841 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4844 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4845 Sset_visited_file_modtime
, 0, 1, 0,
4846 "Update buffer's recorded modification time from the visited file's time.\n\
4847 Useful if the buffer was not read from the file normally\n\
4848 or if the file itself has been changed for some known benign reason.\n\
4849 An argument specifies the modification time value to use\n\
4850 \(instead of that of the visited file), in the form of a list\n\
4851 \(HIGH . LOW) or (HIGH LOW).")
4853 Lisp_Object time_list
;
4855 if (!NILP (time_list
))
4856 current_buffer
->modtime
= cons_to_long (time_list
);
4859 register Lisp_Object filename
;
4861 Lisp_Object handler
;
4863 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4865 /* If the file name has special constructs in it,
4866 call the corresponding file handler. */
4867 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4868 if (!NILP (handler
))
4869 /* The handler can find the file name the same way we did. */
4870 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4872 filename
= ENCODE_FILE (filename
);
4874 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4875 current_buffer
->modtime
= st
.st_mtime
;
4885 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 1);
4886 Fsleep_for (make_number (1), Qnil
);
4887 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4888 Fsleep_for (make_number (1), Qnil
);
4889 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4890 Fsleep_for (make_number (1), Qnil
);
4900 /* Get visited file's mode to become the auto save file's mode. */
4901 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4902 /* But make sure we can overwrite it later! */
4903 auto_save_mode_bits
= st
.st_mode
| 0600;
4905 auto_save_mode_bits
= 0666;
4908 Fwrite_region (Qnil
, Qnil
,
4909 current_buffer
->auto_save_file_name
,
4910 Qnil
, Qlambda
, Qnil
, Qnil
);
4914 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4919 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4920 | XFASTINT (XCONS (stream
)->cdr
)));
4925 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4928 minibuffer_auto_raise
= XINT (value
);
4932 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4933 "Auto-save all buffers that need it.\n\
4934 This is all buffers that have auto-saving enabled\n\
4935 and are changed since last auto-saved.\n\
4936 Auto-saving writes the buffer into a file\n\
4937 so that your editing is not lost if the system crashes.\n\
4938 This file is not the file you visited; that changes only when you save.\n\
4939 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4940 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4941 A non-nil CURRENT-ONLY argument means save only current buffer.")
4942 (no_message
, current_only
)
4943 Lisp_Object no_message
, current_only
;
4945 struct buffer
*old
= current_buffer
, *b
;
4946 Lisp_Object tail
, buf
;
4948 char *omessage
= echo_area_glyphs
;
4949 int omessage_length
= echo_area_glyphs_length
;
4950 int oldmultibyte
= message_enable_multibyte
;
4951 int do_handled_files
;
4954 Lisp_Object lispstream
;
4955 int count
= specpdl_ptr
- specpdl
;
4957 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4959 /* Ordinarily don't quit within this function,
4960 but don't make it impossible to quit (in case we get hung in I/O). */
4964 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4965 point to non-strings reached from Vbuffer_alist. */
4970 if (!NILP (Vrun_hooks
))
4971 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4973 if (STRINGP (Vauto_save_list_file_name
))
4975 Lisp_Object listfile
;
4976 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4977 stream
= fopen (XSTRING (listfile
)->data
, "w");
4980 /* Arrange to close that file whether or not we get an error.
4981 Also reset auto_saving to 0. */
4982 lispstream
= Fcons (Qnil
, Qnil
);
4983 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
4984 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
4995 record_unwind_protect (do_auto_save_unwind
, lispstream
);
4996 record_unwind_protect (do_auto_save_unwind_1
,
4997 make_number (minibuffer_auto_raise
));
4998 minibuffer_auto_raise
= 0;
5001 /* First, save all files which don't have handlers. If Emacs is
5002 crashing, the handlers may tweak what is causing Emacs to crash
5003 in the first place, and it would be a shame if Emacs failed to
5004 autosave perfectly ordinary files because it couldn't handle some
5006 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5007 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
5009 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
5012 /* Record all the buffers that have auto save mode
5013 in the special file that lists them. For each of these buffers,
5014 Record visited name (if any) and auto save name. */
5015 if (STRINGP (b
->auto_save_file_name
)
5016 && stream
!= NULL
&& do_handled_files
== 0)
5018 if (!NILP (b
->filename
))
5020 fwrite (XSTRING (b
->filename
)->data
, 1,
5021 STRING_BYTES (XSTRING (b
->filename
)), stream
);
5023 putc ('\n', stream
);
5024 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
5025 STRING_BYTES (XSTRING (b
->auto_save_file_name
)), stream
);
5026 putc ('\n', stream
);
5029 if (!NILP (current_only
)
5030 && b
!= current_buffer
)
5033 /* Don't auto-save indirect buffers.
5034 The base buffer takes care of it. */
5038 /* Check for auto save enabled
5039 and file changed since last auto save
5040 and file changed since last real save. */
5041 if (STRINGP (b
->auto_save_file_name
)
5042 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5043 && b
->auto_save_modified
< BUF_MODIFF (b
)
5044 /* -1 means we've turned off autosaving for a while--see below. */
5045 && XINT (b
->save_length
) >= 0
5046 && (do_handled_files
5047 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5050 EMACS_TIME before_time
, after_time
;
5052 EMACS_GET_TIME (before_time
);
5054 /* If we had a failure, don't try again for 20 minutes. */
5055 if (b
->auto_save_failure_time
>= 0
5056 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5059 if ((XFASTINT (b
->save_length
) * 10
5060 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5061 /* A short file is likely to change a large fraction;
5062 spare the user annoying messages. */
5063 && XFASTINT (b
->save_length
) > 5000
5064 /* These messages are frequent and annoying for `*mail*'. */
5065 && !EQ (b
->filename
, Qnil
)
5066 && NILP (no_message
))
5068 /* It has shrunk too much; turn off auto-saving here. */
5069 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5070 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
5072 minibuffer_auto_raise
= 0;
5073 /* Turn off auto-saving until there's a real save,
5074 and prevent any more warnings. */
5075 XSETINT (b
->save_length
, -1);
5076 Fsleep_for (make_number (1), Qnil
);
5079 set_buffer_internal (b
);
5080 if (!auto_saved
&& NILP (no_message
))
5081 message1 ("Auto-saving...");
5082 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5084 b
->auto_save_modified
= BUF_MODIFF (b
);
5085 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5086 set_buffer_internal (old
);
5088 EMACS_GET_TIME (after_time
);
5090 /* If auto-save took more than 60 seconds,
5091 assume it was an NFS failure that got a timeout. */
5092 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5093 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5097 /* Prevent another auto save till enough input events come in. */
5098 record_auto_save ();
5100 if (auto_saved
&& NILP (no_message
))
5104 sit_for (1, 0, 0, 0, 0);
5105 message2 (omessage
, omessage_length
, oldmultibyte
);
5108 message1 ("Auto-saving...done");
5113 unbind_to (count
, Qnil
);
5117 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5118 Sset_buffer_auto_saved
, 0, 0, 0,
5119 "Mark current buffer as auto-saved with its current text.\n\
5120 No auto-save file will be written until the buffer changes again.")
5123 current_buffer
->auto_save_modified
= MODIFF
;
5124 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5125 current_buffer
->auto_save_failure_time
= -1;
5129 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5130 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5131 "Clear any record of a recent auto-save failure in the current buffer.")
5134 current_buffer
->auto_save_failure_time
= -1;
5138 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5140 "Return t if buffer has been auto-saved since last read in or saved.")
5143 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5146 /* Reading and completing file names */
5147 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5149 /* In the string VAL, change each $ to $$ and return the result. */
5152 double_dollars (val
)
5155 register unsigned char *old
, *new;
5159 osize
= STRING_BYTES (XSTRING (val
));
5161 /* Count the number of $ characters. */
5162 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
5163 if (*old
++ == '$') count
++;
5166 old
= XSTRING (val
)->data
;
5167 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
5169 new = XSTRING (val
)->data
;
5170 for (n
= osize
; n
> 0; n
--)
5183 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5185 "Internal subroutine for read-file-name. Do not call this.")
5186 (string
, dir
, action
)
5187 Lisp_Object string
, dir
, action
;
5188 /* action is nil for complete, t for return list of completions,
5189 lambda for verify final value */
5191 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5193 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5195 CHECK_STRING (string
, 0);
5202 /* No need to protect ACTION--we only compare it with t and nil. */
5203 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5205 if (XSTRING (string
)->size
== 0)
5207 if (EQ (action
, Qlambda
))
5215 orig_string
= string
;
5216 string
= Fsubstitute_in_file_name (string
);
5217 changed
= NILP (Fstring_equal (string
, orig_string
));
5218 name
= Ffile_name_nondirectory (string
);
5219 val
= Ffile_name_directory (string
);
5221 realdir
= Fexpand_file_name (val
, realdir
);
5226 specdir
= Ffile_name_directory (string
);
5227 val
= Ffile_name_completion (name
, realdir
);
5232 return double_dollars (string
);
5236 if (!NILP (specdir
))
5237 val
= concat2 (specdir
, val
);
5239 return double_dollars (val
);
5242 #endif /* not VMS */
5246 if (EQ (action
, Qt
))
5247 return Ffile_name_all_completions (name
, realdir
);
5248 /* Only other case actually used is ACTION = lambda */
5250 /* Supposedly this helps commands such as `cd' that read directory names,
5251 but can someone explain how it helps them? -- RMS */
5252 if (XSTRING (name
)->size
== 0)
5255 return Ffile_exists_p (string
);
5258 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5259 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5260 Value is not expanded---you must call `expand-file-name' yourself.\n\
5261 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5262 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5263 except that if INITIAL is specified, that combined with DIR is used.)\n\
5264 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5265 Non-nil and non-t means also require confirmation after completion.\n\
5266 Fifth arg INITIAL specifies text to start with.\n\
5267 DIR defaults to current buffer's directory default.")
5268 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5269 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5271 Lisp_Object val
, insdef
, insdef1
, tem
;
5272 struct gcpro gcpro1
, gcpro2
;
5273 register char *homedir
;
5274 int replace_in_history
= 0;
5275 int add_to_history
= 0;
5279 dir
= current_buffer
->directory
;
5280 if (NILP (default_filename
))
5282 if (! NILP (initial
))
5283 default_filename
= Fexpand_file_name (initial
, dir
);
5285 default_filename
= current_buffer
->filename
;
5288 /* If dir starts with user's homedir, change that to ~. */
5289 homedir
= (char *) egetenv ("HOME");
5291 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5292 CORRECT_DIR_SEPS (homedir
);
5296 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5297 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5299 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5300 STRING_BYTES (XSTRING (dir
)) - strlen (homedir
) + 1);
5301 XSTRING (dir
)->data
[0] = '~';
5304 if (insert_default_directory
&& STRINGP (dir
))
5307 if (!NILP (initial
))
5309 Lisp_Object args
[2], pos
;
5313 insdef
= Fconcat (2, args
);
5314 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5315 insdef1
= Fcons (double_dollars (insdef
), pos
);
5318 insdef1
= double_dollars (insdef
);
5320 else if (STRINGP (initial
))
5323 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
5326 insdef
= Qnil
, insdef1
= Qnil
;
5329 count
= specpdl_ptr
- specpdl
;
5330 specbind (intern ("completion-ignore-case"), Qt
);
5333 GCPRO2 (insdef
, default_filename
);
5334 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5335 dir
, mustmatch
, insdef1
,
5336 Qfile_name_history
, default_filename
, Qnil
);
5338 tem
= Fsymbol_value (Qfile_name_history
);
5339 if (CONSP (tem
) && EQ (XCONS (tem
)->car
, val
))
5340 replace_in_history
= 1;
5342 /* If Fcompleting_read returned the inserted default string itself
5343 (rather than a new string with the same contents),
5344 it has to mean that the user typed RET with the minibuffer empty.
5345 In that case, we really want to return ""
5346 so that commands such as set-visited-file-name can distinguish. */
5347 if (EQ (val
, default_filename
))
5349 /* In this case, Fcompleting_read has not added an element
5350 to the history. Maybe we should. */
5351 if (! replace_in_history
)
5354 val
= build_string ("");
5358 unbind_to (count
, Qnil
);
5363 error ("No file name specified");
5365 tem
= Fstring_equal (val
, insdef
);
5367 if (!NILP (tem
) && !NILP (default_filename
))
5368 val
= default_filename
;
5369 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5371 if (!NILP (default_filename
))
5372 val
= default_filename
;
5374 error ("No default file name");
5376 val
= Fsubstitute_in_file_name (val
);
5378 if (replace_in_history
)
5379 /* Replace what Fcompleting_read added to the history
5380 with what we will actually return. */
5381 XCONS (Fsymbol_value (Qfile_name_history
))->car
= val
;
5382 else if (add_to_history
)
5384 /* Add the value to the history--but not if it matches
5385 the last value already there. */
5386 tem
= Fsymbol_value (Qfile_name_history
);
5387 if (! CONSP (tem
) || NILP (Fequal (XCONS (tem
)->car
, val
)))
5388 Fset (Qfile_name_history
,
5397 Qexpand_file_name
= intern ("expand-file-name");
5398 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5399 Qdirectory_file_name
= intern ("directory-file-name");
5400 Qfile_name_directory
= intern ("file-name-directory");
5401 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5402 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5403 Qfile_name_as_directory
= intern ("file-name-as-directory");
5404 Qcopy_file
= intern ("copy-file");
5405 Qmake_directory_internal
= intern ("make-directory-internal");
5406 Qdelete_directory
= intern ("delete-directory");
5407 Qdelete_file
= intern ("delete-file");
5408 Qrename_file
= intern ("rename-file");
5409 Qadd_name_to_file
= intern ("add-name-to-file");
5410 Qmake_symbolic_link
= intern ("make-symbolic-link");
5411 Qfile_exists_p
= intern ("file-exists-p");
5412 Qfile_executable_p
= intern ("file-executable-p");
5413 Qfile_readable_p
= intern ("file-readable-p");
5414 Qfile_writable_p
= intern ("file-writable-p");
5415 Qfile_symlink_p
= intern ("file-symlink-p");
5416 Qaccess_file
= intern ("access-file");
5417 Qfile_directory_p
= intern ("file-directory-p");
5418 Qfile_regular_p
= intern ("file-regular-p");
5419 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5420 Qfile_modes
= intern ("file-modes");
5421 Qset_file_modes
= intern ("set-file-modes");
5422 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5423 Qinsert_file_contents
= intern ("insert-file-contents");
5424 Qwrite_region
= intern ("write-region");
5425 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5426 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5428 staticpro (&Qexpand_file_name
);
5429 staticpro (&Qsubstitute_in_file_name
);
5430 staticpro (&Qdirectory_file_name
);
5431 staticpro (&Qfile_name_directory
);
5432 staticpro (&Qfile_name_nondirectory
);
5433 staticpro (&Qunhandled_file_name_directory
);
5434 staticpro (&Qfile_name_as_directory
);
5435 staticpro (&Qcopy_file
);
5436 staticpro (&Qmake_directory_internal
);
5437 staticpro (&Qdelete_directory
);
5438 staticpro (&Qdelete_file
);
5439 staticpro (&Qrename_file
);
5440 staticpro (&Qadd_name_to_file
);
5441 staticpro (&Qmake_symbolic_link
);
5442 staticpro (&Qfile_exists_p
);
5443 staticpro (&Qfile_executable_p
);
5444 staticpro (&Qfile_readable_p
);
5445 staticpro (&Qfile_writable_p
);
5446 staticpro (&Qaccess_file
);
5447 staticpro (&Qfile_symlink_p
);
5448 staticpro (&Qfile_directory_p
);
5449 staticpro (&Qfile_regular_p
);
5450 staticpro (&Qfile_accessible_directory_p
);
5451 staticpro (&Qfile_modes
);
5452 staticpro (&Qset_file_modes
);
5453 staticpro (&Qfile_newer_than_file_p
);
5454 staticpro (&Qinsert_file_contents
);
5455 staticpro (&Qwrite_region
);
5456 staticpro (&Qverify_visited_file_modtime
);
5457 staticpro (&Qset_visited_file_modtime
);
5459 Qfile_name_history
= intern ("file-name-history");
5460 Fset (Qfile_name_history
, Qnil
);
5461 staticpro (&Qfile_name_history
);
5463 Qfile_error
= intern ("file-error");
5464 staticpro (&Qfile_error
);
5465 Qfile_already_exists
= intern ("file-already-exists");
5466 staticpro (&Qfile_already_exists
);
5467 Qfile_date_error
= intern ("file-date-error");
5468 staticpro (&Qfile_date_error
);
5471 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5472 staticpro (&Qfind_buffer_file_type
);
5475 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5476 "*Coding system for encoding file names.\n\
5477 If it is nil, default-file-name-coding-system (which see) is used.");
5478 Vfile_name_coding_system
= Qnil
;
5480 DEFVAR_LISP ("default-file-name-coding-system",
5481 &Vdefault_file_name_coding_system
,
5482 "Default coding system for encoding file names.\n\
5483 This variable is used only when file-name-coding-system is nil.\n\
5485 This variable is set/changed by the command set-language-environment.\n\
5486 User should not set this variable manually,\n\
5487 instead use file-name-coding-system to get a constant encoding\n\
5488 of file names regardless of the current language environment.");
5489 Vdefault_file_name_coding_system
= Qnil
;
5491 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5492 "*Format in which to write auto-save files.\n\
5493 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5494 If it is t, which is the default, auto-save files are written in the\n\
5495 same format as a regular save would use.");
5496 Vauto_save_file_format
= Qt
;
5498 Qformat_decode
= intern ("format-decode");
5499 staticpro (&Qformat_decode
);
5500 Qformat_annotate_function
= intern ("format-annotate-function");
5501 staticpro (&Qformat_annotate_function
);
5503 Qcar_less_than_car
= intern ("car-less-than-car");
5504 staticpro (&Qcar_less_than_car
);
5506 Fput (Qfile_error
, Qerror_conditions
,
5507 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5508 Fput (Qfile_error
, Qerror_message
,
5509 build_string ("File error"));
5511 Fput (Qfile_already_exists
, Qerror_conditions
,
5512 Fcons (Qfile_already_exists
,
5513 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5514 Fput (Qfile_already_exists
, Qerror_message
,
5515 build_string ("File already exists"));
5517 Fput (Qfile_date_error
, Qerror_conditions
,
5518 Fcons (Qfile_date_error
,
5519 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5520 Fput (Qfile_date_error
, Qerror_message
,
5521 build_string ("Cannot set file date"));
5523 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5524 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5525 insert_default_directory
= 1;
5527 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5528 "*Non-nil means write new files with record format `stmlf'.\n\
5529 nil means use format `var'. This variable is meaningful only on VMS.");
5530 vms_stmlf_recfm
= 0;
5532 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5533 "Directory separator character for built-in functions that return file names.\n\
5534 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5535 This variable affects the built-in functions only on Windows,\n\
5536 on other platforms, it is initialized so that Lisp code can find out\n\
5537 what the normal separator is.");
5538 XSETFASTINT (Vdirectory_sep_char
, '/');
5540 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5541 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5542 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5545 The first argument given to HANDLER is the name of the I/O primitive\n\
5546 to be handled; the remaining arguments are the arguments that were\n\
5547 passed to that primitive. For example, if you do\n\
5548 (file-exists-p FILENAME)\n\
5549 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5550 (funcall HANDLER 'file-exists-p FILENAME)\n\
5551 The function `find-file-name-handler' checks this list for a handler\n\
5552 for its argument.");
5553 Vfile_name_handler_alist
= Qnil
;
5555 DEFVAR_LISP ("set-auto-coding-function",
5556 &Vset_auto_coding_function
,
5557 "If non-nil, a function to call to decide a coding system of file.\n\
5558 One argument is passed to this function: the string of concatination\n\
5559 or the heading 1K-byte and the tailing 3K-byte of a file to be read.\n\
5560 This function should return a coding system to decode the file contents\n\
5561 specified in the heading lines with the format:\n\
5562 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5563 or local variable spec of the tailing lines with `coding:' tag.");
5564 Vset_auto_coding_function
= Qnil
;
5566 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5567 "A list of functions to be called at the end of `insert-file-contents'.\n\
5568 Each is passed one argument, the number of bytes inserted. It should return\n\
5569 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5570 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5571 responsible for calling the after-insert-file-functions if appropriate.");
5572 Vafter_insert_file_functions
= Qnil
;
5574 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5575 "A list of functions to be called at the start of `write-region'.\n\
5576 Each is passed two arguments, START and END as for `write-region'.\n\
5577 These are usually two numbers but not always; see the documentation\n\
5578 for `write-region'. The function should return a list of pairs\n\
5579 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5580 inserted at the specified positions of the file being written (1 means to\n\
5581 insert before the first byte written). The POSITIONs must be sorted into\n\
5582 increasing order. If there are several functions in the list, the several\n\
5583 lists are merged destructively.");
5584 Vwrite_region_annotate_functions
= Qnil
;
5586 DEFVAR_LISP ("write-region-annotations-so-far",
5587 &Vwrite_region_annotations_so_far
,
5588 "When an annotation function is called, this holds the previous annotations.\n\
5589 These are the annotations made by other annotation functions\n\
5590 that were already called. See also `write-region-annotate-functions'.");
5591 Vwrite_region_annotations_so_far
= Qnil
;
5593 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5594 "A list of file name handlers that temporarily should not be used.\n\
5595 This applies only to the operation `inhibit-file-name-operation'.");
5596 Vinhibit_file_name_handlers
= Qnil
;
5598 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5599 "The operation for which `inhibit-file-name-handlers' is applicable.");
5600 Vinhibit_file_name_operation
= Qnil
;
5602 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5603 "File name in which we write a list of all auto save file names.\n\
5604 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5605 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5607 Vauto_save_list_file_name
= Qnil
;
5609 defsubr (&Sfind_file_name_handler
);
5610 defsubr (&Sfile_name_directory
);
5611 defsubr (&Sfile_name_nondirectory
);
5612 defsubr (&Sunhandled_file_name_directory
);
5613 defsubr (&Sfile_name_as_directory
);
5614 defsubr (&Sdirectory_file_name
);
5615 defsubr (&Smake_temp_name
);
5616 defsubr (&Sexpand_file_name
);
5617 defsubr (&Ssubstitute_in_file_name
);
5618 defsubr (&Scopy_file
);
5619 defsubr (&Smake_directory_internal
);
5620 defsubr (&Sdelete_directory
);
5621 defsubr (&Sdelete_file
);
5622 defsubr (&Srename_file
);
5623 defsubr (&Sadd_name_to_file
);
5625 defsubr (&Smake_symbolic_link
);
5626 #endif /* S_IFLNK */
5628 defsubr (&Sdefine_logical_name
);
5631 defsubr (&Ssysnetunam
);
5632 #endif /* HPUX_NET */
5633 defsubr (&Sfile_name_absolute_p
);
5634 defsubr (&Sfile_exists_p
);
5635 defsubr (&Sfile_executable_p
);
5636 defsubr (&Sfile_readable_p
);
5637 defsubr (&Sfile_writable_p
);
5638 defsubr (&Saccess_file
);
5639 defsubr (&Sfile_symlink_p
);
5640 defsubr (&Sfile_directory_p
);
5641 defsubr (&Sfile_accessible_directory_p
);
5642 defsubr (&Sfile_regular_p
);
5643 defsubr (&Sfile_modes
);
5644 defsubr (&Sset_file_modes
);
5645 defsubr (&Sset_default_file_modes
);
5646 defsubr (&Sdefault_file_modes
);
5647 defsubr (&Sfile_newer_than_file_p
);
5648 defsubr (&Sinsert_file_contents
);
5649 defsubr (&Swrite_region
);
5650 defsubr (&Scar_less_than_car
);
5651 defsubr (&Sverify_visited_file_modtime
);
5652 defsubr (&Sclear_visited_file_modtime
);
5653 defsubr (&Svisited_file_modtime
);
5654 defsubr (&Sset_visited_file_modtime
);
5655 defsubr (&Sdo_auto_save
);
5656 defsubr (&Sset_buffer_auto_saved
);
5657 defsubr (&Sclear_buffer_auto_save_failure
);
5658 defsubr (&Srecent_auto_save_p
);
5660 defsubr (&Sread_file_name_internal
);
5661 defsubr (&Sread_file_name
);
5664 defsubr (&Sunix_sync
);