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))
156 #define min(a, b) ((a) < (b) ? (a) : (b))
157 #define max(a, b) ((a) > (b) ? (a) : (b))
159 /* Nonzero during writing of auto-save files */
162 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
163 a new file with the same mode as the original */
164 int auto_save_mode_bits
;
166 /* Coding system for file names, or nil if none. */
167 Lisp_Object Vfile_name_coding_system
;
169 /* Coding system for file names used only when
170 Vfile_name_coding_system is nil. */
171 Lisp_Object Vdefault_file_name_coding_system
;
173 /* Alist of elements (REGEXP . HANDLER) for file names
174 whose I/O is done with a special handler. */
175 Lisp_Object Vfile_name_handler_alist
;
177 /* Format for auto-save files */
178 Lisp_Object Vauto_save_file_format
;
180 /* Lisp functions for translating file formats */
181 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
183 /* Function to be called to decide a coding system of a reading file. */
184 Lisp_Object Vset_auto_coding_function
;
186 /* Functions to be called to process text properties in inserted file. */
187 Lisp_Object Vafter_insert_file_functions
;
189 /* Functions to be called to create text property annotations for file. */
190 Lisp_Object Vwrite_region_annotate_functions
;
192 /* During build_annotations, each time an annotation function is called,
193 this holds the annotations made by the previous functions. */
194 Lisp_Object Vwrite_region_annotations_so_far
;
196 /* File name in which we write a list of all our auto save files. */
197 Lisp_Object Vauto_save_list_file_name
;
199 /* Nonzero means, when reading a filename in the minibuffer,
200 start out by inserting the default directory into the minibuffer. */
201 int insert_default_directory
;
203 /* On VMS, nonzero means write new files with record format stmlf.
204 Zero means use var format. */
207 /* On NT, specifies the directory separator character, used (eg.) when
208 expanding file names. This can be bound to / or \. */
209 Lisp_Object Vdirectory_sep_char
;
211 extern Lisp_Object Vuser_login_name
;
214 extern Lisp_Object Vw32_get_true_file_attributes
;
217 extern int minibuf_level
;
219 extern int minibuffer_auto_raise
;
221 /* These variables describe handlers that have "already" had a chance
222 to handle the current operation.
224 Vinhibit_file_name_handlers is a list of file name handlers.
225 Vinhibit_file_name_operation is the operation being handled.
226 If we try to handle that operation, we ignore those handlers. */
228 static Lisp_Object Vinhibit_file_name_handlers
;
229 static Lisp_Object Vinhibit_file_name_operation
;
231 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
233 Lisp_Object Qfile_name_history
;
235 Lisp_Object Qcar_less_than_car
;
237 static int a_write
P_ ((int, char *, int, int,
238 Lisp_Object
*, struct coding_system
*));
239 static int e_write
P_ ((int, char *, int, struct coding_system
*));
242 report_file_error (string
, data
)
246 Lisp_Object errstring
;
248 errstring
= build_string (strerror (errno
));
250 /* System error messages are capitalized. Downcase the initial
251 unless it is followed by a slash. */
252 if (XSTRING (errstring
)->data
[1] != '/')
253 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
256 Fsignal (Qfile_error
,
257 Fcons (build_string (string
), Fcons (errstring
, data
)));
261 close_file_unwind (fd
)
264 close (XFASTINT (fd
));
268 /* Restore point, having saved it as a marker. */
271 restore_point_unwind (location
)
272 Lisp_Object location
;
274 Fgoto_char (location
);
275 Fset_marker (location
, Qnil
, Qnil
);
279 Lisp_Object Qexpand_file_name
;
280 Lisp_Object Qsubstitute_in_file_name
;
281 Lisp_Object Qdirectory_file_name
;
282 Lisp_Object Qfile_name_directory
;
283 Lisp_Object Qfile_name_nondirectory
;
284 Lisp_Object Qunhandled_file_name_directory
;
285 Lisp_Object Qfile_name_as_directory
;
286 Lisp_Object Qcopy_file
;
287 Lisp_Object Qmake_directory_internal
;
288 Lisp_Object Qdelete_directory
;
289 Lisp_Object Qdelete_file
;
290 Lisp_Object Qrename_file
;
291 Lisp_Object Qadd_name_to_file
;
292 Lisp_Object Qmake_symbolic_link
;
293 Lisp_Object Qfile_exists_p
;
294 Lisp_Object Qfile_executable_p
;
295 Lisp_Object Qfile_readable_p
;
296 Lisp_Object Qfile_writable_p
;
297 Lisp_Object Qfile_symlink_p
;
298 Lisp_Object Qaccess_file
;
299 Lisp_Object Qfile_directory_p
;
300 Lisp_Object Qfile_regular_p
;
301 Lisp_Object Qfile_accessible_directory_p
;
302 Lisp_Object Qfile_modes
;
303 Lisp_Object Qset_file_modes
;
304 Lisp_Object Qfile_newer_than_file_p
;
305 Lisp_Object Qinsert_file_contents
;
306 Lisp_Object Qwrite_region
;
307 Lisp_Object Qverify_visited_file_modtime
;
308 Lisp_Object Qset_visited_file_modtime
;
310 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
311 "Return FILENAME's handler function for OPERATION, if it has one.\n\
312 Otherwise, return nil.\n\
313 A file name is handled if one of the regular expressions in\n\
314 `file-name-handler-alist' matches it.\n\n\
315 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
316 any handlers that are members of `inhibit-file-name-handlers',\n\
317 but we still do run any other handlers. This lets handlers\n\
318 use the standard functions without calling themselves recursively.")
319 (filename
, operation
)
320 Lisp_Object filename
, operation
;
322 /* This function must not munge the match data. */
323 Lisp_Object chain
, inhibited_handlers
;
325 CHECK_STRING (filename
, 0);
327 if (EQ (operation
, Vinhibit_file_name_operation
))
328 inhibited_handlers
= Vinhibit_file_name_handlers
;
330 inhibited_handlers
= Qnil
;
332 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
333 chain
= XCONS (chain
)->cdr
)
336 elt
= XCONS (chain
)->car
;
340 string
= XCONS (elt
)->car
;
341 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
343 Lisp_Object handler
, tem
;
345 handler
= XCONS (elt
)->cdr
;
346 tem
= Fmemq (handler
, inhibited_handlers
);
357 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
359 "Return the directory component in file name FILENAME.\n\
360 Return nil if FILENAME does not include a directory.\n\
361 Otherwise return a directory spec.\n\
362 Given a Unix syntax file name, returns a string ending in slash;\n\
363 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
365 Lisp_Object filename
;
367 register unsigned char *beg
;
368 register unsigned char *p
;
371 CHECK_STRING (filename
, 0);
373 /* If the file name has special constructs in it,
374 call the corresponding file handler. */
375 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
377 return call2 (handler
, Qfile_name_directory
, filename
);
379 #ifdef FILE_SYSTEM_CASE
380 filename
= FILE_SYSTEM_CASE (filename
);
382 beg
= XSTRING (filename
)->data
;
384 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
386 p
= beg
+ STRING_BYTES (XSTRING (filename
));
388 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
390 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
393 /* only recognise drive specifier at the beginning */
395 /* handle the "/:d:foo" and "/:foo" cases correctly */
396 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
397 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
404 /* Expansion of "c:" to drive and default directory. */
407 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
408 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
409 unsigned char *r
= res
;
411 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
413 strncpy (res
, beg
, 2);
418 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
420 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
423 p
= beg
+ strlen (beg
);
426 CORRECT_DIR_SEPS (beg
);
429 if (STRING_MULTIBYTE (filename
))
430 return make_string (beg
, p
- beg
);
431 return make_unibyte_string (beg
, p
- beg
);
434 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
435 Sfile_name_nondirectory
, 1, 1, 0,
436 "Return file name FILENAME sans its directory.\n\
437 For example, in a Unix-syntax file name,\n\
438 this is everything after the last slash,\n\
439 or the entire name if it contains no slash.")
441 Lisp_Object filename
;
443 register unsigned char *beg
, *p
, *end
;
446 CHECK_STRING (filename
, 0);
448 /* If the file name has special constructs in it,
449 call the corresponding file handler. */
450 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
452 return call2 (handler
, Qfile_name_nondirectory
, filename
);
454 beg
= XSTRING (filename
)->data
;
455 end
= p
= beg
+ STRING_BYTES (XSTRING (filename
));
457 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
459 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
462 /* only recognise drive specifier at beginning */
464 /* handle the "/:d:foo" case correctly */
465 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
470 if (STRING_MULTIBYTE (filename
))
471 return make_string (p
, end
- p
);
472 return make_unibyte_string (p
, end
- p
);
475 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
476 Sunhandled_file_name_directory
, 1, 1, 0,
477 "Return a directly usable directory name somehow associated with FILENAME.\n\
478 A `directly usable' directory name is one that may be used without the\n\
479 intervention of any file handler.\n\
480 If FILENAME is a directly usable file itself, return\n\
481 \(file-name-directory FILENAME).\n\
482 The `call-process' and `start-process' functions use this function to\n\
483 get a current directory to run processes in.")
485 Lisp_Object filename
;
489 /* If the file name has special constructs in it,
490 call the corresponding file handler. */
491 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
493 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
495 return Ffile_name_directory (filename
);
500 file_name_as_directory (out
, in
)
503 int size
= strlen (in
) - 1;
516 /* Is it already a directory string? */
517 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
519 /* Is it a VMS directory file name? If so, hack VMS syntax. */
520 else if (! index (in
, '/')
521 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
522 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
523 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
524 || ! strncmp (&in
[size
- 5], ".dir", 4))
525 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
526 && in
[size
] == '1')))
528 register char *p
, *dot
;
532 dir:x.dir --> dir:[x]
533 dir:[x]y.dir --> dir:[x.y] */
535 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
538 strncpy (out
, in
, p
- in
);
557 dot
= index (p
, '.');
560 /* blindly remove any extension */
561 size
= strlen (out
) + (dot
- p
);
562 strncat (out
, p
, dot
- p
);
573 /* For Unix syntax, Append a slash if necessary */
574 if (!IS_DIRECTORY_SEP (out
[size
]))
576 out
[size
+ 1] = DIRECTORY_SEP
;
577 out
[size
+ 2] = '\0';
580 CORRECT_DIR_SEPS (out
);
586 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
587 Sfile_name_as_directory
, 1, 1, 0,
588 "Return a string representing file FILENAME interpreted as a directory.\n\
589 This operation exists because a directory is also a file, but its name as\n\
590 a directory is different from its name as a file.\n\
591 The result can be used as the value of `default-directory'\n\
592 or passed as second argument to `expand-file-name'.\n\
593 For a Unix-syntax file name, just appends a slash.\n\
594 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
601 CHECK_STRING (file
, 0);
605 /* If the file name has special constructs in it,
606 call the corresponding file handler. */
607 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
609 return call2 (handler
, Qfile_name_as_directory
, file
);
611 buf
= (char *) alloca (STRING_BYTES (XSTRING (file
)) + 10);
612 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
616 * Convert from directory name to filename.
618 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
619 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
620 * On UNIX, it's simple: just make sure there isn't a terminating /
622 * Value is nonzero if the string output is different from the input.
626 directory_file_name (src
, dst
)
634 struct FAB fab
= cc$rms_fab
;
635 struct NAM nam
= cc$rms_nam
;
636 char esa
[NAM$C_MAXRSS
];
641 if (! index (src
, '/')
642 && (src
[slen
- 1] == ']'
643 || src
[slen
- 1] == ':'
644 || src
[slen
- 1] == '>'))
646 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
648 fab
.fab$b_fns
= slen
;
649 fab
.fab$l_nam
= &nam
;
650 fab
.fab$l_fop
= FAB$M_NAM
;
653 nam
.nam$b_ess
= sizeof esa
;
654 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
656 /* We call SYS$PARSE to handle such things as [--] for us. */
657 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
659 slen
= nam
.nam$b_esl
;
660 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
665 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
667 /* what about when we have logical_name:???? */
668 if (src
[slen
- 1] == ':')
669 { /* Xlate logical name and see what we get */
670 ptr
= strcpy (dst
, src
); /* upper case for getenv */
673 if ('a' <= *ptr
&& *ptr
<= 'z')
677 dst
[slen
- 1] = 0; /* remove colon */
678 if (!(src
= egetenv (dst
)))
680 /* should we jump to the beginning of this procedure?
681 Good points: allows us to use logical names that xlate
683 Bad points: can be a problem if we just translated to a device
685 For now, I'll punt and always expect VMS names, and hope for
688 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
689 { /* no recursion here! */
695 { /* not a directory spec */
700 bracket
= src
[slen
- 1];
702 /* If bracket is ']' or '>', bracket - 2 is the corresponding
704 ptr
= index (src
, bracket
- 2);
706 { /* no opening bracket */
710 if (!(rptr
= rindex (src
, '.')))
713 strncpy (dst
, src
, slen
);
717 dst
[slen
++] = bracket
;
722 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
723 then translate the device and recurse. */
724 if (dst
[slen
- 1] == ':'
725 && dst
[slen
- 2] != ':' /* skip decnet nodes */
726 && strcmp (src
+ slen
, "[000000]") == 0)
728 dst
[slen
- 1] = '\0';
729 if ((ptr
= egetenv (dst
))
730 && (rlen
= strlen (ptr
) - 1) > 0
731 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
732 && ptr
[rlen
- 1] == '.')
734 char * buf
= (char *) alloca (strlen (ptr
) + 1);
738 return directory_file_name (buf
, dst
);
743 strcat (dst
, "[000000]");
747 rlen
= strlen (rptr
) - 1;
748 strncat (dst
, rptr
, rlen
);
749 dst
[slen
+ rlen
] = '\0';
750 strcat (dst
, ".DIR.1");
754 /* Process as Unix format: just remove any final slash.
755 But leave "/" unchanged; do not change it to "". */
758 /* Handle // as root for apollo's. */
759 if ((slen
> 2 && dst
[slen
- 1] == '/')
760 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
764 && IS_DIRECTORY_SEP (dst
[slen
- 1])
766 && !IS_ANY_SEP (dst
[slen
- 2])
772 CORRECT_DIR_SEPS (dst
);
777 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
779 "Returns the file name of the directory named DIRECTORY.\n\
780 This is the name of the file that holds the data for the directory DIRECTORY.\n\
781 This operation exists because a directory is also a file, but its name as\n\
782 a directory is different from its name as a file.\n\
783 In Unix-syntax, this function just removes the final slash.\n\
784 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
785 it returns a file name such as \"[X]Y.DIR.1\".")
787 Lisp_Object directory
;
792 CHECK_STRING (directory
, 0);
794 if (NILP (directory
))
797 /* If the file name has special constructs in it,
798 call the corresponding file handler. */
799 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
801 return call2 (handler
, Qdirectory_file_name
, directory
);
804 /* 20 extra chars is insufficient for VMS, since we might perform a
805 logical name translation. an equivalence string can be up to 255
806 chars long, so grab that much extra space... - sss */
807 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20 + 255);
809 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20);
811 directory_file_name (XSTRING (directory
)->data
, buf
);
812 return build_string (buf
);
815 static char make_temp_name_tbl
[64] =
817 'A','B','C','D','E','F','G','H',
818 'I','J','K','L','M','N','O','P',
819 'Q','R','S','T','U','V','W','X',
820 'Y','Z','a','b','c','d','e','f',
821 'g','h','i','j','k','l','m','n',
822 'o','p','q','r','s','t','u','v',
823 'w','x','y','z','0','1','2','3',
824 '4','5','6','7','8','9','-','_'
826 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
828 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
829 "Generate temporary file name (string) starting with PREFIX (a string).\n\
830 The Emacs process number forms part of the result,\n\
831 so there is no danger of generating a name being used by another process.\n\
833 In addition, this function makes an attempt to choose a name\n\
834 which has no existing file. To make this work,\n\
835 PREFIX should be an absolute file name.")
842 unsigned char *p
, *data
;
846 CHECK_STRING (prefix
, 0);
848 /* VAL is created by adding 6 characters to PREFIX. The first
849 three are the PID of this process, in base 64, and the second
850 three are incremented if the file already exists. This ensures
851 262144 unique file names per PID per PREFIX. */
853 pid
= (int) getpid ();
855 #ifdef HAVE_LONG_FILE_NAMES
856 sprintf (pidbuf
, "%d", pid
);
857 pidlen
= strlen (pidbuf
);
859 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
860 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
861 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
865 len
= XSTRING (prefix
)->size
;
866 val
= make_uninit_string (len
+ 3 + pidlen
);
867 data
= XSTRING (val
)->data
;
868 bcopy(XSTRING (prefix
)->data
, data
, len
);
871 bcopy (pidbuf
, p
, pidlen
);
874 /* Here we try to minimize useless stat'ing when this function is
875 invoked many times successively with the same PREFIX. We achieve
876 this by initializing count to a random value, and incrementing it
879 We don't want make-temp-name to be called while dumping,
880 because then make_temp_name_count_initialized_p would get set
881 and then make_temp_name_count would not be set when Emacs starts. */
883 if (!make_temp_name_count_initialized_p
)
885 make_temp_name_count
= (unsigned) time (NULL
);
886 make_temp_name_count_initialized_p
= 1;
892 unsigned num
= make_temp_name_count
;
894 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
895 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
896 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
898 /* Poor man's congruential RN generator. Replace with
899 ++make_temp_name_count for debugging. */
900 make_temp_name_count
+= 25229;
901 make_temp_name_count
%= 225307;
903 if (stat (data
, &ignored
) < 0)
905 /* We want to return only if errno is ENOENT. */
909 /* The error here is dubious, but there is little else we
910 can do. The alternatives are to return nil, which is
911 as bad as (and in many cases worse than) throwing the
912 error, or to ignore the error, which will likely result
913 in looping through 225307 stat's, which is not only
914 dog-slow, but also useless since it will fallback to
915 the errow below, anyway. */
916 report_file_error ("Cannot create temporary name for prefix `%s'",
917 Fcons (prefix
, Qnil
));
922 error ("Cannot create temporary name for prefix `%s'",
923 XSTRING (prefix
)->data
);
928 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
929 "Convert filename NAME to absolute, and canonicalize it.\n\
930 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
931 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
932 the current buffer's value of default-directory is used.\n\
933 File name components that are `.' are removed, and \n\
934 so are file name components followed by `..', along with the `..' itself;\n\
935 note that these simplifications are done without checking the resulting\n\
936 file names in the file system.\n\
937 An initial `~/' expands to your home directory.\n\
938 An initial `~USER/' expands to USER's home directory.\n\
939 See also the function `substitute-in-file-name'.")
940 (name
, default_directory
)
941 Lisp_Object name
, default_directory
;
945 register unsigned char *newdir
, *p
, *o
;
947 unsigned char *target
;
950 unsigned char * colon
= 0;
951 unsigned char * close
= 0;
952 unsigned char * slash
= 0;
953 unsigned char * brack
= 0;
954 int lbrack
= 0, rbrack
= 0;
959 int collapse_newdir
= 1;
965 CHECK_STRING (name
, 0);
967 /* If the file name has special constructs in it,
968 call the corresponding file handler. */
969 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
971 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
973 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
974 if (NILP (default_directory
))
975 default_directory
= current_buffer
->directory
;
976 if (! STRINGP (default_directory
))
977 default_directory
= build_string ("/");
979 if (!NILP (default_directory
))
981 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
983 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
986 o
= XSTRING (default_directory
)->data
;
988 /* Make sure DEFAULT_DIRECTORY is properly expanded.
989 It would be better to do this down below where we actually use
990 default_directory. Unfortunately, calling Fexpand_file_name recursively
991 could invoke GC, and the strings might be relocated. This would
992 be annoying because we have pointers into strings lying around
993 that would need adjusting, and people would add new pointers to
994 the code and forget to adjust them, resulting in intermittent bugs.
995 Putting this call here avoids all that crud.
997 The EQ test avoids infinite recursion. */
998 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
999 /* Save time in some common cases - as long as default_directory
1000 is not relative, it can be canonicalized with name below (if it
1001 is needed at all) without requiring it to be expanded now. */
1003 /* Detect MSDOS file names with drive specifiers. */
1004 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1006 /* Detect Windows file names in UNC format. */
1007 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1009 #else /* not DOS_NT */
1010 /* Detect Unix absolute file names (/... alone is not absolute on
1012 && ! (IS_DIRECTORY_SEP (o
[0]))
1013 #endif /* not DOS_NT */
1016 struct gcpro gcpro1
;
1019 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1024 /* Filenames on VMS are always upper case. */
1025 name
= Fupcase (name
);
1027 #ifdef FILE_SYSTEM_CASE
1028 name
= FILE_SYSTEM_CASE (name
);
1031 nm
= XSTRING (name
)->data
;
1034 /* We will force directory separators to be either all \ or /, so make
1035 a local copy to modify, even if there ends up being no change. */
1036 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1038 /* Note if special escape prefix is present, but remove for now. */
1039 if (nm
[0] == '/' && nm
[1] == ':')
1045 /* Find and remove drive specifier if present; this makes nm absolute
1046 even if the rest of the name appears to be relative. Only look for
1047 drive specifier at the beginning. */
1048 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1055 /* If we see "c://somedir", we want to strip the first slash after the
1056 colon when stripping the drive letter. Otherwise, this expands to
1058 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1060 #endif /* WINDOWSNT */
1064 /* Discard any previous drive specifier if nm is now in UNC format. */
1065 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1071 /* If nm is absolute, look for /./ or /../ sequences; if none are
1072 found, we can probably return right away. We will avoid allocating
1073 a new string if name is already fully expanded. */
1075 IS_DIRECTORY_SEP (nm
[0])
1077 && drive
&& !is_escaped
1080 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1087 /* If it turns out that the filename we want to return is just a
1088 suffix of FILENAME, we don't need to go through and edit
1089 things; we just need to construct a new string using data
1090 starting at the middle of FILENAME. If we set lose to a
1091 non-zero value, that means we've discovered that we can't do
1098 /* Since we know the name is absolute, we can assume that each
1099 element starts with a "/". */
1101 /* "." and ".." are hairy. */
1102 if (IS_DIRECTORY_SEP (p
[0])
1104 && (IS_DIRECTORY_SEP (p
[2])
1106 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1113 /* if dev:[dir]/, move nm to / */
1114 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1115 nm
= (brack
? brack
+ 1 : colon
+ 1);
1116 lbrack
= rbrack
= 0;
1124 /* VMS pre V4.4,convert '-'s in filenames. */
1125 if (lbrack
== rbrack
)
1127 if (dots
< 2) /* this is to allow negative version numbers */
1132 if (lbrack
> rbrack
&&
1133 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1134 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1140 /* count open brackets, reset close bracket pointer */
1141 if (p
[0] == '[' || p
[0] == '<')
1142 lbrack
++, brack
= 0;
1143 /* count close brackets, set close bracket pointer */
1144 if (p
[0] == ']' || p
[0] == '>')
1145 rbrack
++, brack
= p
;
1146 /* detect ][ or >< */
1147 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1149 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1150 nm
= p
+ 1, lose
= 1;
1151 if (p
[0] == ':' && (colon
|| slash
))
1152 /* if dev1:[dir]dev2:, move nm to dev2: */
1158 /* if /name/dev:, move nm to dev: */
1161 /* if node::dev:, move colon following dev */
1162 else if (colon
&& colon
[-1] == ':')
1164 /* if dev1:dev2:, move nm to dev2: */
1165 else if (colon
&& colon
[-1] != ':')
1170 if (p
[0] == ':' && !colon
)
1176 if (lbrack
== rbrack
)
1179 else if (p
[0] == '.')
1187 if (index (nm
, '/'))
1188 return build_string (sys_translate_unix (nm
));
1191 /* Make sure directories are all separated with / or \ as
1192 desired, but avoid allocation of a new string when not
1194 CORRECT_DIR_SEPS (nm
);
1196 if (IS_DIRECTORY_SEP (nm
[1]))
1198 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1199 name
= build_string (nm
);
1203 /* drive must be set, so this is okay */
1204 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1206 name
= make_string (nm
- 2, p
- nm
+ 2);
1207 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1208 XSTRING (name
)->data
[1] = ':';
1211 #else /* not DOS_NT */
1212 if (nm
== XSTRING (name
)->data
)
1214 return build_string (nm
);
1215 #endif /* not DOS_NT */
1219 /* At this point, nm might or might not be an absolute file name. We
1220 need to expand ~ or ~user if present, otherwise prefix nm with
1221 default_directory if nm is not absolute, and finally collapse /./
1222 and /foo/../ sequences.
1224 We set newdir to be the appropriate prefix if one is needed:
1225 - the relevant user directory if nm starts with ~ or ~user
1226 - the specified drive's working dir (DOS/NT only) if nm does not
1228 - the value of default_directory.
1230 Note that these prefixes are not guaranteed to be absolute (except
1231 for the working dir of a drive). Therefore, to ensure we always
1232 return an absolute name, if the final prefix is not absolute we
1233 append it to the current working directory. */
1237 if (nm
[0] == '~') /* prefix ~ */
1239 if (IS_DIRECTORY_SEP (nm
[1])
1243 || nm
[1] == 0) /* ~ by itself */
1245 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1246 newdir
= (unsigned char *) "";
1249 collapse_newdir
= 0;
1252 nm
++; /* Don't leave the slash in nm. */
1255 else /* ~user/filename */
1257 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1262 o
= (unsigned char *) alloca (p
- nm
+ 1);
1263 bcopy ((char *) nm
, o
, p
- nm
);
1266 pw
= (struct passwd
*) getpwnam (o
+ 1);
1269 newdir
= (unsigned char *) pw
-> pw_dir
;
1271 nm
= p
+ 1; /* skip the terminator */
1275 collapse_newdir
= 0;
1280 /* If we don't find a user of that name, leave the name
1281 unchanged; don't move nm forward to p. */
1286 /* On DOS and Windows, nm is absolute if a drive name was specified;
1287 use the drive's current directory as the prefix if needed. */
1288 if (!newdir
&& drive
)
1290 /* Get default directory if needed to make nm absolute. */
1291 if (!IS_DIRECTORY_SEP (nm
[0]))
1293 newdir
= alloca (MAXPATHLEN
+ 1);
1294 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1299 /* Either nm starts with /, or drive isn't mounted. */
1300 newdir
= alloca (4);
1301 newdir
[0] = DRIVE_LETTER (drive
);
1309 /* Finally, if no prefix has been specified and nm is not absolute,
1310 then it must be expanded relative to default_directory. */
1314 /* /... alone is not absolute on DOS and Windows. */
1315 && !IS_DIRECTORY_SEP (nm
[0])
1318 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1325 newdir
= XSTRING (default_directory
)->data
;
1327 /* Note if special escape prefix is present, but remove for now. */
1328 if (newdir
[0] == '/' && newdir
[1] == ':')
1339 /* First ensure newdir is an absolute name. */
1341 /* Detect MSDOS file names with drive specifiers. */
1342 ! (IS_DRIVE (newdir
[0])
1343 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1345 /* Detect Windows file names in UNC format. */
1346 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1350 /* Effectively, let newdir be (expand-file-name newdir cwd).
1351 Because of the admonition against calling expand-file-name
1352 when we have pointers into lisp strings, we accomplish this
1353 indirectly by prepending newdir to nm if necessary, and using
1354 cwd (or the wd of newdir's drive) as the new newdir. */
1356 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1361 if (!IS_DIRECTORY_SEP (nm
[0]))
1363 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1364 file_name_as_directory (tmp
, newdir
);
1368 newdir
= alloca (MAXPATHLEN
+ 1);
1371 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1378 /* Strip off drive name from prefix, if present. */
1379 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1385 /* Keep only a prefix from newdir if nm starts with slash
1386 (//server/share for UNC, nothing otherwise). */
1387 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1390 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1392 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1394 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1396 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1408 /* Get rid of any slash at the end of newdir, unless newdir is
1409 just / or // (an incomplete UNC name). */
1410 length
= strlen (newdir
);
1411 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1413 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1417 unsigned char *temp
= (unsigned char *) alloca (length
);
1418 bcopy (newdir
, temp
, length
- 1);
1419 temp
[length
- 1] = 0;
1427 /* Now concatenate the directory and name to new space in the stack frame */
1428 tlen
+= strlen (nm
) + 1;
1430 /* Reserve space for drive specifier and escape prefix, since either
1431 or both may need to be inserted. (The Microsoft x86 compiler
1432 produces incorrect code if the following two lines are combined.) */
1433 target
= (unsigned char *) alloca (tlen
+ 4);
1435 #else /* not DOS_NT */
1436 target
= (unsigned char *) alloca (tlen
);
1437 #endif /* not DOS_NT */
1443 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1446 /* If newdir is effectively "C:/", then the drive letter will have
1447 been stripped and newdir will be "/". Concatenating with an
1448 absolute directory in nm produces "//", which will then be
1449 incorrectly treated as a network share. Ignore newdir in
1450 this case (keeping the drive letter). */
1451 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1452 && newdir
[1] == '\0'))
1454 strcpy (target
, newdir
);
1458 file_name_as_directory (target
, newdir
);
1461 strcat (target
, nm
);
1463 if (index (target
, '/'))
1464 strcpy (target
, sys_translate_unix (target
));
1467 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1469 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1477 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1483 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1484 /* brackets are offset from each other by 2 */
1487 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1488 /* convert [foo][bar] to [bar] */
1489 while (o
[-1] != '[' && o
[-1] != '<')
1491 else if (*p
== '-' && *o
!= '.')
1494 else if (p
[0] == '-' && o
[-1] == '.' &&
1495 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1496 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1500 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1501 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1503 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1505 /* else [foo.-] ==> [-] */
1511 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1512 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1518 if (!IS_DIRECTORY_SEP (*p
))
1522 else if (IS_DIRECTORY_SEP (p
[0])
1524 && (IS_DIRECTORY_SEP (p
[2])
1527 /* If "/." is the entire filename, keep the "/". Otherwise,
1528 just delete the whole "/.". */
1529 if (o
== target
&& p
[2] == '\0')
1533 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1534 /* `/../' is the "superroot" on certain file systems. */
1536 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1538 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1540 /* Keep initial / only if this is the whole name. */
1541 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1549 #endif /* not VMS */
1553 /* At last, set drive name. */
1555 /* Except for network file name. */
1556 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1557 #endif /* WINDOWSNT */
1559 if (!drive
) abort ();
1561 target
[0] = DRIVE_LETTER (drive
);
1564 /* Reinsert the escape prefix if required. */
1571 CORRECT_DIR_SEPS (target
);
1574 return make_string (target
, o
- target
);
1578 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1579 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1580 "Convert FILENAME to absolute, and canonicalize it.\n\
1581 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1582 (does not start with slash); if DEFAULT is nil or missing,\n\
1583 the current buffer's value of default-directory is used.\n\
1584 Filenames containing `.' or `..' as components are simplified;\n\
1585 initial `~/' expands to your home directory.\n\
1586 See also the function `substitute-in-file-name'.")
1588 Lisp_Object name
, defalt
;
1592 register unsigned char *newdir
, *p
, *o
;
1594 unsigned char *target
;
1598 unsigned char * colon
= 0;
1599 unsigned char * close
= 0;
1600 unsigned char * slash
= 0;
1601 unsigned char * brack
= 0;
1602 int lbrack
= 0, rbrack
= 0;
1606 CHECK_STRING (name
, 0);
1609 /* Filenames on VMS are always upper case. */
1610 name
= Fupcase (name
);
1613 nm
= XSTRING (name
)->data
;
1615 /* If nm is absolute, flush ...// and detect /./ and /../.
1616 If no /./ or /../ we can return right away. */
1628 if (p
[0] == '/' && p
[1] == '/'
1630 /* // at start of filename is meaningful on Apollo system. */
1635 if (p
[0] == '/' && p
[1] == '~')
1636 nm
= p
+ 1, lose
= 1;
1637 if (p
[0] == '/' && p
[1] == '.'
1638 && (p
[2] == '/' || p
[2] == 0
1639 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1645 /* if dev:[dir]/, move nm to / */
1646 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1647 nm
= (brack
? brack
+ 1 : colon
+ 1);
1648 lbrack
= rbrack
= 0;
1656 /* VMS pre V4.4,convert '-'s in filenames. */
1657 if (lbrack
== rbrack
)
1659 if (dots
< 2) /* this is to allow negative version numbers */
1664 if (lbrack
> rbrack
&&
1665 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1666 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1672 /* count open brackets, reset close bracket pointer */
1673 if (p
[0] == '[' || p
[0] == '<')
1674 lbrack
++, brack
= 0;
1675 /* count close brackets, set close bracket pointer */
1676 if (p
[0] == ']' || p
[0] == '>')
1677 rbrack
++, brack
= p
;
1678 /* detect ][ or >< */
1679 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1681 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1682 nm
= p
+ 1, lose
= 1;
1683 if (p
[0] == ':' && (colon
|| slash
))
1684 /* if dev1:[dir]dev2:, move nm to dev2: */
1690 /* If /name/dev:, move nm to dev: */
1693 /* If node::dev:, move colon following dev */
1694 else if (colon
&& colon
[-1] == ':')
1696 /* If dev1:dev2:, move nm to dev2: */
1697 else if (colon
&& colon
[-1] != ':')
1702 if (p
[0] == ':' && !colon
)
1708 if (lbrack
== rbrack
)
1711 else if (p
[0] == '.')
1719 if (index (nm
, '/'))
1720 return build_string (sys_translate_unix (nm
));
1722 if (nm
== XSTRING (name
)->data
)
1724 return build_string (nm
);
1728 /* Now determine directory to start with and put it in NEWDIR */
1732 if (nm
[0] == '~') /* prefix ~ */
1737 || nm
[1] == 0)/* ~/filename */
1739 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1740 newdir
= (unsigned char *) "";
1743 nm
++; /* Don't leave the slash in nm. */
1746 else /* ~user/filename */
1748 /* Get past ~ to user */
1749 unsigned char *user
= nm
+ 1;
1750 /* Find end of name. */
1751 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1752 int len
= ptr
? ptr
- user
: strlen (user
);
1754 unsigned char *ptr1
= index (user
, ':');
1755 if (ptr1
!= 0 && ptr1
- user
< len
)
1758 /* Copy the user name into temp storage. */
1759 o
= (unsigned char *) alloca (len
+ 1);
1760 bcopy ((char *) user
, o
, len
);
1763 /* Look up the user name. */
1764 pw
= (struct passwd
*) getpwnam (o
+ 1);
1766 error ("\"%s\" isn't a registered user", o
+ 1);
1768 newdir
= (unsigned char *) pw
->pw_dir
;
1770 /* Discard the user name from NM. */
1777 #endif /* not VMS */
1781 defalt
= current_buffer
->directory
;
1782 CHECK_STRING (defalt
, 1);
1783 newdir
= XSTRING (defalt
)->data
;
1786 /* Now concatenate the directory and name to new space in the stack frame */
1788 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1789 target
= (unsigned char *) alloca (tlen
);
1795 if (nm
[0] == 0 || nm
[0] == '/')
1796 strcpy (target
, newdir
);
1799 file_name_as_directory (target
, newdir
);
1802 strcat (target
, nm
);
1804 if (index (target
, '/'))
1805 strcpy (target
, sys_translate_unix (target
));
1808 /* Now canonicalize by removing /. and /foo/.. if they appear */
1816 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1822 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1823 /* brackets are offset from each other by 2 */
1826 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1827 /* convert [foo][bar] to [bar] */
1828 while (o
[-1] != '[' && o
[-1] != '<')
1830 else if (*p
== '-' && *o
!= '.')
1833 else if (p
[0] == '-' && o
[-1] == '.' &&
1834 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1835 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1839 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1840 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1842 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1844 /* else [foo.-] ==> [-] */
1850 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1851 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1861 else if (!strncmp (p
, "//", 2)
1863 /* // at start of filename is meaningful in Apollo system. */
1871 else if (p
[0] == '/' && p
[1] == '.' &&
1872 (p
[2] == '/' || p
[2] == 0))
1874 else if (!strncmp (p
, "/..", 3)
1875 /* `/../' is the "superroot" on certain file systems. */
1877 && (p
[3] == '/' || p
[3] == 0))
1879 while (o
!= target
&& *--o
!= '/')
1882 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1886 if (o
== target
&& *o
== '/')
1894 #endif /* not VMS */
1897 return make_string (target
, o
- target
);
1901 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1902 Ssubstitute_in_file_name
, 1, 1, 0,
1903 "Substitute environment variables referred to in FILENAME.\n\
1904 `$FOO' where FOO is an environment variable name means to substitute\n\
1905 the value of that variable. The variable name should be terminated\n\
1906 with a character not a letter, digit or underscore; otherwise, enclose\n\
1907 the entire variable name in braces.\n\
1908 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1909 On VMS, `$' substitution is not done; this function does little and only\n\
1910 duplicates what `expand-file-name' does.")
1912 Lisp_Object filename
;
1916 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1917 unsigned char *target
;
1919 int substituted
= 0;
1921 Lisp_Object handler
;
1923 CHECK_STRING (filename
, 0);
1925 /* If the file name has special constructs in it,
1926 call the corresponding file handler. */
1927 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1928 if (!NILP (handler
))
1929 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1931 nm
= XSTRING (filename
)->data
;
1933 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1934 CORRECT_DIR_SEPS (nm
);
1935 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1937 endp
= nm
+ STRING_BYTES (XSTRING (filename
));
1939 /* If /~ or // appears, discard everything through first slash. */
1941 for (p
= nm
; p
!= endp
; p
++)
1944 #if defined (APOLLO) || defined (WINDOWSNT)
1945 /* // at start of file name is meaningful in Apollo and
1946 WindowsNT systems. */
1947 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1948 #else /* not (APOLLO || WINDOWSNT) */
1949 || IS_DIRECTORY_SEP (p
[0])
1950 #endif /* not (APOLLO || WINDOWSNT) */
1955 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1957 || IS_DIRECTORY_SEP (p
[-1])))
1963 /* see comment in expand-file-name about drive specifiers */
1964 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1965 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1974 return build_string (nm
);
1977 /* See if any variables are substituted into the string
1978 and find the total length of their values in `total' */
1980 for (p
= nm
; p
!= endp
;)
1990 /* "$$" means a single "$" */
1999 while (p
!= endp
&& *p
!= '}') p
++;
2000 if (*p
!= '}') goto missingclose
;
2006 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2010 /* Copy out the variable name */
2011 target
= (unsigned char *) alloca (s
- o
+ 1);
2012 strncpy (target
, o
, s
- o
);
2015 strupr (target
); /* $home == $HOME etc. */
2018 /* Get variable value */
2019 o
= (unsigned char *) egetenv (target
);
2020 if (!o
) goto badvar
;
2021 total
+= strlen (o
);
2028 /* If substitution required, recopy the string and do it */
2029 /* Make space in stack frame for the new copy */
2030 xnm
= (unsigned char *) alloca (STRING_BYTES (XSTRING (filename
)) + total
+ 1);
2033 /* Copy the rest of the name through, replacing $ constructs with values */
2050 while (p
!= endp
&& *p
!= '}') p
++;
2051 if (*p
!= '}') goto missingclose
;
2057 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2061 /* Copy out the variable name */
2062 target
= (unsigned char *) alloca (s
- o
+ 1);
2063 strncpy (target
, o
, s
- o
);
2066 strupr (target
); /* $home == $HOME etc. */
2069 /* Get variable value */
2070 o
= (unsigned char *) egetenv (target
);
2074 if (STRING_MULTIBYTE (filename
))
2076 /* If the original string is multibyte,
2077 convert what we substitute into multibyte. */
2078 unsigned char workbuf
[4], *str
;
2084 c
= unibyte_char_to_multibyte (c
);
2085 if (! SINGLE_BYTE_CHAR_P (c
))
2087 len
= CHAR_STRING (c
, workbuf
, str
);
2088 bcopy (str
, x
, len
);
2104 /* If /~ or // appears, discard everything through first slash. */
2106 for (p
= xnm
; p
!= x
; p
++)
2108 #if defined (APOLLO) || defined (WINDOWSNT)
2109 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2110 #else /* not (APOLLO || WINDOWSNT) */
2111 || IS_DIRECTORY_SEP (p
[0])
2112 #endif /* not (APOLLO || WINDOWSNT) */
2114 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2117 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2118 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2122 if (STRING_MULTIBYTE (filename
))
2123 return make_string (xnm
, x
- xnm
);
2124 return make_unibyte_string (xnm
, x
- xnm
);
2127 error ("Bad format environment-variable substitution");
2129 error ("Missing \"}\" in environment-variable substitution");
2131 error ("Substituting nonexistent environment variable \"%s\"", target
);
2134 #endif /* not VMS */
2137 /* A slightly faster and more convenient way to get
2138 (directory-file-name (expand-file-name FOO)). */
2141 expand_and_dir_to_file (filename
, defdir
)
2142 Lisp_Object filename
, defdir
;
2144 register Lisp_Object absname
;
2146 absname
= Fexpand_file_name (filename
, defdir
);
2149 register int c
= XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1];
2150 if (c
== ':' || c
== ']' || c
== '>')
2151 absname
= Fdirectory_file_name (absname
);
2154 /* Remove final slash, if any (unless this is the root dir).
2155 stat behaves differently depending! */
2156 if (XSTRING (absname
)->size
> 1
2157 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1])
2158 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
))-2]))
2159 /* We cannot take shortcuts; they might be wrong for magic file names. */
2160 absname
= Fdirectory_file_name (absname
);
2165 /* Signal an error if the file ABSNAME already exists.
2166 If INTERACTIVE is nonzero, ask the user whether to proceed,
2167 and bypass the error if the user says to go ahead.
2168 QUERYSTRING is a name for the action that is being considered
2171 *STATPTR is used to store the stat information if the file exists.
2172 If the file does not exist, STATPTR->st_mode is set to 0.
2173 If STATPTR is null, we don't store into it.
2175 If QUICK is nonzero, we ask for y or n, not yes or no. */
2178 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2179 Lisp_Object absname
;
2180 unsigned char *querystring
;
2182 struct stat
*statptr
;
2185 register Lisp_Object tem
, encoded_filename
;
2186 struct stat statbuf
;
2187 struct gcpro gcpro1
;
2189 encoded_filename
= ENCODE_FILE (absname
);
2191 /* stat is a good way to tell whether the file exists,
2192 regardless of what access permissions it has. */
2193 if (stat (XSTRING (encoded_filename
)->data
, &statbuf
) >= 0)
2196 Fsignal (Qfile_already_exists
,
2197 Fcons (build_string ("File already exists"),
2198 Fcons (absname
, Qnil
)));
2200 tem
= format1 ("File %s already exists; %s anyway? ",
2201 XSTRING (absname
)->data
, querystring
);
2203 tem
= Fy_or_n_p (tem
);
2205 tem
= do_yes_or_no_p (tem
);
2208 Fsignal (Qfile_already_exists
,
2209 Fcons (build_string ("File already exists"),
2210 Fcons (absname
, Qnil
)));
2217 statptr
->st_mode
= 0;
2222 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2223 "fCopy file: \nFCopy %s to file: \np\nP",
2224 "Copy FILE to NEWNAME. Both args must be strings.\n\
2225 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2226 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2227 A number as third arg means request confirmation if NEWNAME already exists.\n\
2228 This is what happens in interactive use with M-x.\n\
2229 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2230 last-modified time as the old one. (This works on only some systems.)\n\
2231 A prefix arg makes KEEP-TIME non-nil.")
2232 (file
, newname
, ok_if_already_exists
, keep_date
)
2233 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2236 char buf
[16 * 1024];
2237 struct stat st
, out_st
;
2238 Lisp_Object handler
;
2239 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2240 int count
= specpdl_ptr
- specpdl
;
2241 int input_file_statable_p
;
2242 Lisp_Object encoded_file
, encoded_newname
;
2244 encoded_file
= encoded_newname
= Qnil
;
2245 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2246 CHECK_STRING (file
, 0);
2247 CHECK_STRING (newname
, 1);
2249 file
= Fexpand_file_name (file
, Qnil
);
2250 newname
= Fexpand_file_name (newname
, Qnil
);
2252 /* If the input file name has special constructs in it,
2253 call the corresponding file handler. */
2254 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2255 /* Likewise for output file name. */
2257 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2258 if (!NILP (handler
))
2259 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2260 ok_if_already_exists
, keep_date
));
2262 encoded_file
= ENCODE_FILE (file
);
2263 encoded_newname
= ENCODE_FILE (newname
);
2265 if (NILP (ok_if_already_exists
)
2266 || INTEGERP (ok_if_already_exists
))
2267 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2268 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2269 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2272 ifd
= open (XSTRING (encoded_file
)->data
, O_RDONLY
);
2274 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2276 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2278 /* We can only copy regular files and symbolic links. Other files are not
2280 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2282 #if !defined (DOS_NT) || __DJGPP__ > 1
2283 if (out_st
.st_mode
!= 0
2284 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2287 report_file_error ("Input and output files are the same",
2288 Fcons (file
, Fcons (newname
, Qnil
)));
2292 #if defined (S_ISREG) && defined (S_ISLNK)
2293 if (input_file_statable_p
)
2295 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2297 #if defined (EISDIR)
2298 /* Get a better looking error message. */
2301 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2304 #endif /* S_ISREG && S_ISLNK */
2307 /* Create the copy file with the same record format as the input file */
2308 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2311 /* System's default file type was set to binary by _fmode in emacs.c. */
2312 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2313 #else /* not MSDOS */
2314 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2315 #endif /* not MSDOS */
2318 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2320 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2324 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2325 if (write (ofd
, buf
, n
) != n
)
2326 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2329 /* Closing the output clobbers the file times on some systems. */
2330 if (close (ofd
) < 0)
2331 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2333 if (input_file_statable_p
)
2335 if (!NILP (keep_date
))
2337 EMACS_TIME atime
, mtime
;
2338 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2339 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2340 if (set_file_times (XSTRING (encoded_newname
)->data
,
2342 Fsignal (Qfile_date_error
,
2343 Fcons (build_string ("Cannot set file date"),
2344 Fcons (newname
, Qnil
)));
2347 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2349 #if defined (__DJGPP__) && __DJGPP__ > 1
2350 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2351 and if it can't, it tells so. Otherwise, under MSDOS we usually
2352 get only the READ bit, which will make the copied file read-only,
2353 so it's better not to chmod at all. */
2354 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2355 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2356 #endif /* DJGPP version 2 or newer */
2362 /* Discard the unwind protects. */
2363 specpdl_ptr
= specpdl
+ count
;
2369 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2370 Smake_directory_internal
, 1, 1, 0,
2371 "Create a new directory named DIRECTORY.")
2373 Lisp_Object directory
;
2376 Lisp_Object handler
;
2377 Lisp_Object encoded_dir
;
2379 CHECK_STRING (directory
, 0);
2380 directory
= Fexpand_file_name (directory
, Qnil
);
2382 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2383 if (!NILP (handler
))
2384 return call2 (handler
, Qmake_directory_internal
, directory
);
2386 encoded_dir
= ENCODE_FILE (directory
);
2388 dir
= XSTRING (encoded_dir
)->data
;
2391 if (mkdir (dir
) != 0)
2393 if (mkdir (dir
, 0777) != 0)
2395 report_file_error ("Creating directory", Flist (1, &directory
));
2400 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2401 "Delete the directory named DIRECTORY.")
2403 Lisp_Object directory
;
2406 Lisp_Object handler
;
2407 Lisp_Object encoded_dir
;
2409 CHECK_STRING (directory
, 0);
2410 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2412 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2413 if (!NILP (handler
))
2414 return call2 (handler
, Qdelete_directory
, directory
);
2416 encoded_dir
= ENCODE_FILE (directory
);
2418 dir
= XSTRING (encoded_dir
)->data
;
2420 if (rmdir (dir
) != 0)
2421 report_file_error ("Removing directory", Flist (1, &directory
));
2426 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2427 "Delete file named FILENAME.\n\
2428 If file has multiple names, it continues to exist with the other names.")
2430 Lisp_Object filename
;
2432 Lisp_Object handler
;
2433 Lisp_Object encoded_file
;
2435 CHECK_STRING (filename
, 0);
2436 filename
= Fexpand_file_name (filename
, Qnil
);
2438 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2439 if (!NILP (handler
))
2440 return call2 (handler
, Qdelete_file
, filename
);
2442 encoded_file
= ENCODE_FILE (filename
);
2444 if (0 > unlink (XSTRING (encoded_file
)->data
))
2445 report_file_error ("Removing old name", Flist (1, &filename
));
2450 internal_delete_file_1 (ignore
)
2456 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2459 internal_delete_file (filename
)
2460 Lisp_Object filename
;
2462 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2463 Qt
, internal_delete_file_1
));
2466 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2467 "fRename file: \nFRename %s to file: \np",
2468 "Rename FILE as NEWNAME. Both args strings.\n\
2469 If file has names other than FILE, it continues to have those names.\n\
2470 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2471 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2472 A number as third arg means request confirmation if NEWNAME already exists.\n\
2473 This is what happens in interactive use with M-x.")
2474 (file
, newname
, ok_if_already_exists
)
2475 Lisp_Object file
, newname
, ok_if_already_exists
;
2478 Lisp_Object args
[2];
2480 Lisp_Object handler
;
2481 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2482 Lisp_Object encoded_file
, encoded_newname
;
2484 encoded_file
= encoded_newname
= Qnil
;
2485 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2486 CHECK_STRING (file
, 0);
2487 CHECK_STRING (newname
, 1);
2488 file
= Fexpand_file_name (file
, Qnil
);
2489 newname
= Fexpand_file_name (newname
, Qnil
);
2491 /* If the file name has special constructs in it,
2492 call the corresponding file handler. */
2493 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2495 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2496 if (!NILP (handler
))
2497 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2498 file
, newname
, ok_if_already_exists
));
2500 encoded_file
= ENCODE_FILE (file
);
2501 encoded_newname
= ENCODE_FILE (newname
);
2503 if (NILP (ok_if_already_exists
)
2504 || INTEGERP (ok_if_already_exists
))
2505 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2506 INTEGERP (ok_if_already_exists
), 0, 0);
2508 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2510 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2511 || 0 > unlink (XSTRING (encoded_file
)->data
))
2516 Fcopy_file (file
, newname
,
2517 /* We have already prompted if it was an integer,
2518 so don't have copy-file prompt again. */
2519 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2520 Fdelete_file (file
);
2527 report_file_error ("Renaming", Flist (2, args
));
2530 report_file_error ("Renaming", Flist (2, &file
));
2537 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2538 "fAdd name to file: \nFName to add to %s: \np",
2539 "Give FILE additional name NEWNAME. Both args strings.\n\
2540 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2541 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2542 A number as third arg means request confirmation if NEWNAME already exists.\n\
2543 This is what happens in interactive use with M-x.")
2544 (file
, newname
, ok_if_already_exists
)
2545 Lisp_Object file
, newname
, ok_if_already_exists
;
2548 Lisp_Object args
[2];
2550 Lisp_Object handler
;
2551 Lisp_Object encoded_file
, encoded_newname
;
2552 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2554 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2555 encoded_file
= encoded_newname
= Qnil
;
2556 CHECK_STRING (file
, 0);
2557 CHECK_STRING (newname
, 1);
2558 file
= Fexpand_file_name (file
, Qnil
);
2559 newname
= Fexpand_file_name (newname
, Qnil
);
2561 /* If the file name has special constructs in it,
2562 call the corresponding file handler. */
2563 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2564 if (!NILP (handler
))
2565 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2566 newname
, ok_if_already_exists
));
2568 /* If the new name has special constructs in it,
2569 call the corresponding file handler. */
2570 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2571 if (!NILP (handler
))
2572 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2573 newname
, ok_if_already_exists
));
2575 encoded_file
= ENCODE_FILE (file
);
2576 encoded_newname
= ENCODE_FILE (newname
);
2578 if (NILP (ok_if_already_exists
)
2579 || INTEGERP (ok_if_already_exists
))
2580 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2581 INTEGERP (ok_if_already_exists
), 0, 0);
2583 unlink (XSTRING (newname
)->data
);
2584 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2589 report_file_error ("Adding new name", Flist (2, args
));
2591 report_file_error ("Adding new name", Flist (2, &file
));
2600 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2601 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2602 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2603 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2604 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2605 A number as third arg means request confirmation if LINKNAME already exists.\n\
2606 This happens for interactive use with M-x.")
2607 (filename
, linkname
, ok_if_already_exists
)
2608 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2611 Lisp_Object args
[2];
2613 Lisp_Object handler
;
2614 Lisp_Object encoded_filename
, encoded_linkname
;
2615 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2617 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2618 encoded_filename
= encoded_linkname
= Qnil
;
2619 CHECK_STRING (filename
, 0);
2620 CHECK_STRING (linkname
, 1);
2621 /* If the link target has a ~, we must expand it to get
2622 a truly valid file name. Otherwise, do not expand;
2623 we want to permit links to relative file names. */
2624 if (XSTRING (filename
)->data
[0] == '~')
2625 filename
= Fexpand_file_name (filename
, Qnil
);
2626 linkname
= Fexpand_file_name (linkname
, Qnil
);
2628 /* If the file name has special constructs in it,
2629 call the corresponding file handler. */
2630 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2631 if (!NILP (handler
))
2632 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2633 linkname
, ok_if_already_exists
));
2635 /* If the new link name has special constructs in it,
2636 call the corresponding file handler. */
2637 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2638 if (!NILP (handler
))
2639 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2640 linkname
, ok_if_already_exists
));
2642 encoded_filename
= ENCODE_FILE (filename
);
2643 encoded_linkname
= ENCODE_FILE (linkname
);
2645 if (NILP (ok_if_already_exists
)
2646 || INTEGERP (ok_if_already_exists
))
2647 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2648 INTEGERP (ok_if_already_exists
), 0, 0);
2649 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2650 XSTRING (encoded_linkname
)->data
))
2652 /* If we didn't complain already, silently delete existing file. */
2653 if (errno
== EEXIST
)
2655 unlink (XSTRING (encoded_linkname
)->data
);
2656 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2657 XSTRING (encoded_linkname
)->data
))
2667 report_file_error ("Making symbolic link", Flist (2, args
));
2669 report_file_error ("Making symbolic link", Flist (2, &filename
));
2675 #endif /* S_IFLNK */
2679 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2680 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2681 "Define the job-wide logical name NAME to have the value STRING.\n\
2682 If STRING is nil or a null string, the logical name NAME is deleted.")
2687 CHECK_STRING (name
, 0);
2689 delete_logical_name (XSTRING (name
)->data
);
2692 CHECK_STRING (string
, 1);
2694 if (XSTRING (string
)->size
== 0)
2695 delete_logical_name (XSTRING (name
)->data
);
2697 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2706 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2707 "Open a network connection to PATH using LOGIN as the login string.")
2709 Lisp_Object path
, login
;
2713 CHECK_STRING (path
, 0);
2714 CHECK_STRING (login
, 0);
2716 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2718 if (netresult
== -1)
2723 #endif /* HPUX_NET */
2725 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2727 "Return t if file FILENAME specifies an absolute file name.\n\
2728 On Unix, this is a name starting with a `/' or a `~'.")
2730 Lisp_Object filename
;
2734 CHECK_STRING (filename
, 0);
2735 ptr
= XSTRING (filename
)->data
;
2736 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2738 /* ??? This criterion is probably wrong for '<'. */
2739 || index (ptr
, ':') || index (ptr
, '<')
2740 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2744 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2752 /* Return nonzero if file FILENAME exists and can be executed. */
2755 check_executable (filename
)
2759 int len
= strlen (filename
);
2762 if (stat (filename
, &st
) < 0)
2764 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2765 return ((st
.st_mode
& S_IEXEC
) != 0);
2767 return (S_ISREG (st
.st_mode
)
2769 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2770 || stricmp (suffix
, ".exe") == 0
2771 || stricmp (suffix
, ".bat") == 0)
2772 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2773 #endif /* not WINDOWSNT */
2774 #else /* not DOS_NT */
2775 #ifdef HAVE_EUIDACCESS
2776 return (euidaccess (filename
, 1) >= 0);
2778 /* Access isn't quite right because it uses the real uid
2779 and we really want to test with the effective uid.
2780 But Unix doesn't give us a right way to do it. */
2781 return (access (filename
, 1) >= 0);
2783 #endif /* not DOS_NT */
2786 /* Return nonzero if file FILENAME exists and can be written. */
2789 check_writable (filename
)
2794 if (stat (filename
, &st
) < 0)
2796 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2797 #else /* not MSDOS */
2798 #ifdef HAVE_EUIDACCESS
2799 return (euidaccess (filename
, 2) >= 0);
2801 /* Access isn't quite right because it uses the real uid
2802 and we really want to test with the effective uid.
2803 But Unix doesn't give us a right way to do it.
2804 Opening with O_WRONLY could work for an ordinary file,
2805 but would lose for directories. */
2806 return (access (filename
, 2) >= 0);
2808 #endif /* not MSDOS */
2811 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2812 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2813 See also `file-readable-p' and `file-attributes'.")
2815 Lisp_Object filename
;
2817 Lisp_Object absname
;
2818 Lisp_Object handler
;
2819 struct stat statbuf
;
2821 CHECK_STRING (filename
, 0);
2822 absname
= Fexpand_file_name (filename
, Qnil
);
2824 /* If the file name has special constructs in it,
2825 call the corresponding file handler. */
2826 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2827 if (!NILP (handler
))
2828 return call2 (handler
, Qfile_exists_p
, absname
);
2830 absname
= ENCODE_FILE (absname
);
2832 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2835 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2836 "Return t if FILENAME can be executed by you.\n\
2837 For a directory, this means you can access files in that directory.")
2839 Lisp_Object filename
;
2842 Lisp_Object absname
;
2843 Lisp_Object handler
;
2845 CHECK_STRING (filename
, 0);
2846 absname
= Fexpand_file_name (filename
, Qnil
);
2848 /* If the file name has special constructs in it,
2849 call the corresponding file handler. */
2850 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2851 if (!NILP (handler
))
2852 return call2 (handler
, Qfile_executable_p
, absname
);
2854 absname
= ENCODE_FILE (absname
);
2856 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2859 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2860 "Return t if file FILENAME exists and you can read it.\n\
2861 See also `file-exists-p' and `file-attributes'.")
2863 Lisp_Object filename
;
2865 Lisp_Object absname
;
2866 Lisp_Object handler
;
2869 struct stat statbuf
;
2871 CHECK_STRING (filename
, 0);
2872 absname
= Fexpand_file_name (filename
, Qnil
);
2874 /* If the file name has special constructs in it,
2875 call the corresponding file handler. */
2876 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2877 if (!NILP (handler
))
2878 return call2 (handler
, Qfile_readable_p
, absname
);
2880 absname
= ENCODE_FILE (absname
);
2883 /* Under MS-DOS and Windows, open does not work for directories. */
2884 if (access (XSTRING (absname
)->data
, 0) == 0)
2887 #else /* not DOS_NT */
2889 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2890 /* Opening a fifo without O_NONBLOCK can wait.
2891 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2892 except in the case of a fifo, on a system which handles it. */
2893 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2896 if (S_ISFIFO (statbuf
.st_mode
))
2897 flags
|= O_NONBLOCK
;
2899 desc
= open (XSTRING (absname
)->data
, flags
);
2904 #endif /* not DOS_NT */
2907 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2909 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2910 "Return t if file FILENAME can be written or created by you.")
2912 Lisp_Object filename
;
2914 Lisp_Object absname
, dir
, encoded
;
2915 Lisp_Object handler
;
2916 struct stat statbuf
;
2918 CHECK_STRING (filename
, 0);
2919 absname
= Fexpand_file_name (filename
, Qnil
);
2921 /* If the file name has special constructs in it,
2922 call the corresponding file handler. */
2923 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2924 if (!NILP (handler
))
2925 return call2 (handler
, Qfile_writable_p
, absname
);
2927 encoded
= ENCODE_FILE (absname
);
2928 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
2929 return (check_writable (XSTRING (encoded
)->data
)
2932 dir
= Ffile_name_directory (absname
);
2935 dir
= Fdirectory_file_name (dir
);
2939 dir
= Fdirectory_file_name (dir
);
2942 dir
= ENCODE_FILE (dir
);
2943 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2947 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2948 "Access file FILENAME, and get an error if that does not work.\n\
2949 The second argument STRING is used in the error message.\n\
2950 If there is no error, we return nil.")
2952 Lisp_Object filename
, string
;
2954 Lisp_Object handler
, encoded_filename
;
2957 CHECK_STRING (filename
, 0);
2958 CHECK_STRING (string
, 1);
2960 /* If the file name has special constructs in it,
2961 call the corresponding file handler. */
2962 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2963 if (!NILP (handler
))
2964 return call3 (handler
, Qaccess_file
, filename
, string
);
2966 encoded_filename
= ENCODE_FILE (filename
);
2968 fd
= open (XSTRING (encoded_filename
)->data
, O_RDONLY
);
2970 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2976 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2977 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2978 The value is the name of the file to which it is linked.\n\
2979 Otherwise returns nil.")
2981 Lisp_Object filename
;
2988 Lisp_Object handler
;
2990 CHECK_STRING (filename
, 0);
2991 filename
= Fexpand_file_name (filename
, Qnil
);
2993 /* If the file name has special constructs in it,
2994 call the corresponding file handler. */
2995 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2996 if (!NILP (handler
))
2997 return call2 (handler
, Qfile_symlink_p
, filename
);
2999 filename
= ENCODE_FILE (filename
);
3004 buf
= (char *) xmalloc (bufsize
);
3005 bzero (buf
, bufsize
);
3006 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
3007 if (valsize
< bufsize
) break;
3008 /* Buffer was not long enough */
3017 val
= make_string (buf
, valsize
);
3019 val
= DECODE_FILE (val
);
3021 #else /* not S_IFLNK */
3023 #endif /* not S_IFLNK */
3026 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3027 "Return t if FILENAME names an existing directory.\n\
3028 Symbolic links to directories count as directories.\n\
3029 See `file-symlink-p' to distinguish symlinks.")
3031 Lisp_Object filename
;
3033 register Lisp_Object absname
;
3035 Lisp_Object handler
;
3037 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3039 /* If the file name has special constructs in it,
3040 call the corresponding file handler. */
3041 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3042 if (!NILP (handler
))
3043 return call2 (handler
, Qfile_directory_p
, absname
);
3045 absname
= ENCODE_FILE (absname
);
3047 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3049 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3052 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3053 "Return t if file FILENAME is the name of a directory as a file,\n\
3054 and files in that directory can be opened by you. In order to use a\n\
3055 directory as a buffer's current directory, this predicate must return true.\n\
3056 A directory name spec may be given instead; then the value is t\n\
3057 if the directory so specified exists and really is a readable and\n\
3058 searchable directory.")
3060 Lisp_Object filename
;
3062 Lisp_Object handler
;
3064 struct gcpro gcpro1
;
3066 /* If the file name has special constructs in it,
3067 call the corresponding file handler. */
3068 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3069 if (!NILP (handler
))
3070 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3072 /* It's an unlikely combination, but yes we really do need to gcpro:
3073 Suppose that file-accessible-directory-p has no handler, but
3074 file-directory-p does have a handler; this handler causes a GC which
3075 relocates the string in `filename'; and finally file-directory-p
3076 returns non-nil. Then we would end up passing a garbaged string
3077 to file-executable-p. */
3079 tem
= (NILP (Ffile_directory_p (filename
))
3080 || NILP (Ffile_executable_p (filename
)));
3082 return tem
? Qnil
: Qt
;
3085 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3086 "Return t if file FILENAME is the name of a regular file.\n\
3087 This is the sort of file that holds an ordinary stream of data bytes.")
3089 Lisp_Object filename
;
3091 register Lisp_Object absname
;
3093 Lisp_Object handler
;
3095 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3097 /* If the file name has special constructs in it,
3098 call the corresponding file handler. */
3099 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3100 if (!NILP (handler
))
3101 return call2 (handler
, Qfile_regular_p
, absname
);
3103 absname
= ENCODE_FILE (absname
);
3108 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3110 /* Tell stat to use expensive method to get accurate info. */
3111 Vw32_get_true_file_attributes
= Qt
;
3112 result
= stat (XSTRING (absname
)->data
, &st
);
3113 Vw32_get_true_file_attributes
= tem
;
3117 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3120 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3122 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3126 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3127 "Return mode bits of file named FILENAME, as an integer.")
3129 Lisp_Object filename
;
3131 Lisp_Object absname
;
3133 Lisp_Object handler
;
3135 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3137 /* If the file name has special constructs in it,
3138 call the corresponding file handler. */
3139 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3140 if (!NILP (handler
))
3141 return call2 (handler
, Qfile_modes
, absname
);
3143 absname
= ENCODE_FILE (absname
);
3145 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3147 #if defined (MSDOS) && __DJGPP__ < 2
3148 if (check_executable (XSTRING (absname
)->data
))
3149 st
.st_mode
|= S_IEXEC
;
3150 #endif /* MSDOS && __DJGPP__ < 2 */
3152 return make_number (st
.st_mode
& 07777);
3155 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3156 "Set mode bits of file named FILENAME to MODE (an integer).\n\
3157 Only the 12 low bits of MODE are used.")
3159 Lisp_Object filename
, mode
;
3161 Lisp_Object absname
, encoded_absname
;
3162 Lisp_Object handler
;
3164 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3165 CHECK_NUMBER (mode
, 1);
3167 /* If the file name has special constructs in it,
3168 call the corresponding file handler. */
3169 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3170 if (!NILP (handler
))
3171 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3173 encoded_absname
= ENCODE_FILE (absname
);
3175 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
3176 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3181 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3182 "Set the file permission bits for newly created files.\n\
3183 The argument MODE should be an integer; only the low 9 bits are used.\n\
3184 This setting is inherited by subprocesses.")
3188 CHECK_NUMBER (mode
, 0);
3190 umask ((~ XINT (mode
)) & 0777);
3195 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3196 "Return the default file protection for created files.\n\
3197 The value is an integer.")
3203 realmask
= umask (0);
3206 XSETINT (value
, (~ realmask
) & 0777);
3212 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3213 "Tell Unix to finish all pending disk updates.")
3222 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3223 "Return t if file FILE1 is newer than file FILE2.\n\
3224 If FILE1 does not exist, the answer is nil;\n\
3225 otherwise, if FILE2 does not exist, the answer is t.")
3227 Lisp_Object file1
, file2
;
3229 Lisp_Object absname1
, absname2
;
3232 Lisp_Object handler
;
3233 struct gcpro gcpro1
, gcpro2
;
3235 CHECK_STRING (file1
, 0);
3236 CHECK_STRING (file2
, 0);
3239 GCPRO2 (absname1
, file2
);
3240 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3241 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3244 /* If the file name has special constructs in it,
3245 call the corresponding file handler. */
3246 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3248 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3249 if (!NILP (handler
))
3250 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3252 GCPRO2 (absname1
, absname2
);
3253 absname1
= ENCODE_FILE (absname1
);
3254 absname2
= ENCODE_FILE (absname2
);
3257 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3260 mtime1
= st
.st_mtime
;
3262 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3265 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3269 Lisp_Object Qfind_buffer_file_type
;
3272 #ifndef READ_BUF_SIZE
3273 #define READ_BUF_SIZE (64 << 10)
3276 /* This function is called when a function bound to
3277 Vset_auto_coding_function causes some error. At that time, a text
3278 of a file has already been inserted in the current buffer, but,
3279 markers has not yet been adjusted. Thus we must adjust markers
3280 here. We are sure that the buffer was empty before the text of the
3281 file was inserted. */
3284 set_auto_coding_unwind (multibyte
)
3285 Lisp_Object multibyte
;
3287 int inserted
= Z_BYTE
- BEG_BYTE
;
3289 if (!NILP (multibyte
))
3290 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
3291 adjust_after_insert (PT
, PT_BYTE
, Z
, Z_BYTE
, inserted
);
3296 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3298 "Insert contents of file FILENAME after point.\n\
3299 Returns list of absolute file name and number of bytes inserted.\n\
3300 If second argument VISIT is non-nil, the buffer's visited filename\n\
3301 and last save file modtime are set, and it is marked unmodified.\n\
3302 If visiting and the file does not exist, visiting is completed\n\
3303 before the error is signaled.\n\
3304 The optional third and fourth arguments BEG and END\n\
3305 specify what portion of the file to insert.\n\
3306 These arguments count bytes in the file, not characters in the buffer.\n\
3307 If VISIT is non-nil, BEG and END must be nil.\n\
3309 If optional fifth argument REPLACE is non-nil,\n\
3310 it means replace the current buffer contents (in the accessible portion)\n\
3311 with the file contents. This is better than simply deleting and inserting\n\
3312 the whole thing because (1) it preserves some marker positions\n\
3313 and (2) it puts less data in the undo list.\n\
3314 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3315 which is often less than the number of characters to be read.\n\
3317 This does code conversion according to the value of\n\
3318 `coding-system-for-read' or `file-coding-system-alist',\n\
3319 and sets the variable `last-coding-system-used' to the coding system\n\
3321 (filename
, visit
, beg
, end
, replace
)
3322 Lisp_Object filename
, visit
, beg
, end
, replace
;
3327 register int how_much
;
3328 register int unprocessed
;
3329 int count
= specpdl_ptr
- specpdl
;
3330 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3331 Lisp_Object handler
, val
, insval
, orig_filename
;
3334 int not_regular
= 0;
3335 unsigned char read_buf
[READ_BUF_SIZE
];
3336 struct coding_system coding
;
3337 unsigned char buffer
[1 << 14];
3338 int replace_handled
= 0;
3339 int set_coding_system
= 0;
3340 int coding_system_decided
= 0;
3342 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3343 error ("Cannot do file visiting in an indirect buffer");
3345 if (!NILP (current_buffer
->read_only
))
3346 Fbarf_if_buffer_read_only ();
3350 orig_filename
= Qnil
;
3352 GCPRO4 (filename
, val
, p
, orig_filename
);
3354 CHECK_STRING (filename
, 0);
3355 filename
= Fexpand_file_name (filename
, Qnil
);
3357 /* If the file name has special constructs in it,
3358 call the corresponding file handler. */
3359 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3360 if (!NILP (handler
))
3362 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3363 visit
, beg
, end
, replace
);
3364 if (CONSP (val
) && CONSP (XCONS (val
)->cdr
))
3365 inserted
= XINT (XCONS (XCONS (val
)->cdr
)->car
);
3369 orig_filename
= filename
;
3370 filename
= ENCODE_FILE (filename
);
3376 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3378 /* Tell stat to use expensive method to get accurate info. */
3379 Vw32_get_true_file_attributes
= Qt
;
3380 total
= stat (XSTRING (filename
)->data
, &st
);
3381 Vw32_get_true_file_attributes
= tem
;
3386 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3388 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3389 || fstat (fd
, &st
) < 0)
3390 #endif /* not APOLLO */
3391 #endif /* WINDOWSNT */
3393 if (fd
>= 0) close (fd
);
3396 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3399 if (!NILP (Vcoding_system_for_read
))
3400 current_buffer
->buffer_file_coding_system
= Vcoding_system_for_read
;
3405 /* This code will need to be changed in order to work on named
3406 pipes, and it's probably just not worth it. So we should at
3407 least signal an error. */
3408 if (!S_ISREG (st
.st_mode
))
3415 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3416 Fsignal (Qfile_error
,
3417 Fcons (build_string ("not a regular file"),
3418 Fcons (orig_filename
, Qnil
)));
3423 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3426 /* Replacement should preserve point as it preserves markers. */
3427 if (!NILP (replace
))
3428 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3430 record_unwind_protect (close_file_unwind
, make_number (fd
));
3432 /* Supposedly happens on VMS. */
3433 if (! not_regular
&& st
.st_size
< 0)
3434 error ("File size is negative");
3436 if (!NILP (beg
) || !NILP (end
))
3438 error ("Attempt to visit less than an entire file");
3441 CHECK_NUMBER (beg
, 0);
3443 XSETFASTINT (beg
, 0);
3446 CHECK_NUMBER (end
, 0);
3451 XSETINT (end
, st
.st_size
);
3452 if (XINT (end
) != st
.st_size
)
3453 error ("Maximum buffer size exceeded");
3459 /* Decide the coding system to use for reading the file now
3460 because we can't use an optimized method for handling
3461 `coding:' tag if the current buffer is not empty. */
3465 if (!NILP (Vcoding_system_for_read
))
3466 val
= Vcoding_system_for_read
;
3467 else if (! NILP (replace
))
3468 /* In REPLACE mode, we can use the same coding system
3469 that was used to visit the file. */
3470 val
= current_buffer
->buffer_file_coding_system
;
3473 /* Don't try looking inside a file for a coding system
3474 specification if it is not seekable. */
3475 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3477 /* Find a coding system specified in the heading two
3478 lines or in the tailing several lines of the file.
3479 We assume that the 1K-byte and 3K-byte for heading
3480 and tailing respectively are sufficient for this
3482 int how_many
, nread
;
3484 if (st
.st_size
<= (1024 * 4))
3485 nread
= read (fd
, read_buf
, 1024 * 4);
3488 nread
= read (fd
, read_buf
, 1024);
3491 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3492 report_file_error ("Setting file position",
3493 Fcons (orig_filename
, Qnil
));
3494 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3499 error ("IO error reading %s: %s",
3500 XSTRING (orig_filename
)->data
, strerror (errno
));
3503 int count
= specpdl_ptr
- specpdl
;
3504 struct buffer
*prev
= current_buffer
;
3506 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3507 temp_output_buffer_setup (" *code-converting-work*");
3508 set_buffer_internal (XBUFFER (Vstandard_output
));
3509 current_buffer
->enable_multibyte_characters
= Qnil
;
3510 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3511 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3512 val
= call2 (Vset_auto_coding_function
,
3513 filename
, make_number (nread
));
3514 set_buffer_internal (prev
);
3515 /* Discard the unwind protect for recovering the
3519 /* Rewind the file for the actual read done later. */
3520 if (lseek (fd
, 0, 0) < 0)
3521 report_file_error ("Setting file position",
3522 Fcons (orig_filename
, Qnil
));
3528 /* If we have not yet decided a coding system, check
3529 file-coding-system-alist. */
3530 Lisp_Object args
[6], coding_systems
;
3532 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3533 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3534 coding_systems
= Ffind_operation_coding_system (6, args
);
3535 if (CONSP (coding_systems
))
3536 val
= XCONS (coding_systems
)->car
;
3540 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3542 if (NILP (current_buffer
->enable_multibyte_characters
)
3544 /* We must suppress all character code conversion except for
3545 end-of-line conversion. */
3546 setup_raw_text_coding_system (&coding
);
3548 coding_system_decided
= 1;
3551 /* Ensure we always set Vlast_coding_system_used. */
3552 set_coding_system
= 1;
3554 /* If requested, replace the accessible part of the buffer
3555 with the file contents. Avoid replacing text at the
3556 beginning or end of the buffer that matches the file contents;
3557 that preserves markers pointing to the unchanged parts.
3559 Here we implement this feature in an optimized way
3560 for the case where code conversion is NOT needed.
3561 The following if-statement handles the case of conversion
3562 in a less optimal way.
3564 If the code conversion is "automatic" then we try using this
3565 method and hope for the best.
3566 But if we discover the need for conversion, we give up on this method
3567 and let the following if-statement handle the replace job. */
3570 && ! CODING_REQUIRE_DECODING (&coding
)
3571 && (coding
.eol_type
== CODING_EOL_UNDECIDED
3572 || coding
.eol_type
== CODING_EOL_LF
))
3574 /* same_at_start and same_at_end count bytes,
3575 because file access counts bytes
3576 and BEG and END count bytes. */
3577 int same_at_start
= BEGV_BYTE
;
3578 int same_at_end
= ZV_BYTE
;
3580 /* There is still a possibility we will find the need to do code
3581 conversion. If that happens, we set this variable to 1 to
3582 give up on handling REPLACE in the optimized way. */
3583 int giveup_match_end
= 0;
3585 if (XINT (beg
) != 0)
3587 if (lseek (fd
, XINT (beg
), 0) < 0)
3588 report_file_error ("Setting file position",
3589 Fcons (orig_filename
, Qnil
));
3594 /* Count how many chars at the start of the file
3595 match the text at the beginning of the buffer. */
3600 nread
= read (fd
, buffer
, sizeof buffer
);
3602 error ("IO error reading %s: %s",
3603 XSTRING (orig_filename
)->data
, strerror (errno
));
3604 else if (nread
== 0)
3607 if (coding
.type
== coding_type_undecided
)
3608 detect_coding (&coding
, buffer
, nread
);
3609 if (CODING_REQUIRE_DECODING (&coding
))
3610 /* We found that the file should be decoded somehow.
3611 Let's give up here. */
3613 giveup_match_end
= 1;
3617 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3618 detect_eol (&coding
, buffer
, nread
);
3619 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3620 && coding
.eol_type
!= CODING_EOL_LF
)
3621 /* We found that the format of eol should be decoded.
3622 Let's give up here. */
3624 giveup_match_end
= 1;
3629 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3630 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3631 same_at_start
++, bufpos
++;
3632 /* If we found a discrepancy, stop the scan.
3633 Otherwise loop around and scan the next bufferful. */
3634 if (bufpos
!= nread
)
3638 /* If the file matches the buffer completely,
3639 there's no need to replace anything. */
3640 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3644 /* Truncate the buffer to the size of the file. */
3645 del_range_1 (same_at_start
, same_at_end
, 0);
3650 /* Count how many chars at the end of the file
3651 match the text at the end of the buffer. But, if we have
3652 already found that decoding is necessary, don't waste time. */
3653 while (!giveup_match_end
)
3655 int total_read
, nread
, bufpos
, curpos
, trial
;
3657 /* At what file position are we now scanning? */
3658 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3659 /* If the entire file matches the buffer tail, stop the scan. */
3662 /* How much can we scan in the next step? */
3663 trial
= min (curpos
, sizeof buffer
);
3664 if (lseek (fd
, curpos
- trial
, 0) < 0)
3665 report_file_error ("Setting file position",
3666 Fcons (orig_filename
, Qnil
));
3669 while (total_read
< trial
)
3671 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3673 error ("IO error reading %s: %s",
3674 XSTRING (orig_filename
)->data
, strerror (errno
));
3675 total_read
+= nread
;
3677 /* Scan this bufferful from the end, comparing with
3678 the Emacs buffer. */
3679 bufpos
= total_read
;
3680 /* Compare with same_at_start to avoid counting some buffer text
3681 as matching both at the file's beginning and at the end. */
3682 while (bufpos
> 0 && same_at_end
> same_at_start
3683 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3684 same_at_end
--, bufpos
--;
3686 /* If we found a discrepancy, stop the scan.
3687 Otherwise loop around and scan the preceding bufferful. */
3690 /* If this discrepancy is because of code conversion,
3691 we cannot use this method; giveup and try the other. */
3692 if (same_at_end
> same_at_start
3693 && FETCH_BYTE (same_at_end
- 1) >= 0200
3694 && ! NILP (current_buffer
->enable_multibyte_characters
)
3695 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3696 giveup_match_end
= 1;
3702 if (! giveup_match_end
)
3706 /* We win! We can handle REPLACE the optimized way. */
3708 /* Extend the start of non-matching text area to multibyte
3709 character boundary. */
3710 if (! NILP (current_buffer
->enable_multibyte_characters
))
3711 while (same_at_start
> BEGV_BYTE
3712 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3715 /* Extend the end of non-matching text area to multibyte
3716 character boundary. */
3717 if (! NILP (current_buffer
->enable_multibyte_characters
))
3718 while (same_at_end
< ZV_BYTE
3719 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3722 /* Don't try to reuse the same piece of text twice. */
3723 overlap
= (same_at_start
- BEGV_BYTE
3724 - (same_at_end
+ st
.st_size
- ZV
));
3726 same_at_end
+= overlap
;
3728 /* Arrange to read only the nonmatching middle part of the file. */
3729 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3730 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3732 del_range_byte (same_at_start
, same_at_end
, 0);
3733 /* Insert from the file at the proper position. */
3734 temp
= BYTE_TO_CHAR (same_at_start
);
3735 SET_PT_BOTH (temp
, same_at_start
);
3737 /* If display currently starts at beginning of line,
3738 keep it that way. */
3739 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3740 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3742 replace_handled
= 1;
3746 /* If requested, replace the accessible part of the buffer
3747 with the file contents. Avoid replacing text at the
3748 beginning or end of the buffer that matches the file contents;
3749 that preserves markers pointing to the unchanged parts.
3751 Here we implement this feature for the case where code conversion
3752 is needed, in a simple way that needs a lot of memory.
3753 The preceding if-statement handles the case of no conversion
3754 in a more optimized way. */
3755 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3757 int same_at_start
= BEGV_BYTE
;
3758 int same_at_end
= ZV_BYTE
;
3761 /* Make sure that the gap is large enough. */
3762 int bufsize
= 2 * st
.st_size
;
3763 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3766 /* First read the whole file, performing code conversion into
3767 CONVERSION_BUFFER. */
3769 if (lseek (fd
, XINT (beg
), 0) < 0)
3771 xfree (conversion_buffer
);
3772 report_file_error ("Setting file position",
3773 Fcons (orig_filename
, Qnil
));
3776 total
= st
.st_size
; /* Total bytes in the file. */
3777 how_much
= 0; /* Bytes read from file so far. */
3778 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3779 unprocessed
= 0; /* Bytes not processed in previous loop. */
3781 while (how_much
< total
)
3783 /* try is reserved in some compilers (Microsoft C) */
3784 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3785 unsigned char *destination
= read_buf
+ unprocessed
;
3788 /* Allow quitting out of the actual I/O. */
3791 this = read (fd
, destination
, trytry
);
3794 if (this < 0 || this + unprocessed
== 0)
3802 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3804 int require
, result
;
3806 this += unprocessed
;
3808 /* If we are using more space than estimated,
3809 make CONVERSION_BUFFER bigger. */
3810 require
= decoding_buffer_size (&coding
, this);
3811 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3813 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3814 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3817 /* Convert this batch with results in CONVERSION_BUFFER. */
3818 if (how_much
>= total
) /* This is the last block. */
3819 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3820 result
= decode_coding (&coding
, read_buf
,
3821 conversion_buffer
+ inserted
,
3822 this, bufsize
- inserted
);
3824 /* Save for next iteration whatever we didn't convert. */
3825 unprocessed
= this - coding
.consumed
;
3826 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
3827 this = coding
.produced
;
3833 /* At this point, INSERTED is how many characters (i.e. bytes)
3834 are present in CONVERSION_BUFFER.
3835 HOW_MUCH should equal TOTAL,
3836 or should be <= 0 if we couldn't read the file. */
3840 free (conversion_buffer
);
3843 error ("IO error reading %s: %s",
3844 XSTRING (orig_filename
)->data
, strerror (errno
));
3845 else if (how_much
== -2)
3846 error ("maximum buffer size exceeded");
3849 /* Compare the beginning of the converted file
3850 with the buffer text. */
3853 while (bufpos
< inserted
&& same_at_start
< same_at_end
3854 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3855 same_at_start
++, bufpos
++;
3857 /* If the file matches the buffer completely,
3858 there's no need to replace anything. */
3860 if (bufpos
== inserted
)
3862 free (conversion_buffer
);
3865 /* Truncate the buffer to the size of the file. */
3866 del_range_byte (same_at_start
, same_at_end
, 0);
3871 /* Extend the start of non-matching text area to multibyte
3872 character boundary. */
3873 if (! NILP (current_buffer
->enable_multibyte_characters
))
3874 while (same_at_start
> BEGV_BYTE
3875 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3878 /* Scan this bufferful from the end, comparing with
3879 the Emacs buffer. */
3882 /* Compare with same_at_start to avoid counting some buffer text
3883 as matching both at the file's beginning and at the end. */
3884 while (bufpos
> 0 && same_at_end
> same_at_start
3885 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3886 same_at_end
--, bufpos
--;
3888 /* Extend the end of non-matching text area to multibyte
3889 character boundary. */
3890 if (! NILP (current_buffer
->enable_multibyte_characters
))
3891 while (same_at_end
< ZV_BYTE
3892 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3895 /* Don't try to reuse the same piece of text twice. */
3896 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3898 same_at_end
+= overlap
;
3900 /* If display currently starts at beginning of line,
3901 keep it that way. */
3902 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3903 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3905 /* Replace the chars that we need to replace,
3906 and update INSERTED to equal the number of bytes
3907 we are taking from the file. */
3908 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
3910 if (same_at_end
!= same_at_start
)
3912 del_range_byte (same_at_start
, same_at_end
, 0);
3914 same_at_start
= GPT_BYTE
;
3918 temp
= BYTE_TO_CHAR (same_at_start
);
3920 /* Insert from the file at the proper position. */
3921 SET_PT_BOTH (temp
, same_at_start
);
3922 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
3924 /* Set `inserted' to the number of inserted characters. */
3925 inserted
= PT
- temp
;
3927 free (conversion_buffer
);
3936 register Lisp_Object temp
;
3938 total
= XINT (end
) - XINT (beg
);
3940 /* Make sure point-max won't overflow after this insertion. */
3941 XSETINT (temp
, total
);
3942 if (total
!= XINT (temp
))
3943 error ("Maximum buffer size exceeded");
3946 /* For a special file, all we can do is guess. */
3947 total
= READ_BUF_SIZE
;
3949 if (NILP (visit
) && total
> 0)
3950 prepare_to_modify_buffer (PT
, PT
, NULL
);
3953 if (GAP_SIZE
< total
)
3954 make_gap (total
- GAP_SIZE
);
3956 if (XINT (beg
) != 0 || !NILP (replace
))
3958 if (lseek (fd
, XINT (beg
), 0) < 0)
3959 report_file_error ("Setting file position",
3960 Fcons (orig_filename
, Qnil
));
3963 /* In the following loop, HOW_MUCH contains the total bytes read so
3964 far for a regular file, and not changed for a special file. But,
3965 before exiting the loop, it is set to a negative value if I/O
3968 /* Total bytes inserted. */
3970 /* Here, we don't do code conversion in the loop. It is done by
3971 code_convert_region after all data are read into the buffer. */
3972 while (how_much
< total
)
3974 /* try is reserved in some compilers (Microsoft C) */
3975 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3978 /* For a special file, GAP_SIZE should be checked every time. */
3979 if (not_regular
&& GAP_SIZE
< trytry
)
3980 make_gap (total
- GAP_SIZE
);
3982 /* Allow quitting out of the actual I/O. */
3985 this = read (fd
, BYTE_POS_ADDR (PT_BYTE
+ inserted
- 1) + 1, trytry
);
4002 /* For a regular file, where TOTAL is the real size,
4003 count HOW_MUCH to compare with it.
4004 For a special file, where TOTAL is just a buffer size,
4005 so don't bother counting in HOW_MUCH.
4006 (INSERTED is where we count the number of characters inserted.) */
4013 /* Put an anchor to ensure multi-byte form ends at gap. */
4018 /* Discard the unwind protect for closing the file. */
4022 error ("IO error reading %s: %s",
4023 XSTRING (orig_filename
)->data
, strerror (errno
));
4025 if (! coding_system_decided
)
4027 /* The coding system is not yet decided. Decide it by an
4028 optimized method for handling `coding:' tag. */
4032 if (!NILP (Vcoding_system_for_read
))
4033 val
= Vcoding_system_for_read
;
4036 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4038 /* Since we are sure that the current buffer was
4039 empty before the insertion, we can toggle
4040 enable-multibyte-characters directly here without
4041 taking care of marker adjustment and byte
4042 combining problem. */
4043 Lisp_Object prev_multibyte
;
4044 int count
= specpdl_ptr
- specpdl
;
4046 prev_multibyte
= current_buffer
->enable_multibyte_characters
;
4047 current_buffer
->enable_multibyte_characters
= Qnil
;
4048 record_unwind_protect (set_auto_coding_unwind
,
4050 val
= call2 (Vset_auto_coding_function
,
4051 filename
, make_number (inserted
));
4052 /* Discard the unwind protect for recovering the
4053 error of Vset_auto_coding_function. */
4055 current_buffer
->enable_multibyte_characters
= prev_multibyte
;
4056 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
4061 /* If the coding system is not yet decided, check
4062 file-coding-system-alist. */
4063 Lisp_Object args
[6], coding_systems
;
4065 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4066 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4067 coding_systems
= Ffind_operation_coding_system (6, args
);
4068 if (CONSP (coding_systems
))
4069 val
= XCONS (coding_systems
)->car
;
4073 /* The following kludgy code is to avoid some compiler bug.
4075 setup_coding_system (val, &coding);
4078 struct coding_system temp_coding
;
4079 setup_coding_system (val
, &temp_coding
);
4080 bcopy (&temp_coding
, &coding
, sizeof coding
);
4083 if (NILP (current_buffer
->enable_multibyte_characters
)
4085 /* We must suppress all character code conversion except for
4086 end-of-line conversion. */
4087 setup_raw_text_coding_system (&coding
);
4090 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4092 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4094 /* Here, we don't have to consider byte combining (see the
4095 comment below) because code_convert_region takes care of
4097 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4099 inserted
= (NILP (current_buffer
->enable_multibyte_characters
)
4100 ? coding
.produced
: coding
.produced_char
);
4102 else if (!NILP (current_buffer
->enable_multibyte_characters
))
4104 int inserted_byte
= inserted
;
4106 /* There's a possibility that we must combine bytes at the
4107 head (resp. the tail) of the just inserted text with the
4108 bytes before (resp. after) the gap to form a single
4110 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
4111 adjust_after_insert (PT
, PT_BYTE
,
4112 PT
+ inserted_byte
, PT_BYTE
+ inserted_byte
,
4116 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4121 /* Use the conversion type to determine buffer-file-type
4122 (find-buffer-file-type is now used to help determine the
4124 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4125 || coding
.eol_type
== CODING_EOL_LF
)
4126 && ! CODING_REQUIRE_DECODING (&coding
))
4127 current_buffer
->buffer_file_type
= Qt
;
4129 current_buffer
->buffer_file_type
= Qnil
;
4137 if (!EQ (current_buffer
->undo_list
, Qt
))
4138 current_buffer
->undo_list
= Qnil
;
4140 stat (XSTRING (filename
)->data
, &st
);
4145 current_buffer
->modtime
= st
.st_mtime
;
4146 current_buffer
->filename
= orig_filename
;
4149 SAVE_MODIFF
= MODIFF
;
4150 current_buffer
->auto_save_modified
= MODIFF
;
4151 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4152 #ifdef CLASH_DETECTION
4155 if (!NILP (current_buffer
->file_truename
))
4156 unlock_file (current_buffer
->file_truename
);
4157 unlock_file (filename
);
4159 #endif /* CLASH_DETECTION */
4161 Fsignal (Qfile_error
,
4162 Fcons (build_string ("not a regular file"),
4163 Fcons (orig_filename
, Qnil
)));
4165 /* If visiting nonexistent file, return nil. */
4166 if (current_buffer
->modtime
== -1)
4167 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4170 /* Decode file format */
4173 insval
= call3 (Qformat_decode
,
4174 Qnil
, make_number (inserted
), visit
);
4175 CHECK_NUMBER (insval
, 0);
4176 inserted
= XFASTINT (insval
);
4179 /* Call after-change hooks for the inserted text, aside from the case
4180 of normal visiting (not with REPLACE), which is done in a new buffer
4181 "before" the buffer is changed. */
4182 if (inserted
> 0 && total
> 0
4183 && (NILP (visit
) || !NILP (replace
)))
4184 signal_after_change (PT
, 0, inserted
);
4186 if (set_coding_system
)
4187 Vlast_coding_system_used
= coding
.symbol
;
4191 p
= Vafter_insert_file_functions
;
4194 insval
= call1 (Fcar (p
), make_number (inserted
));
4197 CHECK_NUMBER (insval
, 0);
4198 inserted
= XFASTINT (insval
);
4205 /* ??? Retval needs to be dealt with in all cases consistently. */
4207 val
= Fcons (orig_filename
,
4208 Fcons (make_number (inserted
),
4211 RETURN_UNGCPRO (unbind_to (count
, val
));
4214 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
4217 /* If build_annotations switched buffers, switch back to BUF.
4218 Kill the temporary buffer that was selected in the meantime.
4220 Since this kill only the last temporary buffer, some buffers remain
4221 not killed if build_annotations switched buffers more than once.
4225 build_annotations_unwind (buf
)
4230 if (XBUFFER (buf
) == current_buffer
)
4232 tembuf
= Fcurrent_buffer ();
4234 Fkill_buffer (tembuf
);
4238 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4239 "r\nFWrite region to file: \ni\ni\ni\np",
4240 "Write current region into specified file.\n\
4241 When called from a program, takes three arguments:\n\
4242 START, END and FILENAME. START and END are buffer positions.\n\
4243 Optional fourth argument APPEND if non-nil means\n\
4244 append to existing file contents (if any).\n\
4245 Optional fifth argument VISIT if t means\n\
4246 set the last-save-file-modtime of buffer to this file's modtime\n\
4247 and mark buffer not modified.\n\
4248 If VISIT is a string, it is a second file name;\n\
4249 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
4250 VISIT is also the file name to lock and unlock for clash detection.\n\
4251 If VISIT is neither t nor nil nor a string,\n\
4252 that means do not print the \"Wrote file\" message.\n\
4253 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
4254 use for locking and unlocking, overriding FILENAME and VISIT.\n\
4255 The optional seventh arg CONFIRM, if non-nil, says ask for confirmation\n\
4256 before overwriting an existing file.\n\
4257 Kludgy feature: if START is a string, then that string is written\n\
4258 to the file, instead of any buffer contents, and END is ignored.\n\
4260 This does code conversion according to the value of\n\
4261 `coding-system-for-write', `buffer-file-coding-system', or\n\
4262 `file-coding-system-alist', and sets the variable\n\
4263 `last-coding-system-used' to the coding system actually used.")
4265 (start
, end
, filename
, append
, visit
, lockname
, confirm
)
4266 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, confirm
;
4274 int count
= specpdl_ptr
- specpdl
;
4277 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4279 Lisp_Object handler
;
4280 Lisp_Object visit_file
;
4281 Lisp_Object annotations
;
4282 Lisp_Object encoded_filename
;
4283 int visiting
, quietly
;
4284 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4285 struct buffer
*given_buffer
;
4287 int buffer_file_type
= O_BINARY
;
4289 struct coding_system coding
;
4291 if (current_buffer
->base_buffer
&& ! NILP (visit
))
4292 error ("Cannot do file visiting in an indirect buffer");
4294 if (!NILP (start
) && !STRINGP (start
))
4295 validate_region (&start
, &end
);
4297 GCPRO4 (start
, filename
, visit
, lockname
);
4299 /* Decide the coding-system to encode the data with. */
4305 else if (!NILP (Vcoding_system_for_write
))
4306 val
= Vcoding_system_for_write
;
4309 /* If the variable `buffer-file-coding-system' is set locally,
4310 it means that the file was read with some kind of code
4311 conversion or the varialbe is explicitely set by users. We
4312 had better write it out with the same coding system even if
4313 `enable-multibyte-characters' is nil.
4315 If it is not set locally, we anyway have to convert EOL
4316 format if the default value of `buffer-file-coding-system'
4317 tells that it is not Unix-like (LF only) format. */
4318 int using_default_coding
= 0;
4319 int force_raw_text
= 0;
4321 val
= current_buffer
->buffer_file_coding_system
;
4323 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4326 if (NILP (current_buffer
->enable_multibyte_characters
))
4332 /* Check file-coding-system-alist. */
4333 Lisp_Object args
[7], coding_systems
;
4335 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4336 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4338 coding_systems
= Ffind_operation_coding_system (7, args
);
4339 if (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
))
4340 val
= XCONS (coding_systems
)->cdr
;
4344 && !NILP (current_buffer
->buffer_file_coding_system
))
4346 /* If we still have not decided a coding system, use the
4347 default value of buffer-file-coding-system. */
4348 val
= current_buffer
->buffer_file_coding_system
;
4349 using_default_coding
= 1;
4353 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4354 /* Confirm that VAL can surely encode the current region. */
4355 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4357 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4358 if (coding
.eol_type
== CODING_EOL_UNDECIDED
4359 && !using_default_coding
)
4361 if (! EQ (default_buffer_file_coding
.symbol
,
4362 buffer_defaults
.buffer_file_coding_system
))
4363 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4364 &default_buffer_file_coding
);
4365 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4367 Lisp_Object subsidiaries
;
4369 coding
.eol_type
= default_buffer_file_coding
.eol_type
;
4370 subsidiaries
= Fget (coding
.symbol
, Qeol_type
);
4371 if (VECTORP (subsidiaries
)
4372 && XVECTOR (subsidiaries
)->size
== 3)
4374 = XVECTOR (subsidiaries
)->contents
[coding
.eol_type
];
4379 setup_raw_text_coding_system (&coding
);
4380 goto done_setup_coding
;
4383 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4386 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4387 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4390 Vlast_coding_system_used
= coding
.symbol
;
4392 filename
= Fexpand_file_name (filename
, Qnil
);
4394 if (! NILP (confirm
))
4395 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4397 if (STRINGP (visit
))
4398 visit_file
= Fexpand_file_name (visit
, Qnil
);
4400 visit_file
= filename
;
4403 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4404 quietly
= !NILP (visit
);
4408 if (NILP (lockname
))
4409 lockname
= visit_file
;
4411 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4413 /* If the file name has special constructs in it,
4414 call the corresponding file handler. */
4415 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4416 /* If FILENAME has no handler, see if VISIT has one. */
4417 if (NILP (handler
) && STRINGP (visit
))
4418 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4420 if (!NILP (handler
))
4423 val
= call6 (handler
, Qwrite_region
, start
, end
,
4424 filename
, append
, visit
);
4428 SAVE_MODIFF
= MODIFF
;
4429 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4430 current_buffer
->filename
= visit_file
;
4436 /* Special kludge to simplify auto-saving. */
4439 XSETFASTINT (start
, BEG
);
4440 XSETFASTINT (end
, Z
);
4443 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4444 count1
= specpdl_ptr
- specpdl
;
4446 given_buffer
= current_buffer
;
4447 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4448 if (current_buffer
!= given_buffer
)
4450 XSETFASTINT (start
, BEGV
);
4451 XSETFASTINT (end
, ZV
);
4454 #ifdef CLASH_DETECTION
4457 #if 0 /* This causes trouble for GNUS. */
4458 /* If we've locked this file for some other buffer,
4459 query before proceeding. */
4460 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4461 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4464 lock_file (lockname
);
4466 #endif /* CLASH_DETECTION */
4468 encoded_filename
= ENCODE_FILE (filename
);
4470 fn
= XSTRING (encoded_filename
)->data
;
4474 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4475 #else /* not DOS_NT */
4476 desc
= open (fn
, O_WRONLY
);
4477 #endif /* not DOS_NT */
4479 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4481 if (auto_saving
) /* Overwrite any previous version of autosave file */
4483 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4484 desc
= open (fn
, O_RDWR
);
4486 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4487 ? XSTRING (current_buffer
->filename
)->data
: 0,
4490 else /* Write to temporary name and rename if no errors */
4492 Lisp_Object temp_name
;
4493 temp_name
= Ffile_name_directory (filename
);
4495 if (!NILP (temp_name
))
4497 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4498 build_string ("$$SAVE$$")));
4499 fname
= XSTRING (filename
)->data
;
4500 fn
= XSTRING (temp_name
)->data
;
4501 desc
= creat_copy_attrs (fname
, fn
);
4504 /* If we can't open the temporary file, try creating a new
4505 version of the original file. VMS "creat" creates a
4506 new version rather than truncating an existing file. */
4509 desc
= creat (fn
, 0666);
4510 #if 0 /* This can clobber an existing file and fail to replace it,
4511 if the user runs out of space. */
4514 /* We can't make a new version;
4515 try to truncate and rewrite existing version if any. */
4517 desc
= open (fn
, O_RDWR
);
4523 desc
= creat (fn
, 0666);
4528 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4529 S_IREAD
| S_IWRITE
);
4530 #else /* not DOS_NT */
4531 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4532 #endif /* not DOS_NT */
4533 #endif /* not VMS */
4539 #ifdef CLASH_DETECTION
4541 if (!auto_saving
) unlock_file (lockname
);
4543 #endif /* CLASH_DETECTION */
4544 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4547 record_unwind_protect (close_file_unwind
, make_number (desc
));
4549 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4550 if (lseek (desc
, 0, 2) < 0)
4552 #ifdef CLASH_DETECTION
4553 if (!auto_saving
) unlock_file (lockname
);
4554 #endif /* CLASH_DETECTION */
4555 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4560 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4561 * if we do writes that don't end with a carriage return. Furthermore
4562 * it cannot handle writes of more then 16K. The modified
4563 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4564 * this EXCEPT for the last record (iff it doesn't end with a carriage
4565 * return). This implies that if your buffer doesn't end with a carriage
4566 * return, you get one free... tough. However it also means that if
4567 * we make two calls to sys_write (a la the following code) you can
4568 * get one at the gap as well. The easiest way to fix this (honest)
4569 * is to move the gap to the next newline (or the end of the buffer).
4574 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4575 move_gap (find_next_newline (GPT
, 1));
4577 /* Whether VMS or not, we must move the gap to the next of newline
4578 when we must put designation sequences at beginning of line. */
4579 if (INTEGERP (start
)
4580 && coding
.type
== coding_type_iso2022
4581 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4582 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4584 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4585 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4586 move_gap_both (PT
, PT_BYTE
);
4587 SET_PT_BOTH (opoint
, opoint_byte
);
4594 if (STRINGP (start
))
4596 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4597 STRING_BYTES (XSTRING (start
)), 0, &annotations
,
4601 else if (XINT (start
) != XINT (end
))
4603 register int end1
= CHAR_TO_BYTE (XINT (end
));
4605 tem
= CHAR_TO_BYTE (XINT (start
));
4607 if (XINT (start
) < GPT
)
4609 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
),
4610 min (GPT_BYTE
, end1
) - tem
, tem
, &annotations
,
4615 if (XINT (end
) > GPT
&& !failure
)
4617 tem
= max (tem
, GPT_BYTE
);
4618 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
), end1
- tem
,
4619 tem
, &annotations
, &coding
);
4625 /* If file was empty, still need to write the annotations */
4626 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4627 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4631 if (CODING_REQUIRE_FLUSHING (&coding
)
4632 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4635 /* We have to flush out a data. */
4636 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4637 failure
= 0 > e_write (desc
, "", 0, &coding
);
4644 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4645 Disk full in NFS may be reported here. */
4646 /* mib says that closing the file will try to write as fast as NFS can do
4647 it, and that means the fsync here is not crucial for autosave files. */
4648 if (!auto_saving
&& fsync (desc
) < 0)
4650 /* If fsync fails with EINTR, don't treat that as serious. */
4652 failure
= 1, save_errno
= errno
;
4656 /* Spurious "file has changed on disk" warnings have been
4657 observed on Suns as well.
4658 It seems that `close' can change the modtime, under nfs.
4660 (This has supposedly been fixed in Sunos 4,
4661 but who knows about all the other machines with NFS?) */
4664 /* On VMS and APOLLO, must do the stat after the close
4665 since closing changes the modtime. */
4668 /* Recall that #if defined does not work on VMS. */
4675 /* NFS can report a write failure now. */
4676 if (close (desc
) < 0)
4677 failure
= 1, save_errno
= errno
;
4680 /* If we wrote to a temporary name and had no errors, rename to real name. */
4684 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4692 /* Discard the unwind protect for close_file_unwind. */
4693 specpdl_ptr
= specpdl
+ count1
;
4694 /* Restore the original current buffer. */
4695 visit_file
= unbind_to (count
, visit_file
);
4697 #ifdef CLASH_DETECTION
4699 unlock_file (lockname
);
4700 #endif /* CLASH_DETECTION */
4702 /* Do this before reporting IO error
4703 to avoid a "file has changed on disk" warning on
4704 next attempt to save. */
4706 current_buffer
->modtime
= st
.st_mtime
;
4709 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4710 strerror (save_errno
));
4714 SAVE_MODIFF
= MODIFF
;
4715 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4716 current_buffer
->filename
= visit_file
;
4717 update_mode_lines
++;
4723 message_with_string ("Wrote %s", visit_file
, 1);
4728 Lisp_Object
merge ();
4730 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4731 "Return t if (car A) is numerically less than (car B).")
4735 return Flss (Fcar (a
), Fcar (b
));
4738 /* Build the complete list of annotations appropriate for writing out
4739 the text between START and END, by calling all the functions in
4740 write-region-annotate-functions and merging the lists they return.
4741 If one of these functions switches to a different buffer, we assume
4742 that buffer contains altered text. Therefore, the caller must
4743 make sure to restore the current buffer in all cases,
4744 as save-excursion would do. */
4747 build_annotations (start
, end
, pre_write_conversion
)
4748 Lisp_Object start
, end
, pre_write_conversion
;
4750 Lisp_Object annotations
;
4752 struct gcpro gcpro1
, gcpro2
;
4753 Lisp_Object original_buffer
;
4755 XSETBUFFER (original_buffer
, current_buffer
);
4758 p
= Vwrite_region_annotate_functions
;
4759 GCPRO2 (annotations
, p
);
4762 struct buffer
*given_buffer
= current_buffer
;
4763 Vwrite_region_annotations_so_far
= annotations
;
4764 res
= call2 (Fcar (p
), start
, end
);
4765 /* If the function makes a different buffer current,
4766 assume that means this buffer contains altered text to be output.
4767 Reset START and END from the buffer bounds
4768 and discard all previous annotations because they should have
4769 been dealt with by this function. */
4770 if (current_buffer
!= given_buffer
)
4772 XSETFASTINT (start
, BEGV
);
4773 XSETFASTINT (end
, ZV
);
4776 Flength (res
); /* Check basic validity of return value */
4777 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4781 /* Now do the same for annotation functions implied by the file-format */
4782 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4783 p
= Vauto_save_file_format
;
4785 p
= current_buffer
->file_format
;
4788 struct buffer
*given_buffer
= current_buffer
;
4789 Vwrite_region_annotations_so_far
= annotations
;
4790 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4792 if (current_buffer
!= given_buffer
)
4794 XSETFASTINT (start
, BEGV
);
4795 XSETFASTINT (end
, ZV
);
4799 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4803 /* At last, do the same for the function PRE_WRITE_CONVERSION
4804 implied by the current coding-system. */
4805 if (!NILP (pre_write_conversion
))
4807 struct buffer
*given_buffer
= current_buffer
;
4808 Vwrite_region_annotations_so_far
= annotations
;
4809 res
= call2 (pre_write_conversion
, start
, end
);
4811 annotations
= (current_buffer
!= given_buffer
4813 : merge (annotations
, res
, Qcar_less_than_car
));
4820 /* Write to descriptor DESC the NBYTES bytes starting at ADDR,
4821 assuming they start at byte position BYTEPOS in the buffer.
4822 Intersperse with them the annotations from *ANNOT
4823 which fall within the range of byte positions BYTEPOS to BYTEPOS + NBYTES,
4824 each at its appropriate position.
4826 We modify *ANNOT by discarding elements as we use them up.
4828 The return value is negative in case of system call failure. */
4831 a_write (desc
, addr
, nbytes
, bytepos
, annot
, coding
)
4833 register char *addr
;
4834 register int nbytes
;
4837 struct coding_system
*coding
;
4841 int lastpos
= bytepos
+ nbytes
;
4843 while (NILP (*annot
) || CONSP (*annot
))
4845 tem
= Fcar_safe (Fcar (*annot
));
4846 nextpos
= bytepos
- 1;
4848 nextpos
= CHAR_TO_BYTE (XFASTINT (tem
));
4850 /* If there are no more annotations in this range,
4851 output the rest of the range all at once. */
4852 if (! (nextpos
>= bytepos
&& nextpos
<= lastpos
))
4853 return e_write (desc
, addr
, lastpos
- bytepos
, coding
);
4855 /* Output buffer text up to the next annotation's position. */
4856 if (nextpos
> bytepos
)
4858 if (0 > e_write (desc
, addr
, nextpos
- bytepos
, coding
))
4860 addr
+= nextpos
- bytepos
;
4863 /* Output the annotation. */
4864 tem
= Fcdr (Fcar (*annot
));
4867 if (0 > e_write (desc
, XSTRING (tem
)->data
, STRING_BYTES (XSTRING (tem
)),
4871 *annot
= Fcdr (*annot
);
4876 #ifndef WRITE_BUF_SIZE
4877 #define WRITE_BUF_SIZE (16 * 1024)
4880 /* Write NBYTES bytes starting at ADDR into descriptor DESC,
4881 encoding them with coding system CODING. */
4884 e_write (desc
, addr
, nbytes
, coding
)
4886 register char *addr
;
4887 register int nbytes
;
4888 struct coding_system
*coding
;
4890 char buf
[WRITE_BUF_SIZE
];
4892 /* We used to have a code for handling selective display here. But,
4893 now it is handled within encode_coding. */
4898 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
4899 nbytes
-= coding
->consumed
, addr
+= coding
->consumed
;
4900 if (coding
->produced
> 0)
4902 coding
->produced
-= write (desc
, buf
, coding
->produced
);
4903 if (coding
->produced
) return -1;
4905 if (result
== CODING_FINISH_INSUFFICIENT_SRC
)
4907 /* The source text ends by an incomplete multibyte form.
4908 There's no way other than write it out as is. */
4909 nbytes
-= write (desc
, addr
, nbytes
);
4910 if (nbytes
) return -1;
4918 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4919 Sverify_visited_file_modtime
, 1, 1, 0,
4920 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4921 This means that the file has not been changed since it was visited or saved.")
4927 Lisp_Object handler
;
4928 Lisp_Object filename
;
4930 CHECK_BUFFER (buf
, 0);
4933 if (!STRINGP (b
->filename
)) return Qt
;
4934 if (b
->modtime
== 0) return Qt
;
4936 /* If the file name has special constructs in it,
4937 call the corresponding file handler. */
4938 handler
= Ffind_file_name_handler (b
->filename
,
4939 Qverify_visited_file_modtime
);
4940 if (!NILP (handler
))
4941 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4943 filename
= ENCODE_FILE (b
->filename
);
4945 if (stat (XSTRING (filename
)->data
, &st
) < 0)
4947 /* If the file doesn't exist now and didn't exist before,
4948 we say that it isn't modified, provided the error is a tame one. */
4949 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4954 if (st
.st_mtime
== b
->modtime
4955 /* If both are positive, accept them if they are off by one second. */
4956 || (st
.st_mtime
> 0 && b
->modtime
> 0
4957 && (st
.st_mtime
== b
->modtime
+ 1
4958 || st
.st_mtime
== b
->modtime
- 1)))
4963 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4964 Sclear_visited_file_modtime
, 0, 0, 0,
4965 "Clear out records of last mod time of visited file.\n\
4966 Next attempt to save will certainly not complain of a discrepancy.")
4969 current_buffer
->modtime
= 0;
4973 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4974 Svisited_file_modtime
, 0, 0, 0,
4975 "Return the current buffer's recorded visited file modification time.\n\
4976 The value is a list of the form (HIGH . LOW), like the time values\n\
4977 that `file-attributes' returns.")
4980 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4983 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4984 Sset_visited_file_modtime
, 0, 1, 0,
4985 "Update buffer's recorded modification time from the visited file's time.\n\
4986 Useful if the buffer was not read from the file normally\n\
4987 or if the file itself has been changed for some known benign reason.\n\
4988 An argument specifies the modification time value to use\n\
4989 \(instead of that of the visited file), in the form of a list\n\
4990 \(HIGH . LOW) or (HIGH LOW).")
4992 Lisp_Object time_list
;
4994 if (!NILP (time_list
))
4995 current_buffer
->modtime
= cons_to_long (time_list
);
4998 register Lisp_Object filename
;
5000 Lisp_Object handler
;
5002 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5004 /* If the file name has special constructs in it,
5005 call the corresponding file handler. */
5006 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5007 if (!NILP (handler
))
5008 /* The handler can find the file name the same way we did. */
5009 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5011 filename
= ENCODE_FILE (filename
);
5013 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
5014 current_buffer
->modtime
= st
.st_mtime
;
5024 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 1);
5025 Fsleep_for (make_number (1), Qnil
);
5026 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
5027 Fsleep_for (make_number (1), Qnil
);
5028 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
5029 Fsleep_for (make_number (1), Qnil
);
5039 /* Get visited file's mode to become the auto save file's mode. */
5040 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
5041 /* But make sure we can overwrite it later! */
5042 auto_save_mode_bits
= st
.st_mode
| 0600;
5044 auto_save_mode_bits
= 0666;
5047 Fwrite_region (Qnil
, Qnil
,
5048 current_buffer
->auto_save_file_name
,
5049 Qnil
, Qlambda
, Qnil
, Qnil
);
5053 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5058 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
5059 | XFASTINT (XCONS (stream
)->cdr
)));
5064 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5067 minibuffer_auto_raise
= XINT (value
);
5071 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5072 "Auto-save all buffers that need it.\n\
5073 This is all buffers that have auto-saving enabled\n\
5074 and are changed since last auto-saved.\n\
5075 Auto-saving writes the buffer into a file\n\
5076 so that your editing is not lost if the system crashes.\n\
5077 This file is not the file you visited; that changes only when you save.\n\
5078 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
5079 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
5080 A non-nil CURRENT-ONLY argument means save only current buffer.")
5081 (no_message
, current_only
)
5082 Lisp_Object no_message
, current_only
;
5084 struct buffer
*old
= current_buffer
, *b
;
5085 Lisp_Object tail
, buf
;
5087 char *omessage
= echo_area_glyphs
;
5088 int omessage_length
= echo_area_glyphs_length
;
5089 int oldmultibyte
= message_enable_multibyte
;
5090 int do_handled_files
;
5093 Lisp_Object lispstream
;
5094 int count
= specpdl_ptr
- specpdl
;
5096 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5098 /* Ordinarily don't quit within this function,
5099 but don't make it impossible to quit (in case we get hung in I/O). */
5103 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5104 point to non-strings reached from Vbuffer_alist. */
5109 if (!NILP (Vrun_hooks
))
5110 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5112 if (STRINGP (Vauto_save_list_file_name
))
5114 Lisp_Object listfile
;
5115 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5116 stream
= fopen (XSTRING (listfile
)->data
, "w");
5119 /* Arrange to close that file whether or not we get an error.
5120 Also reset auto_saving to 0. */
5121 lispstream
= Fcons (Qnil
, Qnil
);
5122 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
5123 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
5134 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5135 record_unwind_protect (do_auto_save_unwind_1
,
5136 make_number (minibuffer_auto_raise
));
5137 minibuffer_auto_raise
= 0;
5140 /* First, save all files which don't have handlers. If Emacs is
5141 crashing, the handlers may tweak what is causing Emacs to crash
5142 in the first place, and it would be a shame if Emacs failed to
5143 autosave perfectly ordinary files because it couldn't handle some
5145 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5146 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
5148 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
5151 /* Record all the buffers that have auto save mode
5152 in the special file that lists them. For each of these buffers,
5153 Record visited name (if any) and auto save name. */
5154 if (STRINGP (b
->auto_save_file_name
)
5155 && stream
!= NULL
&& do_handled_files
== 0)
5157 if (!NILP (b
->filename
))
5159 fwrite (XSTRING (b
->filename
)->data
, 1,
5160 STRING_BYTES (XSTRING (b
->filename
)), stream
);
5162 putc ('\n', stream
);
5163 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
5164 STRING_BYTES (XSTRING (b
->auto_save_file_name
)), stream
);
5165 putc ('\n', stream
);
5168 if (!NILP (current_only
)
5169 && b
!= current_buffer
)
5172 /* Don't auto-save indirect buffers.
5173 The base buffer takes care of it. */
5177 /* Check for auto save enabled
5178 and file changed since last auto save
5179 and file changed since last real save. */
5180 if (STRINGP (b
->auto_save_file_name
)
5181 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5182 && b
->auto_save_modified
< BUF_MODIFF (b
)
5183 /* -1 means we've turned off autosaving for a while--see below. */
5184 && XINT (b
->save_length
) >= 0
5185 && (do_handled_files
5186 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5189 EMACS_TIME before_time
, after_time
;
5191 EMACS_GET_TIME (before_time
);
5193 /* If we had a failure, don't try again for 20 minutes. */
5194 if (b
->auto_save_failure_time
>= 0
5195 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5198 if ((XFASTINT (b
->save_length
) * 10
5199 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5200 /* A short file is likely to change a large fraction;
5201 spare the user annoying messages. */
5202 && XFASTINT (b
->save_length
) > 5000
5203 /* These messages are frequent and annoying for `*mail*'. */
5204 && !EQ (b
->filename
, Qnil
)
5205 && NILP (no_message
))
5207 /* It has shrunk too much; turn off auto-saving here. */
5208 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5209 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
5211 minibuffer_auto_raise
= 0;
5212 /* Turn off auto-saving until there's a real save,
5213 and prevent any more warnings. */
5214 XSETINT (b
->save_length
, -1);
5215 Fsleep_for (make_number (1), Qnil
);
5218 set_buffer_internal (b
);
5219 if (!auto_saved
&& NILP (no_message
))
5220 message1 ("Auto-saving...");
5221 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5223 b
->auto_save_modified
= BUF_MODIFF (b
);
5224 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5225 set_buffer_internal (old
);
5227 EMACS_GET_TIME (after_time
);
5229 /* If auto-save took more than 60 seconds,
5230 assume it was an NFS failure that got a timeout. */
5231 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5232 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5236 /* Prevent another auto save till enough input events come in. */
5237 record_auto_save ();
5239 if (auto_saved
&& NILP (no_message
))
5243 sit_for (1, 0, 0, 0, 0);
5244 message2 (omessage
, omessage_length
, oldmultibyte
);
5247 message1 ("Auto-saving...done");
5252 unbind_to (count
, Qnil
);
5256 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5257 Sset_buffer_auto_saved
, 0, 0, 0,
5258 "Mark current buffer as auto-saved with its current text.\n\
5259 No auto-save file will be written until the buffer changes again.")
5262 current_buffer
->auto_save_modified
= MODIFF
;
5263 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5264 current_buffer
->auto_save_failure_time
= -1;
5268 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5269 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5270 "Clear any record of a recent auto-save failure in the current buffer.")
5273 current_buffer
->auto_save_failure_time
= -1;
5277 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5279 "Return t if buffer has been auto-saved since last read in or saved.")
5282 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5285 /* Reading and completing file names */
5286 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5288 /* In the string VAL, change each $ to $$ and return the result. */
5291 double_dollars (val
)
5294 register unsigned char *old
, *new;
5298 osize
= STRING_BYTES (XSTRING (val
));
5300 /* Count the number of $ characters. */
5301 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
5302 if (*old
++ == '$') count
++;
5305 old
= XSTRING (val
)->data
;
5306 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
5308 new = XSTRING (val
)->data
;
5309 for (n
= osize
; n
> 0; n
--)
5322 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5324 "Internal subroutine for read-file-name. Do not call this.")
5325 (string
, dir
, action
)
5326 Lisp_Object string
, dir
, action
;
5327 /* action is nil for complete, t for return list of completions,
5328 lambda for verify final value */
5330 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5332 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5334 CHECK_STRING (string
, 0);
5341 /* No need to protect ACTION--we only compare it with t and nil. */
5342 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5344 if (XSTRING (string
)->size
== 0)
5346 if (EQ (action
, Qlambda
))
5354 orig_string
= string
;
5355 string
= Fsubstitute_in_file_name (string
);
5356 changed
= NILP (Fstring_equal (string
, orig_string
));
5357 name
= Ffile_name_nondirectory (string
);
5358 val
= Ffile_name_directory (string
);
5360 realdir
= Fexpand_file_name (val
, realdir
);
5365 specdir
= Ffile_name_directory (string
);
5366 val
= Ffile_name_completion (name
, realdir
);
5371 return double_dollars (string
);
5375 if (!NILP (specdir
))
5376 val
= concat2 (specdir
, val
);
5378 return double_dollars (val
);
5381 #endif /* not VMS */
5385 if (EQ (action
, Qt
))
5386 return Ffile_name_all_completions (name
, realdir
);
5387 /* Only other case actually used is ACTION = lambda */
5389 /* Supposedly this helps commands such as `cd' that read directory names,
5390 but can someone explain how it helps them? -- RMS */
5391 if (XSTRING (name
)->size
== 0)
5394 return Ffile_exists_p (string
);
5397 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5398 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5399 Value is not expanded---you must call `expand-file-name' yourself.\n\
5400 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5401 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5402 except that if INITIAL is specified, that combined with DIR is used.)\n\
5403 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5404 Non-nil and non-t means also require confirmation after completion.\n\
5405 Fifth arg INITIAL specifies text to start with.\n\
5406 DIR defaults to current buffer's directory default.")
5407 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5408 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5410 Lisp_Object val
, insdef
, tem
;
5411 struct gcpro gcpro1
, gcpro2
;
5412 register char *homedir
;
5413 int replace_in_history
= 0;
5414 int add_to_history
= 0;
5418 dir
= current_buffer
->directory
;
5419 if (NILP (default_filename
))
5421 if (! NILP (initial
))
5422 default_filename
= Fexpand_file_name (initial
, dir
);
5424 default_filename
= current_buffer
->filename
;
5427 /* If dir starts with user's homedir, change that to ~. */
5428 homedir
= (char *) egetenv ("HOME");
5430 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5431 CORRECT_DIR_SEPS (homedir
);
5435 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5436 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5438 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5439 STRING_BYTES (XSTRING (dir
)) - strlen (homedir
) + 1);
5440 XSTRING (dir
)->data
[0] = '~';
5442 /* Likewise for default_filename. */
5444 && STRINGP (default_filename
)
5445 && !strncmp (homedir
, XSTRING (default_filename
)->data
, strlen (homedir
))
5446 && IS_DIRECTORY_SEP (XSTRING (default_filename
)->data
[strlen (homedir
)]))
5449 = make_string (XSTRING (default_filename
)->data
+ strlen (homedir
) - 1,
5450 STRING_BYTES (XSTRING (default_filename
)) - strlen (homedir
) + 1);
5451 XSTRING (default_filename
)->data
[0] = '~';
5453 if (!NILP (default_filename
))
5455 CHECK_STRING (default_filename
, 3);
5456 default_filename
= double_dollars (default_filename
);
5459 if (insert_default_directory
&& STRINGP (dir
))
5462 if (!NILP (initial
))
5464 Lisp_Object args
[2], pos
;
5468 insdef
= Fconcat (2, args
);
5469 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5470 insdef
= Fcons (double_dollars (insdef
), pos
);
5473 insdef
= double_dollars (insdef
);
5475 else if (STRINGP (initial
))
5476 insdef
= Fcons (double_dollars (initial
), make_number (0));
5480 count
= specpdl_ptr
- specpdl
;
5482 specbind (intern ("completion-ignore-case"), Qt
);
5485 specbind (intern ("minibuffer-completing-file-name"), Qt
);
5487 GCPRO2 (insdef
, default_filename
);
5488 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5489 dir
, mustmatch
, insdef
,
5490 Qfile_name_history
, default_filename
, Qnil
);
5492 tem
= Fsymbol_value (Qfile_name_history
);
5493 if (CONSP (tem
) && EQ (XCONS (tem
)->car
, val
))
5494 replace_in_history
= 1;
5496 /* If Fcompleting_read returned the inserted default string itself
5497 (rather than a new string with the same contents),
5498 it has to mean that the user typed RET with the minibuffer empty.
5499 In that case, we really want to return ""
5500 so that commands such as set-visited-file-name can distinguish. */
5501 if (EQ (val
, default_filename
))
5503 /* In this case, Fcompleting_read has not added an element
5504 to the history. Maybe we should. */
5505 if (! replace_in_history
)
5508 val
= build_string ("");
5511 unbind_to (count
, Qnil
);
5514 error ("No file name specified");
5516 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
5518 if (!NILP (tem
) && !NILP (default_filename
))
5519 val
= default_filename
;
5520 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5522 if (!NILP (default_filename
))
5523 val
= default_filename
;
5525 error ("No default file name");
5527 val
= Fsubstitute_in_file_name (val
);
5529 if (replace_in_history
)
5530 /* Replace what Fcompleting_read added to the history
5531 with what we will actually return. */
5532 XCONS (Fsymbol_value (Qfile_name_history
))->car
= double_dollars (val
);
5533 else if (add_to_history
)
5535 /* Add the value to the history--but not if it matches
5536 the last value already there. */
5537 Lisp_Object val1
= double_dollars (val
);
5538 tem
= Fsymbol_value (Qfile_name_history
);
5539 if (! CONSP (tem
) || NILP (Fequal (XCONS (tem
)->car
, val1
)))
5540 Fset (Qfile_name_history
,
5549 /* Must be set before any path manipulation is performed. */
5550 XSETFASTINT (Vdirectory_sep_char
, '/');
5556 Qexpand_file_name
= intern ("expand-file-name");
5557 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5558 Qdirectory_file_name
= intern ("directory-file-name");
5559 Qfile_name_directory
= intern ("file-name-directory");
5560 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5561 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5562 Qfile_name_as_directory
= intern ("file-name-as-directory");
5563 Qcopy_file
= intern ("copy-file");
5564 Qmake_directory_internal
= intern ("make-directory-internal");
5565 Qdelete_directory
= intern ("delete-directory");
5566 Qdelete_file
= intern ("delete-file");
5567 Qrename_file
= intern ("rename-file");
5568 Qadd_name_to_file
= intern ("add-name-to-file");
5569 Qmake_symbolic_link
= intern ("make-symbolic-link");
5570 Qfile_exists_p
= intern ("file-exists-p");
5571 Qfile_executable_p
= intern ("file-executable-p");
5572 Qfile_readable_p
= intern ("file-readable-p");
5573 Qfile_writable_p
= intern ("file-writable-p");
5574 Qfile_symlink_p
= intern ("file-symlink-p");
5575 Qaccess_file
= intern ("access-file");
5576 Qfile_directory_p
= intern ("file-directory-p");
5577 Qfile_regular_p
= intern ("file-regular-p");
5578 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5579 Qfile_modes
= intern ("file-modes");
5580 Qset_file_modes
= intern ("set-file-modes");
5581 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5582 Qinsert_file_contents
= intern ("insert-file-contents");
5583 Qwrite_region
= intern ("write-region");
5584 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5585 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5587 staticpro (&Qexpand_file_name
);
5588 staticpro (&Qsubstitute_in_file_name
);
5589 staticpro (&Qdirectory_file_name
);
5590 staticpro (&Qfile_name_directory
);
5591 staticpro (&Qfile_name_nondirectory
);
5592 staticpro (&Qunhandled_file_name_directory
);
5593 staticpro (&Qfile_name_as_directory
);
5594 staticpro (&Qcopy_file
);
5595 staticpro (&Qmake_directory_internal
);
5596 staticpro (&Qdelete_directory
);
5597 staticpro (&Qdelete_file
);
5598 staticpro (&Qrename_file
);
5599 staticpro (&Qadd_name_to_file
);
5600 staticpro (&Qmake_symbolic_link
);
5601 staticpro (&Qfile_exists_p
);
5602 staticpro (&Qfile_executable_p
);
5603 staticpro (&Qfile_readable_p
);
5604 staticpro (&Qfile_writable_p
);
5605 staticpro (&Qaccess_file
);
5606 staticpro (&Qfile_symlink_p
);
5607 staticpro (&Qfile_directory_p
);
5608 staticpro (&Qfile_regular_p
);
5609 staticpro (&Qfile_accessible_directory_p
);
5610 staticpro (&Qfile_modes
);
5611 staticpro (&Qset_file_modes
);
5612 staticpro (&Qfile_newer_than_file_p
);
5613 staticpro (&Qinsert_file_contents
);
5614 staticpro (&Qwrite_region
);
5615 staticpro (&Qverify_visited_file_modtime
);
5616 staticpro (&Qset_visited_file_modtime
);
5618 Qfile_name_history
= intern ("file-name-history");
5619 Fset (Qfile_name_history
, Qnil
);
5620 staticpro (&Qfile_name_history
);
5622 Qfile_error
= intern ("file-error");
5623 staticpro (&Qfile_error
);
5624 Qfile_already_exists
= intern ("file-already-exists");
5625 staticpro (&Qfile_already_exists
);
5626 Qfile_date_error
= intern ("file-date-error");
5627 staticpro (&Qfile_date_error
);
5630 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5631 staticpro (&Qfind_buffer_file_type
);
5634 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5635 "*Coding system for encoding file names.\n\
5636 If it is nil, default-file-name-coding-system (which see) is used.");
5637 Vfile_name_coding_system
= Qnil
;
5639 DEFVAR_LISP ("default-file-name-coding-system",
5640 &Vdefault_file_name_coding_system
,
5641 "Default coding system for encoding file names.\n\
5642 This variable is used only when file-name-coding-system is nil.\n\
5644 This variable is set/changed by the command set-language-environment.\n\
5645 User should not set this variable manually,\n\
5646 instead use file-name-coding-system to get a constant encoding\n\
5647 of file names regardless of the current language environment.");
5648 Vdefault_file_name_coding_system
= Qnil
;
5650 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5651 "*Format in which to write auto-save files.\n\
5652 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5653 If it is t, which is the default, auto-save files are written in the\n\
5654 same format as a regular save would use.");
5655 Vauto_save_file_format
= Qt
;
5657 Qformat_decode
= intern ("format-decode");
5658 staticpro (&Qformat_decode
);
5659 Qformat_annotate_function
= intern ("format-annotate-function");
5660 staticpro (&Qformat_annotate_function
);
5662 Qcar_less_than_car
= intern ("car-less-than-car");
5663 staticpro (&Qcar_less_than_car
);
5665 Fput (Qfile_error
, Qerror_conditions
,
5666 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5667 Fput (Qfile_error
, Qerror_message
,
5668 build_string ("File error"));
5670 Fput (Qfile_already_exists
, Qerror_conditions
,
5671 Fcons (Qfile_already_exists
,
5672 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5673 Fput (Qfile_already_exists
, Qerror_message
,
5674 build_string ("File already exists"));
5676 Fput (Qfile_date_error
, Qerror_conditions
,
5677 Fcons (Qfile_date_error
,
5678 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5679 Fput (Qfile_date_error
, Qerror_message
,
5680 build_string ("Cannot set file date"));
5682 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5683 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5684 insert_default_directory
= 1;
5686 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5687 "*Non-nil means write new files with record format `stmlf'.\n\
5688 nil means use format `var'. This variable is meaningful only on VMS.");
5689 vms_stmlf_recfm
= 0;
5691 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5692 "Directory separator character for built-in functions that return file names.\n\
5693 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5694 This variable affects the built-in functions only on Windows,\n\
5695 on other platforms, it is initialized so that Lisp code can find out\n\
5696 what the normal separator is.");
5698 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5699 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5700 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5703 The first argument given to HANDLER is the name of the I/O primitive\n\
5704 to be handled; the remaining arguments are the arguments that were\n\
5705 passed to that primitive. For example, if you do\n\
5706 (file-exists-p FILENAME)\n\
5707 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5708 (funcall HANDLER 'file-exists-p FILENAME)\n\
5709 The function `find-file-name-handler' checks this list for a handler\n\
5710 for its argument.");
5711 Vfile_name_handler_alist
= Qnil
;
5713 DEFVAR_LISP ("set-auto-coding-function",
5714 &Vset_auto_coding_function
,
5715 "If non-nil, a function to call to decide a coding system of file.\n\
5716 Two arguments are passed to this function: the file name\n\
5717 and the length of a file contents following the point.\n\
5718 This function should return a coding system to decode the file contents.\n\
5719 It should check the file name against `auto-coding-alist'.\n\
5720 If no coding system is decided, it should check a coding system\n\
5721 specified in the heading lines with the format:\n\
5722 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5723 or local variable spec of the tailing lines with `coding:' tag.");
5724 Vset_auto_coding_function
= Qnil
;
5726 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5727 "A list of functions to be called at the end of `insert-file-contents'.\n\
5728 Each is passed one argument, the number of bytes inserted. It should return\n\
5729 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5730 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5731 responsible for calling the after-insert-file-functions if appropriate.");
5732 Vafter_insert_file_functions
= Qnil
;
5734 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5735 "A list of functions to be called at the start of `write-region'.\n\
5736 Each is passed two arguments, START and END as for `write-region'.\n\
5737 These are usually two numbers but not always; see the documentation\n\
5738 for `write-region'. The function should return a list of pairs\n\
5739 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5740 inserted at the specified positions of the file being written (1 means to\n\
5741 insert before the first byte written). The POSITIONs must be sorted into\n\
5742 increasing order. If there are several functions in the list, the several\n\
5743 lists are merged destructively.");
5744 Vwrite_region_annotate_functions
= Qnil
;
5746 DEFVAR_LISP ("write-region-annotations-so-far",
5747 &Vwrite_region_annotations_so_far
,
5748 "When an annotation function is called, this holds the previous annotations.\n\
5749 These are the annotations made by other annotation functions\n\
5750 that were already called. See also `write-region-annotate-functions'.");
5751 Vwrite_region_annotations_so_far
= Qnil
;
5753 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5754 "A list of file name handlers that temporarily should not be used.\n\
5755 This applies only to the operation `inhibit-file-name-operation'.");
5756 Vinhibit_file_name_handlers
= Qnil
;
5758 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5759 "The operation for which `inhibit-file-name-handlers' is applicable.");
5760 Vinhibit_file_name_operation
= Qnil
;
5762 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5763 "File name in which we write a list of all auto save file names.\n\
5764 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5765 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5767 Vauto_save_list_file_name
= Qnil
;
5769 defsubr (&Sfind_file_name_handler
);
5770 defsubr (&Sfile_name_directory
);
5771 defsubr (&Sfile_name_nondirectory
);
5772 defsubr (&Sunhandled_file_name_directory
);
5773 defsubr (&Sfile_name_as_directory
);
5774 defsubr (&Sdirectory_file_name
);
5775 defsubr (&Smake_temp_name
);
5776 defsubr (&Sexpand_file_name
);
5777 defsubr (&Ssubstitute_in_file_name
);
5778 defsubr (&Scopy_file
);
5779 defsubr (&Smake_directory_internal
);
5780 defsubr (&Sdelete_directory
);
5781 defsubr (&Sdelete_file
);
5782 defsubr (&Srename_file
);
5783 defsubr (&Sadd_name_to_file
);
5785 defsubr (&Smake_symbolic_link
);
5786 #endif /* S_IFLNK */
5788 defsubr (&Sdefine_logical_name
);
5791 defsubr (&Ssysnetunam
);
5792 #endif /* HPUX_NET */
5793 defsubr (&Sfile_name_absolute_p
);
5794 defsubr (&Sfile_exists_p
);
5795 defsubr (&Sfile_executable_p
);
5796 defsubr (&Sfile_readable_p
);
5797 defsubr (&Sfile_writable_p
);
5798 defsubr (&Saccess_file
);
5799 defsubr (&Sfile_symlink_p
);
5800 defsubr (&Sfile_directory_p
);
5801 defsubr (&Sfile_accessible_directory_p
);
5802 defsubr (&Sfile_regular_p
);
5803 defsubr (&Sfile_modes
);
5804 defsubr (&Sset_file_modes
);
5805 defsubr (&Sset_default_file_modes
);
5806 defsubr (&Sdefault_file_modes
);
5807 defsubr (&Sfile_newer_than_file_p
);
5808 defsubr (&Sinsert_file_contents
);
5809 defsubr (&Swrite_region
);
5810 defsubr (&Scar_less_than_car
);
5811 defsubr (&Sverify_visited_file_modtime
);
5812 defsubr (&Sclear_visited_file_modtime
);
5813 defsubr (&Svisited_file_modtime
);
5814 defsubr (&Sset_visited_file_modtime
);
5815 defsubr (&Sdo_auto_save
);
5816 defsubr (&Sset_buffer_auto_saved
);
5817 defsubr (&Sclear_buffer_auto_save_failure
);
5818 defsubr (&Srecent_auto_save_p
);
5820 defsubr (&Sread_file_name_internal
);
5821 defsubr (&Sread_file_name
);
5824 defsubr (&Sunix_sync
);