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 /* This function is called when a function bound to
3250 Vset_auto_coding_function causes some error. At that time, a text
3251 of a file has already been inserted in the current buffer, but,
3252 markers has not yet been adjusted. Thus we must adjust markers
3253 here. We are sure that the buffer was empty before the text of the
3254 file was inserted. */
3257 set_auto_coding_unwind (multibyte
)
3258 Lisp_Object multibyte
;
3260 int inserted
= Z_BYTE
- BEG_BYTE
;
3262 if (!NILP (multibyte
))
3263 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
3264 adjust_after_insert (PT
, PT_BYTE
, Z
, Z_BYTE
, inserted
);
3269 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3271 "Insert contents of file FILENAME after point.\n\
3272 Returns list of absolute file name and number of bytes inserted.\n\
3273 If second argument VISIT is non-nil, the buffer's visited filename\n\
3274 and last save file modtime are set, and it is marked unmodified.\n\
3275 If visiting and the file does not exist, visiting is completed\n\
3276 before the error is signaled.\n\
3277 The optional third and fourth arguments BEG and END\n\
3278 specify what portion of the file to insert.\n\
3279 These arguments count bytes in the file, not characters in the buffer.\n\
3280 If VISIT is non-nil, BEG and END must be nil.\n\
3282 If optional fifth argument REPLACE is non-nil,\n\
3283 it means replace the current buffer contents (in the accessible portion)\n\
3284 with the file contents. This is better than simply deleting and inserting\n\
3285 the whole thing because (1) it preserves some marker positions\n\
3286 and (2) it puts less data in the undo list.\n\
3287 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3288 which is often less than the number of characters to be read.\n\
3290 This does code conversion according to the value of\n\
3291 `coding-system-for-read' or `file-coding-system-alist',\n\
3292 and sets the variable `last-coding-system-used' to the coding system\n\
3294 (filename
, visit
, beg
, end
, replace
)
3295 Lisp_Object filename
, visit
, beg
, end
, replace
;
3300 register int how_much
;
3301 register int unprocessed
;
3302 int count
= specpdl_ptr
- specpdl
;
3303 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3304 Lisp_Object handler
, val
, insval
, orig_filename
;
3307 int not_regular
= 0;
3308 unsigned char read_buf
[READ_BUF_SIZE
];
3309 struct coding_system coding
;
3310 unsigned char buffer
[1 << 14];
3311 int replace_handled
= 0;
3312 int set_coding_system
= 0;
3313 int coding_system_decided
= 0;
3315 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3316 error ("Cannot do file visiting in an indirect buffer");
3318 if (!NILP (current_buffer
->read_only
))
3319 Fbarf_if_buffer_read_only ();
3323 orig_filename
= Qnil
;
3325 GCPRO4 (filename
, val
, p
, orig_filename
);
3327 CHECK_STRING (filename
, 0);
3328 filename
= Fexpand_file_name (filename
, Qnil
);
3330 /* If the file name has special constructs in it,
3331 call the corresponding file handler. */
3332 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3333 if (!NILP (handler
))
3335 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3336 visit
, beg
, end
, replace
);
3340 orig_filename
= filename
;
3341 filename
= ENCODE_FILE (filename
);
3346 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3348 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3349 || fstat (fd
, &st
) < 0)
3350 #endif /* not APOLLO */
3352 if (fd
>= 0) close (fd
);
3355 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3358 if (!NILP (Vcoding_system_for_read
))
3359 current_buffer
->buffer_file_coding_system
= Vcoding_system_for_read
;
3364 /* This code will need to be changed in order to work on named
3365 pipes, and it's probably just not worth it. So we should at
3366 least signal an error. */
3367 if (!S_ISREG (st
.st_mode
))
3374 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3375 Fsignal (Qfile_error
,
3376 Fcons (build_string ("not a regular file"),
3377 Fcons (orig_filename
, Qnil
)));
3382 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3385 /* Replacement should preserve point as it preserves markers. */
3386 if (!NILP (replace
))
3387 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3389 record_unwind_protect (close_file_unwind
, make_number (fd
));
3391 /* Supposedly happens on VMS. */
3392 if (! not_regular
&& st
.st_size
< 0)
3393 error ("File size is negative");
3395 if (!NILP (beg
) || !NILP (end
))
3397 error ("Attempt to visit less than an entire file");
3400 CHECK_NUMBER (beg
, 0);
3402 XSETFASTINT (beg
, 0);
3405 CHECK_NUMBER (end
, 0);
3410 XSETINT (end
, st
.st_size
);
3411 if (XINT (end
) != st
.st_size
)
3412 error ("Maximum buffer size exceeded");
3418 /* Decide the coding system to use for reading the file now
3419 because we can't use an optimized method for handling
3420 `coding:' tag if the current buffer is not empty. */
3424 if (!NILP (Vcoding_system_for_read
))
3425 val
= Vcoding_system_for_read
;
3426 else if (! NILP (replace
))
3427 /* In REPLACE mode, we can use the same coding system
3428 that was used to visit the file. */
3429 val
= current_buffer
->buffer_file_coding_system
;
3432 /* Don't try looking inside a file for a coding system
3433 specification if it is not seekable. */
3434 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3436 /* Find a coding system specified in the heading two
3437 lines or in the tailing several lines of the file.
3438 We assume that the 1K-byte and 3K-byte for heading
3439 and tailing respectively are sufficient fot this
3441 int how_many
, nread
;
3443 if (st
.st_size
<= (1024 * 4))
3444 nread
= read (fd
, read_buf
, 1024 * 4);
3447 nread
= read (fd
, read_buf
, 1024);
3450 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3451 report_file_error ("Setting file position",
3452 Fcons (orig_filename
, Qnil
));
3453 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3458 error ("IO error reading %s: %s",
3459 XSTRING (orig_filename
)->data
, strerror (errno
));
3462 int count
= specpdl_ptr
- specpdl
;
3463 struct buffer
*prev
= current_buffer
;
3465 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3466 temp_output_buffer_setup (" *code-converting-work*");
3467 set_buffer_internal (XBUFFER (Vstandard_output
));
3468 current_buffer
->enable_multibyte_characters
= Qnil
;
3469 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3470 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3471 val
= call1 (Vset_auto_coding_function
, make_number (nread
));
3472 set_buffer_internal (prev
);
3473 /* Discard the unwind protect for recovering the
3477 /* Rewind the file for the actual read done later. */
3478 if (lseek (fd
, 0, 0) < 0)
3479 report_file_error ("Setting file position",
3480 Fcons (orig_filename
, Qnil
));
3486 /* If we have not yet decided a coding system, check
3487 file-coding-system-alist. */
3488 Lisp_Object args
[6], coding_systems
;
3490 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3491 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3492 coding_systems
= Ffind_operation_coding_system (6, args
);
3493 if (CONSP (coding_systems
))
3494 val
= XCONS (coding_systems
)->car
;
3498 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3500 if (NILP (Vcoding_system_for_read
)
3501 && NILP (current_buffer
->enable_multibyte_characters
))
3503 /* We must suppress all text conversion except for end-of-line
3507 eol_type
= coding
.eol_type
;
3508 setup_coding_system (Qraw_text
, &coding
);
3509 coding
.eol_type
= eol_type
;
3512 coding_system_decided
= 1;
3515 /* Ensure we always set Vlast_coding_system_used. */
3516 set_coding_system
= 1;
3518 /* If requested, replace the accessible part of the buffer
3519 with the file contents. Avoid replacing text at the
3520 beginning or end of the buffer that matches the file contents;
3521 that preserves markers pointing to the unchanged parts.
3523 Here we implement this feature in an optimized way
3524 for the case where code conversion is NOT needed.
3525 The following if-statement handles the case of conversion
3526 in a less optimal way.
3528 If the code conversion is "automatic" then we try using this
3529 method and hope for the best.
3530 But if we discover the need for conversion, we give up on this method
3531 and let the following if-statement handle the replace job. */
3534 && ! CODING_REQUIRE_DECODING (&coding
)
3535 && (coding
.eol_type
== CODING_EOL_UNDECIDED
3536 || coding
.eol_type
== CODING_EOL_LF
))
3538 /* same_at_start and same_at_end count bytes,
3539 because file access counts bytes
3540 and BEG and END count bytes. */
3541 int same_at_start
= BEGV_BYTE
;
3542 int same_at_end
= ZV_BYTE
;
3544 /* There is still a possibility we will find the need to do code
3545 conversion. If that happens, we set this variable to 1 to
3546 give up on handling REPLACE in the optimized way. */
3547 int giveup_match_end
= 0;
3549 if (XINT (beg
) != 0)
3551 if (lseek (fd
, XINT (beg
), 0) < 0)
3552 report_file_error ("Setting file position",
3553 Fcons (orig_filename
, Qnil
));
3558 /* Count how many chars at the start of the file
3559 match the text at the beginning of the buffer. */
3564 nread
= read (fd
, buffer
, sizeof buffer
);
3566 error ("IO error reading %s: %s",
3567 XSTRING (orig_filename
)->data
, strerror (errno
));
3568 else if (nread
== 0)
3571 if (coding
.type
== coding_type_undecided
)
3572 detect_coding (&coding
, buffer
, nread
);
3573 if (CODING_REQUIRE_DECODING (&coding
))
3574 /* We found that the file should be decoded somehow.
3575 Let's give up here. */
3577 giveup_match_end
= 1;
3581 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3582 detect_eol (&coding
, buffer
, nread
);
3583 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3584 && coding
.eol_type
!= CODING_EOL_LF
)
3585 /* We found that the format of eol should be decoded.
3586 Let's give up here. */
3588 giveup_match_end
= 1;
3593 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3594 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3595 same_at_start
++, bufpos
++;
3596 /* If we found a discrepancy, stop the scan.
3597 Otherwise loop around and scan the next bufferful. */
3598 if (bufpos
!= nread
)
3602 /* If the file matches the buffer completely,
3603 there's no need to replace anything. */
3604 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3608 /* Truncate the buffer to the size of the file. */
3609 del_range_1 (same_at_start
, same_at_end
, 0);
3614 /* Count how many chars at the end of the file
3615 match the text at the end of the buffer. But, if we have
3616 already found that decoding is necessary, don't waste time. */
3617 while (!giveup_match_end
)
3619 int total_read
, nread
, bufpos
, curpos
, trial
;
3621 /* At what file position are we now scanning? */
3622 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3623 /* If the entire file matches the buffer tail, stop the scan. */
3626 /* How much can we scan in the next step? */
3627 trial
= min (curpos
, sizeof buffer
);
3628 if (lseek (fd
, curpos
- trial
, 0) < 0)
3629 report_file_error ("Setting file position",
3630 Fcons (orig_filename
, Qnil
));
3633 while (total_read
< trial
)
3635 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3637 error ("IO error reading %s: %s",
3638 XSTRING (orig_filename
)->data
, strerror (errno
));
3639 total_read
+= nread
;
3641 /* Scan this bufferful from the end, comparing with
3642 the Emacs buffer. */
3643 bufpos
= total_read
;
3644 /* Compare with same_at_start to avoid counting some buffer text
3645 as matching both at the file's beginning and at the end. */
3646 while (bufpos
> 0 && same_at_end
> same_at_start
3647 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3648 same_at_end
--, bufpos
--;
3650 /* If we found a discrepancy, stop the scan.
3651 Otherwise loop around and scan the preceding bufferful. */
3654 /* If this discrepancy is because of code conversion,
3655 we cannot use this method; giveup and try the other. */
3656 if (same_at_end
> same_at_start
3657 && FETCH_BYTE (same_at_end
- 1) >= 0200
3658 && ! NILP (current_buffer
->enable_multibyte_characters
)
3659 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3660 giveup_match_end
= 1;
3666 if (! giveup_match_end
)
3670 /* We win! We can handle REPLACE the optimized way. */
3672 /* Extends the end of non-matching text area to multibyte
3673 character boundary. */
3674 if (! NILP (current_buffer
->enable_multibyte_characters
))
3675 while (same_at_end
< ZV_BYTE
3676 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3679 /* Don't try to reuse the same piece of text twice. */
3680 overlap
= (same_at_start
- BEGV_BYTE
3681 - (same_at_end
+ st
.st_size
- ZV
));
3683 same_at_end
+= overlap
;
3685 /* Arrange to read only the nonmatching middle part of the file. */
3686 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3687 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3689 del_range_byte (same_at_start
, same_at_end
, 0);
3690 /* Insert from the file at the proper position. */
3691 temp
= BYTE_TO_CHAR (same_at_start
);
3692 SET_PT_BOTH (temp
, same_at_start
);
3694 /* If display currently starts at beginning of line,
3695 keep it that way. */
3696 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3697 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3699 replace_handled
= 1;
3703 /* If requested, replace the accessible part of the buffer
3704 with the file contents. Avoid replacing text at the
3705 beginning or end of the buffer that matches the file contents;
3706 that preserves markers pointing to the unchanged parts.
3708 Here we implement this feature for the case where code conversion
3709 is needed, in a simple way that needs a lot of memory.
3710 The preceding if-statement handles the case of no conversion
3711 in a more optimized way. */
3712 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3714 int same_at_start
= BEGV_BYTE
;
3715 int same_at_end
= ZV_BYTE
;
3718 /* Make sure that the gap is large enough. */
3719 int bufsize
= 2 * st
.st_size
;
3720 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3723 /* First read the whole file, performing code conversion into
3724 CONVERSION_BUFFER. */
3726 if (lseek (fd
, XINT (beg
), 0) < 0)
3728 free (conversion_buffer
);
3729 report_file_error ("Setting file position",
3730 Fcons (orig_filename
, Qnil
));
3733 total
= st
.st_size
; /* Total bytes in the file. */
3734 how_much
= 0; /* Bytes read from file so far. */
3735 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3736 unprocessed
= 0; /* Bytes not processed in previous loop. */
3738 while (how_much
< total
)
3740 /* try is reserved in some compilers (Microsoft C) */
3741 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3742 unsigned char *destination
= read_buf
+ unprocessed
;
3745 /* Allow quitting out of the actual I/O. */
3748 this = read (fd
, destination
, trytry
);
3751 if (this < 0 || this + unprocessed
== 0)
3759 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3761 int require
, result
;
3763 this += unprocessed
;
3765 /* If we are using more space than estimated,
3766 make CONVERSION_BUFFER bigger. */
3767 require
= decoding_buffer_size (&coding
, this);
3768 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3770 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3771 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3774 /* Convert this batch with results in CONVERSION_BUFFER. */
3775 if (how_much
>= total
) /* This is the last block. */
3776 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3777 result
= decode_coding (&coding
, read_buf
,
3778 conversion_buffer
+ inserted
,
3779 this, bufsize
- inserted
);
3781 /* Save for next iteration whatever we didn't convert. */
3782 unprocessed
= this - coding
.consumed
;
3783 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
3784 this = coding
.produced
;
3790 /* At this point, INSERTED is how many characters (i.e. bytes)
3791 are present in CONVERSION_BUFFER.
3792 HOW_MUCH should equal TOTAL,
3793 or should be <= 0 if we couldn't read the file. */
3797 free (conversion_buffer
);
3800 error ("IO error reading %s: %s",
3801 XSTRING (orig_filename
)->data
, strerror (errno
));
3802 else if (how_much
== -2)
3803 error ("maximum buffer size exceeded");
3806 /* Compare the beginning of the converted file
3807 with the buffer text. */
3810 while (bufpos
< inserted
&& same_at_start
< same_at_end
3811 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3812 same_at_start
++, bufpos
++;
3814 /* If the file matches the buffer completely,
3815 there's no need to replace anything. */
3817 if (bufpos
== inserted
)
3819 free (conversion_buffer
);
3822 /* Truncate the buffer to the size of the file. */
3823 del_range_1 (same_at_start
, same_at_end
, 0);
3827 /* Scan this bufferful from the end, comparing with
3828 the Emacs buffer. */
3831 /* Compare with same_at_start to avoid counting some buffer text
3832 as matching both at the file's beginning and at the end. */
3833 while (bufpos
> 0 && same_at_end
> same_at_start
3834 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3835 same_at_end
--, bufpos
--;
3837 /* Don't try to reuse the same piece of text twice. */
3838 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3840 same_at_end
+= overlap
;
3842 /* If display currently starts at beginning of line,
3843 keep it that way. */
3844 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3845 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3847 /* Replace the chars that we need to replace,
3848 and update INSERTED to equal the number of bytes
3849 we are taking from the file. */
3850 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
3851 del_range_byte (same_at_start
, same_at_end
, 0);
3852 if (same_at_end
!= same_at_start
)
3853 SET_PT_BOTH (GPT
, GPT_BYTE
);
3856 /* Insert from the file at the proper position. */
3857 temp
= BYTE_TO_CHAR (same_at_start
);
3858 SET_PT_BOTH (temp
, same_at_start
);
3861 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
3864 free (conversion_buffer
);
3873 register Lisp_Object temp
;
3875 total
= XINT (end
) - XINT (beg
);
3877 /* Make sure point-max won't overflow after this insertion. */
3878 XSETINT (temp
, total
);
3879 if (total
!= XINT (temp
))
3880 error ("Maximum buffer size exceeded");
3883 /* For a special file, all we can do is guess. */
3884 total
= READ_BUF_SIZE
;
3886 if (NILP (visit
) && total
> 0)
3887 prepare_to_modify_buffer (PT
, PT
, NULL
);
3890 if (GAP_SIZE
< total
)
3891 make_gap (total
- GAP_SIZE
);
3893 if (XINT (beg
) != 0 || !NILP (replace
))
3895 if (lseek (fd
, XINT (beg
), 0) < 0)
3896 report_file_error ("Setting file position",
3897 Fcons (orig_filename
, Qnil
));
3900 /* In the following loop, HOW_MUCH contains the total bytes read so
3901 far for a regular file, and not changed for a special file. But,
3902 before exiting the loop, it is set to a negative value if I/O
3905 /* Total bytes inserted. */
3907 /* Here, we don't do code conversion in the loop. It is done by
3908 code_convert_region after all data are read into the buffer. */
3909 while (how_much
< total
)
3911 /* try is reserved in some compilers (Microsoft C) */
3912 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3915 /* For a special file, GAP_SIZE should be checked every time. */
3916 if (not_regular
&& GAP_SIZE
< trytry
)
3917 make_gap (total
- GAP_SIZE
);
3919 /* Allow quitting out of the actual I/O. */
3922 this = read (fd
, BYTE_POS_ADDR (PT_BYTE
+ inserted
- 1) + 1, trytry
);
3939 /* For a regular file, where TOTAL is the real size,
3940 count HOW_MUCH to compare with it.
3941 For a special file, where TOTAL is just a buffer size,
3942 so don't bother counting in HOW_MUCH.
3943 (INSERTED is where we count the number of characters inserted.) */
3950 /* Put an anchor to ensure multi-byte form ends at gap. */
3955 /* Discard the unwind protect for closing the file. */
3959 error ("IO error reading %s: %s",
3960 XSTRING (orig_filename
)->data
, strerror (errno
));
3964 if (! coding_system_decided
)
3966 /* The coding system is not yet decided. Decide it by an
3967 optimized method for handling `coding:' tag. */
3971 if (!NILP (Vcoding_system_for_read
))
3972 val
= Vcoding_system_for_read
;
3975 if (! NILP (Vset_auto_coding_function
))
3977 /* Since we are sure that the current buffer was
3978 empty before the insertion, we can toggle
3979 enable-multibyte-characters directly here without
3980 taking care of marker adjustment and byte
3981 combining problem. */
3982 Lisp_Object prev_multibyte
;
3983 int count
= specpdl_ptr
- specpdl
;
3985 prev_multibyte
= current_buffer
->enable_multibyte_characters
;
3986 current_buffer
->enable_multibyte_characters
= Qnil
;
3987 record_unwind_protect (set_auto_coding_unwind
,
3989 val
= call1 (Vset_auto_coding_function
,
3990 make_number (inserted
));
3991 /* Discard the unwind protect for recovering the
3992 error of Vset_auto_coding_function. */
3994 current_buffer
->enable_multibyte_characters
= prev_multibyte
;
3995 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
4000 /* If the coding system is not yet decided, check
4001 file-coding-system-alist. */
4002 Lisp_Object args
[6], coding_systems
;
4004 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4005 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4006 coding_systems
= Ffind_operation_coding_system (6, args
);
4007 if (CONSP (coding_systems
))
4008 val
= XCONS (coding_systems
)->car
;
4012 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4014 if (NILP (Vcoding_system_for_read
)
4015 && NILP (current_buffer
->enable_multibyte_characters
))
4017 /* We must suppress all text conversion except for
4018 end-of-line conversion. */
4021 eol_type
= coding
.eol_type
;
4022 setup_coding_system (Qraw_text
, &coding
);
4023 coding
.eol_type
= eol_type
;
4027 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4029 /* Here, we don't have to consider byte combining (see the
4030 comment below) because code_convert_region takes care of
4032 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4034 inserted
= (NILP (current_buffer
->enable_multibyte_characters
)
4035 ? coding
.produced
: coding
.produced_char
);
4037 else if (!NILP (current_buffer
->enable_multibyte_characters
))
4039 int inserted_byte
= inserted
;
4041 /* There's a possibility that we must combine bytes at the
4042 head (resp. the tail) of the just inserted text with the
4043 bytes before (resp. after) the gap to form a single
4045 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
4046 adjust_after_insert (PT
, PT_BYTE
,
4047 PT
+ inserted_byte
, PT_BYTE
+ inserted_byte
,
4051 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4055 /* Use the conversion type to determine buffer-file-type
4056 (find-buffer-file-type is now used to help determine the
4058 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4059 || coding
.eol_type
== CODING_EOL_LF
)
4060 && ! CODING_REQUIRE_DECODING (&coding
))
4061 current_buffer
->buffer_file_type
= Qt
;
4063 current_buffer
->buffer_file_type
= Qnil
;
4072 if (!EQ (current_buffer
->undo_list
, Qt
))
4073 current_buffer
->undo_list
= Qnil
;
4075 stat (XSTRING (filename
)->data
, &st
);
4080 current_buffer
->modtime
= st
.st_mtime
;
4081 current_buffer
->filename
= orig_filename
;
4084 SAVE_MODIFF
= MODIFF
;
4085 current_buffer
->auto_save_modified
= MODIFF
;
4086 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4087 #ifdef CLASH_DETECTION
4090 if (!NILP (current_buffer
->file_truename
))
4091 unlock_file (current_buffer
->file_truename
);
4092 unlock_file (filename
);
4094 #endif /* CLASH_DETECTION */
4096 Fsignal (Qfile_error
,
4097 Fcons (build_string ("not a regular file"),
4098 Fcons (orig_filename
, Qnil
)));
4100 /* If visiting nonexistent file, return nil. */
4101 if (current_buffer
->modtime
== -1)
4102 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4105 /* Decode file format */
4108 insval
= call3 (Qformat_decode
,
4109 Qnil
, make_number (inserted
), visit
);
4110 CHECK_NUMBER (insval
, 0);
4111 inserted
= XFASTINT (insval
);
4114 /* Call after-change hooks for the inserted text, aside from the case
4115 of normal visiting (not with REPLACE), which is done in a new buffer
4116 "before" the buffer is changed. */
4117 if (inserted
> 0 && total
> 0
4118 && (NILP (visit
) || !NILP (replace
)))
4119 signal_after_change (PT
, 0, inserted
);
4121 if (set_coding_system
)
4122 Vlast_coding_system_used
= coding
.symbol
;
4126 p
= Vafter_insert_file_functions
;
4129 insval
= call1 (Fcar (p
), make_number (inserted
));
4132 CHECK_NUMBER (insval
, 0);
4133 inserted
= XFASTINT (insval
);
4140 /* ??? Retval needs to be dealt with in all cases consistently. */
4142 val
= Fcons (orig_filename
,
4143 Fcons (make_number (inserted
),
4146 RETURN_UNGCPRO (unbind_to (count
, val
));
4149 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
4152 /* If build_annotations switched buffers, switch back to BUF.
4153 Kill the temporary buffer that was selected in the meantime.
4155 Since this kill only the last temporary buffer, some buffers remain
4156 not killed if build_annotations switched buffers more than once.
4160 build_annotations_unwind (buf
)
4165 if (XBUFFER (buf
) == current_buffer
)
4167 tembuf
= Fcurrent_buffer ();
4169 Fkill_buffer (tembuf
);
4173 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4174 "r\nFWrite region to file: \ni\ni\ni\np",
4175 "Write current region into specified file.\n\
4176 When called from a program, takes three arguments:\n\
4177 START, END and FILENAME. START and END are buffer positions.\n\
4178 Optional fourth argument APPEND if non-nil means\n\
4179 append to existing file contents (if any).\n\
4180 Optional fifth argument VISIT if t means\n\
4181 set the last-save-file-modtime of buffer to this file's modtime\n\
4182 and mark buffer not modified.\n\
4183 If VISIT is a string, it is a second file name;\n\
4184 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
4185 VISIT is also the file name to lock and unlock for clash detection.\n\
4186 If VISIT is neither t nor nil nor a string,\n\
4187 that means do not print the \"Wrote file\" message.\n\
4188 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
4189 use for locking and unlocking, overriding FILENAME and VISIT.\n\
4190 The optional seventh arg CONFIRM, if non-nil, says ask for confirmation\n\
4191 before overwriting an existing file.\n\
4192 Kludgy feature: if START is a string, then that string is written\n\
4193 to the file, instead of any buffer contents, and END is ignored.\n\
4195 This does code conversion according to the value of\n\
4196 `coding-system-for-write', `buffer-file-coding-system', or\n\
4197 `file-coding-system-alist', and sets the variable\n\
4198 `last-coding-system-used' to the coding system actually used.")
4200 (start
, end
, filename
, append
, visit
, lockname
, confirm
)
4201 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, confirm
;
4209 int count
= specpdl_ptr
- specpdl
;
4212 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4214 Lisp_Object handler
;
4215 Lisp_Object visit_file
;
4216 Lisp_Object annotations
;
4217 Lisp_Object encoded_filename
;
4218 int visiting
, quietly
;
4219 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4220 struct buffer
*given_buffer
;
4222 int buffer_file_type
= O_BINARY
;
4224 struct coding_system coding
;
4226 if (current_buffer
->base_buffer
&& ! NILP (visit
))
4227 error ("Cannot do file visiting in an indirect buffer");
4229 if (!NILP (start
) && !STRINGP (start
))
4230 validate_region (&start
, &end
);
4232 GCPRO4 (start
, filename
, visit
, lockname
);
4234 /* Decide the coding-system to encode the data with. */
4240 else if (!NILP (Vcoding_system_for_write
))
4241 val
= Vcoding_system_for_write
;
4242 else if (NILP (current_buffer
->enable_multibyte_characters
))
4244 /* If the variable `buffer-file-coding-system' is set locally,
4245 it means that the file was read with some kind of code
4246 conversion or the varialbe is explicitely set by users. We
4247 had better write it out with the same coding system even if
4248 `enable-multibyte-characters' is nil.
4250 If it is not set locally, we anyway have to convert EOL
4251 format if the default value of `buffer-file-coding-system'
4252 tells that it is not Unix-like (LF only) format. */
4253 val
= current_buffer
->buffer_file_coding_system
;
4254 if (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4256 struct coding_system coding_temp
;
4258 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
4259 if (coding_temp
.eol_type
== CODING_EOL_CRLF
4260 || coding_temp
.eol_type
== CODING_EOL_CR
)
4262 setup_coding_system (Qraw_text
, &coding
);
4263 coding
.eol_type
= coding_temp
.eol_type
;
4264 goto done_setup_coding
;
4271 Lisp_Object args
[7], coding_systems
;
4273 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4274 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4276 coding_systems
= Ffind_operation_coding_system (7, args
);
4277 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
4278 ? XCONS (coding_systems
)->cdr
4279 : current_buffer
->buffer_file_coding_system
);
4280 /* Confirm that VAL can surely encode the current region. */
4281 if (!NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4282 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4284 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4287 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4288 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4291 Vlast_coding_system_used
= coding
.symbol
;
4293 filename
= Fexpand_file_name (filename
, Qnil
);
4295 if (! NILP (confirm
))
4296 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4298 if (STRINGP (visit
))
4299 visit_file
= Fexpand_file_name (visit
, Qnil
);
4301 visit_file
= filename
;
4304 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4305 quietly
= !NILP (visit
);
4309 if (NILP (lockname
))
4310 lockname
= visit_file
;
4312 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4314 /* If the file name has special constructs in it,
4315 call the corresponding file handler. */
4316 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4317 /* If FILENAME has no handler, see if VISIT has one. */
4318 if (NILP (handler
) && STRINGP (visit
))
4319 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4321 if (!NILP (handler
))
4324 val
= call6 (handler
, Qwrite_region
, start
, end
,
4325 filename
, append
, visit
);
4329 SAVE_MODIFF
= MODIFF
;
4330 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4331 current_buffer
->filename
= visit_file
;
4337 /* Special kludge to simplify auto-saving. */
4340 XSETFASTINT (start
, BEG
);
4341 XSETFASTINT (end
, Z
);
4344 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4345 count1
= specpdl_ptr
- specpdl
;
4347 given_buffer
= current_buffer
;
4348 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4349 if (current_buffer
!= given_buffer
)
4351 XSETFASTINT (start
, BEGV
);
4352 XSETFASTINT (end
, ZV
);
4355 #ifdef CLASH_DETECTION
4358 #if 0 /* This causes trouble for GNUS. */
4359 /* If we've locked this file for some other buffer,
4360 query before proceeding. */
4361 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4362 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4365 lock_file (lockname
);
4367 #endif /* CLASH_DETECTION */
4369 encoded_filename
= ENCODE_FILE (filename
);
4371 fn
= XSTRING (encoded_filename
)->data
;
4375 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4376 #else /* not DOS_NT */
4377 desc
= open (fn
, O_WRONLY
);
4378 #endif /* not DOS_NT */
4380 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4382 if (auto_saving
) /* Overwrite any previous version of autosave file */
4384 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4385 desc
= open (fn
, O_RDWR
);
4387 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4388 ? XSTRING (current_buffer
->filename
)->data
: 0,
4391 else /* Write to temporary name and rename if no errors */
4393 Lisp_Object temp_name
;
4394 temp_name
= Ffile_name_directory (filename
);
4396 if (!NILP (temp_name
))
4398 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4399 build_string ("$$SAVE$$")));
4400 fname
= XSTRING (filename
)->data
;
4401 fn
= XSTRING (temp_name
)->data
;
4402 desc
= creat_copy_attrs (fname
, fn
);
4405 /* If we can't open the temporary file, try creating a new
4406 version of the original file. VMS "creat" creates a
4407 new version rather than truncating an existing file. */
4410 desc
= creat (fn
, 0666);
4411 #if 0 /* This can clobber an existing file and fail to replace it,
4412 if the user runs out of space. */
4415 /* We can't make a new version;
4416 try to truncate and rewrite existing version if any. */
4418 desc
= open (fn
, O_RDWR
);
4424 desc
= creat (fn
, 0666);
4429 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4430 S_IREAD
| S_IWRITE
);
4431 #else /* not DOS_NT */
4432 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4433 #endif /* not DOS_NT */
4434 #endif /* not VMS */
4440 #ifdef CLASH_DETECTION
4442 if (!auto_saving
) unlock_file (lockname
);
4444 #endif /* CLASH_DETECTION */
4445 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4448 record_unwind_protect (close_file_unwind
, make_number (desc
));
4451 if (lseek (desc
, 0, 2) < 0)
4453 #ifdef CLASH_DETECTION
4454 if (!auto_saving
) unlock_file (lockname
);
4455 #endif /* CLASH_DETECTION */
4456 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4461 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4462 * if we do writes that don't end with a carriage return. Furthermore
4463 * it cannot handle writes of more then 16K. The modified
4464 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4465 * this EXCEPT for the last record (iff it doesn't end with a carriage
4466 * return). This implies that if your buffer doesn't end with a carriage
4467 * return, you get one free... tough. However it also means that if
4468 * we make two calls to sys_write (a la the following code) you can
4469 * get one at the gap as well. The easiest way to fix this (honest)
4470 * is to move the gap to the next newline (or the end of the buffer).
4475 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4476 move_gap (find_next_newline (GPT
, 1));
4478 /* Whether VMS or not, we must move the gap to the next of newline
4479 when we must put designation sequences at beginning of line. */
4480 if (INTEGERP (start
)
4481 && coding
.type
== coding_type_iso2022
4482 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4483 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4485 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4486 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4487 move_gap_both (PT
, PT_BYTE
);
4488 SET_PT_BOTH (opoint
, opoint_byte
);
4495 if (STRINGP (start
))
4497 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4498 STRING_BYTES (XSTRING (start
)), 0, &annotations
,
4502 else if (XINT (start
) != XINT (end
))
4504 register int end1
= CHAR_TO_BYTE (XINT (end
));
4506 tem
= CHAR_TO_BYTE (XINT (start
));
4508 if (XINT (start
) < GPT
)
4510 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
),
4511 min (GPT_BYTE
, end1
) - tem
, tem
, &annotations
,
4516 if (XINT (end
) > GPT
&& !failure
)
4518 tem
= max (tem
, GPT_BYTE
);
4519 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
), end1
- tem
,
4520 tem
, &annotations
, &coding
);
4526 /* If file was empty, still need to write the annotations */
4527 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4528 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4532 if (CODING_REQUIRE_FLUSHING (&coding
)
4533 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4536 /* We have to flush out a data. */
4537 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4538 failure
= 0 > e_write (desc
, "", 0, &coding
);
4545 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4546 Disk full in NFS may be reported here. */
4547 /* mib says that closing the file will try to write as fast as NFS can do
4548 it, and that means the fsync here is not crucial for autosave files. */
4549 if (!auto_saving
&& fsync (desc
) < 0)
4551 /* If fsync fails with EINTR, don't treat that as serious. */
4553 failure
= 1, save_errno
= errno
;
4557 /* Spurious "file has changed on disk" warnings have been
4558 observed on Suns as well.
4559 It seems that `close' can change the modtime, under nfs.
4561 (This has supposedly been fixed in Sunos 4,
4562 but who knows about all the other machines with NFS?) */
4565 /* On VMS and APOLLO, must do the stat after the close
4566 since closing changes the modtime. */
4569 /* Recall that #if defined does not work on VMS. */
4576 /* NFS can report a write failure now. */
4577 if (close (desc
) < 0)
4578 failure
= 1, save_errno
= errno
;
4581 /* If we wrote to a temporary name and had no errors, rename to real name. */
4585 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4593 /* Discard the unwind protect for close_file_unwind. */
4594 specpdl_ptr
= specpdl
+ count1
;
4595 /* Restore the original current buffer. */
4596 visit_file
= unbind_to (count
, visit_file
);
4598 #ifdef CLASH_DETECTION
4600 unlock_file (lockname
);
4601 #endif /* CLASH_DETECTION */
4603 /* Do this before reporting IO error
4604 to avoid a "file has changed on disk" warning on
4605 next attempt to save. */
4607 current_buffer
->modtime
= st
.st_mtime
;
4610 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4611 strerror (save_errno
));
4615 SAVE_MODIFF
= MODIFF
;
4616 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4617 current_buffer
->filename
= visit_file
;
4618 update_mode_lines
++;
4624 message_with_string ("Wrote %s", visit_file
, 1);
4629 Lisp_Object
merge ();
4631 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4632 "Return t if (car A) is numerically less than (car B).")
4636 return Flss (Fcar (a
), Fcar (b
));
4639 /* Build the complete list of annotations appropriate for writing out
4640 the text between START and END, by calling all the functions in
4641 write-region-annotate-functions and merging the lists they return.
4642 If one of these functions switches to a different buffer, we assume
4643 that buffer contains altered text. Therefore, the caller must
4644 make sure to restore the current buffer in all cases,
4645 as save-excursion would do. */
4648 build_annotations (start
, end
, pre_write_conversion
)
4649 Lisp_Object start
, end
, pre_write_conversion
;
4651 Lisp_Object annotations
;
4653 struct gcpro gcpro1
, gcpro2
;
4654 Lisp_Object original_buffer
;
4656 XSETBUFFER (original_buffer
, current_buffer
);
4659 p
= Vwrite_region_annotate_functions
;
4660 GCPRO2 (annotations
, p
);
4663 struct buffer
*given_buffer
= current_buffer
;
4664 Vwrite_region_annotations_so_far
= annotations
;
4665 res
= call2 (Fcar (p
), start
, end
);
4666 /* If the function makes a different buffer current,
4667 assume that means this buffer contains altered text to be output.
4668 Reset START and END from the buffer bounds
4669 and discard all previous annotations because they should have
4670 been dealt with by this function. */
4671 if (current_buffer
!= given_buffer
)
4673 XSETFASTINT (start
, BEGV
);
4674 XSETFASTINT (end
, ZV
);
4677 Flength (res
); /* Check basic validity of return value */
4678 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4682 /* Now do the same for annotation functions implied by the file-format */
4683 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4684 p
= Vauto_save_file_format
;
4686 p
= current_buffer
->file_format
;
4689 struct buffer
*given_buffer
= current_buffer
;
4690 Vwrite_region_annotations_so_far
= annotations
;
4691 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4693 if (current_buffer
!= given_buffer
)
4695 XSETFASTINT (start
, BEGV
);
4696 XSETFASTINT (end
, ZV
);
4700 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4704 /* At last, do the same for the function PRE_WRITE_CONVERSION
4705 implied by the current coding-system. */
4706 if (!NILP (pre_write_conversion
))
4708 struct buffer
*given_buffer
= current_buffer
;
4709 Vwrite_region_annotations_so_far
= annotations
;
4710 res
= call2 (pre_write_conversion
, start
, end
);
4712 annotations
= (current_buffer
!= given_buffer
4714 : merge (annotations
, res
, Qcar_less_than_car
));
4721 /* Write to descriptor DESC the NBYTES bytes starting at ADDR,
4722 assuming they start at byte position BYTEPOS in the buffer.
4723 Intersperse with them the annotations from *ANNOT
4724 which fall within the range of byte positions BYTEPOS to BYTEPOS + NBYTES,
4725 each at its appropriate position.
4727 We modify *ANNOT by discarding elements as we use them up.
4729 The return value is negative in case of system call failure. */
4732 a_write (desc
, addr
, nbytes
, bytepos
, annot
, coding
)
4734 register char *addr
;
4735 register int nbytes
;
4738 struct coding_system
*coding
;
4742 int lastpos
= bytepos
+ nbytes
;
4744 while (NILP (*annot
) || CONSP (*annot
))
4746 tem
= Fcar_safe (Fcar (*annot
));
4747 nextpos
= bytepos
- 1;
4749 nextpos
= CHAR_TO_BYTE (XFASTINT (tem
));
4751 /* If there are no more annotations in this range,
4752 output the rest of the range all at once. */
4753 if (! (nextpos
>= bytepos
&& nextpos
<= lastpos
))
4754 return e_write (desc
, addr
, lastpos
- bytepos
, coding
);
4756 /* Output buffer text up to the next annotation's position. */
4757 if (nextpos
> bytepos
)
4759 if (0 > e_write (desc
, addr
, nextpos
- bytepos
, coding
))
4761 addr
+= nextpos
- bytepos
;
4764 /* Output the annotation. */
4765 tem
= Fcdr (Fcar (*annot
));
4768 if (0 > e_write (desc
, XSTRING (tem
)->data
, STRING_BYTES (XSTRING (tem
)),
4772 *annot
= Fcdr (*annot
);
4777 #ifndef WRITE_BUF_SIZE
4778 #define WRITE_BUF_SIZE (16 * 1024)
4781 /* Write NBYTES bytes starting at ADDR into descriptor DESC,
4782 encoding them with coding system CODING. */
4785 e_write (desc
, addr
, nbytes
, coding
)
4787 register char *addr
;
4788 register int nbytes
;
4789 struct coding_system
*coding
;
4791 char buf
[WRITE_BUF_SIZE
];
4793 /* We used to have a code for handling selective display here. But,
4794 now it is handled within encode_coding. */
4799 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
4800 nbytes
-= coding
->consumed
, addr
+= coding
->consumed
;
4801 if (coding
->produced
> 0)
4803 coding
->produced
-= write (desc
, buf
, coding
->produced
);
4804 if (coding
->produced
) return -1;
4806 if (result
== CODING_FINISH_INSUFFICIENT_SRC
)
4808 /* The source text ends by an incomplete multibyte form.
4809 There's no way other than write it out as is. */
4810 nbytes
-= write (desc
, addr
, nbytes
);
4811 if (nbytes
) return -1;
4819 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4820 Sverify_visited_file_modtime
, 1, 1, 0,
4821 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4822 This means that the file has not been changed since it was visited or saved.")
4828 Lisp_Object handler
;
4829 Lisp_Object filename
;
4831 CHECK_BUFFER (buf
, 0);
4834 if (!STRINGP (b
->filename
)) return Qt
;
4835 if (b
->modtime
== 0) return Qt
;
4837 /* If the file name has special constructs in it,
4838 call the corresponding file handler. */
4839 handler
= Ffind_file_name_handler (b
->filename
,
4840 Qverify_visited_file_modtime
);
4841 if (!NILP (handler
))
4842 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4844 filename
= ENCODE_FILE (b
->filename
);
4846 if (stat (XSTRING (filename
)->data
, &st
) < 0)
4848 /* If the file doesn't exist now and didn't exist before,
4849 we say that it isn't modified, provided the error is a tame one. */
4850 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4855 if (st
.st_mtime
== b
->modtime
4856 /* If both are positive, accept them if they are off by one second. */
4857 || (st
.st_mtime
> 0 && b
->modtime
> 0
4858 && (st
.st_mtime
== b
->modtime
+ 1
4859 || st
.st_mtime
== b
->modtime
- 1)))
4864 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4865 Sclear_visited_file_modtime
, 0, 0, 0,
4866 "Clear out records of last mod time of visited file.\n\
4867 Next attempt to save will certainly not complain of a discrepancy.")
4870 current_buffer
->modtime
= 0;
4874 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4875 Svisited_file_modtime
, 0, 0, 0,
4876 "Return the current buffer's recorded visited file modification time.\n\
4877 The value is a list of the form (HIGH . LOW), like the time values\n\
4878 that `file-attributes' returns.")
4881 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4884 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4885 Sset_visited_file_modtime
, 0, 1, 0,
4886 "Update buffer's recorded modification time from the visited file's time.\n\
4887 Useful if the buffer was not read from the file normally\n\
4888 or if the file itself has been changed for some known benign reason.\n\
4889 An argument specifies the modification time value to use\n\
4890 \(instead of that of the visited file), in the form of a list\n\
4891 \(HIGH . LOW) or (HIGH LOW).")
4893 Lisp_Object time_list
;
4895 if (!NILP (time_list
))
4896 current_buffer
->modtime
= cons_to_long (time_list
);
4899 register Lisp_Object filename
;
4901 Lisp_Object handler
;
4903 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4905 /* If the file name has special constructs in it,
4906 call the corresponding file handler. */
4907 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4908 if (!NILP (handler
))
4909 /* The handler can find the file name the same way we did. */
4910 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4912 filename
= ENCODE_FILE (filename
);
4914 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4915 current_buffer
->modtime
= st
.st_mtime
;
4925 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 1);
4926 Fsleep_for (make_number (1), Qnil
);
4927 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4928 Fsleep_for (make_number (1), Qnil
);
4929 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4930 Fsleep_for (make_number (1), Qnil
);
4940 /* Get visited file's mode to become the auto save file's mode. */
4941 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4942 /* But make sure we can overwrite it later! */
4943 auto_save_mode_bits
= st
.st_mode
| 0600;
4945 auto_save_mode_bits
= 0666;
4948 Fwrite_region (Qnil
, Qnil
,
4949 current_buffer
->auto_save_file_name
,
4950 Qnil
, Qlambda
, Qnil
, Qnil
);
4954 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4959 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4960 | XFASTINT (XCONS (stream
)->cdr
)));
4965 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4968 minibuffer_auto_raise
= XINT (value
);
4972 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4973 "Auto-save all buffers that need it.\n\
4974 This is all buffers that have auto-saving enabled\n\
4975 and are changed since last auto-saved.\n\
4976 Auto-saving writes the buffer into a file\n\
4977 so that your editing is not lost if the system crashes.\n\
4978 This file is not the file you visited; that changes only when you save.\n\
4979 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4980 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4981 A non-nil CURRENT-ONLY argument means save only current buffer.")
4982 (no_message
, current_only
)
4983 Lisp_Object no_message
, current_only
;
4985 struct buffer
*old
= current_buffer
, *b
;
4986 Lisp_Object tail
, buf
;
4988 char *omessage
= echo_area_glyphs
;
4989 int omessage_length
= echo_area_glyphs_length
;
4990 int oldmultibyte
= message_enable_multibyte
;
4991 int do_handled_files
;
4994 Lisp_Object lispstream
;
4995 int count
= specpdl_ptr
- specpdl
;
4997 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4999 /* Ordinarily don't quit within this function,
5000 but don't make it impossible to quit (in case we get hung in I/O). */
5004 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5005 point to non-strings reached from Vbuffer_alist. */
5010 if (!NILP (Vrun_hooks
))
5011 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5013 if (STRINGP (Vauto_save_list_file_name
))
5015 Lisp_Object listfile
;
5016 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5017 stream
= fopen (XSTRING (listfile
)->data
, "w");
5020 /* Arrange to close that file whether or not we get an error.
5021 Also reset auto_saving to 0. */
5022 lispstream
= Fcons (Qnil
, Qnil
);
5023 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
5024 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
5035 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5036 record_unwind_protect (do_auto_save_unwind_1
,
5037 make_number (minibuffer_auto_raise
));
5038 minibuffer_auto_raise
= 0;
5041 /* First, save all files which don't have handlers. If Emacs is
5042 crashing, the handlers may tweak what is causing Emacs to crash
5043 in the first place, and it would be a shame if Emacs failed to
5044 autosave perfectly ordinary files because it couldn't handle some
5046 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5047 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
5049 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
5052 /* Record all the buffers that have auto save mode
5053 in the special file that lists them. For each of these buffers,
5054 Record visited name (if any) and auto save name. */
5055 if (STRINGP (b
->auto_save_file_name
)
5056 && stream
!= NULL
&& do_handled_files
== 0)
5058 if (!NILP (b
->filename
))
5060 fwrite (XSTRING (b
->filename
)->data
, 1,
5061 STRING_BYTES (XSTRING (b
->filename
)), stream
);
5063 putc ('\n', stream
);
5064 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
5065 STRING_BYTES (XSTRING (b
->auto_save_file_name
)), stream
);
5066 putc ('\n', stream
);
5069 if (!NILP (current_only
)
5070 && b
!= current_buffer
)
5073 /* Don't auto-save indirect buffers.
5074 The base buffer takes care of it. */
5078 /* Check for auto save enabled
5079 and file changed since last auto save
5080 and file changed since last real save. */
5081 if (STRINGP (b
->auto_save_file_name
)
5082 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5083 && b
->auto_save_modified
< BUF_MODIFF (b
)
5084 /* -1 means we've turned off autosaving for a while--see below. */
5085 && XINT (b
->save_length
) >= 0
5086 && (do_handled_files
5087 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5090 EMACS_TIME before_time
, after_time
;
5092 EMACS_GET_TIME (before_time
);
5094 /* If we had a failure, don't try again for 20 minutes. */
5095 if (b
->auto_save_failure_time
>= 0
5096 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5099 if ((XFASTINT (b
->save_length
) * 10
5100 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5101 /* A short file is likely to change a large fraction;
5102 spare the user annoying messages. */
5103 && XFASTINT (b
->save_length
) > 5000
5104 /* These messages are frequent and annoying for `*mail*'. */
5105 && !EQ (b
->filename
, Qnil
)
5106 && NILP (no_message
))
5108 /* It has shrunk too much; turn off auto-saving here. */
5109 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5110 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
5112 minibuffer_auto_raise
= 0;
5113 /* Turn off auto-saving until there's a real save,
5114 and prevent any more warnings. */
5115 XSETINT (b
->save_length
, -1);
5116 Fsleep_for (make_number (1), Qnil
);
5119 set_buffer_internal (b
);
5120 if (!auto_saved
&& NILP (no_message
))
5121 message1 ("Auto-saving...");
5122 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5124 b
->auto_save_modified
= BUF_MODIFF (b
);
5125 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5126 set_buffer_internal (old
);
5128 EMACS_GET_TIME (after_time
);
5130 /* If auto-save took more than 60 seconds,
5131 assume it was an NFS failure that got a timeout. */
5132 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5133 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5137 /* Prevent another auto save till enough input events come in. */
5138 record_auto_save ();
5140 if (auto_saved
&& NILP (no_message
))
5144 sit_for (1, 0, 0, 0, 0);
5145 message2 (omessage
, omessage_length
, oldmultibyte
);
5148 message1 ("Auto-saving...done");
5153 unbind_to (count
, Qnil
);
5157 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5158 Sset_buffer_auto_saved
, 0, 0, 0,
5159 "Mark current buffer as auto-saved with its current text.\n\
5160 No auto-save file will be written until the buffer changes again.")
5163 current_buffer
->auto_save_modified
= MODIFF
;
5164 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5165 current_buffer
->auto_save_failure_time
= -1;
5169 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5170 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5171 "Clear any record of a recent auto-save failure in the current buffer.")
5174 current_buffer
->auto_save_failure_time
= -1;
5178 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5180 "Return t if buffer has been auto-saved since last read in or saved.")
5183 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5186 /* Reading and completing file names */
5187 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5189 /* In the string VAL, change each $ to $$ and return the result. */
5192 double_dollars (val
)
5195 register unsigned char *old
, *new;
5199 osize
= STRING_BYTES (XSTRING (val
));
5201 /* Count the number of $ characters. */
5202 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
5203 if (*old
++ == '$') count
++;
5206 old
= XSTRING (val
)->data
;
5207 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
5209 new = XSTRING (val
)->data
;
5210 for (n
= osize
; n
> 0; n
--)
5223 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5225 "Internal subroutine for read-file-name. Do not call this.")
5226 (string
, dir
, action
)
5227 Lisp_Object string
, dir
, action
;
5228 /* action is nil for complete, t for return list of completions,
5229 lambda for verify final value */
5231 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5233 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5235 CHECK_STRING (string
, 0);
5242 /* No need to protect ACTION--we only compare it with t and nil. */
5243 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5245 if (XSTRING (string
)->size
== 0)
5247 if (EQ (action
, Qlambda
))
5255 orig_string
= string
;
5256 string
= Fsubstitute_in_file_name (string
);
5257 changed
= NILP (Fstring_equal (string
, orig_string
));
5258 name
= Ffile_name_nondirectory (string
);
5259 val
= Ffile_name_directory (string
);
5261 realdir
= Fexpand_file_name (val
, realdir
);
5266 specdir
= Ffile_name_directory (string
);
5267 val
= Ffile_name_completion (name
, realdir
);
5272 return double_dollars (string
);
5276 if (!NILP (specdir
))
5277 val
= concat2 (specdir
, val
);
5279 return double_dollars (val
);
5282 #endif /* not VMS */
5286 if (EQ (action
, Qt
))
5287 return Ffile_name_all_completions (name
, realdir
);
5288 /* Only other case actually used is ACTION = lambda */
5290 /* Supposedly this helps commands such as `cd' that read directory names,
5291 but can someone explain how it helps them? -- RMS */
5292 if (XSTRING (name
)->size
== 0)
5295 return Ffile_exists_p (string
);
5298 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5299 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5300 Value is not expanded---you must call `expand-file-name' yourself.\n\
5301 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5302 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5303 except that if INITIAL is specified, that combined with DIR is used.)\n\
5304 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5305 Non-nil and non-t means also require confirmation after completion.\n\
5306 Fifth arg INITIAL specifies text to start with.\n\
5307 DIR defaults to current buffer's directory default.")
5308 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5309 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5311 Lisp_Object val
, insdef
, insdef1
, tem
;
5312 struct gcpro gcpro1
, gcpro2
;
5313 register char *homedir
;
5314 int replace_in_history
= 0;
5315 int add_to_history
= 0;
5319 dir
= current_buffer
->directory
;
5320 if (NILP (default_filename
))
5322 if (! NILP (initial
))
5323 default_filename
= Fexpand_file_name (initial
, dir
);
5325 default_filename
= current_buffer
->filename
;
5328 /* If dir starts with user's homedir, change that to ~. */
5329 homedir
= (char *) egetenv ("HOME");
5331 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5332 CORRECT_DIR_SEPS (homedir
);
5336 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5337 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5339 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5340 STRING_BYTES (XSTRING (dir
)) - strlen (homedir
) + 1);
5341 XSTRING (dir
)->data
[0] = '~';
5344 if (insert_default_directory
&& STRINGP (dir
))
5347 if (!NILP (initial
))
5349 Lisp_Object args
[2], pos
;
5353 insdef
= Fconcat (2, args
);
5354 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5355 insdef1
= Fcons (double_dollars (insdef
), pos
);
5358 insdef1
= double_dollars (insdef
);
5360 else if (STRINGP (initial
))
5363 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
5366 insdef
= Qnil
, insdef1
= Qnil
;
5369 count
= specpdl_ptr
- specpdl
;
5370 specbind (intern ("completion-ignore-case"), Qt
);
5373 GCPRO2 (insdef
, default_filename
);
5374 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5375 dir
, mustmatch
, insdef1
,
5376 Qfile_name_history
, default_filename
, Qnil
);
5378 tem
= Fsymbol_value (Qfile_name_history
);
5379 if (CONSP (tem
) && EQ (XCONS (tem
)->car
, val
))
5380 replace_in_history
= 1;
5382 /* If Fcompleting_read returned the inserted default string itself
5383 (rather than a new string with the same contents),
5384 it has to mean that the user typed RET with the minibuffer empty.
5385 In that case, we really want to return ""
5386 so that commands such as set-visited-file-name can distinguish. */
5387 if (EQ (val
, default_filename
))
5389 /* In this case, Fcompleting_read has not added an element
5390 to the history. Maybe we should. */
5391 if (! replace_in_history
)
5394 val
= build_string ("");
5398 unbind_to (count
, Qnil
);
5403 error ("No file name specified");
5405 tem
= Fstring_equal (val
, insdef
);
5407 if (!NILP (tem
) && !NILP (default_filename
))
5408 val
= default_filename
;
5409 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5411 if (!NILP (default_filename
))
5412 val
= default_filename
;
5414 error ("No default file name");
5416 val
= Fsubstitute_in_file_name (val
);
5418 if (replace_in_history
)
5419 /* Replace what Fcompleting_read added to the history
5420 with what we will actually return. */
5421 XCONS (Fsymbol_value (Qfile_name_history
))->car
= val
;
5422 else if (add_to_history
)
5424 /* Add the value to the history--but not if it matches
5425 the last value already there. */
5426 tem
= Fsymbol_value (Qfile_name_history
);
5427 if (! CONSP (tem
) || NILP (Fequal (XCONS (tem
)->car
, val
)))
5428 Fset (Qfile_name_history
,
5437 Qexpand_file_name
= intern ("expand-file-name");
5438 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5439 Qdirectory_file_name
= intern ("directory-file-name");
5440 Qfile_name_directory
= intern ("file-name-directory");
5441 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5442 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5443 Qfile_name_as_directory
= intern ("file-name-as-directory");
5444 Qcopy_file
= intern ("copy-file");
5445 Qmake_directory_internal
= intern ("make-directory-internal");
5446 Qdelete_directory
= intern ("delete-directory");
5447 Qdelete_file
= intern ("delete-file");
5448 Qrename_file
= intern ("rename-file");
5449 Qadd_name_to_file
= intern ("add-name-to-file");
5450 Qmake_symbolic_link
= intern ("make-symbolic-link");
5451 Qfile_exists_p
= intern ("file-exists-p");
5452 Qfile_executable_p
= intern ("file-executable-p");
5453 Qfile_readable_p
= intern ("file-readable-p");
5454 Qfile_writable_p
= intern ("file-writable-p");
5455 Qfile_symlink_p
= intern ("file-symlink-p");
5456 Qaccess_file
= intern ("access-file");
5457 Qfile_directory_p
= intern ("file-directory-p");
5458 Qfile_regular_p
= intern ("file-regular-p");
5459 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5460 Qfile_modes
= intern ("file-modes");
5461 Qset_file_modes
= intern ("set-file-modes");
5462 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5463 Qinsert_file_contents
= intern ("insert-file-contents");
5464 Qwrite_region
= intern ("write-region");
5465 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5466 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5468 staticpro (&Qexpand_file_name
);
5469 staticpro (&Qsubstitute_in_file_name
);
5470 staticpro (&Qdirectory_file_name
);
5471 staticpro (&Qfile_name_directory
);
5472 staticpro (&Qfile_name_nondirectory
);
5473 staticpro (&Qunhandled_file_name_directory
);
5474 staticpro (&Qfile_name_as_directory
);
5475 staticpro (&Qcopy_file
);
5476 staticpro (&Qmake_directory_internal
);
5477 staticpro (&Qdelete_directory
);
5478 staticpro (&Qdelete_file
);
5479 staticpro (&Qrename_file
);
5480 staticpro (&Qadd_name_to_file
);
5481 staticpro (&Qmake_symbolic_link
);
5482 staticpro (&Qfile_exists_p
);
5483 staticpro (&Qfile_executable_p
);
5484 staticpro (&Qfile_readable_p
);
5485 staticpro (&Qfile_writable_p
);
5486 staticpro (&Qaccess_file
);
5487 staticpro (&Qfile_symlink_p
);
5488 staticpro (&Qfile_directory_p
);
5489 staticpro (&Qfile_regular_p
);
5490 staticpro (&Qfile_accessible_directory_p
);
5491 staticpro (&Qfile_modes
);
5492 staticpro (&Qset_file_modes
);
5493 staticpro (&Qfile_newer_than_file_p
);
5494 staticpro (&Qinsert_file_contents
);
5495 staticpro (&Qwrite_region
);
5496 staticpro (&Qverify_visited_file_modtime
);
5497 staticpro (&Qset_visited_file_modtime
);
5499 Qfile_name_history
= intern ("file-name-history");
5500 Fset (Qfile_name_history
, Qnil
);
5501 staticpro (&Qfile_name_history
);
5503 Qfile_error
= intern ("file-error");
5504 staticpro (&Qfile_error
);
5505 Qfile_already_exists
= intern ("file-already-exists");
5506 staticpro (&Qfile_already_exists
);
5507 Qfile_date_error
= intern ("file-date-error");
5508 staticpro (&Qfile_date_error
);
5511 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5512 staticpro (&Qfind_buffer_file_type
);
5515 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5516 "*Coding system for encoding file names.\n\
5517 If it is nil, default-file-name-coding-system (which see) is used.");
5518 Vfile_name_coding_system
= Qnil
;
5520 DEFVAR_LISP ("default-file-name-coding-system",
5521 &Vdefault_file_name_coding_system
,
5522 "Default coding system for encoding file names.\n\
5523 This variable is used only when file-name-coding-system is nil.\n\
5525 This variable is set/changed by the command set-language-environment.\n\
5526 User should not set this variable manually,\n\
5527 instead use file-name-coding-system to get a constant encoding\n\
5528 of file names regardless of the current language environment.");
5529 Vdefault_file_name_coding_system
= Qnil
;
5531 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5532 "*Format in which to write auto-save files.\n\
5533 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5534 If it is t, which is the default, auto-save files are written in the\n\
5535 same format as a regular save would use.");
5536 Vauto_save_file_format
= Qt
;
5538 Qformat_decode
= intern ("format-decode");
5539 staticpro (&Qformat_decode
);
5540 Qformat_annotate_function
= intern ("format-annotate-function");
5541 staticpro (&Qformat_annotate_function
);
5543 Qcar_less_than_car
= intern ("car-less-than-car");
5544 staticpro (&Qcar_less_than_car
);
5546 Fput (Qfile_error
, Qerror_conditions
,
5547 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5548 Fput (Qfile_error
, Qerror_message
,
5549 build_string ("File error"));
5551 Fput (Qfile_already_exists
, Qerror_conditions
,
5552 Fcons (Qfile_already_exists
,
5553 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5554 Fput (Qfile_already_exists
, Qerror_message
,
5555 build_string ("File already exists"));
5557 Fput (Qfile_date_error
, Qerror_conditions
,
5558 Fcons (Qfile_date_error
,
5559 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5560 Fput (Qfile_date_error
, Qerror_message
,
5561 build_string ("Cannot set file date"));
5563 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5564 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5565 insert_default_directory
= 1;
5567 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5568 "*Non-nil means write new files with record format `stmlf'.\n\
5569 nil means use format `var'. This variable is meaningful only on VMS.");
5570 vms_stmlf_recfm
= 0;
5572 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5573 "Directory separator character for built-in functions that return file names.\n\
5574 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5575 This variable affects the built-in functions only on Windows,\n\
5576 on other platforms, it is initialized so that Lisp code can find out\n\
5577 what the normal separator is.");
5578 XSETFASTINT (Vdirectory_sep_char
, '/');
5580 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5581 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5582 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5585 The first argument given to HANDLER is the name of the I/O primitive\n\
5586 to be handled; the remaining arguments are the arguments that were\n\
5587 passed to that primitive. For example, if you do\n\
5588 (file-exists-p FILENAME)\n\
5589 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5590 (funcall HANDLER 'file-exists-p FILENAME)\n\
5591 The function `find-file-name-handler' checks this list for a handler\n\
5592 for its argument.");
5593 Vfile_name_handler_alist
= Qnil
;
5595 DEFVAR_LISP ("set-auto-coding-function",
5596 &Vset_auto_coding_function
,
5597 "If non-nil, a function to call to decide a coding system of file.\n\
5598 One argument is passed to this function: the string of concatination\n\
5599 or the heading 1K-byte and the tailing 3K-byte of a file to be read.\n\
5600 This function should return a coding system to decode the file contents\n\
5601 specified in the heading lines with the format:\n\
5602 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5603 or local variable spec of the tailing lines with `coding:' tag.");
5604 Vset_auto_coding_function
= Qnil
;
5606 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5607 "A list of functions to be called at the end of `insert-file-contents'.\n\
5608 Each is passed one argument, the number of bytes inserted. It should return\n\
5609 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5610 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5611 responsible for calling the after-insert-file-functions if appropriate.");
5612 Vafter_insert_file_functions
= Qnil
;
5614 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5615 "A list of functions to be called at the start of `write-region'.\n\
5616 Each is passed two arguments, START and END as for `write-region'.\n\
5617 These are usually two numbers but not always; see the documentation\n\
5618 for `write-region'. The function should return a list of pairs\n\
5619 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5620 inserted at the specified positions of the file being written (1 means to\n\
5621 insert before the first byte written). The POSITIONs must be sorted into\n\
5622 increasing order. If there are several functions in the list, the several\n\
5623 lists are merged destructively.");
5624 Vwrite_region_annotate_functions
= Qnil
;
5626 DEFVAR_LISP ("write-region-annotations-so-far",
5627 &Vwrite_region_annotations_so_far
,
5628 "When an annotation function is called, this holds the previous annotations.\n\
5629 These are the annotations made by other annotation functions\n\
5630 that were already called. See also `write-region-annotate-functions'.");
5631 Vwrite_region_annotations_so_far
= Qnil
;
5633 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5634 "A list of file name handlers that temporarily should not be used.\n\
5635 This applies only to the operation `inhibit-file-name-operation'.");
5636 Vinhibit_file_name_handlers
= Qnil
;
5638 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5639 "The operation for which `inhibit-file-name-handlers' is applicable.");
5640 Vinhibit_file_name_operation
= Qnil
;
5642 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5643 "File name in which we write a list of all auto save file names.\n\
5644 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5645 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5647 Vauto_save_list_file_name
= Qnil
;
5649 defsubr (&Sfind_file_name_handler
);
5650 defsubr (&Sfile_name_directory
);
5651 defsubr (&Sfile_name_nondirectory
);
5652 defsubr (&Sunhandled_file_name_directory
);
5653 defsubr (&Sfile_name_as_directory
);
5654 defsubr (&Sdirectory_file_name
);
5655 defsubr (&Smake_temp_name
);
5656 defsubr (&Sexpand_file_name
);
5657 defsubr (&Ssubstitute_in_file_name
);
5658 defsubr (&Scopy_file
);
5659 defsubr (&Smake_directory_internal
);
5660 defsubr (&Sdelete_directory
);
5661 defsubr (&Sdelete_file
);
5662 defsubr (&Srename_file
);
5663 defsubr (&Sadd_name_to_file
);
5665 defsubr (&Smake_symbolic_link
);
5666 #endif /* S_IFLNK */
5668 defsubr (&Sdefine_logical_name
);
5671 defsubr (&Ssysnetunam
);
5672 #endif /* HPUX_NET */
5673 defsubr (&Sfile_name_absolute_p
);
5674 defsubr (&Sfile_exists_p
);
5675 defsubr (&Sfile_executable_p
);
5676 defsubr (&Sfile_readable_p
);
5677 defsubr (&Sfile_writable_p
);
5678 defsubr (&Saccess_file
);
5679 defsubr (&Sfile_symlink_p
);
5680 defsubr (&Sfile_directory_p
);
5681 defsubr (&Sfile_accessible_directory_p
);
5682 defsubr (&Sfile_regular_p
);
5683 defsubr (&Sfile_modes
);
5684 defsubr (&Sset_file_modes
);
5685 defsubr (&Sset_default_file_modes
);
5686 defsubr (&Sdefault_file_modes
);
5687 defsubr (&Sfile_newer_than_file_p
);
5688 defsubr (&Sinsert_file_contents
);
5689 defsubr (&Swrite_region
);
5690 defsubr (&Scar_less_than_car
);
5691 defsubr (&Sverify_visited_file_modtime
);
5692 defsubr (&Sclear_visited_file_modtime
);
5693 defsubr (&Svisited_file_modtime
);
5694 defsubr (&Sset_visited_file_modtime
);
5695 defsubr (&Sdo_auto_save
);
5696 defsubr (&Sset_buffer_auto_saved
);
5697 defsubr (&Sclear_buffer_auto_save_failure
);
5698 defsubr (&Srecent_auto_save_p
);
5700 defsubr (&Sread_file_name_internal
);
5701 defsubr (&Sread_file_name
);
5704 defsubr (&Sunix_sync
);