1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,97,1998 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
23 #if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX)
28 #include <sys/types.h>
35 #if !defined (S_ISLNK) && defined (S_IFLNK)
36 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
39 #if !defined (S_ISFIFO) && defined (S_IFIFO)
40 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
43 #if !defined (S_ISREG) && defined (S_IFREG)
44 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
68 extern char *strerror ();
85 #include "intervals.h"
96 #endif /* not WINDOWSNT */
100 #include <sys/param.h>
108 #define CORRECT_DIR_SEPS(s) \
109 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
110 else unixtodos_filename (s); \
112 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
113 redirector allows the six letters between 'Z' and 'a' as well. */
115 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
118 #define IS_DRIVE(x) isalpha (x)
120 /* Need to lower-case the drive letter, or else expanded
121 filenames will sometimes compare inequal, because
122 `expand-file-name' doesn't always down-case the drive letter. */
123 #define DRIVE_LETTER(x) (tolower (x))
152 #define min(a, b) ((a) < (b) ? (a) : (b))
153 #define max(a, b) ((a) > (b) ? (a) : (b))
155 /* Nonzero during writing of auto-save files */
158 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
159 a new file with the same mode as the original */
160 int auto_save_mode_bits
;
162 /* Coding system for file names, or nil if none. */
163 Lisp_Object Vfile_name_coding_system
;
165 /* Coding system for file names used only when
166 Vfile_name_coding_system is nil. */
167 Lisp_Object Vdefault_file_name_coding_system
;
169 /* Alist of elements (REGEXP . HANDLER) for file names
170 whose I/O is done with a special handler. */
171 Lisp_Object Vfile_name_handler_alist
;
173 /* Format for auto-save files */
174 Lisp_Object Vauto_save_file_format
;
176 /* Lisp functions for translating file formats */
177 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
179 /* Function to be called to decide a coding system of a reading file. */
180 Lisp_Object Vset_auto_coding_function
;
182 /* Functions to be called to process text properties in inserted file. */
183 Lisp_Object Vafter_insert_file_functions
;
185 /* Functions to be called to create text property annotations for file. */
186 Lisp_Object Vwrite_region_annotate_functions
;
188 /* During build_annotations, each time an annotation function is called,
189 this holds the annotations made by the previous functions. */
190 Lisp_Object Vwrite_region_annotations_so_far
;
192 /* File name in which we write a list of all our auto save files. */
193 Lisp_Object Vauto_save_list_file_name
;
195 /* Nonzero means, when reading a filename in the minibuffer,
196 start out by inserting the default directory into the minibuffer. */
197 int insert_default_directory
;
199 /* On VMS, nonzero means write new files with record format stmlf.
200 Zero means use var format. */
203 /* On NT, specifies the directory separator character, used (eg.) when
204 expanding file names. This can be bound to / or \. */
205 Lisp_Object Vdirectory_sep_char
;
207 extern Lisp_Object Vuser_login_name
;
210 extern Lisp_Object Vw32_get_true_file_attributes
;
213 extern int minibuf_level
;
215 extern int minibuffer_auto_raise
;
217 /* These variables describe handlers that have "already" had a chance
218 to handle the current operation.
220 Vinhibit_file_name_handlers is a list of file name handlers.
221 Vinhibit_file_name_operation is the operation being handled.
222 If we try to handle that operation, we ignore those handlers. */
224 static Lisp_Object Vinhibit_file_name_handlers
;
225 static Lisp_Object Vinhibit_file_name_operation
;
227 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
229 Lisp_Object Qfile_name_history
;
231 Lisp_Object Qcar_less_than_car
;
233 static int a_write
P_ ((int, char *, int, int,
234 Lisp_Object
*, struct coding_system
*));
235 static int e_write
P_ ((int, char *, int, struct coding_system
*));
238 report_file_error (string
, data
)
242 Lisp_Object errstring
;
244 errstring
= build_string (strerror (errno
));
246 /* System error messages are capitalized. Downcase the initial
247 unless it is followed by a slash. */
248 if (XSTRING (errstring
)->data
[1] != '/')
249 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
252 Fsignal (Qfile_error
,
253 Fcons (build_string (string
), Fcons (errstring
, data
)));
257 close_file_unwind (fd
)
260 close (XFASTINT (fd
));
264 /* Restore point, having saved it as a marker. */
267 restore_point_unwind (location
)
268 Lisp_Object location
;
270 Fgoto_char (location
);
271 Fset_marker (location
, Qnil
, Qnil
);
275 Lisp_Object Qexpand_file_name
;
276 Lisp_Object Qsubstitute_in_file_name
;
277 Lisp_Object Qdirectory_file_name
;
278 Lisp_Object Qfile_name_directory
;
279 Lisp_Object Qfile_name_nondirectory
;
280 Lisp_Object Qunhandled_file_name_directory
;
281 Lisp_Object Qfile_name_as_directory
;
282 Lisp_Object Qcopy_file
;
283 Lisp_Object Qmake_directory_internal
;
284 Lisp_Object Qdelete_directory
;
285 Lisp_Object Qdelete_file
;
286 Lisp_Object Qrename_file
;
287 Lisp_Object Qadd_name_to_file
;
288 Lisp_Object Qmake_symbolic_link
;
289 Lisp_Object Qfile_exists_p
;
290 Lisp_Object Qfile_executable_p
;
291 Lisp_Object Qfile_readable_p
;
292 Lisp_Object Qfile_writable_p
;
293 Lisp_Object Qfile_symlink_p
;
294 Lisp_Object Qaccess_file
;
295 Lisp_Object Qfile_directory_p
;
296 Lisp_Object Qfile_regular_p
;
297 Lisp_Object Qfile_accessible_directory_p
;
298 Lisp_Object Qfile_modes
;
299 Lisp_Object Qset_file_modes
;
300 Lisp_Object Qfile_newer_than_file_p
;
301 Lisp_Object Qinsert_file_contents
;
302 Lisp_Object Qwrite_region
;
303 Lisp_Object Qverify_visited_file_modtime
;
304 Lisp_Object Qset_visited_file_modtime
;
306 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
307 "Return FILENAME's handler function for OPERATION, if it has one.\n\
308 Otherwise, return nil.\n\
309 A file name is handled if one of the regular expressions in\n\
310 `file-name-handler-alist' matches it.\n\n\
311 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
312 any handlers that are members of `inhibit-file-name-handlers',\n\
313 but we still do run any other handlers. This lets handlers\n\
314 use the standard functions without calling themselves recursively.")
315 (filename
, operation
)
316 Lisp_Object filename
, operation
;
318 /* This function must not munge the match data. */
319 Lisp_Object chain
, inhibited_handlers
;
321 CHECK_STRING (filename
, 0);
323 if (EQ (operation
, Vinhibit_file_name_operation
))
324 inhibited_handlers
= Vinhibit_file_name_handlers
;
326 inhibited_handlers
= Qnil
;
328 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
329 chain
= XCONS (chain
)->cdr
)
332 elt
= XCONS (chain
)->car
;
336 string
= XCONS (elt
)->car
;
337 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
339 Lisp_Object handler
, tem
;
341 handler
= XCONS (elt
)->cdr
;
342 tem
= Fmemq (handler
, inhibited_handlers
);
353 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
355 "Return the directory component in file name FILENAME.\n\
356 Return nil if FILENAME does not include a directory.\n\
357 Otherwise return a directory spec.\n\
358 Given a Unix syntax file name, returns a string ending in slash;\n\
359 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
361 Lisp_Object filename
;
363 register unsigned char *beg
;
364 register unsigned char *p
;
367 CHECK_STRING (filename
, 0);
369 /* If the file name has special constructs in it,
370 call the corresponding file handler. */
371 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
373 return call2 (handler
, Qfile_name_directory
, filename
);
375 #ifdef FILE_SYSTEM_CASE
376 filename
= FILE_SYSTEM_CASE (filename
);
378 beg
= XSTRING (filename
)->data
;
380 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
382 p
= beg
+ STRING_BYTES (XSTRING (filename
));
384 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
386 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
389 /* only recognise drive specifier at the beginning */
391 /* handle the "/:d:foo" and "/:foo" cases correctly */
392 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
393 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
400 /* Expansion of "c:" to drive and default directory. */
403 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
404 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
405 unsigned char *r
= res
;
407 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
409 strncpy (res
, beg
, 2);
414 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
416 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
419 p
= beg
+ strlen (beg
);
422 CORRECT_DIR_SEPS (beg
);
425 if (STRING_MULTIBYTE (filename
))
426 return make_string (beg
, p
- beg
);
427 return make_unibyte_string (beg
, p
- beg
);
430 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
431 Sfile_name_nondirectory
, 1, 1, 0,
432 "Return file name FILENAME sans its directory.\n\
433 For example, in a Unix-syntax file name,\n\
434 this is everything after the last slash,\n\
435 or the entire name if it contains no slash.")
437 Lisp_Object filename
;
439 register unsigned char *beg
, *p
, *end
;
442 CHECK_STRING (filename
, 0);
444 /* If the file name has special constructs in it,
445 call the corresponding file handler. */
446 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
448 return call2 (handler
, Qfile_name_nondirectory
, filename
);
450 beg
= XSTRING (filename
)->data
;
451 end
= p
= beg
+ STRING_BYTES (XSTRING (filename
));
453 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
455 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
458 /* only recognise drive specifier at beginning */
460 /* handle the "/:d:foo" case correctly */
461 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
466 if (STRING_MULTIBYTE (filename
))
467 return make_string (p
, end
- p
);
468 return make_unibyte_string (p
, end
- p
);
471 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
472 Sunhandled_file_name_directory
, 1, 1, 0,
473 "Return a directly usable directory name somehow associated with FILENAME.\n\
474 A `directly usable' directory name is one that may be used without the\n\
475 intervention of any file handler.\n\
476 If FILENAME is a directly usable file itself, return\n\
477 \(file-name-directory FILENAME).\n\
478 The `call-process' and `start-process' functions use this function to\n\
479 get a current directory to run processes in.")
481 Lisp_Object filename
;
485 /* If the file name has special constructs in it,
486 call the corresponding file handler. */
487 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
489 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
491 return Ffile_name_directory (filename
);
496 file_name_as_directory (out
, in
)
499 int size
= strlen (in
) - 1;
512 /* Is it already a directory string? */
513 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
515 /* Is it a VMS directory file name? If so, hack VMS syntax. */
516 else if (! index (in
, '/')
517 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
518 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
519 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
520 || ! strncmp (&in
[size
- 5], ".dir", 4))
521 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
522 && in
[size
] == '1')))
524 register char *p
, *dot
;
528 dir:x.dir --> dir:[x]
529 dir:[x]y.dir --> dir:[x.y] */
531 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
534 strncpy (out
, in
, p
- in
);
553 dot
= index (p
, '.');
556 /* blindly remove any extension */
557 size
= strlen (out
) + (dot
- p
);
558 strncat (out
, p
, dot
- p
);
569 /* For Unix syntax, Append a slash if necessary */
570 if (!IS_DIRECTORY_SEP (out
[size
]))
572 out
[size
+ 1] = DIRECTORY_SEP
;
573 out
[size
+ 2] = '\0';
576 CORRECT_DIR_SEPS (out
);
582 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
583 Sfile_name_as_directory
, 1, 1, 0,
584 "Return a string representing file FILENAME interpreted as a directory.\n\
585 This operation exists because a directory is also a file, but its name as\n\
586 a directory is different from its name as a file.\n\
587 The result can be used as the value of `default-directory'\n\
588 or passed as second argument to `expand-file-name'.\n\
589 For a Unix-syntax file name, just appends a slash.\n\
590 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
597 CHECK_STRING (file
, 0);
601 /* If the file name has special constructs in it,
602 call the corresponding file handler. */
603 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
605 return call2 (handler
, Qfile_name_as_directory
, file
);
607 buf
= (char *) alloca (STRING_BYTES (XSTRING (file
)) + 10);
608 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
612 * Convert from directory name to filename.
614 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
615 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
616 * On UNIX, it's simple: just make sure there isn't a terminating /
618 * Value is nonzero if the string output is different from the input.
622 directory_file_name (src
, dst
)
630 struct FAB fab
= cc$rms_fab
;
631 struct NAM nam
= cc$rms_nam
;
632 char esa
[NAM$C_MAXRSS
];
637 if (! index (src
, '/')
638 && (src
[slen
- 1] == ']'
639 || src
[slen
- 1] == ':'
640 || src
[slen
- 1] == '>'))
642 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
644 fab
.fab$b_fns
= slen
;
645 fab
.fab$l_nam
= &nam
;
646 fab
.fab$l_fop
= FAB$M_NAM
;
649 nam
.nam$b_ess
= sizeof esa
;
650 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
652 /* We call SYS$PARSE to handle such things as [--] for us. */
653 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
655 slen
= nam
.nam$b_esl
;
656 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
661 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
663 /* what about when we have logical_name:???? */
664 if (src
[slen
- 1] == ':')
665 { /* Xlate logical name and see what we get */
666 ptr
= strcpy (dst
, src
); /* upper case for getenv */
669 if ('a' <= *ptr
&& *ptr
<= 'z')
673 dst
[slen
- 1] = 0; /* remove colon */
674 if (!(src
= egetenv (dst
)))
676 /* should we jump to the beginning of this procedure?
677 Good points: allows us to use logical names that xlate
679 Bad points: can be a problem if we just translated to a device
681 For now, I'll punt and always expect VMS names, and hope for
684 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
685 { /* no recursion here! */
691 { /* not a directory spec */
696 bracket
= src
[slen
- 1];
698 /* If bracket is ']' or '>', bracket - 2 is the corresponding
700 ptr
= index (src
, bracket
- 2);
702 { /* no opening bracket */
706 if (!(rptr
= rindex (src
, '.')))
709 strncpy (dst
, src
, slen
);
713 dst
[slen
++] = bracket
;
718 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
719 then translate the device and recurse. */
720 if (dst
[slen
- 1] == ':'
721 && dst
[slen
- 2] != ':' /* skip decnet nodes */
722 && strcmp (src
+ slen
, "[000000]") == 0)
724 dst
[slen
- 1] = '\0';
725 if ((ptr
= egetenv (dst
))
726 && (rlen
= strlen (ptr
) - 1) > 0
727 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
728 && ptr
[rlen
- 1] == '.')
730 char * buf
= (char *) alloca (strlen (ptr
) + 1);
734 return directory_file_name (buf
, dst
);
739 strcat (dst
, "[000000]");
743 rlen
= strlen (rptr
) - 1;
744 strncat (dst
, rptr
, rlen
);
745 dst
[slen
+ rlen
] = '\0';
746 strcat (dst
, ".DIR.1");
750 /* Process as Unix format: just remove any final slash.
751 But leave "/" unchanged; do not change it to "". */
754 /* Handle // as root for apollo's. */
755 if ((slen
> 2 && dst
[slen
- 1] == '/')
756 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
760 && IS_DIRECTORY_SEP (dst
[slen
- 1])
762 && !IS_ANY_SEP (dst
[slen
- 2])
768 CORRECT_DIR_SEPS (dst
);
773 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
775 "Returns the file name of the directory named DIRECTORY.\n\
776 This is the name of the file that holds the data for the directory DIRECTORY.\n\
777 This operation exists because a directory is also a file, but its name as\n\
778 a directory is different from its name as a file.\n\
779 In Unix-syntax, this function just removes the final slash.\n\
780 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
781 it returns a file name such as \"[X]Y.DIR.1\".")
783 Lisp_Object directory
;
788 CHECK_STRING (directory
, 0);
790 if (NILP (directory
))
793 /* If the file name has special constructs in it,
794 call the corresponding file handler. */
795 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
797 return call2 (handler
, Qdirectory_file_name
, directory
);
800 /* 20 extra chars is insufficient for VMS, since we might perform a
801 logical name translation. an equivalence string can be up to 255
802 chars long, so grab that much extra space... - sss */
803 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20 + 255);
805 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20);
807 directory_file_name (XSTRING (directory
)->data
, buf
);
808 return build_string (buf
);
811 static char make_temp_name_tbl
[64] =
813 'A','B','C','D','E','F','G','H',
814 'I','J','K','L','M','N','O','P',
815 'Q','R','S','T','U','V','W','X',
816 'Y','Z','a','b','c','d','e','f',
817 'g','h','i','j','k','l','m','n',
818 'o','p','q','r','s','t','u','v',
819 'w','x','y','z','0','1','2','3',
820 '4','5','6','7','8','9','-','_'
822 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
824 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
825 "Generate temporary file name (string) starting with PREFIX (a string).\n\
826 The Emacs process number forms part of the result,\n\
827 so there is no danger of generating a name being used by another process.\n\
829 In addition, this function makes an attempt to choose a name\n\
830 which has no existing file. To make this work,\n\
831 PREFIX should be an absolute file name.")
838 unsigned char *p
, *data
;
842 CHECK_STRING (prefix
, 0);
844 /* VAL is created by adding 6 characters to PREFIX. The first
845 three are the PID of this process, in base 64, and the second
846 three are incremented if the file already exists. This ensures
847 262144 unique file names per PID per PREFIX. */
849 pid
= (int) getpid ();
851 #ifdef HAVE_LONG_FILE_NAMES
852 sprintf (pidbuf
, "%d", pid
);
853 pidlen
= strlen (pidbuf
);
855 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
856 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
857 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
861 len
= XSTRING (prefix
)->size
;
862 val
= make_uninit_string (len
+ 3 + pidlen
);
863 data
= XSTRING (val
)->data
;
864 bcopy(XSTRING (prefix
)->data
, data
, len
);
867 bcopy (pidbuf
, p
, pidlen
);
870 /* Here we try to minimize useless stat'ing when this function is
871 invoked many times successively with the same PREFIX. We achieve
872 this by initializing count to a random value, and incrementing it
875 We don't want make-temp-name to be called while dumping,
876 because then make_temp_name_count_initialized_p would get set
877 and then make_temp_name_count would not be set when Emacs starts. */
879 if (!make_temp_name_count_initialized_p
)
881 make_temp_name_count
= (unsigned) time (NULL
);
882 make_temp_name_count_initialized_p
= 1;
888 unsigned num
= make_temp_name_count
;
890 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
891 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
892 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
894 /* Poor man's congruential RN generator. Replace with
895 ++make_temp_name_count for debugging. */
896 make_temp_name_count
+= 25229;
897 make_temp_name_count
%= 225307;
899 if (stat (data
, &ignored
) < 0)
901 /* We want to return only if errno is ENOENT. */
905 /* The error here is dubious, but there is little else we
906 can do. The alternatives are to return nil, which is
907 as bad as (and in many cases worse than) throwing the
908 error, or to ignore the error, which will likely result
909 in looping through 225307 stat's, which is not only
910 dog-slow, but also useless since it will fallback to
911 the errow below, anyway. */
912 report_file_error ("Cannot create temporary name for prefix `%s'",
913 Fcons (prefix
, Qnil
));
918 error ("Cannot create temporary name for prefix `%s'",
919 XSTRING (prefix
)->data
);
924 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
925 "Convert filename NAME to absolute, and canonicalize it.\n\
926 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
927 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
928 the current buffer's value of default-directory is used.\n\
929 File name components that are `.' are removed, and \n\
930 so are file name components followed by `..', along with the `..' itself;\n\
931 note that these simplifications are done without checking the resulting\n\
932 file names in the file system.\n\
933 An initial `~/' expands to your home directory.\n\
934 An initial `~USER/' expands to USER's home directory.\n\
935 See also the function `substitute-in-file-name'.")
936 (name
, default_directory
)
937 Lisp_Object name
, default_directory
;
941 register unsigned char *newdir
, *p
, *o
;
943 unsigned char *target
;
946 unsigned char * colon
= 0;
947 unsigned char * close
= 0;
948 unsigned char * slash
= 0;
949 unsigned char * brack
= 0;
950 int lbrack
= 0, rbrack
= 0;
955 int collapse_newdir
= 1;
961 CHECK_STRING (name
, 0);
963 /* If the file name has special constructs in it,
964 call the corresponding file handler. */
965 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
967 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
969 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
970 if (NILP (default_directory
))
971 default_directory
= current_buffer
->directory
;
972 if (! STRINGP (default_directory
))
973 default_directory
= build_string ("/");
975 if (!NILP (default_directory
))
977 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
979 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
982 o
= XSTRING (default_directory
)->data
;
984 /* Make sure DEFAULT_DIRECTORY is properly expanded.
985 It would be better to do this down below where we actually use
986 default_directory. Unfortunately, calling Fexpand_file_name recursively
987 could invoke GC, and the strings might be relocated. This would
988 be annoying because we have pointers into strings lying around
989 that would need adjusting, and people would add new pointers to
990 the code and forget to adjust them, resulting in intermittent bugs.
991 Putting this call here avoids all that crud.
993 The EQ test avoids infinite recursion. */
994 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
995 /* Save time in some common cases - as long as default_directory
996 is not relative, it can be canonicalized with name below (if it
997 is needed at all) without requiring it to be expanded now. */
999 /* Detect MSDOS file names with drive specifiers. */
1000 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1002 /* Detect Windows file names in UNC format. */
1003 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1005 #else /* not DOS_NT */
1006 /* Detect Unix absolute file names (/... alone is not absolute on
1008 && ! (IS_DIRECTORY_SEP (o
[0]))
1009 #endif /* not DOS_NT */
1012 struct gcpro gcpro1
;
1015 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1020 /* Filenames on VMS are always upper case. */
1021 name
= Fupcase (name
);
1023 #ifdef FILE_SYSTEM_CASE
1024 name
= FILE_SYSTEM_CASE (name
);
1027 nm
= XSTRING (name
)->data
;
1030 /* We will force directory separators to be either all \ or /, so make
1031 a local copy to modify, even if there ends up being no change. */
1032 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1034 /* Note if special escape prefix is present, but remove for now. */
1035 if (nm
[0] == '/' && nm
[1] == ':')
1041 /* Find and remove drive specifier if present; this makes nm absolute
1042 even if the rest of the name appears to be relative. Only look for
1043 drive specifier at the beginning. */
1044 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1051 /* If we see "c://somedir", we want to strip the first slash after the
1052 colon when stripping the drive letter. Otherwise, this expands to
1054 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1056 #endif /* WINDOWSNT */
1060 /* Discard any previous drive specifier if nm is now in UNC format. */
1061 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1067 /* If nm is absolute, look for /./ or /../ sequences; if none are
1068 found, we can probably return right away. We will avoid allocating
1069 a new string if name is already fully expanded. */
1071 IS_DIRECTORY_SEP (nm
[0])
1073 && drive
&& !is_escaped
1076 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1083 /* If it turns out that the filename we want to return is just a
1084 suffix of FILENAME, we don't need to go through and edit
1085 things; we just need to construct a new string using data
1086 starting at the middle of FILENAME. If we set lose to a
1087 non-zero value, that means we've discovered that we can't do
1094 /* Since we know the name is absolute, we can assume that each
1095 element starts with a "/". */
1097 /* "." and ".." are hairy. */
1098 if (IS_DIRECTORY_SEP (p
[0])
1100 && (IS_DIRECTORY_SEP (p
[2])
1102 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1109 /* if dev:[dir]/, move nm to / */
1110 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1111 nm
= (brack
? brack
+ 1 : colon
+ 1);
1112 lbrack
= rbrack
= 0;
1120 /* VMS pre V4.4,convert '-'s in filenames. */
1121 if (lbrack
== rbrack
)
1123 if (dots
< 2) /* this is to allow negative version numbers */
1128 if (lbrack
> rbrack
&&
1129 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1130 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1136 /* count open brackets, reset close bracket pointer */
1137 if (p
[0] == '[' || p
[0] == '<')
1138 lbrack
++, brack
= 0;
1139 /* count close brackets, set close bracket pointer */
1140 if (p
[0] == ']' || p
[0] == '>')
1141 rbrack
++, brack
= p
;
1142 /* detect ][ or >< */
1143 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1145 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1146 nm
= p
+ 1, lose
= 1;
1147 if (p
[0] == ':' && (colon
|| slash
))
1148 /* if dev1:[dir]dev2:, move nm to dev2: */
1154 /* if /name/dev:, move nm to dev: */
1157 /* if node::dev:, move colon following dev */
1158 else if (colon
&& colon
[-1] == ':')
1160 /* if dev1:dev2:, move nm to dev2: */
1161 else if (colon
&& colon
[-1] != ':')
1166 if (p
[0] == ':' && !colon
)
1172 if (lbrack
== rbrack
)
1175 else if (p
[0] == '.')
1183 if (index (nm
, '/'))
1184 return build_string (sys_translate_unix (nm
));
1187 /* Make sure directories are all separated with / or \ as
1188 desired, but avoid allocation of a new string when not
1190 CORRECT_DIR_SEPS (nm
);
1192 if (IS_DIRECTORY_SEP (nm
[1]))
1194 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1195 name
= build_string (nm
);
1199 /* drive must be set, so this is okay */
1200 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1202 name
= make_string (nm
- 2, p
- nm
+ 2);
1203 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1204 XSTRING (name
)->data
[1] = ':';
1207 #else /* not DOS_NT */
1208 if (nm
== XSTRING (name
)->data
)
1210 return build_string (nm
);
1211 #endif /* not DOS_NT */
1215 /* At this point, nm might or might not be an absolute file name. We
1216 need to expand ~ or ~user if present, otherwise prefix nm with
1217 default_directory if nm is not absolute, and finally collapse /./
1218 and /foo/../ sequences.
1220 We set newdir to be the appropriate prefix if one is needed:
1221 - the relevant user directory if nm starts with ~ or ~user
1222 - the specified drive's working dir (DOS/NT only) if nm does not
1224 - the value of default_directory.
1226 Note that these prefixes are not guaranteed to be absolute (except
1227 for the working dir of a drive). Therefore, to ensure we always
1228 return an absolute name, if the final prefix is not absolute we
1229 append it to the current working directory. */
1233 if (nm
[0] == '~') /* prefix ~ */
1235 if (IS_DIRECTORY_SEP (nm
[1])
1239 || nm
[1] == 0) /* ~ by itself */
1241 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1242 newdir
= (unsigned char *) "";
1245 collapse_newdir
= 0;
1248 nm
++; /* Don't leave the slash in nm. */
1251 else /* ~user/filename */
1253 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1258 o
= (unsigned char *) alloca (p
- nm
+ 1);
1259 bcopy ((char *) nm
, o
, p
- nm
);
1262 pw
= (struct passwd
*) getpwnam (o
+ 1);
1265 newdir
= (unsigned char *) pw
-> pw_dir
;
1267 nm
= p
+ 1; /* skip the terminator */
1271 collapse_newdir
= 0;
1276 /* If we don't find a user of that name, leave the name
1277 unchanged; don't move nm forward to p. */
1282 /* On DOS and Windows, nm is absolute if a drive name was specified;
1283 use the drive's current directory as the prefix if needed. */
1284 if (!newdir
&& drive
)
1286 /* Get default directory if needed to make nm absolute. */
1287 if (!IS_DIRECTORY_SEP (nm
[0]))
1289 newdir
= alloca (MAXPATHLEN
+ 1);
1290 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1295 /* Either nm starts with /, or drive isn't mounted. */
1296 newdir
= alloca (4);
1297 newdir
[0] = DRIVE_LETTER (drive
);
1305 /* Finally, if no prefix has been specified and nm is not absolute,
1306 then it must be expanded relative to default_directory. */
1310 /* /... alone is not absolute on DOS and Windows. */
1311 && !IS_DIRECTORY_SEP (nm
[0])
1314 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1321 newdir
= XSTRING (default_directory
)->data
;
1323 /* Note if special escape prefix is present, but remove for now. */
1324 if (newdir
[0] == '/' && newdir
[1] == ':')
1335 /* First ensure newdir is an absolute name. */
1337 /* Detect MSDOS file names with drive specifiers. */
1338 ! (IS_DRIVE (newdir
[0])
1339 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1341 /* Detect Windows file names in UNC format. */
1342 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1346 /* Effectively, let newdir be (expand-file-name newdir cwd).
1347 Because of the admonition against calling expand-file-name
1348 when we have pointers into lisp strings, we accomplish this
1349 indirectly by prepending newdir to nm if necessary, and using
1350 cwd (or the wd of newdir's drive) as the new newdir. */
1352 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1357 if (!IS_DIRECTORY_SEP (nm
[0]))
1359 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1360 file_name_as_directory (tmp
, newdir
);
1364 newdir
= alloca (MAXPATHLEN
+ 1);
1367 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1374 /* Strip off drive name from prefix, if present. */
1375 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1381 /* Keep only a prefix from newdir if nm starts with slash
1382 (//server/share for UNC, nothing otherwise). */
1383 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1386 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1388 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1390 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1392 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1404 /* Get rid of any slash at the end of newdir, unless newdir is
1405 just / or // (an incomplete UNC name). */
1406 length
= strlen (newdir
);
1407 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1409 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1413 unsigned char *temp
= (unsigned char *) alloca (length
);
1414 bcopy (newdir
, temp
, length
- 1);
1415 temp
[length
- 1] = 0;
1423 /* Now concatenate the directory and name to new space in the stack frame */
1424 tlen
+= strlen (nm
) + 1;
1426 /* Reserve space for drive specifier and escape prefix, since either
1427 or both may need to be inserted. (The Microsoft x86 compiler
1428 produces incorrect code if the following two lines are combined.) */
1429 target
= (unsigned char *) alloca (tlen
+ 4);
1431 #else /* not DOS_NT */
1432 target
= (unsigned char *) alloca (tlen
);
1433 #endif /* not DOS_NT */
1439 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1442 /* If newdir is effectively "C:/", then the drive letter will have
1443 been stripped and newdir will be "/". Concatenating with an
1444 absolute directory in nm produces "//", which will then be
1445 incorrectly treated as a network share. Ignore newdir in
1446 this case (keeping the drive letter). */
1447 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1448 && newdir
[1] == '\0'))
1450 strcpy (target
, newdir
);
1454 file_name_as_directory (target
, newdir
);
1457 strcat (target
, nm
);
1459 if (index (target
, '/'))
1460 strcpy (target
, sys_translate_unix (target
));
1463 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1465 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1473 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1479 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1480 /* brackets are offset from each other by 2 */
1483 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1484 /* convert [foo][bar] to [bar] */
1485 while (o
[-1] != '[' && o
[-1] != '<')
1487 else if (*p
== '-' && *o
!= '.')
1490 else if (p
[0] == '-' && o
[-1] == '.' &&
1491 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1492 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1496 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1497 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1499 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1501 /* else [foo.-] ==> [-] */
1507 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1508 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1514 if (!IS_DIRECTORY_SEP (*p
))
1518 else if (IS_DIRECTORY_SEP (p
[0])
1520 && (IS_DIRECTORY_SEP (p
[2])
1523 /* If "/." is the entire filename, keep the "/". Otherwise,
1524 just delete the whole "/.". */
1525 if (o
== target
&& p
[2] == '\0')
1529 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1530 /* `/../' is the "superroot" on certain file systems. */
1532 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1534 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1536 /* Keep initial / only if this is the whole name. */
1537 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1545 #endif /* not VMS */
1549 /* At last, set drive name. */
1551 /* Except for network file name. */
1552 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1553 #endif /* WINDOWSNT */
1555 if (!drive
) abort ();
1557 target
[0] = DRIVE_LETTER (drive
);
1560 /* Reinsert the escape prefix if required. */
1567 CORRECT_DIR_SEPS (target
);
1570 return make_string (target
, o
- target
);
1574 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1575 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1576 "Convert FILENAME to absolute, and canonicalize it.\n\
1577 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1578 (does not start with slash); if DEFAULT is nil or missing,\n\
1579 the current buffer's value of default-directory is used.\n\
1580 Filenames containing `.' or `..' as components are simplified;\n\
1581 initial `~/' expands to your home directory.\n\
1582 See also the function `substitute-in-file-name'.")
1584 Lisp_Object name
, defalt
;
1588 register unsigned char *newdir
, *p
, *o
;
1590 unsigned char *target
;
1594 unsigned char * colon
= 0;
1595 unsigned char * close
= 0;
1596 unsigned char * slash
= 0;
1597 unsigned char * brack
= 0;
1598 int lbrack
= 0, rbrack
= 0;
1602 CHECK_STRING (name
, 0);
1605 /* Filenames on VMS are always upper case. */
1606 name
= Fupcase (name
);
1609 nm
= XSTRING (name
)->data
;
1611 /* If nm is absolute, flush ...// and detect /./ and /../.
1612 If no /./ or /../ we can return right away. */
1624 if (p
[0] == '/' && p
[1] == '/'
1626 /* // at start of filename is meaningful on Apollo system. */
1631 if (p
[0] == '/' && p
[1] == '~')
1632 nm
= p
+ 1, lose
= 1;
1633 if (p
[0] == '/' && p
[1] == '.'
1634 && (p
[2] == '/' || p
[2] == 0
1635 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1641 /* if dev:[dir]/, move nm to / */
1642 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1643 nm
= (brack
? brack
+ 1 : colon
+ 1);
1644 lbrack
= rbrack
= 0;
1652 /* VMS pre V4.4,convert '-'s in filenames. */
1653 if (lbrack
== rbrack
)
1655 if (dots
< 2) /* this is to allow negative version numbers */
1660 if (lbrack
> rbrack
&&
1661 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1662 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1668 /* count open brackets, reset close bracket pointer */
1669 if (p
[0] == '[' || p
[0] == '<')
1670 lbrack
++, brack
= 0;
1671 /* count close brackets, set close bracket pointer */
1672 if (p
[0] == ']' || p
[0] == '>')
1673 rbrack
++, brack
= p
;
1674 /* detect ][ or >< */
1675 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1677 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1678 nm
= p
+ 1, lose
= 1;
1679 if (p
[0] == ':' && (colon
|| slash
))
1680 /* if dev1:[dir]dev2:, move nm to dev2: */
1686 /* If /name/dev:, move nm to dev: */
1689 /* If node::dev:, move colon following dev */
1690 else if (colon
&& colon
[-1] == ':')
1692 /* If dev1:dev2:, move nm to dev2: */
1693 else if (colon
&& colon
[-1] != ':')
1698 if (p
[0] == ':' && !colon
)
1704 if (lbrack
== rbrack
)
1707 else if (p
[0] == '.')
1715 if (index (nm
, '/'))
1716 return build_string (sys_translate_unix (nm
));
1718 if (nm
== XSTRING (name
)->data
)
1720 return build_string (nm
);
1724 /* Now determine directory to start with and put it in NEWDIR */
1728 if (nm
[0] == '~') /* prefix ~ */
1733 || nm
[1] == 0)/* ~/filename */
1735 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1736 newdir
= (unsigned char *) "";
1739 nm
++; /* Don't leave the slash in nm. */
1742 else /* ~user/filename */
1744 /* Get past ~ to user */
1745 unsigned char *user
= nm
+ 1;
1746 /* Find end of name. */
1747 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1748 int len
= ptr
? ptr
- user
: strlen (user
);
1750 unsigned char *ptr1
= index (user
, ':');
1751 if (ptr1
!= 0 && ptr1
- user
< len
)
1754 /* Copy the user name into temp storage. */
1755 o
= (unsigned char *) alloca (len
+ 1);
1756 bcopy ((char *) user
, o
, len
);
1759 /* Look up the user name. */
1760 pw
= (struct passwd
*) getpwnam (o
+ 1);
1762 error ("\"%s\" isn't a registered user", o
+ 1);
1764 newdir
= (unsigned char *) pw
->pw_dir
;
1766 /* Discard the user name from NM. */
1773 #endif /* not VMS */
1777 defalt
= current_buffer
->directory
;
1778 CHECK_STRING (defalt
, 1);
1779 newdir
= XSTRING (defalt
)->data
;
1782 /* Now concatenate the directory and name to new space in the stack frame */
1784 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1785 target
= (unsigned char *) alloca (tlen
);
1791 if (nm
[0] == 0 || nm
[0] == '/')
1792 strcpy (target
, newdir
);
1795 file_name_as_directory (target
, newdir
);
1798 strcat (target
, nm
);
1800 if (index (target
, '/'))
1801 strcpy (target
, sys_translate_unix (target
));
1804 /* Now canonicalize by removing /. and /foo/.. if they appear */
1812 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1818 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1819 /* brackets are offset from each other by 2 */
1822 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1823 /* convert [foo][bar] to [bar] */
1824 while (o
[-1] != '[' && o
[-1] != '<')
1826 else if (*p
== '-' && *o
!= '.')
1829 else if (p
[0] == '-' && o
[-1] == '.' &&
1830 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1831 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1835 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1836 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1838 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1840 /* else [foo.-] ==> [-] */
1846 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1847 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1857 else if (!strncmp (p
, "//", 2)
1859 /* // at start of filename is meaningful in Apollo system. */
1867 else if (p
[0] == '/' && p
[1] == '.' &&
1868 (p
[2] == '/' || p
[2] == 0))
1870 else if (!strncmp (p
, "/..", 3)
1871 /* `/../' is the "superroot" on certain file systems. */
1873 && (p
[3] == '/' || p
[3] == 0))
1875 while (o
!= target
&& *--o
!= '/')
1878 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1882 if (o
== target
&& *o
== '/')
1890 #endif /* not VMS */
1893 return make_string (target
, o
- target
);
1897 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1898 Ssubstitute_in_file_name
, 1, 1, 0,
1899 "Substitute environment variables referred to in FILENAME.\n\
1900 `$FOO' where FOO is an environment variable name means to substitute\n\
1901 the value of that variable. The variable name should be terminated\n\
1902 with a character not a letter, digit or underscore; otherwise, enclose\n\
1903 the entire variable name in braces.\n\
1904 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1905 On VMS, `$' substitution is not done; this function does little and only\n\
1906 duplicates what `expand-file-name' does.")
1908 Lisp_Object filename
;
1912 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1913 unsigned char *target
;
1915 int substituted
= 0;
1917 Lisp_Object handler
;
1919 CHECK_STRING (filename
, 0);
1921 /* If the file name has special constructs in it,
1922 call the corresponding file handler. */
1923 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1924 if (!NILP (handler
))
1925 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1927 nm
= XSTRING (filename
)->data
;
1929 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1930 CORRECT_DIR_SEPS (nm
);
1931 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1933 endp
= nm
+ STRING_BYTES (XSTRING (filename
));
1935 /* If /~ or // appears, discard everything through first slash. */
1937 for (p
= nm
; p
!= endp
; p
++)
1940 #if defined (APOLLO) || defined (WINDOWSNT)
1941 /* // at start of file name is meaningful in Apollo and
1942 WindowsNT systems. */
1943 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1944 #else /* not (APOLLO || WINDOWSNT) */
1945 || IS_DIRECTORY_SEP (p
[0])
1946 #endif /* not (APOLLO || WINDOWSNT) */
1951 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1953 || IS_DIRECTORY_SEP (p
[-1])))
1959 /* see comment in expand-file-name about drive specifiers */
1960 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1961 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1970 return build_string (nm
);
1973 /* See if any variables are substituted into the string
1974 and find the total length of their values in `total' */
1976 for (p
= nm
; p
!= endp
;)
1986 /* "$$" means a single "$" */
1995 while (p
!= endp
&& *p
!= '}') p
++;
1996 if (*p
!= '}') goto missingclose
;
2002 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2006 /* Copy out the variable name */
2007 target
= (unsigned char *) alloca (s
- o
+ 1);
2008 strncpy (target
, o
, s
- o
);
2011 strupr (target
); /* $home == $HOME etc. */
2014 /* Get variable value */
2015 o
= (unsigned char *) egetenv (target
);
2016 if (!o
) goto badvar
;
2017 total
+= strlen (o
);
2024 /* If substitution required, recopy the string and do it */
2025 /* Make space in stack frame for the new copy */
2026 xnm
= (unsigned char *) alloca (STRING_BYTES (XSTRING (filename
)) + total
+ 1);
2029 /* Copy the rest of the name through, replacing $ constructs with values */
2046 while (p
!= endp
&& *p
!= '}') p
++;
2047 if (*p
!= '}') goto missingclose
;
2053 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2057 /* Copy out the variable name */
2058 target
= (unsigned char *) alloca (s
- o
+ 1);
2059 strncpy (target
, o
, s
- o
);
2062 strupr (target
); /* $home == $HOME etc. */
2065 /* Get variable value */
2066 o
= (unsigned char *) egetenv (target
);
2070 if (STRING_MULTIBYTE (filename
))
2072 /* If the original string is multibyte,
2073 convert what we substitute into multibyte. */
2074 unsigned char workbuf
[4], *str
;
2080 c
= unibyte_char_to_multibyte (c
);
2081 if (! SINGLE_BYTE_CHAR_P (c
))
2083 len
= CHAR_STRING (c
, workbuf
, str
);
2084 bcopy (str
, x
, len
);
2100 /* If /~ or // appears, discard everything through first slash. */
2102 for (p
= xnm
; p
!= x
; p
++)
2104 #if defined (APOLLO) || defined (WINDOWSNT)
2105 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2106 #else /* not (APOLLO || WINDOWSNT) */
2107 || IS_DIRECTORY_SEP (p
[0])
2108 #endif /* not (APOLLO || WINDOWSNT) */
2110 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2113 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2114 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2118 if (STRING_MULTIBYTE (filename
))
2119 return make_string (xnm
, x
- xnm
);
2120 return make_unibyte_string (xnm
, x
- xnm
);
2123 error ("Bad format environment-variable substitution");
2125 error ("Missing \"}\" in environment-variable substitution");
2127 error ("Substituting nonexistent environment variable \"%s\"", target
);
2130 #endif /* not VMS */
2133 /* A slightly faster and more convenient way to get
2134 (directory-file-name (expand-file-name FOO)). */
2137 expand_and_dir_to_file (filename
, defdir
)
2138 Lisp_Object filename
, defdir
;
2140 register Lisp_Object absname
;
2142 absname
= Fexpand_file_name (filename
, defdir
);
2145 register int c
= XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1];
2146 if (c
== ':' || c
== ']' || c
== '>')
2147 absname
= Fdirectory_file_name (absname
);
2150 /* Remove final slash, if any (unless this is the root dir).
2151 stat behaves differently depending! */
2152 if (XSTRING (absname
)->size
> 1
2153 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1])
2154 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
))-2]))
2155 /* We cannot take shortcuts; they might be wrong for magic file names. */
2156 absname
= Fdirectory_file_name (absname
);
2161 /* Signal an error if the file ABSNAME already exists.
2162 If INTERACTIVE is nonzero, ask the user whether to proceed,
2163 and bypass the error if the user says to go ahead.
2164 QUERYSTRING is a name for the action that is being considered
2167 *STATPTR is used to store the stat information if the file exists.
2168 If the file does not exist, STATPTR->st_mode is set to 0.
2169 If STATPTR is null, we don't store into it.
2171 If QUICK is nonzero, we ask for y or n, not yes or no. */
2174 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2175 Lisp_Object absname
;
2176 unsigned char *querystring
;
2178 struct stat
*statptr
;
2181 register Lisp_Object tem
, encoded_filename
;
2182 struct stat statbuf
;
2183 struct gcpro gcpro1
;
2185 encoded_filename
= ENCODE_FILE (absname
);
2187 /* stat is a good way to tell whether the file exists,
2188 regardless of what access permissions it has. */
2189 if (stat (XSTRING (encoded_filename
)->data
, &statbuf
) >= 0)
2192 Fsignal (Qfile_already_exists
,
2193 Fcons (build_string ("File already exists"),
2194 Fcons (absname
, Qnil
)));
2196 tem
= format1 ("File %s already exists; %s anyway? ",
2197 XSTRING (absname
)->data
, querystring
);
2199 tem
= Fy_or_n_p (tem
);
2201 tem
= do_yes_or_no_p (tem
);
2204 Fsignal (Qfile_already_exists
,
2205 Fcons (build_string ("File already exists"),
2206 Fcons (absname
, Qnil
)));
2213 statptr
->st_mode
= 0;
2218 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2219 "fCopy file: \nFCopy %s to file: \np\nP",
2220 "Copy FILE to NEWNAME. Both args must be strings.\n\
2221 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2222 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2223 A number as third arg means request confirmation if NEWNAME already exists.\n\
2224 This is what happens in interactive use with M-x.\n\
2225 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2226 last-modified time as the old one. (This works on only some systems.)\n\
2227 A prefix arg makes KEEP-TIME non-nil.")
2228 (file
, newname
, ok_if_already_exists
, keep_date
)
2229 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2232 char buf
[16 * 1024];
2233 struct stat st
, out_st
;
2234 Lisp_Object handler
;
2235 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2236 int count
= specpdl_ptr
- specpdl
;
2237 int input_file_statable_p
;
2238 Lisp_Object encoded_file
, encoded_newname
;
2240 encoded_file
= encoded_newname
= Qnil
;
2241 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2242 CHECK_STRING (file
, 0);
2243 CHECK_STRING (newname
, 1);
2245 file
= Fexpand_file_name (file
, Qnil
);
2246 newname
= Fexpand_file_name (newname
, Qnil
);
2248 /* If the input file name has special constructs in it,
2249 call the corresponding file handler. */
2250 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2251 /* Likewise for output file name. */
2253 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2254 if (!NILP (handler
))
2255 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2256 ok_if_already_exists
, keep_date
));
2258 encoded_file
= ENCODE_FILE (file
);
2259 encoded_newname
= ENCODE_FILE (newname
);
2261 if (NILP (ok_if_already_exists
)
2262 || INTEGERP (ok_if_already_exists
))
2263 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2264 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2265 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2268 ifd
= open (XSTRING (encoded_file
)->data
, O_RDONLY
);
2270 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2272 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2274 /* We can only copy regular files and symbolic links. Other files are not
2276 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2278 #if !defined (DOS_NT) || __DJGPP__ > 1
2279 if (out_st
.st_mode
!= 0
2280 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2283 report_file_error ("Input and output files are the same",
2284 Fcons (file
, Fcons (newname
, Qnil
)));
2288 #if defined (S_ISREG) && defined (S_ISLNK)
2289 if (input_file_statable_p
)
2291 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2293 #if defined (EISDIR)
2294 /* Get a better looking error message. */
2297 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2300 #endif /* S_ISREG && S_ISLNK */
2303 /* Create the copy file with the same record format as the input file */
2304 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2307 /* System's default file type was set to binary by _fmode in emacs.c. */
2308 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2309 #else /* not MSDOS */
2310 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2311 #endif /* not MSDOS */
2314 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2316 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2320 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2321 if (write (ofd
, buf
, n
) != n
)
2322 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2325 /* Closing the output clobbers the file times on some systems. */
2326 if (close (ofd
) < 0)
2327 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2329 if (input_file_statable_p
)
2331 if (!NILP (keep_date
))
2333 EMACS_TIME atime
, mtime
;
2334 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2335 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2336 if (set_file_times (XSTRING (encoded_newname
)->data
,
2338 Fsignal (Qfile_date_error
,
2339 Fcons (build_string ("Cannot set file date"),
2340 Fcons (newname
, Qnil
)));
2343 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2345 #if defined (__DJGPP__) && __DJGPP__ > 1
2346 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2347 and if it can't, it tells so. Otherwise, under MSDOS we usually
2348 get only the READ bit, which will make the copied file read-only,
2349 so it's better not to chmod at all. */
2350 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2351 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2352 #endif /* DJGPP version 2 or newer */
2358 /* Discard the unwind protects. */
2359 specpdl_ptr
= specpdl
+ count
;
2365 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2366 Smake_directory_internal
, 1, 1, 0,
2367 "Create a new directory named DIRECTORY.")
2369 Lisp_Object directory
;
2372 Lisp_Object handler
;
2373 Lisp_Object encoded_dir
;
2375 CHECK_STRING (directory
, 0);
2376 directory
= Fexpand_file_name (directory
, Qnil
);
2378 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2379 if (!NILP (handler
))
2380 return call2 (handler
, Qmake_directory_internal
, directory
);
2382 encoded_dir
= ENCODE_FILE (directory
);
2384 dir
= XSTRING (encoded_dir
)->data
;
2387 if (mkdir (dir
) != 0)
2389 if (mkdir (dir
, 0777) != 0)
2391 report_file_error ("Creating directory", Flist (1, &directory
));
2396 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2397 "Delete the directory named DIRECTORY.")
2399 Lisp_Object directory
;
2402 Lisp_Object handler
;
2403 Lisp_Object encoded_dir
;
2405 CHECK_STRING (directory
, 0);
2406 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2408 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2409 if (!NILP (handler
))
2410 return call2 (handler
, Qdelete_directory
, directory
);
2412 encoded_dir
= ENCODE_FILE (directory
);
2414 dir
= XSTRING (encoded_dir
)->data
;
2416 if (rmdir (dir
) != 0)
2417 report_file_error ("Removing directory", Flist (1, &directory
));
2422 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2423 "Delete file named FILENAME.\n\
2424 If file has multiple names, it continues to exist with the other names.")
2426 Lisp_Object filename
;
2428 Lisp_Object handler
;
2429 Lisp_Object encoded_file
;
2431 CHECK_STRING (filename
, 0);
2432 filename
= Fexpand_file_name (filename
, Qnil
);
2434 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2435 if (!NILP (handler
))
2436 return call2 (handler
, Qdelete_file
, filename
);
2438 encoded_file
= ENCODE_FILE (filename
);
2440 if (0 > unlink (XSTRING (encoded_file
)->data
))
2441 report_file_error ("Removing old name", Flist (1, &filename
));
2446 internal_delete_file_1 (ignore
)
2452 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2455 internal_delete_file (filename
)
2456 Lisp_Object filename
;
2458 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2459 Qt
, internal_delete_file_1
));
2462 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2463 "fRename file: \nFRename %s to file: \np",
2464 "Rename FILE as NEWNAME. Both args strings.\n\
2465 If file has names other than FILE, it continues to have those names.\n\
2466 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2467 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2468 A number as third arg means request confirmation if NEWNAME already exists.\n\
2469 This is what happens in interactive use with M-x.")
2470 (file
, newname
, ok_if_already_exists
)
2471 Lisp_Object file
, newname
, ok_if_already_exists
;
2474 Lisp_Object args
[2];
2476 Lisp_Object handler
;
2477 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2478 Lisp_Object encoded_file
, encoded_newname
;
2480 encoded_file
= encoded_newname
= Qnil
;
2481 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2482 CHECK_STRING (file
, 0);
2483 CHECK_STRING (newname
, 1);
2484 file
= Fexpand_file_name (file
, Qnil
);
2485 newname
= Fexpand_file_name (newname
, Qnil
);
2487 /* If the file name has special constructs in it,
2488 call the corresponding file handler. */
2489 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2491 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2492 if (!NILP (handler
))
2493 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2494 file
, newname
, ok_if_already_exists
));
2496 encoded_file
= ENCODE_FILE (file
);
2497 encoded_newname
= ENCODE_FILE (newname
);
2499 if (NILP (ok_if_already_exists
)
2500 || INTEGERP (ok_if_already_exists
))
2501 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2502 INTEGERP (ok_if_already_exists
), 0, 0);
2504 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2506 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2507 || 0 > unlink (XSTRING (encoded_file
)->data
))
2512 Fcopy_file (file
, newname
,
2513 /* We have already prompted if it was an integer,
2514 so don't have copy-file prompt again. */
2515 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2516 Fdelete_file (file
);
2523 report_file_error ("Renaming", Flist (2, args
));
2526 report_file_error ("Renaming", Flist (2, &file
));
2533 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2534 "fAdd name to file: \nFName to add to %s: \np",
2535 "Give FILE additional name NEWNAME. Both args strings.\n\
2536 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2537 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2538 A number as third arg means request confirmation if NEWNAME already exists.\n\
2539 This is what happens in interactive use with M-x.")
2540 (file
, newname
, ok_if_already_exists
)
2541 Lisp_Object file
, newname
, ok_if_already_exists
;
2544 Lisp_Object args
[2];
2546 Lisp_Object handler
;
2547 Lisp_Object encoded_file
, encoded_newname
;
2548 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2550 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2551 encoded_file
= encoded_newname
= Qnil
;
2552 CHECK_STRING (file
, 0);
2553 CHECK_STRING (newname
, 1);
2554 file
= Fexpand_file_name (file
, Qnil
);
2555 newname
= Fexpand_file_name (newname
, Qnil
);
2557 /* If the file name has special constructs in it,
2558 call the corresponding file handler. */
2559 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2560 if (!NILP (handler
))
2561 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2562 newname
, ok_if_already_exists
));
2564 /* If the new name has special constructs in it,
2565 call the corresponding file handler. */
2566 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2567 if (!NILP (handler
))
2568 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2569 newname
, ok_if_already_exists
));
2571 encoded_file
= ENCODE_FILE (file
);
2572 encoded_newname
= ENCODE_FILE (newname
);
2574 if (NILP (ok_if_already_exists
)
2575 || INTEGERP (ok_if_already_exists
))
2576 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2577 INTEGERP (ok_if_already_exists
), 0, 0);
2579 unlink (XSTRING (newname
)->data
);
2580 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2585 report_file_error ("Adding new name", Flist (2, args
));
2587 report_file_error ("Adding new name", Flist (2, &file
));
2596 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2597 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2598 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2599 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2600 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2601 A number as third arg means request confirmation if LINKNAME already exists.\n\
2602 This happens for interactive use with M-x.")
2603 (filename
, linkname
, ok_if_already_exists
)
2604 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2607 Lisp_Object args
[2];
2609 Lisp_Object handler
;
2610 Lisp_Object encoded_filename
, encoded_linkname
;
2611 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2613 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2614 encoded_filename
= encoded_linkname
= Qnil
;
2615 CHECK_STRING (filename
, 0);
2616 CHECK_STRING (linkname
, 1);
2617 /* If the link target has a ~, we must expand it to get
2618 a truly valid file name. Otherwise, do not expand;
2619 we want to permit links to relative file names. */
2620 if (XSTRING (filename
)->data
[0] == '~')
2621 filename
= Fexpand_file_name (filename
, Qnil
);
2622 linkname
= Fexpand_file_name (linkname
, Qnil
);
2624 /* If the file name has special constructs in it,
2625 call the corresponding file handler. */
2626 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2627 if (!NILP (handler
))
2628 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2629 linkname
, ok_if_already_exists
));
2631 /* If the new link name has special constructs in it,
2632 call the corresponding file handler. */
2633 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2634 if (!NILP (handler
))
2635 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2636 linkname
, ok_if_already_exists
));
2638 encoded_filename
= ENCODE_FILE (filename
);
2639 encoded_linkname
= ENCODE_FILE (linkname
);
2641 if (NILP (ok_if_already_exists
)
2642 || INTEGERP (ok_if_already_exists
))
2643 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2644 INTEGERP (ok_if_already_exists
), 0, 0);
2645 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2646 XSTRING (encoded_linkname
)->data
))
2648 /* If we didn't complain already, silently delete existing file. */
2649 if (errno
== EEXIST
)
2651 unlink (XSTRING (encoded_linkname
)->data
);
2652 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2653 XSTRING (encoded_linkname
)->data
))
2663 report_file_error ("Making symbolic link", Flist (2, args
));
2665 report_file_error ("Making symbolic link", Flist (2, &filename
));
2671 #endif /* S_IFLNK */
2675 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2676 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2677 "Define the job-wide logical name NAME to have the value STRING.\n\
2678 If STRING is nil or a null string, the logical name NAME is deleted.")
2683 CHECK_STRING (name
, 0);
2685 delete_logical_name (XSTRING (name
)->data
);
2688 CHECK_STRING (string
, 1);
2690 if (XSTRING (string
)->size
== 0)
2691 delete_logical_name (XSTRING (name
)->data
);
2693 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2702 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2703 "Open a network connection to PATH using LOGIN as the login string.")
2705 Lisp_Object path
, login
;
2709 CHECK_STRING (path
, 0);
2710 CHECK_STRING (login
, 0);
2712 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2714 if (netresult
== -1)
2719 #endif /* HPUX_NET */
2721 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2723 "Return t if file FILENAME specifies an absolute file name.\n\
2724 On Unix, this is a name starting with a `/' or a `~'.")
2726 Lisp_Object filename
;
2730 CHECK_STRING (filename
, 0);
2731 ptr
= XSTRING (filename
)->data
;
2732 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2734 /* ??? This criterion is probably wrong for '<'. */
2735 || index (ptr
, ':') || index (ptr
, '<')
2736 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2740 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2748 /* Return nonzero if file FILENAME exists and can be executed. */
2751 check_executable (filename
)
2755 int len
= strlen (filename
);
2758 if (stat (filename
, &st
) < 0)
2760 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2761 return ((st
.st_mode
& S_IEXEC
) != 0);
2763 return (S_ISREG (st
.st_mode
)
2765 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2766 || stricmp (suffix
, ".exe") == 0
2767 || stricmp (suffix
, ".bat") == 0)
2768 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2769 #endif /* not WINDOWSNT */
2770 #else /* not DOS_NT */
2771 #ifdef HAVE_EUIDACCESS
2772 return (euidaccess (filename
, 1) >= 0);
2774 /* Access isn't quite right because it uses the real uid
2775 and we really want to test with the effective uid.
2776 But Unix doesn't give us a right way to do it. */
2777 return (access (filename
, 1) >= 0);
2779 #endif /* not DOS_NT */
2782 /* Return nonzero if file FILENAME exists and can be written. */
2785 check_writable (filename
)
2790 if (stat (filename
, &st
) < 0)
2792 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2793 #else /* not MSDOS */
2794 #ifdef HAVE_EUIDACCESS
2795 return (euidaccess (filename
, 2) >= 0);
2797 /* Access isn't quite right because it uses the real uid
2798 and we really want to test with the effective uid.
2799 But Unix doesn't give us a right way to do it.
2800 Opening with O_WRONLY could work for an ordinary file,
2801 but would lose for directories. */
2802 return (access (filename
, 2) >= 0);
2804 #endif /* not MSDOS */
2807 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2808 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2809 See also `file-readable-p' and `file-attributes'.")
2811 Lisp_Object filename
;
2813 Lisp_Object absname
;
2814 Lisp_Object handler
;
2815 struct stat statbuf
;
2817 CHECK_STRING (filename
, 0);
2818 absname
= Fexpand_file_name (filename
, Qnil
);
2820 /* If the file name has special constructs in it,
2821 call the corresponding file handler. */
2822 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2823 if (!NILP (handler
))
2824 return call2 (handler
, Qfile_exists_p
, absname
);
2826 absname
= ENCODE_FILE (absname
);
2828 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2831 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2832 "Return t if FILENAME can be executed by you.\n\
2833 For a directory, this means you can access files in that directory.")
2835 Lisp_Object filename
;
2838 Lisp_Object absname
;
2839 Lisp_Object handler
;
2841 CHECK_STRING (filename
, 0);
2842 absname
= Fexpand_file_name (filename
, Qnil
);
2844 /* If the file name has special constructs in it,
2845 call the corresponding file handler. */
2846 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2847 if (!NILP (handler
))
2848 return call2 (handler
, Qfile_executable_p
, absname
);
2850 absname
= ENCODE_FILE (absname
);
2852 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2855 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2856 "Return t if file FILENAME exists and you can read it.\n\
2857 See also `file-exists-p' and `file-attributes'.")
2859 Lisp_Object filename
;
2861 Lisp_Object absname
;
2862 Lisp_Object handler
;
2865 struct stat statbuf
;
2867 CHECK_STRING (filename
, 0);
2868 absname
= Fexpand_file_name (filename
, Qnil
);
2870 /* If the file name has special constructs in it,
2871 call the corresponding file handler. */
2872 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2873 if (!NILP (handler
))
2874 return call2 (handler
, Qfile_readable_p
, absname
);
2876 absname
= ENCODE_FILE (absname
);
2879 /* Under MS-DOS and Windows, open does not work for directories. */
2880 if (access (XSTRING (absname
)->data
, 0) == 0)
2883 #else /* not DOS_NT */
2885 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2886 /* Opening a fifo without O_NONBLOCK can wait.
2887 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2888 except in the case of a fifo, on a system which handles it. */
2889 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2892 if (S_ISFIFO (statbuf
.st_mode
))
2893 flags
|= O_NONBLOCK
;
2895 desc
= open (XSTRING (absname
)->data
, flags
);
2900 #endif /* not DOS_NT */
2903 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2905 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2906 "Return t if file FILENAME can be written or created by you.")
2908 Lisp_Object filename
;
2910 Lisp_Object absname
, dir
, encoded
;
2911 Lisp_Object handler
;
2912 struct stat statbuf
;
2914 CHECK_STRING (filename
, 0);
2915 absname
= Fexpand_file_name (filename
, Qnil
);
2917 /* If the file name has special constructs in it,
2918 call the corresponding file handler. */
2919 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2920 if (!NILP (handler
))
2921 return call2 (handler
, Qfile_writable_p
, absname
);
2923 encoded
= ENCODE_FILE (absname
);
2924 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
2925 return (check_writable (XSTRING (encoded
)->data
)
2928 dir
= Ffile_name_directory (absname
);
2931 dir
= Fdirectory_file_name (dir
);
2935 dir
= Fdirectory_file_name (dir
);
2938 dir
= ENCODE_FILE (dir
);
2939 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2943 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2944 "Access file FILENAME, and get an error if that does not work.\n\
2945 The second argument STRING is used in the error message.\n\
2946 If there is no error, we return nil.")
2948 Lisp_Object filename
, string
;
2950 Lisp_Object handler
, encoded_filename
;
2953 CHECK_STRING (filename
, 0);
2954 CHECK_STRING (string
, 1);
2956 /* If the file name has special constructs in it,
2957 call the corresponding file handler. */
2958 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2959 if (!NILP (handler
))
2960 return call3 (handler
, Qaccess_file
, filename
, string
);
2962 encoded_filename
= ENCODE_FILE (filename
);
2964 fd
= open (XSTRING (encoded_filename
)->data
, O_RDONLY
);
2966 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2972 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2973 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2974 The value is the name of the file to which it is linked.\n\
2975 Otherwise returns nil.")
2977 Lisp_Object filename
;
2984 Lisp_Object handler
;
2986 CHECK_STRING (filename
, 0);
2987 filename
= Fexpand_file_name (filename
, Qnil
);
2989 /* If the file name has special constructs in it,
2990 call the corresponding file handler. */
2991 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2992 if (!NILP (handler
))
2993 return call2 (handler
, Qfile_symlink_p
, filename
);
2995 filename
= ENCODE_FILE (filename
);
3000 buf
= (char *) xmalloc (bufsize
);
3001 bzero (buf
, bufsize
);
3002 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
3003 if (valsize
< bufsize
) break;
3004 /* Buffer was not long enough */
3013 val
= make_string (buf
, valsize
);
3015 val
= DECODE_FILE (val
);
3017 #else /* not S_IFLNK */
3019 #endif /* not S_IFLNK */
3022 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3023 "Return t if FILENAME names an existing directory.")
3025 Lisp_Object filename
;
3027 register Lisp_Object absname
;
3029 Lisp_Object handler
;
3031 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3033 /* If the file name has special constructs in it,
3034 call the corresponding file handler. */
3035 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3036 if (!NILP (handler
))
3037 return call2 (handler
, Qfile_directory_p
, absname
);
3039 absname
= ENCODE_FILE (absname
);
3041 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3043 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3046 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3047 "Return t if file FILENAME is the name of a directory as a file,\n\
3048 and files in that directory can be opened by you. In order to use a\n\
3049 directory as a buffer's current directory, this predicate must return true.\n\
3050 A directory name spec may be given instead; then the value is t\n\
3051 if the directory so specified exists and really is a readable and\n\
3052 searchable directory.")
3054 Lisp_Object filename
;
3056 Lisp_Object handler
;
3058 struct gcpro gcpro1
;
3060 /* If the file name has special constructs in it,
3061 call the corresponding file handler. */
3062 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3063 if (!NILP (handler
))
3064 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3066 /* It's an unlikely combination, but yes we really do need to gcpro:
3067 Suppose that file-accessible-directory-p has no handler, but
3068 file-directory-p does have a handler; this handler causes a GC which
3069 relocates the string in `filename'; and finally file-directory-p
3070 returns non-nil. Then we would end up passing a garbaged string
3071 to file-executable-p. */
3073 tem
= (NILP (Ffile_directory_p (filename
))
3074 || NILP (Ffile_executable_p (filename
)));
3076 return tem
? Qnil
: Qt
;
3079 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3080 "Return t if file FILENAME is the name of a regular file.\n\
3081 This is the sort of file that holds an ordinary stream of data bytes.")
3083 Lisp_Object filename
;
3085 register Lisp_Object absname
;
3087 Lisp_Object handler
;
3089 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3091 /* If the file name has special constructs in it,
3092 call the corresponding file handler. */
3093 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3094 if (!NILP (handler
))
3095 return call2 (handler
, Qfile_regular_p
, absname
);
3097 absname
= ENCODE_FILE (absname
);
3102 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3104 /* Tell stat to use expensive method to get accurate info. */
3105 Vw32_get_true_file_attributes
= Qt
;
3106 result
= stat (XSTRING (absname
)->data
, &st
);
3107 Vw32_get_true_file_attributes
= tem
;
3111 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3114 if (lstat (XSTRING (absname
)->data
, &st
) < 0)
3116 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3120 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3121 "Return mode bits of file named FILENAME, as an integer.")
3123 Lisp_Object filename
;
3125 Lisp_Object absname
;
3127 Lisp_Object handler
;
3129 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3131 /* If the file name has special constructs in it,
3132 call the corresponding file handler. */
3133 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3134 if (!NILP (handler
))
3135 return call2 (handler
, Qfile_modes
, absname
);
3137 absname
= ENCODE_FILE (absname
);
3139 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3141 #if defined (MSDOS) && __DJGPP__ < 2
3142 if (check_executable (XSTRING (absname
)->data
))
3143 st
.st_mode
|= S_IEXEC
;
3144 #endif /* MSDOS && __DJGPP__ < 2 */
3146 return make_number (st
.st_mode
& 07777);
3149 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3150 "Set mode bits of file named FILENAME to MODE (an integer).\n\
3151 Only the 12 low bits of MODE are used.")
3153 Lisp_Object filename
, mode
;
3155 Lisp_Object absname
, encoded_absname
;
3156 Lisp_Object handler
;
3158 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3159 CHECK_NUMBER (mode
, 1);
3161 /* If the file name has special constructs in it,
3162 call the corresponding file handler. */
3163 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3164 if (!NILP (handler
))
3165 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3167 encoded_absname
= ENCODE_FILE (absname
);
3169 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
3170 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3175 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3176 "Set the file permission bits for newly created files.\n\
3177 The argument MODE should be an integer; only the low 9 bits are used.\n\
3178 This setting is inherited by subprocesses.")
3182 CHECK_NUMBER (mode
, 0);
3184 umask ((~ XINT (mode
)) & 0777);
3189 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3190 "Return the default file protection for created files.\n\
3191 The value is an integer.")
3197 realmask
= umask (0);
3200 XSETINT (value
, (~ realmask
) & 0777);
3206 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3207 "Tell Unix to finish all pending disk updates.")
3216 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3217 "Return t if file FILE1 is newer than file FILE2.\n\
3218 If FILE1 does not exist, the answer is nil;\n\
3219 otherwise, if FILE2 does not exist, the answer is t.")
3221 Lisp_Object file1
, file2
;
3223 Lisp_Object absname1
, absname2
;
3226 Lisp_Object handler
;
3227 struct gcpro gcpro1
, gcpro2
;
3229 CHECK_STRING (file1
, 0);
3230 CHECK_STRING (file2
, 0);
3233 GCPRO2 (absname1
, file2
);
3234 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3235 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3238 /* If the file name has special constructs in it,
3239 call the corresponding file handler. */
3240 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3242 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3243 if (!NILP (handler
))
3244 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3246 GCPRO2 (absname1
, absname2
);
3247 absname1
= ENCODE_FILE (absname1
);
3248 absname2
= ENCODE_FILE (absname2
);
3251 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3254 mtime1
= st
.st_mtime
;
3256 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3259 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3263 Lisp_Object Qfind_buffer_file_type
;
3266 #ifndef READ_BUF_SIZE
3267 #define READ_BUF_SIZE (64 << 10)
3270 /* This function is called when a function bound to
3271 Vset_auto_coding_function causes some error. At that time, a text
3272 of a file has already been inserted in the current buffer, but,
3273 markers has not yet been adjusted. Thus we must adjust markers
3274 here. We are sure that the buffer was empty before the text of the
3275 file was inserted. */
3278 set_auto_coding_unwind (multibyte
)
3279 Lisp_Object multibyte
;
3281 int inserted
= Z_BYTE
- BEG_BYTE
;
3283 if (!NILP (multibyte
))
3284 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
3285 adjust_after_insert (PT
, PT_BYTE
, Z
, Z_BYTE
, inserted
);
3290 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3292 "Insert contents of file FILENAME after point.\n\
3293 Returns list of absolute file name and number of bytes inserted.\n\
3294 If second argument VISIT is non-nil, the buffer's visited filename\n\
3295 and last save file modtime are set, and it is marked unmodified.\n\
3296 If visiting and the file does not exist, visiting is completed\n\
3297 before the error is signaled.\n\
3298 The optional third and fourth arguments BEG and END\n\
3299 specify what portion of the file to insert.\n\
3300 These arguments count bytes in the file, not characters in the buffer.\n\
3301 If VISIT is non-nil, BEG and END must be nil.\n\
3303 If optional fifth argument REPLACE is non-nil,\n\
3304 it means replace the current buffer contents (in the accessible portion)\n\
3305 with the file contents. This is better than simply deleting and inserting\n\
3306 the whole thing because (1) it preserves some marker positions\n\
3307 and (2) it puts less data in the undo list.\n\
3308 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3309 which is often less than the number of characters to be read.\n\
3311 This does code conversion according to the value of\n\
3312 `coding-system-for-read' or `file-coding-system-alist',\n\
3313 and sets the variable `last-coding-system-used' to the coding system\n\
3315 (filename
, visit
, beg
, end
, replace
)
3316 Lisp_Object filename
, visit
, beg
, end
, replace
;
3321 register int how_much
;
3322 register int unprocessed
;
3323 int count
= specpdl_ptr
- specpdl
;
3324 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3325 Lisp_Object handler
, val
, insval
, orig_filename
;
3328 int not_regular
= 0;
3329 unsigned char read_buf
[READ_BUF_SIZE
];
3330 struct coding_system coding
;
3331 unsigned char buffer
[1 << 14];
3332 int replace_handled
= 0;
3333 int set_coding_system
= 0;
3334 int coding_system_decided
= 0;
3336 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3337 error ("Cannot do file visiting in an indirect buffer");
3339 if (!NILP (current_buffer
->read_only
))
3340 Fbarf_if_buffer_read_only ();
3344 orig_filename
= Qnil
;
3346 GCPRO4 (filename
, val
, p
, orig_filename
);
3348 CHECK_STRING (filename
, 0);
3349 filename
= Fexpand_file_name (filename
, Qnil
);
3351 /* If the file name has special constructs in it,
3352 call the corresponding file handler. */
3353 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3354 if (!NILP (handler
))
3356 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3357 visit
, beg
, end
, replace
);
3358 if (CONSP (val
) && CONSP (XCONS (val
)->cdr
))
3359 inserted
= XINT (XCONS (XCONS (val
)->cdr
)->car
);
3363 orig_filename
= filename
;
3364 filename
= ENCODE_FILE (filename
);
3370 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3372 /* Tell stat to use expensive method to get accurate info. */
3373 Vw32_get_true_file_attributes
= Qt
;
3374 total
= stat (XSTRING (filename
)->data
, &st
);
3375 Vw32_get_true_file_attributes
= tem
;
3380 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3382 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3383 || fstat (fd
, &st
) < 0)
3384 #endif /* not APOLLO */
3385 #endif /* WINDOWSNT */
3387 if (fd
>= 0) close (fd
);
3390 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3393 if (!NILP (Vcoding_system_for_read
))
3394 current_buffer
->buffer_file_coding_system
= Vcoding_system_for_read
;
3399 /* This code will need to be changed in order to work on named
3400 pipes, and it's probably just not worth it. So we should at
3401 least signal an error. */
3402 if (!S_ISREG (st
.st_mode
))
3409 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3410 Fsignal (Qfile_error
,
3411 Fcons (build_string ("not a regular file"),
3412 Fcons (orig_filename
, Qnil
)));
3417 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3420 /* Replacement should preserve point as it preserves markers. */
3421 if (!NILP (replace
))
3422 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3424 record_unwind_protect (close_file_unwind
, make_number (fd
));
3426 /* Supposedly happens on VMS. */
3427 if (! not_regular
&& st
.st_size
< 0)
3428 error ("File size is negative");
3430 if (!NILP (beg
) || !NILP (end
))
3432 error ("Attempt to visit less than an entire file");
3435 CHECK_NUMBER (beg
, 0);
3437 XSETFASTINT (beg
, 0);
3440 CHECK_NUMBER (end
, 0);
3445 XSETINT (end
, st
.st_size
);
3446 if (XINT (end
) != st
.st_size
)
3447 error ("Maximum buffer size exceeded");
3453 /* Decide the coding system to use for reading the file now
3454 because we can't use an optimized method for handling
3455 `coding:' tag if the current buffer is not empty. */
3459 if (!NILP (Vcoding_system_for_read
))
3460 val
= Vcoding_system_for_read
;
3461 else if (! NILP (replace
))
3462 /* In REPLACE mode, we can use the same coding system
3463 that was used to visit the file. */
3464 val
= current_buffer
->buffer_file_coding_system
;
3467 /* Don't try looking inside a file for a coding system
3468 specification if it is not seekable. */
3469 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3471 /* Find a coding system specified in the heading two
3472 lines or in the tailing several lines of the file.
3473 We assume that the 1K-byte and 3K-byte for heading
3474 and tailing respectively are sufficient fot this
3476 int how_many
, nread
;
3478 if (st
.st_size
<= (1024 * 4))
3479 nread
= read (fd
, read_buf
, 1024 * 4);
3482 nread
= read (fd
, read_buf
, 1024);
3485 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3486 report_file_error ("Setting file position",
3487 Fcons (orig_filename
, Qnil
));
3488 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3493 error ("IO error reading %s: %s",
3494 XSTRING (orig_filename
)->data
, strerror (errno
));
3497 int count
= specpdl_ptr
- specpdl
;
3498 struct buffer
*prev
= current_buffer
;
3500 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3501 temp_output_buffer_setup (" *code-converting-work*");
3502 set_buffer_internal (XBUFFER (Vstandard_output
));
3503 current_buffer
->enable_multibyte_characters
= Qnil
;
3504 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3505 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3506 val
= call2 (Vset_auto_coding_function
,
3507 filename
, make_number (nread
));
3508 set_buffer_internal (prev
);
3509 /* Discard the unwind protect for recovering the
3513 /* Rewind the file for the actual read done later. */
3514 if (lseek (fd
, 0, 0) < 0)
3515 report_file_error ("Setting file position",
3516 Fcons (orig_filename
, Qnil
));
3522 /* If we have not yet decided a coding system, check
3523 file-coding-system-alist. */
3524 Lisp_Object args
[6], coding_systems
;
3526 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3527 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3528 coding_systems
= Ffind_operation_coding_system (6, args
);
3529 if (CONSP (coding_systems
))
3530 val
= XCONS (coding_systems
)->car
;
3534 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3536 if (NILP (Vcoding_system_for_read
)
3537 && NILP (current_buffer
->enable_multibyte_characters
))
3538 /* We must suppress all text conversion except for end-of-line
3540 setup_raw_text_coding_system (&coding
);
3542 coding_system_decided
= 1;
3545 /* Ensure we always set Vlast_coding_system_used. */
3546 set_coding_system
= 1;
3548 /* If requested, replace the accessible part of the buffer
3549 with the file contents. Avoid replacing text at the
3550 beginning or end of the buffer that matches the file contents;
3551 that preserves markers pointing to the unchanged parts.
3553 Here we implement this feature in an optimized way
3554 for the case where code conversion is NOT needed.
3555 The following if-statement handles the case of conversion
3556 in a less optimal way.
3558 If the code conversion is "automatic" then we try using this
3559 method and hope for the best.
3560 But if we discover the need for conversion, we give up on this method
3561 and let the following if-statement handle the replace job. */
3564 && ! CODING_REQUIRE_DECODING (&coding
)
3565 && (coding
.eol_type
== CODING_EOL_UNDECIDED
3566 || coding
.eol_type
== CODING_EOL_LF
))
3568 /* same_at_start and same_at_end count bytes,
3569 because file access counts bytes
3570 and BEG and END count bytes. */
3571 int same_at_start
= BEGV_BYTE
;
3572 int same_at_end
= ZV_BYTE
;
3574 /* There is still a possibility we will find the need to do code
3575 conversion. If that happens, we set this variable to 1 to
3576 give up on handling REPLACE in the optimized way. */
3577 int giveup_match_end
= 0;
3579 if (XINT (beg
) != 0)
3581 if (lseek (fd
, XINT (beg
), 0) < 0)
3582 report_file_error ("Setting file position",
3583 Fcons (orig_filename
, Qnil
));
3588 /* Count how many chars at the start of the file
3589 match the text at the beginning of the buffer. */
3594 nread
= read (fd
, buffer
, sizeof buffer
);
3596 error ("IO error reading %s: %s",
3597 XSTRING (orig_filename
)->data
, strerror (errno
));
3598 else if (nread
== 0)
3601 if (coding
.type
== coding_type_undecided
)
3602 detect_coding (&coding
, buffer
, nread
);
3603 if (CODING_REQUIRE_DECODING (&coding
))
3604 /* We found that the file should be decoded somehow.
3605 Let's give up here. */
3607 giveup_match_end
= 1;
3611 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3612 detect_eol (&coding
, buffer
, nread
);
3613 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3614 && coding
.eol_type
!= CODING_EOL_LF
)
3615 /* We found that the format of eol should be decoded.
3616 Let's give up here. */
3618 giveup_match_end
= 1;
3623 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3624 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3625 same_at_start
++, bufpos
++;
3626 /* If we found a discrepancy, stop the scan.
3627 Otherwise loop around and scan the next bufferful. */
3628 if (bufpos
!= nread
)
3632 /* If the file matches the buffer completely,
3633 there's no need to replace anything. */
3634 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3638 /* Truncate the buffer to the size of the file. */
3639 del_range_1 (same_at_start
, same_at_end
, 0);
3644 /* Count how many chars at the end of the file
3645 match the text at the end of the buffer. But, if we have
3646 already found that decoding is necessary, don't waste time. */
3647 while (!giveup_match_end
)
3649 int total_read
, nread
, bufpos
, curpos
, trial
;
3651 /* At what file position are we now scanning? */
3652 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3653 /* If the entire file matches the buffer tail, stop the scan. */
3656 /* How much can we scan in the next step? */
3657 trial
= min (curpos
, sizeof buffer
);
3658 if (lseek (fd
, curpos
- trial
, 0) < 0)
3659 report_file_error ("Setting file position",
3660 Fcons (orig_filename
, Qnil
));
3663 while (total_read
< trial
)
3665 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3667 error ("IO error reading %s: %s",
3668 XSTRING (orig_filename
)->data
, strerror (errno
));
3669 total_read
+= nread
;
3671 /* Scan this bufferful from the end, comparing with
3672 the Emacs buffer. */
3673 bufpos
= total_read
;
3674 /* Compare with same_at_start to avoid counting some buffer text
3675 as matching both at the file's beginning and at the end. */
3676 while (bufpos
> 0 && same_at_end
> same_at_start
3677 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3678 same_at_end
--, bufpos
--;
3680 /* If we found a discrepancy, stop the scan.
3681 Otherwise loop around and scan the preceding bufferful. */
3684 /* If this discrepancy is because of code conversion,
3685 we cannot use this method; giveup and try the other. */
3686 if (same_at_end
> same_at_start
3687 && FETCH_BYTE (same_at_end
- 1) >= 0200
3688 && ! NILP (current_buffer
->enable_multibyte_characters
)
3689 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3690 giveup_match_end
= 1;
3696 if (! giveup_match_end
)
3700 /* We win! We can handle REPLACE the optimized way. */
3702 /* Extend the start of non-matching text area to multibyte
3703 character boundary. */
3704 if (! NILP (current_buffer
->enable_multibyte_characters
))
3705 while (same_at_start
> BEGV_BYTE
3706 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3709 /* Extend the end of non-matching text area to multibyte
3710 character boundary. */
3711 if (! NILP (current_buffer
->enable_multibyte_characters
))
3712 while (same_at_end
< ZV_BYTE
3713 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3716 /* Don't try to reuse the same piece of text twice. */
3717 overlap
= (same_at_start
- BEGV_BYTE
3718 - (same_at_end
+ st
.st_size
- ZV
));
3720 same_at_end
+= overlap
;
3722 /* Arrange to read only the nonmatching middle part of the file. */
3723 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3724 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3726 del_range_byte (same_at_start
, same_at_end
, 0);
3727 /* Insert from the file at the proper position. */
3728 temp
= BYTE_TO_CHAR (same_at_start
);
3729 SET_PT_BOTH (temp
, same_at_start
);
3731 /* If display currently starts at beginning of line,
3732 keep it that way. */
3733 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3734 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3736 replace_handled
= 1;
3740 /* If requested, replace the accessible part of the buffer
3741 with the file contents. Avoid replacing text at the
3742 beginning or end of the buffer that matches the file contents;
3743 that preserves markers pointing to the unchanged parts.
3745 Here we implement this feature for the case where code conversion
3746 is needed, in a simple way that needs a lot of memory.
3747 The preceding if-statement handles the case of no conversion
3748 in a more optimized way. */
3749 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3751 int same_at_start
= BEGV_BYTE
;
3752 int same_at_end
= ZV_BYTE
;
3755 /* Make sure that the gap is large enough. */
3756 int bufsize
= 2 * st
.st_size
;
3757 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3760 /* First read the whole file, performing code conversion into
3761 CONVERSION_BUFFER. */
3763 if (lseek (fd
, XINT (beg
), 0) < 0)
3765 free (conversion_buffer
);
3766 report_file_error ("Setting file position",
3767 Fcons (orig_filename
, Qnil
));
3770 total
= st
.st_size
; /* Total bytes in the file. */
3771 how_much
= 0; /* Bytes read from file so far. */
3772 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3773 unprocessed
= 0; /* Bytes not processed in previous loop. */
3775 while (how_much
< total
)
3777 /* try is reserved in some compilers (Microsoft C) */
3778 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3779 unsigned char *destination
= read_buf
+ unprocessed
;
3782 /* Allow quitting out of the actual I/O. */
3785 this = read (fd
, destination
, trytry
);
3788 if (this < 0 || this + unprocessed
== 0)
3796 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3798 int require
, result
;
3800 this += unprocessed
;
3802 /* If we are using more space than estimated,
3803 make CONVERSION_BUFFER bigger. */
3804 require
= decoding_buffer_size (&coding
, this);
3805 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3807 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3808 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3811 /* Convert this batch with results in CONVERSION_BUFFER. */
3812 if (how_much
>= total
) /* This is the last block. */
3813 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3814 result
= decode_coding (&coding
, read_buf
,
3815 conversion_buffer
+ inserted
,
3816 this, bufsize
- inserted
);
3818 /* Save for next iteration whatever we didn't convert. */
3819 unprocessed
= this - coding
.consumed
;
3820 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
3821 this = coding
.produced
;
3827 /* At this point, INSERTED is how many characters (i.e. bytes)
3828 are present in CONVERSION_BUFFER.
3829 HOW_MUCH should equal TOTAL,
3830 or should be <= 0 if we couldn't read the file. */
3834 free (conversion_buffer
);
3837 error ("IO error reading %s: %s",
3838 XSTRING (orig_filename
)->data
, strerror (errno
));
3839 else if (how_much
== -2)
3840 error ("maximum buffer size exceeded");
3843 /* Compare the beginning of the converted file
3844 with the buffer text. */
3847 while (bufpos
< inserted
&& same_at_start
< same_at_end
3848 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3849 same_at_start
++, bufpos
++;
3851 /* If the file matches the buffer completely,
3852 there's no need to replace anything. */
3854 if (bufpos
== inserted
)
3856 free (conversion_buffer
);
3859 /* Truncate the buffer to the size of the file. */
3860 del_range_1 (same_at_start
, same_at_end
, 0);
3864 /* Extend the start of non-matching text area to multibyte
3865 character boundary. */
3866 if (! NILP (current_buffer
->enable_multibyte_characters
))
3867 while (same_at_start
> BEGV_BYTE
3868 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3871 /* Scan this bufferful from the end, comparing with
3872 the Emacs buffer. */
3875 /* Compare with same_at_start to avoid counting some buffer text
3876 as matching both at the file's beginning and at the end. */
3877 while (bufpos
> 0 && same_at_end
> same_at_start
3878 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3879 same_at_end
--, bufpos
--;
3881 /* Extend the end of non-matching text area to multibyte
3882 character boundary. */
3883 if (! NILP (current_buffer
->enable_multibyte_characters
))
3884 while (same_at_end
< ZV_BYTE
3885 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3888 /* Don't try to reuse the same piece of text twice. */
3889 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3891 same_at_end
+= overlap
;
3893 /* If display currently starts at beginning of line,
3894 keep it that way. */
3895 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3896 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3898 /* Replace the chars that we need to replace,
3899 and update INSERTED to equal the number of bytes
3900 we are taking from the file. */
3901 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
3902 del_range_byte (same_at_start
, same_at_end
, 0);
3903 if (same_at_end
!= same_at_start
)
3904 SET_PT_BOTH (GPT
, GPT_BYTE
);
3907 /* Insert from the file at the proper position. */
3908 temp
= BYTE_TO_CHAR (same_at_start
);
3909 SET_PT_BOTH (temp
, same_at_start
);
3912 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
3915 free (conversion_buffer
);
3924 register Lisp_Object temp
;
3926 total
= XINT (end
) - XINT (beg
);
3928 /* Make sure point-max won't overflow after this insertion. */
3929 XSETINT (temp
, total
);
3930 if (total
!= XINT (temp
))
3931 error ("Maximum buffer size exceeded");
3934 /* For a special file, all we can do is guess. */
3935 total
= READ_BUF_SIZE
;
3937 if (NILP (visit
) && total
> 0)
3938 prepare_to_modify_buffer (PT
, PT
, NULL
);
3941 if (GAP_SIZE
< total
)
3942 make_gap (total
- GAP_SIZE
);
3944 if (XINT (beg
) != 0 || !NILP (replace
))
3946 if (lseek (fd
, XINT (beg
), 0) < 0)
3947 report_file_error ("Setting file position",
3948 Fcons (orig_filename
, Qnil
));
3951 /* In the following loop, HOW_MUCH contains the total bytes read so
3952 far for a regular file, and not changed for a special file. But,
3953 before exiting the loop, it is set to a negative value if I/O
3956 /* Total bytes inserted. */
3958 /* Here, we don't do code conversion in the loop. It is done by
3959 code_convert_region after all data are read into the buffer. */
3960 while (how_much
< total
)
3962 /* try is reserved in some compilers (Microsoft C) */
3963 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3966 /* For a special file, GAP_SIZE should be checked every time. */
3967 if (not_regular
&& GAP_SIZE
< trytry
)
3968 make_gap (total
- GAP_SIZE
);
3970 /* Allow quitting out of the actual I/O. */
3973 this = read (fd
, BYTE_POS_ADDR (PT_BYTE
+ inserted
- 1) + 1, trytry
);
3990 /* For a regular file, where TOTAL is the real size,
3991 count HOW_MUCH to compare with it.
3992 For a special file, where TOTAL is just a buffer size,
3993 so don't bother counting in HOW_MUCH.
3994 (INSERTED is where we count the number of characters inserted.) */
4001 /* Put an anchor to ensure multi-byte form ends at gap. */
4006 /* Discard the unwind protect for closing the file. */
4010 error ("IO error reading %s: %s",
4011 XSTRING (orig_filename
)->data
, strerror (errno
));
4013 if (! coding_system_decided
)
4015 /* The coding system is not yet decided. Decide it by an
4016 optimized method for handling `coding:' tag. */
4020 if (!NILP (Vcoding_system_for_read
))
4021 val
= Vcoding_system_for_read
;
4024 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4026 /* Since we are sure that the current buffer was
4027 empty before the insertion, we can toggle
4028 enable-multibyte-characters directly here without
4029 taking care of marker adjustment and byte
4030 combining problem. */
4031 Lisp_Object prev_multibyte
;
4032 int count
= specpdl_ptr
- specpdl
;
4034 prev_multibyte
= current_buffer
->enable_multibyte_characters
;
4035 current_buffer
->enable_multibyte_characters
= Qnil
;
4036 record_unwind_protect (set_auto_coding_unwind
,
4038 val
= call2 (Vset_auto_coding_function
,
4039 filename
, make_number (inserted
));
4040 /* Discard the unwind protect for recovering the
4041 error of Vset_auto_coding_function. */
4043 current_buffer
->enable_multibyte_characters
= prev_multibyte
;
4044 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
4049 /* If the coding system is not yet decided, check
4050 file-coding-system-alist. */
4051 Lisp_Object args
[6], coding_systems
;
4053 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4054 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4055 coding_systems
= Ffind_operation_coding_system (6, args
);
4056 if (CONSP (coding_systems
))
4057 val
= XCONS (coding_systems
)->car
;
4061 /* The following kludgy code is to avoid some compiler bug.
4063 setup_coding_system (val, &coding);
4066 struct coding_system temp_coding
;
4067 setup_coding_system (val
, &temp_coding
);
4068 bcopy (&temp_coding
, &coding
, sizeof coding
);
4071 if (NILP (Vcoding_system_for_read
)
4072 && NILP (current_buffer
->enable_multibyte_characters
))
4073 /* We must suppress all text conversion except for
4074 end-of-line conversion. */
4075 setup_raw_text_coding_system (&coding
);
4078 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4080 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4082 /* Here, we don't have to consider byte combining (see the
4083 comment below) because code_convert_region takes care of
4085 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4087 inserted
= (NILP (current_buffer
->enable_multibyte_characters
)
4088 ? coding
.produced
: coding
.produced_char
);
4090 else if (!NILP (current_buffer
->enable_multibyte_characters
))
4092 int inserted_byte
= inserted
;
4094 /* There's a possibility that we must combine bytes at the
4095 head (resp. the tail) of the just inserted text with the
4096 bytes before (resp. after) the gap to form a single
4098 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
4099 adjust_after_insert (PT
, PT_BYTE
,
4100 PT
+ inserted_byte
, PT_BYTE
+ inserted_byte
,
4104 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4109 /* Use the conversion type to determine buffer-file-type
4110 (find-buffer-file-type is now used to help determine the
4112 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4113 || coding
.eol_type
== CODING_EOL_LF
)
4114 && ! CODING_REQUIRE_DECODING (&coding
))
4115 current_buffer
->buffer_file_type
= Qt
;
4117 current_buffer
->buffer_file_type
= Qnil
;
4125 if (!EQ (current_buffer
->undo_list
, Qt
))
4126 current_buffer
->undo_list
= Qnil
;
4128 stat (XSTRING (filename
)->data
, &st
);
4133 current_buffer
->modtime
= st
.st_mtime
;
4134 current_buffer
->filename
= orig_filename
;
4137 SAVE_MODIFF
= MODIFF
;
4138 current_buffer
->auto_save_modified
= MODIFF
;
4139 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4140 #ifdef CLASH_DETECTION
4143 if (!NILP (current_buffer
->file_truename
))
4144 unlock_file (current_buffer
->file_truename
);
4145 unlock_file (filename
);
4147 #endif /* CLASH_DETECTION */
4149 Fsignal (Qfile_error
,
4150 Fcons (build_string ("not a regular file"),
4151 Fcons (orig_filename
, Qnil
)));
4153 /* If visiting nonexistent file, return nil. */
4154 if (current_buffer
->modtime
== -1)
4155 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4158 /* Decode file format */
4161 insval
= call3 (Qformat_decode
,
4162 Qnil
, make_number (inserted
), visit
);
4163 CHECK_NUMBER (insval
, 0);
4164 inserted
= XFASTINT (insval
);
4167 /* Call after-change hooks for the inserted text, aside from the case
4168 of normal visiting (not with REPLACE), which is done in a new buffer
4169 "before" the buffer is changed. */
4170 if (inserted
> 0 && total
> 0
4171 && (NILP (visit
) || !NILP (replace
)))
4172 signal_after_change (PT
, 0, inserted
);
4174 if (set_coding_system
)
4175 Vlast_coding_system_used
= coding
.symbol
;
4179 p
= Vafter_insert_file_functions
;
4182 insval
= call1 (Fcar (p
), make_number (inserted
));
4185 CHECK_NUMBER (insval
, 0);
4186 inserted
= XFASTINT (insval
);
4193 /* ??? Retval needs to be dealt with in all cases consistently. */
4195 val
= Fcons (orig_filename
,
4196 Fcons (make_number (inserted
),
4199 RETURN_UNGCPRO (unbind_to (count
, val
));
4202 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
4205 /* If build_annotations switched buffers, switch back to BUF.
4206 Kill the temporary buffer that was selected in the meantime.
4208 Since this kill only the last temporary buffer, some buffers remain
4209 not killed if build_annotations switched buffers more than once.
4213 build_annotations_unwind (buf
)
4218 if (XBUFFER (buf
) == current_buffer
)
4220 tembuf
= Fcurrent_buffer ();
4222 Fkill_buffer (tembuf
);
4226 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4227 "r\nFWrite region to file: \ni\ni\ni\np",
4228 "Write current region into specified file.\n\
4229 When called from a program, takes three arguments:\n\
4230 START, END and FILENAME. START and END are buffer positions.\n\
4231 Optional fourth argument APPEND if non-nil means\n\
4232 append to existing file contents (if any).\n\
4233 Optional fifth argument VISIT if t means\n\
4234 set the last-save-file-modtime of buffer to this file's modtime\n\
4235 and mark buffer not modified.\n\
4236 If VISIT is a string, it is a second file name;\n\
4237 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
4238 VISIT is also the file name to lock and unlock for clash detection.\n\
4239 If VISIT is neither t nor nil nor a string,\n\
4240 that means do not print the \"Wrote file\" message.\n\
4241 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
4242 use for locking and unlocking, overriding FILENAME and VISIT.\n\
4243 The optional seventh arg CONFIRM, if non-nil, says ask for confirmation\n\
4244 before overwriting an existing file.\n\
4245 Kludgy feature: if START is a string, then that string is written\n\
4246 to the file, instead of any buffer contents, and END is ignored.\n\
4248 This does code conversion according to the value of\n\
4249 `coding-system-for-write', `buffer-file-coding-system', or\n\
4250 `file-coding-system-alist', and sets the variable\n\
4251 `last-coding-system-used' to the coding system actually used.")
4253 (start
, end
, filename
, append
, visit
, lockname
, confirm
)
4254 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, confirm
;
4262 int count
= specpdl_ptr
- specpdl
;
4265 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4267 Lisp_Object handler
;
4268 Lisp_Object visit_file
;
4269 Lisp_Object annotations
;
4270 Lisp_Object encoded_filename
;
4271 int visiting
, quietly
;
4272 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4273 struct buffer
*given_buffer
;
4275 int buffer_file_type
= O_BINARY
;
4277 struct coding_system coding
;
4279 if (current_buffer
->base_buffer
&& ! NILP (visit
))
4280 error ("Cannot do file visiting in an indirect buffer");
4282 if (!NILP (start
) && !STRINGP (start
))
4283 validate_region (&start
, &end
);
4285 GCPRO4 (start
, filename
, visit
, lockname
);
4287 /* Decide the coding-system to encode the data with. */
4293 else if (!NILP (Vcoding_system_for_write
))
4294 val
= Vcoding_system_for_write
;
4297 /* If the variable `buffer-file-coding-system' is set locally,
4298 it means that the file was read with some kind of code
4299 conversion or the varialbe is explicitely set by users. We
4300 had better write it out with the same coding system even if
4301 `enable-multibyte-characters' is nil.
4303 If it is not set locally, we anyway have to convert EOL
4304 format if the default value of `buffer-file-coding-system'
4305 tells that it is not Unix-like (LF only) format. */
4306 int using_default_coding
= 0;
4307 int force_raw_text
= 0;
4309 val
= current_buffer
->buffer_file_coding_system
;
4311 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4314 if (NILP (current_buffer
->enable_multibyte_characters
))
4320 /* Check file-coding-system-alist. */
4321 Lisp_Object args
[7], coding_systems
;
4323 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4324 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4326 coding_systems
= Ffind_operation_coding_system (7, args
);
4327 if (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
))
4328 val
= XCONS (coding_systems
)->cdr
;
4332 && !NILP (current_buffer
->buffer_file_coding_system
))
4334 /* If we still have not decided a coding system, use the
4335 default value of buffer-file-coding-system. */
4336 val
= current_buffer
->buffer_file_coding_system
;
4337 using_default_coding
= 1;
4341 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4342 /* Confirm that VAL can surely encode the current region. */
4343 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4345 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4346 if (coding
.eol_type
== CODING_EOL_UNDECIDED
4347 && !using_default_coding
)
4349 if (! EQ (default_buffer_file_coding
.symbol
,
4350 buffer_defaults
.buffer_file_coding_system
))
4351 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4352 &default_buffer_file_coding
);
4353 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4355 Lisp_Object subsidiaries
;
4357 coding
.eol_type
= default_buffer_file_coding
.eol_type
;
4358 subsidiaries
= Fget (coding
.symbol
, Qeol_type
);
4359 if (VECTORP (subsidiaries
)
4360 && XVECTOR (subsidiaries
)->size
== 3)
4362 = XVECTOR (subsidiaries
)->contents
[coding
.eol_type
];
4367 setup_raw_text_coding_system (&coding
);
4368 goto done_setup_coding
;
4371 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4374 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4375 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4378 Vlast_coding_system_used
= coding
.symbol
;
4380 filename
= Fexpand_file_name (filename
, Qnil
);
4382 if (! NILP (confirm
))
4383 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4385 if (STRINGP (visit
))
4386 visit_file
= Fexpand_file_name (visit
, Qnil
);
4388 visit_file
= filename
;
4391 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4392 quietly
= !NILP (visit
);
4396 if (NILP (lockname
))
4397 lockname
= visit_file
;
4399 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4401 /* If the file name has special constructs in it,
4402 call the corresponding file handler. */
4403 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4404 /* If FILENAME has no handler, see if VISIT has one. */
4405 if (NILP (handler
) && STRINGP (visit
))
4406 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4408 if (!NILP (handler
))
4411 val
= call6 (handler
, Qwrite_region
, start
, end
,
4412 filename
, append
, visit
);
4416 SAVE_MODIFF
= MODIFF
;
4417 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4418 current_buffer
->filename
= visit_file
;
4424 /* Special kludge to simplify auto-saving. */
4427 XSETFASTINT (start
, BEG
);
4428 XSETFASTINT (end
, Z
);
4431 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4432 count1
= specpdl_ptr
- specpdl
;
4434 given_buffer
= current_buffer
;
4435 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4436 if (current_buffer
!= given_buffer
)
4438 XSETFASTINT (start
, BEGV
);
4439 XSETFASTINT (end
, ZV
);
4442 #ifdef CLASH_DETECTION
4445 #if 0 /* This causes trouble for GNUS. */
4446 /* If we've locked this file for some other buffer,
4447 query before proceeding. */
4448 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4449 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4452 lock_file (lockname
);
4454 #endif /* CLASH_DETECTION */
4456 encoded_filename
= ENCODE_FILE (filename
);
4458 fn
= XSTRING (encoded_filename
)->data
;
4462 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4463 #else /* not DOS_NT */
4464 desc
= open (fn
, O_WRONLY
);
4465 #endif /* not DOS_NT */
4467 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4469 if (auto_saving
) /* Overwrite any previous version of autosave file */
4471 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4472 desc
= open (fn
, O_RDWR
);
4474 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4475 ? XSTRING (current_buffer
->filename
)->data
: 0,
4478 else /* Write to temporary name and rename if no errors */
4480 Lisp_Object temp_name
;
4481 temp_name
= Ffile_name_directory (filename
);
4483 if (!NILP (temp_name
))
4485 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4486 build_string ("$$SAVE$$")));
4487 fname
= XSTRING (filename
)->data
;
4488 fn
= XSTRING (temp_name
)->data
;
4489 desc
= creat_copy_attrs (fname
, fn
);
4492 /* If we can't open the temporary file, try creating a new
4493 version of the original file. VMS "creat" creates a
4494 new version rather than truncating an existing file. */
4497 desc
= creat (fn
, 0666);
4498 #if 0 /* This can clobber an existing file and fail to replace it,
4499 if the user runs out of space. */
4502 /* We can't make a new version;
4503 try to truncate and rewrite existing version if any. */
4505 desc
= open (fn
, O_RDWR
);
4511 desc
= creat (fn
, 0666);
4516 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4517 S_IREAD
| S_IWRITE
);
4518 #else /* not DOS_NT */
4519 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4520 #endif /* not DOS_NT */
4521 #endif /* not VMS */
4527 #ifdef CLASH_DETECTION
4529 if (!auto_saving
) unlock_file (lockname
);
4531 #endif /* CLASH_DETECTION */
4532 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4535 record_unwind_protect (close_file_unwind
, make_number (desc
));
4537 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4538 if (lseek (desc
, 0, 2) < 0)
4540 #ifdef CLASH_DETECTION
4541 if (!auto_saving
) unlock_file (lockname
);
4542 #endif /* CLASH_DETECTION */
4543 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4548 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4549 * if we do writes that don't end with a carriage return. Furthermore
4550 * it cannot handle writes of more then 16K. The modified
4551 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4552 * this EXCEPT for the last record (iff it doesn't end with a carriage
4553 * return). This implies that if your buffer doesn't end with a carriage
4554 * return, you get one free... tough. However it also means that if
4555 * we make two calls to sys_write (a la the following code) you can
4556 * get one at the gap as well. The easiest way to fix this (honest)
4557 * is to move the gap to the next newline (or the end of the buffer).
4562 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4563 move_gap (find_next_newline (GPT
, 1));
4565 /* Whether VMS or not, we must move the gap to the next of newline
4566 when we must put designation sequences at beginning of line. */
4567 if (INTEGERP (start
)
4568 && coding
.type
== coding_type_iso2022
4569 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4570 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4572 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4573 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4574 move_gap_both (PT
, PT_BYTE
);
4575 SET_PT_BOTH (opoint
, opoint_byte
);
4582 if (STRINGP (start
))
4584 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4585 STRING_BYTES (XSTRING (start
)), 0, &annotations
,
4589 else if (XINT (start
) != XINT (end
))
4591 register int end1
= CHAR_TO_BYTE (XINT (end
));
4593 tem
= CHAR_TO_BYTE (XINT (start
));
4595 if (XINT (start
) < GPT
)
4597 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
),
4598 min (GPT_BYTE
, end1
) - tem
, tem
, &annotations
,
4603 if (XINT (end
) > GPT
&& !failure
)
4605 tem
= max (tem
, GPT_BYTE
);
4606 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
), end1
- tem
,
4607 tem
, &annotations
, &coding
);
4613 /* If file was empty, still need to write the annotations */
4614 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4615 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4619 if (CODING_REQUIRE_FLUSHING (&coding
)
4620 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4623 /* We have to flush out a data. */
4624 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4625 failure
= 0 > e_write (desc
, "", 0, &coding
);
4632 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4633 Disk full in NFS may be reported here. */
4634 /* mib says that closing the file will try to write as fast as NFS can do
4635 it, and that means the fsync here is not crucial for autosave files. */
4636 if (!auto_saving
&& fsync (desc
) < 0)
4638 /* If fsync fails with EINTR, don't treat that as serious. */
4640 failure
= 1, save_errno
= errno
;
4644 /* Spurious "file has changed on disk" warnings have been
4645 observed on Suns as well.
4646 It seems that `close' can change the modtime, under nfs.
4648 (This has supposedly been fixed in Sunos 4,
4649 but who knows about all the other machines with NFS?) */
4652 /* On VMS and APOLLO, must do the stat after the close
4653 since closing changes the modtime. */
4656 /* Recall that #if defined does not work on VMS. */
4663 /* NFS can report a write failure now. */
4664 if (close (desc
) < 0)
4665 failure
= 1, save_errno
= errno
;
4668 /* If we wrote to a temporary name and had no errors, rename to real name. */
4672 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4680 /* Discard the unwind protect for close_file_unwind. */
4681 specpdl_ptr
= specpdl
+ count1
;
4682 /* Restore the original current buffer. */
4683 visit_file
= unbind_to (count
, visit_file
);
4685 #ifdef CLASH_DETECTION
4687 unlock_file (lockname
);
4688 #endif /* CLASH_DETECTION */
4690 /* Do this before reporting IO error
4691 to avoid a "file has changed on disk" warning on
4692 next attempt to save. */
4694 current_buffer
->modtime
= st
.st_mtime
;
4697 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4698 strerror (save_errno
));
4702 SAVE_MODIFF
= MODIFF
;
4703 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4704 current_buffer
->filename
= visit_file
;
4705 update_mode_lines
++;
4711 message_with_string ("Wrote %s", visit_file
, 1);
4716 Lisp_Object
merge ();
4718 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4719 "Return t if (car A) is numerically less than (car B).")
4723 return Flss (Fcar (a
), Fcar (b
));
4726 /* Build the complete list of annotations appropriate for writing out
4727 the text between START and END, by calling all the functions in
4728 write-region-annotate-functions and merging the lists they return.
4729 If one of these functions switches to a different buffer, we assume
4730 that buffer contains altered text. Therefore, the caller must
4731 make sure to restore the current buffer in all cases,
4732 as save-excursion would do. */
4735 build_annotations (start
, end
, pre_write_conversion
)
4736 Lisp_Object start
, end
, pre_write_conversion
;
4738 Lisp_Object annotations
;
4740 struct gcpro gcpro1
, gcpro2
;
4741 Lisp_Object original_buffer
;
4743 XSETBUFFER (original_buffer
, current_buffer
);
4746 p
= Vwrite_region_annotate_functions
;
4747 GCPRO2 (annotations
, p
);
4750 struct buffer
*given_buffer
= current_buffer
;
4751 Vwrite_region_annotations_so_far
= annotations
;
4752 res
= call2 (Fcar (p
), start
, end
);
4753 /* If the function makes a different buffer current,
4754 assume that means this buffer contains altered text to be output.
4755 Reset START and END from the buffer bounds
4756 and discard all previous annotations because they should have
4757 been dealt with by this function. */
4758 if (current_buffer
!= given_buffer
)
4760 XSETFASTINT (start
, BEGV
);
4761 XSETFASTINT (end
, ZV
);
4764 Flength (res
); /* Check basic validity of return value */
4765 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4769 /* Now do the same for annotation functions implied by the file-format */
4770 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4771 p
= Vauto_save_file_format
;
4773 p
= current_buffer
->file_format
;
4776 struct buffer
*given_buffer
= current_buffer
;
4777 Vwrite_region_annotations_so_far
= annotations
;
4778 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4780 if (current_buffer
!= given_buffer
)
4782 XSETFASTINT (start
, BEGV
);
4783 XSETFASTINT (end
, ZV
);
4787 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4791 /* At last, do the same for the function PRE_WRITE_CONVERSION
4792 implied by the current coding-system. */
4793 if (!NILP (pre_write_conversion
))
4795 struct buffer
*given_buffer
= current_buffer
;
4796 Vwrite_region_annotations_so_far
= annotations
;
4797 res
= call2 (pre_write_conversion
, start
, end
);
4799 annotations
= (current_buffer
!= given_buffer
4801 : merge (annotations
, res
, Qcar_less_than_car
));
4808 /* Write to descriptor DESC the NBYTES bytes starting at ADDR,
4809 assuming they start at byte position BYTEPOS in the buffer.
4810 Intersperse with them the annotations from *ANNOT
4811 which fall within the range of byte positions BYTEPOS to BYTEPOS + NBYTES,
4812 each at its appropriate position.
4814 We modify *ANNOT by discarding elements as we use them up.
4816 The return value is negative in case of system call failure. */
4819 a_write (desc
, addr
, nbytes
, bytepos
, annot
, coding
)
4821 register char *addr
;
4822 register int nbytes
;
4825 struct coding_system
*coding
;
4829 int lastpos
= bytepos
+ nbytes
;
4831 while (NILP (*annot
) || CONSP (*annot
))
4833 tem
= Fcar_safe (Fcar (*annot
));
4834 nextpos
= bytepos
- 1;
4836 nextpos
= CHAR_TO_BYTE (XFASTINT (tem
));
4838 /* If there are no more annotations in this range,
4839 output the rest of the range all at once. */
4840 if (! (nextpos
>= bytepos
&& nextpos
<= lastpos
))
4841 return e_write (desc
, addr
, lastpos
- bytepos
, coding
);
4843 /* Output buffer text up to the next annotation's position. */
4844 if (nextpos
> bytepos
)
4846 if (0 > e_write (desc
, addr
, nextpos
- bytepos
, coding
))
4848 addr
+= nextpos
- bytepos
;
4851 /* Output the annotation. */
4852 tem
= Fcdr (Fcar (*annot
));
4855 if (0 > e_write (desc
, XSTRING (tem
)->data
, STRING_BYTES (XSTRING (tem
)),
4859 *annot
= Fcdr (*annot
);
4864 #ifndef WRITE_BUF_SIZE
4865 #define WRITE_BUF_SIZE (16 * 1024)
4868 /* Write NBYTES bytes starting at ADDR into descriptor DESC,
4869 encoding them with coding system CODING. */
4872 e_write (desc
, addr
, nbytes
, coding
)
4874 register char *addr
;
4875 register int nbytes
;
4876 struct coding_system
*coding
;
4878 char buf
[WRITE_BUF_SIZE
];
4880 /* We used to have a code for handling selective display here. But,
4881 now it is handled within encode_coding. */
4886 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
4887 nbytes
-= coding
->consumed
, addr
+= coding
->consumed
;
4888 if (coding
->produced
> 0)
4890 coding
->produced
-= write (desc
, buf
, coding
->produced
);
4891 if (coding
->produced
) return -1;
4893 if (result
== CODING_FINISH_INSUFFICIENT_SRC
)
4895 /* The source text ends by an incomplete multibyte form.
4896 There's no way other than write it out as is. */
4897 nbytes
-= write (desc
, addr
, nbytes
);
4898 if (nbytes
) return -1;
4906 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4907 Sverify_visited_file_modtime
, 1, 1, 0,
4908 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4909 This means that the file has not been changed since it was visited or saved.")
4915 Lisp_Object handler
;
4916 Lisp_Object filename
;
4918 CHECK_BUFFER (buf
, 0);
4921 if (!STRINGP (b
->filename
)) return Qt
;
4922 if (b
->modtime
== 0) return Qt
;
4924 /* If the file name has special constructs in it,
4925 call the corresponding file handler. */
4926 handler
= Ffind_file_name_handler (b
->filename
,
4927 Qverify_visited_file_modtime
);
4928 if (!NILP (handler
))
4929 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4931 filename
= ENCODE_FILE (b
->filename
);
4933 if (stat (XSTRING (filename
)->data
, &st
) < 0)
4935 /* If the file doesn't exist now and didn't exist before,
4936 we say that it isn't modified, provided the error is a tame one. */
4937 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4942 if (st
.st_mtime
== b
->modtime
4943 /* If both are positive, accept them if they are off by one second. */
4944 || (st
.st_mtime
> 0 && b
->modtime
> 0
4945 && (st
.st_mtime
== b
->modtime
+ 1
4946 || st
.st_mtime
== b
->modtime
- 1)))
4951 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4952 Sclear_visited_file_modtime
, 0, 0, 0,
4953 "Clear out records of last mod time of visited file.\n\
4954 Next attempt to save will certainly not complain of a discrepancy.")
4957 current_buffer
->modtime
= 0;
4961 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4962 Svisited_file_modtime
, 0, 0, 0,
4963 "Return the current buffer's recorded visited file modification time.\n\
4964 The value is a list of the form (HIGH . LOW), like the time values\n\
4965 that `file-attributes' returns.")
4968 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4971 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4972 Sset_visited_file_modtime
, 0, 1, 0,
4973 "Update buffer's recorded modification time from the visited file's time.\n\
4974 Useful if the buffer was not read from the file normally\n\
4975 or if the file itself has been changed for some known benign reason.\n\
4976 An argument specifies the modification time value to use\n\
4977 \(instead of that of the visited file), in the form of a list\n\
4978 \(HIGH . LOW) or (HIGH LOW).")
4980 Lisp_Object time_list
;
4982 if (!NILP (time_list
))
4983 current_buffer
->modtime
= cons_to_long (time_list
);
4986 register Lisp_Object filename
;
4988 Lisp_Object handler
;
4990 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4992 /* If the file name has special constructs in it,
4993 call the corresponding file handler. */
4994 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4995 if (!NILP (handler
))
4996 /* The handler can find the file name the same way we did. */
4997 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4999 filename
= ENCODE_FILE (filename
);
5001 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
5002 current_buffer
->modtime
= st
.st_mtime
;
5012 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 1);
5013 Fsleep_for (make_number (1), Qnil
);
5014 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
5015 Fsleep_for (make_number (1), Qnil
);
5016 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
5017 Fsleep_for (make_number (1), Qnil
);
5027 /* Get visited file's mode to become the auto save file's mode. */
5028 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
5029 /* But make sure we can overwrite it later! */
5030 auto_save_mode_bits
= st
.st_mode
| 0600;
5032 auto_save_mode_bits
= 0666;
5035 Fwrite_region (Qnil
, Qnil
,
5036 current_buffer
->auto_save_file_name
,
5037 Qnil
, Qlambda
, Qnil
, Qnil
);
5041 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5046 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
5047 | XFASTINT (XCONS (stream
)->cdr
)));
5052 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5055 minibuffer_auto_raise
= XINT (value
);
5059 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5060 "Auto-save all buffers that need it.\n\
5061 This is all buffers that have auto-saving enabled\n\
5062 and are changed since last auto-saved.\n\
5063 Auto-saving writes the buffer into a file\n\
5064 so that your editing is not lost if the system crashes.\n\
5065 This file is not the file you visited; that changes only when you save.\n\
5066 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
5067 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
5068 A non-nil CURRENT-ONLY argument means save only current buffer.")
5069 (no_message
, current_only
)
5070 Lisp_Object no_message
, current_only
;
5072 struct buffer
*old
= current_buffer
, *b
;
5073 Lisp_Object tail
, buf
;
5075 char *omessage
= echo_area_glyphs
;
5076 int omessage_length
= echo_area_glyphs_length
;
5077 int oldmultibyte
= message_enable_multibyte
;
5078 int do_handled_files
;
5081 Lisp_Object lispstream
;
5082 int count
= specpdl_ptr
- specpdl
;
5084 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5086 /* Ordinarily don't quit within this function,
5087 but don't make it impossible to quit (in case we get hung in I/O). */
5091 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5092 point to non-strings reached from Vbuffer_alist. */
5097 if (!NILP (Vrun_hooks
))
5098 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5100 if (STRINGP (Vauto_save_list_file_name
))
5102 Lisp_Object listfile
;
5103 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5104 stream
= fopen (XSTRING (listfile
)->data
, "w");
5107 /* Arrange to close that file whether or not we get an error.
5108 Also reset auto_saving to 0. */
5109 lispstream
= Fcons (Qnil
, Qnil
);
5110 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
5111 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
5122 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5123 record_unwind_protect (do_auto_save_unwind_1
,
5124 make_number (minibuffer_auto_raise
));
5125 minibuffer_auto_raise
= 0;
5128 /* First, save all files which don't have handlers. If Emacs is
5129 crashing, the handlers may tweak what is causing Emacs to crash
5130 in the first place, and it would be a shame if Emacs failed to
5131 autosave perfectly ordinary files because it couldn't handle some
5133 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5134 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
5136 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
5139 /* Record all the buffers that have auto save mode
5140 in the special file that lists them. For each of these buffers,
5141 Record visited name (if any) and auto save name. */
5142 if (STRINGP (b
->auto_save_file_name
)
5143 && stream
!= NULL
&& do_handled_files
== 0)
5145 if (!NILP (b
->filename
))
5147 fwrite (XSTRING (b
->filename
)->data
, 1,
5148 STRING_BYTES (XSTRING (b
->filename
)), stream
);
5150 putc ('\n', stream
);
5151 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
5152 STRING_BYTES (XSTRING (b
->auto_save_file_name
)), stream
);
5153 putc ('\n', stream
);
5156 if (!NILP (current_only
)
5157 && b
!= current_buffer
)
5160 /* Don't auto-save indirect buffers.
5161 The base buffer takes care of it. */
5165 /* Check for auto save enabled
5166 and file changed since last auto save
5167 and file changed since last real save. */
5168 if (STRINGP (b
->auto_save_file_name
)
5169 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5170 && b
->auto_save_modified
< BUF_MODIFF (b
)
5171 /* -1 means we've turned off autosaving for a while--see below. */
5172 && XINT (b
->save_length
) >= 0
5173 && (do_handled_files
5174 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5177 EMACS_TIME before_time
, after_time
;
5179 EMACS_GET_TIME (before_time
);
5181 /* If we had a failure, don't try again for 20 minutes. */
5182 if (b
->auto_save_failure_time
>= 0
5183 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5186 if ((XFASTINT (b
->save_length
) * 10
5187 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5188 /* A short file is likely to change a large fraction;
5189 spare the user annoying messages. */
5190 && XFASTINT (b
->save_length
) > 5000
5191 /* These messages are frequent and annoying for `*mail*'. */
5192 && !EQ (b
->filename
, Qnil
)
5193 && NILP (no_message
))
5195 /* It has shrunk too much; turn off auto-saving here. */
5196 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5197 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
5199 minibuffer_auto_raise
= 0;
5200 /* Turn off auto-saving until there's a real save,
5201 and prevent any more warnings. */
5202 XSETINT (b
->save_length
, -1);
5203 Fsleep_for (make_number (1), Qnil
);
5206 set_buffer_internal (b
);
5207 if (!auto_saved
&& NILP (no_message
))
5208 message1 ("Auto-saving...");
5209 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5211 b
->auto_save_modified
= BUF_MODIFF (b
);
5212 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5213 set_buffer_internal (old
);
5215 EMACS_GET_TIME (after_time
);
5217 /* If auto-save took more than 60 seconds,
5218 assume it was an NFS failure that got a timeout. */
5219 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5220 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5224 /* Prevent another auto save till enough input events come in. */
5225 record_auto_save ();
5227 if (auto_saved
&& NILP (no_message
))
5231 sit_for (1, 0, 0, 0, 0);
5232 message2 (omessage
, omessage_length
, oldmultibyte
);
5235 message1 ("Auto-saving...done");
5240 unbind_to (count
, Qnil
);
5244 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5245 Sset_buffer_auto_saved
, 0, 0, 0,
5246 "Mark current buffer as auto-saved with its current text.\n\
5247 No auto-save file will be written until the buffer changes again.")
5250 current_buffer
->auto_save_modified
= MODIFF
;
5251 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5252 current_buffer
->auto_save_failure_time
= -1;
5256 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5257 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5258 "Clear any record of a recent auto-save failure in the current buffer.")
5261 current_buffer
->auto_save_failure_time
= -1;
5265 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5267 "Return t if buffer has been auto-saved since last read in or saved.")
5270 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5273 /* Reading and completing file names */
5274 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5276 /* In the string VAL, change each $ to $$ and return the result. */
5279 double_dollars (val
)
5282 register unsigned char *old
, *new;
5286 osize
= STRING_BYTES (XSTRING (val
));
5288 /* Count the number of $ characters. */
5289 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
5290 if (*old
++ == '$') count
++;
5293 old
= XSTRING (val
)->data
;
5294 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
5296 new = XSTRING (val
)->data
;
5297 for (n
= osize
; n
> 0; n
--)
5310 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5312 "Internal subroutine for read-file-name. Do not call this.")
5313 (string
, dir
, action
)
5314 Lisp_Object string
, dir
, action
;
5315 /* action is nil for complete, t for return list of completions,
5316 lambda for verify final value */
5318 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5320 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5322 CHECK_STRING (string
, 0);
5329 /* No need to protect ACTION--we only compare it with t and nil. */
5330 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5332 if (XSTRING (string
)->size
== 0)
5334 if (EQ (action
, Qlambda
))
5342 orig_string
= string
;
5343 string
= Fsubstitute_in_file_name (string
);
5344 changed
= NILP (Fstring_equal (string
, orig_string
));
5345 name
= Ffile_name_nondirectory (string
);
5346 val
= Ffile_name_directory (string
);
5348 realdir
= Fexpand_file_name (val
, realdir
);
5353 specdir
= Ffile_name_directory (string
);
5354 val
= Ffile_name_completion (name
, realdir
);
5359 return double_dollars (string
);
5363 if (!NILP (specdir
))
5364 val
= concat2 (specdir
, val
);
5366 return double_dollars (val
);
5369 #endif /* not VMS */
5373 if (EQ (action
, Qt
))
5374 return Ffile_name_all_completions (name
, realdir
);
5375 /* Only other case actually used is ACTION = lambda */
5377 /* Supposedly this helps commands such as `cd' that read directory names,
5378 but can someone explain how it helps them? -- RMS */
5379 if (XSTRING (name
)->size
== 0)
5382 return Ffile_exists_p (string
);
5385 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5386 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5387 Value is not expanded---you must call `expand-file-name' yourself.\n\
5388 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5389 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5390 except that if INITIAL is specified, that combined with DIR is used.)\n\
5391 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5392 Non-nil and non-t means also require confirmation after completion.\n\
5393 Fifth arg INITIAL specifies text to start with.\n\
5394 DIR defaults to current buffer's directory default.")
5395 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5396 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5398 Lisp_Object val
, insdef
, insdef1
, tem
;
5399 struct gcpro gcpro1
, gcpro2
;
5400 register char *homedir
;
5401 int replace_in_history
= 0;
5402 int add_to_history
= 0;
5406 dir
= current_buffer
->directory
;
5407 if (NILP (default_filename
))
5409 if (! NILP (initial
))
5410 default_filename
= Fexpand_file_name (initial
, dir
);
5412 default_filename
= current_buffer
->filename
;
5415 /* If dir starts with user's homedir, change that to ~. */
5416 homedir
= (char *) egetenv ("HOME");
5418 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5419 CORRECT_DIR_SEPS (homedir
);
5423 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5424 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5426 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5427 STRING_BYTES (XSTRING (dir
)) - strlen (homedir
) + 1);
5428 XSTRING (dir
)->data
[0] = '~';
5431 if (insert_default_directory
&& STRINGP (dir
))
5434 if (!NILP (initial
))
5436 Lisp_Object args
[2], pos
;
5440 insdef
= Fconcat (2, args
);
5441 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5442 insdef1
= Fcons (double_dollars (insdef
), pos
);
5445 insdef1
= double_dollars (insdef
);
5447 else if (STRINGP (initial
))
5450 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
5453 insdef
= Qnil
, insdef1
= Qnil
;
5455 count
= specpdl_ptr
- specpdl
;
5457 specbind (intern ("completion-ignore-case"), Qt
);
5460 specbind (intern ("minibuffer-completing-file-name"), Qt
);
5462 GCPRO2 (insdef
, default_filename
);
5463 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5464 dir
, mustmatch
, insdef1
,
5465 Qfile_name_history
, default_filename
, Qnil
);
5467 tem
= Fsymbol_value (Qfile_name_history
);
5468 if (CONSP (tem
) && EQ (XCONS (tem
)->car
, val
))
5469 replace_in_history
= 1;
5471 /* If Fcompleting_read returned the inserted default string itself
5472 (rather than a new string with the same contents),
5473 it has to mean that the user typed RET with the minibuffer empty.
5474 In that case, we really want to return ""
5475 so that commands such as set-visited-file-name can distinguish. */
5476 if (EQ (val
, default_filename
))
5478 /* In this case, Fcompleting_read has not added an element
5479 to the history. Maybe we should. */
5480 if (! replace_in_history
)
5483 val
= build_string ("");
5486 unbind_to (count
, Qnil
);
5489 error ("No file name specified");
5491 tem
= Fstring_equal (val
, insdef
);
5493 if (!NILP (tem
) && !NILP (default_filename
))
5494 val
= default_filename
;
5495 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5497 if (!NILP (default_filename
))
5498 val
= default_filename
;
5500 error ("No default file name");
5502 val
= Fsubstitute_in_file_name (val
);
5504 if (replace_in_history
)
5505 /* Replace what Fcompleting_read added to the history
5506 with what we will actually return. */
5507 XCONS (Fsymbol_value (Qfile_name_history
))->car
= val
;
5508 else if (add_to_history
)
5510 /* Add the value to the history--but not if it matches
5511 the last value already there. */
5512 tem
= Fsymbol_value (Qfile_name_history
);
5513 if (! CONSP (tem
) || NILP (Fequal (XCONS (tem
)->car
, val
)))
5514 Fset (Qfile_name_history
,
5523 /* Must be set before any path manipulation is performed. */
5524 XSETFASTINT (Vdirectory_sep_char
, '/');
5530 Qexpand_file_name
= intern ("expand-file-name");
5531 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5532 Qdirectory_file_name
= intern ("directory-file-name");
5533 Qfile_name_directory
= intern ("file-name-directory");
5534 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5535 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5536 Qfile_name_as_directory
= intern ("file-name-as-directory");
5537 Qcopy_file
= intern ("copy-file");
5538 Qmake_directory_internal
= intern ("make-directory-internal");
5539 Qdelete_directory
= intern ("delete-directory");
5540 Qdelete_file
= intern ("delete-file");
5541 Qrename_file
= intern ("rename-file");
5542 Qadd_name_to_file
= intern ("add-name-to-file");
5543 Qmake_symbolic_link
= intern ("make-symbolic-link");
5544 Qfile_exists_p
= intern ("file-exists-p");
5545 Qfile_executable_p
= intern ("file-executable-p");
5546 Qfile_readable_p
= intern ("file-readable-p");
5547 Qfile_writable_p
= intern ("file-writable-p");
5548 Qfile_symlink_p
= intern ("file-symlink-p");
5549 Qaccess_file
= intern ("access-file");
5550 Qfile_directory_p
= intern ("file-directory-p");
5551 Qfile_regular_p
= intern ("file-regular-p");
5552 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5553 Qfile_modes
= intern ("file-modes");
5554 Qset_file_modes
= intern ("set-file-modes");
5555 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5556 Qinsert_file_contents
= intern ("insert-file-contents");
5557 Qwrite_region
= intern ("write-region");
5558 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5559 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5561 staticpro (&Qexpand_file_name
);
5562 staticpro (&Qsubstitute_in_file_name
);
5563 staticpro (&Qdirectory_file_name
);
5564 staticpro (&Qfile_name_directory
);
5565 staticpro (&Qfile_name_nondirectory
);
5566 staticpro (&Qunhandled_file_name_directory
);
5567 staticpro (&Qfile_name_as_directory
);
5568 staticpro (&Qcopy_file
);
5569 staticpro (&Qmake_directory_internal
);
5570 staticpro (&Qdelete_directory
);
5571 staticpro (&Qdelete_file
);
5572 staticpro (&Qrename_file
);
5573 staticpro (&Qadd_name_to_file
);
5574 staticpro (&Qmake_symbolic_link
);
5575 staticpro (&Qfile_exists_p
);
5576 staticpro (&Qfile_executable_p
);
5577 staticpro (&Qfile_readable_p
);
5578 staticpro (&Qfile_writable_p
);
5579 staticpro (&Qaccess_file
);
5580 staticpro (&Qfile_symlink_p
);
5581 staticpro (&Qfile_directory_p
);
5582 staticpro (&Qfile_regular_p
);
5583 staticpro (&Qfile_accessible_directory_p
);
5584 staticpro (&Qfile_modes
);
5585 staticpro (&Qset_file_modes
);
5586 staticpro (&Qfile_newer_than_file_p
);
5587 staticpro (&Qinsert_file_contents
);
5588 staticpro (&Qwrite_region
);
5589 staticpro (&Qverify_visited_file_modtime
);
5590 staticpro (&Qset_visited_file_modtime
);
5592 Qfile_name_history
= intern ("file-name-history");
5593 Fset (Qfile_name_history
, Qnil
);
5594 staticpro (&Qfile_name_history
);
5596 Qfile_error
= intern ("file-error");
5597 staticpro (&Qfile_error
);
5598 Qfile_already_exists
= intern ("file-already-exists");
5599 staticpro (&Qfile_already_exists
);
5600 Qfile_date_error
= intern ("file-date-error");
5601 staticpro (&Qfile_date_error
);
5604 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5605 staticpro (&Qfind_buffer_file_type
);
5608 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5609 "*Coding system for encoding file names.\n\
5610 If it is nil, default-file-name-coding-system (which see) is used.");
5611 Vfile_name_coding_system
= Qnil
;
5613 DEFVAR_LISP ("default-file-name-coding-system",
5614 &Vdefault_file_name_coding_system
,
5615 "Default coding system for encoding file names.\n\
5616 This variable is used only when file-name-coding-system is nil.\n\
5618 This variable is set/changed by the command set-language-environment.\n\
5619 User should not set this variable manually,\n\
5620 instead use file-name-coding-system to get a constant encoding\n\
5621 of file names regardless of the current language environment.");
5622 Vdefault_file_name_coding_system
= Qnil
;
5624 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5625 "*Format in which to write auto-save files.\n\
5626 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5627 If it is t, which is the default, auto-save files are written in the\n\
5628 same format as a regular save would use.");
5629 Vauto_save_file_format
= Qt
;
5631 Qformat_decode
= intern ("format-decode");
5632 staticpro (&Qformat_decode
);
5633 Qformat_annotate_function
= intern ("format-annotate-function");
5634 staticpro (&Qformat_annotate_function
);
5636 Qcar_less_than_car
= intern ("car-less-than-car");
5637 staticpro (&Qcar_less_than_car
);
5639 Fput (Qfile_error
, Qerror_conditions
,
5640 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5641 Fput (Qfile_error
, Qerror_message
,
5642 build_string ("File error"));
5644 Fput (Qfile_already_exists
, Qerror_conditions
,
5645 Fcons (Qfile_already_exists
,
5646 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5647 Fput (Qfile_already_exists
, Qerror_message
,
5648 build_string ("File already exists"));
5650 Fput (Qfile_date_error
, Qerror_conditions
,
5651 Fcons (Qfile_date_error
,
5652 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5653 Fput (Qfile_date_error
, Qerror_message
,
5654 build_string ("Cannot set file date"));
5656 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5657 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5658 insert_default_directory
= 1;
5660 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5661 "*Non-nil means write new files with record format `stmlf'.\n\
5662 nil means use format `var'. This variable is meaningful only on VMS.");
5663 vms_stmlf_recfm
= 0;
5665 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5666 "Directory separator character for built-in functions that return file names.\n\
5667 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5668 This variable affects the built-in functions only on Windows,\n\
5669 on other platforms, it is initialized so that Lisp code can find out\n\
5670 what the normal separator is.");
5672 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5673 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5674 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5677 The first argument given to HANDLER is the name of the I/O primitive\n\
5678 to be handled; the remaining arguments are the arguments that were\n\
5679 passed to that primitive. For example, if you do\n\
5680 (file-exists-p FILENAME)\n\
5681 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5682 (funcall HANDLER 'file-exists-p FILENAME)\n\
5683 The function `find-file-name-handler' checks this list for a handler\n\
5684 for its argument.");
5685 Vfile_name_handler_alist
= Qnil
;
5687 DEFVAR_LISP ("set-auto-coding-function",
5688 &Vset_auto_coding_function
,
5689 "If non-nil, a function to call to decide a coding system of file.\n\
5690 Two arguments are passed to this function: the file name\n\
5691 and the length of a file contents following the point.\n\
5692 This function should return a coding system to decode the file contents.\n\
5693 It should check the file name against `auto-coding-alist'.\n\
5694 If no coding system is decided, it should check a coding system\n\
5695 specified in the heading lines with the format:\n\
5696 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5697 or local variable spec of the tailing lines with `coding:' tag.");
5698 Vset_auto_coding_function
= Qnil
;
5700 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5701 "A list of functions to be called at the end of `insert-file-contents'.\n\
5702 Each is passed one argument, the number of bytes inserted. It should return\n\
5703 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5704 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5705 responsible for calling the after-insert-file-functions if appropriate.");
5706 Vafter_insert_file_functions
= Qnil
;
5708 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5709 "A list of functions to be called at the start of `write-region'.\n\
5710 Each is passed two arguments, START and END as for `write-region'.\n\
5711 These are usually two numbers but not always; see the documentation\n\
5712 for `write-region'. The function should return a list of pairs\n\
5713 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5714 inserted at the specified positions of the file being written (1 means to\n\
5715 insert before the first byte written). The POSITIONs must be sorted into\n\
5716 increasing order. If there are several functions in the list, the several\n\
5717 lists are merged destructively.");
5718 Vwrite_region_annotate_functions
= Qnil
;
5720 DEFVAR_LISP ("write-region-annotations-so-far",
5721 &Vwrite_region_annotations_so_far
,
5722 "When an annotation function is called, this holds the previous annotations.\n\
5723 These are the annotations made by other annotation functions\n\
5724 that were already called. See also `write-region-annotate-functions'.");
5725 Vwrite_region_annotations_so_far
= Qnil
;
5727 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5728 "A list of file name handlers that temporarily should not be used.\n\
5729 This applies only to the operation `inhibit-file-name-operation'.");
5730 Vinhibit_file_name_handlers
= Qnil
;
5732 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5733 "The operation for which `inhibit-file-name-handlers' is applicable.");
5734 Vinhibit_file_name_operation
= Qnil
;
5736 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5737 "File name in which we write a list of all auto save file names.\n\
5738 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5739 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5741 Vauto_save_list_file_name
= Qnil
;
5743 defsubr (&Sfind_file_name_handler
);
5744 defsubr (&Sfile_name_directory
);
5745 defsubr (&Sfile_name_nondirectory
);
5746 defsubr (&Sunhandled_file_name_directory
);
5747 defsubr (&Sfile_name_as_directory
);
5748 defsubr (&Sdirectory_file_name
);
5749 defsubr (&Smake_temp_name
);
5750 defsubr (&Sexpand_file_name
);
5751 defsubr (&Ssubstitute_in_file_name
);
5752 defsubr (&Scopy_file
);
5753 defsubr (&Smake_directory_internal
);
5754 defsubr (&Sdelete_directory
);
5755 defsubr (&Sdelete_file
);
5756 defsubr (&Srename_file
);
5757 defsubr (&Sadd_name_to_file
);
5759 defsubr (&Smake_symbolic_link
);
5760 #endif /* S_IFLNK */
5762 defsubr (&Sdefine_logical_name
);
5765 defsubr (&Ssysnetunam
);
5766 #endif /* HPUX_NET */
5767 defsubr (&Sfile_name_absolute_p
);
5768 defsubr (&Sfile_exists_p
);
5769 defsubr (&Sfile_executable_p
);
5770 defsubr (&Sfile_readable_p
);
5771 defsubr (&Sfile_writable_p
);
5772 defsubr (&Saccess_file
);
5773 defsubr (&Sfile_symlink_p
);
5774 defsubr (&Sfile_directory_p
);
5775 defsubr (&Sfile_accessible_directory_p
);
5776 defsubr (&Sfile_regular_p
);
5777 defsubr (&Sfile_modes
);
5778 defsubr (&Sset_file_modes
);
5779 defsubr (&Sset_default_file_modes
);
5780 defsubr (&Sdefault_file_modes
);
5781 defsubr (&Sfile_newer_than_file_p
);
5782 defsubr (&Sinsert_file_contents
);
5783 defsubr (&Swrite_region
);
5784 defsubr (&Scar_less_than_car
);
5785 defsubr (&Sverify_visited_file_modtime
);
5786 defsubr (&Sclear_visited_file_modtime
);
5787 defsubr (&Svisited_file_modtime
);
5788 defsubr (&Sset_visited_file_modtime
);
5789 defsubr (&Sdo_auto_save
);
5790 defsubr (&Sset_buffer_auto_saved
);
5791 defsubr (&Sclear_buffer_auto_save_failure
);
5792 defsubr (&Srecent_auto_save_p
);
5794 defsubr (&Sread_file_name_internal
);
5795 defsubr (&Sread_file_name
);
5798 defsubr (&Sunix_sync
);