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))
144 #include "commands.h"
145 extern int use_dialog_box
;
159 #define min(a, b) ((a) < (b) ? (a) : (b))
160 #define max(a, b) ((a) > (b) ? (a) : (b))
162 /* Nonzero during writing of auto-save files */
165 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
166 a new file with the same mode as the original */
167 int auto_save_mode_bits
;
169 /* Coding system for file names, or nil if none. */
170 Lisp_Object Vfile_name_coding_system
;
172 /* Coding system for file names used only when
173 Vfile_name_coding_system is nil. */
174 Lisp_Object Vdefault_file_name_coding_system
;
176 /* Alist of elements (REGEXP . HANDLER) for file names
177 whose I/O is done with a special handler. */
178 Lisp_Object Vfile_name_handler_alist
;
180 /* Format for auto-save files */
181 Lisp_Object Vauto_save_file_format
;
183 /* Lisp functions for translating file formats */
184 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
186 /* Function to be called to decide a coding system of a reading file. */
187 Lisp_Object Vset_auto_coding_function
;
189 /* Functions to be called to process text properties in inserted file. */
190 Lisp_Object Vafter_insert_file_functions
;
192 /* Functions to be called to create text property annotations for file. */
193 Lisp_Object Vwrite_region_annotate_functions
;
195 /* During build_annotations, each time an annotation function is called,
196 this holds the annotations made by the previous functions. */
197 Lisp_Object Vwrite_region_annotations_so_far
;
199 /* File name in which we write a list of all our auto save files. */
200 Lisp_Object Vauto_save_list_file_name
;
202 /* Nonzero means, when reading a filename in the minibuffer,
203 start out by inserting the default directory into the minibuffer. */
204 int insert_default_directory
;
206 /* On VMS, nonzero means write new files with record format stmlf.
207 Zero means use var format. */
210 /* On NT, specifies the directory separator character, used (eg.) when
211 expanding file names. This can be bound to / or \. */
212 Lisp_Object Vdirectory_sep_char
;
214 extern Lisp_Object Vuser_login_name
;
217 extern Lisp_Object Vw32_get_true_file_attributes
;
220 extern int minibuf_level
;
222 extern int minibuffer_auto_raise
;
224 /* These variables describe handlers that have "already" had a chance
225 to handle the current operation.
227 Vinhibit_file_name_handlers is a list of file name handlers.
228 Vinhibit_file_name_operation is the operation being handled.
229 If we try to handle that operation, we ignore those handlers. */
231 static Lisp_Object Vinhibit_file_name_handlers
;
232 static Lisp_Object Vinhibit_file_name_operation
;
234 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
236 Lisp_Object Qfile_name_history
;
238 Lisp_Object Qcar_less_than_car
;
240 static int a_write
P_ ((int, char *, int, int,
241 Lisp_Object
*, struct coding_system
*));
242 static int e_write
P_ ((int, char *, int, struct coding_system
*));
245 report_file_error (string
, data
)
249 Lisp_Object errstring
;
251 errstring
= build_string (strerror (errno
));
253 /* System error messages are capitalized. Downcase the initial
254 unless it is followed by a slash. */
255 if (XSTRING (errstring
)->data
[1] != '/')
256 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
259 Fsignal (Qfile_error
,
260 Fcons (build_string (string
), Fcons (errstring
, data
)));
264 close_file_unwind (fd
)
267 close (XFASTINT (fd
));
271 /* Restore point, having saved it as a marker. */
274 restore_point_unwind (location
)
275 Lisp_Object location
;
277 Fgoto_char (location
);
278 Fset_marker (location
, Qnil
, Qnil
);
282 Lisp_Object Qexpand_file_name
;
283 Lisp_Object Qsubstitute_in_file_name
;
284 Lisp_Object Qdirectory_file_name
;
285 Lisp_Object Qfile_name_directory
;
286 Lisp_Object Qfile_name_nondirectory
;
287 Lisp_Object Qunhandled_file_name_directory
;
288 Lisp_Object Qfile_name_as_directory
;
289 Lisp_Object Qcopy_file
;
290 Lisp_Object Qmake_directory_internal
;
291 Lisp_Object Qdelete_directory
;
292 Lisp_Object Qdelete_file
;
293 Lisp_Object Qrename_file
;
294 Lisp_Object Qadd_name_to_file
;
295 Lisp_Object Qmake_symbolic_link
;
296 Lisp_Object Qfile_exists_p
;
297 Lisp_Object Qfile_executable_p
;
298 Lisp_Object Qfile_readable_p
;
299 Lisp_Object Qfile_writable_p
;
300 Lisp_Object Qfile_symlink_p
;
301 Lisp_Object Qaccess_file
;
302 Lisp_Object Qfile_directory_p
;
303 Lisp_Object Qfile_regular_p
;
304 Lisp_Object Qfile_accessible_directory_p
;
305 Lisp_Object Qfile_modes
;
306 Lisp_Object Qset_file_modes
;
307 Lisp_Object Qfile_newer_than_file_p
;
308 Lisp_Object Qinsert_file_contents
;
309 Lisp_Object Qwrite_region
;
310 Lisp_Object Qverify_visited_file_modtime
;
311 Lisp_Object Qset_visited_file_modtime
;
313 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
314 "Return FILENAME's handler function for OPERATION, if it has one.\n\
315 Otherwise, return nil.\n\
316 A file name is handled if one of the regular expressions in\n\
317 `file-name-handler-alist' matches it.\n\n\
318 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
319 any handlers that are members of `inhibit-file-name-handlers',\n\
320 but we still do run any other handlers. This lets handlers\n\
321 use the standard functions without calling themselves recursively.")
322 (filename
, operation
)
323 Lisp_Object filename
, operation
;
325 /* This function must not munge the match data. */
326 Lisp_Object chain
, inhibited_handlers
;
328 CHECK_STRING (filename
, 0);
330 if (EQ (operation
, Vinhibit_file_name_operation
))
331 inhibited_handlers
= Vinhibit_file_name_handlers
;
333 inhibited_handlers
= Qnil
;
335 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
336 chain
= XCONS (chain
)->cdr
)
339 elt
= XCONS (chain
)->car
;
343 string
= XCONS (elt
)->car
;
344 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
346 Lisp_Object handler
, tem
;
348 handler
= XCONS (elt
)->cdr
;
349 tem
= Fmemq (handler
, inhibited_handlers
);
360 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
362 "Return the directory component in file name FILENAME.\n\
363 Return nil if FILENAME does not include a directory.\n\
364 Otherwise return a directory spec.\n\
365 Given a Unix syntax file name, returns a string ending in slash;\n\
366 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
368 Lisp_Object filename
;
370 register unsigned char *beg
;
371 register unsigned char *p
;
374 CHECK_STRING (filename
, 0);
376 /* If the file name has special constructs in it,
377 call the corresponding file handler. */
378 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
380 return call2 (handler
, Qfile_name_directory
, filename
);
382 #ifdef FILE_SYSTEM_CASE
383 filename
= FILE_SYSTEM_CASE (filename
);
385 beg
= XSTRING (filename
)->data
;
387 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
389 p
= beg
+ STRING_BYTES (XSTRING (filename
));
391 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
393 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
396 /* only recognise drive specifier at the beginning */
398 /* handle the "/:d:foo" and "/:foo" cases correctly */
399 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
400 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
407 /* Expansion of "c:" to drive and default directory. */
410 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
411 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
412 unsigned char *r
= res
;
414 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
416 strncpy (res
, beg
, 2);
421 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
423 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
426 p
= beg
+ strlen (beg
);
429 CORRECT_DIR_SEPS (beg
);
432 if (STRING_MULTIBYTE (filename
))
433 return make_string (beg
, p
- beg
);
434 return make_unibyte_string (beg
, p
- beg
);
437 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
438 Sfile_name_nondirectory
, 1, 1, 0,
439 "Return file name FILENAME sans its directory.\n\
440 For example, in a Unix-syntax file name,\n\
441 this is everything after the last slash,\n\
442 or the entire name if it contains no slash.")
444 Lisp_Object filename
;
446 register unsigned char *beg
, *p
, *end
;
449 CHECK_STRING (filename
, 0);
451 /* If the file name has special constructs in it,
452 call the corresponding file handler. */
453 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
455 return call2 (handler
, Qfile_name_nondirectory
, filename
);
457 beg
= XSTRING (filename
)->data
;
458 end
= p
= beg
+ STRING_BYTES (XSTRING (filename
));
460 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
462 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
465 /* only recognise drive specifier at beginning */
467 /* handle the "/:d:foo" case correctly */
468 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
473 if (STRING_MULTIBYTE (filename
))
474 return make_string (p
, end
- p
);
475 return make_unibyte_string (p
, end
- p
);
478 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
479 Sunhandled_file_name_directory
, 1, 1, 0,
480 "Return a directly usable directory name somehow associated with FILENAME.\n\
481 A `directly usable' directory name is one that may be used without the\n\
482 intervention of any file handler.\n\
483 If FILENAME is a directly usable file itself, return\n\
484 \(file-name-directory FILENAME).\n\
485 The `call-process' and `start-process' functions use this function to\n\
486 get a current directory to run processes in.")
488 Lisp_Object filename
;
492 /* If the file name has special constructs in it,
493 call the corresponding file handler. */
494 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
496 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
498 return Ffile_name_directory (filename
);
503 file_name_as_directory (out
, in
)
506 int size
= strlen (in
) - 1;
519 /* Is it already a directory string? */
520 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
522 /* Is it a VMS directory file name? If so, hack VMS syntax. */
523 else if (! index (in
, '/')
524 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
525 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
526 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
527 || ! strncmp (&in
[size
- 5], ".dir", 4))
528 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
529 && in
[size
] == '1')))
531 register char *p
, *dot
;
535 dir:x.dir --> dir:[x]
536 dir:[x]y.dir --> dir:[x.y] */
538 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
541 strncpy (out
, in
, p
- in
);
560 dot
= index (p
, '.');
563 /* blindly remove any extension */
564 size
= strlen (out
) + (dot
- p
);
565 strncat (out
, p
, dot
- p
);
576 /* For Unix syntax, Append a slash if necessary */
577 if (!IS_DIRECTORY_SEP (out
[size
]))
579 out
[size
+ 1] = DIRECTORY_SEP
;
580 out
[size
+ 2] = '\0';
583 CORRECT_DIR_SEPS (out
);
589 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
590 Sfile_name_as_directory
, 1, 1, 0,
591 "Return a string representing file FILENAME interpreted as a directory.\n\
592 This operation exists because a directory is also a file, but its name as\n\
593 a directory is different from its name as a file.\n\
594 The result can be used as the value of `default-directory'\n\
595 or passed as second argument to `expand-file-name'.\n\
596 For a Unix-syntax file name, just appends a slash.\n\
597 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
604 CHECK_STRING (file
, 0);
608 /* If the file name has special constructs in it,
609 call the corresponding file handler. */
610 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
612 return call2 (handler
, Qfile_name_as_directory
, file
);
614 buf
= (char *) alloca (STRING_BYTES (XSTRING (file
)) + 10);
615 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
619 * Convert from directory name to filename.
621 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
622 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
623 * On UNIX, it's simple: just make sure there isn't a terminating /
625 * Value is nonzero if the string output is different from the input.
629 directory_file_name (src
, dst
)
637 struct FAB fab
= cc$rms_fab
;
638 struct NAM nam
= cc$rms_nam
;
639 char esa
[NAM$C_MAXRSS
];
644 if (! index (src
, '/')
645 && (src
[slen
- 1] == ']'
646 || src
[slen
- 1] == ':'
647 || src
[slen
- 1] == '>'))
649 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
651 fab
.fab$b_fns
= slen
;
652 fab
.fab$l_nam
= &nam
;
653 fab
.fab$l_fop
= FAB$M_NAM
;
656 nam
.nam$b_ess
= sizeof esa
;
657 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
659 /* We call SYS$PARSE to handle such things as [--] for us. */
660 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
662 slen
= nam
.nam$b_esl
;
663 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
668 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
670 /* what about when we have logical_name:???? */
671 if (src
[slen
- 1] == ':')
672 { /* Xlate logical name and see what we get */
673 ptr
= strcpy (dst
, src
); /* upper case for getenv */
676 if ('a' <= *ptr
&& *ptr
<= 'z')
680 dst
[slen
- 1] = 0; /* remove colon */
681 if (!(src
= egetenv (dst
)))
683 /* should we jump to the beginning of this procedure?
684 Good points: allows us to use logical names that xlate
686 Bad points: can be a problem if we just translated to a device
688 For now, I'll punt and always expect VMS names, and hope for
691 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
692 { /* no recursion here! */
698 { /* not a directory spec */
703 bracket
= src
[slen
- 1];
705 /* If bracket is ']' or '>', bracket - 2 is the corresponding
707 ptr
= index (src
, bracket
- 2);
709 { /* no opening bracket */
713 if (!(rptr
= rindex (src
, '.')))
716 strncpy (dst
, src
, slen
);
720 dst
[slen
++] = bracket
;
725 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
726 then translate the device and recurse. */
727 if (dst
[slen
- 1] == ':'
728 && dst
[slen
- 2] != ':' /* skip decnet nodes */
729 && strcmp (src
+ slen
, "[000000]") == 0)
731 dst
[slen
- 1] = '\0';
732 if ((ptr
= egetenv (dst
))
733 && (rlen
= strlen (ptr
) - 1) > 0
734 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
735 && ptr
[rlen
- 1] == '.')
737 char * buf
= (char *) alloca (strlen (ptr
) + 1);
741 return directory_file_name (buf
, dst
);
746 strcat (dst
, "[000000]");
750 rlen
= strlen (rptr
) - 1;
751 strncat (dst
, rptr
, rlen
);
752 dst
[slen
+ rlen
] = '\0';
753 strcat (dst
, ".DIR.1");
757 /* Process as Unix format: just remove any final slash.
758 But leave "/" unchanged; do not change it to "". */
761 /* Handle // as root for apollo's. */
762 if ((slen
> 2 && dst
[slen
- 1] == '/')
763 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
767 && IS_DIRECTORY_SEP (dst
[slen
- 1])
769 && !IS_ANY_SEP (dst
[slen
- 2])
775 CORRECT_DIR_SEPS (dst
);
780 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
782 "Returns the file name of the directory named DIRECTORY.\n\
783 This is the name of the file that holds the data for the directory DIRECTORY.\n\
784 This operation exists because a directory is also a file, but its name as\n\
785 a directory is different from its name as a file.\n\
786 In Unix-syntax, this function just removes the final slash.\n\
787 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
788 it returns a file name such as \"[X]Y.DIR.1\".")
790 Lisp_Object directory
;
795 CHECK_STRING (directory
, 0);
797 if (NILP (directory
))
800 /* If the file name has special constructs in it,
801 call the corresponding file handler. */
802 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
804 return call2 (handler
, Qdirectory_file_name
, directory
);
807 /* 20 extra chars is insufficient for VMS, since we might perform a
808 logical name translation. an equivalence string can be up to 255
809 chars long, so grab that much extra space... - sss */
810 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20 + 255);
812 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20);
814 directory_file_name (XSTRING (directory
)->data
, buf
);
815 return build_string (buf
);
818 static char make_temp_name_tbl
[64] =
820 'A','B','C','D','E','F','G','H',
821 'I','J','K','L','M','N','O','P',
822 'Q','R','S','T','U','V','W','X',
823 'Y','Z','a','b','c','d','e','f',
824 'g','h','i','j','k','l','m','n',
825 'o','p','q','r','s','t','u','v',
826 'w','x','y','z','0','1','2','3',
827 '4','5','6','7','8','9','-','_'
829 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
831 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
832 "Generate temporary file name (string) starting with PREFIX (a string).\n\
833 The Emacs process number forms part of the result,\n\
834 so there is no danger of generating a name being used by another process.\n\
836 In addition, this function makes an attempt to choose a name\n\
837 which has no existing file. To make this work,\n\
838 PREFIX should be an absolute file name.")
845 unsigned char *p
, *data
;
849 CHECK_STRING (prefix
, 0);
851 /* VAL is created by adding 6 characters to PREFIX. The first
852 three are the PID of this process, in base 64, and the second
853 three are incremented if the file already exists. This ensures
854 262144 unique file names per PID per PREFIX. */
856 pid
= (int) getpid ();
858 #ifdef HAVE_LONG_FILE_NAMES
859 sprintf (pidbuf
, "%d", pid
);
860 pidlen
= strlen (pidbuf
);
862 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
863 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
864 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
868 len
= XSTRING (prefix
)->size
;
869 val
= make_uninit_string (len
+ 3 + pidlen
);
870 data
= XSTRING (val
)->data
;
871 bcopy(XSTRING (prefix
)->data
, data
, len
);
874 bcopy (pidbuf
, p
, pidlen
);
877 /* Here we try to minimize useless stat'ing when this function is
878 invoked many times successively with the same PREFIX. We achieve
879 this by initializing count to a random value, and incrementing it
882 We don't want make-temp-name to be called while dumping,
883 because then make_temp_name_count_initialized_p would get set
884 and then make_temp_name_count would not be set when Emacs starts. */
886 if (!make_temp_name_count_initialized_p
)
888 make_temp_name_count
= (unsigned) time (NULL
);
889 make_temp_name_count_initialized_p
= 1;
895 unsigned num
= make_temp_name_count
;
897 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
898 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
899 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
901 /* Poor man's congruential RN generator. Replace with
902 ++make_temp_name_count for debugging. */
903 make_temp_name_count
+= 25229;
904 make_temp_name_count
%= 225307;
906 if (stat (data
, &ignored
) < 0)
908 /* We want to return only if errno is ENOENT. */
912 /* The error here is dubious, but there is little else we
913 can do. The alternatives are to return nil, which is
914 as bad as (and in many cases worse than) throwing the
915 error, or to ignore the error, which will likely result
916 in looping through 225307 stat's, which is not only
917 dog-slow, but also useless since it will fallback to
918 the errow below, anyway. */
919 report_file_error ("Cannot create temporary name for prefix `%s'",
920 Fcons (prefix
, Qnil
));
925 error ("Cannot create temporary name for prefix `%s'",
926 XSTRING (prefix
)->data
);
931 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
932 "Convert filename NAME to absolute, and canonicalize it.\n\
933 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
934 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
935 the current buffer's value of default-directory is used.\n\
936 File name components that are `.' are removed, and \n\
937 so are file name components followed by `..', along with the `..' itself;\n\
938 note that these simplifications are done without checking the resulting\n\
939 file names in the file system.\n\
940 An initial `~/' expands to your home directory.\n\
941 An initial `~USER/' expands to USER's home directory.\n\
942 See also the function `substitute-in-file-name'.")
943 (name
, default_directory
)
944 Lisp_Object name
, default_directory
;
948 register unsigned char *newdir
, *p
, *o
;
950 unsigned char *target
;
953 unsigned char * colon
= 0;
954 unsigned char * close
= 0;
955 unsigned char * slash
= 0;
956 unsigned char * brack
= 0;
957 int lbrack
= 0, rbrack
= 0;
962 int collapse_newdir
= 1;
968 CHECK_STRING (name
, 0);
970 /* If the file name has special constructs in it,
971 call the corresponding file handler. */
972 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
974 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
976 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
977 if (NILP (default_directory
))
978 default_directory
= current_buffer
->directory
;
979 if (! STRINGP (default_directory
))
980 default_directory
= build_string ("/");
982 if (!NILP (default_directory
))
984 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
986 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
989 o
= XSTRING (default_directory
)->data
;
991 /* Make sure DEFAULT_DIRECTORY is properly expanded.
992 It would be better to do this down below where we actually use
993 default_directory. Unfortunately, calling Fexpand_file_name recursively
994 could invoke GC, and the strings might be relocated. This would
995 be annoying because we have pointers into strings lying around
996 that would need adjusting, and people would add new pointers to
997 the code and forget to adjust them, resulting in intermittent bugs.
998 Putting this call here avoids all that crud.
1000 The EQ test avoids infinite recursion. */
1001 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1002 /* Save time in some common cases - as long as default_directory
1003 is not relative, it can be canonicalized with name below (if it
1004 is needed at all) without requiring it to be expanded now. */
1006 /* Detect MSDOS file names with drive specifiers. */
1007 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1009 /* Detect Windows file names in UNC format. */
1010 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1012 #else /* not DOS_NT */
1013 /* Detect Unix absolute file names (/... alone is not absolute on
1015 && ! (IS_DIRECTORY_SEP (o
[0]))
1016 #endif /* not DOS_NT */
1019 struct gcpro gcpro1
;
1022 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1027 /* Filenames on VMS are always upper case. */
1028 name
= Fupcase (name
);
1030 #ifdef FILE_SYSTEM_CASE
1031 name
= FILE_SYSTEM_CASE (name
);
1034 nm
= XSTRING (name
)->data
;
1037 /* We will force directory separators to be either all \ or /, so make
1038 a local copy to modify, even if there ends up being no change. */
1039 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1041 /* Note if special escape prefix is present, but remove for now. */
1042 if (nm
[0] == '/' && nm
[1] == ':')
1048 /* Find and remove drive specifier if present; this makes nm absolute
1049 even if the rest of the name appears to be relative. Only look for
1050 drive specifier at the beginning. */
1051 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1058 /* If we see "c://somedir", we want to strip the first slash after the
1059 colon when stripping the drive letter. Otherwise, this expands to
1061 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1063 #endif /* WINDOWSNT */
1067 /* Discard any previous drive specifier if nm is now in UNC format. */
1068 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1074 /* If nm is absolute, look for /./ or /../ sequences; if none are
1075 found, we can probably return right away. We will avoid allocating
1076 a new string if name is already fully expanded. */
1078 IS_DIRECTORY_SEP (nm
[0])
1080 && drive
&& !is_escaped
1083 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1090 /* If it turns out that the filename we want to return is just a
1091 suffix of FILENAME, we don't need to go through and edit
1092 things; we just need to construct a new string using data
1093 starting at the middle of FILENAME. If we set lose to a
1094 non-zero value, that means we've discovered that we can't do
1101 /* Since we know the name is absolute, we can assume that each
1102 element starts with a "/". */
1104 /* "." and ".." are hairy. */
1105 if (IS_DIRECTORY_SEP (p
[0])
1107 && (IS_DIRECTORY_SEP (p
[2])
1109 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1116 /* if dev:[dir]/, move nm to / */
1117 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1118 nm
= (brack
? brack
+ 1 : colon
+ 1);
1119 lbrack
= rbrack
= 0;
1127 /* VMS pre V4.4,convert '-'s in filenames. */
1128 if (lbrack
== rbrack
)
1130 if (dots
< 2) /* this is to allow negative version numbers */
1135 if (lbrack
> rbrack
&&
1136 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1137 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1143 /* count open brackets, reset close bracket pointer */
1144 if (p
[0] == '[' || p
[0] == '<')
1145 lbrack
++, brack
= 0;
1146 /* count close brackets, set close bracket pointer */
1147 if (p
[0] == ']' || p
[0] == '>')
1148 rbrack
++, brack
= p
;
1149 /* detect ][ or >< */
1150 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1152 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1153 nm
= p
+ 1, lose
= 1;
1154 if (p
[0] == ':' && (colon
|| slash
))
1155 /* if dev1:[dir]dev2:, move nm to dev2: */
1161 /* if /name/dev:, move nm to dev: */
1164 /* if node::dev:, move colon following dev */
1165 else if (colon
&& colon
[-1] == ':')
1167 /* if dev1:dev2:, move nm to dev2: */
1168 else if (colon
&& colon
[-1] != ':')
1173 if (p
[0] == ':' && !colon
)
1179 if (lbrack
== rbrack
)
1182 else if (p
[0] == '.')
1190 if (index (nm
, '/'))
1191 return build_string (sys_translate_unix (nm
));
1194 /* Make sure directories are all separated with / or \ as
1195 desired, but avoid allocation of a new string when not
1197 CORRECT_DIR_SEPS (nm
);
1199 if (IS_DIRECTORY_SEP (nm
[1]))
1201 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1202 name
= build_string (nm
);
1206 /* drive must be set, so this is okay */
1207 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1209 name
= make_string (nm
- 2, p
- nm
+ 2);
1210 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1211 XSTRING (name
)->data
[1] = ':';
1214 #else /* not DOS_NT */
1215 if (nm
== XSTRING (name
)->data
)
1217 return build_string (nm
);
1218 #endif /* not DOS_NT */
1222 /* At this point, nm might or might not be an absolute file name. We
1223 need to expand ~ or ~user if present, otherwise prefix nm with
1224 default_directory if nm is not absolute, and finally collapse /./
1225 and /foo/../ sequences.
1227 We set newdir to be the appropriate prefix if one is needed:
1228 - the relevant user directory if nm starts with ~ or ~user
1229 - the specified drive's working dir (DOS/NT only) if nm does not
1231 - the value of default_directory.
1233 Note that these prefixes are not guaranteed to be absolute (except
1234 for the working dir of a drive). Therefore, to ensure we always
1235 return an absolute name, if the final prefix is not absolute we
1236 append it to the current working directory. */
1240 if (nm
[0] == '~') /* prefix ~ */
1242 if (IS_DIRECTORY_SEP (nm
[1])
1246 || nm
[1] == 0) /* ~ by itself */
1248 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1249 newdir
= (unsigned char *) "";
1252 collapse_newdir
= 0;
1255 nm
++; /* Don't leave the slash in nm. */
1258 else /* ~user/filename */
1260 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1265 o
= (unsigned char *) alloca (p
- nm
+ 1);
1266 bcopy ((char *) nm
, o
, p
- nm
);
1269 pw
= (struct passwd
*) getpwnam (o
+ 1);
1272 newdir
= (unsigned char *) pw
-> pw_dir
;
1274 nm
= p
+ 1; /* skip the terminator */
1278 collapse_newdir
= 0;
1283 /* If we don't find a user of that name, leave the name
1284 unchanged; don't move nm forward to p. */
1289 /* On DOS and Windows, nm is absolute if a drive name was specified;
1290 use the drive's current directory as the prefix if needed. */
1291 if (!newdir
&& drive
)
1293 /* Get default directory if needed to make nm absolute. */
1294 if (!IS_DIRECTORY_SEP (nm
[0]))
1296 newdir
= alloca (MAXPATHLEN
+ 1);
1297 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1302 /* Either nm starts with /, or drive isn't mounted. */
1303 newdir
= alloca (4);
1304 newdir
[0] = DRIVE_LETTER (drive
);
1312 /* Finally, if no prefix has been specified and nm is not absolute,
1313 then it must be expanded relative to default_directory. */
1317 /* /... alone is not absolute on DOS and Windows. */
1318 && !IS_DIRECTORY_SEP (nm
[0])
1321 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1328 newdir
= XSTRING (default_directory
)->data
;
1330 /* Note if special escape prefix is present, but remove for now. */
1331 if (newdir
[0] == '/' && newdir
[1] == ':')
1342 /* First ensure newdir is an absolute name. */
1344 /* Detect MSDOS file names with drive specifiers. */
1345 ! (IS_DRIVE (newdir
[0])
1346 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1348 /* Detect Windows file names in UNC format. */
1349 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1353 /* Effectively, let newdir be (expand-file-name newdir cwd).
1354 Because of the admonition against calling expand-file-name
1355 when we have pointers into lisp strings, we accomplish this
1356 indirectly by prepending newdir to nm if necessary, and using
1357 cwd (or the wd of newdir's drive) as the new newdir. */
1359 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1364 if (!IS_DIRECTORY_SEP (nm
[0]))
1366 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1367 file_name_as_directory (tmp
, newdir
);
1371 newdir
= alloca (MAXPATHLEN
+ 1);
1374 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1381 /* Strip off drive name from prefix, if present. */
1382 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1388 /* Keep only a prefix from newdir if nm starts with slash
1389 (//server/share for UNC, nothing otherwise). */
1390 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1393 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1395 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1397 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1399 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1411 /* Get rid of any slash at the end of newdir, unless newdir is
1412 just / or // (an incomplete UNC name). */
1413 length
= strlen (newdir
);
1414 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1416 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1420 unsigned char *temp
= (unsigned char *) alloca (length
);
1421 bcopy (newdir
, temp
, length
- 1);
1422 temp
[length
- 1] = 0;
1430 /* Now concatenate the directory and name to new space in the stack frame */
1431 tlen
+= strlen (nm
) + 1;
1433 /* Reserve space for drive specifier and escape prefix, since either
1434 or both may need to be inserted. (The Microsoft x86 compiler
1435 produces incorrect code if the following two lines are combined.) */
1436 target
= (unsigned char *) alloca (tlen
+ 4);
1438 #else /* not DOS_NT */
1439 target
= (unsigned char *) alloca (tlen
);
1440 #endif /* not DOS_NT */
1446 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1449 /* If newdir is effectively "C:/", then the drive letter will have
1450 been stripped and newdir will be "/". Concatenating with an
1451 absolute directory in nm produces "//", which will then be
1452 incorrectly treated as a network share. Ignore newdir in
1453 this case (keeping the drive letter). */
1454 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1455 && newdir
[1] == '\0'))
1457 strcpy (target
, newdir
);
1461 file_name_as_directory (target
, newdir
);
1464 strcat (target
, nm
);
1466 if (index (target
, '/'))
1467 strcpy (target
, sys_translate_unix (target
));
1470 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1472 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1480 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1486 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1487 /* brackets are offset from each other by 2 */
1490 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1491 /* convert [foo][bar] to [bar] */
1492 while (o
[-1] != '[' && o
[-1] != '<')
1494 else if (*p
== '-' && *o
!= '.')
1497 else if (p
[0] == '-' && o
[-1] == '.' &&
1498 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1499 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1503 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1504 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1506 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1508 /* else [foo.-] ==> [-] */
1514 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1515 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1521 if (!IS_DIRECTORY_SEP (*p
))
1525 else if (IS_DIRECTORY_SEP (p
[0])
1527 && (IS_DIRECTORY_SEP (p
[2])
1530 /* If "/." is the entire filename, keep the "/". Otherwise,
1531 just delete the whole "/.". */
1532 if (o
== target
&& p
[2] == '\0')
1536 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1537 /* `/../' is the "superroot" on certain file systems. */
1539 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1541 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1543 /* Keep initial / only if this is the whole name. */
1544 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1552 #endif /* not VMS */
1556 /* At last, set drive name. */
1558 /* Except for network file name. */
1559 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1560 #endif /* WINDOWSNT */
1562 if (!drive
) abort ();
1564 target
[0] = DRIVE_LETTER (drive
);
1567 /* Reinsert the escape prefix if required. */
1574 CORRECT_DIR_SEPS (target
);
1577 return make_string (target
, o
- target
);
1581 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1582 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1583 "Convert FILENAME to absolute, and canonicalize it.\n\
1584 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1585 (does not start with slash); if DEFAULT is nil or missing,\n\
1586 the current buffer's value of default-directory is used.\n\
1587 Filenames containing `.' or `..' as components are simplified;\n\
1588 initial `~/' expands to your home directory.\n\
1589 See also the function `substitute-in-file-name'.")
1591 Lisp_Object name
, defalt
;
1595 register unsigned char *newdir
, *p
, *o
;
1597 unsigned char *target
;
1601 unsigned char * colon
= 0;
1602 unsigned char * close
= 0;
1603 unsigned char * slash
= 0;
1604 unsigned char * brack
= 0;
1605 int lbrack
= 0, rbrack
= 0;
1609 CHECK_STRING (name
, 0);
1612 /* Filenames on VMS are always upper case. */
1613 name
= Fupcase (name
);
1616 nm
= XSTRING (name
)->data
;
1618 /* If nm is absolute, flush ...// and detect /./ and /../.
1619 If no /./ or /../ we can return right away. */
1631 if (p
[0] == '/' && p
[1] == '/'
1633 /* // at start of filename is meaningful on Apollo system. */
1638 if (p
[0] == '/' && p
[1] == '~')
1639 nm
= p
+ 1, lose
= 1;
1640 if (p
[0] == '/' && p
[1] == '.'
1641 && (p
[2] == '/' || p
[2] == 0
1642 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1648 /* if dev:[dir]/, move nm to / */
1649 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1650 nm
= (brack
? brack
+ 1 : colon
+ 1);
1651 lbrack
= rbrack
= 0;
1659 /* VMS pre V4.4,convert '-'s in filenames. */
1660 if (lbrack
== rbrack
)
1662 if (dots
< 2) /* this is to allow negative version numbers */
1667 if (lbrack
> rbrack
&&
1668 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1669 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1675 /* count open brackets, reset close bracket pointer */
1676 if (p
[0] == '[' || p
[0] == '<')
1677 lbrack
++, brack
= 0;
1678 /* count close brackets, set close bracket pointer */
1679 if (p
[0] == ']' || p
[0] == '>')
1680 rbrack
++, brack
= p
;
1681 /* detect ][ or >< */
1682 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1684 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1685 nm
= p
+ 1, lose
= 1;
1686 if (p
[0] == ':' && (colon
|| slash
))
1687 /* if dev1:[dir]dev2:, move nm to dev2: */
1693 /* If /name/dev:, move nm to dev: */
1696 /* If node::dev:, move colon following dev */
1697 else if (colon
&& colon
[-1] == ':')
1699 /* If dev1:dev2:, move nm to dev2: */
1700 else if (colon
&& colon
[-1] != ':')
1705 if (p
[0] == ':' && !colon
)
1711 if (lbrack
== rbrack
)
1714 else if (p
[0] == '.')
1722 if (index (nm
, '/'))
1723 return build_string (sys_translate_unix (nm
));
1725 if (nm
== XSTRING (name
)->data
)
1727 return build_string (nm
);
1731 /* Now determine directory to start with and put it in NEWDIR */
1735 if (nm
[0] == '~') /* prefix ~ */
1740 || nm
[1] == 0)/* ~/filename */
1742 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1743 newdir
= (unsigned char *) "";
1746 nm
++; /* Don't leave the slash in nm. */
1749 else /* ~user/filename */
1751 /* Get past ~ to user */
1752 unsigned char *user
= nm
+ 1;
1753 /* Find end of name. */
1754 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1755 int len
= ptr
? ptr
- user
: strlen (user
);
1757 unsigned char *ptr1
= index (user
, ':');
1758 if (ptr1
!= 0 && ptr1
- user
< len
)
1761 /* Copy the user name into temp storage. */
1762 o
= (unsigned char *) alloca (len
+ 1);
1763 bcopy ((char *) user
, o
, len
);
1766 /* Look up the user name. */
1767 pw
= (struct passwd
*) getpwnam (o
+ 1);
1769 error ("\"%s\" isn't a registered user", o
+ 1);
1771 newdir
= (unsigned char *) pw
->pw_dir
;
1773 /* Discard the user name from NM. */
1780 #endif /* not VMS */
1784 defalt
= current_buffer
->directory
;
1785 CHECK_STRING (defalt
, 1);
1786 newdir
= XSTRING (defalt
)->data
;
1789 /* Now concatenate the directory and name to new space in the stack frame */
1791 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1792 target
= (unsigned char *) alloca (tlen
);
1798 if (nm
[0] == 0 || nm
[0] == '/')
1799 strcpy (target
, newdir
);
1802 file_name_as_directory (target
, newdir
);
1805 strcat (target
, nm
);
1807 if (index (target
, '/'))
1808 strcpy (target
, sys_translate_unix (target
));
1811 /* Now canonicalize by removing /. and /foo/.. if they appear */
1819 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1825 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1826 /* brackets are offset from each other by 2 */
1829 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1830 /* convert [foo][bar] to [bar] */
1831 while (o
[-1] != '[' && o
[-1] != '<')
1833 else if (*p
== '-' && *o
!= '.')
1836 else if (p
[0] == '-' && o
[-1] == '.' &&
1837 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1838 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1842 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1843 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1845 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1847 /* else [foo.-] ==> [-] */
1853 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1854 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1864 else if (!strncmp (p
, "//", 2)
1866 /* // at start of filename is meaningful in Apollo system. */
1874 else if (p
[0] == '/' && p
[1] == '.' &&
1875 (p
[2] == '/' || p
[2] == 0))
1877 else if (!strncmp (p
, "/..", 3)
1878 /* `/../' is the "superroot" on certain file systems. */
1880 && (p
[3] == '/' || p
[3] == 0))
1882 while (o
!= target
&& *--o
!= '/')
1885 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1889 if (o
== target
&& *o
== '/')
1897 #endif /* not VMS */
1900 return make_string (target
, o
- target
);
1904 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1905 Ssubstitute_in_file_name
, 1, 1, 0,
1906 "Substitute environment variables referred to in FILENAME.\n\
1907 `$FOO' where FOO is an environment variable name means to substitute\n\
1908 the value of that variable. The variable name should be terminated\n\
1909 with a character not a letter, digit or underscore; otherwise, enclose\n\
1910 the entire variable name in braces.\n\
1911 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1912 On VMS, `$' substitution is not done; this function does little and only\n\
1913 duplicates what `expand-file-name' does.")
1915 Lisp_Object filename
;
1919 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1920 unsigned char *target
;
1922 int substituted
= 0;
1924 Lisp_Object handler
;
1926 CHECK_STRING (filename
, 0);
1928 /* If the file name has special constructs in it,
1929 call the corresponding file handler. */
1930 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1931 if (!NILP (handler
))
1932 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1934 nm
= XSTRING (filename
)->data
;
1936 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1937 CORRECT_DIR_SEPS (nm
);
1938 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1940 endp
= nm
+ STRING_BYTES (XSTRING (filename
));
1942 /* If /~ or // appears, discard everything through first slash. */
1944 for (p
= nm
; p
!= endp
; p
++)
1947 #if defined (APOLLO) || defined (WINDOWSNT)
1948 /* // at start of file name is meaningful in Apollo and
1949 WindowsNT systems. */
1950 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1951 #else /* not (APOLLO || WINDOWSNT) */
1952 || IS_DIRECTORY_SEP (p
[0])
1953 #endif /* not (APOLLO || WINDOWSNT) */
1958 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1960 || IS_DIRECTORY_SEP (p
[-1])))
1966 /* see comment in expand-file-name about drive specifiers */
1967 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1968 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1977 return build_string (nm
);
1980 /* See if any variables are substituted into the string
1981 and find the total length of their values in `total' */
1983 for (p
= nm
; p
!= endp
;)
1993 /* "$$" means a single "$" */
2002 while (p
!= endp
&& *p
!= '}') p
++;
2003 if (*p
!= '}') goto missingclose
;
2009 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2013 /* Copy out the variable name */
2014 target
= (unsigned char *) alloca (s
- o
+ 1);
2015 strncpy (target
, o
, s
- o
);
2018 strupr (target
); /* $home == $HOME etc. */
2021 /* Get variable value */
2022 o
= (unsigned char *) egetenv (target
);
2023 if (!o
) goto badvar
;
2024 total
+= strlen (o
);
2031 /* If substitution required, recopy the string and do it */
2032 /* Make space in stack frame for the new copy */
2033 xnm
= (unsigned char *) alloca (STRING_BYTES (XSTRING (filename
)) + total
+ 1);
2036 /* Copy the rest of the name through, replacing $ constructs with values */
2053 while (p
!= endp
&& *p
!= '}') p
++;
2054 if (*p
!= '}') goto missingclose
;
2060 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2064 /* Copy out the variable name */
2065 target
= (unsigned char *) alloca (s
- o
+ 1);
2066 strncpy (target
, o
, s
- o
);
2069 strupr (target
); /* $home == $HOME etc. */
2072 /* Get variable value */
2073 o
= (unsigned char *) egetenv (target
);
2077 if (STRING_MULTIBYTE (filename
))
2079 /* If the original string is multibyte,
2080 convert what we substitute into multibyte. */
2081 unsigned char workbuf
[4], *str
;
2087 c
= unibyte_char_to_multibyte (c
);
2088 if (! SINGLE_BYTE_CHAR_P (c
))
2090 len
= CHAR_STRING (c
, workbuf
, str
);
2091 bcopy (str
, x
, len
);
2107 /* If /~ or // appears, discard everything through first slash. */
2109 for (p
= xnm
; p
!= x
; p
++)
2111 #if defined (APOLLO) || defined (WINDOWSNT)
2112 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2113 #else /* not (APOLLO || WINDOWSNT) */
2114 || IS_DIRECTORY_SEP (p
[0])
2115 #endif /* not (APOLLO || WINDOWSNT) */
2117 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2120 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2121 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2125 if (STRING_MULTIBYTE (filename
))
2126 return make_string (xnm
, x
- xnm
);
2127 return make_unibyte_string (xnm
, x
- xnm
);
2130 error ("Bad format environment-variable substitution");
2132 error ("Missing \"}\" in environment-variable substitution");
2134 error ("Substituting nonexistent environment variable \"%s\"", target
);
2137 #endif /* not VMS */
2140 /* A slightly faster and more convenient way to get
2141 (directory-file-name (expand-file-name FOO)). */
2144 expand_and_dir_to_file (filename
, defdir
)
2145 Lisp_Object filename
, defdir
;
2147 register Lisp_Object absname
;
2149 absname
= Fexpand_file_name (filename
, defdir
);
2152 register int c
= XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1];
2153 if (c
== ':' || c
== ']' || c
== '>')
2154 absname
= Fdirectory_file_name (absname
);
2157 /* Remove final slash, if any (unless this is the root dir).
2158 stat behaves differently depending! */
2159 if (XSTRING (absname
)->size
> 1
2160 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1])
2161 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
))-2]))
2162 /* We cannot take shortcuts; they might be wrong for magic file names. */
2163 absname
= Fdirectory_file_name (absname
);
2168 /* Signal an error if the file ABSNAME already exists.
2169 If INTERACTIVE is nonzero, ask the user whether to proceed,
2170 and bypass the error if the user says to go ahead.
2171 QUERYSTRING is a name for the action that is being considered
2174 *STATPTR is used to store the stat information if the file exists.
2175 If the file does not exist, STATPTR->st_mode is set to 0.
2176 If STATPTR is null, we don't store into it.
2178 If QUICK is nonzero, we ask for y or n, not yes or no. */
2181 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2182 Lisp_Object absname
;
2183 unsigned char *querystring
;
2185 struct stat
*statptr
;
2188 register Lisp_Object tem
, encoded_filename
;
2189 struct stat statbuf
;
2190 struct gcpro gcpro1
;
2192 encoded_filename
= ENCODE_FILE (absname
);
2194 /* stat is a good way to tell whether the file exists,
2195 regardless of what access permissions it has. */
2196 if (stat (XSTRING (encoded_filename
)->data
, &statbuf
) >= 0)
2199 Fsignal (Qfile_already_exists
,
2200 Fcons (build_string ("File already exists"),
2201 Fcons (absname
, Qnil
)));
2203 tem
= format1 ("File %s already exists; %s anyway? ",
2204 XSTRING (absname
)->data
, querystring
);
2206 tem
= Fy_or_n_p (tem
);
2208 tem
= do_yes_or_no_p (tem
);
2211 Fsignal (Qfile_already_exists
,
2212 Fcons (build_string ("File already exists"),
2213 Fcons (absname
, Qnil
)));
2220 statptr
->st_mode
= 0;
2225 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2226 "fCopy file: \nFCopy %s to file: \np\nP",
2227 "Copy FILE to NEWNAME. Both args must be strings.\n\
2228 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2229 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2230 A number as third arg means request confirmation if NEWNAME already exists.\n\
2231 This is what happens in interactive use with M-x.\n\
2232 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2233 last-modified time as the old one. (This works on only some systems.)\n\
2234 A prefix arg makes KEEP-TIME non-nil.")
2235 (file
, newname
, ok_if_already_exists
, keep_date
)
2236 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2239 char buf
[16 * 1024];
2240 struct stat st
, out_st
;
2241 Lisp_Object handler
;
2242 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2243 int count
= specpdl_ptr
- specpdl
;
2244 int input_file_statable_p
;
2245 Lisp_Object encoded_file
, encoded_newname
;
2247 encoded_file
= encoded_newname
= Qnil
;
2248 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2249 CHECK_STRING (file
, 0);
2250 CHECK_STRING (newname
, 1);
2252 file
= Fexpand_file_name (file
, Qnil
);
2253 newname
= Fexpand_file_name (newname
, Qnil
);
2255 /* If the input file name has special constructs in it,
2256 call the corresponding file handler. */
2257 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2258 /* Likewise for output file name. */
2260 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2261 if (!NILP (handler
))
2262 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2263 ok_if_already_exists
, keep_date
));
2265 encoded_file
= ENCODE_FILE (file
);
2266 encoded_newname
= ENCODE_FILE (newname
);
2268 if (NILP (ok_if_already_exists
)
2269 || INTEGERP (ok_if_already_exists
))
2270 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2271 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2272 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2275 ifd
= open (XSTRING (encoded_file
)->data
, O_RDONLY
);
2277 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2279 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2281 /* We can only copy regular files and symbolic links. Other files are not
2283 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2285 #if !defined (DOS_NT) || __DJGPP__ > 1
2286 if (out_st
.st_mode
!= 0
2287 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2290 report_file_error ("Input and output files are the same",
2291 Fcons (file
, Fcons (newname
, Qnil
)));
2295 #if defined (S_ISREG) && defined (S_ISLNK)
2296 if (input_file_statable_p
)
2298 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2300 #if defined (EISDIR)
2301 /* Get a better looking error message. */
2304 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2307 #endif /* S_ISREG && S_ISLNK */
2310 /* Create the copy file with the same record format as the input file */
2311 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2314 /* System's default file type was set to binary by _fmode in emacs.c. */
2315 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2316 #else /* not MSDOS */
2317 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2318 #endif /* not MSDOS */
2321 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2323 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2327 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2328 if (write (ofd
, buf
, n
) != n
)
2329 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2332 /* Closing the output clobbers the file times on some systems. */
2333 if (close (ofd
) < 0)
2334 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2336 if (input_file_statable_p
)
2338 if (!NILP (keep_date
))
2340 EMACS_TIME atime
, mtime
;
2341 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2342 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2343 if (set_file_times (XSTRING (encoded_newname
)->data
,
2345 Fsignal (Qfile_date_error
,
2346 Fcons (build_string ("Cannot set file date"),
2347 Fcons (newname
, Qnil
)));
2350 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2352 #if defined (__DJGPP__) && __DJGPP__ > 1
2353 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2354 and if it can't, it tells so. Otherwise, under MSDOS we usually
2355 get only the READ bit, which will make the copied file read-only,
2356 so it's better not to chmod at all. */
2357 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2358 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2359 #endif /* DJGPP version 2 or newer */
2365 /* Discard the unwind protects. */
2366 specpdl_ptr
= specpdl
+ count
;
2372 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2373 Smake_directory_internal
, 1, 1, 0,
2374 "Create a new directory named DIRECTORY.")
2376 Lisp_Object directory
;
2379 Lisp_Object handler
;
2380 Lisp_Object encoded_dir
;
2382 CHECK_STRING (directory
, 0);
2383 directory
= Fexpand_file_name (directory
, Qnil
);
2385 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2386 if (!NILP (handler
))
2387 return call2 (handler
, Qmake_directory_internal
, directory
);
2389 encoded_dir
= ENCODE_FILE (directory
);
2391 dir
= XSTRING (encoded_dir
)->data
;
2394 if (mkdir (dir
) != 0)
2396 if (mkdir (dir
, 0777) != 0)
2398 report_file_error ("Creating directory", Flist (1, &directory
));
2403 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2404 "Delete the directory named DIRECTORY.")
2406 Lisp_Object directory
;
2409 Lisp_Object handler
;
2410 Lisp_Object encoded_dir
;
2412 CHECK_STRING (directory
, 0);
2413 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2415 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2416 if (!NILP (handler
))
2417 return call2 (handler
, Qdelete_directory
, directory
);
2419 encoded_dir
= ENCODE_FILE (directory
);
2421 dir
= XSTRING (encoded_dir
)->data
;
2423 if (rmdir (dir
) != 0)
2424 report_file_error ("Removing directory", Flist (1, &directory
));
2429 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2430 "Delete file named FILENAME.\n\
2431 If file has multiple names, it continues to exist with the other names.")
2433 Lisp_Object filename
;
2435 Lisp_Object handler
;
2436 Lisp_Object encoded_file
;
2438 CHECK_STRING (filename
, 0);
2439 filename
= Fexpand_file_name (filename
, Qnil
);
2441 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2442 if (!NILP (handler
))
2443 return call2 (handler
, Qdelete_file
, filename
);
2445 encoded_file
= ENCODE_FILE (filename
);
2447 if (0 > unlink (XSTRING (encoded_file
)->data
))
2448 report_file_error ("Removing old name", Flist (1, &filename
));
2453 internal_delete_file_1 (ignore
)
2459 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2462 internal_delete_file (filename
)
2463 Lisp_Object filename
;
2465 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2466 Qt
, internal_delete_file_1
));
2469 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2470 "fRename file: \nFRename %s to file: \np",
2471 "Rename FILE as NEWNAME. Both args strings.\n\
2472 If file has names other than FILE, it continues to have those names.\n\
2473 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2474 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2475 A number as third arg means request confirmation if NEWNAME already exists.\n\
2476 This is what happens in interactive use with M-x.")
2477 (file
, newname
, ok_if_already_exists
)
2478 Lisp_Object file
, newname
, ok_if_already_exists
;
2481 Lisp_Object args
[2];
2483 Lisp_Object handler
;
2484 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2485 Lisp_Object encoded_file
, encoded_newname
;
2487 encoded_file
= encoded_newname
= Qnil
;
2488 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2489 CHECK_STRING (file
, 0);
2490 CHECK_STRING (newname
, 1);
2491 file
= Fexpand_file_name (file
, Qnil
);
2492 newname
= Fexpand_file_name (newname
, Qnil
);
2494 /* If the file name has special constructs in it,
2495 call the corresponding file handler. */
2496 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2498 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2499 if (!NILP (handler
))
2500 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2501 file
, newname
, ok_if_already_exists
));
2503 encoded_file
= ENCODE_FILE (file
);
2504 encoded_newname
= ENCODE_FILE (newname
);
2506 if (NILP (ok_if_already_exists
)
2507 || INTEGERP (ok_if_already_exists
))
2508 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2509 INTEGERP (ok_if_already_exists
), 0, 0);
2511 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2513 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2514 || 0 > unlink (XSTRING (encoded_file
)->data
))
2519 Fcopy_file (file
, newname
,
2520 /* We have already prompted if it was an integer,
2521 so don't have copy-file prompt again. */
2522 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2523 Fdelete_file (file
);
2530 report_file_error ("Renaming", Flist (2, args
));
2533 report_file_error ("Renaming", Flist (2, &file
));
2540 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2541 "fAdd name to file: \nFName to add to %s: \np",
2542 "Give FILE additional name NEWNAME. Both args strings.\n\
2543 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2544 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2545 A number as third arg means request confirmation if NEWNAME already exists.\n\
2546 This is what happens in interactive use with M-x.")
2547 (file
, newname
, ok_if_already_exists
)
2548 Lisp_Object file
, newname
, ok_if_already_exists
;
2551 Lisp_Object args
[2];
2553 Lisp_Object handler
;
2554 Lisp_Object encoded_file
, encoded_newname
;
2555 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2557 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2558 encoded_file
= encoded_newname
= Qnil
;
2559 CHECK_STRING (file
, 0);
2560 CHECK_STRING (newname
, 1);
2561 file
= Fexpand_file_name (file
, Qnil
);
2562 newname
= Fexpand_file_name (newname
, Qnil
);
2564 /* If the file name has special constructs in it,
2565 call the corresponding file handler. */
2566 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2567 if (!NILP (handler
))
2568 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2569 newname
, ok_if_already_exists
));
2571 /* If the new name has special constructs in it,
2572 call the corresponding file handler. */
2573 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2574 if (!NILP (handler
))
2575 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2576 newname
, ok_if_already_exists
));
2578 encoded_file
= ENCODE_FILE (file
);
2579 encoded_newname
= ENCODE_FILE (newname
);
2581 if (NILP (ok_if_already_exists
)
2582 || INTEGERP (ok_if_already_exists
))
2583 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2584 INTEGERP (ok_if_already_exists
), 0, 0);
2586 unlink (XSTRING (newname
)->data
);
2587 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2592 report_file_error ("Adding new name", Flist (2, args
));
2594 report_file_error ("Adding new name", Flist (2, &file
));
2603 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2604 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2605 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2606 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2607 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2608 A number as third arg means request confirmation if LINKNAME already exists.\n\
2609 This happens for interactive use with M-x.")
2610 (filename
, linkname
, ok_if_already_exists
)
2611 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2614 Lisp_Object args
[2];
2616 Lisp_Object handler
;
2617 Lisp_Object encoded_filename
, encoded_linkname
;
2618 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2620 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2621 encoded_filename
= encoded_linkname
= Qnil
;
2622 CHECK_STRING (filename
, 0);
2623 CHECK_STRING (linkname
, 1);
2624 /* If the link target has a ~, we must expand it to get
2625 a truly valid file name. Otherwise, do not expand;
2626 we want to permit links to relative file names. */
2627 if (XSTRING (filename
)->data
[0] == '~')
2628 filename
= Fexpand_file_name (filename
, Qnil
);
2629 linkname
= Fexpand_file_name (linkname
, Qnil
);
2631 /* If the file name has special constructs in it,
2632 call the corresponding file handler. */
2633 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2634 if (!NILP (handler
))
2635 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2636 linkname
, ok_if_already_exists
));
2638 /* If the new link name has special constructs in it,
2639 call the corresponding file handler. */
2640 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2641 if (!NILP (handler
))
2642 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2643 linkname
, ok_if_already_exists
));
2645 encoded_filename
= ENCODE_FILE (filename
);
2646 encoded_linkname
= ENCODE_FILE (linkname
);
2648 if (NILP (ok_if_already_exists
)
2649 || INTEGERP (ok_if_already_exists
))
2650 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2651 INTEGERP (ok_if_already_exists
), 0, 0);
2652 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2653 XSTRING (encoded_linkname
)->data
))
2655 /* If we didn't complain already, silently delete existing file. */
2656 if (errno
== EEXIST
)
2658 unlink (XSTRING (encoded_linkname
)->data
);
2659 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2660 XSTRING (encoded_linkname
)->data
))
2670 report_file_error ("Making symbolic link", Flist (2, args
));
2672 report_file_error ("Making symbolic link", Flist (2, &filename
));
2678 #endif /* S_IFLNK */
2682 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2683 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2684 "Define the job-wide logical name NAME to have the value STRING.\n\
2685 If STRING is nil or a null string, the logical name NAME is deleted.")
2690 CHECK_STRING (name
, 0);
2692 delete_logical_name (XSTRING (name
)->data
);
2695 CHECK_STRING (string
, 1);
2697 if (XSTRING (string
)->size
== 0)
2698 delete_logical_name (XSTRING (name
)->data
);
2700 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2709 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2710 "Open a network connection to PATH using LOGIN as the login string.")
2712 Lisp_Object path
, login
;
2716 CHECK_STRING (path
, 0);
2717 CHECK_STRING (login
, 0);
2719 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2721 if (netresult
== -1)
2726 #endif /* HPUX_NET */
2728 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2730 "Return t if file FILENAME specifies an absolute file name.\n\
2731 On Unix, this is a name starting with a `/' or a `~'.")
2733 Lisp_Object filename
;
2737 CHECK_STRING (filename
, 0);
2738 ptr
= XSTRING (filename
)->data
;
2739 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2741 /* ??? This criterion is probably wrong for '<'. */
2742 || index (ptr
, ':') || index (ptr
, '<')
2743 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2747 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2755 /* Return nonzero if file FILENAME exists and can be executed. */
2758 check_executable (filename
)
2762 int len
= strlen (filename
);
2765 if (stat (filename
, &st
) < 0)
2767 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2768 return ((st
.st_mode
& S_IEXEC
) != 0);
2770 return (S_ISREG (st
.st_mode
)
2772 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2773 || stricmp (suffix
, ".exe") == 0
2774 || stricmp (suffix
, ".bat") == 0)
2775 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2776 #endif /* not WINDOWSNT */
2777 #else /* not DOS_NT */
2778 #ifdef HAVE_EUIDACCESS
2779 return (euidaccess (filename
, 1) >= 0);
2781 /* Access isn't quite right because it uses the real uid
2782 and we really want to test with the effective uid.
2783 But Unix doesn't give us a right way to do it. */
2784 return (access (filename
, 1) >= 0);
2786 #endif /* not DOS_NT */
2789 /* Return nonzero if file FILENAME exists and can be written. */
2792 check_writable (filename
)
2797 if (stat (filename
, &st
) < 0)
2799 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2800 #else /* not MSDOS */
2801 #ifdef HAVE_EUIDACCESS
2802 return (euidaccess (filename
, 2) >= 0);
2804 /* Access isn't quite right because it uses the real uid
2805 and we really want to test with the effective uid.
2806 But Unix doesn't give us a right way to do it.
2807 Opening with O_WRONLY could work for an ordinary file,
2808 but would lose for directories. */
2809 return (access (filename
, 2) >= 0);
2811 #endif /* not MSDOS */
2814 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2815 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2816 See also `file-readable-p' and `file-attributes'.")
2818 Lisp_Object filename
;
2820 Lisp_Object absname
;
2821 Lisp_Object handler
;
2822 struct stat statbuf
;
2824 CHECK_STRING (filename
, 0);
2825 absname
= Fexpand_file_name (filename
, Qnil
);
2827 /* If the file name has special constructs in it,
2828 call the corresponding file handler. */
2829 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2830 if (!NILP (handler
))
2831 return call2 (handler
, Qfile_exists_p
, absname
);
2833 absname
= ENCODE_FILE (absname
);
2835 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2838 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2839 "Return t if FILENAME can be executed by you.\n\
2840 For a directory, this means you can access files in that directory.")
2842 Lisp_Object filename
;
2845 Lisp_Object absname
;
2846 Lisp_Object handler
;
2848 CHECK_STRING (filename
, 0);
2849 absname
= Fexpand_file_name (filename
, Qnil
);
2851 /* If the file name has special constructs in it,
2852 call the corresponding file handler. */
2853 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2854 if (!NILP (handler
))
2855 return call2 (handler
, Qfile_executable_p
, absname
);
2857 absname
= ENCODE_FILE (absname
);
2859 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2862 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2863 "Return t if file FILENAME exists and you can read it.\n\
2864 See also `file-exists-p' and `file-attributes'.")
2866 Lisp_Object filename
;
2868 Lisp_Object absname
;
2869 Lisp_Object handler
;
2872 struct stat statbuf
;
2874 CHECK_STRING (filename
, 0);
2875 absname
= Fexpand_file_name (filename
, Qnil
);
2877 /* If the file name has special constructs in it,
2878 call the corresponding file handler. */
2879 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2880 if (!NILP (handler
))
2881 return call2 (handler
, Qfile_readable_p
, absname
);
2883 absname
= ENCODE_FILE (absname
);
2886 /* Under MS-DOS and Windows, open does not work for directories. */
2887 if (access (XSTRING (absname
)->data
, 0) == 0)
2890 #else /* not DOS_NT */
2892 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2893 /* Opening a fifo without O_NONBLOCK can wait.
2894 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2895 except in the case of a fifo, on a system which handles it. */
2896 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2899 if (S_ISFIFO (statbuf
.st_mode
))
2900 flags
|= O_NONBLOCK
;
2902 desc
= open (XSTRING (absname
)->data
, flags
);
2907 #endif /* not DOS_NT */
2910 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2912 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2913 "Return t if file FILENAME can be written or created by you.")
2915 Lisp_Object filename
;
2917 Lisp_Object absname
, dir
, encoded
;
2918 Lisp_Object handler
;
2919 struct stat statbuf
;
2921 CHECK_STRING (filename
, 0);
2922 absname
= Fexpand_file_name (filename
, Qnil
);
2924 /* If the file name has special constructs in it,
2925 call the corresponding file handler. */
2926 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2927 if (!NILP (handler
))
2928 return call2 (handler
, Qfile_writable_p
, absname
);
2930 encoded
= ENCODE_FILE (absname
);
2931 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
2932 return (check_writable (XSTRING (encoded
)->data
)
2935 dir
= Ffile_name_directory (absname
);
2938 dir
= Fdirectory_file_name (dir
);
2942 dir
= Fdirectory_file_name (dir
);
2945 dir
= ENCODE_FILE (dir
);
2946 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2950 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2951 "Access file FILENAME, and get an error if that does not work.\n\
2952 The second argument STRING is used in the error message.\n\
2953 If there is no error, we return nil.")
2955 Lisp_Object filename
, string
;
2957 Lisp_Object handler
, encoded_filename
;
2960 CHECK_STRING (filename
, 0);
2961 CHECK_STRING (string
, 1);
2963 /* If the file name has special constructs in it,
2964 call the corresponding file handler. */
2965 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2966 if (!NILP (handler
))
2967 return call3 (handler
, Qaccess_file
, filename
, string
);
2969 encoded_filename
= ENCODE_FILE (filename
);
2971 fd
= open (XSTRING (encoded_filename
)->data
, O_RDONLY
);
2973 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2979 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2980 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2981 The value is the name of the file to which it is linked.\n\
2982 Otherwise returns nil.")
2984 Lisp_Object filename
;
2991 Lisp_Object handler
;
2993 CHECK_STRING (filename
, 0);
2994 filename
= Fexpand_file_name (filename
, Qnil
);
2996 /* If the file name has special constructs in it,
2997 call the corresponding file handler. */
2998 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2999 if (!NILP (handler
))
3000 return call2 (handler
, Qfile_symlink_p
, filename
);
3002 filename
= ENCODE_FILE (filename
);
3007 buf
= (char *) xmalloc (bufsize
);
3008 bzero (buf
, bufsize
);
3009 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
3010 if (valsize
< bufsize
) break;
3011 /* Buffer was not long enough */
3020 val
= make_string (buf
, valsize
);
3022 val
= DECODE_FILE (val
);
3024 #else /* not S_IFLNK */
3026 #endif /* not S_IFLNK */
3029 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3030 "Return t if FILENAME names an existing directory.\n\
3031 Symbolic links to directories count as directories.\n\
3032 See `file-symlink-p' to distinguish symlinks.")
3034 Lisp_Object filename
;
3036 register Lisp_Object absname
;
3038 Lisp_Object handler
;
3040 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3042 /* If the file name has special constructs in it,
3043 call the corresponding file handler. */
3044 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3045 if (!NILP (handler
))
3046 return call2 (handler
, Qfile_directory_p
, absname
);
3048 absname
= ENCODE_FILE (absname
);
3050 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3052 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3055 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3056 "Return t if file FILENAME is the name of a directory as a file,\n\
3057 and files in that directory can be opened by you. In order to use a\n\
3058 directory as a buffer's current directory, this predicate must return true.\n\
3059 A directory name spec may be given instead; then the value is t\n\
3060 if the directory so specified exists and really is a readable and\n\
3061 searchable directory.")
3063 Lisp_Object filename
;
3065 Lisp_Object handler
;
3067 struct gcpro gcpro1
;
3069 /* If the file name has special constructs in it,
3070 call the corresponding file handler. */
3071 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3072 if (!NILP (handler
))
3073 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3075 /* It's an unlikely combination, but yes we really do need to gcpro:
3076 Suppose that file-accessible-directory-p has no handler, but
3077 file-directory-p does have a handler; this handler causes a GC which
3078 relocates the string in `filename'; and finally file-directory-p
3079 returns non-nil. Then we would end up passing a garbaged string
3080 to file-executable-p. */
3082 tem
= (NILP (Ffile_directory_p (filename
))
3083 || NILP (Ffile_executable_p (filename
)));
3085 return tem
? Qnil
: Qt
;
3088 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3089 "Return t if file FILENAME is the name of a regular file.\n\
3090 This is the sort of file that holds an ordinary stream of data bytes.")
3092 Lisp_Object filename
;
3094 register Lisp_Object absname
;
3096 Lisp_Object handler
;
3098 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3100 /* If the file name has special constructs in it,
3101 call the corresponding file handler. */
3102 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3103 if (!NILP (handler
))
3104 return call2 (handler
, Qfile_regular_p
, absname
);
3106 absname
= ENCODE_FILE (absname
);
3111 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3113 /* Tell stat to use expensive method to get accurate info. */
3114 Vw32_get_true_file_attributes
= Qt
;
3115 result
= stat (XSTRING (absname
)->data
, &st
);
3116 Vw32_get_true_file_attributes
= tem
;
3120 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3123 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3125 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3129 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3130 "Return mode bits of file named FILENAME, as an integer.")
3132 Lisp_Object filename
;
3134 Lisp_Object absname
;
3136 Lisp_Object handler
;
3138 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3140 /* If the file name has special constructs in it,
3141 call the corresponding file handler. */
3142 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3143 if (!NILP (handler
))
3144 return call2 (handler
, Qfile_modes
, absname
);
3146 absname
= ENCODE_FILE (absname
);
3148 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3150 #if defined (MSDOS) && __DJGPP__ < 2
3151 if (check_executable (XSTRING (absname
)->data
))
3152 st
.st_mode
|= S_IEXEC
;
3153 #endif /* MSDOS && __DJGPP__ < 2 */
3155 return make_number (st
.st_mode
& 07777);
3158 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3159 "Set mode bits of file named FILENAME to MODE (an integer).\n\
3160 Only the 12 low bits of MODE are used.")
3162 Lisp_Object filename
, mode
;
3164 Lisp_Object absname
, encoded_absname
;
3165 Lisp_Object handler
;
3167 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3168 CHECK_NUMBER (mode
, 1);
3170 /* If the file name has special constructs in it,
3171 call the corresponding file handler. */
3172 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3173 if (!NILP (handler
))
3174 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3176 encoded_absname
= ENCODE_FILE (absname
);
3178 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
3179 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3184 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3185 "Set the file permission bits for newly created files.\n\
3186 The argument MODE should be an integer; only the low 9 bits are used.\n\
3187 This setting is inherited by subprocesses.")
3191 CHECK_NUMBER (mode
, 0);
3193 umask ((~ XINT (mode
)) & 0777);
3198 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3199 "Return the default file protection for created files.\n\
3200 The value is an integer.")
3206 realmask
= umask (0);
3209 XSETINT (value
, (~ realmask
) & 0777);
3215 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3216 "Tell Unix to finish all pending disk updates.")
3225 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3226 "Return t if file FILE1 is newer than file FILE2.\n\
3227 If FILE1 does not exist, the answer is nil;\n\
3228 otherwise, if FILE2 does not exist, the answer is t.")
3230 Lisp_Object file1
, file2
;
3232 Lisp_Object absname1
, absname2
;
3235 Lisp_Object handler
;
3236 struct gcpro gcpro1
, gcpro2
;
3238 CHECK_STRING (file1
, 0);
3239 CHECK_STRING (file2
, 0);
3242 GCPRO2 (absname1
, file2
);
3243 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3244 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3247 /* If the file name has special constructs in it,
3248 call the corresponding file handler. */
3249 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3251 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3252 if (!NILP (handler
))
3253 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3255 GCPRO2 (absname1
, absname2
);
3256 absname1
= ENCODE_FILE (absname1
);
3257 absname2
= ENCODE_FILE (absname2
);
3260 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3263 mtime1
= st
.st_mtime
;
3265 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3268 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3272 Lisp_Object Qfind_buffer_file_type
;
3275 #ifndef READ_BUF_SIZE
3276 #define READ_BUF_SIZE (64 << 10)
3279 /* This function is called when a function bound to
3280 Vset_auto_coding_function causes some error. At that time, a text
3281 of a file has already been inserted in the current buffer, but,
3282 markers has not yet been adjusted. Thus we must adjust markers
3283 here. We are sure that the buffer was empty before the text of the
3284 file was inserted. */
3287 set_auto_coding_unwind (multibyte
)
3288 Lisp_Object multibyte
;
3290 int inserted
= Z_BYTE
- BEG_BYTE
;
3292 if (!NILP (multibyte
))
3293 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
3294 adjust_after_insert (PT
, PT_BYTE
, Z
, Z_BYTE
, inserted
);
3299 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3301 "Insert contents of file FILENAME after point.\n\
3302 Returns list of absolute file name and number of bytes inserted.\n\
3303 If second argument VISIT is non-nil, the buffer's visited filename\n\
3304 and last save file modtime are set, and it is marked unmodified.\n\
3305 If visiting and the file does not exist, visiting is completed\n\
3306 before the error is signaled.\n\
3307 The optional third and fourth arguments BEG and END\n\
3308 specify what portion of the file to insert.\n\
3309 These arguments count bytes in the file, not characters in the buffer.\n\
3310 If VISIT is non-nil, BEG and END must be nil.\n\
3312 If optional fifth argument REPLACE is non-nil,\n\
3313 it means replace the current buffer contents (in the accessible portion)\n\
3314 with the file contents. This is better than simply deleting and inserting\n\
3315 the whole thing because (1) it preserves some marker positions\n\
3316 and (2) it puts less data in the undo list.\n\
3317 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3318 which is often less than the number of characters to be read.\n\
3320 This does code conversion according to the value of\n\
3321 `coding-system-for-read' or `file-coding-system-alist',\n\
3322 and sets the variable `last-coding-system-used' to the coding system\n\
3324 (filename
, visit
, beg
, end
, replace
)
3325 Lisp_Object filename
, visit
, beg
, end
, replace
;
3330 register int how_much
;
3331 register int unprocessed
;
3332 int count
= specpdl_ptr
- specpdl
;
3333 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3334 Lisp_Object handler
, val
, insval
, orig_filename
;
3337 int not_regular
= 0;
3338 unsigned char read_buf
[READ_BUF_SIZE
];
3339 struct coding_system coding
;
3340 unsigned char buffer
[1 << 14];
3341 int replace_handled
= 0;
3342 int set_coding_system
= 0;
3343 int coding_system_decided
= 0;
3345 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3346 error ("Cannot do file visiting in an indirect buffer");
3348 if (!NILP (current_buffer
->read_only
))
3349 Fbarf_if_buffer_read_only ();
3353 orig_filename
= Qnil
;
3355 GCPRO4 (filename
, val
, p
, orig_filename
);
3357 CHECK_STRING (filename
, 0);
3358 filename
= Fexpand_file_name (filename
, Qnil
);
3360 /* If the file name has special constructs in it,
3361 call the corresponding file handler. */
3362 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3363 if (!NILP (handler
))
3365 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3366 visit
, beg
, end
, replace
);
3367 if (CONSP (val
) && CONSP (XCONS (val
)->cdr
))
3368 inserted
= XINT (XCONS (XCONS (val
)->cdr
)->car
);
3372 orig_filename
= filename
;
3373 filename
= ENCODE_FILE (filename
);
3379 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3381 /* Tell stat to use expensive method to get accurate info. */
3382 Vw32_get_true_file_attributes
= Qt
;
3383 total
= stat (XSTRING (filename
)->data
, &st
);
3384 Vw32_get_true_file_attributes
= tem
;
3389 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3391 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3392 || fstat (fd
, &st
) < 0)
3393 #endif /* not APOLLO */
3394 #endif /* WINDOWSNT */
3396 if (fd
>= 0) close (fd
);
3399 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3402 if (!NILP (Vcoding_system_for_read
))
3403 current_buffer
->buffer_file_coding_system
= Vcoding_system_for_read
;
3408 /* This code will need to be changed in order to work on named
3409 pipes, and it's probably just not worth it. So we should at
3410 least signal an error. */
3411 if (!S_ISREG (st
.st_mode
))
3418 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3419 Fsignal (Qfile_error
,
3420 Fcons (build_string ("not a regular file"),
3421 Fcons (orig_filename
, Qnil
)));
3426 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3429 /* Replacement should preserve point as it preserves markers. */
3430 if (!NILP (replace
))
3431 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3433 record_unwind_protect (close_file_unwind
, make_number (fd
));
3435 /* Supposedly happens on VMS. */
3436 if (! not_regular
&& st
.st_size
< 0)
3437 error ("File size is negative");
3439 /* Prevent redisplay optimizations. */
3440 current_buffer
->clip_changed
= 1;
3442 if (!NILP (beg
) || !NILP (end
))
3444 error ("Attempt to visit less than an entire file");
3447 CHECK_NUMBER (beg
, 0);
3449 XSETFASTINT (beg
, 0);
3452 CHECK_NUMBER (end
, 0);
3457 XSETINT (end
, st
.st_size
);
3458 if (XINT (end
) != st
.st_size
)
3459 error ("Maximum buffer size exceeded");
3465 /* Decide the coding system to use for reading the file now
3466 because we can't use an optimized method for handling
3467 `coding:' tag if the current buffer is not empty. */
3471 if (!NILP (Vcoding_system_for_read
))
3472 val
= Vcoding_system_for_read
;
3473 else if (! NILP (replace
))
3474 /* In REPLACE mode, we can use the same coding system
3475 that was used to visit the file. */
3476 val
= current_buffer
->buffer_file_coding_system
;
3479 /* Don't try looking inside a file for a coding system
3480 specification if it is not seekable. */
3481 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3483 /* Find a coding system specified in the heading two
3484 lines or in the tailing several lines of the file.
3485 We assume that the 1K-byte and 3K-byte for heading
3486 and tailing respectively are sufficient for this
3488 int how_many
, nread
;
3490 if (st
.st_size
<= (1024 * 4))
3491 nread
= read (fd
, read_buf
, 1024 * 4);
3494 nread
= read (fd
, read_buf
, 1024);
3497 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3498 report_file_error ("Setting file position",
3499 Fcons (orig_filename
, Qnil
));
3500 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3505 error ("IO error reading %s: %s",
3506 XSTRING (orig_filename
)->data
, strerror (errno
));
3509 int count
= specpdl_ptr
- specpdl
;
3510 struct buffer
*prev
= current_buffer
;
3512 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3513 temp_output_buffer_setup (" *code-converting-work*");
3514 set_buffer_internal (XBUFFER (Vstandard_output
));
3515 current_buffer
->enable_multibyte_characters
= Qnil
;
3516 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3517 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3518 val
= call2 (Vset_auto_coding_function
,
3519 filename
, make_number (nread
));
3520 set_buffer_internal (prev
);
3521 /* Discard the unwind protect for recovering the
3525 /* Rewind the file for the actual read done later. */
3526 if (lseek (fd
, 0, 0) < 0)
3527 report_file_error ("Setting file position",
3528 Fcons (orig_filename
, Qnil
));
3534 /* If we have not yet decided a coding system, check
3535 file-coding-system-alist. */
3536 Lisp_Object args
[6], coding_systems
;
3538 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3539 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3540 coding_systems
= Ffind_operation_coding_system (6, args
);
3541 if (CONSP (coding_systems
))
3542 val
= XCONS (coding_systems
)->car
;
3546 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3548 if (NILP (current_buffer
->enable_multibyte_characters
)
3550 /* We must suppress all character code conversion except for
3551 end-of-line conversion. */
3552 setup_raw_text_coding_system (&coding
);
3554 coding_system_decided
= 1;
3557 /* Ensure we always set Vlast_coding_system_used. */
3558 set_coding_system
= 1;
3560 /* If requested, replace the accessible part of the buffer
3561 with the file contents. Avoid replacing text at the
3562 beginning or end of the buffer that matches the file contents;
3563 that preserves markers pointing to the unchanged parts.
3565 Here we implement this feature in an optimized way
3566 for the case where code conversion is NOT needed.
3567 The following if-statement handles the case of conversion
3568 in a less optimal way.
3570 If the code conversion is "automatic" then we try using this
3571 method and hope for the best.
3572 But if we discover the need for conversion, we give up on this method
3573 and let the following if-statement handle the replace job. */
3576 && ! CODING_REQUIRE_DECODING (&coding
)
3577 && (coding
.eol_type
== CODING_EOL_UNDECIDED
3578 || coding
.eol_type
== CODING_EOL_LF
))
3580 /* same_at_start and same_at_end count bytes,
3581 because file access counts bytes
3582 and BEG and END count bytes. */
3583 int same_at_start
= BEGV_BYTE
;
3584 int same_at_end
= ZV_BYTE
;
3586 /* There is still a possibility we will find the need to do code
3587 conversion. If that happens, we set this variable to 1 to
3588 give up on handling REPLACE in the optimized way. */
3589 int giveup_match_end
= 0;
3591 if (XINT (beg
) != 0)
3593 if (lseek (fd
, XINT (beg
), 0) < 0)
3594 report_file_error ("Setting file position",
3595 Fcons (orig_filename
, Qnil
));
3600 /* Count how many chars at the start of the file
3601 match the text at the beginning of the buffer. */
3606 nread
= read (fd
, buffer
, sizeof buffer
);
3608 error ("IO error reading %s: %s",
3609 XSTRING (orig_filename
)->data
, strerror (errno
));
3610 else if (nread
== 0)
3613 if (coding
.type
== coding_type_undecided
)
3614 detect_coding (&coding
, buffer
, nread
);
3615 if (CODING_REQUIRE_DECODING (&coding
))
3616 /* We found that the file should be decoded somehow.
3617 Let's give up here. */
3619 giveup_match_end
= 1;
3623 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3624 detect_eol (&coding
, buffer
, nread
);
3625 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3626 && coding
.eol_type
!= CODING_EOL_LF
)
3627 /* We found that the format of eol should be decoded.
3628 Let's give up here. */
3630 giveup_match_end
= 1;
3635 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3636 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3637 same_at_start
++, bufpos
++;
3638 /* If we found a discrepancy, stop the scan.
3639 Otherwise loop around and scan the next bufferful. */
3640 if (bufpos
!= nread
)
3644 /* If the file matches the buffer completely,
3645 there's no need to replace anything. */
3646 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3650 /* Truncate the buffer to the size of the file. */
3651 del_range_1 (same_at_start
, same_at_end
, 0);
3656 /* Count how many chars at the end of the file
3657 match the text at the end of the buffer. But, if we have
3658 already found that decoding is necessary, don't waste time. */
3659 while (!giveup_match_end
)
3661 int total_read
, nread
, bufpos
, curpos
, trial
;
3663 /* At what file position are we now scanning? */
3664 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3665 /* If the entire file matches the buffer tail, stop the scan. */
3668 /* How much can we scan in the next step? */
3669 trial
= min (curpos
, sizeof buffer
);
3670 if (lseek (fd
, curpos
- trial
, 0) < 0)
3671 report_file_error ("Setting file position",
3672 Fcons (orig_filename
, Qnil
));
3675 while (total_read
< trial
)
3677 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3679 error ("IO error reading %s: %s",
3680 XSTRING (orig_filename
)->data
, strerror (errno
));
3681 total_read
+= nread
;
3683 /* Scan this bufferful from the end, comparing with
3684 the Emacs buffer. */
3685 bufpos
= total_read
;
3686 /* Compare with same_at_start to avoid counting some buffer text
3687 as matching both at the file's beginning and at the end. */
3688 while (bufpos
> 0 && same_at_end
> same_at_start
3689 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3690 same_at_end
--, bufpos
--;
3692 /* If we found a discrepancy, stop the scan.
3693 Otherwise loop around and scan the preceding bufferful. */
3696 /* If this discrepancy is because of code conversion,
3697 we cannot use this method; giveup and try the other. */
3698 if (same_at_end
> same_at_start
3699 && FETCH_BYTE (same_at_end
- 1) >= 0200
3700 && ! NILP (current_buffer
->enable_multibyte_characters
)
3701 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3702 giveup_match_end
= 1;
3708 if (! giveup_match_end
)
3712 /* We win! We can handle REPLACE the optimized way. */
3714 /* Extend the start of non-matching text area to multibyte
3715 character boundary. */
3716 if (! NILP (current_buffer
->enable_multibyte_characters
))
3717 while (same_at_start
> BEGV_BYTE
3718 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3721 /* Extend the end of non-matching text area to multibyte
3722 character boundary. */
3723 if (! NILP (current_buffer
->enable_multibyte_characters
))
3724 while (same_at_end
< ZV_BYTE
3725 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3728 /* Don't try to reuse the same piece of text twice. */
3729 overlap
= (same_at_start
- BEGV_BYTE
3730 - (same_at_end
+ st
.st_size
- ZV
));
3732 same_at_end
+= overlap
;
3734 /* Arrange to read only the nonmatching middle part of the file. */
3735 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3736 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3738 del_range_byte (same_at_start
, same_at_end
, 0);
3739 /* Insert from the file at the proper position. */
3740 temp
= BYTE_TO_CHAR (same_at_start
);
3741 SET_PT_BOTH (temp
, same_at_start
);
3743 /* If display currently starts at beginning of line,
3744 keep it that way. */
3745 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3746 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3748 replace_handled
= 1;
3752 /* If requested, replace the accessible part of the buffer
3753 with the file contents. Avoid replacing text at the
3754 beginning or end of the buffer that matches the file contents;
3755 that preserves markers pointing to the unchanged parts.
3757 Here we implement this feature for the case where code conversion
3758 is needed, in a simple way that needs a lot of memory.
3759 The preceding if-statement handles the case of no conversion
3760 in a more optimized way. */
3761 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3763 int same_at_start
= BEGV_BYTE
;
3764 int same_at_end
= ZV_BYTE
;
3767 /* Make sure that the gap is large enough. */
3768 int bufsize
= 2 * st
.st_size
;
3769 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3772 /* First read the whole file, performing code conversion into
3773 CONVERSION_BUFFER. */
3775 if (lseek (fd
, XINT (beg
), 0) < 0)
3777 xfree (conversion_buffer
);
3778 report_file_error ("Setting file position",
3779 Fcons (orig_filename
, Qnil
));
3782 total
= st
.st_size
; /* Total bytes in the file. */
3783 how_much
= 0; /* Bytes read from file so far. */
3784 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3785 unprocessed
= 0; /* Bytes not processed in previous loop. */
3787 while (how_much
< total
)
3789 /* try is reserved in some compilers (Microsoft C) */
3790 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3791 unsigned char *destination
= read_buf
+ unprocessed
;
3794 /* Allow quitting out of the actual I/O. */
3797 this = read (fd
, destination
, trytry
);
3800 if (this < 0 || this + unprocessed
== 0)
3808 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3810 int require
, result
;
3812 this += unprocessed
;
3814 /* If we are using more space than estimated,
3815 make CONVERSION_BUFFER bigger. */
3816 require
= decoding_buffer_size (&coding
, this);
3817 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3819 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3820 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3823 /* Convert this batch with results in CONVERSION_BUFFER. */
3824 if (how_much
>= total
) /* This is the last block. */
3825 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3826 result
= decode_coding (&coding
, read_buf
,
3827 conversion_buffer
+ inserted
,
3828 this, bufsize
- inserted
);
3830 /* Save for next iteration whatever we didn't convert. */
3831 unprocessed
= this - coding
.consumed
;
3832 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
3833 this = coding
.produced
;
3839 /* At this point, INSERTED is how many characters (i.e. bytes)
3840 are present in CONVERSION_BUFFER.
3841 HOW_MUCH should equal TOTAL,
3842 or should be <= 0 if we couldn't read the file. */
3846 xfree (conversion_buffer
);
3849 error ("IO error reading %s: %s",
3850 XSTRING (orig_filename
)->data
, strerror (errno
));
3851 else if (how_much
== -2)
3852 error ("maximum buffer size exceeded");
3855 /* Compare the beginning of the converted file
3856 with the buffer text. */
3859 while (bufpos
< inserted
&& same_at_start
< same_at_end
3860 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3861 same_at_start
++, bufpos
++;
3863 /* If the file matches the buffer completely,
3864 there's no need to replace anything. */
3866 if (bufpos
== inserted
)
3868 xfree (conversion_buffer
);
3871 /* Truncate the buffer to the size of the file. */
3872 del_range_byte (same_at_start
, same_at_end
, 0);
3877 /* Extend the start of non-matching text area to multibyte
3878 character boundary. */
3879 if (! NILP (current_buffer
->enable_multibyte_characters
))
3880 while (same_at_start
> BEGV_BYTE
3881 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3884 /* Scan this bufferful from the end, comparing with
3885 the Emacs buffer. */
3888 /* Compare with same_at_start to avoid counting some buffer text
3889 as matching both at the file's beginning and at the end. */
3890 while (bufpos
> 0 && same_at_end
> same_at_start
3891 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3892 same_at_end
--, bufpos
--;
3894 /* Extend the end of non-matching text area to multibyte
3895 character boundary. */
3896 if (! NILP (current_buffer
->enable_multibyte_characters
))
3897 while (same_at_end
< ZV_BYTE
3898 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3901 /* Don't try to reuse the same piece of text twice. */
3902 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3904 same_at_end
+= overlap
;
3906 /* If display currently starts at beginning of line,
3907 keep it that way. */
3908 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3909 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3911 /* Replace the chars that we need to replace,
3912 and update INSERTED to equal the number of bytes
3913 we are taking from the file. */
3914 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
3916 if (same_at_end
!= same_at_start
)
3918 del_range_byte (same_at_start
, same_at_end
, 0);
3920 same_at_start
= GPT_BYTE
;
3924 temp
= BYTE_TO_CHAR (same_at_start
);
3926 /* Insert from the file at the proper position. */
3927 SET_PT_BOTH (temp
, same_at_start
);
3928 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
3930 /* Set `inserted' to the number of inserted characters. */
3931 inserted
= PT
- temp
;
3933 free (conversion_buffer
);
3942 register Lisp_Object temp
;
3944 total
= XINT (end
) - XINT (beg
);
3946 /* Make sure point-max won't overflow after this insertion. */
3947 XSETINT (temp
, total
);
3948 if (total
!= XINT (temp
))
3949 error ("Maximum buffer size exceeded");
3952 /* For a special file, all we can do is guess. */
3953 total
= READ_BUF_SIZE
;
3955 if (NILP (visit
) && total
> 0)
3956 prepare_to_modify_buffer (PT
, PT
, NULL
);
3959 if (GAP_SIZE
< total
)
3960 make_gap (total
- GAP_SIZE
);
3962 if (XINT (beg
) != 0 || !NILP (replace
))
3964 if (lseek (fd
, XINT (beg
), 0) < 0)
3965 report_file_error ("Setting file position",
3966 Fcons (orig_filename
, Qnil
));
3969 /* In the following loop, HOW_MUCH contains the total bytes read so
3970 far for a regular file, and not changed for a special file. But,
3971 before exiting the loop, it is set to a negative value if I/O
3974 /* Total bytes inserted. */
3976 /* Here, we don't do code conversion in the loop. It is done by
3977 code_convert_region after all data are read into the buffer. */
3978 while (how_much
< total
)
3980 /* try is reserved in some compilers (Microsoft C) */
3981 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3984 /* For a special file, GAP_SIZE should be checked every time. */
3985 if (not_regular
&& GAP_SIZE
< trytry
)
3986 make_gap (total
- GAP_SIZE
);
3988 /* Allow quitting out of the actual I/O. */
3991 this = read (fd
, BYTE_POS_ADDR (PT_BYTE
+ inserted
- 1) + 1, trytry
);
4008 /* For a regular file, where TOTAL is the real size,
4009 count HOW_MUCH to compare with it.
4010 For a special file, where TOTAL is just a buffer size,
4011 so don't bother counting in HOW_MUCH.
4012 (INSERTED is where we count the number of characters inserted.) */
4019 /* Put an anchor to ensure multi-byte form ends at gap. */
4024 /* Discard the unwind protect for closing the file. */
4028 error ("IO error reading %s: %s",
4029 XSTRING (orig_filename
)->data
, strerror (errno
));
4031 if (! coding_system_decided
)
4033 /* The coding system is not yet decided. Decide it by an
4034 optimized method for handling `coding:' tag. */
4038 if (!NILP (Vcoding_system_for_read
))
4039 val
= Vcoding_system_for_read
;
4042 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4044 /* Since we are sure that the current buffer was
4045 empty before the insertion, we can toggle
4046 enable-multibyte-characters directly here without
4047 taking care of marker adjustment and byte
4048 combining problem. */
4049 Lisp_Object prev_multibyte
;
4050 int count
= specpdl_ptr
- specpdl
;
4052 prev_multibyte
= current_buffer
->enable_multibyte_characters
;
4053 current_buffer
->enable_multibyte_characters
= Qnil
;
4054 record_unwind_protect (set_auto_coding_unwind
,
4056 val
= call2 (Vset_auto_coding_function
,
4057 filename
, make_number (inserted
));
4058 /* Discard the unwind protect for recovering the
4059 error of Vset_auto_coding_function. */
4061 current_buffer
->enable_multibyte_characters
= prev_multibyte
;
4062 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
4067 /* If the coding system is not yet decided, check
4068 file-coding-system-alist. */
4069 Lisp_Object args
[6], coding_systems
;
4071 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4072 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4073 coding_systems
= Ffind_operation_coding_system (6, args
);
4074 if (CONSP (coding_systems
))
4075 val
= XCONS (coding_systems
)->car
;
4079 /* The following kludgy code is to avoid some compiler bug.
4081 setup_coding_system (val, &coding);
4084 struct coding_system temp_coding
;
4085 setup_coding_system (val
, &temp_coding
);
4086 bcopy (&temp_coding
, &coding
, sizeof coding
);
4089 if (NILP (current_buffer
->enable_multibyte_characters
)
4091 /* We must suppress all character code conversion except for
4092 end-of-line conversion. */
4093 setup_raw_text_coding_system (&coding
);
4096 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4098 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4100 /* Here, we don't have to consider byte combining (see the
4101 comment below) because code_convert_region takes care of
4103 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4105 inserted
= (NILP (current_buffer
->enable_multibyte_characters
)
4106 ? coding
.produced
: coding
.produced_char
);
4108 else if (!NILP (current_buffer
->enable_multibyte_characters
))
4110 int inserted_byte
= inserted
;
4112 /* There's a possibility that we must combine bytes at the
4113 head (resp. the tail) of the just inserted text with the
4114 bytes before (resp. after) the gap to form a single
4116 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
4117 adjust_after_insert (PT
, PT_BYTE
,
4118 PT
+ inserted_byte
, PT_BYTE
+ inserted_byte
,
4122 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4127 /* Use the conversion type to determine buffer-file-type
4128 (find-buffer-file-type is now used to help determine the
4130 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4131 || coding
.eol_type
== CODING_EOL_LF
)
4132 && ! CODING_REQUIRE_DECODING (&coding
))
4133 current_buffer
->buffer_file_type
= Qt
;
4135 current_buffer
->buffer_file_type
= Qnil
;
4143 if (!EQ (current_buffer
->undo_list
, Qt
))
4144 current_buffer
->undo_list
= Qnil
;
4146 stat (XSTRING (filename
)->data
, &st
);
4151 current_buffer
->modtime
= st
.st_mtime
;
4152 current_buffer
->filename
= orig_filename
;
4155 SAVE_MODIFF
= MODIFF
;
4156 current_buffer
->auto_save_modified
= MODIFF
;
4157 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4158 #ifdef CLASH_DETECTION
4161 if (!NILP (current_buffer
->file_truename
))
4162 unlock_file (current_buffer
->file_truename
);
4163 unlock_file (filename
);
4165 #endif /* CLASH_DETECTION */
4167 Fsignal (Qfile_error
,
4168 Fcons (build_string ("not a regular file"),
4169 Fcons (orig_filename
, Qnil
)));
4171 /* If visiting nonexistent file, return nil. */
4172 if (current_buffer
->modtime
== -1)
4173 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4176 /* Decode file format */
4179 insval
= call3 (Qformat_decode
,
4180 Qnil
, make_number (inserted
), visit
);
4181 CHECK_NUMBER (insval
, 0);
4182 inserted
= XFASTINT (insval
);
4185 /* Call after-change hooks for the inserted text, aside from the case
4186 of normal visiting (not with REPLACE), which is done in a new buffer
4187 "before" the buffer is changed. */
4188 if (inserted
> 0 && total
> 0
4189 && (NILP (visit
) || !NILP (replace
)))
4190 signal_after_change (PT
, 0, inserted
);
4192 if (set_coding_system
)
4193 Vlast_coding_system_used
= coding
.symbol
;
4197 p
= Vafter_insert_file_functions
;
4200 insval
= call1 (Fcar (p
), make_number (inserted
));
4203 CHECK_NUMBER (insval
, 0);
4204 inserted
= XFASTINT (insval
);
4211 /* ??? Retval needs to be dealt with in all cases consistently. */
4213 val
= Fcons (orig_filename
,
4214 Fcons (make_number (inserted
),
4217 RETURN_UNGCPRO (unbind_to (count
, val
));
4220 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
4223 /* If build_annotations switched buffers, switch back to BUF.
4224 Kill the temporary buffer that was selected in the meantime.
4226 Since this kill only the last temporary buffer, some buffers remain
4227 not killed if build_annotations switched buffers more than once.
4231 build_annotations_unwind (buf
)
4236 if (XBUFFER (buf
) == current_buffer
)
4238 tembuf
= Fcurrent_buffer ();
4240 Fkill_buffer (tembuf
);
4244 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4245 "r\nFWrite region to file: \ni\ni\ni\np",
4246 "Write current region into specified file.\n\
4247 When called from a program, takes three arguments:\n\
4248 START, END and FILENAME. START and END are buffer positions.\n\
4249 Optional fourth argument APPEND if non-nil means\n\
4250 append to existing file contents (if any).\n\
4251 Optional fifth argument VISIT if t means\n\
4252 set the last-save-file-modtime of buffer to this file's modtime\n\
4253 and mark buffer not modified.\n\
4254 If VISIT is a string, it is a second file name;\n\
4255 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
4256 VISIT is also the file name to lock and unlock for clash detection.\n\
4257 If VISIT is neither t nor nil nor a string,\n\
4258 that means do not print the \"Wrote file\" message.\n\
4259 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
4260 use for locking and unlocking, overriding FILENAME and VISIT.\n\
4261 The optional seventh arg CONFIRM, if non-nil, says ask for confirmation\n\
4262 before overwriting an existing file.\n\
4263 Kludgy feature: if START is a string, then that string is written\n\
4264 to the file, instead of any buffer contents, and END is ignored.\n\
4266 This does code conversion according to the value of\n\
4267 `coding-system-for-write', `buffer-file-coding-system', or\n\
4268 `file-coding-system-alist', and sets the variable\n\
4269 `last-coding-system-used' to the coding system actually used.")
4271 (start
, end
, filename
, append
, visit
, lockname
, confirm
)
4272 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, confirm
;
4280 int count
= specpdl_ptr
- specpdl
;
4283 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4285 Lisp_Object handler
;
4286 Lisp_Object visit_file
;
4287 Lisp_Object annotations
;
4288 Lisp_Object encoded_filename
;
4289 int visiting
, quietly
;
4290 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4291 struct buffer
*given_buffer
;
4293 int buffer_file_type
= O_BINARY
;
4295 struct coding_system coding
;
4297 if (current_buffer
->base_buffer
&& ! NILP (visit
))
4298 error ("Cannot do file visiting in an indirect buffer");
4300 if (!NILP (start
) && !STRINGP (start
))
4301 validate_region (&start
, &end
);
4303 GCPRO4 (start
, filename
, visit
, lockname
);
4305 /* Decide the coding-system to encode the data with. */
4311 else if (!NILP (Vcoding_system_for_write
))
4312 val
= Vcoding_system_for_write
;
4315 /* If the variable `buffer-file-coding-system' is set locally,
4316 it means that the file was read with some kind of code
4317 conversion or the varialbe is explicitely set by users. We
4318 had better write it out with the same coding system even if
4319 `enable-multibyte-characters' is nil.
4321 If it is not set locally, we anyway have to convert EOL
4322 format if the default value of `buffer-file-coding-system'
4323 tells that it is not Unix-like (LF only) format. */
4324 int using_default_coding
= 0;
4325 int force_raw_text
= 0;
4327 val
= current_buffer
->buffer_file_coding_system
;
4329 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4332 if (NILP (current_buffer
->enable_multibyte_characters
))
4338 /* Check file-coding-system-alist. */
4339 Lisp_Object args
[7], coding_systems
;
4341 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4342 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4344 coding_systems
= Ffind_operation_coding_system (7, args
);
4345 if (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
))
4346 val
= XCONS (coding_systems
)->cdr
;
4350 && !NILP (current_buffer
->buffer_file_coding_system
))
4352 /* If we still have not decided a coding system, use the
4353 default value of buffer-file-coding-system. */
4354 val
= current_buffer
->buffer_file_coding_system
;
4355 using_default_coding
= 1;
4359 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4360 /* Confirm that VAL can surely encode the current region. */
4361 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4363 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4364 if (coding
.eol_type
== CODING_EOL_UNDECIDED
4365 && !using_default_coding
)
4367 if (! EQ (default_buffer_file_coding
.symbol
,
4368 buffer_defaults
.buffer_file_coding_system
))
4369 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4370 &default_buffer_file_coding
);
4371 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4373 Lisp_Object subsidiaries
;
4375 coding
.eol_type
= default_buffer_file_coding
.eol_type
;
4376 subsidiaries
= Fget (coding
.symbol
, Qeol_type
);
4377 if (VECTORP (subsidiaries
)
4378 && XVECTOR (subsidiaries
)->size
== 3)
4380 = XVECTOR (subsidiaries
)->contents
[coding
.eol_type
];
4385 setup_raw_text_coding_system (&coding
);
4386 goto done_setup_coding
;
4389 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4392 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4393 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4396 Vlast_coding_system_used
= coding
.symbol
;
4398 filename
= Fexpand_file_name (filename
, Qnil
);
4400 if (! NILP (confirm
))
4401 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4403 if (STRINGP (visit
))
4404 visit_file
= Fexpand_file_name (visit
, Qnil
);
4406 visit_file
= filename
;
4409 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4410 quietly
= !NILP (visit
);
4414 if (NILP (lockname
))
4415 lockname
= visit_file
;
4417 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4419 /* If the file name has special constructs in it,
4420 call the corresponding file handler. */
4421 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4422 /* If FILENAME has no handler, see if VISIT has one. */
4423 if (NILP (handler
) && STRINGP (visit
))
4424 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4426 if (!NILP (handler
))
4429 val
= call6 (handler
, Qwrite_region
, start
, end
,
4430 filename
, append
, visit
);
4434 SAVE_MODIFF
= MODIFF
;
4435 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4436 current_buffer
->filename
= visit_file
;
4442 /* Special kludge to simplify auto-saving. */
4445 XSETFASTINT (start
, BEG
);
4446 XSETFASTINT (end
, Z
);
4449 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4450 count1
= specpdl_ptr
- specpdl
;
4452 given_buffer
= current_buffer
;
4453 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4454 if (current_buffer
!= given_buffer
)
4456 XSETFASTINT (start
, BEGV
);
4457 XSETFASTINT (end
, ZV
);
4460 #ifdef CLASH_DETECTION
4463 #if 0 /* This causes trouble for GNUS. */
4464 /* If we've locked this file for some other buffer,
4465 query before proceeding. */
4466 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4467 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4470 lock_file (lockname
);
4472 #endif /* CLASH_DETECTION */
4474 encoded_filename
= ENCODE_FILE (filename
);
4476 fn
= XSTRING (encoded_filename
)->data
;
4480 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4481 #else /* not DOS_NT */
4482 desc
= open (fn
, O_WRONLY
);
4483 #endif /* not DOS_NT */
4485 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4487 if (auto_saving
) /* Overwrite any previous version of autosave file */
4489 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4490 desc
= open (fn
, O_RDWR
);
4492 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4493 ? XSTRING (current_buffer
->filename
)->data
: 0,
4496 else /* Write to temporary name and rename if no errors */
4498 Lisp_Object temp_name
;
4499 temp_name
= Ffile_name_directory (filename
);
4501 if (!NILP (temp_name
))
4503 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4504 build_string ("$$SAVE$$")));
4505 fname
= XSTRING (filename
)->data
;
4506 fn
= XSTRING (temp_name
)->data
;
4507 desc
= creat_copy_attrs (fname
, fn
);
4510 /* If we can't open the temporary file, try creating a new
4511 version of the original file. VMS "creat" creates a
4512 new version rather than truncating an existing file. */
4515 desc
= creat (fn
, 0666);
4516 #if 0 /* This can clobber an existing file and fail to replace it,
4517 if the user runs out of space. */
4520 /* We can't make a new version;
4521 try to truncate and rewrite existing version if any. */
4523 desc
= open (fn
, O_RDWR
);
4529 desc
= creat (fn
, 0666);
4534 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4535 S_IREAD
| S_IWRITE
);
4536 #else /* not DOS_NT */
4537 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4538 #endif /* not DOS_NT */
4539 #endif /* not VMS */
4545 #ifdef CLASH_DETECTION
4547 if (!auto_saving
) unlock_file (lockname
);
4549 #endif /* CLASH_DETECTION */
4550 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4553 record_unwind_protect (close_file_unwind
, make_number (desc
));
4555 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4556 if (lseek (desc
, 0, 2) < 0)
4558 #ifdef CLASH_DETECTION
4559 if (!auto_saving
) unlock_file (lockname
);
4560 #endif /* CLASH_DETECTION */
4561 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4566 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4567 * if we do writes that don't end with a carriage return. Furthermore
4568 * it cannot handle writes of more then 16K. The modified
4569 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4570 * this EXCEPT for the last record (iff it doesn't end with a carriage
4571 * return). This implies that if your buffer doesn't end with a carriage
4572 * return, you get one free... tough. However it also means that if
4573 * we make two calls to sys_write (a la the following code) you can
4574 * get one at the gap as well. The easiest way to fix this (honest)
4575 * is to move the gap to the next newline (or the end of the buffer).
4580 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4581 move_gap (find_next_newline (GPT
, 1));
4583 /* Whether VMS or not, we must move the gap to the next of newline
4584 when we must put designation sequences at beginning of line. */
4585 if (INTEGERP (start
)
4586 && coding
.type
== coding_type_iso2022
4587 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4588 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4590 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4591 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4592 move_gap_both (PT
, PT_BYTE
);
4593 SET_PT_BOTH (opoint
, opoint_byte
);
4600 if (STRINGP (start
))
4602 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4603 STRING_BYTES (XSTRING (start
)), 0, &annotations
,
4607 else if (XINT (start
) != XINT (end
))
4609 register int end1
= CHAR_TO_BYTE (XINT (end
));
4611 tem
= CHAR_TO_BYTE (XINT (start
));
4613 if (XINT (start
) < GPT
)
4615 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
),
4616 min (GPT_BYTE
, end1
) - tem
, tem
, &annotations
,
4621 if (XINT (end
) > GPT
&& !failure
)
4623 tem
= max (tem
, GPT_BYTE
);
4624 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
), end1
- tem
,
4625 tem
, &annotations
, &coding
);
4631 /* If file was empty, still need to write the annotations */
4632 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4633 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4637 if (CODING_REQUIRE_FLUSHING (&coding
)
4638 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4641 /* We have to flush out a data. */
4642 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4643 failure
= 0 > e_write (desc
, "", 0, &coding
);
4650 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4651 Disk full in NFS may be reported here. */
4652 /* mib says that closing the file will try to write as fast as NFS can do
4653 it, and that means the fsync here is not crucial for autosave files. */
4654 if (!auto_saving
&& fsync (desc
) < 0)
4656 /* If fsync fails with EINTR, don't treat that as serious. */
4658 failure
= 1, save_errno
= errno
;
4662 /* Spurious "file has changed on disk" warnings have been
4663 observed on Suns as well.
4664 It seems that `close' can change the modtime, under nfs.
4666 (This has supposedly been fixed in Sunos 4,
4667 but who knows about all the other machines with NFS?) */
4670 /* On VMS and APOLLO, must do the stat after the close
4671 since closing changes the modtime. */
4674 /* Recall that #if defined does not work on VMS. */
4681 /* NFS can report a write failure now. */
4682 if (close (desc
) < 0)
4683 failure
= 1, save_errno
= errno
;
4686 /* If we wrote to a temporary name and had no errors, rename to real name. */
4690 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4698 /* Discard the unwind protect for close_file_unwind. */
4699 specpdl_ptr
= specpdl
+ count1
;
4700 /* Restore the original current buffer. */
4701 visit_file
= unbind_to (count
, visit_file
);
4703 #ifdef CLASH_DETECTION
4705 unlock_file (lockname
);
4706 #endif /* CLASH_DETECTION */
4708 /* Do this before reporting IO error
4709 to avoid a "file has changed on disk" warning on
4710 next attempt to save. */
4712 current_buffer
->modtime
= st
.st_mtime
;
4715 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4716 strerror (save_errno
));
4720 SAVE_MODIFF
= MODIFF
;
4721 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4722 current_buffer
->filename
= visit_file
;
4723 update_mode_lines
++;
4729 message_with_string ("Wrote %s", visit_file
, 1);
4734 Lisp_Object
merge ();
4736 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4737 "Return t if (car A) is numerically less than (car B).")
4741 return Flss (Fcar (a
), Fcar (b
));
4744 /* Build the complete list of annotations appropriate for writing out
4745 the text between START and END, by calling all the functions in
4746 write-region-annotate-functions and merging the lists they return.
4747 If one of these functions switches to a different buffer, we assume
4748 that buffer contains altered text. Therefore, the caller must
4749 make sure to restore the current buffer in all cases,
4750 as save-excursion would do. */
4753 build_annotations (start
, end
, pre_write_conversion
)
4754 Lisp_Object start
, end
, pre_write_conversion
;
4756 Lisp_Object annotations
;
4758 struct gcpro gcpro1
, gcpro2
;
4759 Lisp_Object original_buffer
;
4761 XSETBUFFER (original_buffer
, current_buffer
);
4764 p
= Vwrite_region_annotate_functions
;
4765 GCPRO2 (annotations
, p
);
4768 struct buffer
*given_buffer
= current_buffer
;
4769 Vwrite_region_annotations_so_far
= annotations
;
4770 res
= call2 (Fcar (p
), start
, end
);
4771 /* If the function makes a different buffer current,
4772 assume that means this buffer contains altered text to be output.
4773 Reset START and END from the buffer bounds
4774 and discard all previous annotations because they should have
4775 been dealt with by this function. */
4776 if (current_buffer
!= given_buffer
)
4778 XSETFASTINT (start
, BEGV
);
4779 XSETFASTINT (end
, ZV
);
4782 Flength (res
); /* Check basic validity of return value */
4783 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4787 /* Now do the same for annotation functions implied by the file-format */
4788 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4789 p
= Vauto_save_file_format
;
4791 p
= current_buffer
->file_format
;
4794 struct buffer
*given_buffer
= current_buffer
;
4795 Vwrite_region_annotations_so_far
= annotations
;
4796 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4798 if (current_buffer
!= given_buffer
)
4800 XSETFASTINT (start
, BEGV
);
4801 XSETFASTINT (end
, ZV
);
4805 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4809 /* At last, do the same for the function PRE_WRITE_CONVERSION
4810 implied by the current coding-system. */
4811 if (!NILP (pre_write_conversion
))
4813 struct buffer
*given_buffer
= current_buffer
;
4814 Vwrite_region_annotations_so_far
= annotations
;
4815 res
= call2 (pre_write_conversion
, start
, end
);
4817 annotations
= (current_buffer
!= given_buffer
4819 : merge (annotations
, res
, Qcar_less_than_car
));
4826 /* Write to descriptor DESC the NBYTES bytes starting at ADDR,
4827 assuming they start at byte position BYTEPOS in the buffer.
4828 Intersperse with them the annotations from *ANNOT
4829 which fall within the range of byte positions BYTEPOS to BYTEPOS + NBYTES,
4830 each at its appropriate position.
4832 We modify *ANNOT by discarding elements as we use them up.
4834 The return value is negative in case of system call failure. */
4837 a_write (desc
, addr
, nbytes
, bytepos
, annot
, coding
)
4839 register char *addr
;
4840 register int nbytes
;
4843 struct coding_system
*coding
;
4847 int lastpos
= bytepos
+ nbytes
;
4849 while (NILP (*annot
) || CONSP (*annot
))
4851 tem
= Fcar_safe (Fcar (*annot
));
4852 nextpos
= bytepos
- 1;
4854 nextpos
= CHAR_TO_BYTE (XFASTINT (tem
));
4856 /* If there are no more annotations in this range,
4857 output the rest of the range all at once. */
4858 if (! (nextpos
>= bytepos
&& nextpos
<= lastpos
))
4859 return e_write (desc
, addr
, lastpos
- bytepos
, coding
);
4861 /* Output buffer text up to the next annotation's position. */
4862 if (nextpos
> bytepos
)
4864 if (0 > e_write (desc
, addr
, nextpos
- bytepos
, coding
))
4866 addr
+= nextpos
- bytepos
;
4869 /* Output the annotation. */
4870 tem
= Fcdr (Fcar (*annot
));
4873 if (0 > e_write (desc
, XSTRING (tem
)->data
, STRING_BYTES (XSTRING (tem
)),
4877 *annot
= Fcdr (*annot
);
4882 #ifndef WRITE_BUF_SIZE
4883 #define WRITE_BUF_SIZE (16 * 1024)
4886 /* Write NBYTES bytes starting at ADDR into descriptor DESC,
4887 encoding them with coding system CODING. */
4890 e_write (desc
, addr
, nbytes
, coding
)
4892 register char *addr
;
4893 register int nbytes
;
4894 struct coding_system
*coding
;
4896 char buf
[WRITE_BUF_SIZE
];
4898 /* We used to have a code for handling selective display here. But,
4899 now it is handled within encode_coding. */
4904 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
4905 nbytes
-= coding
->consumed
, addr
+= coding
->consumed
;
4906 if (coding
->produced
> 0)
4908 coding
->produced
-= write (desc
, buf
, coding
->produced
);
4909 if (coding
->produced
) return -1;
4911 if (result
== CODING_FINISH_INSUFFICIENT_SRC
)
4913 /* The source text ends by an incomplete multibyte form.
4914 There's no way other than write it out as is. */
4915 nbytes
-= write (desc
, addr
, nbytes
);
4916 if (nbytes
) return -1;
4924 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4925 Sverify_visited_file_modtime
, 1, 1, 0,
4926 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4927 This means that the file has not been changed since it was visited or saved.")
4933 Lisp_Object handler
;
4934 Lisp_Object filename
;
4936 CHECK_BUFFER (buf
, 0);
4939 if (!STRINGP (b
->filename
)) return Qt
;
4940 if (b
->modtime
== 0) return Qt
;
4942 /* If the file name has special constructs in it,
4943 call the corresponding file handler. */
4944 handler
= Ffind_file_name_handler (b
->filename
,
4945 Qverify_visited_file_modtime
);
4946 if (!NILP (handler
))
4947 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4949 filename
= ENCODE_FILE (b
->filename
);
4951 if (stat (XSTRING (filename
)->data
, &st
) < 0)
4953 /* If the file doesn't exist now and didn't exist before,
4954 we say that it isn't modified, provided the error is a tame one. */
4955 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4960 if (st
.st_mtime
== b
->modtime
4961 /* If both are positive, accept them if they are off by one second. */
4962 || (st
.st_mtime
> 0 && b
->modtime
> 0
4963 && (st
.st_mtime
== b
->modtime
+ 1
4964 || st
.st_mtime
== b
->modtime
- 1)))
4969 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4970 Sclear_visited_file_modtime
, 0, 0, 0,
4971 "Clear out records of last mod time of visited file.\n\
4972 Next attempt to save will certainly not complain of a discrepancy.")
4975 current_buffer
->modtime
= 0;
4979 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4980 Svisited_file_modtime
, 0, 0, 0,
4981 "Return the current buffer's recorded visited file modification time.\n\
4982 The value is a list of the form (HIGH . LOW), like the time values\n\
4983 that `file-attributes' returns.")
4986 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4989 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4990 Sset_visited_file_modtime
, 0, 1, 0,
4991 "Update buffer's recorded modification time from the visited file's time.\n\
4992 Useful if the buffer was not read from the file normally\n\
4993 or if the file itself has been changed for some known benign reason.\n\
4994 An argument specifies the modification time value to use\n\
4995 \(instead of that of the visited file), in the form of a list\n\
4996 \(HIGH . LOW) or (HIGH LOW).")
4998 Lisp_Object time_list
;
5000 if (!NILP (time_list
))
5001 current_buffer
->modtime
= cons_to_long (time_list
);
5004 register Lisp_Object filename
;
5006 Lisp_Object handler
;
5008 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5010 /* If the file name has special constructs in it,
5011 call the corresponding file handler. */
5012 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5013 if (!NILP (handler
))
5014 /* The handler can find the file name the same way we did. */
5015 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5017 filename
= ENCODE_FILE (filename
);
5019 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
5020 current_buffer
->modtime
= st
.st_mtime
;
5030 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 1);
5031 Fsleep_for (make_number (1), Qnil
);
5032 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
5033 Fsleep_for (make_number (1), Qnil
);
5034 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
5035 Fsleep_for (make_number (1), Qnil
);
5045 /* Get visited file's mode to become the auto save file's mode. */
5046 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
5047 /* But make sure we can overwrite it later! */
5048 auto_save_mode_bits
= st
.st_mode
| 0600;
5050 auto_save_mode_bits
= 0666;
5053 Fwrite_region (Qnil
, Qnil
,
5054 current_buffer
->auto_save_file_name
,
5055 Qnil
, Qlambda
, Qnil
, Qnil
);
5059 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5064 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
5065 | XFASTINT (XCONS (stream
)->cdr
)));
5070 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5073 minibuffer_auto_raise
= XINT (value
);
5077 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5078 "Auto-save all buffers that need it.\n\
5079 This is all buffers that have auto-saving enabled\n\
5080 and are changed since last auto-saved.\n\
5081 Auto-saving writes the buffer into a file\n\
5082 so that your editing is not lost if the system crashes.\n\
5083 This file is not the file you visited; that changes only when you save.\n\
5084 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
5085 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
5086 A non-nil CURRENT-ONLY argument means save only current buffer.")
5087 (no_message
, current_only
)
5088 Lisp_Object no_message
, current_only
;
5090 struct buffer
*old
= current_buffer
, *b
;
5091 Lisp_Object tail
, buf
;
5093 char *omessage
= echo_area_glyphs
;
5094 Lisp_Object omessage_string
= echo_area_message
;
5095 int omessage_length
= echo_area_glyphs_length
;
5096 int oldmultibyte
= message_enable_multibyte
;
5097 int do_handled_files
;
5100 Lisp_Object lispstream
;
5101 int count
= specpdl_ptr
- specpdl
;
5103 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5104 struct gcpro gcpro1
;
5106 GCPRO1 (omessage_string
);
5108 /* Ordinarily don't quit within this function,
5109 but don't make it impossible to quit (in case we get hung in I/O). */
5113 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5114 point to non-strings reached from Vbuffer_alist. */
5119 if (!NILP (Vrun_hooks
))
5120 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5122 if (STRINGP (Vauto_save_list_file_name
))
5124 Lisp_Object listfile
;
5125 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5126 stream
= fopen (XSTRING (listfile
)->data
, "w");
5129 /* Arrange to close that file whether or not we get an error.
5130 Also reset auto_saving to 0. */
5131 lispstream
= Fcons (Qnil
, Qnil
);
5132 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
5133 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
5144 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5145 record_unwind_protect (do_auto_save_unwind_1
,
5146 make_number (minibuffer_auto_raise
));
5147 minibuffer_auto_raise
= 0;
5150 /* First, save all files which don't have handlers. If Emacs is
5151 crashing, the handlers may tweak what is causing Emacs to crash
5152 in the first place, and it would be a shame if Emacs failed to
5153 autosave perfectly ordinary files because it couldn't handle some
5155 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5156 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
5158 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
5161 /* Record all the buffers that have auto save mode
5162 in the special file that lists them. For each of these buffers,
5163 Record visited name (if any) and auto save name. */
5164 if (STRINGP (b
->auto_save_file_name
)
5165 && stream
!= NULL
&& do_handled_files
== 0)
5167 if (!NILP (b
->filename
))
5169 fwrite (XSTRING (b
->filename
)->data
, 1,
5170 STRING_BYTES (XSTRING (b
->filename
)), stream
);
5172 putc ('\n', stream
);
5173 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
5174 STRING_BYTES (XSTRING (b
->auto_save_file_name
)), stream
);
5175 putc ('\n', stream
);
5178 if (!NILP (current_only
)
5179 && b
!= current_buffer
)
5182 /* Don't auto-save indirect buffers.
5183 The base buffer takes care of it. */
5187 /* Check for auto save enabled
5188 and file changed since last auto save
5189 and file changed since last real save. */
5190 if (STRINGP (b
->auto_save_file_name
)
5191 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5192 && b
->auto_save_modified
< BUF_MODIFF (b
)
5193 /* -1 means we've turned off autosaving for a while--see below. */
5194 && XINT (b
->save_length
) >= 0
5195 && (do_handled_files
5196 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5199 EMACS_TIME before_time
, after_time
;
5201 EMACS_GET_TIME (before_time
);
5203 /* If we had a failure, don't try again for 20 minutes. */
5204 if (b
->auto_save_failure_time
>= 0
5205 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5208 if ((XFASTINT (b
->save_length
) * 10
5209 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5210 /* A short file is likely to change a large fraction;
5211 spare the user annoying messages. */
5212 && XFASTINT (b
->save_length
) > 5000
5213 /* These messages are frequent and annoying for `*mail*'. */
5214 && !EQ (b
->filename
, Qnil
)
5215 && NILP (no_message
))
5217 /* It has shrunk too much; turn off auto-saving here. */
5218 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5219 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
5221 minibuffer_auto_raise
= 0;
5222 /* Turn off auto-saving until there's a real save,
5223 and prevent any more warnings. */
5224 XSETINT (b
->save_length
, -1);
5225 Fsleep_for (make_number (1), Qnil
);
5228 set_buffer_internal (b
);
5229 if (!auto_saved
&& NILP (no_message
))
5230 message1 ("Auto-saving...");
5231 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5233 b
->auto_save_modified
= BUF_MODIFF (b
);
5234 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5235 set_buffer_internal (old
);
5237 EMACS_GET_TIME (after_time
);
5239 /* If auto-save took more than 60 seconds,
5240 assume it was an NFS failure that got a timeout. */
5241 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5242 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5246 /* Prevent another auto save till enough input events come in. */
5247 record_auto_save ();
5249 if (auto_saved
&& NILP (no_message
))
5251 if (STRINGP (omessage_string
))
5253 sit_for (1, 0, 0, 0, 0);
5254 message3 (omessage_string
, omessage_length
, oldmultibyte
);
5258 sit_for (1, 0, 0, 0, 0);
5259 message2 (omessage
, omessage_length
, oldmultibyte
);
5262 message1 ("Auto-saving...done");
5268 unbind_to (count
, Qnil
);
5272 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5273 Sset_buffer_auto_saved
, 0, 0, 0,
5274 "Mark current buffer as auto-saved with its current text.\n\
5275 No auto-save file will be written until the buffer changes again.")
5278 current_buffer
->auto_save_modified
= MODIFF
;
5279 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5280 current_buffer
->auto_save_failure_time
= -1;
5284 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5285 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5286 "Clear any record of a recent auto-save failure in the current buffer.")
5289 current_buffer
->auto_save_failure_time
= -1;
5293 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5295 "Return t if buffer has been auto-saved since last read in or saved.")
5298 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5301 /* Reading and completing file names */
5302 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5304 /* In the string VAL, change each $ to $$ and return the result. */
5307 double_dollars (val
)
5310 register unsigned char *old
, *new;
5314 osize
= STRING_BYTES (XSTRING (val
));
5316 /* Count the number of $ characters. */
5317 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
5318 if (*old
++ == '$') count
++;
5321 old
= XSTRING (val
)->data
;
5322 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
5324 new = XSTRING (val
)->data
;
5325 for (n
= osize
; n
> 0; n
--)
5338 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5340 "Internal subroutine for read-file-name. Do not call this.")
5341 (string
, dir
, action
)
5342 Lisp_Object string
, dir
, action
;
5343 /* action is nil for complete, t for return list of completions,
5344 lambda for verify final value */
5346 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5348 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5350 CHECK_STRING (string
, 0);
5357 /* No need to protect ACTION--we only compare it with t and nil. */
5358 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5360 if (XSTRING (string
)->size
== 0)
5362 if (EQ (action
, Qlambda
))
5370 orig_string
= string
;
5371 string
= Fsubstitute_in_file_name (string
);
5372 changed
= NILP (Fstring_equal (string
, orig_string
));
5373 name
= Ffile_name_nondirectory (string
);
5374 val
= Ffile_name_directory (string
);
5376 realdir
= Fexpand_file_name (val
, realdir
);
5381 specdir
= Ffile_name_directory (string
);
5382 val
= Ffile_name_completion (name
, realdir
);
5387 return double_dollars (string
);
5391 if (!NILP (specdir
))
5392 val
= concat2 (specdir
, val
);
5394 return double_dollars (val
);
5397 #endif /* not VMS */
5401 if (EQ (action
, Qt
))
5402 return Ffile_name_all_completions (name
, realdir
);
5403 /* Only other case actually used is ACTION = lambda */
5405 /* Supposedly this helps commands such as `cd' that read directory names,
5406 but can someone explain how it helps them? -- RMS */
5407 if (XSTRING (name
)->size
== 0)
5410 return Ffile_exists_p (string
);
5413 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5414 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5415 Value is not expanded---you must call `expand-file-name' yourself.\n\
5416 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5417 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5418 except that if INITIAL is specified, that combined with DIR is used.)\n\
5419 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5420 Non-nil and non-t means also require confirmation after completion.\n\
5421 Fifth arg INITIAL specifies text to start with.\n\
5422 DIR defaults to current buffer's directory default.")
5423 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5424 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5426 Lisp_Object val
, insdef
, tem
;
5427 struct gcpro gcpro1
, gcpro2
;
5428 register char *homedir
;
5429 int replace_in_history
= 0;
5430 int add_to_history
= 0;
5434 dir
= current_buffer
->directory
;
5435 if (NILP (default_filename
))
5437 if (! NILP (initial
))
5438 default_filename
= Fexpand_file_name (initial
, dir
);
5440 default_filename
= current_buffer
->filename
;
5443 /* If dir starts with user's homedir, change that to ~. */
5444 homedir
= (char *) egetenv ("HOME");
5446 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5447 CORRECT_DIR_SEPS (homedir
);
5451 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5452 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5454 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5455 STRING_BYTES (XSTRING (dir
)) - strlen (homedir
) + 1);
5456 XSTRING (dir
)->data
[0] = '~';
5458 /* Likewise for default_filename. */
5460 && STRINGP (default_filename
)
5461 && !strncmp (homedir
, XSTRING (default_filename
)->data
, strlen (homedir
))
5462 && IS_DIRECTORY_SEP (XSTRING (default_filename
)->data
[strlen (homedir
)]))
5465 = make_string (XSTRING (default_filename
)->data
+ strlen (homedir
) - 1,
5466 STRING_BYTES (XSTRING (default_filename
)) - strlen (homedir
) + 1);
5467 XSTRING (default_filename
)->data
[0] = '~';
5469 if (!NILP (default_filename
))
5471 CHECK_STRING (default_filename
, 3);
5472 default_filename
= double_dollars (default_filename
);
5475 if (insert_default_directory
&& STRINGP (dir
))
5478 if (!NILP (initial
))
5480 Lisp_Object args
[2], pos
;
5484 insdef
= Fconcat (2, args
);
5485 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5486 insdef
= Fcons (double_dollars (insdef
), pos
);
5489 insdef
= double_dollars (insdef
);
5491 else if (STRINGP (initial
))
5492 insdef
= Fcons (double_dollars (initial
), make_number (0));
5496 count
= specpdl_ptr
- specpdl
;
5498 specbind (intern ("completion-ignore-case"), Qt
);
5501 specbind (intern ("minibuffer-completing-file-name"), Qt
);
5503 GCPRO2 (insdef
, default_filename
);
5506 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5510 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
5515 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5516 dir
, mustmatch
, insdef
,
5517 Qfile_name_history
, default_filename
, Qnil
);
5519 tem
= Fsymbol_value (Qfile_name_history
);
5520 if (CONSP (tem
) && EQ (XCONS (tem
)->car
, val
))
5521 replace_in_history
= 1;
5523 /* If Fcompleting_read returned the inserted default string itself
5524 (rather than a new string with the same contents),
5525 it has to mean that the user typed RET with the minibuffer empty.
5526 In that case, we really want to return ""
5527 so that commands such as set-visited-file-name can distinguish. */
5528 if (EQ (val
, default_filename
))
5530 /* In this case, Fcompleting_read has not added an element
5531 to the history. Maybe we should. */
5532 if (! replace_in_history
)
5535 val
= build_string ("");
5538 unbind_to (count
, Qnil
);
5541 error ("No file name specified");
5543 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
5545 if (!NILP (tem
) && !NILP (default_filename
))
5546 val
= default_filename
;
5547 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5549 if (!NILP (default_filename
))
5550 val
= default_filename
;
5552 error ("No default file name");
5554 val
= Fsubstitute_in_file_name (val
);
5556 if (replace_in_history
)
5557 /* Replace what Fcompleting_read added to the history
5558 with what we will actually return. */
5559 XCONS (Fsymbol_value (Qfile_name_history
))->car
= double_dollars (val
);
5560 else if (add_to_history
)
5562 /* Add the value to the history--but not if it matches
5563 the last value already there. */
5564 Lisp_Object val1
= double_dollars (val
);
5565 tem
= Fsymbol_value (Qfile_name_history
);
5566 if (! CONSP (tem
) || NILP (Fequal (XCONS (tem
)->car
, val1
)))
5567 Fset (Qfile_name_history
,
5578 /* Must be set before any path manipulation is performed. */
5579 XSETFASTINT (Vdirectory_sep_char
, '/');
5586 Qexpand_file_name
= intern ("expand-file-name");
5587 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5588 Qdirectory_file_name
= intern ("directory-file-name");
5589 Qfile_name_directory
= intern ("file-name-directory");
5590 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5591 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5592 Qfile_name_as_directory
= intern ("file-name-as-directory");
5593 Qcopy_file
= intern ("copy-file");
5594 Qmake_directory_internal
= intern ("make-directory-internal");
5595 Qdelete_directory
= intern ("delete-directory");
5596 Qdelete_file
= intern ("delete-file");
5597 Qrename_file
= intern ("rename-file");
5598 Qadd_name_to_file
= intern ("add-name-to-file");
5599 Qmake_symbolic_link
= intern ("make-symbolic-link");
5600 Qfile_exists_p
= intern ("file-exists-p");
5601 Qfile_executable_p
= intern ("file-executable-p");
5602 Qfile_readable_p
= intern ("file-readable-p");
5603 Qfile_writable_p
= intern ("file-writable-p");
5604 Qfile_symlink_p
= intern ("file-symlink-p");
5605 Qaccess_file
= intern ("access-file");
5606 Qfile_directory_p
= intern ("file-directory-p");
5607 Qfile_regular_p
= intern ("file-regular-p");
5608 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5609 Qfile_modes
= intern ("file-modes");
5610 Qset_file_modes
= intern ("set-file-modes");
5611 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5612 Qinsert_file_contents
= intern ("insert-file-contents");
5613 Qwrite_region
= intern ("write-region");
5614 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5615 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5617 staticpro (&Qexpand_file_name
);
5618 staticpro (&Qsubstitute_in_file_name
);
5619 staticpro (&Qdirectory_file_name
);
5620 staticpro (&Qfile_name_directory
);
5621 staticpro (&Qfile_name_nondirectory
);
5622 staticpro (&Qunhandled_file_name_directory
);
5623 staticpro (&Qfile_name_as_directory
);
5624 staticpro (&Qcopy_file
);
5625 staticpro (&Qmake_directory_internal
);
5626 staticpro (&Qdelete_directory
);
5627 staticpro (&Qdelete_file
);
5628 staticpro (&Qrename_file
);
5629 staticpro (&Qadd_name_to_file
);
5630 staticpro (&Qmake_symbolic_link
);
5631 staticpro (&Qfile_exists_p
);
5632 staticpro (&Qfile_executable_p
);
5633 staticpro (&Qfile_readable_p
);
5634 staticpro (&Qfile_writable_p
);
5635 staticpro (&Qaccess_file
);
5636 staticpro (&Qfile_symlink_p
);
5637 staticpro (&Qfile_directory_p
);
5638 staticpro (&Qfile_regular_p
);
5639 staticpro (&Qfile_accessible_directory_p
);
5640 staticpro (&Qfile_modes
);
5641 staticpro (&Qset_file_modes
);
5642 staticpro (&Qfile_newer_than_file_p
);
5643 staticpro (&Qinsert_file_contents
);
5644 staticpro (&Qwrite_region
);
5645 staticpro (&Qverify_visited_file_modtime
);
5646 staticpro (&Qset_visited_file_modtime
);
5648 Qfile_name_history
= intern ("file-name-history");
5649 Fset (Qfile_name_history
, Qnil
);
5650 staticpro (&Qfile_name_history
);
5652 Qfile_error
= intern ("file-error");
5653 staticpro (&Qfile_error
);
5654 Qfile_already_exists
= intern ("file-already-exists");
5655 staticpro (&Qfile_already_exists
);
5656 Qfile_date_error
= intern ("file-date-error");
5657 staticpro (&Qfile_date_error
);
5660 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5661 staticpro (&Qfind_buffer_file_type
);
5664 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5665 "*Coding system for encoding file names.\n\
5666 If it is nil, default-file-name-coding-system (which see) is used.");
5667 Vfile_name_coding_system
= Qnil
;
5669 DEFVAR_LISP ("default-file-name-coding-system",
5670 &Vdefault_file_name_coding_system
,
5671 "Default coding system for encoding file names.\n\
5672 This variable is used only when file-name-coding-system is nil.\n\
5674 This variable is set/changed by the command set-language-environment.\n\
5675 User should not set this variable manually,\n\
5676 instead use file-name-coding-system to get a constant encoding\n\
5677 of file names regardless of the current language environment.");
5678 Vdefault_file_name_coding_system
= Qnil
;
5680 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5681 "*Format in which to write auto-save files.\n\
5682 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5683 If it is t, which is the default, auto-save files are written in the\n\
5684 same format as a regular save would use.");
5685 Vauto_save_file_format
= Qt
;
5687 Qformat_decode
= intern ("format-decode");
5688 staticpro (&Qformat_decode
);
5689 Qformat_annotate_function
= intern ("format-annotate-function");
5690 staticpro (&Qformat_annotate_function
);
5692 Qcar_less_than_car
= intern ("car-less-than-car");
5693 staticpro (&Qcar_less_than_car
);
5695 Fput (Qfile_error
, Qerror_conditions
,
5696 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5697 Fput (Qfile_error
, Qerror_message
,
5698 build_string ("File error"));
5700 Fput (Qfile_already_exists
, Qerror_conditions
,
5701 Fcons (Qfile_already_exists
,
5702 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5703 Fput (Qfile_already_exists
, Qerror_message
,
5704 build_string ("File already exists"));
5706 Fput (Qfile_date_error
, Qerror_conditions
,
5707 Fcons (Qfile_date_error
,
5708 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5709 Fput (Qfile_date_error
, Qerror_message
,
5710 build_string ("Cannot set file date"));
5712 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5713 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5714 insert_default_directory
= 1;
5716 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5717 "*Non-nil means write new files with record format `stmlf'.\n\
5718 nil means use format `var'. This variable is meaningful only on VMS.");
5719 vms_stmlf_recfm
= 0;
5721 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5722 "Directory separator character for built-in functions that return file names.\n\
5723 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5724 This variable affects the built-in functions only on Windows,\n\
5725 on other platforms, it is initialized so that Lisp code can find out\n\
5726 what the normal separator is.");
5728 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5729 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5730 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5733 The first argument given to HANDLER is the name of the I/O primitive\n\
5734 to be handled; the remaining arguments are the arguments that were\n\
5735 passed to that primitive. For example, if you do\n\
5736 (file-exists-p FILENAME)\n\
5737 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5738 (funcall HANDLER 'file-exists-p FILENAME)\n\
5739 The function `find-file-name-handler' checks this list for a handler\n\
5740 for its argument.");
5741 Vfile_name_handler_alist
= Qnil
;
5743 DEFVAR_LISP ("set-auto-coding-function",
5744 &Vset_auto_coding_function
,
5745 "If non-nil, a function to call to decide a coding system of file.\n\
5746 Two arguments are passed to this function: the file name\n\
5747 and the length of a file contents following the point.\n\
5748 This function should return a coding system to decode the file contents.\n\
5749 It should check the file name against `auto-coding-alist'.\n\
5750 If no coding system is decided, it should check a coding system\n\
5751 specified in the heading lines with the format:\n\
5752 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5753 or local variable spec of the tailing lines with `coding:' tag.");
5754 Vset_auto_coding_function
= Qnil
;
5756 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5757 "A list of functions to be called at the end of `insert-file-contents'.\n\
5758 Each is passed one argument, the number of bytes inserted. It should return\n\
5759 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5760 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5761 responsible for calling the after-insert-file-functions if appropriate.");
5762 Vafter_insert_file_functions
= Qnil
;
5764 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5765 "A list of functions to be called at the start of `write-region'.\n\
5766 Each is passed two arguments, START and END as for `write-region'.\n\
5767 These are usually two numbers but not always; see the documentation\n\
5768 for `write-region'. The function should return a list of pairs\n\
5769 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5770 inserted at the specified positions of the file being written (1 means to\n\
5771 insert before the first byte written). The POSITIONs must be sorted into\n\
5772 increasing order. If there are several functions in the list, the several\n\
5773 lists are merged destructively.");
5774 Vwrite_region_annotate_functions
= Qnil
;
5776 DEFVAR_LISP ("write-region-annotations-so-far",
5777 &Vwrite_region_annotations_so_far
,
5778 "When an annotation function is called, this holds the previous annotations.\n\
5779 These are the annotations made by other annotation functions\n\
5780 that were already called. See also `write-region-annotate-functions'.");
5781 Vwrite_region_annotations_so_far
= Qnil
;
5783 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5784 "A list of file name handlers that temporarily should not be used.\n\
5785 This applies only to the operation `inhibit-file-name-operation'.");
5786 Vinhibit_file_name_handlers
= Qnil
;
5788 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5789 "The operation for which `inhibit-file-name-handlers' is applicable.");
5790 Vinhibit_file_name_operation
= Qnil
;
5792 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5793 "File name in which we write a list of all auto save file names.\n\
5794 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5795 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5797 Vauto_save_list_file_name
= Qnil
;
5799 defsubr (&Sfind_file_name_handler
);
5800 defsubr (&Sfile_name_directory
);
5801 defsubr (&Sfile_name_nondirectory
);
5802 defsubr (&Sunhandled_file_name_directory
);
5803 defsubr (&Sfile_name_as_directory
);
5804 defsubr (&Sdirectory_file_name
);
5805 defsubr (&Smake_temp_name
);
5806 defsubr (&Sexpand_file_name
);
5807 defsubr (&Ssubstitute_in_file_name
);
5808 defsubr (&Scopy_file
);
5809 defsubr (&Smake_directory_internal
);
5810 defsubr (&Sdelete_directory
);
5811 defsubr (&Sdelete_file
);
5812 defsubr (&Srename_file
);
5813 defsubr (&Sadd_name_to_file
);
5815 defsubr (&Smake_symbolic_link
);
5816 #endif /* S_IFLNK */
5818 defsubr (&Sdefine_logical_name
);
5821 defsubr (&Ssysnetunam
);
5822 #endif /* HPUX_NET */
5823 defsubr (&Sfile_name_absolute_p
);
5824 defsubr (&Sfile_exists_p
);
5825 defsubr (&Sfile_executable_p
);
5826 defsubr (&Sfile_readable_p
);
5827 defsubr (&Sfile_writable_p
);
5828 defsubr (&Saccess_file
);
5829 defsubr (&Sfile_symlink_p
);
5830 defsubr (&Sfile_directory_p
);
5831 defsubr (&Sfile_accessible_directory_p
);
5832 defsubr (&Sfile_regular_p
);
5833 defsubr (&Sfile_modes
);
5834 defsubr (&Sset_file_modes
);
5835 defsubr (&Sset_default_file_modes
);
5836 defsubr (&Sdefault_file_modes
);
5837 defsubr (&Sfile_newer_than_file_p
);
5838 defsubr (&Sinsert_file_contents
);
5839 defsubr (&Swrite_region
);
5840 defsubr (&Scar_less_than_car
);
5841 defsubr (&Sverify_visited_file_modtime
);
5842 defsubr (&Sclear_visited_file_modtime
);
5843 defsubr (&Svisited_file_modtime
);
5844 defsubr (&Sset_visited_file_modtime
);
5845 defsubr (&Sdo_auto_save
);
5846 defsubr (&Sset_buffer_auto_saved
);
5847 defsubr (&Sclear_buffer_auto_save_failure
);
5848 defsubr (&Srecent_auto_save_p
);
5850 defsubr (&Sread_file_name_internal
);
5851 defsubr (&Sread_file_name
);
5854 defsubr (&Sunix_sync
);