1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,97,1998 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
23 #if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX)
28 #include <sys/types.h>
35 #if !defined (S_ISLNK) && defined (S_IFLNK)
36 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
39 #if !defined (S_ISFIFO) && defined (S_IFIFO)
40 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
43 #if !defined (S_ISREG) && defined (S_IFREG)
44 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
68 extern char *strerror ();
85 #include "intervals.h"
96 #endif /* not WINDOWSNT */
100 #include <sys/param.h>
108 #define CORRECT_DIR_SEPS(s) \
109 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
110 else unixtodos_filename (s); \
112 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
113 redirector allows the six letters between 'Z' and 'a' as well. */
115 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
118 #define IS_DRIVE(x) isalpha (x)
120 /* Need to lower-case the drive letter, or else expanded
121 filenames will sometimes compare inequal, because
122 `expand-file-name' doesn't always down-case the drive letter. */
123 #define DRIVE_LETTER(x) (tolower (x))
152 #define min(a, b) ((a) < (b) ? (a) : (b))
153 #define max(a, b) ((a) > (b) ? (a) : (b))
155 /* Nonzero during writing of auto-save files */
158 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
159 a new file with the same mode as the original */
160 int auto_save_mode_bits
;
162 /* Coding system for file names, or nil if none. */
163 Lisp_Object Vfile_name_coding_system
;
165 /* Coding system for file names used only when
166 Vfile_name_coding_system is nil. */
167 Lisp_Object Vdefault_file_name_coding_system
;
169 /* Alist of elements (REGEXP . HANDLER) for file names
170 whose I/O is done with a special handler. */
171 Lisp_Object Vfile_name_handler_alist
;
173 /* Format for auto-save files */
174 Lisp_Object Vauto_save_file_format
;
176 /* Lisp functions for translating file formats */
177 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
179 /* Function to be called to decide a coding system of a reading file. */
180 Lisp_Object Vset_auto_coding_function
;
182 /* Functions to be called to process text properties in inserted file. */
183 Lisp_Object Vafter_insert_file_functions
;
185 /* Functions to be called to create text property annotations for file. */
186 Lisp_Object Vwrite_region_annotate_functions
;
188 /* During build_annotations, each time an annotation function is called,
189 this holds the annotations made by the previous functions. */
190 Lisp_Object Vwrite_region_annotations_so_far
;
192 /* File name in which we write a list of all our auto save files. */
193 Lisp_Object Vauto_save_list_file_name
;
195 /* Nonzero means, when reading a filename in the minibuffer,
196 start out by inserting the default directory into the minibuffer. */
197 int insert_default_directory
;
199 /* On VMS, nonzero means write new files with record format stmlf.
200 Zero means use var format. */
203 /* On NT, specifies the directory separator character, used (eg.) when
204 expanding file names. This can be bound to / or \. */
205 Lisp_Object Vdirectory_sep_char
;
207 extern Lisp_Object Vuser_login_name
;
209 extern int minibuf_level
;
211 extern int minibuffer_auto_raise
;
213 /* These variables describe handlers that have "already" had a chance
214 to handle the current operation.
216 Vinhibit_file_name_handlers is a list of file name handlers.
217 Vinhibit_file_name_operation is the operation being handled.
218 If we try to handle that operation, we ignore those handlers. */
220 static Lisp_Object Vinhibit_file_name_handlers
;
221 static Lisp_Object Vinhibit_file_name_operation
;
223 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
225 Lisp_Object Qfile_name_history
;
227 Lisp_Object Qcar_less_than_car
;
229 static int a_write
P_ ((int, char *, int, int,
230 Lisp_Object
*, struct coding_system
*));
231 static int e_write
P_ ((int, char *, int, struct coding_system
*));
234 report_file_error (string
, data
)
238 Lisp_Object errstring
;
240 errstring
= build_string (strerror (errno
));
242 /* System error messages are capitalized. Downcase the initial
243 unless it is followed by a slash. */
244 if (XSTRING (errstring
)->data
[1] != '/')
245 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
248 Fsignal (Qfile_error
,
249 Fcons (build_string (string
), Fcons (errstring
, data
)));
253 close_file_unwind (fd
)
256 close (XFASTINT (fd
));
260 /* Restore point, having saved it as a marker. */
263 restore_point_unwind (location
)
264 Lisp_Object location
;
266 Fgoto_char (location
);
267 Fset_marker (location
, Qnil
, Qnil
);
271 Lisp_Object Qexpand_file_name
;
272 Lisp_Object Qsubstitute_in_file_name
;
273 Lisp_Object Qdirectory_file_name
;
274 Lisp_Object Qfile_name_directory
;
275 Lisp_Object Qfile_name_nondirectory
;
276 Lisp_Object Qunhandled_file_name_directory
;
277 Lisp_Object Qfile_name_as_directory
;
278 Lisp_Object Qcopy_file
;
279 Lisp_Object Qmake_directory_internal
;
280 Lisp_Object Qdelete_directory
;
281 Lisp_Object Qdelete_file
;
282 Lisp_Object Qrename_file
;
283 Lisp_Object Qadd_name_to_file
;
284 Lisp_Object Qmake_symbolic_link
;
285 Lisp_Object Qfile_exists_p
;
286 Lisp_Object Qfile_executable_p
;
287 Lisp_Object Qfile_readable_p
;
288 Lisp_Object Qfile_writable_p
;
289 Lisp_Object Qfile_symlink_p
;
290 Lisp_Object Qaccess_file
;
291 Lisp_Object Qfile_directory_p
;
292 Lisp_Object Qfile_regular_p
;
293 Lisp_Object Qfile_accessible_directory_p
;
294 Lisp_Object Qfile_modes
;
295 Lisp_Object Qset_file_modes
;
296 Lisp_Object Qfile_newer_than_file_p
;
297 Lisp_Object Qinsert_file_contents
;
298 Lisp_Object Qwrite_region
;
299 Lisp_Object Qverify_visited_file_modtime
;
300 Lisp_Object Qset_visited_file_modtime
;
302 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
303 "Return FILENAME's handler function for OPERATION, if it has one.\n\
304 Otherwise, return nil.\n\
305 A file name is handled if one of the regular expressions in\n\
306 `file-name-handler-alist' matches it.\n\n\
307 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
308 any handlers that are members of `inhibit-file-name-handlers',\n\
309 but we still do run any other handlers. This lets handlers\n\
310 use the standard functions without calling themselves recursively.")
311 (filename
, operation
)
312 Lisp_Object filename
, operation
;
314 /* This function must not munge the match data. */
315 Lisp_Object chain
, inhibited_handlers
;
317 CHECK_STRING (filename
, 0);
319 if (EQ (operation
, Vinhibit_file_name_operation
))
320 inhibited_handlers
= Vinhibit_file_name_handlers
;
322 inhibited_handlers
= Qnil
;
324 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
325 chain
= XCONS (chain
)->cdr
)
328 elt
= XCONS (chain
)->car
;
332 string
= XCONS (elt
)->car
;
333 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
335 Lisp_Object handler
, tem
;
337 handler
= XCONS (elt
)->cdr
;
338 tem
= Fmemq (handler
, inhibited_handlers
);
349 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
351 "Return the directory component in file name FILENAME.\n\
352 Return nil if FILENAME does not include a directory.\n\
353 Otherwise return a directory spec.\n\
354 Given a Unix syntax file name, returns a string ending in slash;\n\
355 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
357 Lisp_Object filename
;
359 register unsigned char *beg
;
360 register unsigned char *p
;
363 CHECK_STRING (filename
, 0);
365 /* If the file name has special constructs in it,
366 call the corresponding file handler. */
367 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
369 return call2 (handler
, Qfile_name_directory
, filename
);
371 #ifdef FILE_SYSTEM_CASE
372 filename
= FILE_SYSTEM_CASE (filename
);
374 beg
= XSTRING (filename
)->data
;
376 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
378 p
= beg
+ STRING_BYTES (XSTRING (filename
));
380 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
382 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
385 /* only recognise drive specifier at the beginning */
387 /* handle the "/:d:foo" and "/:foo" cases correctly */
388 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
389 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
396 /* Expansion of "c:" to drive and default directory. */
399 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
400 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
401 unsigned char *r
= res
;
403 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
405 strncpy (res
, beg
, 2);
410 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
412 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
415 p
= beg
+ strlen (beg
);
418 CORRECT_DIR_SEPS (beg
);
421 if (STRING_MULTIBYTE (filename
))
422 return make_string (beg
, p
- beg
);
423 return make_unibyte_string (beg
, p
- beg
);
426 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
427 Sfile_name_nondirectory
, 1, 1, 0,
428 "Return file name FILENAME sans its directory.\n\
429 For example, in a Unix-syntax file name,\n\
430 this is everything after the last slash,\n\
431 or the entire name if it contains no slash.")
433 Lisp_Object filename
;
435 register unsigned char *beg
, *p
, *end
;
438 CHECK_STRING (filename
, 0);
440 /* If the file name has special constructs in it,
441 call the corresponding file handler. */
442 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
444 return call2 (handler
, Qfile_name_nondirectory
, filename
);
446 beg
= XSTRING (filename
)->data
;
447 end
= p
= beg
+ STRING_BYTES (XSTRING (filename
));
449 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
451 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
454 /* only recognise drive specifier at beginning */
456 /* handle the "/:d:foo" case correctly */
457 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
462 if (STRING_MULTIBYTE (filename
))
463 return make_string (p
, end
- p
);
464 return make_unibyte_string (p
, end
- p
);
467 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
468 Sunhandled_file_name_directory
, 1, 1, 0,
469 "Return a directly usable directory name somehow associated with FILENAME.\n\
470 A `directly usable' directory name is one that may be used without the\n\
471 intervention of any file handler.\n\
472 If FILENAME is a directly usable file itself, return\n\
473 \(file-name-directory FILENAME).\n\
474 The `call-process' and `start-process' functions use this function to\n\
475 get a current directory to run processes in.")
477 Lisp_Object filename
;
481 /* If the file name has special constructs in it,
482 call the corresponding file handler. */
483 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
485 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
487 return Ffile_name_directory (filename
);
492 file_name_as_directory (out
, in
)
495 int size
= strlen (in
) - 1;
508 /* Is it already a directory string? */
509 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
511 /* Is it a VMS directory file name? If so, hack VMS syntax. */
512 else if (! index (in
, '/')
513 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
514 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
515 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
516 || ! strncmp (&in
[size
- 5], ".dir", 4))
517 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
518 && in
[size
] == '1')))
520 register char *p
, *dot
;
524 dir:x.dir --> dir:[x]
525 dir:[x]y.dir --> dir:[x.y] */
527 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
530 strncpy (out
, in
, p
- in
);
549 dot
= index (p
, '.');
552 /* blindly remove any extension */
553 size
= strlen (out
) + (dot
- p
);
554 strncat (out
, p
, dot
- p
);
565 /* For Unix syntax, Append a slash if necessary */
566 if (!IS_DIRECTORY_SEP (out
[size
]))
568 out
[size
+ 1] = DIRECTORY_SEP
;
569 out
[size
+ 2] = '\0';
572 CORRECT_DIR_SEPS (out
);
578 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
579 Sfile_name_as_directory
, 1, 1, 0,
580 "Return a string representing file FILENAME interpreted as a directory.\n\
581 This operation exists because a directory is also a file, but its name as\n\
582 a directory is different from its name as a file.\n\
583 The result can be used as the value of `default-directory'\n\
584 or passed as second argument to `expand-file-name'.\n\
585 For a Unix-syntax file name, just appends a slash.\n\
586 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
593 CHECK_STRING (file
, 0);
597 /* If the file name has special constructs in it,
598 call the corresponding file handler. */
599 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
601 return call2 (handler
, Qfile_name_as_directory
, file
);
603 buf
= (char *) alloca (STRING_BYTES (XSTRING (file
)) + 10);
604 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
608 * Convert from directory name to filename.
610 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
611 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
612 * On UNIX, it's simple: just make sure there isn't a terminating /
614 * Value is nonzero if the string output is different from the input.
618 directory_file_name (src
, dst
)
626 struct FAB fab
= cc$rms_fab
;
627 struct NAM nam
= cc$rms_nam
;
628 char esa
[NAM$C_MAXRSS
];
633 if (! index (src
, '/')
634 && (src
[slen
- 1] == ']'
635 || src
[slen
- 1] == ':'
636 || src
[slen
- 1] == '>'))
638 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
640 fab
.fab$b_fns
= slen
;
641 fab
.fab$l_nam
= &nam
;
642 fab
.fab$l_fop
= FAB$M_NAM
;
645 nam
.nam$b_ess
= sizeof esa
;
646 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
648 /* We call SYS$PARSE to handle such things as [--] for us. */
649 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
651 slen
= nam
.nam$b_esl
;
652 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
657 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
659 /* what about when we have logical_name:???? */
660 if (src
[slen
- 1] == ':')
661 { /* Xlate logical name and see what we get */
662 ptr
= strcpy (dst
, src
); /* upper case for getenv */
665 if ('a' <= *ptr
&& *ptr
<= 'z')
669 dst
[slen
- 1] = 0; /* remove colon */
670 if (!(src
= egetenv (dst
)))
672 /* should we jump to the beginning of this procedure?
673 Good points: allows us to use logical names that xlate
675 Bad points: can be a problem if we just translated to a device
677 For now, I'll punt and always expect VMS names, and hope for
680 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
681 { /* no recursion here! */
687 { /* not a directory spec */
692 bracket
= src
[slen
- 1];
694 /* If bracket is ']' or '>', bracket - 2 is the corresponding
696 ptr
= index (src
, bracket
- 2);
698 { /* no opening bracket */
702 if (!(rptr
= rindex (src
, '.')))
705 strncpy (dst
, src
, slen
);
709 dst
[slen
++] = bracket
;
714 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
715 then translate the device and recurse. */
716 if (dst
[slen
- 1] == ':'
717 && dst
[slen
- 2] != ':' /* skip decnet nodes */
718 && strcmp (src
+ slen
, "[000000]") == 0)
720 dst
[slen
- 1] = '\0';
721 if ((ptr
= egetenv (dst
))
722 && (rlen
= strlen (ptr
) - 1) > 0
723 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
724 && ptr
[rlen
- 1] == '.')
726 char * buf
= (char *) alloca (strlen (ptr
) + 1);
730 return directory_file_name (buf
, dst
);
735 strcat (dst
, "[000000]");
739 rlen
= strlen (rptr
) - 1;
740 strncat (dst
, rptr
, rlen
);
741 dst
[slen
+ rlen
] = '\0';
742 strcat (dst
, ".DIR.1");
746 /* Process as Unix format: just remove any final slash.
747 But leave "/" unchanged; do not change it to "". */
750 /* Handle // as root for apollo's. */
751 if ((slen
> 2 && dst
[slen
- 1] == '/')
752 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
756 && IS_DIRECTORY_SEP (dst
[slen
- 1])
758 && !IS_ANY_SEP (dst
[slen
- 2])
764 CORRECT_DIR_SEPS (dst
);
769 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
771 "Returns the file name of the directory named DIRECTORY.\n\
772 This is the name of the file that holds the data for the directory DIRECTORY.\n\
773 This operation exists because a directory is also a file, but its name as\n\
774 a directory is different from its name as a file.\n\
775 In Unix-syntax, this function just removes the final slash.\n\
776 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
777 it returns a file name such as \"[X]Y.DIR.1\".")
779 Lisp_Object directory
;
784 CHECK_STRING (directory
, 0);
786 if (NILP (directory
))
789 /* If the file name has special constructs in it,
790 call the corresponding file handler. */
791 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
793 return call2 (handler
, Qdirectory_file_name
, directory
);
796 /* 20 extra chars is insufficient for VMS, since we might perform a
797 logical name translation. an equivalence string can be up to 255
798 chars long, so grab that much extra space... - sss */
799 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20 + 255);
801 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20);
803 directory_file_name (XSTRING (directory
)->data
, buf
);
804 return build_string (buf
);
807 static char make_temp_name_tbl
[64] =
809 'A','B','C','D','E','F','G','H',
810 'I','J','K','L','M','N','O','P',
811 'Q','R','S','T','U','V','W','X',
812 'Y','Z','a','b','c','d','e','f',
813 'g','h','i','j','k','l','m','n',
814 'o','p','q','r','s','t','u','v',
815 'w','x','y','z','0','1','2','3',
816 '4','5','6','7','8','9','-','_'
818 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
820 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
821 "Generate temporary file name (string) starting with PREFIX (a string).\n\
822 The Emacs process number forms part of the result,\n\
823 so there is no danger of generating a name being used by another process.\n\
825 In addition, this function makes an attempt to choose a name\n\
826 which has no existing file. To make this work,\n\
827 PREFIX should be an absolute file name.")
834 unsigned char *p
, *data
;
838 CHECK_STRING (prefix
, 0);
840 /* VAL is created by adding 6 characters to PREFIX. The first
841 three are the PID of this process, in base 64, and the second
842 three are incremented if the file already exists. This ensures
843 262144 unique file names per PID per PREFIX. */
845 pid
= (int) getpid ();
847 #ifdef HAVE_LONG_FILE_NAMES
848 sprintf (pidbuf
, "%d", pid
);
849 pidlen
= strlen (pidbuf
);
851 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
852 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
853 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
857 len
= XSTRING (prefix
)->size
;
858 val
= make_uninit_string (len
+ 3 + pidlen
);
859 data
= XSTRING (val
)->data
;
860 bcopy(XSTRING (prefix
)->data
, data
, len
);
863 bcopy (pidbuf
, p
, pidlen
);
866 /* Here we try to minimize useless stat'ing when this function is
867 invoked many times successively with the same PREFIX. We achieve
868 this by initializing count to a random value, and incrementing it
871 We don't want make-temp-name to be called while dumping,
872 because then make_temp_name_count_initialized_p would get set
873 and then make_temp_name_count would not be set when Emacs starts. */
875 if (!make_temp_name_count_initialized_p
)
877 make_temp_name_count
= (unsigned) time (NULL
);
878 make_temp_name_count_initialized_p
= 1;
884 unsigned num
= make_temp_name_count
;
886 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
887 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
888 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
890 /* Poor man's congruential RN generator. Replace with
891 ++make_temp_name_count for debugging. */
892 make_temp_name_count
+= 25229;
893 make_temp_name_count
%= 225307;
895 if (stat (data
, &ignored
) < 0)
897 /* We want to return only if errno is ENOENT. */
901 /* The error here is dubious, but there is little else we
902 can do. The alternatives are to return nil, which is
903 as bad as (and in many cases worse than) throwing the
904 error, or to ignore the error, which will likely result
905 in looping through 225307 stat's, which is not only
906 dog-slow, but also useless since it will fallback to
907 the errow below, anyway. */
908 report_file_error ("Cannot create temporary name for prefix `%s'",
909 Fcons (prefix
, Qnil
));
914 error ("Cannot create temporary name for prefix `%s'",
915 XSTRING (prefix
)->data
);
920 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
921 "Convert filename NAME to absolute, and canonicalize it.\n\
922 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
923 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
924 the current buffer's value of default-directory is used.\n\
925 File name components that are `.' are removed, and \n\
926 so are file name components followed by `..', along with the `..' itself;\n\
927 note that these simplifications are done without checking the resulting\n\
928 file names in the file system.\n\
929 An initial `~/' expands to your home directory.\n\
930 An initial `~USER/' expands to USER's home directory.\n\
931 See also the function `substitute-in-file-name'.")
932 (name
, default_directory
)
933 Lisp_Object name
, default_directory
;
937 register unsigned char *newdir
, *p
, *o
;
939 unsigned char *target
;
942 unsigned char * colon
= 0;
943 unsigned char * close
= 0;
944 unsigned char * slash
= 0;
945 unsigned char * brack
= 0;
946 int lbrack
= 0, rbrack
= 0;
951 int collapse_newdir
= 1;
957 CHECK_STRING (name
, 0);
959 /* If the file name has special constructs in it,
960 call the corresponding file handler. */
961 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
963 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
965 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
966 if (NILP (default_directory
))
967 default_directory
= current_buffer
->directory
;
968 if (! STRINGP (default_directory
))
969 default_directory
= build_string ("/");
971 if (!NILP (default_directory
))
973 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
975 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
978 o
= XSTRING (default_directory
)->data
;
980 /* Make sure DEFAULT_DIRECTORY is properly expanded.
981 It would be better to do this down below where we actually use
982 default_directory. Unfortunately, calling Fexpand_file_name recursively
983 could invoke GC, and the strings might be relocated. This would
984 be annoying because we have pointers into strings lying around
985 that would need adjusting, and people would add new pointers to
986 the code and forget to adjust them, resulting in intermittent bugs.
987 Putting this call here avoids all that crud.
989 The EQ test avoids infinite recursion. */
990 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
991 /* Save time in some common cases - as long as default_directory
992 is not relative, it can be canonicalized with name below (if it
993 is needed at all) without requiring it to be expanded now. */
995 /* Detect MSDOS file names with drive specifiers. */
996 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
998 /* Detect Windows file names in UNC format. */
999 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1001 #else /* not DOS_NT */
1002 /* Detect Unix absolute file names (/... alone is not absolute on
1004 && ! (IS_DIRECTORY_SEP (o
[0]))
1005 #endif /* not DOS_NT */
1008 struct gcpro gcpro1
;
1011 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1016 /* Filenames on VMS are always upper case. */
1017 name
= Fupcase (name
);
1019 #ifdef FILE_SYSTEM_CASE
1020 name
= FILE_SYSTEM_CASE (name
);
1023 nm
= XSTRING (name
)->data
;
1026 /* We will force directory separators to be either all \ or /, so make
1027 a local copy to modify, even if there ends up being no change. */
1028 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1030 /* Note if special escape prefix is present, but remove for now. */
1031 if (nm
[0] == '/' && nm
[1] == ':')
1037 /* Find and remove drive specifier if present; this makes nm absolute
1038 even if the rest of the name appears to be relative. Only look for
1039 drive specifier at the beginning. */
1040 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1047 /* If we see "c://somedir", we want to strip the first slash after the
1048 colon when stripping the drive letter. Otherwise, this expands to
1050 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1052 #endif /* WINDOWSNT */
1056 /* Discard any previous drive specifier if nm is now in UNC format. */
1057 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1063 /* If nm is absolute, look for /./ or /../ sequences; if none are
1064 found, we can probably return right away. We will avoid allocating
1065 a new string if name is already fully expanded. */
1067 IS_DIRECTORY_SEP (nm
[0])
1069 && drive
&& !is_escaped
1072 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1079 /* If it turns out that the filename we want to return is just a
1080 suffix of FILENAME, we don't need to go through and edit
1081 things; we just need to construct a new string using data
1082 starting at the middle of FILENAME. If we set lose to a
1083 non-zero value, that means we've discovered that we can't do
1090 /* Since we know the name is absolute, we can assume that each
1091 element starts with a "/". */
1093 /* "." and ".." are hairy. */
1094 if (IS_DIRECTORY_SEP (p
[0])
1096 && (IS_DIRECTORY_SEP (p
[2])
1098 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1105 /* if dev:[dir]/, move nm to / */
1106 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1107 nm
= (brack
? brack
+ 1 : colon
+ 1);
1108 lbrack
= rbrack
= 0;
1116 /* VMS pre V4.4,convert '-'s in filenames. */
1117 if (lbrack
== rbrack
)
1119 if (dots
< 2) /* this is to allow negative version numbers */
1124 if (lbrack
> rbrack
&&
1125 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1126 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1132 /* count open brackets, reset close bracket pointer */
1133 if (p
[0] == '[' || p
[0] == '<')
1134 lbrack
++, brack
= 0;
1135 /* count close brackets, set close bracket pointer */
1136 if (p
[0] == ']' || p
[0] == '>')
1137 rbrack
++, brack
= p
;
1138 /* detect ][ or >< */
1139 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1141 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1142 nm
= p
+ 1, lose
= 1;
1143 if (p
[0] == ':' && (colon
|| slash
))
1144 /* if dev1:[dir]dev2:, move nm to dev2: */
1150 /* if /name/dev:, move nm to dev: */
1153 /* if node::dev:, move colon following dev */
1154 else if (colon
&& colon
[-1] == ':')
1156 /* if dev1:dev2:, move nm to dev2: */
1157 else if (colon
&& colon
[-1] != ':')
1162 if (p
[0] == ':' && !colon
)
1168 if (lbrack
== rbrack
)
1171 else if (p
[0] == '.')
1179 if (index (nm
, '/'))
1180 return build_string (sys_translate_unix (nm
));
1183 /* Make sure directories are all separated with / or \ as
1184 desired, but avoid allocation of a new string when not
1186 CORRECT_DIR_SEPS (nm
);
1188 if (IS_DIRECTORY_SEP (nm
[1]))
1190 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1191 name
= build_string (nm
);
1195 /* drive must be set, so this is okay */
1196 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1198 name
= make_string (nm
- 2, p
- nm
+ 2);
1199 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1200 XSTRING (name
)->data
[1] = ':';
1203 #else /* not DOS_NT */
1204 if (nm
== XSTRING (name
)->data
)
1206 return build_string (nm
);
1207 #endif /* not DOS_NT */
1211 /* At this point, nm might or might not be an absolute file name. We
1212 need to expand ~ or ~user if present, otherwise prefix nm with
1213 default_directory if nm is not absolute, and finally collapse /./
1214 and /foo/../ sequences.
1216 We set newdir to be the appropriate prefix if one is needed:
1217 - the relevant user directory if nm starts with ~ or ~user
1218 - the specified drive's working dir (DOS/NT only) if nm does not
1220 - the value of default_directory.
1222 Note that these prefixes are not guaranteed to be absolute (except
1223 for the working dir of a drive). Therefore, to ensure we always
1224 return an absolute name, if the final prefix is not absolute we
1225 append it to the current working directory. */
1229 if (nm
[0] == '~') /* prefix ~ */
1231 if (IS_DIRECTORY_SEP (nm
[1])
1235 || nm
[1] == 0) /* ~ by itself */
1237 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1238 newdir
= (unsigned char *) "";
1241 collapse_newdir
= 0;
1244 nm
++; /* Don't leave the slash in nm. */
1247 else /* ~user/filename */
1249 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1254 o
= (unsigned char *) alloca (p
- nm
+ 1);
1255 bcopy ((char *) nm
, o
, p
- nm
);
1258 pw
= (struct passwd
*) getpwnam (o
+ 1);
1261 newdir
= (unsigned char *) pw
-> pw_dir
;
1263 nm
= p
+ 1; /* skip the terminator */
1267 collapse_newdir
= 0;
1272 /* If we don't find a user of that name, leave the name
1273 unchanged; don't move nm forward to p. */
1278 /* On DOS and Windows, nm is absolute if a drive name was specified;
1279 use the drive's current directory as the prefix if needed. */
1280 if (!newdir
&& drive
)
1282 /* Get default directory if needed to make nm absolute. */
1283 if (!IS_DIRECTORY_SEP (nm
[0]))
1285 newdir
= alloca (MAXPATHLEN
+ 1);
1286 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1291 /* Either nm starts with /, or drive isn't mounted. */
1292 newdir
= alloca (4);
1293 newdir
[0] = DRIVE_LETTER (drive
);
1301 /* Finally, if no prefix has been specified and nm is not absolute,
1302 then it must be expanded relative to default_directory. */
1306 /* /... alone is not absolute on DOS and Windows. */
1307 && !IS_DIRECTORY_SEP (nm
[0])
1310 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1317 newdir
= XSTRING (default_directory
)->data
;
1319 /* Note if special escape prefix is present, but remove for now. */
1320 if (newdir
[0] == '/' && newdir
[1] == ':')
1331 /* First ensure newdir is an absolute name. */
1333 /* Detect MSDOS file names with drive specifiers. */
1334 ! (IS_DRIVE (newdir
[0])
1335 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1337 /* Detect Windows file names in UNC format. */
1338 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1342 /* Effectively, let newdir be (expand-file-name newdir cwd).
1343 Because of the admonition against calling expand-file-name
1344 when we have pointers into lisp strings, we accomplish this
1345 indirectly by prepending newdir to nm if necessary, and using
1346 cwd (or the wd of newdir's drive) as the new newdir. */
1348 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1353 if (!IS_DIRECTORY_SEP (nm
[0]))
1355 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1356 file_name_as_directory (tmp
, newdir
);
1360 newdir
= alloca (MAXPATHLEN
+ 1);
1363 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1370 /* Strip off drive name from prefix, if present. */
1371 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1377 /* Keep only a prefix from newdir if nm starts with slash
1378 (//server/share for UNC, nothing otherwise). */
1379 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1382 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1384 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1386 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1388 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1400 /* Get rid of any slash at the end of newdir, unless newdir is
1401 just / or // (an incomplete UNC name). */
1402 length
= strlen (newdir
);
1403 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1405 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1409 unsigned char *temp
= (unsigned char *) alloca (length
);
1410 bcopy (newdir
, temp
, length
- 1);
1411 temp
[length
- 1] = 0;
1419 /* Now concatenate the directory and name to new space in the stack frame */
1420 tlen
+= strlen (nm
) + 1;
1422 /* Reserve space for drive specifier and escape prefix, since either
1423 or both may need to be inserted. (The Microsoft x86 compiler
1424 produces incorrect code if the following two lines are combined.) */
1425 target
= (unsigned char *) alloca (tlen
+ 4);
1427 #else /* not DOS_NT */
1428 target
= (unsigned char *) alloca (tlen
);
1429 #endif /* not DOS_NT */
1435 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1438 /* If newdir is effectively "C:/", then the drive letter will have
1439 been stripped and newdir will be "/". Concatenating with an
1440 absolute directory in nm produces "//", which will then be
1441 incorrectly treated as a network share. Ignore newdir in
1442 this case (keeping the drive letter). */
1443 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1444 && newdir
[1] == '\0'))
1446 strcpy (target
, newdir
);
1450 file_name_as_directory (target
, newdir
);
1453 strcat (target
, nm
);
1455 if (index (target
, '/'))
1456 strcpy (target
, sys_translate_unix (target
));
1459 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1461 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1469 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1475 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1476 /* brackets are offset from each other by 2 */
1479 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1480 /* convert [foo][bar] to [bar] */
1481 while (o
[-1] != '[' && o
[-1] != '<')
1483 else if (*p
== '-' && *o
!= '.')
1486 else if (p
[0] == '-' && o
[-1] == '.' &&
1487 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1488 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1492 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1493 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1495 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1497 /* else [foo.-] ==> [-] */
1503 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1504 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1510 if (!IS_DIRECTORY_SEP (*p
))
1514 else if (IS_DIRECTORY_SEP (p
[0])
1516 && (IS_DIRECTORY_SEP (p
[2])
1519 /* If "/." is the entire filename, keep the "/". Otherwise,
1520 just delete the whole "/.". */
1521 if (o
== target
&& p
[2] == '\0')
1525 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1526 /* `/../' is the "superroot" on certain file systems. */
1528 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1530 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1532 /* Keep initial / only if this is the whole name. */
1533 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1541 #endif /* not VMS */
1545 /* At last, set drive name. */
1547 /* Except for network file name. */
1548 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1549 #endif /* WINDOWSNT */
1551 if (!drive
) abort ();
1553 target
[0] = DRIVE_LETTER (drive
);
1556 /* Reinsert the escape prefix if required. */
1563 CORRECT_DIR_SEPS (target
);
1566 return make_string (target
, o
- target
);
1570 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1571 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1572 "Convert FILENAME to absolute, and canonicalize it.\n\
1573 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1574 (does not start with slash); if DEFAULT is nil or missing,\n\
1575 the current buffer's value of default-directory is used.\n\
1576 Filenames containing `.' or `..' as components are simplified;\n\
1577 initial `~/' expands to your home directory.\n\
1578 See also the function `substitute-in-file-name'.")
1580 Lisp_Object name
, defalt
;
1584 register unsigned char *newdir
, *p
, *o
;
1586 unsigned char *target
;
1590 unsigned char * colon
= 0;
1591 unsigned char * close
= 0;
1592 unsigned char * slash
= 0;
1593 unsigned char * brack
= 0;
1594 int lbrack
= 0, rbrack
= 0;
1598 CHECK_STRING (name
, 0);
1601 /* Filenames on VMS are always upper case. */
1602 name
= Fupcase (name
);
1605 nm
= XSTRING (name
)->data
;
1607 /* If nm is absolute, flush ...// and detect /./ and /../.
1608 If no /./ or /../ we can return right away. */
1620 if (p
[0] == '/' && p
[1] == '/'
1622 /* // at start of filename is meaningful on Apollo system. */
1627 if (p
[0] == '/' && p
[1] == '~')
1628 nm
= p
+ 1, lose
= 1;
1629 if (p
[0] == '/' && p
[1] == '.'
1630 && (p
[2] == '/' || p
[2] == 0
1631 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1637 /* if dev:[dir]/, move nm to / */
1638 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1639 nm
= (brack
? brack
+ 1 : colon
+ 1);
1640 lbrack
= rbrack
= 0;
1648 /* VMS pre V4.4,convert '-'s in filenames. */
1649 if (lbrack
== rbrack
)
1651 if (dots
< 2) /* this is to allow negative version numbers */
1656 if (lbrack
> rbrack
&&
1657 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1658 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1664 /* count open brackets, reset close bracket pointer */
1665 if (p
[0] == '[' || p
[0] == '<')
1666 lbrack
++, brack
= 0;
1667 /* count close brackets, set close bracket pointer */
1668 if (p
[0] == ']' || p
[0] == '>')
1669 rbrack
++, brack
= p
;
1670 /* detect ][ or >< */
1671 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1673 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1674 nm
= p
+ 1, lose
= 1;
1675 if (p
[0] == ':' && (colon
|| slash
))
1676 /* if dev1:[dir]dev2:, move nm to dev2: */
1682 /* If /name/dev:, move nm to dev: */
1685 /* If node::dev:, move colon following dev */
1686 else if (colon
&& colon
[-1] == ':')
1688 /* If dev1:dev2:, move nm to dev2: */
1689 else if (colon
&& colon
[-1] != ':')
1694 if (p
[0] == ':' && !colon
)
1700 if (lbrack
== rbrack
)
1703 else if (p
[0] == '.')
1711 if (index (nm
, '/'))
1712 return build_string (sys_translate_unix (nm
));
1714 if (nm
== XSTRING (name
)->data
)
1716 return build_string (nm
);
1720 /* Now determine directory to start with and put it in NEWDIR */
1724 if (nm
[0] == '~') /* prefix ~ */
1729 || nm
[1] == 0)/* ~/filename */
1731 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1732 newdir
= (unsigned char *) "";
1735 nm
++; /* Don't leave the slash in nm. */
1738 else /* ~user/filename */
1740 /* Get past ~ to user */
1741 unsigned char *user
= nm
+ 1;
1742 /* Find end of name. */
1743 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1744 int len
= ptr
? ptr
- user
: strlen (user
);
1746 unsigned char *ptr1
= index (user
, ':');
1747 if (ptr1
!= 0 && ptr1
- user
< len
)
1750 /* Copy the user name into temp storage. */
1751 o
= (unsigned char *) alloca (len
+ 1);
1752 bcopy ((char *) user
, o
, len
);
1755 /* Look up the user name. */
1756 pw
= (struct passwd
*) getpwnam (o
+ 1);
1758 error ("\"%s\" isn't a registered user", o
+ 1);
1760 newdir
= (unsigned char *) pw
->pw_dir
;
1762 /* Discard the user name from NM. */
1769 #endif /* not VMS */
1773 defalt
= current_buffer
->directory
;
1774 CHECK_STRING (defalt
, 1);
1775 newdir
= XSTRING (defalt
)->data
;
1778 /* Now concatenate the directory and name to new space in the stack frame */
1780 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1781 target
= (unsigned char *) alloca (tlen
);
1787 if (nm
[0] == 0 || nm
[0] == '/')
1788 strcpy (target
, newdir
);
1791 file_name_as_directory (target
, newdir
);
1794 strcat (target
, nm
);
1796 if (index (target
, '/'))
1797 strcpy (target
, sys_translate_unix (target
));
1800 /* Now canonicalize by removing /. and /foo/.. if they appear */
1808 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1814 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1815 /* brackets are offset from each other by 2 */
1818 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1819 /* convert [foo][bar] to [bar] */
1820 while (o
[-1] != '[' && o
[-1] != '<')
1822 else if (*p
== '-' && *o
!= '.')
1825 else if (p
[0] == '-' && o
[-1] == '.' &&
1826 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1827 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1831 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1832 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1834 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1836 /* else [foo.-] ==> [-] */
1842 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1843 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1853 else if (!strncmp (p
, "//", 2)
1855 /* // at start of filename is meaningful in Apollo system. */
1863 else if (p
[0] == '/' && p
[1] == '.' &&
1864 (p
[2] == '/' || p
[2] == 0))
1866 else if (!strncmp (p
, "/..", 3)
1867 /* `/../' is the "superroot" on certain file systems. */
1869 && (p
[3] == '/' || p
[3] == 0))
1871 while (o
!= target
&& *--o
!= '/')
1874 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1878 if (o
== target
&& *o
== '/')
1886 #endif /* not VMS */
1889 return make_string (target
, o
- target
);
1893 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1894 Ssubstitute_in_file_name
, 1, 1, 0,
1895 "Substitute environment variables referred to in FILENAME.\n\
1896 `$FOO' where FOO is an environment variable name means to substitute\n\
1897 the value of that variable. The variable name should be terminated\n\
1898 with a character not a letter, digit or underscore; otherwise, enclose\n\
1899 the entire variable name in braces.\n\
1900 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1901 On VMS, `$' substitution is not done; this function does little and only\n\
1902 duplicates what `expand-file-name' does.")
1904 Lisp_Object filename
;
1908 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1909 unsigned char *target
;
1911 int substituted
= 0;
1913 Lisp_Object handler
;
1915 CHECK_STRING (filename
, 0);
1917 /* If the file name has special constructs in it,
1918 call the corresponding file handler. */
1919 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1920 if (!NILP (handler
))
1921 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1923 nm
= XSTRING (filename
)->data
;
1925 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1926 CORRECT_DIR_SEPS (nm
);
1927 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1929 endp
= nm
+ STRING_BYTES (XSTRING (filename
));
1931 /* If /~ or // appears, discard everything through first slash. */
1933 for (p
= nm
; p
!= endp
; p
++)
1936 #if defined (APOLLO) || defined (WINDOWSNT)
1937 /* // at start of file name is meaningful in Apollo and
1938 WindowsNT systems. */
1939 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1940 #else /* not (APOLLO || WINDOWSNT) */
1941 || IS_DIRECTORY_SEP (p
[0])
1942 #endif /* not (APOLLO || WINDOWSNT) */
1947 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1949 || IS_DIRECTORY_SEP (p
[-1])))
1955 /* see comment in expand-file-name about drive specifiers */
1956 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1957 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1966 return build_string (nm
);
1969 /* See if any variables are substituted into the string
1970 and find the total length of their values in `total' */
1972 for (p
= nm
; p
!= endp
;)
1982 /* "$$" means a single "$" */
1991 while (p
!= endp
&& *p
!= '}') p
++;
1992 if (*p
!= '}') goto missingclose
;
1998 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2002 /* Copy out the variable name */
2003 target
= (unsigned char *) alloca (s
- o
+ 1);
2004 strncpy (target
, o
, s
- o
);
2007 strupr (target
); /* $home == $HOME etc. */
2010 /* Get variable value */
2011 o
= (unsigned char *) egetenv (target
);
2012 if (!o
) goto badvar
;
2013 total
+= strlen (o
);
2020 /* If substitution required, recopy the string and do it */
2021 /* Make space in stack frame for the new copy */
2022 xnm
= (unsigned char *) alloca (STRING_BYTES (XSTRING (filename
)) + total
+ 1);
2025 /* Copy the rest of the name through, replacing $ constructs with values */
2042 while (p
!= endp
&& *p
!= '}') p
++;
2043 if (*p
!= '}') goto missingclose
;
2049 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2053 /* Copy out the variable name */
2054 target
= (unsigned char *) alloca (s
- o
+ 1);
2055 strncpy (target
, o
, s
- o
);
2058 strupr (target
); /* $home == $HOME etc. */
2061 /* Get variable value */
2062 o
= (unsigned char *) egetenv (target
);
2066 if (STRING_MULTIBYTE (filename
))
2068 /* If the original string is multibyte,
2069 convert what we substitute into multibyte. */
2070 unsigned char workbuf
[4], *str
;
2076 c
= unibyte_char_to_multibyte (c
);
2077 if (! SINGLE_BYTE_CHAR_P (c
))
2079 len
= CHAR_STRING (c
, workbuf
, str
);
2080 bcopy (str
, x
, len
);
2096 /* If /~ or // appears, discard everything through first slash. */
2098 for (p
= xnm
; p
!= x
; p
++)
2100 #if defined (APOLLO) || defined (WINDOWSNT)
2101 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2102 #else /* not (APOLLO || WINDOWSNT) */
2103 || IS_DIRECTORY_SEP (p
[0])
2104 #endif /* not (APOLLO || WINDOWSNT) */
2106 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2109 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2110 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2114 if (STRING_MULTIBYTE (filename
))
2115 return make_string (xnm
, x
- xnm
);
2116 return make_unibyte_string (xnm
, x
- xnm
);
2119 error ("Bad format environment-variable substitution");
2121 error ("Missing \"}\" in environment-variable substitution");
2123 error ("Substituting nonexistent environment variable \"%s\"", target
);
2126 #endif /* not VMS */
2129 /* A slightly faster and more convenient way to get
2130 (directory-file-name (expand-file-name FOO)). */
2133 expand_and_dir_to_file (filename
, defdir
)
2134 Lisp_Object filename
, defdir
;
2136 register Lisp_Object absname
;
2138 absname
= Fexpand_file_name (filename
, defdir
);
2141 register int c
= XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1];
2142 if (c
== ':' || c
== ']' || c
== '>')
2143 absname
= Fdirectory_file_name (absname
);
2146 /* Remove final slash, if any (unless this is the root dir).
2147 stat behaves differently depending! */
2148 if (XSTRING (absname
)->size
> 1
2149 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1])
2150 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
))-2]))
2151 /* We cannot take shortcuts; they might be wrong for magic file names. */
2152 absname
= Fdirectory_file_name (absname
);
2157 /* Signal an error if the file ABSNAME already exists.
2158 If INTERACTIVE is nonzero, ask the user whether to proceed,
2159 and bypass the error if the user says to go ahead.
2160 QUERYSTRING is a name for the action that is being considered
2163 *STATPTR is used to store the stat information if the file exists.
2164 If the file does not exist, STATPTR->st_mode is set to 0.
2165 If STATPTR is null, we don't store into it.
2167 If QUICK is nonzero, we ask for y or n, not yes or no. */
2170 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2171 Lisp_Object absname
;
2172 unsigned char *querystring
;
2174 struct stat
*statptr
;
2177 register Lisp_Object tem
, encoded_filename
;
2178 struct stat statbuf
;
2179 struct gcpro gcpro1
;
2181 encoded_filename
= ENCODE_FILE (absname
);
2183 /* stat is a good way to tell whether the file exists,
2184 regardless of what access permissions it has. */
2185 if (stat (XSTRING (encoded_filename
)->data
, &statbuf
) >= 0)
2188 Fsignal (Qfile_already_exists
,
2189 Fcons (build_string ("File already exists"),
2190 Fcons (absname
, Qnil
)));
2192 tem
= format1 ("File %s already exists; %s anyway? ",
2193 XSTRING (absname
)->data
, querystring
);
2195 tem
= Fy_or_n_p (tem
);
2197 tem
= do_yes_or_no_p (tem
);
2200 Fsignal (Qfile_already_exists
,
2201 Fcons (build_string ("File already exists"),
2202 Fcons (absname
, Qnil
)));
2209 statptr
->st_mode
= 0;
2214 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2215 "fCopy file: \nFCopy %s to file: \np\nP",
2216 "Copy FILE to NEWNAME. Both args must be strings.\n\
2217 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2218 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2219 A number as third arg means request confirmation if NEWNAME already exists.\n\
2220 This is what happens in interactive use with M-x.\n\
2221 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2222 last-modified time as the old one. (This works on only some systems.)\n\
2223 A prefix arg makes KEEP-TIME non-nil.")
2224 (file
, newname
, ok_if_already_exists
, keep_date
)
2225 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2228 char buf
[16 * 1024];
2229 struct stat st
, out_st
;
2230 Lisp_Object handler
;
2231 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2232 int count
= specpdl_ptr
- specpdl
;
2233 int input_file_statable_p
;
2234 Lisp_Object encoded_file
, encoded_newname
;
2236 encoded_file
= encoded_newname
= Qnil
;
2237 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2238 CHECK_STRING (file
, 0);
2239 CHECK_STRING (newname
, 1);
2241 file
= Fexpand_file_name (file
, Qnil
);
2242 newname
= Fexpand_file_name (newname
, Qnil
);
2244 /* If the input file name has special constructs in it,
2245 call the corresponding file handler. */
2246 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2247 /* Likewise for output file name. */
2249 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2250 if (!NILP (handler
))
2251 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2252 ok_if_already_exists
, keep_date
));
2254 encoded_file
= ENCODE_FILE (file
);
2255 encoded_newname
= ENCODE_FILE (newname
);
2257 if (NILP (ok_if_already_exists
)
2258 || INTEGERP (ok_if_already_exists
))
2259 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2260 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2261 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2264 ifd
= open (XSTRING (encoded_file
)->data
, O_RDONLY
);
2266 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2268 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2270 /* We can only copy regular files and symbolic links. Other files are not
2272 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2274 #if !defined (DOS_NT) || __DJGPP__ > 1
2275 if (out_st
.st_mode
!= 0
2276 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2279 report_file_error ("Input and output files are the same",
2280 Fcons (file
, Fcons (newname
, Qnil
)));
2284 #if defined (S_ISREG) && defined (S_ISLNK)
2285 if (input_file_statable_p
)
2287 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2289 #if defined (EISDIR)
2290 /* Get a better looking error message. */
2293 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2296 #endif /* S_ISREG && S_ISLNK */
2299 /* Create the copy file with the same record format as the input file */
2300 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2303 /* System's default file type was set to binary by _fmode in emacs.c. */
2304 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2305 #else /* not MSDOS */
2306 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2307 #endif /* not MSDOS */
2310 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2312 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2316 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2317 if (write (ofd
, buf
, n
) != n
)
2318 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2321 /* Closing the output clobbers the file times on some systems. */
2322 if (close (ofd
) < 0)
2323 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2325 if (input_file_statable_p
)
2327 if (!NILP (keep_date
))
2329 EMACS_TIME atime
, mtime
;
2330 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2331 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2332 if (set_file_times (XSTRING (encoded_newname
)->data
,
2334 Fsignal (Qfile_date_error
,
2335 Fcons (build_string ("Cannot set file date"),
2336 Fcons (newname
, Qnil
)));
2339 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2341 #if defined (__DJGPP__) && __DJGPP__ > 1
2342 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2343 and if it can't, it tells so. Otherwise, under MSDOS we usually
2344 get only the READ bit, which will make the copied file read-only,
2345 so it's better not to chmod at all. */
2346 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2347 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2348 #endif /* DJGPP version 2 or newer */
2354 /* Discard the unwind protects. */
2355 specpdl_ptr
= specpdl
+ count
;
2361 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2362 Smake_directory_internal
, 1, 1, 0,
2363 "Create a new directory named DIRECTORY.")
2365 Lisp_Object directory
;
2368 Lisp_Object handler
;
2369 Lisp_Object encoded_dir
;
2371 CHECK_STRING (directory
, 0);
2372 directory
= Fexpand_file_name (directory
, Qnil
);
2374 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2375 if (!NILP (handler
))
2376 return call2 (handler
, Qmake_directory_internal
, directory
);
2378 encoded_dir
= ENCODE_FILE (directory
);
2380 dir
= XSTRING (encoded_dir
)->data
;
2383 if (mkdir (dir
) != 0)
2385 if (mkdir (dir
, 0777) != 0)
2387 report_file_error ("Creating directory", Flist (1, &directory
));
2392 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2393 "Delete the directory named DIRECTORY.")
2395 Lisp_Object directory
;
2398 Lisp_Object handler
;
2399 Lisp_Object encoded_dir
;
2401 CHECK_STRING (directory
, 0);
2402 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2404 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2405 if (!NILP (handler
))
2406 return call2 (handler
, Qdelete_directory
, directory
);
2408 encoded_dir
= ENCODE_FILE (directory
);
2410 dir
= XSTRING (encoded_dir
)->data
;
2412 if (rmdir (dir
) != 0)
2413 report_file_error ("Removing directory", Flist (1, &directory
));
2418 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2419 "Delete file named FILENAME.\n\
2420 If file has multiple names, it continues to exist with the other names.")
2422 Lisp_Object filename
;
2424 Lisp_Object handler
;
2425 Lisp_Object encoded_file
;
2427 CHECK_STRING (filename
, 0);
2428 filename
= Fexpand_file_name (filename
, Qnil
);
2430 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2431 if (!NILP (handler
))
2432 return call2 (handler
, Qdelete_file
, filename
);
2434 encoded_file
= ENCODE_FILE (filename
);
2436 if (0 > unlink (XSTRING (encoded_file
)->data
))
2437 report_file_error ("Removing old name", Flist (1, &filename
));
2442 internal_delete_file_1 (ignore
)
2448 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2451 internal_delete_file (filename
)
2452 Lisp_Object filename
;
2454 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2455 Qt
, internal_delete_file_1
));
2458 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2459 "fRename file: \nFRename %s to file: \np",
2460 "Rename FILE as NEWNAME. Both args strings.\n\
2461 If file has names other than FILE, it continues to have those names.\n\
2462 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2463 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2464 A number as third arg means request confirmation if NEWNAME already exists.\n\
2465 This is what happens in interactive use with M-x.")
2466 (file
, newname
, ok_if_already_exists
)
2467 Lisp_Object file
, newname
, ok_if_already_exists
;
2470 Lisp_Object args
[2];
2472 Lisp_Object handler
;
2473 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2474 Lisp_Object encoded_file
, encoded_newname
;
2476 encoded_file
= encoded_newname
= Qnil
;
2477 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2478 CHECK_STRING (file
, 0);
2479 CHECK_STRING (newname
, 1);
2480 file
= Fexpand_file_name (file
, Qnil
);
2481 newname
= Fexpand_file_name (newname
, Qnil
);
2483 /* If the file name has special constructs in it,
2484 call the corresponding file handler. */
2485 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2487 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2488 if (!NILP (handler
))
2489 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2490 file
, newname
, ok_if_already_exists
));
2492 encoded_file
= ENCODE_FILE (file
);
2493 encoded_newname
= ENCODE_FILE (newname
);
2495 if (NILP (ok_if_already_exists
)
2496 || INTEGERP (ok_if_already_exists
))
2497 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2498 INTEGERP (ok_if_already_exists
), 0, 0);
2500 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2502 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2503 || 0 > unlink (XSTRING (encoded_file
)->data
))
2508 Fcopy_file (file
, newname
,
2509 /* We have already prompted if it was an integer,
2510 so don't have copy-file prompt again. */
2511 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2512 Fdelete_file (file
);
2519 report_file_error ("Renaming", Flist (2, args
));
2522 report_file_error ("Renaming", Flist (2, &file
));
2529 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2530 "fAdd name to file: \nFName to add to %s: \np",
2531 "Give FILE additional name NEWNAME. Both args strings.\n\
2532 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2533 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2534 A number as third arg means request confirmation if NEWNAME already exists.\n\
2535 This is what happens in interactive use with M-x.")
2536 (file
, newname
, ok_if_already_exists
)
2537 Lisp_Object file
, newname
, ok_if_already_exists
;
2540 Lisp_Object args
[2];
2542 Lisp_Object handler
;
2543 Lisp_Object encoded_file
, encoded_newname
;
2544 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2546 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2547 encoded_file
= encoded_newname
= Qnil
;
2548 CHECK_STRING (file
, 0);
2549 CHECK_STRING (newname
, 1);
2550 file
= Fexpand_file_name (file
, Qnil
);
2551 newname
= Fexpand_file_name (newname
, Qnil
);
2553 /* If the file name has special constructs in it,
2554 call the corresponding file handler. */
2555 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2556 if (!NILP (handler
))
2557 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2558 newname
, ok_if_already_exists
));
2560 /* If the new name has special constructs in it,
2561 call the corresponding file handler. */
2562 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2563 if (!NILP (handler
))
2564 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2565 newname
, ok_if_already_exists
));
2567 encoded_file
= ENCODE_FILE (file
);
2568 encoded_newname
= ENCODE_FILE (newname
);
2570 if (NILP (ok_if_already_exists
)
2571 || INTEGERP (ok_if_already_exists
))
2572 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2573 INTEGERP (ok_if_already_exists
), 0, 0);
2575 unlink (XSTRING (newname
)->data
);
2576 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2581 report_file_error ("Adding new name", Flist (2, args
));
2583 report_file_error ("Adding new name", Flist (2, &file
));
2592 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2593 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2594 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2595 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2596 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2597 A number as third arg means request confirmation if LINKNAME already exists.\n\
2598 This happens for interactive use with M-x.")
2599 (filename
, linkname
, ok_if_already_exists
)
2600 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2603 Lisp_Object args
[2];
2605 Lisp_Object handler
;
2606 Lisp_Object encoded_filename
, encoded_linkname
;
2607 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2609 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2610 encoded_filename
= encoded_linkname
= Qnil
;
2611 CHECK_STRING (filename
, 0);
2612 CHECK_STRING (linkname
, 1);
2613 /* If the link target has a ~, we must expand it to get
2614 a truly valid file name. Otherwise, do not expand;
2615 we want to permit links to relative file names. */
2616 if (XSTRING (filename
)->data
[0] == '~')
2617 filename
= Fexpand_file_name (filename
, Qnil
);
2618 linkname
= Fexpand_file_name (linkname
, Qnil
);
2620 /* If the file name has special constructs in it,
2621 call the corresponding file handler. */
2622 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2623 if (!NILP (handler
))
2624 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2625 linkname
, ok_if_already_exists
));
2627 /* If the new link name has special constructs in it,
2628 call the corresponding file handler. */
2629 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2630 if (!NILP (handler
))
2631 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2632 linkname
, ok_if_already_exists
));
2634 encoded_filename
= ENCODE_FILE (filename
);
2635 encoded_linkname
= ENCODE_FILE (linkname
);
2637 if (NILP (ok_if_already_exists
)
2638 || INTEGERP (ok_if_already_exists
))
2639 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2640 INTEGERP (ok_if_already_exists
), 0, 0);
2641 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2642 XSTRING (encoded_linkname
)->data
))
2644 /* If we didn't complain already, silently delete existing file. */
2645 if (errno
== EEXIST
)
2647 unlink (XSTRING (encoded_linkname
)->data
);
2648 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2649 XSTRING (encoded_linkname
)->data
))
2659 report_file_error ("Making symbolic link", Flist (2, args
));
2661 report_file_error ("Making symbolic link", Flist (2, &filename
));
2667 #endif /* S_IFLNK */
2671 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2672 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2673 "Define the job-wide logical name NAME to have the value STRING.\n\
2674 If STRING is nil or a null string, the logical name NAME is deleted.")
2679 CHECK_STRING (name
, 0);
2681 delete_logical_name (XSTRING (name
)->data
);
2684 CHECK_STRING (string
, 1);
2686 if (XSTRING (string
)->size
== 0)
2687 delete_logical_name (XSTRING (name
)->data
);
2689 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2698 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2699 "Open a network connection to PATH using LOGIN as the login string.")
2701 Lisp_Object path
, login
;
2705 CHECK_STRING (path
, 0);
2706 CHECK_STRING (login
, 0);
2708 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2710 if (netresult
== -1)
2715 #endif /* HPUX_NET */
2717 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2719 "Return t if file FILENAME specifies an absolute file name.\n\
2720 On Unix, this is a name starting with a `/' or a `~'.")
2722 Lisp_Object filename
;
2726 CHECK_STRING (filename
, 0);
2727 ptr
= XSTRING (filename
)->data
;
2728 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2730 /* ??? This criterion is probably wrong for '<'. */
2731 || index (ptr
, ':') || index (ptr
, '<')
2732 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2736 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2744 /* Return nonzero if file FILENAME exists and can be executed. */
2747 check_executable (filename
)
2751 int len
= strlen (filename
);
2754 if (stat (filename
, &st
) < 0)
2756 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2757 return ((st
.st_mode
& S_IEXEC
) != 0);
2759 return (S_ISREG (st
.st_mode
)
2761 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2762 || stricmp (suffix
, ".exe") == 0
2763 || stricmp (suffix
, ".bat") == 0)
2764 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2765 #endif /* not WINDOWSNT */
2766 #else /* not DOS_NT */
2767 #ifdef HAVE_EUIDACCESS
2768 return (euidaccess (filename
, 1) >= 0);
2770 /* Access isn't quite right because it uses the real uid
2771 and we really want to test with the effective uid.
2772 But Unix doesn't give us a right way to do it. */
2773 return (access (filename
, 1) >= 0);
2775 #endif /* not DOS_NT */
2778 /* Return nonzero if file FILENAME exists and can be written. */
2781 check_writable (filename
)
2786 if (stat (filename
, &st
) < 0)
2788 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2789 #else /* not MSDOS */
2790 #ifdef HAVE_EUIDACCESS
2791 return (euidaccess (filename
, 2) >= 0);
2793 /* Access isn't quite right because it uses the real uid
2794 and we really want to test with the effective uid.
2795 But Unix doesn't give us a right way to do it.
2796 Opening with O_WRONLY could work for an ordinary file,
2797 but would lose for directories. */
2798 return (access (filename
, 2) >= 0);
2800 #endif /* not MSDOS */
2803 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2804 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2805 See also `file-readable-p' and `file-attributes'.")
2807 Lisp_Object filename
;
2809 Lisp_Object absname
;
2810 Lisp_Object handler
;
2811 struct stat statbuf
;
2813 CHECK_STRING (filename
, 0);
2814 absname
= Fexpand_file_name (filename
, Qnil
);
2816 /* If the file name has special constructs in it,
2817 call the corresponding file handler. */
2818 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2819 if (!NILP (handler
))
2820 return call2 (handler
, Qfile_exists_p
, absname
);
2822 absname
= ENCODE_FILE (absname
);
2824 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2827 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2828 "Return t if FILENAME can be executed by you.\n\
2829 For a directory, this means you can access files in that directory.")
2831 Lisp_Object filename
;
2834 Lisp_Object absname
;
2835 Lisp_Object handler
;
2837 CHECK_STRING (filename
, 0);
2838 absname
= Fexpand_file_name (filename
, Qnil
);
2840 /* If the file name has special constructs in it,
2841 call the corresponding file handler. */
2842 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2843 if (!NILP (handler
))
2844 return call2 (handler
, Qfile_executable_p
, absname
);
2846 absname
= ENCODE_FILE (absname
);
2848 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2851 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2852 "Return t if file FILENAME exists and you can read it.\n\
2853 See also `file-exists-p' and `file-attributes'.")
2855 Lisp_Object filename
;
2857 Lisp_Object absname
;
2858 Lisp_Object handler
;
2861 struct stat statbuf
;
2863 CHECK_STRING (filename
, 0);
2864 absname
= Fexpand_file_name (filename
, Qnil
);
2866 /* If the file name has special constructs in it,
2867 call the corresponding file handler. */
2868 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2869 if (!NILP (handler
))
2870 return call2 (handler
, Qfile_readable_p
, absname
);
2872 absname
= ENCODE_FILE (absname
);
2875 /* Under MS-DOS and Windows, open does not work for directories. */
2876 if (access (XSTRING (absname
)->data
, 0) == 0)
2879 #else /* not DOS_NT */
2881 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2882 /* Opening a fifo without O_NONBLOCK can wait.
2883 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2884 except in the case of a fifo, on a system which handles it. */
2885 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2888 if (S_ISFIFO (statbuf
.st_mode
))
2889 flags
|= O_NONBLOCK
;
2891 desc
= open (XSTRING (absname
)->data
, flags
);
2896 #endif /* not DOS_NT */
2899 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2901 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2902 "Return t if file FILENAME can be written or created by you.")
2904 Lisp_Object filename
;
2906 Lisp_Object absname
, dir
, encoded
;
2907 Lisp_Object handler
;
2908 struct stat statbuf
;
2910 CHECK_STRING (filename
, 0);
2911 absname
= Fexpand_file_name (filename
, Qnil
);
2913 /* If the file name has special constructs in it,
2914 call the corresponding file handler. */
2915 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2916 if (!NILP (handler
))
2917 return call2 (handler
, Qfile_writable_p
, absname
);
2919 encoded
= ENCODE_FILE (absname
);
2920 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
2921 return (check_writable (XSTRING (encoded
)->data
)
2924 dir
= Ffile_name_directory (absname
);
2927 dir
= Fdirectory_file_name (dir
);
2931 dir
= Fdirectory_file_name (dir
);
2934 dir
= ENCODE_FILE (dir
);
2935 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2939 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2940 "Access file FILENAME, and get an error if that does not work.\n\
2941 The second argument STRING is used in the error message.\n\
2942 If there is no error, we return nil.")
2944 Lisp_Object filename
, string
;
2946 Lisp_Object handler
, encoded_filename
;
2949 CHECK_STRING (filename
, 0);
2950 CHECK_STRING (string
, 1);
2952 /* If the file name has special constructs in it,
2953 call the corresponding file handler. */
2954 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2955 if (!NILP (handler
))
2956 return call3 (handler
, Qaccess_file
, filename
, string
);
2958 encoded_filename
= ENCODE_FILE (filename
);
2960 fd
= open (XSTRING (encoded_filename
)->data
, O_RDONLY
);
2962 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2968 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2969 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2970 The value is the name of the file to which it is linked.\n\
2971 Otherwise returns nil.")
2973 Lisp_Object filename
;
2980 Lisp_Object handler
;
2982 CHECK_STRING (filename
, 0);
2983 filename
= Fexpand_file_name (filename
, Qnil
);
2985 /* If the file name has special constructs in it,
2986 call the corresponding file handler. */
2987 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2988 if (!NILP (handler
))
2989 return call2 (handler
, Qfile_symlink_p
, filename
);
2991 filename
= ENCODE_FILE (filename
);
2996 buf
= (char *) xmalloc (bufsize
);
2997 bzero (buf
, bufsize
);
2998 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2999 if (valsize
< bufsize
) break;
3000 /* Buffer was not long enough */
3009 val
= make_string (buf
, valsize
);
3011 val
= DECODE_FILE (val
);
3013 #else /* not S_IFLNK */
3015 #endif /* not S_IFLNK */
3018 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3019 "Return t if FILENAME names an existing directory.")
3021 Lisp_Object filename
;
3023 register Lisp_Object absname
;
3025 Lisp_Object handler
;
3027 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3029 /* If the file name has special constructs in it,
3030 call the corresponding file handler. */
3031 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3032 if (!NILP (handler
))
3033 return call2 (handler
, Qfile_directory_p
, absname
);
3035 absname
= ENCODE_FILE (absname
);
3037 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3039 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3042 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3043 "Return t if file FILENAME is the name of a directory as a file,\n\
3044 and files in that directory can be opened by you. In order to use a\n\
3045 directory as a buffer's current directory, this predicate must return true.\n\
3046 A directory name spec may be given instead; then the value is t\n\
3047 if the directory so specified exists and really is a readable and\n\
3048 searchable directory.")
3050 Lisp_Object filename
;
3052 Lisp_Object handler
;
3054 struct gcpro gcpro1
;
3056 /* If the file name has special constructs in it,
3057 call the corresponding file handler. */
3058 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3059 if (!NILP (handler
))
3060 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3062 /* It's an unlikely combination, but yes we really do need to gcpro:
3063 Suppose that file-accessible-directory-p has no handler, but
3064 file-directory-p does have a handler; this handler causes a GC which
3065 relocates the string in `filename'; and finally file-directory-p
3066 returns non-nil. Then we would end up passing a garbaged string
3067 to file-executable-p. */
3069 tem
= (NILP (Ffile_directory_p (filename
))
3070 || NILP (Ffile_executable_p (filename
)));
3072 return tem
? Qnil
: Qt
;
3075 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3076 "Return t if file FILENAME is the name of a regular file.\n\
3077 This is the sort of file that holds an ordinary stream of data bytes.")
3079 Lisp_Object filename
;
3081 register Lisp_Object absname
;
3083 Lisp_Object handler
;
3085 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3087 /* If the file name has special constructs in it,
3088 call the corresponding file handler. */
3089 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3090 if (!NILP (handler
))
3091 return call2 (handler
, Qfile_regular_p
, absname
);
3093 absname
= ENCODE_FILE (absname
);
3095 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3097 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3100 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3101 "Return mode bits of file named FILENAME, as an integer.")
3103 Lisp_Object filename
;
3105 Lisp_Object absname
;
3107 Lisp_Object handler
;
3109 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3111 /* If the file name has special constructs in it,
3112 call the corresponding file handler. */
3113 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3114 if (!NILP (handler
))
3115 return call2 (handler
, Qfile_modes
, absname
);
3117 absname
= ENCODE_FILE (absname
);
3119 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3121 #if defined (MSDOS) && __DJGPP__ < 2
3122 if (check_executable (XSTRING (absname
)->data
))
3123 st
.st_mode
|= S_IEXEC
;
3124 #endif /* MSDOS && __DJGPP__ < 2 */
3126 return make_number (st
.st_mode
& 07777);
3129 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3130 "Set mode bits of file named FILENAME to MODE (an integer).\n\
3131 Only the 12 low bits of MODE are used.")
3133 Lisp_Object filename
, mode
;
3135 Lisp_Object absname
, encoded_absname
;
3136 Lisp_Object handler
;
3138 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3139 CHECK_NUMBER (mode
, 1);
3141 /* If the file name has special constructs in it,
3142 call the corresponding file handler. */
3143 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3144 if (!NILP (handler
))
3145 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3147 encoded_absname
= ENCODE_FILE (absname
);
3149 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
3150 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3155 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3156 "Set the file permission bits for newly created files.\n\
3157 The argument MODE should be an integer; only the low 9 bits are used.\n\
3158 This setting is inherited by subprocesses.")
3162 CHECK_NUMBER (mode
, 0);
3164 umask ((~ XINT (mode
)) & 0777);
3169 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3170 "Return the default file protection for created files.\n\
3171 The value is an integer.")
3177 realmask
= umask (0);
3180 XSETINT (value
, (~ realmask
) & 0777);
3186 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3187 "Tell Unix to finish all pending disk updates.")
3196 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3197 "Return t if file FILE1 is newer than file FILE2.\n\
3198 If FILE1 does not exist, the answer is nil;\n\
3199 otherwise, if FILE2 does not exist, the answer is t.")
3201 Lisp_Object file1
, file2
;
3203 Lisp_Object absname1
, absname2
;
3206 Lisp_Object handler
;
3207 struct gcpro gcpro1
, gcpro2
;
3209 CHECK_STRING (file1
, 0);
3210 CHECK_STRING (file2
, 0);
3213 GCPRO2 (absname1
, file2
);
3214 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3215 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3218 /* If the file name has special constructs in it,
3219 call the corresponding file handler. */
3220 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3222 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3223 if (!NILP (handler
))
3224 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3226 GCPRO2 (absname1
, absname2
);
3227 absname1
= ENCODE_FILE (absname1
);
3228 absname2
= ENCODE_FILE (absname2
);
3231 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3234 mtime1
= st
.st_mtime
;
3236 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3239 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3243 Lisp_Object Qfind_buffer_file_type
;
3246 #ifndef READ_BUF_SIZE
3247 #define READ_BUF_SIZE (64 << 10)
3250 /* This function is called when a function bound to
3251 Vset_auto_coding_function causes some error. At that time, a text
3252 of a file has already been inserted in the current buffer, but,
3253 markers has not yet been adjusted. Thus we must adjust markers
3254 here. We are sure that the buffer was empty before the text of the
3255 file was inserted. */
3258 set_auto_coding_unwind (multibyte
)
3259 Lisp_Object multibyte
;
3261 int inserted
= Z_BYTE
- BEG_BYTE
;
3263 if (!NILP (multibyte
))
3264 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
3265 adjust_after_insert (PT
, PT_BYTE
, Z
, Z_BYTE
, inserted
);
3270 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3272 "Insert contents of file FILENAME after point.\n\
3273 Returns list of absolute file name and number of bytes inserted.\n\
3274 If second argument VISIT is non-nil, the buffer's visited filename\n\
3275 and last save file modtime are set, and it is marked unmodified.\n\
3276 If visiting and the file does not exist, visiting is completed\n\
3277 before the error is signaled.\n\
3278 The optional third and fourth arguments BEG and END\n\
3279 specify what portion of the file to insert.\n\
3280 These arguments count bytes in the file, not characters in the buffer.\n\
3281 If VISIT is non-nil, BEG and END must be nil.\n\
3283 If optional fifth argument REPLACE is non-nil,\n\
3284 it means replace the current buffer contents (in the accessible portion)\n\
3285 with the file contents. This is better than simply deleting and inserting\n\
3286 the whole thing because (1) it preserves some marker positions\n\
3287 and (2) it puts less data in the undo list.\n\
3288 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3289 which is often less than the number of characters to be read.\n\
3291 This does code conversion according to the value of\n\
3292 `coding-system-for-read' or `file-coding-system-alist',\n\
3293 and sets the variable `last-coding-system-used' to the coding system\n\
3295 (filename
, visit
, beg
, end
, replace
)
3296 Lisp_Object filename
, visit
, beg
, end
, replace
;
3301 register int how_much
;
3302 register int unprocessed
;
3303 int count
= specpdl_ptr
- specpdl
;
3304 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3305 Lisp_Object handler
, val
, insval
, orig_filename
;
3308 int not_regular
= 0;
3309 unsigned char read_buf
[READ_BUF_SIZE
];
3310 struct coding_system coding
;
3311 unsigned char buffer
[1 << 14];
3312 int replace_handled
= 0;
3313 int set_coding_system
= 0;
3314 int coding_system_decided
= 0;
3316 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3317 error ("Cannot do file visiting in an indirect buffer");
3319 if (!NILP (current_buffer
->read_only
))
3320 Fbarf_if_buffer_read_only ();
3324 orig_filename
= Qnil
;
3326 GCPRO4 (filename
, val
, p
, orig_filename
);
3328 CHECK_STRING (filename
, 0);
3329 filename
= Fexpand_file_name (filename
, Qnil
);
3331 /* If the file name has special constructs in it,
3332 call the corresponding file handler. */
3333 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3334 if (!NILP (handler
))
3336 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3337 visit
, beg
, end
, replace
);
3338 if (CONSP (val
) && CONSP (XCONS (val
)->cdr
))
3339 inserted
= XINT (XCONS (XCONS (val
)->cdr
)->car
);
3343 orig_filename
= filename
;
3344 filename
= ENCODE_FILE (filename
);
3349 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3351 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3352 || fstat (fd
, &st
) < 0)
3353 #endif /* not APOLLO */
3355 if (fd
>= 0) close (fd
);
3358 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3361 if (!NILP (Vcoding_system_for_read
))
3362 current_buffer
->buffer_file_coding_system
= Vcoding_system_for_read
;
3367 /* This code will need to be changed in order to work on named
3368 pipes, and it's probably just not worth it. So we should at
3369 least signal an error. */
3370 if (!S_ISREG (st
.st_mode
))
3377 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3378 Fsignal (Qfile_error
,
3379 Fcons (build_string ("not a regular file"),
3380 Fcons (orig_filename
, Qnil
)));
3385 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3388 /* Replacement should preserve point as it preserves markers. */
3389 if (!NILP (replace
))
3390 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3392 record_unwind_protect (close_file_unwind
, make_number (fd
));
3394 /* Supposedly happens on VMS. */
3395 if (! not_regular
&& st
.st_size
< 0)
3396 error ("File size is negative");
3398 if (!NILP (beg
) || !NILP (end
))
3400 error ("Attempt to visit less than an entire file");
3403 CHECK_NUMBER (beg
, 0);
3405 XSETFASTINT (beg
, 0);
3408 CHECK_NUMBER (end
, 0);
3413 XSETINT (end
, st
.st_size
);
3414 if (XINT (end
) != st
.st_size
)
3415 error ("Maximum buffer size exceeded");
3421 /* Decide the coding system to use for reading the file now
3422 because we can't use an optimized method for handling
3423 `coding:' tag if the current buffer is not empty. */
3427 if (!NILP (Vcoding_system_for_read
))
3428 val
= Vcoding_system_for_read
;
3429 else if (! NILP (replace
))
3430 /* In REPLACE mode, we can use the same coding system
3431 that was used to visit the file. */
3432 val
= current_buffer
->buffer_file_coding_system
;
3435 /* Don't try looking inside a file for a coding system
3436 specification if it is not seekable. */
3437 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3439 /* Find a coding system specified in the heading two
3440 lines or in the tailing several lines of the file.
3441 We assume that the 1K-byte and 3K-byte for heading
3442 and tailing respectively are sufficient fot this
3444 int how_many
, nread
;
3446 if (st
.st_size
<= (1024 * 4))
3447 nread
= read (fd
, read_buf
, 1024 * 4);
3450 nread
= read (fd
, read_buf
, 1024);
3453 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3454 report_file_error ("Setting file position",
3455 Fcons (orig_filename
, Qnil
));
3456 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3461 error ("IO error reading %s: %s",
3462 XSTRING (orig_filename
)->data
, strerror (errno
));
3465 int count
= specpdl_ptr
- specpdl
;
3466 struct buffer
*prev
= current_buffer
;
3468 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3469 temp_output_buffer_setup (" *code-converting-work*");
3470 set_buffer_internal (XBUFFER (Vstandard_output
));
3471 current_buffer
->enable_multibyte_characters
= Qnil
;
3472 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3473 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3474 val
= call1 (Vset_auto_coding_function
, make_number (nread
));
3475 set_buffer_internal (prev
);
3476 /* Discard the unwind protect for recovering the
3480 /* Rewind the file for the actual read done later. */
3481 if (lseek (fd
, 0, 0) < 0)
3482 report_file_error ("Setting file position",
3483 Fcons (orig_filename
, Qnil
));
3489 /* If we have not yet decided a coding system, check
3490 file-coding-system-alist. */
3491 Lisp_Object args
[6], coding_systems
;
3493 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3494 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3495 coding_systems
= Ffind_operation_coding_system (6, args
);
3496 if (CONSP (coding_systems
))
3497 val
= XCONS (coding_systems
)->car
;
3501 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3503 if (NILP (Vcoding_system_for_read
)
3504 && NILP (current_buffer
->enable_multibyte_characters
))
3505 /* We must suppress all text conversion except for end-of-line
3507 setup_raw_text_coding_system (&coding
);
3509 coding_system_decided
= 1;
3512 /* Ensure we always set Vlast_coding_system_used. */
3513 set_coding_system
= 1;
3515 /* If requested, replace the accessible part of the buffer
3516 with the file contents. Avoid replacing text at the
3517 beginning or end of the buffer that matches the file contents;
3518 that preserves markers pointing to the unchanged parts.
3520 Here we implement this feature in an optimized way
3521 for the case where code conversion is NOT needed.
3522 The following if-statement handles the case of conversion
3523 in a less optimal way.
3525 If the code conversion is "automatic" then we try using this
3526 method and hope for the best.
3527 But if we discover the need for conversion, we give up on this method
3528 and let the following if-statement handle the replace job. */
3531 && ! CODING_REQUIRE_DECODING (&coding
)
3532 && (coding
.eol_type
== CODING_EOL_UNDECIDED
3533 || coding
.eol_type
== CODING_EOL_LF
))
3535 /* same_at_start and same_at_end count bytes,
3536 because file access counts bytes
3537 and BEG and END count bytes. */
3538 int same_at_start
= BEGV_BYTE
;
3539 int same_at_end
= ZV_BYTE
;
3541 /* There is still a possibility we will find the need to do code
3542 conversion. If that happens, we set this variable to 1 to
3543 give up on handling REPLACE in the optimized way. */
3544 int giveup_match_end
= 0;
3546 if (XINT (beg
) != 0)
3548 if (lseek (fd
, XINT (beg
), 0) < 0)
3549 report_file_error ("Setting file position",
3550 Fcons (orig_filename
, Qnil
));
3555 /* Count how many chars at the start of the file
3556 match the text at the beginning of the buffer. */
3561 nread
= read (fd
, buffer
, sizeof buffer
);
3563 error ("IO error reading %s: %s",
3564 XSTRING (orig_filename
)->data
, strerror (errno
));
3565 else if (nread
== 0)
3568 if (coding
.type
== coding_type_undecided
)
3569 detect_coding (&coding
, buffer
, nread
);
3570 if (CODING_REQUIRE_DECODING (&coding
))
3571 /* We found that the file should be decoded somehow.
3572 Let's give up here. */
3574 giveup_match_end
= 1;
3578 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3579 detect_eol (&coding
, buffer
, nread
);
3580 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3581 && coding
.eol_type
!= CODING_EOL_LF
)
3582 /* We found that the format of eol should be decoded.
3583 Let's give up here. */
3585 giveup_match_end
= 1;
3590 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3591 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3592 same_at_start
++, bufpos
++;
3593 /* If we found a discrepancy, stop the scan.
3594 Otherwise loop around and scan the next bufferful. */
3595 if (bufpos
!= nread
)
3599 /* If the file matches the buffer completely,
3600 there's no need to replace anything. */
3601 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3605 /* Truncate the buffer to the size of the file. */
3606 del_range_1 (same_at_start
, same_at_end
, 0);
3611 /* Count how many chars at the end of the file
3612 match the text at the end of the buffer. But, if we have
3613 already found that decoding is necessary, don't waste time. */
3614 while (!giveup_match_end
)
3616 int total_read
, nread
, bufpos
, curpos
, trial
;
3618 /* At what file position are we now scanning? */
3619 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3620 /* If the entire file matches the buffer tail, stop the scan. */
3623 /* How much can we scan in the next step? */
3624 trial
= min (curpos
, sizeof buffer
);
3625 if (lseek (fd
, curpos
- trial
, 0) < 0)
3626 report_file_error ("Setting file position",
3627 Fcons (orig_filename
, Qnil
));
3630 while (total_read
< trial
)
3632 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3634 error ("IO error reading %s: %s",
3635 XSTRING (orig_filename
)->data
, strerror (errno
));
3636 total_read
+= nread
;
3638 /* Scan this bufferful from the end, comparing with
3639 the Emacs buffer. */
3640 bufpos
= total_read
;
3641 /* Compare with same_at_start to avoid counting some buffer text
3642 as matching both at the file's beginning and at the end. */
3643 while (bufpos
> 0 && same_at_end
> same_at_start
3644 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3645 same_at_end
--, bufpos
--;
3647 /* If we found a discrepancy, stop the scan.
3648 Otherwise loop around and scan the preceding bufferful. */
3651 /* If this discrepancy is because of code conversion,
3652 we cannot use this method; giveup and try the other. */
3653 if (same_at_end
> same_at_start
3654 && FETCH_BYTE (same_at_end
- 1) >= 0200
3655 && ! NILP (current_buffer
->enable_multibyte_characters
)
3656 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3657 giveup_match_end
= 1;
3663 if (! giveup_match_end
)
3667 /* We win! We can handle REPLACE the optimized way. */
3669 /* Extends the end of non-matching text area to multibyte
3670 character boundary. */
3671 if (! NILP (current_buffer
->enable_multibyte_characters
))
3672 while (same_at_end
< ZV_BYTE
3673 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3676 /* Don't try to reuse the same piece of text twice. */
3677 overlap
= (same_at_start
- BEGV_BYTE
3678 - (same_at_end
+ st
.st_size
- ZV
));
3680 same_at_end
+= overlap
;
3682 /* Arrange to read only the nonmatching middle part of the file. */
3683 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3684 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3686 del_range_byte (same_at_start
, same_at_end
, 0);
3687 /* Insert from the file at the proper position. */
3688 temp
= BYTE_TO_CHAR (same_at_start
);
3689 SET_PT_BOTH (temp
, same_at_start
);
3691 /* If display currently starts at beginning of line,
3692 keep it that way. */
3693 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3694 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3696 replace_handled
= 1;
3700 /* If requested, replace the accessible part of the buffer
3701 with the file contents. Avoid replacing text at the
3702 beginning or end of the buffer that matches the file contents;
3703 that preserves markers pointing to the unchanged parts.
3705 Here we implement this feature for the case where code conversion
3706 is needed, in a simple way that needs a lot of memory.
3707 The preceding if-statement handles the case of no conversion
3708 in a more optimized way. */
3709 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3711 int same_at_start
= BEGV_BYTE
;
3712 int same_at_end
= ZV_BYTE
;
3715 /* Make sure that the gap is large enough. */
3716 int bufsize
= 2 * st
.st_size
;
3717 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3720 /* First read the whole file, performing code conversion into
3721 CONVERSION_BUFFER. */
3723 if (lseek (fd
, XINT (beg
), 0) < 0)
3725 free (conversion_buffer
);
3726 report_file_error ("Setting file position",
3727 Fcons (orig_filename
, Qnil
));
3730 total
= st
.st_size
; /* Total bytes in the file. */
3731 how_much
= 0; /* Bytes read from file so far. */
3732 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3733 unprocessed
= 0; /* Bytes not processed in previous loop. */
3735 while (how_much
< total
)
3737 /* try is reserved in some compilers (Microsoft C) */
3738 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3739 unsigned char *destination
= read_buf
+ unprocessed
;
3742 /* Allow quitting out of the actual I/O. */
3745 this = read (fd
, destination
, trytry
);
3748 if (this < 0 || this + unprocessed
== 0)
3756 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3758 int require
, result
;
3760 this += unprocessed
;
3762 /* If we are using more space than estimated,
3763 make CONVERSION_BUFFER bigger. */
3764 require
= decoding_buffer_size (&coding
, this);
3765 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3767 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3768 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3771 /* Convert this batch with results in CONVERSION_BUFFER. */
3772 if (how_much
>= total
) /* This is the last block. */
3773 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3774 result
= decode_coding (&coding
, read_buf
,
3775 conversion_buffer
+ inserted
,
3776 this, bufsize
- inserted
);
3778 /* Save for next iteration whatever we didn't convert. */
3779 unprocessed
= this - coding
.consumed
;
3780 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
3781 this = coding
.produced
;
3787 /* At this point, INSERTED is how many characters (i.e. bytes)
3788 are present in CONVERSION_BUFFER.
3789 HOW_MUCH should equal TOTAL,
3790 or should be <= 0 if we couldn't read the file. */
3794 free (conversion_buffer
);
3797 error ("IO error reading %s: %s",
3798 XSTRING (orig_filename
)->data
, strerror (errno
));
3799 else if (how_much
== -2)
3800 error ("maximum buffer size exceeded");
3803 /* Compare the beginning of the converted file
3804 with the buffer text. */
3807 while (bufpos
< inserted
&& same_at_start
< same_at_end
3808 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3809 same_at_start
++, bufpos
++;
3811 /* If the file matches the buffer completely,
3812 there's no need to replace anything. */
3814 if (bufpos
== inserted
)
3816 free (conversion_buffer
);
3819 /* Truncate the buffer to the size of the file. */
3820 del_range_1 (same_at_start
, same_at_end
, 0);
3824 /* Scan this bufferful from the end, comparing with
3825 the Emacs buffer. */
3828 /* Compare with same_at_start to avoid counting some buffer text
3829 as matching both at the file's beginning and at the end. */
3830 while (bufpos
> 0 && same_at_end
> same_at_start
3831 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3832 same_at_end
--, bufpos
--;
3834 /* Don't try to reuse the same piece of text twice. */
3835 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3837 same_at_end
+= overlap
;
3839 /* If display currently starts at beginning of line,
3840 keep it that way. */
3841 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3842 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3844 /* Replace the chars that we need to replace,
3845 and update INSERTED to equal the number of bytes
3846 we are taking from the file. */
3847 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
3848 del_range_byte (same_at_start
, same_at_end
, 0);
3849 if (same_at_end
!= same_at_start
)
3850 SET_PT_BOTH (GPT
, GPT_BYTE
);
3853 /* Insert from the file at the proper position. */
3854 temp
= BYTE_TO_CHAR (same_at_start
);
3855 SET_PT_BOTH (temp
, same_at_start
);
3858 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
3861 free (conversion_buffer
);
3870 register Lisp_Object temp
;
3872 total
= XINT (end
) - XINT (beg
);
3874 /* Make sure point-max won't overflow after this insertion. */
3875 XSETINT (temp
, total
);
3876 if (total
!= XINT (temp
))
3877 error ("Maximum buffer size exceeded");
3880 /* For a special file, all we can do is guess. */
3881 total
= READ_BUF_SIZE
;
3883 if (NILP (visit
) && total
> 0)
3884 prepare_to_modify_buffer (PT
, PT
, NULL
);
3887 if (GAP_SIZE
< total
)
3888 make_gap (total
- GAP_SIZE
);
3890 if (XINT (beg
) != 0 || !NILP (replace
))
3892 if (lseek (fd
, XINT (beg
), 0) < 0)
3893 report_file_error ("Setting file position",
3894 Fcons (orig_filename
, Qnil
));
3897 /* In the following loop, HOW_MUCH contains the total bytes read so
3898 far for a regular file, and not changed for a special file. But,
3899 before exiting the loop, it is set to a negative value if I/O
3902 /* Total bytes inserted. */
3904 /* Here, we don't do code conversion in the loop. It is done by
3905 code_convert_region after all data are read into the buffer. */
3906 while (how_much
< total
)
3908 /* try is reserved in some compilers (Microsoft C) */
3909 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3912 /* For a special file, GAP_SIZE should be checked every time. */
3913 if (not_regular
&& GAP_SIZE
< trytry
)
3914 make_gap (total
- GAP_SIZE
);
3916 /* Allow quitting out of the actual I/O. */
3919 this = read (fd
, BYTE_POS_ADDR (PT_BYTE
+ inserted
- 1) + 1, trytry
);
3936 /* For a regular file, where TOTAL is the real size,
3937 count HOW_MUCH to compare with it.
3938 For a special file, where TOTAL is just a buffer size,
3939 so don't bother counting in HOW_MUCH.
3940 (INSERTED is where we count the number of characters inserted.) */
3947 /* Put an anchor to ensure multi-byte form ends at gap. */
3952 /* Discard the unwind protect for closing the file. */
3956 error ("IO error reading %s: %s",
3957 XSTRING (orig_filename
)->data
, strerror (errno
));
3961 if (! coding_system_decided
)
3963 /* The coding system is not yet decided. Decide it by an
3964 optimized method for handling `coding:' tag. */
3968 if (!NILP (Vcoding_system_for_read
))
3969 val
= Vcoding_system_for_read
;
3972 if (! NILP (Vset_auto_coding_function
))
3974 /* Since we are sure that the current buffer was
3975 empty before the insertion, we can toggle
3976 enable-multibyte-characters directly here without
3977 taking care of marker adjustment and byte
3978 combining problem. */
3979 Lisp_Object prev_multibyte
;
3980 int count
= specpdl_ptr
- specpdl
;
3982 prev_multibyte
= current_buffer
->enable_multibyte_characters
;
3983 current_buffer
->enable_multibyte_characters
= Qnil
;
3984 record_unwind_protect (set_auto_coding_unwind
,
3986 val
= call1 (Vset_auto_coding_function
,
3987 make_number (inserted
));
3988 /* Discard the unwind protect for recovering the
3989 error of Vset_auto_coding_function. */
3991 current_buffer
->enable_multibyte_characters
= prev_multibyte
;
3992 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3997 /* If the coding system is not yet decided, check
3998 file-coding-system-alist. */
3999 Lisp_Object args
[6], coding_systems
;
4001 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4002 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4003 coding_systems
= Ffind_operation_coding_system (6, args
);
4004 if (CONSP (coding_systems
))
4005 val
= XCONS (coding_systems
)->car
;
4009 /* The following kludgy code is to avoid some compiler bug.
4011 setup_coding_system (val, &coding);
4014 struct coding_system temp_coding
;
4015 setup_coding_system (val
, &temp_coding
);
4016 bcopy (&temp_coding
, &coding
, sizeof coding
);
4019 if (NILP (Vcoding_system_for_read
)
4020 && NILP (current_buffer
->enable_multibyte_characters
))
4021 /* We must suppress all text conversion except for
4022 end-of-line conversion. */
4023 setup_raw_text_coding_system (&coding
);
4026 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4028 /* Here, we don't have to consider byte combining (see the
4029 comment below) because code_convert_region takes care of
4031 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4033 inserted
= (NILP (current_buffer
->enable_multibyte_characters
)
4034 ? coding
.produced
: coding
.produced_char
);
4036 else if (!NILP (current_buffer
->enable_multibyte_characters
))
4038 int inserted_byte
= inserted
;
4040 /* There's a possibility that we must combine bytes at the
4041 head (resp. the tail) of the just inserted text with the
4042 bytes before (resp. after) the gap to form a single
4044 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
4045 adjust_after_insert (PT
, PT_BYTE
,
4046 PT
+ inserted_byte
, PT_BYTE
+ inserted_byte
,
4050 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4054 /* Use the conversion type to determine buffer-file-type
4055 (find-buffer-file-type is now used to help determine the
4057 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4058 || coding
.eol_type
== CODING_EOL_LF
)
4059 && ! CODING_REQUIRE_DECODING (&coding
))
4060 current_buffer
->buffer_file_type
= Qt
;
4062 current_buffer
->buffer_file_type
= Qnil
;
4071 if (!EQ (current_buffer
->undo_list
, Qt
))
4072 current_buffer
->undo_list
= Qnil
;
4074 stat (XSTRING (filename
)->data
, &st
);
4079 current_buffer
->modtime
= st
.st_mtime
;
4080 current_buffer
->filename
= orig_filename
;
4083 SAVE_MODIFF
= MODIFF
;
4084 current_buffer
->auto_save_modified
= MODIFF
;
4085 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4086 #ifdef CLASH_DETECTION
4089 if (!NILP (current_buffer
->file_truename
))
4090 unlock_file (current_buffer
->file_truename
);
4091 unlock_file (filename
);
4093 #endif /* CLASH_DETECTION */
4095 Fsignal (Qfile_error
,
4096 Fcons (build_string ("not a regular file"),
4097 Fcons (orig_filename
, Qnil
)));
4099 /* If visiting nonexistent file, return nil. */
4100 if (current_buffer
->modtime
== -1)
4101 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4104 /* Decode file format */
4107 insval
= call3 (Qformat_decode
,
4108 Qnil
, make_number (inserted
), visit
);
4109 CHECK_NUMBER (insval
, 0);
4110 inserted
= XFASTINT (insval
);
4113 /* Call after-change hooks for the inserted text, aside from the case
4114 of normal visiting (not with REPLACE), which is done in a new buffer
4115 "before" the buffer is changed. */
4116 if (inserted
> 0 && total
> 0
4117 && (NILP (visit
) || !NILP (replace
)))
4118 signal_after_change (PT
, 0, inserted
);
4120 if (set_coding_system
&& inserted
> 0)
4121 Vlast_coding_system_used
= coding
.symbol
;
4125 p
= Vafter_insert_file_functions
;
4128 insval
= call1 (Fcar (p
), make_number (inserted
));
4131 CHECK_NUMBER (insval
, 0);
4132 inserted
= XFASTINT (insval
);
4139 /* ??? Retval needs to be dealt with in all cases consistently. */
4141 val
= Fcons (orig_filename
,
4142 Fcons (make_number (inserted
),
4145 RETURN_UNGCPRO (unbind_to (count
, val
));
4148 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
4151 /* If build_annotations switched buffers, switch back to BUF.
4152 Kill the temporary buffer that was selected in the meantime.
4154 Since this kill only the last temporary buffer, some buffers remain
4155 not killed if build_annotations switched buffers more than once.
4159 build_annotations_unwind (buf
)
4164 if (XBUFFER (buf
) == current_buffer
)
4166 tembuf
= Fcurrent_buffer ();
4168 Fkill_buffer (tembuf
);
4172 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4173 "r\nFWrite region to file: \ni\ni\ni\np",
4174 "Write current region into specified file.\n\
4175 When called from a program, takes three arguments:\n\
4176 START, END and FILENAME. START and END are buffer positions.\n\
4177 Optional fourth argument APPEND if non-nil means\n\
4178 append to existing file contents (if any).\n\
4179 Optional fifth argument VISIT if t means\n\
4180 set the last-save-file-modtime of buffer to this file's modtime\n\
4181 and mark buffer not modified.\n\
4182 If VISIT is a string, it is a second file name;\n\
4183 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
4184 VISIT is also the file name to lock and unlock for clash detection.\n\
4185 If VISIT is neither t nor nil nor a string,\n\
4186 that means do not print the \"Wrote file\" message.\n\
4187 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
4188 use for locking and unlocking, overriding FILENAME and VISIT.\n\
4189 The optional seventh arg CONFIRM, if non-nil, says ask for confirmation\n\
4190 before overwriting an existing file.\n\
4191 Kludgy feature: if START is a string, then that string is written\n\
4192 to the file, instead of any buffer contents, and END is ignored.\n\
4194 This does code conversion according to the value of\n\
4195 `coding-system-for-write', `buffer-file-coding-system', or\n\
4196 `file-coding-system-alist', and sets the variable\n\
4197 `last-coding-system-used' to the coding system actually used.")
4199 (start
, end
, filename
, append
, visit
, lockname
, confirm
)
4200 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, confirm
;
4208 int count
= specpdl_ptr
- specpdl
;
4211 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4213 Lisp_Object handler
;
4214 Lisp_Object visit_file
;
4215 Lisp_Object annotations
;
4216 Lisp_Object encoded_filename
;
4217 int visiting
, quietly
;
4218 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4219 struct buffer
*given_buffer
;
4221 int buffer_file_type
= O_BINARY
;
4223 struct coding_system coding
;
4225 if (current_buffer
->base_buffer
&& ! NILP (visit
))
4226 error ("Cannot do file visiting in an indirect buffer");
4228 if (!NILP (start
) && !STRINGP (start
))
4229 validate_region (&start
, &end
);
4231 GCPRO4 (start
, filename
, visit
, lockname
);
4233 /* Decide the coding-system to encode the data with. */
4239 else if (!NILP (Vcoding_system_for_write
))
4240 val
= Vcoding_system_for_write
;
4241 else if (NILP (current_buffer
->enable_multibyte_characters
))
4243 /* If the variable `buffer-file-coding-system' is set locally,
4244 it means that the file was read with some kind of code
4245 conversion or the varialbe is explicitely set by users. We
4246 had better write it out with the same coding system even if
4247 `enable-multibyte-characters' is nil.
4249 If it is not set locally, we anyway have to convert EOL
4250 format if the default value of `buffer-file-coding-system'
4251 tells that it is not Unix-like (LF only) format. */
4252 val
= current_buffer
->buffer_file_coding_system
;
4253 if (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4255 struct coding_system coding_temp
;
4257 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
4258 if (coding_temp
.eol_type
== CODING_EOL_CRLF
4259 || coding_temp
.eol_type
== CODING_EOL_CR
)
4261 setup_coding_system (Qraw_text
, &coding
);
4262 coding
.eol_type
= coding_temp
.eol_type
;
4263 goto done_setup_coding
;
4270 Lisp_Object args
[7], coding_systems
;
4272 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4273 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4275 coding_systems
= Ffind_operation_coding_system (7, args
);
4276 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
4277 ? XCONS (coding_systems
)->cdr
4278 : current_buffer
->buffer_file_coding_system
);
4279 /* Confirm that VAL can surely encode the current region. */
4280 if (!NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4281 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4283 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4286 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4287 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4290 Vlast_coding_system_used
= coding
.symbol
;
4292 filename
= Fexpand_file_name (filename
, Qnil
);
4294 if (! NILP (confirm
))
4295 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4297 if (STRINGP (visit
))
4298 visit_file
= Fexpand_file_name (visit
, Qnil
);
4300 visit_file
= filename
;
4303 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4304 quietly
= !NILP (visit
);
4308 if (NILP (lockname
))
4309 lockname
= visit_file
;
4311 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4313 /* If the file name has special constructs in it,
4314 call the corresponding file handler. */
4315 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4316 /* If FILENAME has no handler, see if VISIT has one. */
4317 if (NILP (handler
) && STRINGP (visit
))
4318 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4320 if (!NILP (handler
))
4323 val
= call6 (handler
, Qwrite_region
, start
, end
,
4324 filename
, append
, visit
);
4328 SAVE_MODIFF
= MODIFF
;
4329 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4330 current_buffer
->filename
= visit_file
;
4336 /* Special kludge to simplify auto-saving. */
4339 XSETFASTINT (start
, BEG
);
4340 XSETFASTINT (end
, Z
);
4343 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4344 count1
= specpdl_ptr
- specpdl
;
4346 given_buffer
= current_buffer
;
4347 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4348 if (current_buffer
!= given_buffer
)
4350 XSETFASTINT (start
, BEGV
);
4351 XSETFASTINT (end
, ZV
);
4354 #ifdef CLASH_DETECTION
4357 #if 0 /* This causes trouble for GNUS. */
4358 /* If we've locked this file for some other buffer,
4359 query before proceeding. */
4360 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4361 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4364 lock_file (lockname
);
4366 #endif /* CLASH_DETECTION */
4368 encoded_filename
= ENCODE_FILE (filename
);
4370 fn
= XSTRING (encoded_filename
)->data
;
4374 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4375 #else /* not DOS_NT */
4376 desc
= open (fn
, O_WRONLY
);
4377 #endif /* not DOS_NT */
4379 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4381 if (auto_saving
) /* Overwrite any previous version of autosave file */
4383 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4384 desc
= open (fn
, O_RDWR
);
4386 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4387 ? XSTRING (current_buffer
->filename
)->data
: 0,
4390 else /* Write to temporary name and rename if no errors */
4392 Lisp_Object temp_name
;
4393 temp_name
= Ffile_name_directory (filename
);
4395 if (!NILP (temp_name
))
4397 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4398 build_string ("$$SAVE$$")));
4399 fname
= XSTRING (filename
)->data
;
4400 fn
= XSTRING (temp_name
)->data
;
4401 desc
= creat_copy_attrs (fname
, fn
);
4404 /* If we can't open the temporary file, try creating a new
4405 version of the original file. VMS "creat" creates a
4406 new version rather than truncating an existing file. */
4409 desc
= creat (fn
, 0666);
4410 #if 0 /* This can clobber an existing file and fail to replace it,
4411 if the user runs out of space. */
4414 /* We can't make a new version;
4415 try to truncate and rewrite existing version if any. */
4417 desc
= open (fn
, O_RDWR
);
4423 desc
= creat (fn
, 0666);
4428 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4429 S_IREAD
| S_IWRITE
);
4430 #else /* not DOS_NT */
4431 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4432 #endif /* not DOS_NT */
4433 #endif /* not VMS */
4439 #ifdef CLASH_DETECTION
4441 if (!auto_saving
) unlock_file (lockname
);
4443 #endif /* CLASH_DETECTION */
4444 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4447 record_unwind_protect (close_file_unwind
, make_number (desc
));
4450 if (lseek (desc
, 0, 2) < 0)
4452 #ifdef CLASH_DETECTION
4453 if (!auto_saving
) unlock_file (lockname
);
4454 #endif /* CLASH_DETECTION */
4455 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4460 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4461 * if we do writes that don't end with a carriage return. Furthermore
4462 * it cannot handle writes of more then 16K. The modified
4463 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4464 * this EXCEPT for the last record (iff it doesn't end with a carriage
4465 * return). This implies that if your buffer doesn't end with a carriage
4466 * return, you get one free... tough. However it also means that if
4467 * we make two calls to sys_write (a la the following code) you can
4468 * get one at the gap as well. The easiest way to fix this (honest)
4469 * is to move the gap to the next newline (or the end of the buffer).
4474 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4475 move_gap (find_next_newline (GPT
, 1));
4477 /* Whether VMS or not, we must move the gap to the next of newline
4478 when we must put designation sequences at beginning of line. */
4479 if (INTEGERP (start
)
4480 && coding
.type
== coding_type_iso2022
4481 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4482 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4484 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4485 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4486 move_gap_both (PT
, PT_BYTE
);
4487 SET_PT_BOTH (opoint
, opoint_byte
);
4494 if (STRINGP (start
))
4496 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4497 STRING_BYTES (XSTRING (start
)), 0, &annotations
,
4501 else if (XINT (start
) != XINT (end
))
4503 register int end1
= CHAR_TO_BYTE (XINT (end
));
4505 tem
= CHAR_TO_BYTE (XINT (start
));
4507 if (XINT (start
) < GPT
)
4509 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
),
4510 min (GPT_BYTE
, end1
) - tem
, tem
, &annotations
,
4515 if (XINT (end
) > GPT
&& !failure
)
4517 tem
= max (tem
, GPT_BYTE
);
4518 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
), end1
- tem
,
4519 tem
, &annotations
, &coding
);
4525 /* If file was empty, still need to write the annotations */
4526 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4527 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4531 if (CODING_REQUIRE_FLUSHING (&coding
)
4532 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4535 /* We have to flush out a data. */
4536 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4537 failure
= 0 > e_write (desc
, "", 0, &coding
);
4544 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4545 Disk full in NFS may be reported here. */
4546 /* mib says that closing the file will try to write as fast as NFS can do
4547 it, and that means the fsync here is not crucial for autosave files. */
4548 if (!auto_saving
&& fsync (desc
) < 0)
4550 /* If fsync fails with EINTR, don't treat that as serious. */
4552 failure
= 1, save_errno
= errno
;
4556 /* Spurious "file has changed on disk" warnings have been
4557 observed on Suns as well.
4558 It seems that `close' can change the modtime, under nfs.
4560 (This has supposedly been fixed in Sunos 4,
4561 but who knows about all the other machines with NFS?) */
4564 /* On VMS and APOLLO, must do the stat after the close
4565 since closing changes the modtime. */
4568 /* Recall that #if defined does not work on VMS. */
4575 /* NFS can report a write failure now. */
4576 if (close (desc
) < 0)
4577 failure
= 1, save_errno
= errno
;
4580 /* If we wrote to a temporary name and had no errors, rename to real name. */
4584 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4592 /* Discard the unwind protect for close_file_unwind. */
4593 specpdl_ptr
= specpdl
+ count1
;
4594 /* Restore the original current buffer. */
4595 visit_file
= unbind_to (count
, visit_file
);
4597 #ifdef CLASH_DETECTION
4599 unlock_file (lockname
);
4600 #endif /* CLASH_DETECTION */
4602 /* Do this before reporting IO error
4603 to avoid a "file has changed on disk" warning on
4604 next attempt to save. */
4606 current_buffer
->modtime
= st
.st_mtime
;
4609 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4610 strerror (save_errno
));
4614 SAVE_MODIFF
= MODIFF
;
4615 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4616 current_buffer
->filename
= visit_file
;
4617 update_mode_lines
++;
4623 message_with_string ("Wrote %s", visit_file
, 1);
4628 Lisp_Object
merge ();
4630 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4631 "Return t if (car A) is numerically less than (car B).")
4635 return Flss (Fcar (a
), Fcar (b
));
4638 /* Build the complete list of annotations appropriate for writing out
4639 the text between START and END, by calling all the functions in
4640 write-region-annotate-functions and merging the lists they return.
4641 If one of these functions switches to a different buffer, we assume
4642 that buffer contains altered text. Therefore, the caller must
4643 make sure to restore the current buffer in all cases,
4644 as save-excursion would do. */
4647 build_annotations (start
, end
, pre_write_conversion
)
4648 Lisp_Object start
, end
, pre_write_conversion
;
4650 Lisp_Object annotations
;
4652 struct gcpro gcpro1
, gcpro2
;
4653 Lisp_Object original_buffer
;
4655 XSETBUFFER (original_buffer
, current_buffer
);
4658 p
= Vwrite_region_annotate_functions
;
4659 GCPRO2 (annotations
, p
);
4662 struct buffer
*given_buffer
= current_buffer
;
4663 Vwrite_region_annotations_so_far
= annotations
;
4664 res
= call2 (Fcar (p
), start
, end
);
4665 /* If the function makes a different buffer current,
4666 assume that means this buffer contains altered text to be output.
4667 Reset START and END from the buffer bounds
4668 and discard all previous annotations because they should have
4669 been dealt with by this function. */
4670 if (current_buffer
!= given_buffer
)
4672 XSETFASTINT (start
, BEGV
);
4673 XSETFASTINT (end
, ZV
);
4676 Flength (res
); /* Check basic validity of return value */
4677 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4681 /* Now do the same for annotation functions implied by the file-format */
4682 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4683 p
= Vauto_save_file_format
;
4685 p
= current_buffer
->file_format
;
4688 struct buffer
*given_buffer
= current_buffer
;
4689 Vwrite_region_annotations_so_far
= annotations
;
4690 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4692 if (current_buffer
!= given_buffer
)
4694 XSETFASTINT (start
, BEGV
);
4695 XSETFASTINT (end
, ZV
);
4699 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4703 /* At last, do the same for the function PRE_WRITE_CONVERSION
4704 implied by the current coding-system. */
4705 if (!NILP (pre_write_conversion
))
4707 struct buffer
*given_buffer
= current_buffer
;
4708 Vwrite_region_annotations_so_far
= annotations
;
4709 res
= call2 (pre_write_conversion
, start
, end
);
4711 annotations
= (current_buffer
!= given_buffer
4713 : merge (annotations
, res
, Qcar_less_than_car
));
4720 /* Write to descriptor DESC the NBYTES bytes starting at ADDR,
4721 assuming they start at byte position BYTEPOS in the buffer.
4722 Intersperse with them the annotations from *ANNOT
4723 which fall within the range of byte positions BYTEPOS to BYTEPOS + NBYTES,
4724 each at its appropriate position.
4726 We modify *ANNOT by discarding elements as we use them up.
4728 The return value is negative in case of system call failure. */
4731 a_write (desc
, addr
, nbytes
, bytepos
, annot
, coding
)
4733 register char *addr
;
4734 register int nbytes
;
4737 struct coding_system
*coding
;
4741 int lastpos
= bytepos
+ nbytes
;
4743 while (NILP (*annot
) || CONSP (*annot
))
4745 tem
= Fcar_safe (Fcar (*annot
));
4746 nextpos
= bytepos
- 1;
4748 nextpos
= CHAR_TO_BYTE (XFASTINT (tem
));
4750 /* If there are no more annotations in this range,
4751 output the rest of the range all at once. */
4752 if (! (nextpos
>= bytepos
&& nextpos
<= lastpos
))
4753 return e_write (desc
, addr
, lastpos
- bytepos
, coding
);
4755 /* Output buffer text up to the next annotation's position. */
4756 if (nextpos
> bytepos
)
4758 if (0 > e_write (desc
, addr
, nextpos
- bytepos
, coding
))
4760 addr
+= nextpos
- bytepos
;
4763 /* Output the annotation. */
4764 tem
= Fcdr (Fcar (*annot
));
4767 if (0 > e_write (desc
, XSTRING (tem
)->data
, STRING_BYTES (XSTRING (tem
)),
4771 *annot
= Fcdr (*annot
);
4776 #ifndef WRITE_BUF_SIZE
4777 #define WRITE_BUF_SIZE (16 * 1024)
4780 /* Write NBYTES bytes starting at ADDR into descriptor DESC,
4781 encoding them with coding system CODING. */
4784 e_write (desc
, addr
, nbytes
, coding
)
4786 register char *addr
;
4787 register int nbytes
;
4788 struct coding_system
*coding
;
4790 char buf
[WRITE_BUF_SIZE
];
4792 /* We used to have a code for handling selective display here. But,
4793 now it is handled within encode_coding. */
4798 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
4799 nbytes
-= coding
->consumed
, addr
+= coding
->consumed
;
4800 if (coding
->produced
> 0)
4802 coding
->produced
-= write (desc
, buf
, coding
->produced
);
4803 if (coding
->produced
) return -1;
4805 if (result
== CODING_FINISH_INSUFFICIENT_SRC
)
4807 /* The source text ends by an incomplete multibyte form.
4808 There's no way other than write it out as is. */
4809 nbytes
-= write (desc
, addr
, nbytes
);
4810 if (nbytes
) return -1;
4818 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4819 Sverify_visited_file_modtime
, 1, 1, 0,
4820 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4821 This means that the file has not been changed since it was visited or saved.")
4827 Lisp_Object handler
;
4828 Lisp_Object filename
;
4830 CHECK_BUFFER (buf
, 0);
4833 if (!STRINGP (b
->filename
)) return Qt
;
4834 if (b
->modtime
== 0) return Qt
;
4836 /* If the file name has special constructs in it,
4837 call the corresponding file handler. */
4838 handler
= Ffind_file_name_handler (b
->filename
,
4839 Qverify_visited_file_modtime
);
4840 if (!NILP (handler
))
4841 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4843 filename
= ENCODE_FILE (b
->filename
);
4845 if (stat (XSTRING (filename
)->data
, &st
) < 0)
4847 /* If the file doesn't exist now and didn't exist before,
4848 we say that it isn't modified, provided the error is a tame one. */
4849 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4854 if (st
.st_mtime
== b
->modtime
4855 /* If both are positive, accept them if they are off by one second. */
4856 || (st
.st_mtime
> 0 && b
->modtime
> 0
4857 && (st
.st_mtime
== b
->modtime
+ 1
4858 || st
.st_mtime
== b
->modtime
- 1)))
4863 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4864 Sclear_visited_file_modtime
, 0, 0, 0,
4865 "Clear out records of last mod time of visited file.\n\
4866 Next attempt to save will certainly not complain of a discrepancy.")
4869 current_buffer
->modtime
= 0;
4873 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4874 Svisited_file_modtime
, 0, 0, 0,
4875 "Return the current buffer's recorded visited file modification time.\n\
4876 The value is a list of the form (HIGH . LOW), like the time values\n\
4877 that `file-attributes' returns.")
4880 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4883 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4884 Sset_visited_file_modtime
, 0, 1, 0,
4885 "Update buffer's recorded modification time from the visited file's time.\n\
4886 Useful if the buffer was not read from the file normally\n\
4887 or if the file itself has been changed for some known benign reason.\n\
4888 An argument specifies the modification time value to use\n\
4889 \(instead of that of the visited file), in the form of a list\n\
4890 \(HIGH . LOW) or (HIGH LOW).")
4892 Lisp_Object time_list
;
4894 if (!NILP (time_list
))
4895 current_buffer
->modtime
= cons_to_long (time_list
);
4898 register Lisp_Object filename
;
4900 Lisp_Object handler
;
4902 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4904 /* If the file name has special constructs in it,
4905 call the corresponding file handler. */
4906 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4907 if (!NILP (handler
))
4908 /* The handler can find the file name the same way we did. */
4909 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4911 filename
= ENCODE_FILE (filename
);
4913 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4914 current_buffer
->modtime
= st
.st_mtime
;
4924 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 1);
4925 Fsleep_for (make_number (1), Qnil
);
4926 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4927 Fsleep_for (make_number (1), Qnil
);
4928 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4929 Fsleep_for (make_number (1), Qnil
);
4939 /* Get visited file's mode to become the auto save file's mode. */
4940 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4941 /* But make sure we can overwrite it later! */
4942 auto_save_mode_bits
= st
.st_mode
| 0600;
4944 auto_save_mode_bits
= 0666;
4947 Fwrite_region (Qnil
, Qnil
,
4948 current_buffer
->auto_save_file_name
,
4949 Qnil
, Qlambda
, Qnil
, Qnil
);
4953 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4958 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4959 | XFASTINT (XCONS (stream
)->cdr
)));
4964 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4967 minibuffer_auto_raise
= XINT (value
);
4971 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4972 "Auto-save all buffers that need it.\n\
4973 This is all buffers that have auto-saving enabled\n\
4974 and are changed since last auto-saved.\n\
4975 Auto-saving writes the buffer into a file\n\
4976 so that your editing is not lost if the system crashes.\n\
4977 This file is not the file you visited; that changes only when you save.\n\
4978 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4979 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4980 A non-nil CURRENT-ONLY argument means save only current buffer.")
4981 (no_message
, current_only
)
4982 Lisp_Object no_message
, current_only
;
4984 struct buffer
*old
= current_buffer
, *b
;
4985 Lisp_Object tail
, buf
;
4987 char *omessage
= echo_area_glyphs
;
4988 int omessage_length
= echo_area_glyphs_length
;
4989 int oldmultibyte
= message_enable_multibyte
;
4990 int do_handled_files
;
4993 Lisp_Object lispstream
;
4994 int count
= specpdl_ptr
- specpdl
;
4996 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4998 /* Ordinarily don't quit within this function,
4999 but don't make it impossible to quit (in case we get hung in I/O). */
5003 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5004 point to non-strings reached from Vbuffer_alist. */
5009 if (!NILP (Vrun_hooks
))
5010 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5012 if (STRINGP (Vauto_save_list_file_name
))
5014 Lisp_Object listfile
;
5015 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5016 stream
= fopen (XSTRING (listfile
)->data
, "w");
5019 /* Arrange to close that file whether or not we get an error.
5020 Also reset auto_saving to 0. */
5021 lispstream
= Fcons (Qnil
, Qnil
);
5022 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
5023 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
5034 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5035 record_unwind_protect (do_auto_save_unwind_1
,
5036 make_number (minibuffer_auto_raise
));
5037 minibuffer_auto_raise
= 0;
5040 /* First, save all files which don't have handlers. If Emacs is
5041 crashing, the handlers may tweak what is causing Emacs to crash
5042 in the first place, and it would be a shame if Emacs failed to
5043 autosave perfectly ordinary files because it couldn't handle some
5045 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5046 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
5048 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
5051 /* Record all the buffers that have auto save mode
5052 in the special file that lists them. For each of these buffers,
5053 Record visited name (if any) and auto save name. */
5054 if (STRINGP (b
->auto_save_file_name
)
5055 && stream
!= NULL
&& do_handled_files
== 0)
5057 if (!NILP (b
->filename
))
5059 fwrite (XSTRING (b
->filename
)->data
, 1,
5060 STRING_BYTES (XSTRING (b
->filename
)), stream
);
5062 putc ('\n', stream
);
5063 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
5064 STRING_BYTES (XSTRING (b
->auto_save_file_name
)), stream
);
5065 putc ('\n', stream
);
5068 if (!NILP (current_only
)
5069 && b
!= current_buffer
)
5072 /* Don't auto-save indirect buffers.
5073 The base buffer takes care of it. */
5077 /* Check for auto save enabled
5078 and file changed since last auto save
5079 and file changed since last real save. */
5080 if (STRINGP (b
->auto_save_file_name
)
5081 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5082 && b
->auto_save_modified
< BUF_MODIFF (b
)
5083 /* -1 means we've turned off autosaving for a while--see below. */
5084 && XINT (b
->save_length
) >= 0
5085 && (do_handled_files
5086 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5089 EMACS_TIME before_time
, after_time
;
5091 EMACS_GET_TIME (before_time
);
5093 /* If we had a failure, don't try again for 20 minutes. */
5094 if (b
->auto_save_failure_time
>= 0
5095 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5098 if ((XFASTINT (b
->save_length
) * 10
5099 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5100 /* A short file is likely to change a large fraction;
5101 spare the user annoying messages. */
5102 && XFASTINT (b
->save_length
) > 5000
5103 /* These messages are frequent and annoying for `*mail*'. */
5104 && !EQ (b
->filename
, Qnil
)
5105 && NILP (no_message
))
5107 /* It has shrunk too much; turn off auto-saving here. */
5108 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5109 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
5111 minibuffer_auto_raise
= 0;
5112 /* Turn off auto-saving until there's a real save,
5113 and prevent any more warnings. */
5114 XSETINT (b
->save_length
, -1);
5115 Fsleep_for (make_number (1), Qnil
);
5118 set_buffer_internal (b
);
5119 if (!auto_saved
&& NILP (no_message
))
5120 message1 ("Auto-saving...");
5121 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5123 b
->auto_save_modified
= BUF_MODIFF (b
);
5124 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5125 set_buffer_internal (old
);
5127 EMACS_GET_TIME (after_time
);
5129 /* If auto-save took more than 60 seconds,
5130 assume it was an NFS failure that got a timeout. */
5131 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5132 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5136 /* Prevent another auto save till enough input events come in. */
5137 record_auto_save ();
5139 if (auto_saved
&& NILP (no_message
))
5143 sit_for (1, 0, 0, 0, 0);
5144 message2 (omessage
, omessage_length
, oldmultibyte
);
5147 message1 ("Auto-saving...done");
5152 unbind_to (count
, Qnil
);
5156 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5157 Sset_buffer_auto_saved
, 0, 0, 0,
5158 "Mark current buffer as auto-saved with its current text.\n\
5159 No auto-save file will be written until the buffer changes again.")
5162 current_buffer
->auto_save_modified
= MODIFF
;
5163 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5164 current_buffer
->auto_save_failure_time
= -1;
5168 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5169 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5170 "Clear any record of a recent auto-save failure in the current buffer.")
5173 current_buffer
->auto_save_failure_time
= -1;
5177 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5179 "Return t if buffer has been auto-saved since last read in or saved.")
5182 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5185 /* Reading and completing file names */
5186 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5188 /* In the string VAL, change each $ to $$ and return the result. */
5191 double_dollars (val
)
5194 register unsigned char *old
, *new;
5198 osize
= STRING_BYTES (XSTRING (val
));
5200 /* Count the number of $ characters. */
5201 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
5202 if (*old
++ == '$') count
++;
5205 old
= XSTRING (val
)->data
;
5206 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
5208 new = XSTRING (val
)->data
;
5209 for (n
= osize
; n
> 0; n
--)
5222 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5224 "Internal subroutine for read-file-name. Do not call this.")
5225 (string
, dir
, action
)
5226 Lisp_Object string
, dir
, action
;
5227 /* action is nil for complete, t for return list of completions,
5228 lambda for verify final value */
5230 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5232 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5234 CHECK_STRING (string
, 0);
5241 /* No need to protect ACTION--we only compare it with t and nil. */
5242 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5244 if (XSTRING (string
)->size
== 0)
5246 if (EQ (action
, Qlambda
))
5254 orig_string
= string
;
5255 string
= Fsubstitute_in_file_name (string
);
5256 changed
= NILP (Fstring_equal (string
, orig_string
));
5257 name
= Ffile_name_nondirectory (string
);
5258 val
= Ffile_name_directory (string
);
5260 realdir
= Fexpand_file_name (val
, realdir
);
5265 specdir
= Ffile_name_directory (string
);
5266 val
= Ffile_name_completion (name
, realdir
);
5271 return double_dollars (string
);
5275 if (!NILP (specdir
))
5276 val
= concat2 (specdir
, val
);
5278 return double_dollars (val
);
5281 #endif /* not VMS */
5285 if (EQ (action
, Qt
))
5286 return Ffile_name_all_completions (name
, realdir
);
5287 /* Only other case actually used is ACTION = lambda */
5289 /* Supposedly this helps commands such as `cd' that read directory names,
5290 but can someone explain how it helps them? -- RMS */
5291 if (XSTRING (name
)->size
== 0)
5294 return Ffile_exists_p (string
);
5297 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5298 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5299 Value is not expanded---you must call `expand-file-name' yourself.\n\
5300 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5301 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5302 except that if INITIAL is specified, that combined with DIR is used.)\n\
5303 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5304 Non-nil and non-t means also require confirmation after completion.\n\
5305 Fifth arg INITIAL specifies text to start with.\n\
5306 DIR defaults to current buffer's directory default.")
5307 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5308 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5310 Lisp_Object val
, insdef
, insdef1
, tem
;
5311 struct gcpro gcpro1
, gcpro2
;
5312 register char *homedir
;
5313 int replace_in_history
= 0;
5314 int add_to_history
= 0;
5318 dir
= current_buffer
->directory
;
5319 if (NILP (default_filename
))
5321 if (! NILP (initial
))
5322 default_filename
= Fexpand_file_name (initial
, dir
);
5324 default_filename
= current_buffer
->filename
;
5327 /* If dir starts with user's homedir, change that to ~. */
5328 homedir
= (char *) egetenv ("HOME");
5330 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5331 CORRECT_DIR_SEPS (homedir
);
5335 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5336 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5338 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5339 STRING_BYTES (XSTRING (dir
)) - strlen (homedir
) + 1);
5340 XSTRING (dir
)->data
[0] = '~';
5343 if (insert_default_directory
&& STRINGP (dir
))
5346 if (!NILP (initial
))
5348 Lisp_Object args
[2], pos
;
5352 insdef
= Fconcat (2, args
);
5353 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5354 insdef1
= Fcons (double_dollars (insdef
), pos
);
5357 insdef1
= double_dollars (insdef
);
5359 else if (STRINGP (initial
))
5362 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
5365 insdef
= Qnil
, insdef1
= Qnil
;
5367 count
= specpdl_ptr
- specpdl
;
5369 specbind (intern ("completion-ignore-case"), Qt
);
5372 specbind (intern ("minibuffer-completing-file-name"), Qt
);
5374 GCPRO2 (insdef
, default_filename
);
5375 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5376 dir
, mustmatch
, insdef1
,
5377 Qfile_name_history
, default_filename
, Qnil
);
5379 tem
= Fsymbol_value (Qfile_name_history
);
5380 if (CONSP (tem
) && EQ (XCONS (tem
)->car
, val
))
5381 replace_in_history
= 1;
5383 /* If Fcompleting_read returned the inserted default string itself
5384 (rather than a new string with the same contents),
5385 it has to mean that the user typed RET with the minibuffer empty.
5386 In that case, we really want to return ""
5387 so that commands such as set-visited-file-name can distinguish. */
5388 if (EQ (val
, default_filename
))
5390 /* In this case, Fcompleting_read has not added an element
5391 to the history. Maybe we should. */
5392 if (! replace_in_history
)
5395 val
= build_string ("");
5398 unbind_to (count
, Qnil
);
5401 error ("No file name specified");
5403 tem
= Fstring_equal (val
, insdef
);
5405 if (!NILP (tem
) && !NILP (default_filename
))
5406 val
= default_filename
;
5407 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5409 if (!NILP (default_filename
))
5410 val
= default_filename
;
5412 error ("No default file name");
5414 val
= Fsubstitute_in_file_name (val
);
5416 if (replace_in_history
)
5417 /* Replace what Fcompleting_read added to the history
5418 with what we will actually return. */
5419 XCONS (Fsymbol_value (Qfile_name_history
))->car
= val
;
5420 else if (add_to_history
)
5422 /* Add the value to the history--but not if it matches
5423 the last value already there. */
5424 tem
= Fsymbol_value (Qfile_name_history
);
5425 if (! CONSP (tem
) || NILP (Fequal (XCONS (tem
)->car
, val
)))
5426 Fset (Qfile_name_history
,
5435 Qexpand_file_name
= intern ("expand-file-name");
5436 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5437 Qdirectory_file_name
= intern ("directory-file-name");
5438 Qfile_name_directory
= intern ("file-name-directory");
5439 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5440 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5441 Qfile_name_as_directory
= intern ("file-name-as-directory");
5442 Qcopy_file
= intern ("copy-file");
5443 Qmake_directory_internal
= intern ("make-directory-internal");
5444 Qdelete_directory
= intern ("delete-directory");
5445 Qdelete_file
= intern ("delete-file");
5446 Qrename_file
= intern ("rename-file");
5447 Qadd_name_to_file
= intern ("add-name-to-file");
5448 Qmake_symbolic_link
= intern ("make-symbolic-link");
5449 Qfile_exists_p
= intern ("file-exists-p");
5450 Qfile_executable_p
= intern ("file-executable-p");
5451 Qfile_readable_p
= intern ("file-readable-p");
5452 Qfile_writable_p
= intern ("file-writable-p");
5453 Qfile_symlink_p
= intern ("file-symlink-p");
5454 Qaccess_file
= intern ("access-file");
5455 Qfile_directory_p
= intern ("file-directory-p");
5456 Qfile_regular_p
= intern ("file-regular-p");
5457 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5458 Qfile_modes
= intern ("file-modes");
5459 Qset_file_modes
= intern ("set-file-modes");
5460 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5461 Qinsert_file_contents
= intern ("insert-file-contents");
5462 Qwrite_region
= intern ("write-region");
5463 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5464 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5466 staticpro (&Qexpand_file_name
);
5467 staticpro (&Qsubstitute_in_file_name
);
5468 staticpro (&Qdirectory_file_name
);
5469 staticpro (&Qfile_name_directory
);
5470 staticpro (&Qfile_name_nondirectory
);
5471 staticpro (&Qunhandled_file_name_directory
);
5472 staticpro (&Qfile_name_as_directory
);
5473 staticpro (&Qcopy_file
);
5474 staticpro (&Qmake_directory_internal
);
5475 staticpro (&Qdelete_directory
);
5476 staticpro (&Qdelete_file
);
5477 staticpro (&Qrename_file
);
5478 staticpro (&Qadd_name_to_file
);
5479 staticpro (&Qmake_symbolic_link
);
5480 staticpro (&Qfile_exists_p
);
5481 staticpro (&Qfile_executable_p
);
5482 staticpro (&Qfile_readable_p
);
5483 staticpro (&Qfile_writable_p
);
5484 staticpro (&Qaccess_file
);
5485 staticpro (&Qfile_symlink_p
);
5486 staticpro (&Qfile_directory_p
);
5487 staticpro (&Qfile_regular_p
);
5488 staticpro (&Qfile_accessible_directory_p
);
5489 staticpro (&Qfile_modes
);
5490 staticpro (&Qset_file_modes
);
5491 staticpro (&Qfile_newer_than_file_p
);
5492 staticpro (&Qinsert_file_contents
);
5493 staticpro (&Qwrite_region
);
5494 staticpro (&Qverify_visited_file_modtime
);
5495 staticpro (&Qset_visited_file_modtime
);
5497 Qfile_name_history
= intern ("file-name-history");
5498 Fset (Qfile_name_history
, Qnil
);
5499 staticpro (&Qfile_name_history
);
5501 Qfile_error
= intern ("file-error");
5502 staticpro (&Qfile_error
);
5503 Qfile_already_exists
= intern ("file-already-exists");
5504 staticpro (&Qfile_already_exists
);
5505 Qfile_date_error
= intern ("file-date-error");
5506 staticpro (&Qfile_date_error
);
5509 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5510 staticpro (&Qfind_buffer_file_type
);
5513 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5514 "*Coding system for encoding file names.\n\
5515 If it is nil, default-file-name-coding-system (which see) is used.");
5516 Vfile_name_coding_system
= Qnil
;
5518 DEFVAR_LISP ("default-file-name-coding-system",
5519 &Vdefault_file_name_coding_system
,
5520 "Default coding system for encoding file names.\n\
5521 This variable is used only when file-name-coding-system is nil.\n\
5523 This variable is set/changed by the command set-language-environment.\n\
5524 User should not set this variable manually,\n\
5525 instead use file-name-coding-system to get a constant encoding\n\
5526 of file names regardless of the current language environment.");
5527 Vdefault_file_name_coding_system
= Qnil
;
5529 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5530 "*Format in which to write auto-save files.\n\
5531 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5532 If it is t, which is the default, auto-save files are written in the\n\
5533 same format as a regular save would use.");
5534 Vauto_save_file_format
= Qt
;
5536 Qformat_decode
= intern ("format-decode");
5537 staticpro (&Qformat_decode
);
5538 Qformat_annotate_function
= intern ("format-annotate-function");
5539 staticpro (&Qformat_annotate_function
);
5541 Qcar_less_than_car
= intern ("car-less-than-car");
5542 staticpro (&Qcar_less_than_car
);
5544 Fput (Qfile_error
, Qerror_conditions
,
5545 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5546 Fput (Qfile_error
, Qerror_message
,
5547 build_string ("File error"));
5549 Fput (Qfile_already_exists
, Qerror_conditions
,
5550 Fcons (Qfile_already_exists
,
5551 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5552 Fput (Qfile_already_exists
, Qerror_message
,
5553 build_string ("File already exists"));
5555 Fput (Qfile_date_error
, Qerror_conditions
,
5556 Fcons (Qfile_date_error
,
5557 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5558 Fput (Qfile_date_error
, Qerror_message
,
5559 build_string ("Cannot set file date"));
5561 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5562 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5563 insert_default_directory
= 1;
5565 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5566 "*Non-nil means write new files with record format `stmlf'.\n\
5567 nil means use format `var'. This variable is meaningful only on VMS.");
5568 vms_stmlf_recfm
= 0;
5570 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5571 "Directory separator character for built-in functions that return file names.\n\
5572 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5573 This variable affects the built-in functions only on Windows,\n\
5574 on other platforms, it is initialized so that Lisp code can find out\n\
5575 what the normal separator is.");
5576 XSETFASTINT (Vdirectory_sep_char
, '/');
5578 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5579 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5580 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5583 The first argument given to HANDLER is the name of the I/O primitive\n\
5584 to be handled; the remaining arguments are the arguments that were\n\
5585 passed to that primitive. For example, if you do\n\
5586 (file-exists-p FILENAME)\n\
5587 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5588 (funcall HANDLER 'file-exists-p FILENAME)\n\
5589 The function `find-file-name-handler' checks this list for a handler\n\
5590 for its argument.");
5591 Vfile_name_handler_alist
= Qnil
;
5593 DEFVAR_LISP ("set-auto-coding-function",
5594 &Vset_auto_coding_function
,
5595 "If non-nil, a function to call to decide a coding system of file.\n\
5596 One argument is passed to this function: the length of a file contents\n\
5597 following the point.\n\
5598 This function should return a coding system to decode the file contents\n\
5599 specified in the heading lines with the format:\n\
5600 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5601 or local variable spec of the tailing lines with `coding:' tag.");
5602 Vset_auto_coding_function
= Qnil
;
5604 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5605 "A list of functions to be called at the end of `insert-file-contents'.\n\
5606 Each is passed one argument, the number of bytes inserted. It should return\n\
5607 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5608 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5609 responsible for calling the after-insert-file-functions if appropriate.");
5610 Vafter_insert_file_functions
= Qnil
;
5612 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5613 "A list of functions to be called at the start of `write-region'.\n\
5614 Each is passed two arguments, START and END as for `write-region'.\n\
5615 These are usually two numbers but not always; see the documentation\n\
5616 for `write-region'. The function should return a list of pairs\n\
5617 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5618 inserted at the specified positions of the file being written (1 means to\n\
5619 insert before the first byte written). The POSITIONs must be sorted into\n\
5620 increasing order. If there are several functions in the list, the several\n\
5621 lists are merged destructively.");
5622 Vwrite_region_annotate_functions
= Qnil
;
5624 DEFVAR_LISP ("write-region-annotations-so-far",
5625 &Vwrite_region_annotations_so_far
,
5626 "When an annotation function is called, this holds the previous annotations.\n\
5627 These are the annotations made by other annotation functions\n\
5628 that were already called. See also `write-region-annotate-functions'.");
5629 Vwrite_region_annotations_so_far
= Qnil
;
5631 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5632 "A list of file name handlers that temporarily should not be used.\n\
5633 This applies only to the operation `inhibit-file-name-operation'.");
5634 Vinhibit_file_name_handlers
= Qnil
;
5636 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5637 "The operation for which `inhibit-file-name-handlers' is applicable.");
5638 Vinhibit_file_name_operation
= Qnil
;
5640 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5641 "File name in which we write a list of all auto save file names.\n\
5642 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5643 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5645 Vauto_save_list_file_name
= Qnil
;
5647 defsubr (&Sfind_file_name_handler
);
5648 defsubr (&Sfile_name_directory
);
5649 defsubr (&Sfile_name_nondirectory
);
5650 defsubr (&Sunhandled_file_name_directory
);
5651 defsubr (&Sfile_name_as_directory
);
5652 defsubr (&Sdirectory_file_name
);
5653 defsubr (&Smake_temp_name
);
5654 defsubr (&Sexpand_file_name
);
5655 defsubr (&Ssubstitute_in_file_name
);
5656 defsubr (&Scopy_file
);
5657 defsubr (&Smake_directory_internal
);
5658 defsubr (&Sdelete_directory
);
5659 defsubr (&Sdelete_file
);
5660 defsubr (&Srename_file
);
5661 defsubr (&Sadd_name_to_file
);
5663 defsubr (&Smake_symbolic_link
);
5664 #endif /* S_IFLNK */
5666 defsubr (&Sdefine_logical_name
);
5669 defsubr (&Ssysnetunam
);
5670 #endif /* HPUX_NET */
5671 defsubr (&Sfile_name_absolute_p
);
5672 defsubr (&Sfile_exists_p
);
5673 defsubr (&Sfile_executable_p
);
5674 defsubr (&Sfile_readable_p
);
5675 defsubr (&Sfile_writable_p
);
5676 defsubr (&Saccess_file
);
5677 defsubr (&Sfile_symlink_p
);
5678 defsubr (&Sfile_directory_p
);
5679 defsubr (&Sfile_accessible_directory_p
);
5680 defsubr (&Sfile_regular_p
);
5681 defsubr (&Sfile_modes
);
5682 defsubr (&Sset_file_modes
);
5683 defsubr (&Sset_default_file_modes
);
5684 defsubr (&Sdefault_file_modes
);
5685 defsubr (&Sfile_newer_than_file_p
);
5686 defsubr (&Sinsert_file_contents
);
5687 defsubr (&Swrite_region
);
5688 defsubr (&Scar_less_than_car
);
5689 defsubr (&Sverify_visited_file_modtime
);
5690 defsubr (&Sclear_visited_file_modtime
);
5691 defsubr (&Svisited_file_modtime
);
5692 defsubr (&Sset_visited_file_modtime
);
5693 defsubr (&Sdo_auto_save
);
5694 defsubr (&Sset_buffer_auto_saved
);
5695 defsubr (&Sclear_buffer_auto_save_failure
);
5696 defsubr (&Srecent_auto_save_p
);
5698 defsubr (&Sread_file_name_internal
);
5699 defsubr (&Sread_file_name
);
5702 defsubr (&Sunix_sync
);