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\
3269 This does code conversion according to the value of\n\
3270 `coding-system-for-read' or `file-coding-system-alist',\n\
3271 and sets the variable `last-coding-system-used' to the coding system\n\
3273 (filename
, visit
, beg
, end
, replace
)
3274 Lisp_Object filename
, visit
, beg
, end
, replace
;
3279 register int how_much
;
3280 register int unprocessed
;
3281 int count
= specpdl_ptr
- specpdl
;
3282 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3283 Lisp_Object handler
, val
, insval
, orig_filename
;
3286 int not_regular
= 0;
3287 unsigned char read_buf
[READ_BUF_SIZE
];
3288 struct coding_system coding
;
3289 unsigned char buffer
[1 << 14];
3290 int replace_handled
= 0;
3291 int set_coding_system
= 0;
3293 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3294 error ("Cannot do file visiting in an indirect buffer");
3296 if (!NILP (current_buffer
->read_only
))
3297 Fbarf_if_buffer_read_only ();
3301 orig_filename
= Qnil
;
3303 GCPRO4 (filename
, val
, p
, orig_filename
);
3305 CHECK_STRING (filename
, 0);
3306 filename
= Fexpand_file_name (filename
, Qnil
);
3308 /* If the file name has special constructs in it,
3309 call the corresponding file handler. */
3310 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3311 if (!NILP (handler
))
3313 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3314 visit
, beg
, end
, replace
);
3318 orig_filename
= filename
;
3319 filename
= ENCODE_FILE (filename
);
3324 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3326 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3327 || fstat (fd
, &st
) < 0)
3328 #endif /* not APOLLO */
3330 if (fd
>= 0) close (fd
);
3333 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3336 if (!NILP (Vcoding_system_for_read
))
3337 current_buffer
->buffer_file_coding_system
= Vcoding_system_for_read
;
3342 /* This code will need to be changed in order to work on named
3343 pipes, and it's probably just not worth it. So we should at
3344 least signal an error. */
3345 if (!S_ISREG (st
.st_mode
))
3352 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3353 Fsignal (Qfile_error
,
3354 Fcons (build_string ("not a regular file"),
3355 Fcons (orig_filename
, Qnil
)));
3360 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3363 /* Replacement should preserve point as it preserves markers. */
3364 if (!NILP (replace
))
3365 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3367 record_unwind_protect (close_file_unwind
, make_number (fd
));
3369 /* Supposedly happens on VMS. */
3370 if (! not_regular
&& st
.st_size
< 0)
3371 error ("File size is negative");
3373 if (!NILP (beg
) || !NILP (end
))
3375 error ("Attempt to visit less than an entire file");
3378 CHECK_NUMBER (beg
, 0);
3380 XSETFASTINT (beg
, 0);
3383 CHECK_NUMBER (end
, 0);
3388 XSETINT (end
, st
.st_size
);
3389 if (XINT (end
) != st
.st_size
)
3390 error ("Maximum buffer size exceeded");
3394 /* Decide the coding-system of the file. */
3399 if (!NILP (Vcoding_system_for_read
))
3400 val
= Vcoding_system_for_read
;
3401 else if (! NILP (replace
))
3402 /* In REPLACE mode, we can use the same coding system
3403 that was used to visit the file. */
3404 val
= current_buffer
->buffer_file_coding_system
;
3405 else if (! not_regular
)
3407 /* Don't try looking inside a file for a coding system specification
3408 if it is not seekable. */
3409 if (! NILP (Vset_auto_coding_function
))
3411 /* Find a coding system specified in the heading two lines
3412 or in the tailing several lines of the file. We assume
3413 that the 1K-byte and 3K-byte for heading and tailing
3414 respectively are sufficient fot this purpose. */
3416 int beginning_of_end
, end_of_beginning
;
3418 if (st
.st_size
<= (1024 * 4))
3420 nread
= read (fd
, read_buf
, 1024 * 4);
3421 end_of_beginning
= nread
;
3422 beginning_of_end
= 0;
3426 nread
= read (fd
, read_buf
, 1024);
3427 end_of_beginning
= nread
;
3428 beginning_of_end
= nread
;
3431 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3432 report_file_error ("Setting file position",
3433 Fcons (orig_filename
, Qnil
));
3434 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3439 error ("IO error reading %s: %s",
3440 XSTRING (orig_filename
)->data
, strerror (errno
));
3444 int possible_spec
= 0;
3445 unsigned char *p
, *p1
;
3447 unsigned char *copy
= (unsigned char *) alloca (nread
+ 1);
3449 /* Make a copy of the contents of read_buf in COPY,
3450 and convert it to lower case so we can compare
3451 more efficiently. */
3452 bcopy (read_buf
, copy
, nread
);
3453 for (i
= 0; i
< nread
; i
++)
3454 copy
[i
] = DOWNCASE (copy
[i
]);
3455 /* Ensure various comparisons fail at end of data. */
3458 /* Now test quickly whether the file contains a -*- line. */
3460 while (*p
!= '\n' && p
- copy
< end_of_beginning
)
3462 if (copy
[0] == '#' && copy
[1] == '!')
3463 while (*p
!= '\n' && p
- copy
< end_of_beginning
)
3468 if (p1
[0] == '-' && p1
[1] == '*' && p1
[2] == '-')
3472 if (! bcmp ("coding:", p1
, 7))
3484 /* Test quickly whether the file
3485 contains a local variables list. */
3486 p
= ©
[nread
- 1];
3487 p1
= ©
[beginning_of_end
];
3490 if (p
[0] == '\n' && p
[1] == '\f')
3495 while (p1
- p
>= 16)
3497 if (! bcmp ("local variables:", p
, 16))
3508 /* Always make this a unibyte string
3509 because we have not yet decoded it. */
3510 tem
= make_unibyte_string (read_buf
, nread
);
3511 val
= call1 (Vset_auto_coding_function
, tem
);
3514 /* Rewind the file for the actual read done later. */
3515 if (lseek (fd
, 0, 0) < 0)
3516 report_file_error ("Setting file position",
3517 Fcons (orig_filename
, Qnil
));
3522 Lisp_Object args
[6], coding_systems
;
3524 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3525 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3526 coding_systems
= Ffind_operation_coding_system (6, args
);
3527 if (CONSP (coding_systems
))
3528 val
= XCONS (coding_systems
)->car
;
3532 if (NILP (Vcoding_system_for_read
)
3533 && NILP (current_buffer
->enable_multibyte_characters
))
3535 /* We must suppress all text conversion except for end-of-line
3537 struct coding_system coding_temp
;
3539 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
3540 setup_coding_system (Qraw_text
, &coding
);
3541 coding
.eol_type
= coding_temp
.eol_type
;
3544 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3547 /* If requested, replace the accessible part of the buffer
3548 with the file contents. Avoid replacing text at the
3549 beginning or end of the buffer that matches the file contents;
3550 that preserves markers pointing to the unchanged parts.
3552 Here we implement this feature in an optimized way
3553 for the case where code conversion is NOT needed.
3554 The following if-statement handles the case of conversion
3555 in a less optimal way.
3557 If the code conversion is "automatic" then we try using this
3558 method and hope for the best.
3559 But if we discover the need for conversion, we give up on this method
3560 and let the following if-statement handle the replace job. */
3562 && ! CODING_REQUIRE_DECODING (&coding
)
3563 && (coding
.eol_type
== CODING_EOL_UNDECIDED
3564 || coding
.eol_type
== CODING_EOL_LF
))
3566 /* same_at_start and same_at_end count bytes,
3567 because file access counts bytes
3568 and BEG and END count bytes. */
3569 int same_at_start
= BEGV_BYTE
;
3570 int same_at_end
= ZV_BYTE
;
3572 /* There is still a possibility we will find the need to do code
3573 conversion. If that happens, we set this variable to 1 to
3574 give up on handling REPLACE in the optimized way. */
3575 int giveup_match_end
= 0;
3577 if (XINT (beg
) != 0)
3579 if (lseek (fd
, XINT (beg
), 0) < 0)
3580 report_file_error ("Setting file position",
3581 Fcons (orig_filename
, Qnil
));
3586 /* Count how many chars at the start of the file
3587 match the text at the beginning of the buffer. */
3592 nread
= read (fd
, buffer
, sizeof buffer
);
3594 error ("IO error reading %s: %s",
3595 XSTRING (orig_filename
)->data
, strerror (errno
));
3596 else if (nread
== 0)
3599 if (coding
.type
== coding_type_undecided
)
3600 detect_coding (&coding
, buffer
, nread
);
3601 if (CODING_REQUIRE_DECODING (&coding
))
3602 /* We found that the file should be decoded somehow.
3603 Let's give up here. */
3605 giveup_match_end
= 1;
3609 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3610 detect_eol (&coding
, buffer
, nread
);
3611 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3612 && coding
.eol_type
!= CODING_EOL_LF
)
3613 /* We found that the format of eol should be decoded.
3614 Let's give up here. */
3616 giveup_match_end
= 1;
3621 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3622 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3623 same_at_start
++, bufpos
++;
3624 /* If we found a discrepancy, stop the scan.
3625 Otherwise loop around and scan the next bufferful. */
3626 if (bufpos
!= nread
)
3630 /* If the file matches the buffer completely,
3631 there's no need to replace anything. */
3632 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3636 /* Truncate the buffer to the size of the file. */
3637 del_range_1 (same_at_start
, same_at_end
, 0);
3642 /* Count how many chars at the end of the file
3643 match the text at the end of the buffer. But, if we have
3644 already found that decoding is necessary, don't waste time. */
3645 while (!giveup_match_end
)
3647 int total_read
, nread
, bufpos
, curpos
, trial
;
3649 /* At what file position are we now scanning? */
3650 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3651 /* If the entire file matches the buffer tail, stop the scan. */
3654 /* How much can we scan in the next step? */
3655 trial
= min (curpos
, sizeof buffer
);
3656 if (lseek (fd
, curpos
- trial
, 0) < 0)
3657 report_file_error ("Setting file position",
3658 Fcons (orig_filename
, Qnil
));
3661 while (total_read
< trial
)
3663 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3665 error ("IO error reading %s: %s",
3666 XSTRING (orig_filename
)->data
, strerror (errno
));
3667 total_read
+= nread
;
3669 /* Scan this bufferful from the end, comparing with
3670 the Emacs buffer. */
3671 bufpos
= total_read
;
3672 /* Compare with same_at_start to avoid counting some buffer text
3673 as matching both at the file's beginning and at the end. */
3674 while (bufpos
> 0 && same_at_end
> same_at_start
3675 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3676 same_at_end
--, bufpos
--;
3678 /* If we found a discrepancy, stop the scan.
3679 Otherwise loop around and scan the preceding bufferful. */
3682 /* If this discrepancy is because of code conversion,
3683 we cannot use this method; giveup and try the other. */
3684 if (same_at_end
> same_at_start
3685 && FETCH_BYTE (same_at_end
- 1) >= 0200
3686 && ! NILP (current_buffer
->enable_multibyte_characters
)
3687 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3688 giveup_match_end
= 1;
3694 if (! giveup_match_end
)
3698 /* We win! We can handle REPLACE the optimized way. */
3700 /* Extends the end of non-matching text area to multibyte
3701 character boundary. */
3702 if (! NILP (current_buffer
->enable_multibyte_characters
))
3703 while (same_at_end
< ZV_BYTE
3704 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3707 /* Don't try to reuse the same piece of text twice. */
3708 overlap
= (same_at_start
- BEGV_BYTE
3709 - (same_at_end
+ st
.st_size
- ZV
));
3711 same_at_end
+= overlap
;
3713 /* Arrange to read only the nonmatching middle part of the file. */
3714 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3715 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3717 del_range_byte (same_at_start
, same_at_end
, 0);
3718 /* Insert from the file at the proper position. */
3719 temp
= BYTE_TO_CHAR (same_at_start
);
3720 SET_PT_BOTH (temp
, same_at_start
);
3722 /* If display currently starts at beginning of line,
3723 keep it that way. */
3724 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3725 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3727 replace_handled
= 1;
3731 /* If requested, replace the accessible part of the buffer
3732 with the file contents. Avoid replacing text at the
3733 beginning or end of the buffer that matches the file contents;
3734 that preserves markers pointing to the unchanged parts.
3736 Here we implement this feature for the case where code conversion
3737 is needed, in a simple way that needs a lot of memory.
3738 The preceding if-statement handles the case of no conversion
3739 in a more optimized way. */
3740 if (!NILP (replace
) && ! replace_handled
)
3742 int same_at_start
= BEGV_BYTE
;
3743 int same_at_end
= ZV_BYTE
;
3746 /* Make sure that the gap is large enough. */
3747 int bufsize
= 2 * st
.st_size
;
3748 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3751 /* First read the whole file, performing code conversion into
3752 CONVERSION_BUFFER. */
3754 if (lseek (fd
, XINT (beg
), 0) < 0)
3756 free (conversion_buffer
);
3757 report_file_error ("Setting file position",
3758 Fcons (orig_filename
, Qnil
));
3761 total
= st
.st_size
; /* Total bytes in the file. */
3762 how_much
= 0; /* Bytes read from file so far. */
3763 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3764 unprocessed
= 0; /* Bytes not processed in previous loop. */
3766 while (how_much
< total
)
3768 /* try is reserved in some compilers (Microsoft C) */
3769 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3770 char *destination
= read_buf
+ unprocessed
;
3773 /* Allow quitting out of the actual I/O. */
3776 this = read (fd
, destination
, trytry
);
3779 if (this < 0 || this + unprocessed
== 0)
3787 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3789 int require
, result
;
3791 this += unprocessed
;
3793 /* If we are using more space than estimated,
3794 make CONVERSION_BUFFER bigger. */
3795 require
= decoding_buffer_size (&coding
, this);
3796 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3798 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3799 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3802 /* Convert this batch with results in CONVERSION_BUFFER. */
3803 if (how_much
>= total
) /* This is the last block. */
3804 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3805 result
= decode_coding (&coding
, read_buf
,
3806 conversion_buffer
+ inserted
,
3807 this, bufsize
- inserted
);
3809 /* Save for next iteration whatever we didn't convert. */
3810 unprocessed
= this - coding
.consumed
;
3811 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
3812 this = coding
.produced
;
3818 /* At this point, INSERTED is how many characters (i.e. bytes)
3819 are present in CONVERSION_BUFFER.
3820 HOW_MUCH should equal TOTAL,
3821 or should be <= 0 if we couldn't read the file. */
3825 free (conversion_buffer
);
3828 error ("IO error reading %s: %s",
3829 XSTRING (orig_filename
)->data
, strerror (errno
));
3830 else if (how_much
== -2)
3831 error ("maximum buffer size exceeded");
3834 /* Compare the beginning of the converted file
3835 with the buffer text. */
3838 while (bufpos
< inserted
&& same_at_start
< same_at_end
3839 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3840 same_at_start
++, bufpos
++;
3842 /* If the file matches the buffer completely,
3843 there's no need to replace anything. */
3845 if (bufpos
== inserted
)
3847 free (conversion_buffer
);
3850 /* Truncate the buffer to the size of the file. */
3851 del_range_1 (same_at_start
, same_at_end
, 0);
3855 /* Scan this bufferful from the end, comparing with
3856 the Emacs buffer. */
3859 /* Compare with same_at_start to avoid counting some buffer text
3860 as matching both at the file's beginning and at the end. */
3861 while (bufpos
> 0 && same_at_end
> same_at_start
3862 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3863 same_at_end
--, bufpos
--;
3865 /* Don't try to reuse the same piece of text twice. */
3866 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3868 same_at_end
+= overlap
;
3870 /* If display currently starts at beginning of line,
3871 keep it that way. */
3872 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3873 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3875 /* Replace the chars that we need to replace,
3876 and update INSERTED to equal the number of bytes
3877 we are taking from the file. */
3878 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
3879 del_range_byte (same_at_start
, same_at_end
, 0);
3880 if (same_at_end
!= same_at_start
)
3881 SET_PT_BOTH (GPT
, GPT_BYTE
);
3884 /* Insert from the file at the proper position. */
3885 temp
= BYTE_TO_CHAR (same_at_start
);
3886 SET_PT_BOTH (temp
, same_at_start
);
3889 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
3892 free (conversion_buffer
);
3901 register Lisp_Object temp
;
3903 total
= XINT (end
) - XINT (beg
);
3905 /* Make sure point-max won't overflow after this insertion. */
3906 XSETINT (temp
, total
);
3907 if (total
!= XINT (temp
))
3908 error ("Maximum buffer size exceeded");
3911 /* For a special file, all we can do is guess. */
3912 total
= READ_BUF_SIZE
;
3914 if (NILP (visit
) && total
> 0)
3915 prepare_to_modify_buffer (PT
, PT
, NULL
);
3918 if (GAP_SIZE
< total
)
3919 make_gap (total
- GAP_SIZE
);
3921 if (XINT (beg
) != 0 || !NILP (replace
))
3923 if (lseek (fd
, XINT (beg
), 0) < 0)
3924 report_file_error ("Setting file position",
3925 Fcons (orig_filename
, Qnil
));
3928 /* In the following loop, HOW_MUCH contains the total bytes read so
3929 far for a regular file, and not changed for a special file. But,
3930 before exiting the loop, it is set to a negative value if I/O
3933 /* Total bytes inserted. */
3935 /* Here, we don't do code conversion in the loop. It is done by
3936 code_convert_region after all data are read into the buffer. */
3937 while (how_much
< total
)
3939 /* try is reserved in some compilers (Microsoft C) */
3940 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3943 /* For a special file, GAP_SIZE should be checked every time. */
3944 if (not_regular
&& GAP_SIZE
< trytry
)
3945 make_gap (total
- GAP_SIZE
);
3947 /* Allow quitting out of the actual I/O. */
3950 this = read (fd
, BYTE_POS_ADDR (PT_BYTE
+ inserted
- 1) + 1, trytry
);
3967 /* For a regular file, where TOTAL is the real size,
3968 count HOW_MUCH to compare with it.
3969 For a special file, where TOTAL is just a buffer size,
3970 so don't bother counting in HOW_MUCH.
3971 (INSERTED is where we count the number of characters inserted.) */
3978 /* Put an anchor to ensure multi-byte form ends at gap. */
3983 /* Discard the unwind protect for closing the file. */
3987 error ("IO error reading %s: %s",
3988 XSTRING (orig_filename
)->data
, strerror (errno
));
3992 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3994 /* Here, we don't have to consider byte combining (see the
3995 comment below) because code_convert_region takes care of
3997 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
3999 inserted
= (NILP (current_buffer
->enable_multibyte_characters
)
4000 ? coding
.produced
: coding
.produced_char
);
4002 else if (!NILP (current_buffer
->enable_multibyte_characters
))
4004 int inserted_byte
= inserted
;
4006 /* There's a possibility that we must combine bytes at the
4007 head (resp. the tail) of the just inserted text with the
4008 bytes before (resp. after) the gap to form a single
4010 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
4011 adjust_after_insert (PT
, PT_BYTE
,
4012 PT
+ inserted_byte
, PT_BYTE
+ inserted_byte
,
4016 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4020 /* Use the conversion type to determine buffer-file-type
4021 (find-buffer-file-type is now used to help determine the
4023 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4024 || coding
.eol_type
== CODING_EOL_LF
)
4025 && ! CODING_REQUIRE_DECODING (&coding
))
4026 current_buffer
->buffer_file_type
= Qt
;
4028 current_buffer
->buffer_file_type
= Qnil
;
4032 set_coding_system
= 1;
4039 if (!EQ (current_buffer
->undo_list
, Qt
))
4040 current_buffer
->undo_list
= Qnil
;
4042 stat (XSTRING (filename
)->data
, &st
);
4047 current_buffer
->modtime
= st
.st_mtime
;
4048 current_buffer
->filename
= orig_filename
;
4051 SAVE_MODIFF
= MODIFF
;
4052 current_buffer
->auto_save_modified
= MODIFF
;
4053 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4054 #ifdef CLASH_DETECTION
4057 if (!NILP (current_buffer
->file_truename
))
4058 unlock_file (current_buffer
->file_truename
);
4059 unlock_file (filename
);
4061 #endif /* CLASH_DETECTION */
4063 Fsignal (Qfile_error
,
4064 Fcons (build_string ("not a regular file"),
4065 Fcons (orig_filename
, Qnil
)));
4067 /* If visiting nonexistent file, return nil. */
4068 if (current_buffer
->modtime
== -1)
4069 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4072 /* Decode file format */
4075 insval
= call3 (Qformat_decode
,
4076 Qnil
, make_number (inserted
), visit
);
4077 CHECK_NUMBER (insval
, 0);
4078 inserted
= XFASTINT (insval
);
4081 /* Call after-change hooks for the inserted text, aside from the case
4082 of normal visiting (not with REPLACE), which is done in a new buffer
4083 "before" the buffer is changed. */
4084 if (inserted
> 0 && total
> 0
4085 && (NILP (visit
) || !NILP (replace
)))
4086 signal_after_change (PT
, 0, inserted
);
4088 if (set_coding_system
)
4089 Vlast_coding_system_used
= coding
.symbol
;
4093 p
= Vafter_insert_file_functions
;
4096 insval
= call1 (Fcar (p
), make_number (inserted
));
4099 CHECK_NUMBER (insval
, 0);
4100 inserted
= XFASTINT (insval
);
4107 /* ??? Retval needs to be dealt with in all cases consistently. */
4109 val
= Fcons (orig_filename
,
4110 Fcons (make_number (inserted
),
4113 RETURN_UNGCPRO (unbind_to (count
, val
));
4116 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
4119 /* If build_annotations switched buffers, switch back to BUF.
4120 Kill the temporary buffer that was selected in the meantime.
4122 Since this kill only the last temporary buffer, some buffers remain
4123 not killed if build_annotations switched buffers more than once.
4127 build_annotations_unwind (buf
)
4132 if (XBUFFER (buf
) == current_buffer
)
4134 tembuf
= Fcurrent_buffer ();
4136 Fkill_buffer (tembuf
);
4140 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4141 "r\nFWrite region to file: \ni\ni\ni\np",
4142 "Write current region into specified file.\n\
4143 When called from a program, takes three arguments:\n\
4144 START, END and FILENAME. START and END are buffer positions.\n\
4145 Optional fourth argument APPEND if non-nil means\n\
4146 append to existing file contents (if any).\n\
4147 Optional fifth argument VISIT if t means\n\
4148 set the last-save-file-modtime of buffer to this file's modtime\n\
4149 and mark buffer not modified.\n\
4150 If VISIT is a string, it is a second file name;\n\
4151 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
4152 VISIT is also the file name to lock and unlock for clash detection.\n\
4153 If VISIT is neither t nor nil nor a string,\n\
4154 that means do not print the \"Wrote file\" message.\n\
4155 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
4156 use for locking and unlocking, overriding FILENAME and VISIT.\n\
4157 The optional seventh arg CONFIRM, if non-nil, says ask for confirmation\n\
4158 before overwriting an existing file.\n\
4159 Kludgy feature: if START is a string, then that string is written\n\
4160 to the file, instead of any buffer contents, and END is ignored.")
4161 (start
, end
, filename
, append
, visit
, lockname
, confirm
)
4162 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, confirm
;
4170 int count
= specpdl_ptr
- specpdl
;
4173 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4175 Lisp_Object handler
;
4176 Lisp_Object visit_file
;
4177 Lisp_Object annotations
;
4178 Lisp_Object encoded_filename
;
4179 int visiting
, quietly
;
4180 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4181 struct buffer
*given_buffer
;
4183 int buffer_file_type
= O_BINARY
;
4185 struct coding_system coding
;
4187 if (current_buffer
->base_buffer
&& ! NILP (visit
))
4188 error ("Cannot do file visiting in an indirect buffer");
4190 if (!NILP (start
) && !STRINGP (start
))
4191 validate_region (&start
, &end
);
4193 GCPRO4 (start
, filename
, visit
, lockname
);
4195 /* Decide the coding-system to encode the data with. */
4201 else if (!NILP (Vcoding_system_for_write
))
4202 val
= Vcoding_system_for_write
;
4203 else if (NILP (current_buffer
->enable_multibyte_characters
))
4205 /* If the variable `buffer-file-coding-system' is set locally,
4206 it means that the file was read with some kind of code
4207 conversion or the varialbe is explicitely set by users. We
4208 had better write it out with the same coding system even if
4209 `enable-multibyte-characters' is nil.
4211 If it is not set locally, we anyway have to convert EOL
4212 format if the default value of `buffer-file-coding-system'
4213 tells that it is not Unix-like (LF only) format. */
4214 val
= current_buffer
->buffer_file_coding_system
;
4215 if (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4217 struct coding_system coding_temp
;
4219 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
4220 if (coding_temp
.eol_type
== CODING_EOL_CRLF
4221 || coding_temp
.eol_type
== CODING_EOL_CR
)
4223 setup_coding_system (Qraw_text
, &coding
);
4224 coding
.eol_type
= coding_temp
.eol_type
;
4225 goto done_setup_coding
;
4232 Lisp_Object args
[7], coding_systems
;
4234 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4235 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4237 coding_systems
= Ffind_operation_coding_system (7, args
);
4238 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
4239 ? XCONS (coding_systems
)->cdr
4240 : current_buffer
->buffer_file_coding_system
);
4241 /* Confirm that VAL can surely encode the current region. */
4242 if (!NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4243 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4245 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4248 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4249 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4252 Vlast_coding_system_used
= coding
.symbol
;
4254 filename
= Fexpand_file_name (filename
, Qnil
);
4256 if (! NILP (confirm
))
4257 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4259 if (STRINGP (visit
))
4260 visit_file
= Fexpand_file_name (visit
, Qnil
);
4262 visit_file
= filename
;
4265 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4266 quietly
= !NILP (visit
);
4270 if (NILP (lockname
))
4271 lockname
= visit_file
;
4273 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4275 /* If the file name has special constructs in it,
4276 call the corresponding file handler. */
4277 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4278 /* If FILENAME has no handler, see if VISIT has one. */
4279 if (NILP (handler
) && STRINGP (visit
))
4280 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4282 if (!NILP (handler
))
4285 val
= call6 (handler
, Qwrite_region
, start
, end
,
4286 filename
, append
, visit
);
4290 SAVE_MODIFF
= MODIFF
;
4291 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4292 current_buffer
->filename
= visit_file
;
4298 /* Special kludge to simplify auto-saving. */
4301 XSETFASTINT (start
, BEG
);
4302 XSETFASTINT (end
, Z
);
4305 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4306 count1
= specpdl_ptr
- specpdl
;
4308 given_buffer
= current_buffer
;
4309 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4310 if (current_buffer
!= given_buffer
)
4312 XSETFASTINT (start
, BEGV
);
4313 XSETFASTINT (end
, ZV
);
4316 #ifdef CLASH_DETECTION
4319 #if 0 /* This causes trouble for GNUS. */
4320 /* If we've locked this file for some other buffer,
4321 query before proceeding. */
4322 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4323 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4326 lock_file (lockname
);
4328 #endif /* CLASH_DETECTION */
4330 encoded_filename
= ENCODE_FILE (filename
);
4332 fn
= XSTRING (encoded_filename
)->data
;
4336 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4337 #else /* not DOS_NT */
4338 desc
= open (fn
, O_WRONLY
);
4339 #endif /* not DOS_NT */
4341 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4343 if (auto_saving
) /* Overwrite any previous version of autosave file */
4345 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4346 desc
= open (fn
, O_RDWR
);
4348 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4349 ? XSTRING (current_buffer
->filename
)->data
: 0,
4352 else /* Write to temporary name and rename if no errors */
4354 Lisp_Object temp_name
;
4355 temp_name
= Ffile_name_directory (filename
);
4357 if (!NILP (temp_name
))
4359 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4360 build_string ("$$SAVE$$")));
4361 fname
= XSTRING (filename
)->data
;
4362 fn
= XSTRING (temp_name
)->data
;
4363 desc
= creat_copy_attrs (fname
, fn
);
4366 /* If we can't open the temporary file, try creating a new
4367 version of the original file. VMS "creat" creates a
4368 new version rather than truncating an existing file. */
4371 desc
= creat (fn
, 0666);
4372 #if 0 /* This can clobber an existing file and fail to replace it,
4373 if the user runs out of space. */
4376 /* We can't make a new version;
4377 try to truncate and rewrite existing version if any. */
4379 desc
= open (fn
, O_RDWR
);
4385 desc
= creat (fn
, 0666);
4390 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4391 S_IREAD
| S_IWRITE
);
4392 #else /* not DOS_NT */
4393 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4394 #endif /* not DOS_NT */
4395 #endif /* not VMS */
4401 #ifdef CLASH_DETECTION
4403 if (!auto_saving
) unlock_file (lockname
);
4405 #endif /* CLASH_DETECTION */
4406 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4409 record_unwind_protect (close_file_unwind
, make_number (desc
));
4412 if (lseek (desc
, 0, 2) < 0)
4414 #ifdef CLASH_DETECTION
4415 if (!auto_saving
) unlock_file (lockname
);
4416 #endif /* CLASH_DETECTION */
4417 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4422 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4423 * if we do writes that don't end with a carriage return. Furthermore
4424 * it cannot handle writes of more then 16K. The modified
4425 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4426 * this EXCEPT for the last record (iff it doesn't end with a carriage
4427 * return). This implies that if your buffer doesn't end with a carriage
4428 * return, you get one free... tough. However it also means that if
4429 * we make two calls to sys_write (a la the following code) you can
4430 * get one at the gap as well. The easiest way to fix this (honest)
4431 * is to move the gap to the next newline (or the end of the buffer).
4436 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4437 move_gap (find_next_newline (GPT
, 1));
4439 /* Whether VMS or not, we must move the gap to the next of newline
4440 when we must put designation sequences at beginning of line. */
4441 if (INTEGERP (start
)
4442 && coding
.type
== coding_type_iso2022
4443 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4444 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4446 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4447 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4448 move_gap_both (PT
, PT_BYTE
);
4449 SET_PT_BOTH (opoint
, opoint_byte
);
4456 if (STRINGP (start
))
4458 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4459 STRING_BYTES (XSTRING (start
)), 0, &annotations
,
4463 else if (XINT (start
) != XINT (end
))
4465 register int end1
= CHAR_TO_BYTE (XINT (end
));
4467 tem
= CHAR_TO_BYTE (XINT (start
));
4469 if (XINT (start
) < GPT
)
4471 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
),
4472 min (GPT_BYTE
, end1
) - tem
, tem
, &annotations
,
4477 if (XINT (end
) > GPT
&& !failure
)
4479 tem
= max (tem
, GPT_BYTE
);
4480 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
), end1
- tem
,
4481 tem
, &annotations
, &coding
);
4487 /* If file was empty, still need to write the annotations */
4488 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4489 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4493 if (CODING_REQUIRE_FLUSHING (&coding
)
4494 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4497 /* We have to flush out a data. */
4498 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4499 failure
= 0 > e_write (desc
, "", 0, &coding
);
4506 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4507 Disk full in NFS may be reported here. */
4508 /* mib says that closing the file will try to write as fast as NFS can do
4509 it, and that means the fsync here is not crucial for autosave files. */
4510 if (!auto_saving
&& fsync (desc
) < 0)
4512 /* If fsync fails with EINTR, don't treat that as serious. */
4514 failure
= 1, save_errno
= errno
;
4518 /* Spurious "file has changed on disk" warnings have been
4519 observed on Suns as well.
4520 It seems that `close' can change the modtime, under nfs.
4522 (This has supposedly been fixed in Sunos 4,
4523 but who knows about all the other machines with NFS?) */
4526 /* On VMS and APOLLO, must do the stat after the close
4527 since closing changes the modtime. */
4530 /* Recall that #if defined does not work on VMS. */
4537 /* NFS can report a write failure now. */
4538 if (close (desc
) < 0)
4539 failure
= 1, save_errno
= errno
;
4542 /* If we wrote to a temporary name and had no errors, rename to real name. */
4546 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4554 /* Discard the unwind protect for close_file_unwind. */
4555 specpdl_ptr
= specpdl
+ count1
;
4556 /* Restore the original current buffer. */
4557 visit_file
= unbind_to (count
, visit_file
);
4559 #ifdef CLASH_DETECTION
4561 unlock_file (lockname
);
4562 #endif /* CLASH_DETECTION */
4564 /* Do this before reporting IO error
4565 to avoid a "file has changed on disk" warning on
4566 next attempt to save. */
4568 current_buffer
->modtime
= st
.st_mtime
;
4571 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4572 strerror (save_errno
));
4576 SAVE_MODIFF
= MODIFF
;
4577 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4578 current_buffer
->filename
= visit_file
;
4579 update_mode_lines
++;
4585 message_with_string ("Wrote %s", visit_file
, 1);
4590 Lisp_Object
merge ();
4592 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4593 "Return t if (car A) is numerically less than (car B).")
4597 return Flss (Fcar (a
), Fcar (b
));
4600 /* Build the complete list of annotations appropriate for writing out
4601 the text between START and END, by calling all the functions in
4602 write-region-annotate-functions and merging the lists they return.
4603 If one of these functions switches to a different buffer, we assume
4604 that buffer contains altered text. Therefore, the caller must
4605 make sure to restore the current buffer in all cases,
4606 as save-excursion would do. */
4609 build_annotations (start
, end
, pre_write_conversion
)
4610 Lisp_Object start
, end
, pre_write_conversion
;
4612 Lisp_Object annotations
;
4614 struct gcpro gcpro1
, gcpro2
;
4615 Lisp_Object original_buffer
;
4617 XSETBUFFER (original_buffer
, current_buffer
);
4620 p
= Vwrite_region_annotate_functions
;
4621 GCPRO2 (annotations
, p
);
4624 struct buffer
*given_buffer
= current_buffer
;
4625 Vwrite_region_annotations_so_far
= annotations
;
4626 res
= call2 (Fcar (p
), start
, end
);
4627 /* If the function makes a different buffer current,
4628 assume that means this buffer contains altered text to be output.
4629 Reset START and END from the buffer bounds
4630 and discard all previous annotations because they should have
4631 been dealt with by this function. */
4632 if (current_buffer
!= given_buffer
)
4634 XSETFASTINT (start
, BEGV
);
4635 XSETFASTINT (end
, ZV
);
4638 Flength (res
); /* Check basic validity of return value */
4639 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4643 /* Now do the same for annotation functions implied by the file-format */
4644 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4645 p
= Vauto_save_file_format
;
4647 p
= current_buffer
->file_format
;
4650 struct buffer
*given_buffer
= current_buffer
;
4651 Vwrite_region_annotations_so_far
= annotations
;
4652 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4654 if (current_buffer
!= given_buffer
)
4656 XSETFASTINT (start
, BEGV
);
4657 XSETFASTINT (end
, ZV
);
4661 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4665 /* At last, do the same for the function PRE_WRITE_CONVERSION
4666 implied by the current coding-system. */
4667 if (!NILP (pre_write_conversion
))
4669 struct buffer
*given_buffer
= current_buffer
;
4670 Vwrite_region_annotations_so_far
= annotations
;
4671 res
= call2 (pre_write_conversion
, start
, end
);
4673 annotations
= (current_buffer
!= given_buffer
4675 : merge (annotations
, res
, Qcar_less_than_car
));
4682 /* Write to descriptor DESC the NBYTES bytes starting at ADDR,
4683 assuming they start at byte position BYTEPOS in the buffer.
4684 Intersperse with them the annotations from *ANNOT
4685 which fall within the range of byte positions BYTEPOS to BYTEPOS + NBYTES,
4686 each at its appropriate position.
4688 We modify *ANNOT by discarding elements as we use them up.
4690 The return value is negative in case of system call failure. */
4693 a_write (desc
, addr
, nbytes
, bytepos
, annot
, coding
)
4695 register char *addr
;
4696 register int nbytes
;
4699 struct coding_system
*coding
;
4703 int lastpos
= bytepos
+ nbytes
;
4705 while (NILP (*annot
) || CONSP (*annot
))
4707 tem
= Fcar_safe (Fcar (*annot
));
4708 nextpos
= bytepos
- 1;
4710 nextpos
= CHAR_TO_BYTE (XFASTINT (tem
));
4712 /* If there are no more annotations in this range,
4713 output the rest of the range all at once. */
4714 if (! (nextpos
>= bytepos
&& nextpos
<= lastpos
))
4715 return e_write (desc
, addr
, lastpos
- bytepos
, coding
);
4717 /* Output buffer text up to the next annotation's position. */
4718 if (nextpos
> bytepos
)
4720 if (0 > e_write (desc
, addr
, nextpos
- bytepos
, coding
))
4722 addr
+= nextpos
- bytepos
;
4725 /* Output the annotation. */
4726 tem
= Fcdr (Fcar (*annot
));
4729 if (0 > e_write (desc
, XSTRING (tem
)->data
, STRING_BYTES (XSTRING (tem
)),
4733 *annot
= Fcdr (*annot
);
4738 #ifndef WRITE_BUF_SIZE
4739 #define WRITE_BUF_SIZE (16 * 1024)
4742 /* Write NBYTES bytes starting at ADDR into descriptor DESC,
4743 encoding them with coding system CODING. */
4746 e_write (desc
, addr
, nbytes
, coding
)
4748 register char *addr
;
4749 register int nbytes
;
4750 struct coding_system
*coding
;
4752 char buf
[WRITE_BUF_SIZE
];
4754 /* We used to have a code for handling selective display here. But,
4755 now it is handled within encode_coding. */
4758 encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
4759 nbytes
-= coding
->consumed
, addr
+= coding
->consumed
;
4760 if (coding
->produced
> 0)
4762 coding
->produced
-= write (desc
, buf
, coding
->produced
);
4763 if (coding
->produced
) return -1;
4771 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4772 Sverify_visited_file_modtime
, 1, 1, 0,
4773 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4774 This means that the file has not been changed since it was visited or saved.")
4780 Lisp_Object handler
;
4781 Lisp_Object filename
;
4783 CHECK_BUFFER (buf
, 0);
4786 if (!STRINGP (b
->filename
)) return Qt
;
4787 if (b
->modtime
== 0) return Qt
;
4789 /* If the file name has special constructs in it,
4790 call the corresponding file handler. */
4791 handler
= Ffind_file_name_handler (b
->filename
,
4792 Qverify_visited_file_modtime
);
4793 if (!NILP (handler
))
4794 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4796 filename
= ENCODE_FILE (b
->filename
);
4798 if (stat (XSTRING (filename
)->data
, &st
) < 0)
4800 /* If the file doesn't exist now and didn't exist before,
4801 we say that it isn't modified, provided the error is a tame one. */
4802 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4807 if (st
.st_mtime
== b
->modtime
4808 /* If both are positive, accept them if they are off by one second. */
4809 || (st
.st_mtime
> 0 && b
->modtime
> 0
4810 && (st
.st_mtime
== b
->modtime
+ 1
4811 || st
.st_mtime
== b
->modtime
- 1)))
4816 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4817 Sclear_visited_file_modtime
, 0, 0, 0,
4818 "Clear out records of last mod time of visited file.\n\
4819 Next attempt to save will certainly not complain of a discrepancy.")
4822 current_buffer
->modtime
= 0;
4826 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4827 Svisited_file_modtime
, 0, 0, 0,
4828 "Return the current buffer's recorded visited file modification time.\n\
4829 The value is a list of the form (HIGH . LOW), like the time values\n\
4830 that `file-attributes' returns.")
4833 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4836 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4837 Sset_visited_file_modtime
, 0, 1, 0,
4838 "Update buffer's recorded modification time from the visited file's time.\n\
4839 Useful if the buffer was not read from the file normally\n\
4840 or if the file itself has been changed for some known benign reason.\n\
4841 An argument specifies the modification time value to use\n\
4842 \(instead of that of the visited file), in the form of a list\n\
4843 \(HIGH . LOW) or (HIGH LOW).")
4845 Lisp_Object time_list
;
4847 if (!NILP (time_list
))
4848 current_buffer
->modtime
= cons_to_long (time_list
);
4851 register Lisp_Object filename
;
4853 Lisp_Object handler
;
4855 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4857 /* If the file name has special constructs in it,
4858 call the corresponding file handler. */
4859 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4860 if (!NILP (handler
))
4861 /* The handler can find the file name the same way we did. */
4862 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4864 filename
= ENCODE_FILE (filename
);
4866 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4867 current_buffer
->modtime
= st
.st_mtime
;
4877 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 1);
4878 Fsleep_for (make_number (1), Qnil
);
4879 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4880 Fsleep_for (make_number (1), Qnil
);
4881 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4882 Fsleep_for (make_number (1), Qnil
);
4892 /* Get visited file's mode to become the auto save file's mode. */
4893 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4894 /* But make sure we can overwrite it later! */
4895 auto_save_mode_bits
= st
.st_mode
| 0600;
4897 auto_save_mode_bits
= 0666;
4900 Fwrite_region (Qnil
, Qnil
,
4901 current_buffer
->auto_save_file_name
,
4902 Qnil
, Qlambda
, Qnil
, Qnil
);
4906 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4911 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4912 | XFASTINT (XCONS (stream
)->cdr
)));
4917 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4920 minibuffer_auto_raise
= XINT (value
);
4924 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4925 "Auto-save all buffers that need it.\n\
4926 This is all buffers that have auto-saving enabled\n\
4927 and are changed since last auto-saved.\n\
4928 Auto-saving writes the buffer into a file\n\
4929 so that your editing is not lost if the system crashes.\n\
4930 This file is not the file you visited; that changes only when you save.\n\
4931 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4932 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4933 A non-nil CURRENT-ONLY argument means save only current buffer.")
4934 (no_message
, current_only
)
4935 Lisp_Object no_message
, current_only
;
4937 struct buffer
*old
= current_buffer
, *b
;
4938 Lisp_Object tail
, buf
;
4940 char *omessage
= echo_area_glyphs
;
4941 int omessage_length
= echo_area_glyphs_length
;
4942 int oldmultibyte
= message_enable_multibyte
;
4943 int do_handled_files
;
4946 Lisp_Object lispstream
;
4947 int count
= specpdl_ptr
- specpdl
;
4949 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4951 /* Ordinarily don't quit within this function,
4952 but don't make it impossible to quit (in case we get hung in I/O). */
4956 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4957 point to non-strings reached from Vbuffer_alist. */
4962 if (!NILP (Vrun_hooks
))
4963 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4965 if (STRINGP (Vauto_save_list_file_name
))
4967 Lisp_Object listfile
;
4968 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4969 stream
= fopen (XSTRING (listfile
)->data
, "w");
4972 /* Arrange to close that file whether or not we get an error.
4973 Also reset auto_saving to 0. */
4974 lispstream
= Fcons (Qnil
, Qnil
);
4975 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
4976 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
4987 record_unwind_protect (do_auto_save_unwind
, lispstream
);
4988 record_unwind_protect (do_auto_save_unwind_1
,
4989 make_number (minibuffer_auto_raise
));
4990 minibuffer_auto_raise
= 0;
4993 /* First, save all files which don't have handlers. If Emacs is
4994 crashing, the handlers may tweak what is causing Emacs to crash
4995 in the first place, and it would be a shame if Emacs failed to
4996 autosave perfectly ordinary files because it couldn't handle some
4998 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4999 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
5001 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
5004 /* Record all the buffers that have auto save mode
5005 in the special file that lists them. For each of these buffers,
5006 Record visited name (if any) and auto save name. */
5007 if (STRINGP (b
->auto_save_file_name
)
5008 && stream
!= NULL
&& do_handled_files
== 0)
5010 if (!NILP (b
->filename
))
5012 fwrite (XSTRING (b
->filename
)->data
, 1,
5013 STRING_BYTES (XSTRING (b
->filename
)), stream
);
5015 putc ('\n', stream
);
5016 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
5017 STRING_BYTES (XSTRING (b
->auto_save_file_name
)), stream
);
5018 putc ('\n', stream
);
5021 if (!NILP (current_only
)
5022 && b
!= current_buffer
)
5025 /* Don't auto-save indirect buffers.
5026 The base buffer takes care of it. */
5030 /* Check for auto save enabled
5031 and file changed since last auto save
5032 and file changed since last real save. */
5033 if (STRINGP (b
->auto_save_file_name
)
5034 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5035 && b
->auto_save_modified
< BUF_MODIFF (b
)
5036 /* -1 means we've turned off autosaving for a while--see below. */
5037 && XINT (b
->save_length
) >= 0
5038 && (do_handled_files
5039 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5042 EMACS_TIME before_time
, after_time
;
5044 EMACS_GET_TIME (before_time
);
5046 /* If we had a failure, don't try again for 20 minutes. */
5047 if (b
->auto_save_failure_time
>= 0
5048 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5051 if ((XFASTINT (b
->save_length
) * 10
5052 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5053 /* A short file is likely to change a large fraction;
5054 spare the user annoying messages. */
5055 && XFASTINT (b
->save_length
) > 5000
5056 /* These messages are frequent and annoying for `*mail*'. */
5057 && !EQ (b
->filename
, Qnil
)
5058 && NILP (no_message
))
5060 /* It has shrunk too much; turn off auto-saving here. */
5061 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5062 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
5064 minibuffer_auto_raise
= 0;
5065 /* Turn off auto-saving until there's a real save,
5066 and prevent any more warnings. */
5067 XSETINT (b
->save_length
, -1);
5068 Fsleep_for (make_number (1), Qnil
);
5071 set_buffer_internal (b
);
5072 if (!auto_saved
&& NILP (no_message
))
5073 message1 ("Auto-saving...");
5074 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5076 b
->auto_save_modified
= BUF_MODIFF (b
);
5077 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5078 set_buffer_internal (old
);
5080 EMACS_GET_TIME (after_time
);
5082 /* If auto-save took more than 60 seconds,
5083 assume it was an NFS failure that got a timeout. */
5084 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5085 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5089 /* Prevent another auto save till enough input events come in. */
5090 record_auto_save ();
5092 if (auto_saved
&& NILP (no_message
))
5096 sit_for (1, 0, 0, 0, 0);
5097 message2 (omessage
, omessage_length
, oldmultibyte
);
5100 message1 ("Auto-saving...done");
5105 unbind_to (count
, Qnil
);
5109 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5110 Sset_buffer_auto_saved
, 0, 0, 0,
5111 "Mark current buffer as auto-saved with its current text.\n\
5112 No auto-save file will be written until the buffer changes again.")
5115 current_buffer
->auto_save_modified
= MODIFF
;
5116 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5117 current_buffer
->auto_save_failure_time
= -1;
5121 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5122 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5123 "Clear any record of a recent auto-save failure in the current buffer.")
5126 current_buffer
->auto_save_failure_time
= -1;
5130 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5132 "Return t if buffer has been auto-saved since last read in or saved.")
5135 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5138 /* Reading and completing file names */
5139 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5141 /* In the string VAL, change each $ to $$ and return the result. */
5144 double_dollars (val
)
5147 register unsigned char *old
, *new;
5151 osize
= STRING_BYTES (XSTRING (val
));
5153 /* Count the number of $ characters. */
5154 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
5155 if (*old
++ == '$') count
++;
5158 old
= XSTRING (val
)->data
;
5159 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
5161 new = XSTRING (val
)->data
;
5162 for (n
= osize
; n
> 0; n
--)
5175 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5177 "Internal subroutine for read-file-name. Do not call this.")
5178 (string
, dir
, action
)
5179 Lisp_Object string
, dir
, action
;
5180 /* action is nil for complete, t for return list of completions,
5181 lambda for verify final value */
5183 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5185 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5187 CHECK_STRING (string
, 0);
5194 /* No need to protect ACTION--we only compare it with t and nil. */
5195 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5197 if (XSTRING (string
)->size
== 0)
5199 if (EQ (action
, Qlambda
))
5207 orig_string
= string
;
5208 string
= Fsubstitute_in_file_name (string
);
5209 changed
= NILP (Fstring_equal (string
, orig_string
));
5210 name
= Ffile_name_nondirectory (string
);
5211 val
= Ffile_name_directory (string
);
5213 realdir
= Fexpand_file_name (val
, realdir
);
5218 specdir
= Ffile_name_directory (string
);
5219 val
= Ffile_name_completion (name
, realdir
);
5224 return double_dollars (string
);
5228 if (!NILP (specdir
))
5229 val
= concat2 (specdir
, val
);
5231 return double_dollars (val
);
5234 #endif /* not VMS */
5238 if (EQ (action
, Qt
))
5239 return Ffile_name_all_completions (name
, realdir
);
5240 /* Only other case actually used is ACTION = lambda */
5242 /* Supposedly this helps commands such as `cd' that read directory names,
5243 but can someone explain how it helps them? -- RMS */
5244 if (XSTRING (name
)->size
== 0)
5247 return Ffile_exists_p (string
);
5250 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5251 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5252 Value is not expanded---you must call `expand-file-name' yourself.\n\
5253 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5254 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5255 except that if INITIAL is specified, that combined with DIR is used.)\n\
5256 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5257 Non-nil and non-t means also require confirmation after completion.\n\
5258 Fifth arg INITIAL specifies text to start with.\n\
5259 DIR defaults to current buffer's directory default.")
5260 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5261 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5263 Lisp_Object val
, insdef
, insdef1
, tem
;
5264 struct gcpro gcpro1
, gcpro2
;
5265 register char *homedir
;
5266 int replace_in_history
= 0;
5267 int add_to_history
= 0;
5271 dir
= current_buffer
->directory
;
5272 if (NILP (default_filename
))
5274 if (! NILP (initial
))
5275 default_filename
= Fexpand_file_name (initial
, dir
);
5277 default_filename
= current_buffer
->filename
;
5280 /* If dir starts with user's homedir, change that to ~. */
5281 homedir
= (char *) egetenv ("HOME");
5283 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5284 CORRECT_DIR_SEPS (homedir
);
5288 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5289 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5291 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5292 STRING_BYTES (XSTRING (dir
)) - strlen (homedir
) + 1);
5293 XSTRING (dir
)->data
[0] = '~';
5296 if (insert_default_directory
&& STRINGP (dir
))
5299 if (!NILP (initial
))
5301 Lisp_Object args
[2], pos
;
5305 insdef
= Fconcat (2, args
);
5306 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5307 insdef1
= Fcons (double_dollars (insdef
), pos
);
5310 insdef1
= double_dollars (insdef
);
5312 else if (STRINGP (initial
))
5315 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
5318 insdef
= Qnil
, insdef1
= Qnil
;
5321 count
= specpdl_ptr
- specpdl
;
5322 specbind (intern ("completion-ignore-case"), Qt
);
5325 GCPRO2 (insdef
, default_filename
);
5326 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5327 dir
, mustmatch
, insdef1
,
5328 Qfile_name_history
, default_filename
, Qnil
);
5330 tem
= Fsymbol_value (Qfile_name_history
);
5331 if (CONSP (tem
) && EQ (XCONS (tem
)->car
, val
))
5332 replace_in_history
= 1;
5334 /* If Fcompleting_read returned the inserted default string itself
5335 (rather than a new string with the same contents),
5336 it has to mean that the user typed RET with the minibuffer empty.
5337 In that case, we really want to return ""
5338 so that commands such as set-visited-file-name can distinguish. */
5339 if (EQ (val
, default_filename
))
5341 /* In this case, Fcompleting_read has not added an element
5342 to the history. Maybe we should. */
5343 if (! replace_in_history
)
5346 val
= build_string ("");
5350 unbind_to (count
, Qnil
);
5355 error ("No file name specified");
5357 tem
= Fstring_equal (val
, insdef
);
5359 if (!NILP (tem
) && !NILP (default_filename
))
5360 val
= default_filename
;
5361 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5363 if (!NILP (default_filename
))
5364 val
= default_filename
;
5366 error ("No default file name");
5368 val
= Fsubstitute_in_file_name (val
);
5370 if (replace_in_history
)
5371 /* Replace what Fcompleting_read added to the history
5372 with what we will actually return. */
5373 XCONS (Fsymbol_value (Qfile_name_history
))->car
= val
;
5374 else if (add_to_history
)
5376 /* Add the value to the history--but not if it matches
5377 the last value already there. */
5378 tem
= Fsymbol_value (Qfile_name_history
);
5379 if (! CONSP (tem
) || NILP (Fequal (XCONS (tem
)->car
, val
)))
5380 Fset (Qfile_name_history
,
5389 Qexpand_file_name
= intern ("expand-file-name");
5390 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5391 Qdirectory_file_name
= intern ("directory-file-name");
5392 Qfile_name_directory
= intern ("file-name-directory");
5393 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5394 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5395 Qfile_name_as_directory
= intern ("file-name-as-directory");
5396 Qcopy_file
= intern ("copy-file");
5397 Qmake_directory_internal
= intern ("make-directory-internal");
5398 Qdelete_directory
= intern ("delete-directory");
5399 Qdelete_file
= intern ("delete-file");
5400 Qrename_file
= intern ("rename-file");
5401 Qadd_name_to_file
= intern ("add-name-to-file");
5402 Qmake_symbolic_link
= intern ("make-symbolic-link");
5403 Qfile_exists_p
= intern ("file-exists-p");
5404 Qfile_executable_p
= intern ("file-executable-p");
5405 Qfile_readable_p
= intern ("file-readable-p");
5406 Qfile_writable_p
= intern ("file-writable-p");
5407 Qfile_symlink_p
= intern ("file-symlink-p");
5408 Qaccess_file
= intern ("access-file");
5409 Qfile_directory_p
= intern ("file-directory-p");
5410 Qfile_regular_p
= intern ("file-regular-p");
5411 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5412 Qfile_modes
= intern ("file-modes");
5413 Qset_file_modes
= intern ("set-file-modes");
5414 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5415 Qinsert_file_contents
= intern ("insert-file-contents");
5416 Qwrite_region
= intern ("write-region");
5417 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5418 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5420 staticpro (&Qexpand_file_name
);
5421 staticpro (&Qsubstitute_in_file_name
);
5422 staticpro (&Qdirectory_file_name
);
5423 staticpro (&Qfile_name_directory
);
5424 staticpro (&Qfile_name_nondirectory
);
5425 staticpro (&Qunhandled_file_name_directory
);
5426 staticpro (&Qfile_name_as_directory
);
5427 staticpro (&Qcopy_file
);
5428 staticpro (&Qmake_directory_internal
);
5429 staticpro (&Qdelete_directory
);
5430 staticpro (&Qdelete_file
);
5431 staticpro (&Qrename_file
);
5432 staticpro (&Qadd_name_to_file
);
5433 staticpro (&Qmake_symbolic_link
);
5434 staticpro (&Qfile_exists_p
);
5435 staticpro (&Qfile_executable_p
);
5436 staticpro (&Qfile_readable_p
);
5437 staticpro (&Qfile_writable_p
);
5438 staticpro (&Qaccess_file
);
5439 staticpro (&Qfile_symlink_p
);
5440 staticpro (&Qfile_directory_p
);
5441 staticpro (&Qfile_regular_p
);
5442 staticpro (&Qfile_accessible_directory_p
);
5443 staticpro (&Qfile_modes
);
5444 staticpro (&Qset_file_modes
);
5445 staticpro (&Qfile_newer_than_file_p
);
5446 staticpro (&Qinsert_file_contents
);
5447 staticpro (&Qwrite_region
);
5448 staticpro (&Qverify_visited_file_modtime
);
5449 staticpro (&Qset_visited_file_modtime
);
5451 Qfile_name_history
= intern ("file-name-history");
5452 Fset (Qfile_name_history
, Qnil
);
5453 staticpro (&Qfile_name_history
);
5455 Qfile_error
= intern ("file-error");
5456 staticpro (&Qfile_error
);
5457 Qfile_already_exists
= intern ("file-already-exists");
5458 staticpro (&Qfile_already_exists
);
5459 Qfile_date_error
= intern ("file-date-error");
5460 staticpro (&Qfile_date_error
);
5463 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5464 staticpro (&Qfind_buffer_file_type
);
5467 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5468 "*Coding system for encoding file names.\n\
5469 If it is nil, default-file-name-coding-system (which see) is used.");
5470 Vfile_name_coding_system
= Qnil
;
5472 DEFVAR_LISP ("default-file-name-coding-system",
5473 &Vdefault_file_name_coding_system
,
5474 "Default coding system for encoding file names.\n\
5475 This variable is used only when file-name-coding-system is nil.\n\
5477 This variable is set/changed by the command set-language-environment.\n\
5478 User should not set this variable manually,\n\
5479 instead use file-name-coding-system to get a constant encoding\n\
5480 of file names regardless of the current language environment.");
5481 Vdefault_file_name_coding_system
= Qnil
;
5483 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5484 "*Format in which to write auto-save files.\n\
5485 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5486 If it is t, which is the default, auto-save files are written in the\n\
5487 same format as a regular save would use.");
5488 Vauto_save_file_format
= Qt
;
5490 Qformat_decode
= intern ("format-decode");
5491 staticpro (&Qformat_decode
);
5492 Qformat_annotate_function
= intern ("format-annotate-function");
5493 staticpro (&Qformat_annotate_function
);
5495 Qcar_less_than_car
= intern ("car-less-than-car");
5496 staticpro (&Qcar_less_than_car
);
5498 Fput (Qfile_error
, Qerror_conditions
,
5499 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5500 Fput (Qfile_error
, Qerror_message
,
5501 build_string ("File error"));
5503 Fput (Qfile_already_exists
, Qerror_conditions
,
5504 Fcons (Qfile_already_exists
,
5505 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5506 Fput (Qfile_already_exists
, Qerror_message
,
5507 build_string ("File already exists"));
5509 Fput (Qfile_date_error
, Qerror_conditions
,
5510 Fcons (Qfile_date_error
,
5511 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5512 Fput (Qfile_date_error
, Qerror_message
,
5513 build_string ("Cannot set file date"));
5515 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5516 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5517 insert_default_directory
= 1;
5519 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5520 "*Non-nil means write new files with record format `stmlf'.\n\
5521 nil means use format `var'. This variable is meaningful only on VMS.");
5522 vms_stmlf_recfm
= 0;
5524 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5525 "Directory separator character for built-in functions that return file names.\n\
5526 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5527 This variable affects the built-in functions only on Windows,\n\
5528 on other platforms, it is initialized so that Lisp code can find out\n\
5529 what the normal separator is.");
5530 XSETFASTINT (Vdirectory_sep_char
, '/');
5532 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5533 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5534 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5537 The first argument given to HANDLER is the name of the I/O primitive\n\
5538 to be handled; the remaining arguments are the arguments that were\n\
5539 passed to that primitive. For example, if you do\n\
5540 (file-exists-p FILENAME)\n\
5541 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5542 (funcall HANDLER 'file-exists-p FILENAME)\n\
5543 The function `find-file-name-handler' checks this list for a handler\n\
5544 for its argument.");
5545 Vfile_name_handler_alist
= Qnil
;
5547 DEFVAR_LISP ("set-auto-coding-function",
5548 &Vset_auto_coding_function
,
5549 "If non-nil, a function to call to decide a coding system of file.\n\
5550 One argument is passed to this function: the string of concatination\n\
5551 or the heading 1K-byte and the tailing 3K-byte of a file to be read.\n\
5552 This function should return a coding system to decode the file contents\n\
5553 specified in the heading lines with the format:\n\
5554 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5555 or local variable spec of the tailing lines with `coding:' tag.");
5556 Vset_auto_coding_function
= Qnil
;
5558 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5559 "A list of functions to be called at the end of `insert-file-contents'.\n\
5560 Each is passed one argument, the number of bytes inserted. It should return\n\
5561 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5562 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5563 responsible for calling the after-insert-file-functions if appropriate.");
5564 Vafter_insert_file_functions
= Qnil
;
5566 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5567 "A list of functions to be called at the start of `write-region'.\n\
5568 Each is passed two arguments, START and END as for `write-region'.\n\
5569 These are usually two numbers but not always; see the documentation\n\
5570 for `write-region'. The function should return a list of pairs\n\
5571 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5572 inserted at the specified positions of the file being written (1 means to\n\
5573 insert before the first byte written). The POSITIONs must be sorted into\n\
5574 increasing order. If there are several functions in the list, the several\n\
5575 lists are merged destructively.");
5576 Vwrite_region_annotate_functions
= Qnil
;
5578 DEFVAR_LISP ("write-region-annotations-so-far",
5579 &Vwrite_region_annotations_so_far
,
5580 "When an annotation function is called, this holds the previous annotations.\n\
5581 These are the annotations made by other annotation functions\n\
5582 that were already called. See also `write-region-annotate-functions'.");
5583 Vwrite_region_annotations_so_far
= Qnil
;
5585 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5586 "A list of file name handlers that temporarily should not be used.\n\
5587 This applies only to the operation `inhibit-file-name-operation'.");
5588 Vinhibit_file_name_handlers
= Qnil
;
5590 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5591 "The operation for which `inhibit-file-name-handlers' is applicable.");
5592 Vinhibit_file_name_operation
= Qnil
;
5594 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5595 "File name in which we write a list of all auto save file names.\n\
5596 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5597 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5599 Vauto_save_list_file_name
= Qnil
;
5601 defsubr (&Sfind_file_name_handler
);
5602 defsubr (&Sfile_name_directory
);
5603 defsubr (&Sfile_name_nondirectory
);
5604 defsubr (&Sunhandled_file_name_directory
);
5605 defsubr (&Sfile_name_as_directory
);
5606 defsubr (&Sdirectory_file_name
);
5607 defsubr (&Smake_temp_name
);
5608 defsubr (&Sexpand_file_name
);
5609 defsubr (&Ssubstitute_in_file_name
);
5610 defsubr (&Scopy_file
);
5611 defsubr (&Smake_directory_internal
);
5612 defsubr (&Sdelete_directory
);
5613 defsubr (&Sdelete_file
);
5614 defsubr (&Srename_file
);
5615 defsubr (&Sadd_name_to_file
);
5617 defsubr (&Smake_symbolic_link
);
5618 #endif /* S_IFLNK */
5620 defsubr (&Sdefine_logical_name
);
5623 defsubr (&Ssysnetunam
);
5624 #endif /* HPUX_NET */
5625 defsubr (&Sfile_name_absolute_p
);
5626 defsubr (&Sfile_exists_p
);
5627 defsubr (&Sfile_executable_p
);
5628 defsubr (&Sfile_readable_p
);
5629 defsubr (&Sfile_writable_p
);
5630 defsubr (&Saccess_file
);
5631 defsubr (&Sfile_symlink_p
);
5632 defsubr (&Sfile_directory_p
);
5633 defsubr (&Sfile_accessible_directory_p
);
5634 defsubr (&Sfile_regular_p
);
5635 defsubr (&Sfile_modes
);
5636 defsubr (&Sset_file_modes
);
5637 defsubr (&Sset_default_file_modes
);
5638 defsubr (&Sdefault_file_modes
);
5639 defsubr (&Sfile_newer_than_file_p
);
5640 defsubr (&Sinsert_file_contents
);
5641 defsubr (&Swrite_region
);
5642 defsubr (&Scar_less_than_car
);
5643 defsubr (&Sverify_visited_file_modtime
);
5644 defsubr (&Sclear_visited_file_modtime
);
5645 defsubr (&Svisited_file_modtime
);
5646 defsubr (&Sset_visited_file_modtime
);
5647 defsubr (&Sdo_auto_save
);
5648 defsubr (&Sset_buffer_auto_saved
);
5649 defsubr (&Sclear_buffer_auto_save_failure
);
5650 defsubr (&Srecent_auto_save_p
);
5652 defsubr (&Sread_file_name_internal
);
5653 defsubr (&Sread_file_name
);
5656 defsubr (&Sunix_sync
);