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>
39 #if !defined (S_ISLNK) && defined (S_IFLNK)
40 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
43 #if !defined (S_ISFIFO) && defined (S_IFIFO)
44 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
47 #if !defined (S_ISREG) && defined (S_IFREG)
48 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
72 extern char *strerror ();
89 #include "intervals.h"
100 #endif /* not WINDOWSNT */
104 #include <sys/param.h>
112 #define CORRECT_DIR_SEPS(s) \
113 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
114 else unixtodos_filename (s); \
116 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
117 redirector allows the six letters between 'Z' and 'a' as well. */
119 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
122 #define IS_DRIVE(x) isalpha (x)
124 /* Need to lower-case the drive letter, or else expanded
125 filenames will sometimes compare inequal, because
126 `expand-file-name' doesn't always down-case the drive letter. */
127 #define DRIVE_LETTER(x) (tolower (x))
148 #include "commands.h"
149 extern int use_dialog_box
;
163 #define min(a, b) ((a) < (b) ? (a) : (b))
164 #define max(a, b) ((a) > (b) ? (a) : (b))
166 /* Nonzero during writing of auto-save files */
169 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
170 a new file with the same mode as the original */
171 int auto_save_mode_bits
;
173 /* Coding system for file names, or nil if none. */
174 Lisp_Object Vfile_name_coding_system
;
176 /* Coding system for file names used only when
177 Vfile_name_coding_system is nil. */
178 Lisp_Object Vdefault_file_name_coding_system
;
180 /* Alist of elements (REGEXP . HANDLER) for file names
181 whose I/O is done with a special handler. */
182 Lisp_Object Vfile_name_handler_alist
;
184 /* Format for auto-save files */
185 Lisp_Object Vauto_save_file_format
;
187 /* Lisp functions for translating file formats */
188 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
190 /* Function to be called to decide a coding system of a reading file. */
191 Lisp_Object Vset_auto_coding_function
;
193 /* Functions to be called to process text properties in inserted file. */
194 Lisp_Object Vafter_insert_file_functions
;
196 /* Functions to be called to create text property annotations for file. */
197 Lisp_Object Vwrite_region_annotate_functions
;
199 /* During build_annotations, each time an annotation function is called,
200 this holds the annotations made by the previous functions. */
201 Lisp_Object Vwrite_region_annotations_so_far
;
203 /* File name in which we write a list of all our auto save files. */
204 Lisp_Object Vauto_save_list_file_name
;
206 /* Nonzero means, when reading a filename in the minibuffer,
207 start out by inserting the default directory into the minibuffer. */
208 int insert_default_directory
;
210 /* On VMS, nonzero means write new files with record format stmlf.
211 Zero means use var format. */
214 /* On NT, specifies the directory separator character, used (eg.) when
215 expanding file names. This can be bound to / or \. */
216 Lisp_Object Vdirectory_sep_char
;
218 extern Lisp_Object Vuser_login_name
;
221 extern Lisp_Object Vw32_get_true_file_attributes
;
224 extern int minibuf_level
;
226 extern int minibuffer_auto_raise
;
228 /* These variables describe handlers that have "already" had a chance
229 to handle the current operation.
231 Vinhibit_file_name_handlers is a list of file name handlers.
232 Vinhibit_file_name_operation is the operation being handled.
233 If we try to handle that operation, we ignore those handlers. */
235 static Lisp_Object Vinhibit_file_name_handlers
;
236 static Lisp_Object Vinhibit_file_name_operation
;
238 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
240 Lisp_Object Qfile_name_history
;
242 Lisp_Object Qcar_less_than_car
;
244 static int a_write
P_ ((int, char *, int, int,
245 Lisp_Object
*, struct coding_system
*));
246 static int e_write
P_ ((int, char *, int, struct coding_system
*));
249 report_file_error (string
, data
)
253 Lisp_Object errstring
;
256 errstring
= build_string (strerror (errno
));
261 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
264 /* System error messages are capitalized. Downcase the initial
265 unless it is followed by a slash. */
266 if (XSTRING (errstring
)->data
[1] != '/')
267 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
269 Fsignal (Qfile_error
,
270 Fcons (build_string (string
), Fcons (errstring
, data
)));
275 close_file_unwind (fd
)
278 close (XFASTINT (fd
));
282 /* Restore point, having saved it as a marker. */
285 restore_point_unwind (location
)
286 Lisp_Object location
;
288 Fgoto_char (location
);
289 Fset_marker (location
, Qnil
, Qnil
);
293 Lisp_Object Qexpand_file_name
;
294 Lisp_Object Qsubstitute_in_file_name
;
295 Lisp_Object Qdirectory_file_name
;
296 Lisp_Object Qfile_name_directory
;
297 Lisp_Object Qfile_name_nondirectory
;
298 Lisp_Object Qunhandled_file_name_directory
;
299 Lisp_Object Qfile_name_as_directory
;
300 Lisp_Object Qcopy_file
;
301 Lisp_Object Qmake_directory_internal
;
302 Lisp_Object Qdelete_directory
;
303 Lisp_Object Qdelete_file
;
304 Lisp_Object Qrename_file
;
305 Lisp_Object Qadd_name_to_file
;
306 Lisp_Object Qmake_symbolic_link
;
307 Lisp_Object Qfile_exists_p
;
308 Lisp_Object Qfile_executable_p
;
309 Lisp_Object Qfile_readable_p
;
310 Lisp_Object Qfile_writable_p
;
311 Lisp_Object Qfile_symlink_p
;
312 Lisp_Object Qaccess_file
;
313 Lisp_Object Qfile_directory_p
;
314 Lisp_Object Qfile_regular_p
;
315 Lisp_Object Qfile_accessible_directory_p
;
316 Lisp_Object Qfile_modes
;
317 Lisp_Object Qset_file_modes
;
318 Lisp_Object Qfile_newer_than_file_p
;
319 Lisp_Object Qinsert_file_contents
;
320 Lisp_Object Qwrite_region
;
321 Lisp_Object Qverify_visited_file_modtime
;
322 Lisp_Object Qset_visited_file_modtime
;
324 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
325 "Return FILENAME's handler function for OPERATION, if it has one.\n\
326 Otherwise, return nil.\n\
327 A file name is handled if one of the regular expressions in\n\
328 `file-name-handler-alist' matches it.\n\n\
329 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
330 any handlers that are members of `inhibit-file-name-handlers',\n\
331 but we still do run any other handlers. This lets handlers\n\
332 use the standard functions without calling themselves recursively.")
333 (filename
, operation
)
334 Lisp_Object filename
, operation
;
336 /* This function must not munge the match data. */
337 Lisp_Object chain
, inhibited_handlers
;
339 CHECK_STRING (filename
, 0);
341 if (EQ (operation
, Vinhibit_file_name_operation
))
342 inhibited_handlers
= Vinhibit_file_name_handlers
;
344 inhibited_handlers
= Qnil
;
346 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
347 chain
= XCDR (chain
))
355 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
357 Lisp_Object handler
, tem
;
359 handler
= XCDR (elt
);
360 tem
= Fmemq (handler
, inhibited_handlers
);
371 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
373 "Return the directory component in file name FILENAME.\n\
374 Return nil if FILENAME does not include a directory.\n\
375 Otherwise return a directory spec.\n\
376 Given a Unix syntax file name, returns a string ending in slash;\n\
377 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
379 Lisp_Object filename
;
381 register unsigned char *beg
;
382 register unsigned char *p
;
385 CHECK_STRING (filename
, 0);
387 /* If the file name has special constructs in it,
388 call the corresponding file handler. */
389 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
391 return call2 (handler
, Qfile_name_directory
, filename
);
393 #ifdef FILE_SYSTEM_CASE
394 filename
= FILE_SYSTEM_CASE (filename
);
396 beg
= XSTRING (filename
)->data
;
398 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
400 p
= beg
+ STRING_BYTES (XSTRING (filename
));
402 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
404 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
407 /* only recognise drive specifier at the beginning */
409 /* handle the "/:d:foo" and "/:foo" cases correctly */
410 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
411 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
418 /* Expansion of "c:" to drive and default directory. */
421 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
422 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
423 unsigned char *r
= res
;
425 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
427 strncpy (res
, beg
, 2);
432 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
434 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
437 p
= beg
+ strlen (beg
);
440 CORRECT_DIR_SEPS (beg
);
443 if (STRING_MULTIBYTE (filename
))
444 return make_string (beg
, p
- beg
);
445 return make_unibyte_string (beg
, p
- beg
);
448 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
449 Sfile_name_nondirectory
, 1, 1, 0,
450 "Return file name FILENAME sans its directory.\n\
451 For example, in a Unix-syntax file name,\n\
452 this is everything after the last slash,\n\
453 or the entire name if it contains no slash.")
455 Lisp_Object filename
;
457 register unsigned char *beg
, *p
, *end
;
460 CHECK_STRING (filename
, 0);
462 /* If the file name has special constructs in it,
463 call the corresponding file handler. */
464 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
466 return call2 (handler
, Qfile_name_nondirectory
, filename
);
468 beg
= XSTRING (filename
)->data
;
469 end
= p
= beg
+ STRING_BYTES (XSTRING (filename
));
471 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
473 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
476 /* only recognise drive specifier at beginning */
478 /* handle the "/:d:foo" case correctly */
479 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
484 if (STRING_MULTIBYTE (filename
))
485 return make_string (p
, end
- p
);
486 return make_unibyte_string (p
, end
- p
);
489 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
490 Sunhandled_file_name_directory
, 1, 1, 0,
491 "Return a directly usable directory name somehow associated with FILENAME.\n\
492 A `directly usable' directory name is one that may be used without the\n\
493 intervention of any file handler.\n\
494 If FILENAME is a directly usable file itself, return\n\
495 \(file-name-directory FILENAME).\n\
496 The `call-process' and `start-process' functions use this function to\n\
497 get a current directory to run processes in.")
499 Lisp_Object filename
;
503 /* If the file name has special constructs in it,
504 call the corresponding file handler. */
505 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
507 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
509 return Ffile_name_directory (filename
);
514 file_name_as_directory (out
, in
)
517 int size
= strlen (in
) - 1;
530 /* Is it already a directory string? */
531 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
533 /* Is it a VMS directory file name? If so, hack VMS syntax. */
534 else if (! index (in
, '/')
535 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
536 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
537 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
538 || ! strncmp (&in
[size
- 5], ".dir", 4))
539 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
540 && in
[size
] == '1')))
542 register char *p
, *dot
;
546 dir:x.dir --> dir:[x]
547 dir:[x]y.dir --> dir:[x.y] */
549 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
552 strncpy (out
, in
, p
- in
);
571 dot
= index (p
, '.');
574 /* blindly remove any extension */
575 size
= strlen (out
) + (dot
- p
);
576 strncat (out
, p
, dot
- p
);
587 /* For Unix syntax, Append a slash if necessary */
588 if (!IS_DIRECTORY_SEP (out
[size
]))
590 out
[size
+ 1] = DIRECTORY_SEP
;
591 out
[size
+ 2] = '\0';
594 CORRECT_DIR_SEPS (out
);
600 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
601 Sfile_name_as_directory
, 1, 1, 0,
602 "Return a string representing file FILENAME interpreted as a directory.\n\
603 This operation exists because a directory is also a file, but its name as\n\
604 a directory is different from its name as a file.\n\
605 The result can be used as the value of `default-directory'\n\
606 or passed as second argument to `expand-file-name'.\n\
607 For a Unix-syntax file name, just appends a slash.\n\
608 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
615 CHECK_STRING (file
, 0);
619 /* If the file name has special constructs in it,
620 call the corresponding file handler. */
621 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
623 return call2 (handler
, Qfile_name_as_directory
, file
);
625 buf
= (char *) alloca (STRING_BYTES (XSTRING (file
)) + 10);
626 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
630 * Convert from directory name to filename.
632 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
633 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
634 * On UNIX, it's simple: just make sure there isn't a terminating /
636 * Value is nonzero if the string output is different from the input.
640 directory_file_name (src
, dst
)
648 struct FAB fab
= cc$rms_fab
;
649 struct NAM nam
= cc$rms_nam
;
650 char esa
[NAM$C_MAXRSS
];
655 if (! index (src
, '/')
656 && (src
[slen
- 1] == ']'
657 || src
[slen
- 1] == ':'
658 || src
[slen
- 1] == '>'))
660 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
662 fab
.fab$b_fns
= slen
;
663 fab
.fab$l_nam
= &nam
;
664 fab
.fab$l_fop
= FAB$M_NAM
;
667 nam
.nam$b_ess
= sizeof esa
;
668 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
670 /* We call SYS$PARSE to handle such things as [--] for us. */
671 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
673 slen
= nam
.nam$b_esl
;
674 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
679 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
681 /* what about when we have logical_name:???? */
682 if (src
[slen
- 1] == ':')
683 { /* Xlate logical name and see what we get */
684 ptr
= strcpy (dst
, src
); /* upper case for getenv */
687 if ('a' <= *ptr
&& *ptr
<= 'z')
691 dst
[slen
- 1] = 0; /* remove colon */
692 if (!(src
= egetenv (dst
)))
694 /* should we jump to the beginning of this procedure?
695 Good points: allows us to use logical names that xlate
697 Bad points: can be a problem if we just translated to a device
699 For now, I'll punt and always expect VMS names, and hope for
702 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
703 { /* no recursion here! */
709 { /* not a directory spec */
714 bracket
= src
[slen
- 1];
716 /* If bracket is ']' or '>', bracket - 2 is the corresponding
718 ptr
= index (src
, bracket
- 2);
720 { /* no opening bracket */
724 if (!(rptr
= rindex (src
, '.')))
727 strncpy (dst
, src
, slen
);
731 dst
[slen
++] = bracket
;
736 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
737 then translate the device and recurse. */
738 if (dst
[slen
- 1] == ':'
739 && dst
[slen
- 2] != ':' /* skip decnet nodes */
740 && strcmp (src
+ slen
, "[000000]") == 0)
742 dst
[slen
- 1] = '\0';
743 if ((ptr
= egetenv (dst
))
744 && (rlen
= strlen (ptr
) - 1) > 0
745 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
746 && ptr
[rlen
- 1] == '.')
748 char * buf
= (char *) alloca (strlen (ptr
) + 1);
752 return directory_file_name (buf
, dst
);
757 strcat (dst
, "[000000]");
761 rlen
= strlen (rptr
) - 1;
762 strncat (dst
, rptr
, rlen
);
763 dst
[slen
+ rlen
] = '\0';
764 strcat (dst
, ".DIR.1");
768 /* Process as Unix format: just remove any final slash.
769 But leave "/" unchanged; do not change it to "". */
772 /* Handle // as root for apollo's. */
773 if ((slen
> 2 && dst
[slen
- 1] == '/')
774 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
778 && IS_DIRECTORY_SEP (dst
[slen
- 1])
780 && !IS_ANY_SEP (dst
[slen
- 2])
786 CORRECT_DIR_SEPS (dst
);
791 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
793 "Returns the file name of the directory named DIRECTORY.\n\
794 This is the name of the file that holds the data for the directory DIRECTORY.\n\
795 This operation exists because a directory is also a file, but its name as\n\
796 a directory is different from its name as a file.\n\
797 In Unix-syntax, this function just removes the final slash.\n\
798 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
799 it returns a file name such as \"[X]Y.DIR.1\".")
801 Lisp_Object directory
;
806 CHECK_STRING (directory
, 0);
808 if (NILP (directory
))
811 /* If the file name has special constructs in it,
812 call the corresponding file handler. */
813 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
815 return call2 (handler
, Qdirectory_file_name
, directory
);
818 /* 20 extra chars is insufficient for VMS, since we might perform a
819 logical name translation. an equivalence string can be up to 255
820 chars long, so grab that much extra space... - sss */
821 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20 + 255);
823 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20);
825 directory_file_name (XSTRING (directory
)->data
, buf
);
826 return build_string (buf
);
829 static char make_temp_name_tbl
[64] =
831 'A','B','C','D','E','F','G','H',
832 'I','J','K','L','M','N','O','P',
833 'Q','R','S','T','U','V','W','X',
834 'Y','Z','a','b','c','d','e','f',
835 'g','h','i','j','k','l','m','n',
836 'o','p','q','r','s','t','u','v',
837 'w','x','y','z','0','1','2','3',
838 '4','5','6','7','8','9','-','_'
840 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
842 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
843 "Generate temporary file name (string) starting with PREFIX (a string).\n\
844 The Emacs process number forms part of the result,\n\
845 so there is no danger of generating a name being used by another process.\n\
847 In addition, this function makes an attempt to choose a name\n\
848 which has no existing file. To make this work,\n\
849 PREFIX should be an absolute file name.")
856 unsigned char *p
, *data
;
860 CHECK_STRING (prefix
, 0);
862 /* VAL is created by adding 6 characters to PREFIX. The first
863 three are the PID of this process, in base 64, and the second
864 three are incremented if the file already exists. This ensures
865 262144 unique file names per PID per PREFIX. */
867 pid
= (int) getpid ();
869 #ifdef HAVE_LONG_FILE_NAMES
870 sprintf (pidbuf
, "%d", pid
);
871 pidlen
= strlen (pidbuf
);
873 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
874 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
875 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
879 len
= XSTRING (prefix
)->size
;
880 val
= make_uninit_string (len
+ 3 + pidlen
);
881 data
= XSTRING (val
)->data
;
882 bcopy(XSTRING (prefix
)->data
, data
, len
);
885 bcopy (pidbuf
, p
, pidlen
);
888 /* Here we try to minimize useless stat'ing when this function is
889 invoked many times successively with the same PREFIX. We achieve
890 this by initializing count to a random value, and incrementing it
893 We don't want make-temp-name to be called while dumping,
894 because then make_temp_name_count_initialized_p would get set
895 and then make_temp_name_count would not be set when Emacs starts. */
897 if (!make_temp_name_count_initialized_p
)
899 make_temp_name_count
= (unsigned) time (NULL
);
900 make_temp_name_count_initialized_p
= 1;
906 unsigned num
= make_temp_name_count
;
908 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
909 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
910 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
912 /* Poor man's congruential RN generator. Replace with
913 ++make_temp_name_count for debugging. */
914 make_temp_name_count
+= 25229;
915 make_temp_name_count
%= 225307;
917 if (stat (data
, &ignored
) < 0)
919 /* We want to return only if errno is ENOENT. */
923 /* The error here is dubious, but there is little else we
924 can do. The alternatives are to return nil, which is
925 as bad as (and in many cases worse than) throwing the
926 error, or to ignore the error, which will likely result
927 in looping through 225307 stat's, which is not only
928 dog-slow, but also useless since it will fallback to
929 the errow below, anyway. */
930 report_file_error ("Cannot create temporary name for prefix `%s'",
931 Fcons (prefix
, Qnil
));
936 error ("Cannot create temporary name for prefix `%s'",
937 XSTRING (prefix
)->data
);
942 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
943 "Convert filename NAME to absolute, and canonicalize it.\n\
944 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
945 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
946 the current buffer's value of default-directory is used.\n\
947 File name components that are `.' are removed, and \n\
948 so are file name components followed by `..', along with the `..' itself;\n\
949 note that these simplifications are done without checking the resulting\n\
950 file names in the file system.\n\
951 An initial `~/' expands to your home directory.\n\
952 An initial `~USER/' expands to USER's home directory.\n\
953 See also the function `substitute-in-file-name'.")
954 (name
, default_directory
)
955 Lisp_Object name
, default_directory
;
959 register unsigned char *newdir
, *p
, *o
;
961 unsigned char *target
;
964 unsigned char * colon
= 0;
965 unsigned char * close
= 0;
966 unsigned char * slash
= 0;
967 unsigned char * brack
= 0;
968 int lbrack
= 0, rbrack
= 0;
973 int collapse_newdir
= 1;
979 CHECK_STRING (name
, 0);
981 /* If the file name has special constructs in it,
982 call the corresponding file handler. */
983 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
985 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
987 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
988 if (NILP (default_directory
))
989 default_directory
= current_buffer
->directory
;
990 if (! STRINGP (default_directory
))
991 default_directory
= build_string ("/");
993 if (!NILP (default_directory
))
995 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
997 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1000 o
= XSTRING (default_directory
)->data
;
1002 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1003 It would be better to do this down below where we actually use
1004 default_directory. Unfortunately, calling Fexpand_file_name recursively
1005 could invoke GC, and the strings might be relocated. This would
1006 be annoying because we have pointers into strings lying around
1007 that would need adjusting, and people would add new pointers to
1008 the code and forget to adjust them, resulting in intermittent bugs.
1009 Putting this call here avoids all that crud.
1011 The EQ test avoids infinite recursion. */
1012 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1013 /* Save time in some common cases - as long as default_directory
1014 is not relative, it can be canonicalized with name below (if it
1015 is needed at all) without requiring it to be expanded now. */
1017 /* Detect MSDOS file names with drive specifiers. */
1018 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1020 /* Detect Windows file names in UNC format. */
1021 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1023 #else /* not DOS_NT */
1024 /* Detect Unix absolute file names (/... alone is not absolute on
1026 && ! (IS_DIRECTORY_SEP (o
[0]))
1027 #endif /* not DOS_NT */
1030 struct gcpro gcpro1
;
1033 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1038 /* Filenames on VMS are always upper case. */
1039 name
= Fupcase (name
);
1041 #ifdef FILE_SYSTEM_CASE
1042 name
= FILE_SYSTEM_CASE (name
);
1045 nm
= XSTRING (name
)->data
;
1048 /* We will force directory separators to be either all \ or /, so make
1049 a local copy to modify, even if there ends up being no change. */
1050 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1052 /* Note if special escape prefix is present, but remove for now. */
1053 if (nm
[0] == '/' && nm
[1] == ':')
1059 /* Find and remove drive specifier if present; this makes nm absolute
1060 even if the rest of the name appears to be relative. Only look for
1061 drive specifier at the beginning. */
1062 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1069 /* If we see "c://somedir", we want to strip the first slash after the
1070 colon when stripping the drive letter. Otherwise, this expands to
1072 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1074 #endif /* WINDOWSNT */
1078 /* Discard any previous drive specifier if nm is now in UNC format. */
1079 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1085 /* If nm is absolute, look for /./ or /../ sequences; if none are
1086 found, we can probably return right away. We will avoid allocating
1087 a new string if name is already fully expanded. */
1089 IS_DIRECTORY_SEP (nm
[0])
1091 && drive
&& !is_escaped
1094 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1101 /* If it turns out that the filename we want to return is just a
1102 suffix of FILENAME, we don't need to go through and edit
1103 things; we just need to construct a new string using data
1104 starting at the middle of FILENAME. If we set lose to a
1105 non-zero value, that means we've discovered that we can't do
1112 /* Since we know the name is absolute, we can assume that each
1113 element starts with a "/". */
1115 /* "." and ".." are hairy. */
1116 if (IS_DIRECTORY_SEP (p
[0])
1118 && (IS_DIRECTORY_SEP (p
[2])
1120 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1127 /* if dev:[dir]/, move nm to / */
1128 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1129 nm
= (brack
? brack
+ 1 : colon
+ 1);
1130 lbrack
= rbrack
= 0;
1138 /* VMS pre V4.4,convert '-'s in filenames. */
1139 if (lbrack
== rbrack
)
1141 if (dots
< 2) /* this is to allow negative version numbers */
1146 if (lbrack
> rbrack
&&
1147 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1148 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1154 /* count open brackets, reset close bracket pointer */
1155 if (p
[0] == '[' || p
[0] == '<')
1156 lbrack
++, brack
= 0;
1157 /* count close brackets, set close bracket pointer */
1158 if (p
[0] == ']' || p
[0] == '>')
1159 rbrack
++, brack
= p
;
1160 /* detect ][ or >< */
1161 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1163 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1164 nm
= p
+ 1, lose
= 1;
1165 if (p
[0] == ':' && (colon
|| slash
))
1166 /* if dev1:[dir]dev2:, move nm to dev2: */
1172 /* if /name/dev:, move nm to dev: */
1175 /* if node::dev:, move colon following dev */
1176 else if (colon
&& colon
[-1] == ':')
1178 /* if dev1:dev2:, move nm to dev2: */
1179 else if (colon
&& colon
[-1] != ':')
1184 if (p
[0] == ':' && !colon
)
1190 if (lbrack
== rbrack
)
1193 else if (p
[0] == '.')
1201 if (index (nm
, '/'))
1202 return build_string (sys_translate_unix (nm
));
1205 /* Make sure directories are all separated with / or \ as
1206 desired, but avoid allocation of a new string when not
1208 CORRECT_DIR_SEPS (nm
);
1210 if (IS_DIRECTORY_SEP (nm
[1]))
1212 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1213 name
= build_string (nm
);
1217 /* drive must be set, so this is okay */
1218 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1220 name
= make_string (nm
- 2, p
- nm
+ 2);
1221 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1222 XSTRING (name
)->data
[1] = ':';
1225 #else /* not DOS_NT */
1226 if (nm
== XSTRING (name
)->data
)
1228 return build_string (nm
);
1229 #endif /* not DOS_NT */
1233 /* At this point, nm might or might not be an absolute file name. We
1234 need to expand ~ or ~user if present, otherwise prefix nm with
1235 default_directory if nm is not absolute, and finally collapse /./
1236 and /foo/../ sequences.
1238 We set newdir to be the appropriate prefix if one is needed:
1239 - the relevant user directory if nm starts with ~ or ~user
1240 - the specified drive's working dir (DOS/NT only) if nm does not
1242 - the value of default_directory.
1244 Note that these prefixes are not guaranteed to be absolute (except
1245 for the working dir of a drive). Therefore, to ensure we always
1246 return an absolute name, if the final prefix is not absolute we
1247 append it to the current working directory. */
1251 if (nm
[0] == '~') /* prefix ~ */
1253 if (IS_DIRECTORY_SEP (nm
[1])
1257 || nm
[1] == 0) /* ~ by itself */
1259 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1260 newdir
= (unsigned char *) "";
1263 collapse_newdir
= 0;
1266 nm
++; /* Don't leave the slash in nm. */
1269 else /* ~user/filename */
1271 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1276 o
= (unsigned char *) alloca (p
- nm
+ 1);
1277 bcopy ((char *) nm
, o
, p
- nm
);
1280 pw
= (struct passwd
*) getpwnam (o
+ 1);
1283 newdir
= (unsigned char *) pw
-> pw_dir
;
1285 nm
= p
+ 1; /* skip the terminator */
1289 collapse_newdir
= 0;
1294 /* If we don't find a user of that name, leave the name
1295 unchanged; don't move nm forward to p. */
1300 /* On DOS and Windows, nm is absolute if a drive name was specified;
1301 use the drive's current directory as the prefix if needed. */
1302 if (!newdir
&& drive
)
1304 /* Get default directory if needed to make nm absolute. */
1305 if (!IS_DIRECTORY_SEP (nm
[0]))
1307 newdir
= alloca (MAXPATHLEN
+ 1);
1308 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1313 /* Either nm starts with /, or drive isn't mounted. */
1314 newdir
= alloca (4);
1315 newdir
[0] = DRIVE_LETTER (drive
);
1323 /* Finally, if no prefix has been specified and nm is not absolute,
1324 then it must be expanded relative to default_directory. */
1328 /* /... alone is not absolute on DOS and Windows. */
1329 && !IS_DIRECTORY_SEP (nm
[0])
1332 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1339 newdir
= XSTRING (default_directory
)->data
;
1341 /* Note if special escape prefix is present, but remove for now. */
1342 if (newdir
[0] == '/' && newdir
[1] == ':')
1353 /* First ensure newdir is an absolute name. */
1355 /* Detect MSDOS file names with drive specifiers. */
1356 ! (IS_DRIVE (newdir
[0])
1357 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1359 /* Detect Windows file names in UNC format. */
1360 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1364 /* Effectively, let newdir be (expand-file-name newdir cwd).
1365 Because of the admonition against calling expand-file-name
1366 when we have pointers into lisp strings, we accomplish this
1367 indirectly by prepending newdir to nm if necessary, and using
1368 cwd (or the wd of newdir's drive) as the new newdir. */
1370 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1375 if (!IS_DIRECTORY_SEP (nm
[0]))
1377 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1378 file_name_as_directory (tmp
, newdir
);
1382 newdir
= alloca (MAXPATHLEN
+ 1);
1385 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1392 /* Strip off drive name from prefix, if present. */
1393 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1399 /* Keep only a prefix from newdir if nm starts with slash
1400 (//server/share for UNC, nothing otherwise). */
1401 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1404 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1406 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1408 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1410 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1422 /* Get rid of any slash at the end of newdir, unless newdir is
1423 just / or // (an incomplete UNC name). */
1424 length
= strlen (newdir
);
1425 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1427 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1431 unsigned char *temp
= (unsigned char *) alloca (length
);
1432 bcopy (newdir
, temp
, length
- 1);
1433 temp
[length
- 1] = 0;
1441 /* Now concatenate the directory and name to new space in the stack frame */
1442 tlen
+= strlen (nm
) + 1;
1444 /* Reserve space for drive specifier and escape prefix, since either
1445 or both may need to be inserted. (The Microsoft x86 compiler
1446 produces incorrect code if the following two lines are combined.) */
1447 target
= (unsigned char *) alloca (tlen
+ 4);
1449 #else /* not DOS_NT */
1450 target
= (unsigned char *) alloca (tlen
);
1451 #endif /* not DOS_NT */
1457 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1460 /* If newdir is effectively "C:/", then the drive letter will have
1461 been stripped and newdir will be "/". Concatenating with an
1462 absolute directory in nm produces "//", which will then be
1463 incorrectly treated as a network share. Ignore newdir in
1464 this case (keeping the drive letter). */
1465 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1466 && newdir
[1] == '\0'))
1468 strcpy (target
, newdir
);
1472 file_name_as_directory (target
, newdir
);
1475 strcat (target
, nm
);
1477 if (index (target
, '/'))
1478 strcpy (target
, sys_translate_unix (target
));
1481 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1483 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1491 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1497 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1498 /* brackets are offset from each other by 2 */
1501 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1502 /* convert [foo][bar] to [bar] */
1503 while (o
[-1] != '[' && o
[-1] != '<')
1505 else if (*p
== '-' && *o
!= '.')
1508 else if (p
[0] == '-' && o
[-1] == '.' &&
1509 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1510 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1514 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1515 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1517 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1519 /* else [foo.-] ==> [-] */
1525 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1526 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1532 if (!IS_DIRECTORY_SEP (*p
))
1536 else if (IS_DIRECTORY_SEP (p
[0])
1538 && (IS_DIRECTORY_SEP (p
[2])
1541 /* If "/." is the entire filename, keep the "/". Otherwise,
1542 just delete the whole "/.". */
1543 if (o
== target
&& p
[2] == '\0')
1547 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1548 /* `/../' is the "superroot" on certain file systems. */
1550 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1552 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1554 /* Keep initial / only if this is the whole name. */
1555 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1563 #endif /* not VMS */
1567 /* At last, set drive name. */
1569 /* Except for network file name. */
1570 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1571 #endif /* WINDOWSNT */
1573 if (!drive
) abort ();
1575 target
[0] = DRIVE_LETTER (drive
);
1578 /* Reinsert the escape prefix if required. */
1585 CORRECT_DIR_SEPS (target
);
1588 return make_string (target
, o
- target
);
1592 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1593 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1594 "Convert FILENAME to absolute, and canonicalize it.\n\
1595 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1596 (does not start with slash); if DEFAULT is nil or missing,\n\
1597 the current buffer's value of default-directory is used.\n\
1598 Filenames containing `.' or `..' as components are simplified;\n\
1599 initial `~/' expands to your home directory.\n\
1600 See also the function `substitute-in-file-name'.")
1602 Lisp_Object name
, defalt
;
1606 register unsigned char *newdir
, *p
, *o
;
1608 unsigned char *target
;
1612 unsigned char * colon
= 0;
1613 unsigned char * close
= 0;
1614 unsigned char * slash
= 0;
1615 unsigned char * brack
= 0;
1616 int lbrack
= 0, rbrack
= 0;
1620 CHECK_STRING (name
, 0);
1623 /* Filenames on VMS are always upper case. */
1624 name
= Fupcase (name
);
1627 nm
= XSTRING (name
)->data
;
1629 /* If nm is absolute, flush ...// and detect /./ and /../.
1630 If no /./ or /../ we can return right away. */
1642 if (p
[0] == '/' && p
[1] == '/'
1644 /* // at start of filename is meaningful on Apollo system. */
1649 if (p
[0] == '/' && p
[1] == '~')
1650 nm
= p
+ 1, lose
= 1;
1651 if (p
[0] == '/' && p
[1] == '.'
1652 && (p
[2] == '/' || p
[2] == 0
1653 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1659 /* if dev:[dir]/, move nm to / */
1660 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1661 nm
= (brack
? brack
+ 1 : colon
+ 1);
1662 lbrack
= rbrack
= 0;
1670 /* VMS pre V4.4,convert '-'s in filenames. */
1671 if (lbrack
== rbrack
)
1673 if (dots
< 2) /* this is to allow negative version numbers */
1678 if (lbrack
> rbrack
&&
1679 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1680 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1686 /* count open brackets, reset close bracket pointer */
1687 if (p
[0] == '[' || p
[0] == '<')
1688 lbrack
++, brack
= 0;
1689 /* count close brackets, set close bracket pointer */
1690 if (p
[0] == ']' || p
[0] == '>')
1691 rbrack
++, brack
= p
;
1692 /* detect ][ or >< */
1693 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1695 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1696 nm
= p
+ 1, lose
= 1;
1697 if (p
[0] == ':' && (colon
|| slash
))
1698 /* if dev1:[dir]dev2:, move nm to dev2: */
1704 /* If /name/dev:, move nm to dev: */
1707 /* If node::dev:, move colon following dev */
1708 else if (colon
&& colon
[-1] == ':')
1710 /* If dev1:dev2:, move nm to dev2: */
1711 else if (colon
&& colon
[-1] != ':')
1716 if (p
[0] == ':' && !colon
)
1722 if (lbrack
== rbrack
)
1725 else if (p
[0] == '.')
1733 if (index (nm
, '/'))
1734 return build_string (sys_translate_unix (nm
));
1736 if (nm
== XSTRING (name
)->data
)
1738 return build_string (nm
);
1742 /* Now determine directory to start with and put it in NEWDIR */
1746 if (nm
[0] == '~') /* prefix ~ */
1751 || nm
[1] == 0)/* ~/filename */
1753 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1754 newdir
= (unsigned char *) "";
1757 nm
++; /* Don't leave the slash in nm. */
1760 else /* ~user/filename */
1762 /* Get past ~ to user */
1763 unsigned char *user
= nm
+ 1;
1764 /* Find end of name. */
1765 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1766 int len
= ptr
? ptr
- user
: strlen (user
);
1768 unsigned char *ptr1
= index (user
, ':');
1769 if (ptr1
!= 0 && ptr1
- user
< len
)
1772 /* Copy the user name into temp storage. */
1773 o
= (unsigned char *) alloca (len
+ 1);
1774 bcopy ((char *) user
, o
, len
);
1777 /* Look up the user name. */
1778 pw
= (struct passwd
*) getpwnam (o
+ 1);
1780 error ("\"%s\" isn't a registered user", o
+ 1);
1782 newdir
= (unsigned char *) pw
->pw_dir
;
1784 /* Discard the user name from NM. */
1791 #endif /* not VMS */
1795 defalt
= current_buffer
->directory
;
1796 CHECK_STRING (defalt
, 1);
1797 newdir
= XSTRING (defalt
)->data
;
1800 /* Now concatenate the directory and name to new space in the stack frame */
1802 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1803 target
= (unsigned char *) alloca (tlen
);
1809 if (nm
[0] == 0 || nm
[0] == '/')
1810 strcpy (target
, newdir
);
1813 file_name_as_directory (target
, newdir
);
1816 strcat (target
, nm
);
1818 if (index (target
, '/'))
1819 strcpy (target
, sys_translate_unix (target
));
1822 /* Now canonicalize by removing /. and /foo/.. if they appear */
1830 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1836 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1837 /* brackets are offset from each other by 2 */
1840 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1841 /* convert [foo][bar] to [bar] */
1842 while (o
[-1] != '[' && o
[-1] != '<')
1844 else if (*p
== '-' && *o
!= '.')
1847 else if (p
[0] == '-' && o
[-1] == '.' &&
1848 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1849 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1853 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1854 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1856 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1858 /* else [foo.-] ==> [-] */
1864 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1865 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1875 else if (!strncmp (p
, "//", 2)
1877 /* // at start of filename is meaningful in Apollo system. */
1885 else if (p
[0] == '/' && p
[1] == '.' &&
1886 (p
[2] == '/' || p
[2] == 0))
1888 else if (!strncmp (p
, "/..", 3)
1889 /* `/../' is the "superroot" on certain file systems. */
1891 && (p
[3] == '/' || p
[3] == 0))
1893 while (o
!= target
&& *--o
!= '/')
1896 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1900 if (o
== target
&& *o
== '/')
1908 #endif /* not VMS */
1911 return make_string (target
, o
- target
);
1915 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1916 Ssubstitute_in_file_name
, 1, 1, 0,
1917 "Substitute environment variables referred to in FILENAME.\n\
1918 `$FOO' where FOO is an environment variable name means to substitute\n\
1919 the value of that variable. The variable name should be terminated\n\
1920 with a character not a letter, digit or underscore; otherwise, enclose\n\
1921 the entire variable name in braces.\n\
1922 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1923 On VMS, `$' substitution is not done; this function does little and only\n\
1924 duplicates what `expand-file-name' does.")
1926 Lisp_Object filename
;
1930 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1931 unsigned char *target
;
1933 int substituted
= 0;
1935 Lisp_Object handler
;
1937 CHECK_STRING (filename
, 0);
1939 /* If the file name has special constructs in it,
1940 call the corresponding file handler. */
1941 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1942 if (!NILP (handler
))
1943 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1945 nm
= XSTRING (filename
)->data
;
1947 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1948 CORRECT_DIR_SEPS (nm
);
1949 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1951 endp
= nm
+ STRING_BYTES (XSTRING (filename
));
1953 /* If /~ or // appears, discard everything through first slash. */
1955 for (p
= nm
; p
!= endp
; p
++)
1958 #if defined (APOLLO) || defined (WINDOWSNT)
1959 /* // at start of file name is meaningful in Apollo and
1960 WindowsNT systems. */
1961 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1962 #else /* not (APOLLO || WINDOWSNT) */
1963 || IS_DIRECTORY_SEP (p
[0])
1964 #endif /* not (APOLLO || WINDOWSNT) */
1969 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1971 || IS_DIRECTORY_SEP (p
[-1])))
1977 /* see comment in expand-file-name about drive specifiers */
1978 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1979 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1988 return build_string (nm
);
1991 /* See if any variables are substituted into the string
1992 and find the total length of their values in `total' */
1994 for (p
= nm
; p
!= endp
;)
2004 /* "$$" means a single "$" */
2013 while (p
!= endp
&& *p
!= '}') p
++;
2014 if (*p
!= '}') goto missingclose
;
2020 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2024 /* Copy out the variable name */
2025 target
= (unsigned char *) alloca (s
- o
+ 1);
2026 strncpy (target
, o
, s
- o
);
2029 strupr (target
); /* $home == $HOME etc. */
2032 /* Get variable value */
2033 o
= (unsigned char *) egetenv (target
);
2034 if (!o
) goto badvar
;
2035 total
+= strlen (o
);
2042 /* If substitution required, recopy the string and do it */
2043 /* Make space in stack frame for the new copy */
2044 xnm
= (unsigned char *) alloca (STRING_BYTES (XSTRING (filename
)) + total
+ 1);
2047 /* Copy the rest of the name through, replacing $ constructs with values */
2064 while (p
!= endp
&& *p
!= '}') p
++;
2065 if (*p
!= '}') goto missingclose
;
2071 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2075 /* Copy out the variable name */
2076 target
= (unsigned char *) alloca (s
- o
+ 1);
2077 strncpy (target
, o
, s
- o
);
2080 strupr (target
); /* $home == $HOME etc. */
2083 /* Get variable value */
2084 o
= (unsigned char *) egetenv (target
);
2088 if (STRING_MULTIBYTE (filename
))
2090 /* If the original string is multibyte,
2091 convert what we substitute into multibyte. */
2092 unsigned char workbuf
[4], *str
;
2098 c
= unibyte_char_to_multibyte (c
);
2099 if (! SINGLE_BYTE_CHAR_P (c
))
2101 len
= CHAR_STRING (c
, workbuf
, str
);
2102 bcopy (str
, x
, len
);
2118 /* If /~ or // appears, discard everything through first slash. */
2120 for (p
= xnm
; p
!= x
; p
++)
2122 #if defined (APOLLO) || defined (WINDOWSNT)
2123 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2124 #else /* not (APOLLO || WINDOWSNT) */
2125 || IS_DIRECTORY_SEP (p
[0])
2126 #endif /* not (APOLLO || WINDOWSNT) */
2128 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2131 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2132 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2136 if (STRING_MULTIBYTE (filename
))
2137 return make_string (xnm
, x
- xnm
);
2138 return make_unibyte_string (xnm
, x
- xnm
);
2141 error ("Bad format environment-variable substitution");
2143 error ("Missing \"}\" in environment-variable substitution");
2145 error ("Substituting nonexistent environment variable \"%s\"", target
);
2148 #endif /* not VMS */
2151 /* A slightly faster and more convenient way to get
2152 (directory-file-name (expand-file-name FOO)). */
2155 expand_and_dir_to_file (filename
, defdir
)
2156 Lisp_Object filename
, defdir
;
2158 register Lisp_Object absname
;
2160 absname
= Fexpand_file_name (filename
, defdir
);
2163 register int c
= XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1];
2164 if (c
== ':' || c
== ']' || c
== '>')
2165 absname
= Fdirectory_file_name (absname
);
2168 /* Remove final slash, if any (unless this is the root dir).
2169 stat behaves differently depending! */
2170 if (XSTRING (absname
)->size
> 1
2171 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1])
2172 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
))-2]))
2173 /* We cannot take shortcuts; they might be wrong for magic file names. */
2174 absname
= Fdirectory_file_name (absname
);
2179 /* Signal an error if the file ABSNAME already exists.
2180 If INTERACTIVE is nonzero, ask the user whether to proceed,
2181 and bypass the error if the user says to go ahead.
2182 QUERYSTRING is a name for the action that is being considered
2185 *STATPTR is used to store the stat information if the file exists.
2186 If the file does not exist, STATPTR->st_mode is set to 0.
2187 If STATPTR is null, we don't store into it.
2189 If QUICK is nonzero, we ask for y or n, not yes or no. */
2192 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2193 Lisp_Object absname
;
2194 unsigned char *querystring
;
2196 struct stat
*statptr
;
2199 register Lisp_Object tem
, encoded_filename
;
2200 struct stat statbuf
;
2201 struct gcpro gcpro1
;
2203 encoded_filename
= ENCODE_FILE (absname
);
2205 /* stat is a good way to tell whether the file exists,
2206 regardless of what access permissions it has. */
2207 if (stat (XSTRING (encoded_filename
)->data
, &statbuf
) >= 0)
2210 Fsignal (Qfile_already_exists
,
2211 Fcons (build_string ("File already exists"),
2212 Fcons (absname
, Qnil
)));
2214 tem
= format1 ("File %s already exists; %s anyway? ",
2215 XSTRING (absname
)->data
, querystring
);
2217 tem
= Fy_or_n_p (tem
);
2219 tem
= do_yes_or_no_p (tem
);
2222 Fsignal (Qfile_already_exists
,
2223 Fcons (build_string ("File already exists"),
2224 Fcons (absname
, Qnil
)));
2231 statptr
->st_mode
= 0;
2236 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2237 "fCopy file: \nFCopy %s to file: \np\nP",
2238 "Copy FILE to NEWNAME. Both args must be strings.\n\
2239 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2240 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2241 A number as third arg means request confirmation if NEWNAME already exists.\n\
2242 This is what happens in interactive use with M-x.\n\
2243 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2244 last-modified time as the old one. (This works on only some systems.)\n\
2245 A prefix arg makes KEEP-TIME non-nil.")
2246 (file
, newname
, ok_if_already_exists
, keep_date
)
2247 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2250 char buf
[16 * 1024];
2251 struct stat st
, out_st
;
2252 Lisp_Object handler
;
2253 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2254 int count
= specpdl_ptr
- specpdl
;
2255 int input_file_statable_p
;
2256 Lisp_Object encoded_file
, encoded_newname
;
2258 encoded_file
= encoded_newname
= Qnil
;
2259 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2260 CHECK_STRING (file
, 0);
2261 CHECK_STRING (newname
, 1);
2263 file
= Fexpand_file_name (file
, Qnil
);
2264 newname
= Fexpand_file_name (newname
, Qnil
);
2266 /* If the input file name has special constructs in it,
2267 call the corresponding file handler. */
2268 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2269 /* Likewise for output file name. */
2271 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2272 if (!NILP (handler
))
2273 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2274 ok_if_already_exists
, keep_date
));
2276 encoded_file
= ENCODE_FILE (file
);
2277 encoded_newname
= ENCODE_FILE (newname
);
2279 if (NILP (ok_if_already_exists
)
2280 || INTEGERP (ok_if_already_exists
))
2281 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2282 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2283 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2286 ifd
= open (XSTRING (encoded_file
)->data
, O_RDONLY
);
2288 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2290 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2292 /* We can only copy regular files and symbolic links. Other files are not
2294 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2296 #if !defined (DOS_NT) || __DJGPP__ > 1
2297 if (out_st
.st_mode
!= 0
2298 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2301 report_file_error ("Input and output files are the same",
2302 Fcons (file
, Fcons (newname
, Qnil
)));
2306 #if defined (S_ISREG) && defined (S_ISLNK)
2307 if (input_file_statable_p
)
2309 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2311 #if defined (EISDIR)
2312 /* Get a better looking error message. */
2315 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2318 #endif /* S_ISREG && S_ISLNK */
2321 /* Create the copy file with the same record format as the input file */
2322 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2325 /* System's default file type was set to binary by _fmode in emacs.c. */
2326 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2327 #else /* not MSDOS */
2328 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2329 #endif /* not MSDOS */
2332 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2334 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2338 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2339 if (write (ofd
, buf
, n
) != n
)
2340 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2343 /* Closing the output clobbers the file times on some systems. */
2344 if (close (ofd
) < 0)
2345 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2347 if (input_file_statable_p
)
2349 if (!NILP (keep_date
))
2351 EMACS_TIME atime
, mtime
;
2352 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2353 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2354 if (set_file_times (XSTRING (encoded_newname
)->data
,
2356 Fsignal (Qfile_date_error
,
2357 Fcons (build_string ("Cannot set file date"),
2358 Fcons (newname
, Qnil
)));
2361 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2363 #if defined (__DJGPP__) && __DJGPP__ > 1
2364 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2365 and if it can't, it tells so. Otherwise, under MSDOS we usually
2366 get only the READ bit, which will make the copied file read-only,
2367 so it's better not to chmod at all. */
2368 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2369 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2370 #endif /* DJGPP version 2 or newer */
2376 /* Discard the unwind protects. */
2377 specpdl_ptr
= specpdl
+ count
;
2383 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2384 Smake_directory_internal
, 1, 1, 0,
2385 "Create a new directory named DIRECTORY.")
2387 Lisp_Object directory
;
2390 Lisp_Object handler
;
2391 Lisp_Object encoded_dir
;
2393 CHECK_STRING (directory
, 0);
2394 directory
= Fexpand_file_name (directory
, Qnil
);
2396 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2397 if (!NILP (handler
))
2398 return call2 (handler
, Qmake_directory_internal
, directory
);
2400 encoded_dir
= ENCODE_FILE (directory
);
2402 dir
= XSTRING (encoded_dir
)->data
;
2405 if (mkdir (dir
) != 0)
2407 if (mkdir (dir
, 0777) != 0)
2409 report_file_error ("Creating directory", Flist (1, &directory
));
2414 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2415 "Delete the directory named DIRECTORY.")
2417 Lisp_Object directory
;
2420 Lisp_Object handler
;
2421 Lisp_Object encoded_dir
;
2423 CHECK_STRING (directory
, 0);
2424 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2426 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2427 if (!NILP (handler
))
2428 return call2 (handler
, Qdelete_directory
, directory
);
2430 encoded_dir
= ENCODE_FILE (directory
);
2432 dir
= XSTRING (encoded_dir
)->data
;
2434 if (rmdir (dir
) != 0)
2435 report_file_error ("Removing directory", Flist (1, &directory
));
2440 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2441 "Delete file named FILENAME.\n\
2442 If file has multiple names, it continues to exist with the other names.")
2444 Lisp_Object filename
;
2446 Lisp_Object handler
;
2447 Lisp_Object encoded_file
;
2449 CHECK_STRING (filename
, 0);
2450 filename
= Fexpand_file_name (filename
, Qnil
);
2452 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2453 if (!NILP (handler
))
2454 return call2 (handler
, Qdelete_file
, filename
);
2456 encoded_file
= ENCODE_FILE (filename
);
2458 if (0 > unlink (XSTRING (encoded_file
)->data
))
2459 report_file_error ("Removing old name", Flist (1, &filename
));
2464 internal_delete_file_1 (ignore
)
2470 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2473 internal_delete_file (filename
)
2474 Lisp_Object filename
;
2476 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2477 Qt
, internal_delete_file_1
));
2480 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2481 "fRename file: \nFRename %s to file: \np",
2482 "Rename FILE as NEWNAME. Both args strings.\n\
2483 If file has names other than FILE, it continues to have those names.\n\
2484 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2485 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2486 A number as third arg means request confirmation if NEWNAME already exists.\n\
2487 This is what happens in interactive use with M-x.")
2488 (file
, newname
, ok_if_already_exists
)
2489 Lisp_Object file
, newname
, ok_if_already_exists
;
2492 Lisp_Object args
[2];
2494 Lisp_Object handler
;
2495 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2496 Lisp_Object encoded_file
, encoded_newname
;
2498 encoded_file
= encoded_newname
= Qnil
;
2499 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2500 CHECK_STRING (file
, 0);
2501 CHECK_STRING (newname
, 1);
2502 file
= Fexpand_file_name (file
, Qnil
);
2503 newname
= Fexpand_file_name (newname
, Qnil
);
2505 /* If the file name has special constructs in it,
2506 call the corresponding file handler. */
2507 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2509 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2510 if (!NILP (handler
))
2511 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2512 file
, newname
, ok_if_already_exists
));
2514 encoded_file
= ENCODE_FILE (file
);
2515 encoded_newname
= ENCODE_FILE (newname
);
2517 if (NILP (ok_if_already_exists
)
2518 || INTEGERP (ok_if_already_exists
))
2519 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2520 INTEGERP (ok_if_already_exists
), 0, 0);
2522 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2524 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2525 || 0 > unlink (XSTRING (encoded_file
)->data
))
2530 Fcopy_file (file
, newname
,
2531 /* We have already prompted if it was an integer,
2532 so don't have copy-file prompt again. */
2533 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2534 Fdelete_file (file
);
2541 report_file_error ("Renaming", Flist (2, args
));
2544 report_file_error ("Renaming", Flist (2, &file
));
2551 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2552 "fAdd name to file: \nFName to add to %s: \np",
2553 "Give FILE additional name NEWNAME. Both args strings.\n\
2554 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2555 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2556 A number as third arg means request confirmation if NEWNAME already exists.\n\
2557 This is what happens in interactive use with M-x.")
2558 (file
, newname
, ok_if_already_exists
)
2559 Lisp_Object file
, newname
, ok_if_already_exists
;
2562 Lisp_Object args
[2];
2564 Lisp_Object handler
;
2565 Lisp_Object encoded_file
, encoded_newname
;
2566 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2568 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2569 encoded_file
= encoded_newname
= Qnil
;
2570 CHECK_STRING (file
, 0);
2571 CHECK_STRING (newname
, 1);
2572 file
= Fexpand_file_name (file
, Qnil
);
2573 newname
= Fexpand_file_name (newname
, Qnil
);
2575 /* If the file name has special constructs in it,
2576 call the corresponding file handler. */
2577 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2578 if (!NILP (handler
))
2579 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2580 newname
, ok_if_already_exists
));
2582 /* If the new name has special constructs in it,
2583 call the corresponding file handler. */
2584 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2585 if (!NILP (handler
))
2586 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2587 newname
, ok_if_already_exists
));
2589 encoded_file
= ENCODE_FILE (file
);
2590 encoded_newname
= ENCODE_FILE (newname
);
2592 if (NILP (ok_if_already_exists
)
2593 || INTEGERP (ok_if_already_exists
))
2594 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2595 INTEGERP (ok_if_already_exists
), 0, 0);
2597 unlink (XSTRING (newname
)->data
);
2598 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2603 report_file_error ("Adding new name", Flist (2, args
));
2605 report_file_error ("Adding new name", Flist (2, &file
));
2614 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2615 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2616 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2617 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2618 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2619 A number as third arg means request confirmation if LINKNAME already exists.\n\
2620 This happens for interactive use with M-x.")
2621 (filename
, linkname
, ok_if_already_exists
)
2622 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2625 Lisp_Object args
[2];
2627 Lisp_Object handler
;
2628 Lisp_Object encoded_filename
, encoded_linkname
;
2629 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2631 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2632 encoded_filename
= encoded_linkname
= Qnil
;
2633 CHECK_STRING (filename
, 0);
2634 CHECK_STRING (linkname
, 1);
2635 /* If the link target has a ~, we must expand it to get
2636 a truly valid file name. Otherwise, do not expand;
2637 we want to permit links to relative file names. */
2638 if (XSTRING (filename
)->data
[0] == '~')
2639 filename
= Fexpand_file_name (filename
, Qnil
);
2640 linkname
= Fexpand_file_name (linkname
, Qnil
);
2642 /* If the file name has special constructs in it,
2643 call the corresponding file handler. */
2644 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2645 if (!NILP (handler
))
2646 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2647 linkname
, ok_if_already_exists
));
2649 /* If the new link name has special constructs in it,
2650 call the corresponding file handler. */
2651 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2652 if (!NILP (handler
))
2653 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2654 linkname
, ok_if_already_exists
));
2656 encoded_filename
= ENCODE_FILE (filename
);
2657 encoded_linkname
= ENCODE_FILE (linkname
);
2659 if (NILP (ok_if_already_exists
)
2660 || INTEGERP (ok_if_already_exists
))
2661 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2662 INTEGERP (ok_if_already_exists
), 0, 0);
2663 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2664 XSTRING (encoded_linkname
)->data
))
2666 /* If we didn't complain already, silently delete existing file. */
2667 if (errno
== EEXIST
)
2669 unlink (XSTRING (encoded_linkname
)->data
);
2670 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2671 XSTRING (encoded_linkname
)->data
))
2681 report_file_error ("Making symbolic link", Flist (2, args
));
2683 report_file_error ("Making symbolic link", Flist (2, &filename
));
2689 #endif /* S_IFLNK */
2693 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2694 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2695 "Define the job-wide logical name NAME to have the value STRING.\n\
2696 If STRING is nil or a null string, the logical name NAME is deleted.")
2701 CHECK_STRING (name
, 0);
2703 delete_logical_name (XSTRING (name
)->data
);
2706 CHECK_STRING (string
, 1);
2708 if (XSTRING (string
)->size
== 0)
2709 delete_logical_name (XSTRING (name
)->data
);
2711 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2720 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2721 "Open a network connection to PATH using LOGIN as the login string.")
2723 Lisp_Object path
, login
;
2727 CHECK_STRING (path
, 0);
2728 CHECK_STRING (login
, 0);
2730 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2732 if (netresult
== -1)
2737 #endif /* HPUX_NET */
2739 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2741 "Return t if file FILENAME specifies an absolute file name.\n\
2742 On Unix, this is a name starting with a `/' or a `~'.")
2744 Lisp_Object filename
;
2748 CHECK_STRING (filename
, 0);
2749 ptr
= XSTRING (filename
)->data
;
2750 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2752 /* ??? This criterion is probably wrong for '<'. */
2753 || index (ptr
, ':') || index (ptr
, '<')
2754 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2758 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2766 /* Return nonzero if file FILENAME exists and can be executed. */
2769 check_executable (filename
)
2773 int len
= strlen (filename
);
2776 if (stat (filename
, &st
) < 0)
2778 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2779 return ((st
.st_mode
& S_IEXEC
) != 0);
2781 return (S_ISREG (st
.st_mode
)
2783 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2784 || stricmp (suffix
, ".exe") == 0
2785 || stricmp (suffix
, ".bat") == 0)
2786 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2787 #endif /* not WINDOWSNT */
2788 #else /* not DOS_NT */
2789 #ifdef HAVE_EUIDACCESS
2790 return (euidaccess (filename
, 1) >= 0);
2792 /* Access isn't quite right because it uses the real uid
2793 and we really want to test with the effective uid.
2794 But Unix doesn't give us a right way to do it. */
2795 return (access (filename
, 1) >= 0);
2797 #endif /* not DOS_NT */
2800 /* Return nonzero if file FILENAME exists and can be written. */
2803 check_writable (filename
)
2808 if (stat (filename
, &st
) < 0)
2810 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2811 #else /* not MSDOS */
2812 #ifdef HAVE_EUIDACCESS
2813 return (euidaccess (filename
, 2) >= 0);
2815 /* Access isn't quite right because it uses the real uid
2816 and we really want to test with the effective uid.
2817 But Unix doesn't give us a right way to do it.
2818 Opening with O_WRONLY could work for an ordinary file,
2819 but would lose for directories. */
2820 return (access (filename
, 2) >= 0);
2822 #endif /* not MSDOS */
2825 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2826 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2827 See also `file-readable-p' and `file-attributes'.")
2829 Lisp_Object filename
;
2831 Lisp_Object absname
;
2832 Lisp_Object handler
;
2833 struct stat statbuf
;
2835 CHECK_STRING (filename
, 0);
2836 absname
= Fexpand_file_name (filename
, Qnil
);
2838 /* If the file name has special constructs in it,
2839 call the corresponding file handler. */
2840 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2841 if (!NILP (handler
))
2842 return call2 (handler
, Qfile_exists_p
, absname
);
2844 absname
= ENCODE_FILE (absname
);
2846 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2849 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2850 "Return t if FILENAME can be executed by you.\n\
2851 For a directory, this means you can access files in that directory.")
2853 Lisp_Object filename
;
2856 Lisp_Object absname
;
2857 Lisp_Object handler
;
2859 CHECK_STRING (filename
, 0);
2860 absname
= Fexpand_file_name (filename
, Qnil
);
2862 /* If the file name has special constructs in it,
2863 call the corresponding file handler. */
2864 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2865 if (!NILP (handler
))
2866 return call2 (handler
, Qfile_executable_p
, absname
);
2868 absname
= ENCODE_FILE (absname
);
2870 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2873 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2874 "Return t if file FILENAME exists and you can read it.\n\
2875 See also `file-exists-p' and `file-attributes'.")
2877 Lisp_Object filename
;
2879 Lisp_Object absname
;
2880 Lisp_Object handler
;
2883 struct stat statbuf
;
2885 CHECK_STRING (filename
, 0);
2886 absname
= Fexpand_file_name (filename
, Qnil
);
2888 /* If the file name has special constructs in it,
2889 call the corresponding file handler. */
2890 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2891 if (!NILP (handler
))
2892 return call2 (handler
, Qfile_readable_p
, absname
);
2894 absname
= ENCODE_FILE (absname
);
2897 /* Under MS-DOS and Windows, open does not work for directories. */
2898 if (access (XSTRING (absname
)->data
, 0) == 0)
2901 #else /* not DOS_NT */
2903 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2904 /* Opening a fifo without O_NONBLOCK can wait.
2905 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2906 except in the case of a fifo, on a system which handles it. */
2907 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2910 if (S_ISFIFO (statbuf
.st_mode
))
2911 flags
|= O_NONBLOCK
;
2913 desc
= open (XSTRING (absname
)->data
, flags
);
2918 #endif /* not DOS_NT */
2921 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2923 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2924 "Return t if file FILENAME can be written or created by you.")
2926 Lisp_Object filename
;
2928 Lisp_Object absname
, dir
, encoded
;
2929 Lisp_Object handler
;
2930 struct stat statbuf
;
2932 CHECK_STRING (filename
, 0);
2933 absname
= Fexpand_file_name (filename
, Qnil
);
2935 /* If the file name has special constructs in it,
2936 call the corresponding file handler. */
2937 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2938 if (!NILP (handler
))
2939 return call2 (handler
, Qfile_writable_p
, absname
);
2941 encoded
= ENCODE_FILE (absname
);
2942 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
2943 return (check_writable (XSTRING (encoded
)->data
)
2946 dir
= Ffile_name_directory (absname
);
2949 dir
= Fdirectory_file_name (dir
);
2953 dir
= Fdirectory_file_name (dir
);
2956 dir
= ENCODE_FILE (dir
);
2957 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2961 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2962 "Access file FILENAME, and get an error if that does not work.\n\
2963 The second argument STRING is used in the error message.\n\
2964 If there is no error, we return nil.")
2966 Lisp_Object filename
, string
;
2968 Lisp_Object handler
, encoded_filename
;
2971 CHECK_STRING (filename
, 0);
2972 CHECK_STRING (string
, 1);
2974 /* If the file name has special constructs in it,
2975 call the corresponding file handler. */
2976 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2977 if (!NILP (handler
))
2978 return call3 (handler
, Qaccess_file
, filename
, string
);
2980 encoded_filename
= ENCODE_FILE (filename
);
2982 fd
= open (XSTRING (encoded_filename
)->data
, O_RDONLY
);
2984 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2990 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2991 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2992 The value is the name of the file to which it is linked.\n\
2993 Otherwise returns nil.")
2995 Lisp_Object filename
;
3002 Lisp_Object handler
;
3004 CHECK_STRING (filename
, 0);
3005 filename
= Fexpand_file_name (filename
, Qnil
);
3007 /* If the file name has special constructs in it,
3008 call the corresponding file handler. */
3009 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3010 if (!NILP (handler
))
3011 return call2 (handler
, Qfile_symlink_p
, filename
);
3013 filename
= ENCODE_FILE (filename
);
3018 buf
= (char *) xmalloc (bufsize
);
3019 bzero (buf
, bufsize
);
3020 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
3021 if (valsize
< bufsize
) break;
3022 /* Buffer was not long enough */
3031 val
= make_string (buf
, valsize
);
3033 val
= DECODE_FILE (val
);
3035 #else /* not S_IFLNK */
3037 #endif /* not S_IFLNK */
3040 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3041 "Return t if FILENAME names an existing directory.\n\
3042 Symbolic links to directories count as directories.\n\
3043 See `file-symlink-p' to distinguish symlinks.")
3045 Lisp_Object filename
;
3047 register Lisp_Object absname
;
3049 Lisp_Object handler
;
3051 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3053 /* If the file name has special constructs in it,
3054 call the corresponding file handler. */
3055 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3056 if (!NILP (handler
))
3057 return call2 (handler
, Qfile_directory_p
, absname
);
3059 absname
= ENCODE_FILE (absname
);
3061 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3063 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3066 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3067 "Return t if file FILENAME is the name of a directory as a file,\n\
3068 and files in that directory can be opened by you. In order to use a\n\
3069 directory as a buffer's current directory, this predicate must return true.\n\
3070 A directory name spec may be given instead; then the value is t\n\
3071 if the directory so specified exists and really is a readable and\n\
3072 searchable directory.")
3074 Lisp_Object filename
;
3076 Lisp_Object handler
;
3078 struct gcpro gcpro1
;
3080 /* If the file name has special constructs in it,
3081 call the corresponding file handler. */
3082 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3083 if (!NILP (handler
))
3084 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3086 /* It's an unlikely combination, but yes we really do need to gcpro:
3087 Suppose that file-accessible-directory-p has no handler, but
3088 file-directory-p does have a handler; this handler causes a GC which
3089 relocates the string in `filename'; and finally file-directory-p
3090 returns non-nil. Then we would end up passing a garbaged string
3091 to file-executable-p. */
3093 tem
= (NILP (Ffile_directory_p (filename
))
3094 || NILP (Ffile_executable_p (filename
)));
3096 return tem
? Qnil
: Qt
;
3099 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3100 "Return t if file FILENAME is the name of a regular file.\n\
3101 This is the sort of file that holds an ordinary stream of data bytes.")
3103 Lisp_Object filename
;
3105 register Lisp_Object absname
;
3107 Lisp_Object handler
;
3109 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3111 /* If the file name has special constructs in it,
3112 call the corresponding file handler. */
3113 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3114 if (!NILP (handler
))
3115 return call2 (handler
, Qfile_regular_p
, absname
);
3117 absname
= ENCODE_FILE (absname
);
3122 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3124 /* Tell stat to use expensive method to get accurate info. */
3125 Vw32_get_true_file_attributes
= Qt
;
3126 result
= stat (XSTRING (absname
)->data
, &st
);
3127 Vw32_get_true_file_attributes
= tem
;
3131 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3134 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3136 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3140 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3141 "Return mode bits of file named FILENAME, as an integer.")
3143 Lisp_Object filename
;
3145 Lisp_Object absname
;
3147 Lisp_Object handler
;
3149 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3151 /* If the file name has special constructs in it,
3152 call the corresponding file handler. */
3153 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3154 if (!NILP (handler
))
3155 return call2 (handler
, Qfile_modes
, absname
);
3157 absname
= ENCODE_FILE (absname
);
3159 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3161 #if defined (MSDOS) && __DJGPP__ < 2
3162 if (check_executable (XSTRING (absname
)->data
))
3163 st
.st_mode
|= S_IEXEC
;
3164 #endif /* MSDOS && __DJGPP__ < 2 */
3166 return make_number (st
.st_mode
& 07777);
3169 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3170 "Set mode bits of file named FILENAME to MODE (an integer).\n\
3171 Only the 12 low bits of MODE are used.")
3173 Lisp_Object filename
, mode
;
3175 Lisp_Object absname
, encoded_absname
;
3176 Lisp_Object handler
;
3178 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3179 CHECK_NUMBER (mode
, 1);
3181 /* If the file name has special constructs in it,
3182 call the corresponding file handler. */
3183 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3184 if (!NILP (handler
))
3185 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3187 encoded_absname
= ENCODE_FILE (absname
);
3189 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
3190 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3195 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3196 "Set the file permission bits for newly created files.\n\
3197 The argument MODE should be an integer; only the low 9 bits are used.\n\
3198 This setting is inherited by subprocesses.")
3202 CHECK_NUMBER (mode
, 0);
3204 umask ((~ XINT (mode
)) & 0777);
3209 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3210 "Return the default file protection for created files.\n\
3211 The value is an integer.")
3217 realmask
= umask (0);
3220 XSETINT (value
, (~ realmask
) & 0777);
3226 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3227 "Tell Unix to finish all pending disk updates.")
3236 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3237 "Return t if file FILE1 is newer than file FILE2.\n\
3238 If FILE1 does not exist, the answer is nil;\n\
3239 otherwise, if FILE2 does not exist, the answer is t.")
3241 Lisp_Object file1
, file2
;
3243 Lisp_Object absname1
, absname2
;
3246 Lisp_Object handler
;
3247 struct gcpro gcpro1
, gcpro2
;
3249 CHECK_STRING (file1
, 0);
3250 CHECK_STRING (file2
, 0);
3253 GCPRO2 (absname1
, file2
);
3254 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3255 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3258 /* If the file name has special constructs in it,
3259 call the corresponding file handler. */
3260 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3262 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3263 if (!NILP (handler
))
3264 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3266 GCPRO2 (absname1
, absname2
);
3267 absname1
= ENCODE_FILE (absname1
);
3268 absname2
= ENCODE_FILE (absname2
);
3271 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3274 mtime1
= st
.st_mtime
;
3276 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3279 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3283 Lisp_Object Qfind_buffer_file_type
;
3286 #ifndef READ_BUF_SIZE
3287 #define READ_BUF_SIZE (64 << 10)
3290 /* This function is called when a function bound to
3291 Vset_auto_coding_function causes some error. At that time, a text
3292 of a file has already been inserted in the current buffer, but,
3293 markers has not yet been adjusted. Thus we must adjust markers
3294 here. We are sure that the buffer was empty before the text of the
3295 file was inserted. */
3298 set_auto_coding_unwind (multibyte
)
3299 Lisp_Object multibyte
;
3301 int inserted
= Z_BYTE
- BEG_BYTE
;
3303 if (!NILP (multibyte
))
3304 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
3305 adjust_after_insert (PT
, PT_BYTE
, Z
, Z_BYTE
, inserted
);
3310 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3312 "Insert contents of file FILENAME after point.\n\
3313 Returns list of absolute file name and number of bytes inserted.\n\
3314 If second argument VISIT is non-nil, the buffer's visited filename\n\
3315 and last save file modtime are set, and it is marked unmodified.\n\
3316 If visiting and the file does not exist, visiting is completed\n\
3317 before the error is signaled.\n\
3318 The optional third and fourth arguments BEG and END\n\
3319 specify what portion of the file to insert.\n\
3320 These arguments count bytes in the file, not characters in the buffer.\n\
3321 If VISIT is non-nil, BEG and END must be nil.\n\
3323 If optional fifth argument REPLACE is non-nil,\n\
3324 it means replace the current buffer contents (in the accessible portion)\n\
3325 with the file contents. This is better than simply deleting and inserting\n\
3326 the whole thing because (1) it preserves some marker positions\n\
3327 and (2) it puts less data in the undo list.\n\
3328 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3329 which is often less than the number of characters to be read.\n\
3331 This does code conversion according to the value of\n\
3332 `coding-system-for-read' or `file-coding-system-alist',\n\
3333 and sets the variable `last-coding-system-used' to the coding system\n\
3335 (filename
, visit
, beg
, end
, replace
)
3336 Lisp_Object filename
, visit
, beg
, end
, replace
;
3341 register int how_much
;
3342 register int unprocessed
;
3343 int count
= specpdl_ptr
- specpdl
;
3344 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3345 Lisp_Object handler
, val
, insval
, orig_filename
;
3348 int not_regular
= 0;
3349 unsigned char read_buf
[READ_BUF_SIZE
];
3350 struct coding_system coding
;
3351 unsigned char buffer
[1 << 14];
3352 int replace_handled
= 0;
3353 int set_coding_system
= 0;
3354 int coding_system_decided
= 0;
3356 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3357 error ("Cannot do file visiting in an indirect buffer");
3359 if (!NILP (current_buffer
->read_only
))
3360 Fbarf_if_buffer_read_only ();
3364 orig_filename
= Qnil
;
3366 GCPRO4 (filename
, val
, p
, orig_filename
);
3368 CHECK_STRING (filename
, 0);
3369 filename
= Fexpand_file_name (filename
, Qnil
);
3371 /* If the file name has special constructs in it,
3372 call the corresponding file handler. */
3373 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3374 if (!NILP (handler
))
3376 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3377 visit
, beg
, end
, replace
);
3378 if (CONSP (val
) && CONSP (XCDR (val
)))
3379 inserted
= XINT (XCAR (XCDR (val
)));
3383 orig_filename
= filename
;
3384 filename
= ENCODE_FILE (filename
);
3390 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3392 /* Tell stat to use expensive method to get accurate info. */
3393 Vw32_get_true_file_attributes
= Qt
;
3394 total
= stat (XSTRING (filename
)->data
, &st
);
3395 Vw32_get_true_file_attributes
= tem
;
3400 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3402 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3403 || fstat (fd
, &st
) < 0)
3404 #endif /* not APOLLO */
3405 #endif /* WINDOWSNT */
3407 if (fd
>= 0) close (fd
);
3410 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3413 if (!NILP (Vcoding_system_for_read
))
3414 current_buffer
->buffer_file_coding_system
= Vcoding_system_for_read
;
3419 /* This code will need to be changed in order to work on named
3420 pipes, and it's probably just not worth it. So we should at
3421 least signal an error. */
3422 if (!S_ISREG (st
.st_mode
))
3429 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3430 Fsignal (Qfile_error
,
3431 Fcons (build_string ("not a regular file"),
3432 Fcons (orig_filename
, Qnil
)));
3437 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3440 /* Replacement should preserve point as it preserves markers. */
3441 if (!NILP (replace
))
3442 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3444 record_unwind_protect (close_file_unwind
, make_number (fd
));
3446 /* Supposedly happens on VMS. */
3447 if (! not_regular
&& st
.st_size
< 0)
3448 error ("File size is negative");
3450 /* Prevent redisplay optimizations. */
3451 current_buffer
->clip_changed
= 1;
3453 if (!NILP (beg
) || !NILP (end
))
3455 error ("Attempt to visit less than an entire file");
3458 CHECK_NUMBER (beg
, 0);
3460 XSETFASTINT (beg
, 0);
3463 CHECK_NUMBER (end
, 0);
3468 XSETINT (end
, st
.st_size
);
3469 if (XINT (end
) != st
.st_size
)
3470 error ("Maximum buffer size exceeded");
3476 /* Decide the coding system to use for reading the file now
3477 because we can't use an optimized method for handling
3478 `coding:' tag if the current buffer is not empty. */
3482 if (!NILP (Vcoding_system_for_read
))
3483 val
= Vcoding_system_for_read
;
3484 else if (! NILP (replace
))
3485 /* In REPLACE mode, we can use the same coding system
3486 that was used to visit the file. */
3487 val
= current_buffer
->buffer_file_coding_system
;
3490 /* Don't try looking inside a file for a coding system
3491 specification if it is not seekable. */
3492 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3494 /* Find a coding system specified in the heading two
3495 lines or in the tailing several lines of the file.
3496 We assume that the 1K-byte and 3K-byte for heading
3497 and tailing respectively are sufficient for this
3499 int how_many
, nread
;
3501 if (st
.st_size
<= (1024 * 4))
3502 nread
= read (fd
, read_buf
, 1024 * 4);
3505 nread
= read (fd
, read_buf
, 1024);
3508 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3509 report_file_error ("Setting file position",
3510 Fcons (orig_filename
, Qnil
));
3511 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3516 error ("IO error reading %s: %s",
3517 XSTRING (orig_filename
)->data
, strerror (errno
));
3520 int count
= specpdl_ptr
- specpdl
;
3521 struct buffer
*prev
= current_buffer
;
3523 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3524 temp_output_buffer_setup (" *code-converting-work*");
3525 set_buffer_internal (XBUFFER (Vstandard_output
));
3526 current_buffer
->enable_multibyte_characters
= Qnil
;
3527 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3528 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3529 val
= call2 (Vset_auto_coding_function
,
3530 filename
, make_number (nread
));
3531 set_buffer_internal (prev
);
3532 /* Discard the unwind protect for recovering the
3536 /* Rewind the file for the actual read done later. */
3537 if (lseek (fd
, 0, 0) < 0)
3538 report_file_error ("Setting file position",
3539 Fcons (orig_filename
, Qnil
));
3545 /* If we have not yet decided a coding system, check
3546 file-coding-system-alist. */
3547 Lisp_Object args
[6], coding_systems
;
3549 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3550 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3551 coding_systems
= Ffind_operation_coding_system (6, args
);
3552 if (CONSP (coding_systems
))
3553 val
= XCAR (coding_systems
);
3557 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3559 if (NILP (current_buffer
->enable_multibyte_characters
)
3561 /* We must suppress all character code conversion except for
3562 end-of-line conversion. */
3563 setup_raw_text_coding_system (&coding
);
3565 coding_system_decided
= 1;
3568 /* Ensure we always set Vlast_coding_system_used. */
3569 set_coding_system
= 1;
3571 /* If requested, replace the accessible part of the buffer
3572 with the file contents. Avoid replacing text at the
3573 beginning or end of the buffer that matches the file contents;
3574 that preserves markers pointing to the unchanged parts.
3576 Here we implement this feature in an optimized way
3577 for the case where code conversion is NOT needed.
3578 The following if-statement handles the case of conversion
3579 in a less optimal way.
3581 If the code conversion is "automatic" then we try using this
3582 method and hope for the best.
3583 But if we discover the need for conversion, we give up on this method
3584 and let the following if-statement handle the replace job. */
3587 && ! CODING_REQUIRE_DECODING (&coding
)
3588 && (coding
.eol_type
== CODING_EOL_UNDECIDED
3589 || coding
.eol_type
== CODING_EOL_LF
))
3591 /* same_at_start and same_at_end count bytes,
3592 because file access counts bytes
3593 and BEG and END count bytes. */
3594 int same_at_start
= BEGV_BYTE
;
3595 int same_at_end
= ZV_BYTE
;
3597 /* There is still a possibility we will find the need to do code
3598 conversion. If that happens, we set this variable to 1 to
3599 give up on handling REPLACE in the optimized way. */
3600 int giveup_match_end
= 0;
3602 if (XINT (beg
) != 0)
3604 if (lseek (fd
, XINT (beg
), 0) < 0)
3605 report_file_error ("Setting file position",
3606 Fcons (orig_filename
, Qnil
));
3611 /* Count how many chars at the start of the file
3612 match the text at the beginning of the buffer. */
3617 nread
= read (fd
, buffer
, sizeof buffer
);
3619 error ("IO error reading %s: %s",
3620 XSTRING (orig_filename
)->data
, strerror (errno
));
3621 else if (nread
== 0)
3624 if (coding
.type
== coding_type_undecided
)
3625 detect_coding (&coding
, buffer
, nread
);
3626 if (CODING_REQUIRE_DECODING (&coding
))
3627 /* We found that the file should be decoded somehow.
3628 Let's give up here. */
3630 giveup_match_end
= 1;
3634 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3635 detect_eol (&coding
, buffer
, nread
);
3636 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3637 && coding
.eol_type
!= CODING_EOL_LF
)
3638 /* We found that the format of eol should be decoded.
3639 Let's give up here. */
3641 giveup_match_end
= 1;
3646 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3647 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3648 same_at_start
++, bufpos
++;
3649 /* If we found a discrepancy, stop the scan.
3650 Otherwise loop around and scan the next bufferful. */
3651 if (bufpos
!= nread
)
3655 /* If the file matches the buffer completely,
3656 there's no need to replace anything. */
3657 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3661 /* Truncate the buffer to the size of the file. */
3662 del_range_1 (same_at_start
, same_at_end
, 0);
3667 /* Count how many chars at the end of the file
3668 match the text at the end of the buffer. But, if we have
3669 already found that decoding is necessary, don't waste time. */
3670 while (!giveup_match_end
)
3672 int total_read
, nread
, bufpos
, curpos
, trial
;
3674 /* At what file position are we now scanning? */
3675 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3676 /* If the entire file matches the buffer tail, stop the scan. */
3679 /* How much can we scan in the next step? */
3680 trial
= min (curpos
, sizeof buffer
);
3681 if (lseek (fd
, curpos
- trial
, 0) < 0)
3682 report_file_error ("Setting file position",
3683 Fcons (orig_filename
, Qnil
));
3686 while (total_read
< trial
)
3688 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3690 error ("IO error reading %s: %s",
3691 XSTRING (orig_filename
)->data
, strerror (errno
));
3692 total_read
+= nread
;
3694 /* Scan this bufferful from the end, comparing with
3695 the Emacs buffer. */
3696 bufpos
= total_read
;
3697 /* Compare with same_at_start to avoid counting some buffer text
3698 as matching both at the file's beginning and at the end. */
3699 while (bufpos
> 0 && same_at_end
> same_at_start
3700 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3701 same_at_end
--, bufpos
--;
3703 /* If we found a discrepancy, stop the scan.
3704 Otherwise loop around and scan the preceding bufferful. */
3707 /* If this discrepancy is because of code conversion,
3708 we cannot use this method; giveup and try the other. */
3709 if (same_at_end
> same_at_start
3710 && FETCH_BYTE (same_at_end
- 1) >= 0200
3711 && ! NILP (current_buffer
->enable_multibyte_characters
)
3712 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3713 giveup_match_end
= 1;
3719 if (! giveup_match_end
)
3723 /* We win! We can handle REPLACE the optimized way. */
3725 /* Extend the start of non-matching text area to multibyte
3726 character boundary. */
3727 if (! NILP (current_buffer
->enable_multibyte_characters
))
3728 while (same_at_start
> BEGV_BYTE
3729 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3732 /* Extend the end of non-matching text area to multibyte
3733 character boundary. */
3734 if (! NILP (current_buffer
->enable_multibyte_characters
))
3735 while (same_at_end
< ZV_BYTE
3736 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3739 /* Don't try to reuse the same piece of text twice. */
3740 overlap
= (same_at_start
- BEGV_BYTE
3741 - (same_at_end
+ st
.st_size
- ZV
));
3743 same_at_end
+= overlap
;
3745 /* Arrange to read only the nonmatching middle part of the file. */
3746 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3747 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3749 del_range_byte (same_at_start
, same_at_end
, 0);
3750 /* Insert from the file at the proper position. */
3751 temp
= BYTE_TO_CHAR (same_at_start
);
3752 SET_PT_BOTH (temp
, same_at_start
);
3754 /* If display currently starts at beginning of line,
3755 keep it that way. */
3756 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3757 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3759 replace_handled
= 1;
3763 /* If requested, replace the accessible part of the buffer
3764 with the file contents. Avoid replacing text at the
3765 beginning or end of the buffer that matches the file contents;
3766 that preserves markers pointing to the unchanged parts.
3768 Here we implement this feature for the case where code conversion
3769 is needed, in a simple way that needs a lot of memory.
3770 The preceding if-statement handles the case of no conversion
3771 in a more optimized way. */
3772 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3774 int same_at_start
= BEGV_BYTE
;
3775 int same_at_end
= ZV_BYTE
;
3778 /* Make sure that the gap is large enough. */
3779 int bufsize
= 2 * st
.st_size
;
3780 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3783 /* First read the whole file, performing code conversion into
3784 CONVERSION_BUFFER. */
3786 if (lseek (fd
, XINT (beg
), 0) < 0)
3788 xfree (conversion_buffer
);
3789 report_file_error ("Setting file position",
3790 Fcons (orig_filename
, Qnil
));
3793 total
= st
.st_size
; /* Total bytes in the file. */
3794 how_much
= 0; /* Bytes read from file so far. */
3795 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3796 unprocessed
= 0; /* Bytes not processed in previous loop. */
3798 while (how_much
< total
)
3800 /* try is reserved in some compilers (Microsoft C) */
3801 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3802 unsigned char *destination
= read_buf
+ unprocessed
;
3805 /* Allow quitting out of the actual I/O. */
3808 this = read (fd
, destination
, trytry
);
3811 if (this < 0 || this + unprocessed
== 0)
3819 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3821 int require
, result
;
3823 this += unprocessed
;
3825 /* If we are using more space than estimated,
3826 make CONVERSION_BUFFER bigger. */
3827 require
= decoding_buffer_size (&coding
, this);
3828 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3830 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3831 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3834 /* Convert this batch with results in CONVERSION_BUFFER. */
3835 if (how_much
>= total
) /* This is the last block. */
3836 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3837 result
= decode_coding (&coding
, read_buf
,
3838 conversion_buffer
+ inserted
,
3839 this, bufsize
- inserted
);
3841 /* Save for next iteration whatever we didn't convert. */
3842 unprocessed
= this - coding
.consumed
;
3843 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
3844 this = coding
.produced
;
3850 /* At this point, INSERTED is how many characters (i.e. bytes)
3851 are present in CONVERSION_BUFFER.
3852 HOW_MUCH should equal TOTAL,
3853 or should be <= 0 if we couldn't read the file. */
3857 xfree (conversion_buffer
);
3860 error ("IO error reading %s: %s",
3861 XSTRING (orig_filename
)->data
, strerror (errno
));
3862 else if (how_much
== -2)
3863 error ("maximum buffer size exceeded");
3866 /* Compare the beginning of the converted file
3867 with the buffer text. */
3870 while (bufpos
< inserted
&& same_at_start
< same_at_end
3871 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3872 same_at_start
++, bufpos
++;
3874 /* If the file matches the buffer completely,
3875 there's no need to replace anything. */
3877 if (bufpos
== inserted
)
3879 xfree (conversion_buffer
);
3882 /* Truncate the buffer to the size of the file. */
3883 del_range_byte (same_at_start
, same_at_end
, 0);
3888 /* Extend the start of non-matching text area to multibyte
3889 character boundary. */
3890 if (! NILP (current_buffer
->enable_multibyte_characters
))
3891 while (same_at_start
> BEGV_BYTE
3892 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3895 /* Scan this bufferful from the end, comparing with
3896 the Emacs buffer. */
3899 /* Compare with same_at_start to avoid counting some buffer text
3900 as matching both at the file's beginning and at the end. */
3901 while (bufpos
> 0 && same_at_end
> same_at_start
3902 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3903 same_at_end
--, bufpos
--;
3905 /* Extend the end of non-matching text area to multibyte
3906 character boundary. */
3907 if (! NILP (current_buffer
->enable_multibyte_characters
))
3908 while (same_at_end
< ZV_BYTE
3909 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3912 /* Don't try to reuse the same piece of text twice. */
3913 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3915 same_at_end
+= overlap
;
3917 /* If display currently starts at beginning of line,
3918 keep it that way. */
3919 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3920 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3922 /* Replace the chars that we need to replace,
3923 and update INSERTED to equal the number of bytes
3924 we are taking from the file. */
3925 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
3927 if (same_at_end
!= same_at_start
)
3929 del_range_byte (same_at_start
, same_at_end
, 0);
3931 same_at_start
= GPT_BYTE
;
3935 temp
= BYTE_TO_CHAR (same_at_start
);
3937 /* Insert from the file at the proper position. */
3938 SET_PT_BOTH (temp
, same_at_start
);
3939 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
3941 /* Set `inserted' to the number of inserted characters. */
3942 inserted
= PT
- temp
;
3944 free (conversion_buffer
);
3953 register Lisp_Object temp
;
3955 total
= XINT (end
) - XINT (beg
);
3957 /* Make sure point-max won't overflow after this insertion. */
3958 XSETINT (temp
, total
);
3959 if (total
!= XINT (temp
))
3960 error ("Maximum buffer size exceeded");
3963 /* For a special file, all we can do is guess. */
3964 total
= READ_BUF_SIZE
;
3966 if (NILP (visit
) && total
> 0)
3967 prepare_to_modify_buffer (PT
, PT
, NULL
);
3970 if (GAP_SIZE
< total
)
3971 make_gap (total
- GAP_SIZE
);
3973 if (XINT (beg
) != 0 || !NILP (replace
))
3975 if (lseek (fd
, XINT (beg
), 0) < 0)
3976 report_file_error ("Setting file position",
3977 Fcons (orig_filename
, Qnil
));
3980 /* In the following loop, HOW_MUCH contains the total bytes read so
3981 far for a regular file, and not changed for a special file. But,
3982 before exiting the loop, it is set to a negative value if I/O
3985 /* Total bytes inserted. */
3987 /* Here, we don't do code conversion in the loop. It is done by
3988 code_convert_region after all data are read into the buffer. */
3989 while (how_much
< total
)
3991 /* try is reserved in some compilers (Microsoft C) */
3992 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3995 /* For a special file, GAP_SIZE should be checked every time. */
3996 if (not_regular
&& GAP_SIZE
< trytry
)
3997 make_gap (total
- GAP_SIZE
);
3999 /* Allow quitting out of the actual I/O. */
4002 this = read (fd
, BYTE_POS_ADDR (PT_BYTE
+ inserted
- 1) + 1, trytry
);
4019 /* For a regular file, where TOTAL is the real size,
4020 count HOW_MUCH to compare with it.
4021 For a special file, where TOTAL is just a buffer size,
4022 so don't bother counting in HOW_MUCH.
4023 (INSERTED is where we count the number of characters inserted.) */
4030 /* Put an anchor to ensure multi-byte form ends at gap. */
4035 /* Discard the unwind protect for closing the file. */
4039 error ("IO error reading %s: %s",
4040 XSTRING (orig_filename
)->data
, strerror (errno
));
4042 if (! coding_system_decided
)
4044 /* The coding system is not yet decided. Decide it by an
4045 optimized method for handling `coding:' tag. */
4049 if (!NILP (Vcoding_system_for_read
))
4050 val
= Vcoding_system_for_read
;
4053 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4055 /* Since we are sure that the current buffer was
4056 empty before the insertion, we can toggle
4057 enable-multibyte-characters directly here without
4058 taking care of marker adjustment and byte
4059 combining problem. */
4060 Lisp_Object prev_multibyte
;
4061 int count
= specpdl_ptr
- specpdl
;
4063 prev_multibyte
= current_buffer
->enable_multibyte_characters
;
4064 current_buffer
->enable_multibyte_characters
= Qnil
;
4065 record_unwind_protect (set_auto_coding_unwind
,
4067 val
= call2 (Vset_auto_coding_function
,
4068 filename
, make_number (inserted
));
4069 /* Discard the unwind protect for recovering the
4070 error of Vset_auto_coding_function. */
4072 current_buffer
->enable_multibyte_characters
= prev_multibyte
;
4073 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
4078 /* If the coding system is not yet decided, check
4079 file-coding-system-alist. */
4080 Lisp_Object args
[6], coding_systems
;
4082 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4083 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4084 coding_systems
= Ffind_operation_coding_system (6, args
);
4085 if (CONSP (coding_systems
))
4086 val
= XCAR (coding_systems
);
4090 /* The following kludgy code is to avoid some compiler bug.
4092 setup_coding_system (val, &coding);
4095 struct coding_system temp_coding
;
4096 setup_coding_system (val
, &temp_coding
);
4097 bcopy (&temp_coding
, &coding
, sizeof coding
);
4100 if (NILP (current_buffer
->enable_multibyte_characters
)
4102 /* We must suppress all character code conversion except for
4103 end-of-line conversion. */
4104 setup_raw_text_coding_system (&coding
);
4107 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4109 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4111 /* Here, we don't have to consider byte combining (see the
4112 comment below) because code_convert_region takes care of
4114 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4116 inserted
= (NILP (current_buffer
->enable_multibyte_characters
)
4117 ? coding
.produced
: coding
.produced_char
);
4119 else if (!NILP (current_buffer
->enable_multibyte_characters
))
4121 int inserted_byte
= inserted
;
4123 /* There's a possibility that we must combine bytes at the
4124 head (resp. the tail) of the just inserted text with the
4125 bytes before (resp. after) the gap to form a single
4127 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
4128 adjust_after_insert (PT
, PT_BYTE
,
4129 PT
+ inserted_byte
, PT_BYTE
+ inserted_byte
,
4133 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4138 /* Use the conversion type to determine buffer-file-type
4139 (find-buffer-file-type is now used to help determine the
4141 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4142 || coding
.eol_type
== CODING_EOL_LF
)
4143 && ! CODING_REQUIRE_DECODING (&coding
))
4144 current_buffer
->buffer_file_type
= Qt
;
4146 current_buffer
->buffer_file_type
= Qnil
;
4154 if (!EQ (current_buffer
->undo_list
, Qt
))
4155 current_buffer
->undo_list
= Qnil
;
4157 stat (XSTRING (filename
)->data
, &st
);
4162 current_buffer
->modtime
= st
.st_mtime
;
4163 current_buffer
->filename
= orig_filename
;
4166 SAVE_MODIFF
= MODIFF
;
4167 current_buffer
->auto_save_modified
= MODIFF
;
4168 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4169 #ifdef CLASH_DETECTION
4172 if (!NILP (current_buffer
->file_truename
))
4173 unlock_file (current_buffer
->file_truename
);
4174 unlock_file (filename
);
4176 #endif /* CLASH_DETECTION */
4178 Fsignal (Qfile_error
,
4179 Fcons (build_string ("not a regular file"),
4180 Fcons (orig_filename
, Qnil
)));
4182 /* If visiting nonexistent file, return nil. */
4183 if (current_buffer
->modtime
== -1)
4184 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4187 /* Decode file format */
4190 insval
= call3 (Qformat_decode
,
4191 Qnil
, make_number (inserted
), visit
);
4192 CHECK_NUMBER (insval
, 0);
4193 inserted
= XFASTINT (insval
);
4196 /* Call after-change hooks for the inserted text, aside from the case
4197 of normal visiting (not with REPLACE), which is done in a new buffer
4198 "before" the buffer is changed. */
4199 if (inserted
> 0 && total
> 0
4200 && (NILP (visit
) || !NILP (replace
)))
4201 signal_after_change (PT
, 0, inserted
);
4203 if (set_coding_system
)
4204 Vlast_coding_system_used
= coding
.symbol
;
4208 p
= Vafter_insert_file_functions
;
4211 insval
= call1 (Fcar (p
), make_number (inserted
));
4214 CHECK_NUMBER (insval
, 0);
4215 inserted
= XFASTINT (insval
);
4222 /* ??? Retval needs to be dealt with in all cases consistently. */
4224 val
= Fcons (orig_filename
,
4225 Fcons (make_number (inserted
),
4228 RETURN_UNGCPRO (unbind_to (count
, val
));
4231 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
4234 /* If build_annotations switched buffers, switch back to BUF.
4235 Kill the temporary buffer that was selected in the meantime.
4237 Since this kill only the last temporary buffer, some buffers remain
4238 not killed if build_annotations switched buffers more than once.
4242 build_annotations_unwind (buf
)
4247 if (XBUFFER (buf
) == current_buffer
)
4249 tembuf
= Fcurrent_buffer ();
4251 Fkill_buffer (tembuf
);
4255 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4256 "r\nFWrite region to file: \ni\ni\ni\np",
4257 "Write current region into specified file.\n\
4258 When called from a program, takes three arguments:\n\
4259 START, END and FILENAME. START and END are buffer positions.\n\
4260 Optional fourth argument APPEND if non-nil means\n\
4261 append to existing file contents (if any).\n\
4262 Optional fifth argument VISIT if t means\n\
4263 set the last-save-file-modtime of buffer to this file's modtime\n\
4264 and mark buffer not modified.\n\
4265 If VISIT is a string, it is a second file name;\n\
4266 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
4267 VISIT is also the file name to lock and unlock for clash detection.\n\
4268 If VISIT is neither t nor nil nor a string,\n\
4269 that means do not print the \"Wrote file\" message.\n\
4270 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
4271 use for locking and unlocking, overriding FILENAME and VISIT.\n\
4272 The optional seventh arg MUSTBENEW, if non-nil, insists on a check\n\
4273 for an existing file with the same name. If MUSTBENEW is `excl',\n\
4274 that means to get an error if the file already exists; never overwrite.\n\
4275 If MUSTBENEW is neither nil nor `excl', that means ask for\n\
4276 confirmation before overwriting, but do go ahead and overwrite the file\n\
4277 if the user confirms.\n\
4278 Kludgy feature: if START is a string, then that string is written\n\
4279 to the file, instead of any buffer contents, and END is ignored.\n\
4281 This does code conversion according to the value of\n\
4282 `coding-system-for-write', `buffer-file-coding-system', or\n\
4283 `file-coding-system-alist', and sets the variable\n\
4284 `last-coding-system-used' to the coding system actually used.")
4286 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4287 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4295 int count
= specpdl_ptr
- specpdl
;
4298 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4300 Lisp_Object handler
;
4301 Lisp_Object visit_file
;
4302 Lisp_Object annotations
;
4303 Lisp_Object encoded_filename
;
4304 int visiting
, quietly
;
4305 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4306 struct buffer
*given_buffer
;
4308 int buffer_file_type
= O_BINARY
;
4310 struct coding_system coding
;
4312 if (current_buffer
->base_buffer
&& ! NILP (visit
))
4313 error ("Cannot do file visiting in an indirect buffer");
4315 if (!NILP (start
) && !STRINGP (start
))
4316 validate_region (&start
, &end
);
4318 GCPRO4 (start
, filename
, visit
, lockname
);
4320 /* Decide the coding-system to encode the data with. */
4326 else if (!NILP (Vcoding_system_for_write
))
4327 val
= Vcoding_system_for_write
;
4330 /* If the variable `buffer-file-coding-system' is set locally,
4331 it means that the file was read with some kind of code
4332 conversion or the varialbe is explicitely set by users. We
4333 had better write it out with the same coding system even if
4334 `enable-multibyte-characters' is nil.
4336 If it is not set locally, we anyway have to convert EOL
4337 format if the default value of `buffer-file-coding-system'
4338 tells that it is not Unix-like (LF only) format. */
4339 int using_default_coding
= 0;
4340 int force_raw_text
= 0;
4342 val
= current_buffer
->buffer_file_coding_system
;
4344 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4347 if (NILP (current_buffer
->enable_multibyte_characters
))
4353 /* Check file-coding-system-alist. */
4354 Lisp_Object args
[7], coding_systems
;
4356 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4357 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4359 coding_systems
= Ffind_operation_coding_system (7, args
);
4360 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4361 val
= XCDR (coding_systems
);
4365 && !NILP (current_buffer
->buffer_file_coding_system
))
4367 /* If we still have not decided a coding system, use the
4368 default value of buffer-file-coding-system. */
4369 val
= current_buffer
->buffer_file_coding_system
;
4370 using_default_coding
= 1;
4374 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4375 /* Confirm that VAL can surely encode the current region. */
4376 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4378 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4379 if (coding
.eol_type
== CODING_EOL_UNDECIDED
4380 && !using_default_coding
)
4382 if (! EQ (default_buffer_file_coding
.symbol
,
4383 buffer_defaults
.buffer_file_coding_system
))
4384 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4385 &default_buffer_file_coding
);
4386 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4388 Lisp_Object subsidiaries
;
4390 coding
.eol_type
= default_buffer_file_coding
.eol_type
;
4391 subsidiaries
= Fget (coding
.symbol
, Qeol_type
);
4392 if (VECTORP (subsidiaries
)
4393 && XVECTOR (subsidiaries
)->size
== 3)
4395 = XVECTOR (subsidiaries
)->contents
[coding
.eol_type
];
4400 setup_raw_text_coding_system (&coding
);
4401 goto done_setup_coding
;
4404 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4407 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4408 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4411 Vlast_coding_system_used
= coding
.symbol
;
4413 filename
= Fexpand_file_name (filename
, Qnil
);
4415 if (! NILP (mustbenew
) && mustbenew
!= Qexcl
)
4416 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4418 if (STRINGP (visit
))
4419 visit_file
= Fexpand_file_name (visit
, Qnil
);
4421 visit_file
= filename
;
4424 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4425 quietly
= !NILP (visit
);
4429 if (NILP (lockname
))
4430 lockname
= visit_file
;
4432 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4434 /* If the file name has special constructs in it,
4435 call the corresponding file handler. */
4436 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4437 /* If FILENAME has no handler, see if VISIT has one. */
4438 if (NILP (handler
) && STRINGP (visit
))
4439 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4441 if (!NILP (handler
))
4444 val
= call6 (handler
, Qwrite_region
, start
, end
,
4445 filename
, append
, visit
);
4449 SAVE_MODIFF
= MODIFF
;
4450 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4451 current_buffer
->filename
= visit_file
;
4457 /* Special kludge to simplify auto-saving. */
4460 XSETFASTINT (start
, BEG
);
4461 XSETFASTINT (end
, Z
);
4464 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4465 count1
= specpdl_ptr
- specpdl
;
4467 given_buffer
= current_buffer
;
4468 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4469 if (current_buffer
!= given_buffer
)
4471 XSETFASTINT (start
, BEGV
);
4472 XSETFASTINT (end
, ZV
);
4475 #ifdef CLASH_DETECTION
4478 #if 0 /* This causes trouble for GNUS. */
4479 /* If we've locked this file for some other buffer,
4480 query before proceeding. */
4481 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4482 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4485 lock_file (lockname
);
4487 #endif /* CLASH_DETECTION */
4489 encoded_filename
= ENCODE_FILE (filename
);
4491 fn
= XSTRING (encoded_filename
)->data
;
4495 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4496 #else /* not DOS_NT */
4497 desc
= open (fn
, O_WRONLY
);
4498 #endif /* not DOS_NT */
4500 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4502 if (auto_saving
) /* Overwrite any previous version of autosave file */
4504 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4505 desc
= open (fn
, O_RDWR
);
4507 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4508 ? XSTRING (current_buffer
->filename
)->data
: 0,
4511 else /* Write to temporary name and rename if no errors */
4513 Lisp_Object temp_name
;
4514 temp_name
= Ffile_name_directory (filename
);
4516 if (!NILP (temp_name
))
4518 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4519 build_string ("$$SAVE$$")));
4520 fname
= XSTRING (filename
)->data
;
4521 fn
= XSTRING (temp_name
)->data
;
4522 desc
= creat_copy_attrs (fname
, fn
);
4525 /* If we can't open the temporary file, try creating a new
4526 version of the original file. VMS "creat" creates a
4527 new version rather than truncating an existing file. */
4530 desc
= creat (fn
, 0666);
4531 #if 0 /* This can clobber an existing file and fail to replace it,
4532 if the user runs out of space. */
4535 /* We can't make a new version;
4536 try to truncate and rewrite existing version if any. */
4538 desc
= open (fn
, O_RDWR
);
4544 desc
= creat (fn
, 0666);
4549 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
4550 | (mustbenew
== Qexcl
? O_EXCL
: 0),
4551 S_IREAD
| S_IWRITE
);
4552 #else /* not DOS_NT */
4553 desc
= open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4554 | (mustbenew
== Qexcl
? O_EXCL
: 0),
4555 auto_saving
? auto_save_mode_bits
: 0666);
4556 #endif /* not DOS_NT */
4557 #endif /* not VMS */
4563 #ifdef CLASH_DETECTION
4565 if (!auto_saving
) unlock_file (lockname
);
4567 #endif /* CLASH_DETECTION */
4568 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4571 record_unwind_protect (close_file_unwind
, make_number (desc
));
4573 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4574 if (lseek (desc
, 0, 2) < 0)
4576 #ifdef CLASH_DETECTION
4577 if (!auto_saving
) unlock_file (lockname
);
4578 #endif /* CLASH_DETECTION */
4579 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4584 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4585 * if we do writes that don't end with a carriage return. Furthermore
4586 * it cannot handle writes of more then 16K. The modified
4587 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4588 * this EXCEPT for the last record (iff it doesn't end with a carriage
4589 * return). This implies that if your buffer doesn't end with a carriage
4590 * return, you get one free... tough. However it also means that if
4591 * we make two calls to sys_write (a la the following code) you can
4592 * get one at the gap as well. The easiest way to fix this (honest)
4593 * is to move the gap to the next newline (or the end of the buffer).
4598 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4599 move_gap (find_next_newline (GPT
, 1));
4601 /* Whether VMS or not, we must move the gap to the next of newline
4602 when we must put designation sequences at beginning of line. */
4603 if (INTEGERP (start
)
4604 && coding
.type
== coding_type_iso2022
4605 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4606 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4608 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4609 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4610 move_gap_both (PT
, PT_BYTE
);
4611 SET_PT_BOTH (opoint
, opoint_byte
);
4618 if (STRINGP (start
))
4620 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4621 STRING_BYTES (XSTRING (start
)), 0, &annotations
,
4625 else if (XINT (start
) != XINT (end
))
4627 register int end1
= CHAR_TO_BYTE (XINT (end
));
4629 tem
= CHAR_TO_BYTE (XINT (start
));
4631 if (XINT (start
) < GPT
)
4633 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
),
4634 min (GPT_BYTE
, end1
) - tem
, tem
, &annotations
,
4639 if (XINT (end
) > GPT
&& !failure
)
4641 tem
= max (tem
, GPT_BYTE
);
4642 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
), end1
- tem
,
4643 tem
, &annotations
, &coding
);
4649 /* If file was empty, still need to write the annotations */
4650 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4651 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4655 if (CODING_REQUIRE_FLUSHING (&coding
)
4656 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4659 /* We have to flush out a data. */
4660 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4661 failure
= 0 > e_write (desc
, "", 0, &coding
);
4668 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4669 Disk full in NFS may be reported here. */
4670 /* mib says that closing the file will try to write as fast as NFS can do
4671 it, and that means the fsync here is not crucial for autosave files. */
4672 if (!auto_saving
&& fsync (desc
) < 0)
4674 /* If fsync fails with EINTR, don't treat that as serious. */
4676 failure
= 1, save_errno
= errno
;
4680 /* Spurious "file has changed on disk" warnings have been
4681 observed on Suns as well.
4682 It seems that `close' can change the modtime, under nfs.
4684 (This has supposedly been fixed in Sunos 4,
4685 but who knows about all the other machines with NFS?) */
4688 /* On VMS and APOLLO, must do the stat after the close
4689 since closing changes the modtime. */
4692 /* Recall that #if defined does not work on VMS. */
4699 /* NFS can report a write failure now. */
4700 if (close (desc
) < 0)
4701 failure
= 1, save_errno
= errno
;
4704 /* If we wrote to a temporary name and had no errors, rename to real name. */
4708 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4716 /* Discard the unwind protect for close_file_unwind. */
4717 specpdl_ptr
= specpdl
+ count1
;
4718 /* Restore the original current buffer. */
4719 visit_file
= unbind_to (count
, visit_file
);
4721 #ifdef CLASH_DETECTION
4723 unlock_file (lockname
);
4724 #endif /* CLASH_DETECTION */
4726 /* Do this before reporting IO error
4727 to avoid a "file has changed on disk" warning on
4728 next attempt to save. */
4730 current_buffer
->modtime
= st
.st_mtime
;
4733 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4734 strerror (save_errno
));
4738 SAVE_MODIFF
= MODIFF
;
4739 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4740 current_buffer
->filename
= visit_file
;
4741 update_mode_lines
++;
4747 message_with_string ("Wrote %s", visit_file
, 1);
4752 Lisp_Object
merge ();
4754 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4755 "Return t if (car A) is numerically less than (car B).")
4759 return Flss (Fcar (a
), Fcar (b
));
4762 /* Build the complete list of annotations appropriate for writing out
4763 the text between START and END, by calling all the functions in
4764 write-region-annotate-functions and merging the lists they return.
4765 If one of these functions switches to a different buffer, we assume
4766 that buffer contains altered text. Therefore, the caller must
4767 make sure to restore the current buffer in all cases,
4768 as save-excursion would do. */
4771 build_annotations (start
, end
, pre_write_conversion
)
4772 Lisp_Object start
, end
, pre_write_conversion
;
4774 Lisp_Object annotations
;
4776 struct gcpro gcpro1
, gcpro2
;
4777 Lisp_Object original_buffer
;
4779 XSETBUFFER (original_buffer
, current_buffer
);
4782 p
= Vwrite_region_annotate_functions
;
4783 GCPRO2 (annotations
, p
);
4786 struct buffer
*given_buffer
= current_buffer
;
4787 Vwrite_region_annotations_so_far
= annotations
;
4788 res
= call2 (Fcar (p
), start
, end
);
4789 /* If the function makes a different buffer current,
4790 assume that means this buffer contains altered text to be output.
4791 Reset START and END from the buffer bounds
4792 and discard all previous annotations because they should have
4793 been dealt with by this function. */
4794 if (current_buffer
!= given_buffer
)
4796 XSETFASTINT (start
, BEGV
);
4797 XSETFASTINT (end
, ZV
);
4800 Flength (res
); /* Check basic validity of return value */
4801 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4805 /* Now do the same for annotation functions implied by the file-format */
4806 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4807 p
= Vauto_save_file_format
;
4809 p
= current_buffer
->file_format
;
4812 struct buffer
*given_buffer
= current_buffer
;
4813 Vwrite_region_annotations_so_far
= annotations
;
4814 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4816 if (current_buffer
!= given_buffer
)
4818 XSETFASTINT (start
, BEGV
);
4819 XSETFASTINT (end
, ZV
);
4823 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4827 /* At last, do the same for the function PRE_WRITE_CONVERSION
4828 implied by the current coding-system. */
4829 if (!NILP (pre_write_conversion
))
4831 struct buffer
*given_buffer
= current_buffer
;
4832 Vwrite_region_annotations_so_far
= annotations
;
4833 res
= call2 (pre_write_conversion
, start
, end
);
4835 annotations
= (current_buffer
!= given_buffer
4837 : merge (annotations
, res
, Qcar_less_than_car
));
4844 /* Write to descriptor DESC the NBYTES bytes starting at ADDR,
4845 assuming they start at byte position BYTEPOS in the buffer.
4846 Intersperse with them the annotations from *ANNOT
4847 which fall within the range of byte positions BYTEPOS to BYTEPOS + NBYTES,
4848 each at its appropriate position.
4850 We modify *ANNOT by discarding elements as we use them up.
4852 The return value is negative in case of system call failure. */
4855 a_write (desc
, addr
, nbytes
, bytepos
, annot
, coding
)
4857 register char *addr
;
4858 register int nbytes
;
4861 struct coding_system
*coding
;
4865 int lastpos
= bytepos
+ nbytes
;
4867 while (NILP (*annot
) || CONSP (*annot
))
4869 tem
= Fcar_safe (Fcar (*annot
));
4870 nextpos
= bytepos
- 1;
4872 nextpos
= CHAR_TO_BYTE (XFASTINT (tem
));
4874 /* If there are no more annotations in this range,
4875 output the rest of the range all at once. */
4876 if (! (nextpos
>= bytepos
&& nextpos
<= lastpos
))
4877 return e_write (desc
, addr
, lastpos
- bytepos
, coding
);
4879 /* Output buffer text up to the next annotation's position. */
4880 if (nextpos
> bytepos
)
4882 if (0 > e_write (desc
, addr
, nextpos
- bytepos
, coding
))
4884 addr
+= nextpos
- bytepos
;
4887 /* Output the annotation. */
4888 tem
= Fcdr (Fcar (*annot
));
4891 if (0 > e_write (desc
, XSTRING (tem
)->data
, STRING_BYTES (XSTRING (tem
)),
4895 *annot
= Fcdr (*annot
);
4900 #ifndef WRITE_BUF_SIZE
4901 #define WRITE_BUF_SIZE (16 * 1024)
4904 /* Write NBYTES bytes starting at ADDR into descriptor DESC,
4905 encoding them with coding system CODING. */
4908 e_write (desc
, addr
, nbytes
, coding
)
4910 register char *addr
;
4911 register int nbytes
;
4912 struct coding_system
*coding
;
4914 char buf
[WRITE_BUF_SIZE
];
4916 /* We used to have a code for handling selective display here. But,
4917 now it is handled within encode_coding. */
4922 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
4923 nbytes
-= coding
->consumed
, addr
+= coding
->consumed
;
4924 if (coding
->produced
> 0)
4926 coding
->produced
-= write (desc
, buf
, coding
->produced
);
4927 if (coding
->produced
) return -1;
4929 if (result
== CODING_FINISH_INSUFFICIENT_SRC
)
4931 /* The source text ends by an incomplete multibyte form.
4932 There's no way other than write it out as is. */
4933 nbytes
-= write (desc
, addr
, nbytes
);
4934 if (nbytes
) return -1;
4942 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4943 Sverify_visited_file_modtime
, 1, 1, 0,
4944 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4945 This means that the file has not been changed since it was visited or saved.")
4951 Lisp_Object handler
;
4952 Lisp_Object filename
;
4954 CHECK_BUFFER (buf
, 0);
4957 if (!STRINGP (b
->filename
)) return Qt
;
4958 if (b
->modtime
== 0) return Qt
;
4960 /* If the file name has special constructs in it,
4961 call the corresponding file handler. */
4962 handler
= Ffind_file_name_handler (b
->filename
,
4963 Qverify_visited_file_modtime
);
4964 if (!NILP (handler
))
4965 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4967 filename
= ENCODE_FILE (b
->filename
);
4969 if (stat (XSTRING (filename
)->data
, &st
) < 0)
4971 /* If the file doesn't exist now and didn't exist before,
4972 we say that it isn't modified, provided the error is a tame one. */
4973 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4978 if (st
.st_mtime
== b
->modtime
4979 /* If both are positive, accept them if they are off by one second. */
4980 || (st
.st_mtime
> 0 && b
->modtime
> 0
4981 && (st
.st_mtime
== b
->modtime
+ 1
4982 || st
.st_mtime
== b
->modtime
- 1)))
4987 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4988 Sclear_visited_file_modtime
, 0, 0, 0,
4989 "Clear out records of last mod time of visited file.\n\
4990 Next attempt to save will certainly not complain of a discrepancy.")
4993 current_buffer
->modtime
= 0;
4997 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4998 Svisited_file_modtime
, 0, 0, 0,
4999 "Return the current buffer's recorded visited file modification time.\n\
5000 The value is a list of the form (HIGH . LOW), like the time values\n\
5001 that `file-attributes' returns.")
5004 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5007 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5008 Sset_visited_file_modtime
, 0, 1, 0,
5009 "Update buffer's recorded modification time from the visited file's time.\n\
5010 Useful if the buffer was not read from the file normally\n\
5011 or if the file itself has been changed for some known benign reason.\n\
5012 An argument specifies the modification time value to use\n\
5013 \(instead of that of the visited file), in the form of a list\n\
5014 \(HIGH . LOW) or (HIGH LOW).")
5016 Lisp_Object time_list
;
5018 if (!NILP (time_list
))
5019 current_buffer
->modtime
= cons_to_long (time_list
);
5022 register Lisp_Object filename
;
5024 Lisp_Object handler
;
5026 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5028 /* If the file name has special constructs in it,
5029 call the corresponding file handler. */
5030 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5031 if (!NILP (handler
))
5032 /* The handler can find the file name the same way we did. */
5033 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5035 filename
= ENCODE_FILE (filename
);
5037 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
5038 current_buffer
->modtime
= st
.st_mtime
;
5048 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 1);
5049 Fsleep_for (make_number (1), Qnil
);
5050 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
5051 Fsleep_for (make_number (1), Qnil
);
5052 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
5053 Fsleep_for (make_number (1), Qnil
);
5063 /* Get visited file's mode to become the auto save file's mode. */
5064 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
5065 /* But make sure we can overwrite it later! */
5066 auto_save_mode_bits
= st
.st_mode
| 0600;
5068 auto_save_mode_bits
= 0666;
5071 Fwrite_region (Qnil
, Qnil
,
5072 current_buffer
->auto_save_file_name
,
5073 Qnil
, Qlambda
, Qnil
, Qnil
);
5077 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5082 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5083 | XFASTINT (XCDR (stream
))));
5088 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5091 minibuffer_auto_raise
= XINT (value
);
5095 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5096 "Auto-save all buffers that need it.\n\
5097 This is all buffers that have auto-saving enabled\n\
5098 and are changed since last auto-saved.\n\
5099 Auto-saving writes the buffer into a file\n\
5100 so that your editing is not lost if the system crashes.\n\
5101 This file is not the file you visited; that changes only when you save.\n\
5102 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
5103 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
5104 A non-nil CURRENT-ONLY argument means save only current buffer.")
5105 (no_message
, current_only
)
5106 Lisp_Object no_message
, current_only
;
5108 struct buffer
*old
= current_buffer
, *b
;
5109 Lisp_Object tail
, buf
;
5111 int do_handled_files
;
5114 Lisp_Object lispstream
;
5115 int count
= specpdl_ptr
- specpdl
;
5117 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5118 int message_p
= push_message ();
5120 /* Ordinarily don't quit within this function,
5121 but don't make it impossible to quit (in case we get hung in I/O). */
5125 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5126 point to non-strings reached from Vbuffer_alist. */
5131 if (!NILP (Vrun_hooks
))
5132 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5134 if (STRINGP (Vauto_save_list_file_name
))
5136 Lisp_Object listfile
;
5137 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5138 stream
= fopen (XSTRING (listfile
)->data
, "w");
5141 /* Arrange to close that file whether or not we get an error.
5142 Also reset auto_saving to 0. */
5143 lispstream
= Fcons (Qnil
, Qnil
);
5144 XSETFASTINT (XCAR (lispstream
), (EMACS_UINT
)stream
>> 16);
5145 XSETFASTINT (XCDR (lispstream
), (EMACS_UINT
)stream
& 0xffff);
5156 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5157 record_unwind_protect (do_auto_save_unwind_1
,
5158 make_number (minibuffer_auto_raise
));
5159 minibuffer_auto_raise
= 0;
5162 /* First, save all files which don't have handlers. If Emacs is
5163 crashing, the handlers may tweak what is causing Emacs to crash
5164 in the first place, and it would be a shame if Emacs failed to
5165 autosave perfectly ordinary files because it couldn't handle some
5167 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5168 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5170 buf
= XCDR (XCAR (tail
));
5173 /* Record all the buffers that have auto save mode
5174 in the special file that lists them. For each of these buffers,
5175 Record visited name (if any) and auto save name. */
5176 if (STRINGP (b
->auto_save_file_name
)
5177 && stream
!= NULL
&& do_handled_files
== 0)
5179 if (!NILP (b
->filename
))
5181 fwrite (XSTRING (b
->filename
)->data
, 1,
5182 STRING_BYTES (XSTRING (b
->filename
)), stream
);
5184 putc ('\n', stream
);
5185 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
5186 STRING_BYTES (XSTRING (b
->auto_save_file_name
)), stream
);
5187 putc ('\n', stream
);
5190 if (!NILP (current_only
)
5191 && b
!= current_buffer
)
5194 /* Don't auto-save indirect buffers.
5195 The base buffer takes care of it. */
5199 /* Check for auto save enabled
5200 and file changed since last auto save
5201 and file changed since last real save. */
5202 if (STRINGP (b
->auto_save_file_name
)
5203 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5204 && b
->auto_save_modified
< BUF_MODIFF (b
)
5205 /* -1 means we've turned off autosaving for a while--see below. */
5206 && XINT (b
->save_length
) >= 0
5207 && (do_handled_files
5208 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5211 EMACS_TIME before_time
, after_time
;
5213 EMACS_GET_TIME (before_time
);
5215 /* If we had a failure, don't try again for 20 minutes. */
5216 if (b
->auto_save_failure_time
>= 0
5217 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5220 if ((XFASTINT (b
->save_length
) * 10
5221 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5222 /* A short file is likely to change a large fraction;
5223 spare the user annoying messages. */
5224 && XFASTINT (b
->save_length
) > 5000
5225 /* These messages are frequent and annoying for `*mail*'. */
5226 && !EQ (b
->filename
, Qnil
)
5227 && NILP (no_message
))
5229 /* It has shrunk too much; turn off auto-saving here. */
5230 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5231 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
5233 minibuffer_auto_raise
= 0;
5234 /* Turn off auto-saving until there's a real save,
5235 and prevent any more warnings. */
5236 XSETINT (b
->save_length
, -1);
5237 Fsleep_for (make_number (1), Qnil
);
5240 set_buffer_internal (b
);
5241 if (!auto_saved
&& NILP (no_message
))
5242 message1 ("Auto-saving...");
5243 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5245 b
->auto_save_modified
= BUF_MODIFF (b
);
5246 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5247 set_buffer_internal (old
);
5249 EMACS_GET_TIME (after_time
);
5251 /* If auto-save took more than 60 seconds,
5252 assume it was an NFS failure that got a timeout. */
5253 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5254 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5258 /* Prevent another auto save till enough input events come in. */
5259 record_auto_save ();
5261 if (auto_saved
&& NILP (no_message
))
5265 sit_for (1, 0, 0, 0, 0);
5269 message1 ("Auto-saving...done");
5275 unbind_to (count
, Qnil
);
5279 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5280 Sset_buffer_auto_saved
, 0, 0, 0,
5281 "Mark current buffer as auto-saved with its current text.\n\
5282 No auto-save file will be written until the buffer changes again.")
5285 current_buffer
->auto_save_modified
= MODIFF
;
5286 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5287 current_buffer
->auto_save_failure_time
= -1;
5291 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5292 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5293 "Clear any record of a recent auto-save failure in the current buffer.")
5296 current_buffer
->auto_save_failure_time
= -1;
5300 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5302 "Return t if buffer has been auto-saved since last read in or saved.")
5305 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5308 /* Reading and completing file names */
5309 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5311 /* In the string VAL, change each $ to $$ and return the result. */
5314 double_dollars (val
)
5317 register unsigned char *old
, *new;
5321 osize
= STRING_BYTES (XSTRING (val
));
5323 /* Count the number of $ characters. */
5324 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
5325 if (*old
++ == '$') count
++;
5328 old
= XSTRING (val
)->data
;
5329 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
5331 new = XSTRING (val
)->data
;
5332 for (n
= osize
; n
> 0; n
--)
5345 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5347 "Internal subroutine for read-file-name. Do not call this.")
5348 (string
, dir
, action
)
5349 Lisp_Object string
, dir
, action
;
5350 /* action is nil for complete, t for return list of completions,
5351 lambda for verify final value */
5353 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5355 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5357 CHECK_STRING (string
, 0);
5364 /* No need to protect ACTION--we only compare it with t and nil. */
5365 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5367 if (XSTRING (string
)->size
== 0)
5369 if (EQ (action
, Qlambda
))
5377 orig_string
= string
;
5378 string
= Fsubstitute_in_file_name (string
);
5379 changed
= NILP (Fstring_equal (string
, orig_string
));
5380 name
= Ffile_name_nondirectory (string
);
5381 val
= Ffile_name_directory (string
);
5383 realdir
= Fexpand_file_name (val
, realdir
);
5388 specdir
= Ffile_name_directory (string
);
5389 val
= Ffile_name_completion (name
, realdir
);
5394 return double_dollars (string
);
5398 if (!NILP (specdir
))
5399 val
= concat2 (specdir
, val
);
5401 return double_dollars (val
);
5404 #endif /* not VMS */
5408 if (EQ (action
, Qt
))
5409 return Ffile_name_all_completions (name
, realdir
);
5410 /* Only other case actually used is ACTION = lambda */
5412 /* Supposedly this helps commands such as `cd' that read directory names,
5413 but can someone explain how it helps them? -- RMS */
5414 if (XSTRING (name
)->size
== 0)
5417 return Ffile_exists_p (string
);
5420 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5421 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5422 Value is not expanded---you must call `expand-file-name' yourself.\n\
5423 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5424 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5425 except that if INITIAL is specified, that combined with DIR is used.)\n\
5426 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5427 Non-nil and non-t means also require confirmation after completion.\n\
5428 Fifth arg INITIAL specifies text to start with.\n\
5429 DIR defaults to current buffer's directory default.")
5430 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5431 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5433 Lisp_Object val
, insdef
, tem
;
5434 struct gcpro gcpro1
, gcpro2
;
5435 register char *homedir
;
5436 int replace_in_history
= 0;
5437 int add_to_history
= 0;
5441 dir
= current_buffer
->directory
;
5442 if (NILP (default_filename
))
5444 if (! NILP (initial
))
5445 default_filename
= Fexpand_file_name (initial
, dir
);
5447 default_filename
= current_buffer
->filename
;
5450 /* If dir starts with user's homedir, change that to ~. */
5451 homedir
= (char *) egetenv ("HOME");
5453 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5454 CORRECT_DIR_SEPS (homedir
);
5458 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5459 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5461 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5462 STRING_BYTES (XSTRING (dir
)) - strlen (homedir
) + 1);
5463 XSTRING (dir
)->data
[0] = '~';
5465 /* Likewise for default_filename. */
5467 && STRINGP (default_filename
)
5468 && !strncmp (homedir
, XSTRING (default_filename
)->data
, strlen (homedir
))
5469 && IS_DIRECTORY_SEP (XSTRING (default_filename
)->data
[strlen (homedir
)]))
5472 = make_string (XSTRING (default_filename
)->data
+ strlen (homedir
) - 1,
5473 STRING_BYTES (XSTRING (default_filename
)) - strlen (homedir
) + 1);
5474 XSTRING (default_filename
)->data
[0] = '~';
5476 if (!NILP (default_filename
))
5478 CHECK_STRING (default_filename
, 3);
5479 default_filename
= double_dollars (default_filename
);
5482 if (insert_default_directory
&& STRINGP (dir
))
5485 if (!NILP (initial
))
5487 Lisp_Object args
[2], pos
;
5491 insdef
= Fconcat (2, args
);
5492 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5493 insdef
= Fcons (double_dollars (insdef
), pos
);
5496 insdef
= double_dollars (insdef
);
5498 else if (STRINGP (initial
))
5499 insdef
= Fcons (double_dollars (initial
), make_number (0));
5503 count
= specpdl_ptr
- specpdl
;
5505 specbind (intern ("completion-ignore-case"), Qt
);
5508 specbind (intern ("minibuffer-completing-file-name"), Qt
);
5510 GCPRO2 (insdef
, default_filename
);
5513 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5517 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
5522 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5523 dir
, mustmatch
, insdef
,
5524 Qfile_name_history
, default_filename
, Qnil
);
5526 tem
= Fsymbol_value (Qfile_name_history
);
5527 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
5528 replace_in_history
= 1;
5530 /* If Fcompleting_read returned the inserted default string itself
5531 (rather than a new string with the same contents),
5532 it has to mean that the user typed RET with the minibuffer empty.
5533 In that case, we really want to return ""
5534 so that commands such as set-visited-file-name can distinguish. */
5535 if (EQ (val
, default_filename
))
5537 /* In this case, Fcompleting_read has not added an element
5538 to the history. Maybe we should. */
5539 if (! replace_in_history
)
5542 val
= build_string ("");
5545 unbind_to (count
, Qnil
);
5548 error ("No file name specified");
5550 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
5552 if (!NILP (tem
) && !NILP (default_filename
))
5553 val
= default_filename
;
5554 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5556 if (!NILP (default_filename
))
5557 val
= default_filename
;
5559 error ("No default file name");
5561 val
= Fsubstitute_in_file_name (val
);
5563 if (replace_in_history
)
5564 /* Replace what Fcompleting_read added to the history
5565 with what we will actually return. */
5566 XCAR (Fsymbol_value (Qfile_name_history
)) = double_dollars (val
);
5567 else if (add_to_history
)
5569 /* Add the value to the history--but not if it matches
5570 the last value already there. */
5571 Lisp_Object val1
= double_dollars (val
);
5572 tem
= Fsymbol_value (Qfile_name_history
);
5573 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
5574 Fset (Qfile_name_history
,
5585 /* Must be set before any path manipulation is performed. */
5586 XSETFASTINT (Vdirectory_sep_char
, '/');
5593 Qexpand_file_name
= intern ("expand-file-name");
5594 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5595 Qdirectory_file_name
= intern ("directory-file-name");
5596 Qfile_name_directory
= intern ("file-name-directory");
5597 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5598 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5599 Qfile_name_as_directory
= intern ("file-name-as-directory");
5600 Qcopy_file
= intern ("copy-file");
5601 Qmake_directory_internal
= intern ("make-directory-internal");
5602 Qdelete_directory
= intern ("delete-directory");
5603 Qdelete_file
= intern ("delete-file");
5604 Qrename_file
= intern ("rename-file");
5605 Qadd_name_to_file
= intern ("add-name-to-file");
5606 Qmake_symbolic_link
= intern ("make-symbolic-link");
5607 Qfile_exists_p
= intern ("file-exists-p");
5608 Qfile_executable_p
= intern ("file-executable-p");
5609 Qfile_readable_p
= intern ("file-readable-p");
5610 Qfile_writable_p
= intern ("file-writable-p");
5611 Qfile_symlink_p
= intern ("file-symlink-p");
5612 Qaccess_file
= intern ("access-file");
5613 Qfile_directory_p
= intern ("file-directory-p");
5614 Qfile_regular_p
= intern ("file-regular-p");
5615 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5616 Qfile_modes
= intern ("file-modes");
5617 Qset_file_modes
= intern ("set-file-modes");
5618 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5619 Qinsert_file_contents
= intern ("insert-file-contents");
5620 Qwrite_region
= intern ("write-region");
5621 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5622 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5624 staticpro (&Qexpand_file_name
);
5625 staticpro (&Qsubstitute_in_file_name
);
5626 staticpro (&Qdirectory_file_name
);
5627 staticpro (&Qfile_name_directory
);
5628 staticpro (&Qfile_name_nondirectory
);
5629 staticpro (&Qunhandled_file_name_directory
);
5630 staticpro (&Qfile_name_as_directory
);
5631 staticpro (&Qcopy_file
);
5632 staticpro (&Qmake_directory_internal
);
5633 staticpro (&Qdelete_directory
);
5634 staticpro (&Qdelete_file
);
5635 staticpro (&Qrename_file
);
5636 staticpro (&Qadd_name_to_file
);
5637 staticpro (&Qmake_symbolic_link
);
5638 staticpro (&Qfile_exists_p
);
5639 staticpro (&Qfile_executable_p
);
5640 staticpro (&Qfile_readable_p
);
5641 staticpro (&Qfile_writable_p
);
5642 staticpro (&Qaccess_file
);
5643 staticpro (&Qfile_symlink_p
);
5644 staticpro (&Qfile_directory_p
);
5645 staticpro (&Qfile_regular_p
);
5646 staticpro (&Qfile_accessible_directory_p
);
5647 staticpro (&Qfile_modes
);
5648 staticpro (&Qset_file_modes
);
5649 staticpro (&Qfile_newer_than_file_p
);
5650 staticpro (&Qinsert_file_contents
);
5651 staticpro (&Qwrite_region
);
5652 staticpro (&Qverify_visited_file_modtime
);
5653 staticpro (&Qset_visited_file_modtime
);
5655 Qfile_name_history
= intern ("file-name-history");
5656 Fset (Qfile_name_history
, Qnil
);
5657 staticpro (&Qfile_name_history
);
5659 Qfile_error
= intern ("file-error");
5660 staticpro (&Qfile_error
);
5661 Qfile_already_exists
= intern ("file-already-exists");
5662 staticpro (&Qfile_already_exists
);
5663 Qfile_date_error
= intern ("file-date-error");
5664 staticpro (&Qfile_date_error
);
5665 Qexcl
= intern ("excl");
5669 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5670 staticpro (&Qfind_buffer_file_type
);
5673 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5674 "*Coding system for encoding file names.\n\
5675 If it is nil, default-file-name-coding-system (which see) is used.");
5676 Vfile_name_coding_system
= Qnil
;
5678 DEFVAR_LISP ("default-file-name-coding-system",
5679 &Vdefault_file_name_coding_system
,
5680 "Default coding system for encoding file names.\n\
5681 This variable is used only when file-name-coding-system is nil.\n\
5683 This variable is set/changed by the command set-language-environment.\n\
5684 User should not set this variable manually,\n\
5685 instead use file-name-coding-system to get a constant encoding\n\
5686 of file names regardless of the current language environment.");
5687 Vdefault_file_name_coding_system
= Qnil
;
5689 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5690 "*Format in which to write auto-save files.\n\
5691 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5692 If it is t, which is the default, auto-save files are written in the\n\
5693 same format as a regular save would use.");
5694 Vauto_save_file_format
= Qt
;
5696 Qformat_decode
= intern ("format-decode");
5697 staticpro (&Qformat_decode
);
5698 Qformat_annotate_function
= intern ("format-annotate-function");
5699 staticpro (&Qformat_annotate_function
);
5701 Qcar_less_than_car
= intern ("car-less-than-car");
5702 staticpro (&Qcar_less_than_car
);
5704 Fput (Qfile_error
, Qerror_conditions
,
5705 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5706 Fput (Qfile_error
, Qerror_message
,
5707 build_string ("File error"));
5709 Fput (Qfile_already_exists
, Qerror_conditions
,
5710 Fcons (Qfile_already_exists
,
5711 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5712 Fput (Qfile_already_exists
, Qerror_message
,
5713 build_string ("File already exists"));
5715 Fput (Qfile_date_error
, Qerror_conditions
,
5716 Fcons (Qfile_date_error
,
5717 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5718 Fput (Qfile_date_error
, Qerror_message
,
5719 build_string ("Cannot set file date"));
5721 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5722 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5723 insert_default_directory
= 1;
5725 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5726 "*Non-nil means write new files with record format `stmlf'.\n\
5727 nil means use format `var'. This variable is meaningful only on VMS.");
5728 vms_stmlf_recfm
= 0;
5730 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5731 "Directory separator character for built-in functions that return file names.\n\
5732 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5733 This variable affects the built-in functions only on Windows,\n\
5734 on other platforms, it is initialized so that Lisp code can find out\n\
5735 what the normal separator is.");
5737 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5738 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5739 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5742 The first argument given to HANDLER is the name of the I/O primitive\n\
5743 to be handled; the remaining arguments are the arguments that were\n\
5744 passed to that primitive. For example, if you do\n\
5745 (file-exists-p FILENAME)\n\
5746 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5747 (funcall HANDLER 'file-exists-p FILENAME)\n\
5748 The function `find-file-name-handler' checks this list for a handler\n\
5749 for its argument.");
5750 Vfile_name_handler_alist
= Qnil
;
5752 DEFVAR_LISP ("set-auto-coding-function",
5753 &Vset_auto_coding_function
,
5754 "If non-nil, a function to call to decide a coding system of file.\n\
5755 Two arguments are passed to this function: the file name\n\
5756 and the length of a file contents following the point.\n\
5757 This function should return a coding system to decode the file contents.\n\
5758 It should check the file name against `auto-coding-alist'.\n\
5759 If no coding system is decided, it should check a coding system\n\
5760 specified in the heading lines with the format:\n\
5761 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5762 or local variable spec of the tailing lines with `coding:' tag.");
5763 Vset_auto_coding_function
= Qnil
;
5765 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5766 "A list of functions to be called at the end of `insert-file-contents'.\n\
5767 Each is passed one argument, the number of bytes inserted. It should return\n\
5768 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5769 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5770 responsible for calling the after-insert-file-functions if appropriate.");
5771 Vafter_insert_file_functions
= Qnil
;
5773 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5774 "A list of functions to be called at the start of `write-region'.\n\
5775 Each is passed two arguments, START and END as for `write-region'.\n\
5776 These are usually two numbers but not always; see the documentation\n\
5777 for `write-region'. The function should return a list of pairs\n\
5778 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5779 inserted at the specified positions of the file being written (1 means to\n\
5780 insert before the first byte written). The POSITIONs must be sorted into\n\
5781 increasing order. If there are several functions in the list, the several\n\
5782 lists are merged destructively.");
5783 Vwrite_region_annotate_functions
= Qnil
;
5785 DEFVAR_LISP ("write-region-annotations-so-far",
5786 &Vwrite_region_annotations_so_far
,
5787 "When an annotation function is called, this holds the previous annotations.\n\
5788 These are the annotations made by other annotation functions\n\
5789 that were already called. See also `write-region-annotate-functions'.");
5790 Vwrite_region_annotations_so_far
= Qnil
;
5792 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5793 "A list of file name handlers that temporarily should not be used.\n\
5794 This applies only to the operation `inhibit-file-name-operation'.");
5795 Vinhibit_file_name_handlers
= Qnil
;
5797 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5798 "The operation for which `inhibit-file-name-handlers' is applicable.");
5799 Vinhibit_file_name_operation
= Qnil
;
5801 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5802 "File name in which we write a list of all auto save file names.\n\
5803 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5804 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5806 Vauto_save_list_file_name
= Qnil
;
5808 defsubr (&Sfind_file_name_handler
);
5809 defsubr (&Sfile_name_directory
);
5810 defsubr (&Sfile_name_nondirectory
);
5811 defsubr (&Sunhandled_file_name_directory
);
5812 defsubr (&Sfile_name_as_directory
);
5813 defsubr (&Sdirectory_file_name
);
5814 defsubr (&Smake_temp_name
);
5815 defsubr (&Sexpand_file_name
);
5816 defsubr (&Ssubstitute_in_file_name
);
5817 defsubr (&Scopy_file
);
5818 defsubr (&Smake_directory_internal
);
5819 defsubr (&Sdelete_directory
);
5820 defsubr (&Sdelete_file
);
5821 defsubr (&Srename_file
);
5822 defsubr (&Sadd_name_to_file
);
5824 defsubr (&Smake_symbolic_link
);
5825 #endif /* S_IFLNK */
5827 defsubr (&Sdefine_logical_name
);
5830 defsubr (&Ssysnetunam
);
5831 #endif /* HPUX_NET */
5832 defsubr (&Sfile_name_absolute_p
);
5833 defsubr (&Sfile_exists_p
);
5834 defsubr (&Sfile_executable_p
);
5835 defsubr (&Sfile_readable_p
);
5836 defsubr (&Sfile_writable_p
);
5837 defsubr (&Saccess_file
);
5838 defsubr (&Sfile_symlink_p
);
5839 defsubr (&Sfile_directory_p
);
5840 defsubr (&Sfile_accessible_directory_p
);
5841 defsubr (&Sfile_regular_p
);
5842 defsubr (&Sfile_modes
);
5843 defsubr (&Sset_file_modes
);
5844 defsubr (&Sset_default_file_modes
);
5845 defsubr (&Sdefault_file_modes
);
5846 defsubr (&Sfile_newer_than_file_p
);
5847 defsubr (&Sinsert_file_contents
);
5848 defsubr (&Swrite_region
);
5849 defsubr (&Scar_less_than_car
);
5850 defsubr (&Sverify_visited_file_modtime
);
5851 defsubr (&Sclear_visited_file_modtime
);
5852 defsubr (&Svisited_file_modtime
);
5853 defsubr (&Sset_visited_file_modtime
);
5854 defsubr (&Sdo_auto_save
);
5855 defsubr (&Sset_buffer_auto_saved
);
5856 defsubr (&Sclear_buffer_auto_save_failure
);
5857 defsubr (&Srecent_auto_save_p
);
5859 defsubr (&Sread_file_name_internal
);
5860 defsubr (&Sread_file_name
);
5863 defsubr (&Sunix_sync
);