1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96 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)
27 #include <sys/types.h>
34 #if !defined (S_ISLNK) && defined (S_IFLNK)
35 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
38 #if !defined (S_ISFIFO) && defined (S_IFIFO)
39 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
42 #if !defined (S_ISREG) && defined (S_IFREG)
43 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
54 #include <sys/param.h>
76 extern char *strerror ();
93 #include "intervals.h"
104 #endif /* not WINDOWSNT */
107 #define CORRECT_DIR_SEPS(s) \
108 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
109 else unixtodos_filename (s); \
111 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
112 redirector allows the six letters between 'Z' and 'a' as well. */
114 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
117 #define IS_DRIVE(x) isalpha (x)
119 /* Need to lower-case the drive letter, or else expanded
120 filenames will sometimes compare inequal, because
121 `expand-file-name' doesn't always down-case the drive letter. */
122 #define DRIVE_LETTER(x) (tolower (x))
151 #define min(a, b) ((a) < (b) ? (a) : (b))
152 #define max(a, b) ((a) > (b) ? (a) : (b))
154 /* Nonzero during writing of auto-save files */
157 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
158 a new file with the same mode as the original */
159 int auto_save_mode_bits
;
161 /* Alist of elements (REGEXP . HANDLER) for file names
162 whose I/O is done with a special handler. */
163 Lisp_Object Vfile_name_handler_alist
;
165 /* Format for auto-save files */
166 Lisp_Object Vauto_save_file_format
;
168 /* Lisp functions for translating file formats */
169 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
171 /* Functions to be called to process text properties in inserted file. */
172 Lisp_Object Vafter_insert_file_functions
;
174 /* Functions to be called to create text property annotations for file. */
175 Lisp_Object Vwrite_region_annotate_functions
;
177 /* During build_annotations, each time an annotation function is called,
178 this holds the annotations made by the previous functions. */
179 Lisp_Object Vwrite_region_annotations_so_far
;
181 /* File name in which we write a list of all our auto save files. */
182 Lisp_Object Vauto_save_list_file_name
;
184 /* Nonzero means, when reading a filename in the minibuffer,
185 start out by inserting the default directory into the minibuffer. */
186 int insert_default_directory
;
188 /* On VMS, nonzero means write new files with record format stmlf.
189 Zero means use var format. */
192 /* On NT, specifies the directory separator character, used (eg.) when
193 expanding file names. This can be bound to / or \. */
194 Lisp_Object Vdirectory_sep_char
;
196 extern Lisp_Object Vuser_login_name
;
198 extern int minibuf_level
;
200 /* These variables describe handlers that have "already" had a chance
201 to handle the current operation.
203 Vinhibit_file_name_handlers is a list of file name handlers.
204 Vinhibit_file_name_operation is the operation being handled.
205 If we try to handle that operation, we ignore those handlers. */
207 static Lisp_Object Vinhibit_file_name_handlers
;
208 static Lisp_Object Vinhibit_file_name_operation
;
210 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
212 Lisp_Object Qfile_name_history
;
214 Lisp_Object Qcar_less_than_car
;
216 report_file_error (string
, data
)
220 Lisp_Object errstring
;
222 errstring
= build_string (strerror (errno
));
224 /* System error messages are capitalized. Downcase the initial
225 unless it is followed by a slash. */
226 if (XSTRING (errstring
)->data
[1] != '/')
227 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
230 Fsignal (Qfile_error
,
231 Fcons (build_string (string
), Fcons (errstring
, data
)));
234 close_file_unwind (fd
)
237 close (XFASTINT (fd
));
240 /* Restore point, having saved it as a marker. */
242 restore_point_unwind (location
)
243 Lisp_Object location
;
245 SET_PT (marker_position (location
));
246 Fset_marker (location
, Qnil
, Qnil
);
249 Lisp_Object Qexpand_file_name
;
250 Lisp_Object Qsubstitute_in_file_name
;
251 Lisp_Object Qdirectory_file_name
;
252 Lisp_Object Qfile_name_directory
;
253 Lisp_Object Qfile_name_nondirectory
;
254 Lisp_Object Qunhandled_file_name_directory
;
255 Lisp_Object Qfile_name_as_directory
;
256 Lisp_Object Qcopy_file
;
257 Lisp_Object Qmake_directory_internal
;
258 Lisp_Object Qdelete_directory
;
259 Lisp_Object Qdelete_file
;
260 Lisp_Object Qrename_file
;
261 Lisp_Object Qadd_name_to_file
;
262 Lisp_Object Qmake_symbolic_link
;
263 Lisp_Object Qfile_exists_p
;
264 Lisp_Object Qfile_executable_p
;
265 Lisp_Object Qfile_readable_p
;
266 Lisp_Object Qfile_writable_p
;
267 Lisp_Object Qfile_symlink_p
;
268 Lisp_Object Qaccess_file
;
269 Lisp_Object Qfile_directory_p
;
270 Lisp_Object Qfile_regular_p
;
271 Lisp_Object Qfile_accessible_directory_p
;
272 Lisp_Object Qfile_modes
;
273 Lisp_Object Qset_file_modes
;
274 Lisp_Object Qfile_newer_than_file_p
;
275 Lisp_Object Qinsert_file_contents
;
276 Lisp_Object Qwrite_region
;
277 Lisp_Object Qverify_visited_file_modtime
;
278 Lisp_Object Qset_visited_file_modtime
;
280 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
281 "Return FILENAME's handler function for OPERATION, if it has one.\n\
282 Otherwise, return nil.\n\
283 A file name is handled if one of the regular expressions in\n\
284 `file-name-handler-alist' matches it.\n\n\
285 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
286 any handlers that are members of `inhibit-file-name-handlers',\n\
287 but we still do run any other handlers. This lets handlers\n\
288 use the standard functions without calling themselves recursively.")
289 (filename
, operation
)
290 Lisp_Object filename
, operation
;
292 /* This function must not munge the match data. */
293 Lisp_Object chain
, inhibited_handlers
;
295 CHECK_STRING (filename
, 0);
297 if (EQ (operation
, Vinhibit_file_name_operation
))
298 inhibited_handlers
= Vinhibit_file_name_handlers
;
300 inhibited_handlers
= Qnil
;
302 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
303 chain
= XCONS (chain
)->cdr
)
306 elt
= XCONS (chain
)->car
;
310 string
= XCONS (elt
)->car
;
311 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
313 Lisp_Object handler
, tem
;
315 handler
= XCONS (elt
)->cdr
;
316 tem
= Fmemq (handler
, inhibited_handlers
);
327 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
329 "Return the directory component in file name FILENAME.\n\
330 Return nil if FILENAME does not include a directory.\n\
331 Otherwise return a directory spec.\n\
332 Given a Unix syntax file name, returns a string ending in slash;\n\
333 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
335 Lisp_Object filename
;
337 register unsigned char *beg
;
338 register unsigned char *p
;
341 CHECK_STRING (filename
, 0);
343 /* If the file name has special constructs in it,
344 call the corresponding file handler. */
345 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
347 return call2 (handler
, Qfile_name_directory
, filename
);
349 #ifdef FILE_SYSTEM_CASE
350 filename
= FILE_SYSTEM_CASE (filename
);
352 beg
= XSTRING (filename
)->data
;
354 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
356 p
= beg
+ XSTRING (filename
)->size
;
358 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
360 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
363 /* only recognise drive specifier at beginning */
364 && !(p
[-1] == ':' && p
== beg
+ 2)
371 /* Expansion of "c:" to drive and default directory. */
372 if (p
== beg
+ 2 && beg
[1] == ':')
374 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
375 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
376 if (getdefdir (toupper (*beg
) - 'A' + 1, res
))
378 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
381 p
= beg
+ strlen (beg
);
384 CORRECT_DIR_SEPS (beg
);
386 return make_string (beg
, p
- beg
);
389 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
391 "Return file name FILENAME sans its directory.\n\
392 For example, in a Unix-syntax file name,\n\
393 this is everything after the last slash,\n\
394 or the entire name if it contains no slash.")
396 Lisp_Object filename
;
398 register unsigned char *beg
, *p
, *end
;
401 CHECK_STRING (filename
, 0);
403 /* If the file name has special constructs in it,
404 call the corresponding file handler. */
405 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
407 return call2 (handler
, Qfile_name_nondirectory
, filename
);
409 beg
= XSTRING (filename
)->data
;
410 end
= p
= beg
+ XSTRING (filename
)->size
;
412 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
414 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
417 /* only recognise drive specifier at beginning */
418 && !(p
[-1] == ':' && p
== beg
+ 2)
422 return make_string (p
, end
- p
);
425 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
426 "Return a directly usable directory name somehow associated with FILENAME.\n\
427 A `directly usable' directory name is one that may be used without the\n\
428 intervention of any file handler.\n\
429 If FILENAME is a directly usable file itself, return\n\
430 (file-name-directory FILENAME).\n\
431 The `call-process' and `start-process' functions use this function to\n\
432 get a current directory to run processes in.")
434 Lisp_Object filename
;
438 /* If the file name has special constructs in it,
439 call the corresponding file handler. */
440 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
442 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
444 return Ffile_name_directory (filename
);
449 file_name_as_directory (out
, in
)
452 int size
= strlen (in
) - 1;
457 /* Is it already a directory string? */
458 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
460 /* Is it a VMS directory file name? If so, hack VMS syntax. */
461 else if (! index (in
, '/')
462 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
463 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
464 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
465 || ! strncmp (&in
[size
- 5], ".dir", 4))
466 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
467 && in
[size
] == '1')))
469 register char *p
, *dot
;
473 dir:x.dir --> dir:[x]
474 dir:[x]y.dir --> dir:[x.y] */
476 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
479 strncpy (out
, in
, p
- in
);
498 dot
= index (p
, '.');
501 /* blindly remove any extension */
502 size
= strlen (out
) + (dot
- p
);
503 strncat (out
, p
, dot
- p
);
514 /* For Unix syntax, Append a slash if necessary */
515 if (!IS_DIRECTORY_SEP (out
[size
]))
517 out
[size
+ 1] = DIRECTORY_SEP
;
518 out
[size
+ 2] = '\0';
521 CORRECT_DIR_SEPS (out
);
527 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
528 Sfile_name_as_directory
, 1, 1, 0,
529 "Return a string representing file FILENAME interpreted as a directory.\n\
530 This operation exists because a directory is also a file, but its name as\n\
531 a directory is different from its name as a file.\n\
532 The result can be used as the value of `default-directory'\n\
533 or passed as second argument to `expand-file-name'.\n\
534 For a Unix-syntax file name, just appends a slash.\n\
535 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
542 CHECK_STRING (file
, 0);
546 /* If the file name has special constructs in it,
547 call the corresponding file handler. */
548 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
550 return call2 (handler
, Qfile_name_as_directory
, file
);
552 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
553 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
557 * Convert from directory name to filename.
559 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
560 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
561 * On UNIX, it's simple: just make sure there isn't a terminating /
563 * Value is nonzero if the string output is different from the input.
566 directory_file_name (src
, dst
)
574 struct FAB fab
= cc$rms_fab
;
575 struct NAM nam
= cc$rms_nam
;
576 char esa
[NAM$C_MAXRSS
];
581 if (! index (src
, '/')
582 && (src
[slen
- 1] == ']'
583 || src
[slen
- 1] == ':'
584 || src
[slen
- 1] == '>'))
586 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
588 fab
.fab$b_fns
= slen
;
589 fab
.fab$l_nam
= &nam
;
590 fab
.fab$l_fop
= FAB$M_NAM
;
593 nam
.nam$b_ess
= sizeof esa
;
594 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
596 /* We call SYS$PARSE to handle such things as [--] for us. */
597 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
599 slen
= nam
.nam$b_esl
;
600 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
605 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
607 /* what about when we have logical_name:???? */
608 if (src
[slen
- 1] == ':')
609 { /* Xlate logical name and see what we get */
610 ptr
= strcpy (dst
, src
); /* upper case for getenv */
613 if ('a' <= *ptr
&& *ptr
<= 'z')
617 dst
[slen
- 1] = 0; /* remove colon */
618 if (!(src
= egetenv (dst
)))
620 /* should we jump to the beginning of this procedure?
621 Good points: allows us to use logical names that xlate
623 Bad points: can be a problem if we just translated to a device
625 For now, I'll punt and always expect VMS names, and hope for
628 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
629 { /* no recursion here! */
635 { /* not a directory spec */
640 bracket
= src
[slen
- 1];
642 /* If bracket is ']' or '>', bracket - 2 is the corresponding
644 ptr
= index (src
, bracket
- 2);
646 { /* no opening bracket */
650 if (!(rptr
= rindex (src
, '.')))
653 strncpy (dst
, src
, slen
);
657 dst
[slen
++] = bracket
;
662 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
663 then translate the device and recurse. */
664 if (dst
[slen
- 1] == ':'
665 && dst
[slen
- 2] != ':' /* skip decnet nodes */
666 && strcmp (src
+ slen
, "[000000]") == 0)
668 dst
[slen
- 1] = '\0';
669 if ((ptr
= egetenv (dst
))
670 && (rlen
= strlen (ptr
) - 1) > 0
671 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
672 && ptr
[rlen
- 1] == '.')
674 char * buf
= (char *) alloca (strlen (ptr
) + 1);
678 return directory_file_name (buf
, dst
);
683 strcat (dst
, "[000000]");
687 rlen
= strlen (rptr
) - 1;
688 strncat (dst
, rptr
, rlen
);
689 dst
[slen
+ rlen
] = '\0';
690 strcat (dst
, ".DIR.1");
694 /* Process as Unix format: just remove any final slash.
695 But leave "/" unchanged; do not change it to "". */
698 /* Handle // as root for apollo's. */
699 if ((slen
> 2 && dst
[slen
- 1] == '/')
700 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
704 && IS_DIRECTORY_SEP (dst
[slen
- 1])
706 && !IS_ANY_SEP (dst
[slen
- 2])
712 CORRECT_DIR_SEPS (dst
);
717 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
719 "Returns the file name of the directory named DIRECTORY.\n\
720 This is the name of the file that holds the data for the directory DIRECTORY.\n\
721 This operation exists because a directory is also a file, but its name as\n\
722 a directory is different from its name as a file.\n\
723 In Unix-syntax, this function just removes the final slash.\n\
724 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
725 it returns a file name such as \"[X]Y.DIR.1\".")
727 Lisp_Object directory
;
732 CHECK_STRING (directory
, 0);
734 if (NILP (directory
))
737 /* If the file name has special constructs in it,
738 call the corresponding file handler. */
739 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
741 return call2 (handler
, Qdirectory_file_name
, directory
);
744 /* 20 extra chars is insufficient for VMS, since we might perform a
745 logical name translation. an equivalence string can be up to 255
746 chars long, so grab that much extra space... - sss */
747 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
749 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
751 directory_file_name (XSTRING (directory
)->data
, buf
);
752 return build_string (buf
);
755 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
756 "Generate temporary file name (string) starting with PREFIX (a string).\n\
757 The Emacs process number forms part of the result,\n\
758 so there is no danger of generating a name being used by another process.")
764 /* Don't use too many characters of the restricted 8+3 DOS
766 val
= concat2 (prefix
, build_string ("a.XXX"));
768 val
= concat2 (prefix
, build_string ("XXXXXX"));
770 mktemp (XSTRING (val
)->data
);
772 CORRECT_DIR_SEPS (XSTRING (val
)->data
);
777 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
778 "Convert filename NAME to absolute, and canonicalize it.\n\
779 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
780 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
781 the current buffer's value of default-directory is used.\n\
782 File name components that are `.' are removed, and \n\
783 so are file name components followed by `..', along with the `..' itself;\n\
784 note that these simplifications are done without checking the resulting\n\
785 file names in the file system.\n\
786 An initial `~/' expands to your home directory.\n\
787 An initial `~USER/' expands to USER's home directory.\n\
788 See also the function `substitute-in-file-name'.")
789 (name
, default_directory
)
790 Lisp_Object name
, default_directory
;
794 register unsigned char *newdir
, *p
, *o
;
796 unsigned char *target
;
799 unsigned char * colon
= 0;
800 unsigned char * close
= 0;
801 unsigned char * slash
= 0;
802 unsigned char * brack
= 0;
803 int lbrack
= 0, rbrack
= 0;
808 int collapse_newdir
= 1;
813 CHECK_STRING (name
, 0);
815 /* If the file name has special constructs in it,
816 call the corresponding file handler. */
817 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
819 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
821 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
822 if (NILP (default_directory
))
823 default_directory
= current_buffer
->directory
;
824 CHECK_STRING (default_directory
, 1);
826 if (!NILP (default_directory
))
828 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
830 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
833 o
= XSTRING (default_directory
)->data
;
835 /* Make sure DEFAULT_DIRECTORY is properly expanded.
836 It would be better to do this down below where we actually use
837 default_directory. Unfortunately, calling Fexpand_file_name recursively
838 could invoke GC, and the strings might be relocated. This would
839 be annoying because we have pointers into strings lying around
840 that would need adjusting, and people would add new pointers to
841 the code and forget to adjust them, resulting in intermittent bugs.
842 Putting this call here avoids all that crud.
844 The EQ test avoids infinite recursion. */
845 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
846 /* Save time in some common cases - as long as default_directory
847 is not relative, it can be canonicalized with name below (if it
848 is needed at all) without requiring it to be expanded now. */
850 /* Detect MSDOS file names with drive specifiers. */
851 && ! (IS_DRIVE (o
[0]) && (IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2])))
853 /* Detect Windows file names in UNC format. */
854 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
856 #else /* not DOS_NT */
857 /* Detect Unix absolute file names (/... alone is not absolute on
859 && ! (IS_DIRECTORY_SEP (o
[0]))
860 #endif /* not DOS_NT */
866 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
871 /* Filenames on VMS are always upper case. */
872 name
= Fupcase (name
);
874 #ifdef FILE_SYSTEM_CASE
875 name
= FILE_SYSTEM_CASE (name
);
878 nm
= XSTRING (name
)->data
;
881 /* We will force directory separators to be either all \ or /, so make
882 a local copy to modify, even if there ends up being no change. */
883 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
885 /* Find and remove drive specifier if present; this makes nm absolute
886 even if the rest of the name appears to be relative. */
888 unsigned char *colon
= rindex (nm
, ':');
891 /* Only recognize colon as part of drive specifier if there is a
892 single alphabetic character preceeding the colon (and if the
893 character before the drive letter, if present, is a directory
894 separator); this is to support the remote system syntax used by
895 ange-ftp, and the "po:username" syntax for POP mailboxes. */
899 else if (IS_DRIVE (colon
[-1])
900 && (colon
== nm
+ 1 || IS_DIRECTORY_SEP (colon
[-2])))
907 while (--colon
>= nm
)
915 /* Discard any previous drive specifier if nm is now in UNC format. */
916 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
922 /* If nm is absolute, look for /./ or /../ sequences; if none are
923 found, we can probably return right away. We will avoid allocating
924 a new string if name is already fully expanded. */
926 IS_DIRECTORY_SEP (nm
[0])
931 && (drive
|| IS_DIRECTORY_SEP (nm
[1]))
938 /* If it turns out that the filename we want to return is just a
939 suffix of FILENAME, we don't need to go through and edit
940 things; we just need to construct a new string using data
941 starting at the middle of FILENAME. If we set lose to a
942 non-zero value, that means we've discovered that we can't do
949 /* Since we know the name is absolute, we can assume that each
950 element starts with a "/". */
952 /* "." and ".." are hairy. */
953 if (IS_DIRECTORY_SEP (p
[0])
955 && (IS_DIRECTORY_SEP (p
[2])
957 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
964 /* if dev:[dir]/, move nm to / */
965 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
966 nm
= (brack
? brack
+ 1 : colon
+ 1);
975 /* VMS pre V4.4,convert '-'s in filenames. */
976 if (lbrack
== rbrack
)
978 if (dots
< 2) /* this is to allow negative version numbers */
983 if (lbrack
> rbrack
&&
984 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
985 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
991 /* count open brackets, reset close bracket pointer */
992 if (p
[0] == '[' || p
[0] == '<')
994 /* count close brackets, set close bracket pointer */
995 if (p
[0] == ']' || p
[0] == '>')
997 /* detect ][ or >< */
998 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1000 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1001 nm
= p
+ 1, lose
= 1;
1002 if (p
[0] == ':' && (colon
|| slash
))
1003 /* if dev1:[dir]dev2:, move nm to dev2: */
1009 /* if /name/dev:, move nm to dev: */
1012 /* if node::dev:, move colon following dev */
1013 else if (colon
&& colon
[-1] == ':')
1015 /* if dev1:dev2:, move nm to dev2: */
1016 else if (colon
&& colon
[-1] != ':')
1021 if (p
[0] == ':' && !colon
)
1027 if (lbrack
== rbrack
)
1030 else if (p
[0] == '.')
1038 if (index (nm
, '/'))
1039 return build_string (sys_translate_unix (nm
));
1042 /* Make sure directories are all separated with / or \ as
1043 desired, but avoid allocation of a new string when not
1045 CORRECT_DIR_SEPS (nm
);
1047 if (IS_DIRECTORY_SEP (nm
[1]))
1049 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1050 name
= build_string (nm
);
1054 /* drive must be set, so this is okay */
1055 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1057 name
= make_string (nm
- 2, p
- nm
+ 2);
1058 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1059 XSTRING (name
)->data
[1] = ':';
1062 #else /* not DOS_NT */
1063 if (nm
== XSTRING (name
)->data
)
1065 return build_string (nm
);
1066 #endif /* not DOS_NT */
1070 /* At this point, nm might or might not be an absolute file name. We
1071 need to expand ~ or ~user if present, otherwise prefix nm with
1072 default_directory if nm is not absolute, and finally collapse /./
1073 and /foo/../ sequences.
1075 We set newdir to be the appropriate prefix if one is needed:
1076 - the relevant user directory if nm starts with ~ or ~user
1077 - the specified drive's working dir (DOS/NT only) if nm does not
1079 - the value of default_directory.
1081 Note that these prefixes are not guaranteed to be absolute (except
1082 for the working dir of a drive). Therefore, to ensure we always
1083 return an absolute name, if the final prefix is not absolute we
1084 append it to the current working directory. */
1088 if (nm
[0] == '~') /* prefix ~ */
1090 if (IS_DIRECTORY_SEP (nm
[1])
1094 || nm
[1] == 0) /* ~ by itself */
1096 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1097 newdir
= (unsigned char *) "";
1100 collapse_newdir
= 0;
1103 nm
++; /* Don't leave the slash in nm. */
1106 else /* ~user/filename */
1108 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1113 o
= (unsigned char *) alloca (p
- nm
+ 1);
1114 bcopy ((char *) nm
, o
, p
- nm
);
1117 pw
= (struct passwd
*) getpwnam (o
+ 1);
1120 newdir
= (unsigned char *) pw
-> pw_dir
;
1122 nm
= p
+ 1; /* skip the terminator */
1126 collapse_newdir
= 0;
1131 /* If we don't find a user of that name, leave the name
1132 unchanged; don't move nm forward to p. */
1137 /* On DOS and Windows, nm is absolute if a drive name was specified;
1138 use the drive's current directory as the prefix if needed. */
1139 if (!newdir
&& drive
)
1141 /* Get default directory if needed to make nm absolute. */
1142 if (!IS_DIRECTORY_SEP (nm
[0]))
1144 newdir
= alloca (MAXPATHLEN
+ 1);
1145 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1150 /* Either nm starts with /, or drive isn't mounted. */
1151 newdir
= alloca (4);
1152 newdir
[0] = DRIVE_LETTER (drive
);
1160 /* Finally, if no prefix has been specified and nm is not absolute,
1161 then it must be expanded relative to default_directory. */
1165 /* /... alone is not absolute on DOS and Windows. */
1166 && !IS_DIRECTORY_SEP (nm
[0])
1169 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1176 newdir
= XSTRING (default_directory
)->data
;
1182 /* First ensure newdir is an absolute name. */
1184 /* Detect MSDOS file names with drive specifiers. */
1185 ! (IS_DRIVE (newdir
[0])
1186 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1188 /* Detect Windows file names in UNC format. */
1189 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1193 /* Effectively, let newdir be (expand-file-name newdir cwd).
1194 Because of the admonition against calling expand-file-name
1195 when we have pointers into lisp strings, we accomplish this
1196 indirectly by prepending newdir to nm if necessary, and using
1197 cwd (or the wd of newdir's drive) as the new newdir. */
1199 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1204 if (!IS_DIRECTORY_SEP (nm
[0]))
1206 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1207 file_name_as_directory (tmp
, newdir
);
1211 newdir
= alloca (MAXPATHLEN
+ 1);
1214 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1221 /* Strip off drive name from prefix, if present. */
1222 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1228 /* Keep only a prefix from newdir if nm starts with slash
1229 (//server/share for UNC, nothing otherwise). */
1230 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1233 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1235 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1237 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1239 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1251 /* Get rid of any slash at the end of newdir, unless newdir is
1252 just // (an incomplete UNC name). */
1253 length
= strlen (newdir
);
1254 if (IS_DIRECTORY_SEP (newdir
[length
- 1])
1256 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1260 unsigned char *temp
= (unsigned char *) alloca (length
);
1261 bcopy (newdir
, temp
, length
- 1);
1262 temp
[length
- 1] = 0;
1270 /* Now concatenate the directory and name to new space in the stack frame */
1271 tlen
+= strlen (nm
) + 1;
1273 /* Add reserved space for drive name. (The Microsoft x86 compiler
1274 produces incorrect code if the following two lines are combined.) */
1275 target
= (unsigned char *) alloca (tlen
+ 2);
1277 #else /* not DOS_NT */
1278 target
= (unsigned char *) alloca (tlen
);
1279 #endif /* not DOS_NT */
1285 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1286 strcpy (target
, newdir
);
1289 file_name_as_directory (target
, newdir
);
1292 strcat (target
, nm
);
1294 if (index (target
, '/'))
1295 strcpy (target
, sys_translate_unix (target
));
1298 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1300 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1308 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1314 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1315 /* brackets are offset from each other by 2 */
1318 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1319 /* convert [foo][bar] to [bar] */
1320 while (o
[-1] != '[' && o
[-1] != '<')
1322 else if (*p
== '-' && *o
!= '.')
1325 else if (p
[0] == '-' && o
[-1] == '.' &&
1326 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1327 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1331 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1332 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1334 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1336 /* else [foo.-] ==> [-] */
1342 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1343 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1349 if (!IS_DIRECTORY_SEP (*p
))
1353 else if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
1354 #if defined (APOLLO) || defined (WINDOWSNT)
1355 /* // at start of filename is meaningful in Apollo
1356 and WindowsNT systems */
1358 #endif /* APOLLO || WINDOWSNT */
1364 else if (IS_DIRECTORY_SEP (p
[0])
1366 && (IS_DIRECTORY_SEP (p
[2])
1369 /* If "/." is the entire filename, keep the "/". Otherwise,
1370 just delete the whole "/.". */
1371 if (o
== target
&& p
[2] == '\0')
1375 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1376 /* `/../' is the "superroot" on certain file systems. */
1378 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1380 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1382 if (o
== target
&& IS_ANY_SEP (*o
))
1390 #endif /* not VMS */
1394 /* At last, set drive name. */
1396 /* Except for network file name. */
1397 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1398 #endif /* WINDOWSNT */
1400 if (!drive
) abort ();
1402 target
[0] = DRIVE_LETTER (drive
);
1405 CORRECT_DIR_SEPS (target
);
1408 return make_string (target
, o
- target
);
1412 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1413 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1414 "Convert FILENAME to absolute, and canonicalize it.\n\
1415 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1416 (does not start with slash); if DEFAULT is nil or missing,\n\
1417 the current buffer's value of default-directory is used.\n\
1418 Filenames containing `.' or `..' as components are simplified;\n\
1419 initial `~/' expands to your home directory.\n\
1420 See also the function `substitute-in-file-name'.")
1422 Lisp_Object name
, defalt
;
1426 register unsigned char *newdir
, *p
, *o
;
1428 unsigned char *target
;
1432 unsigned char * colon
= 0;
1433 unsigned char * close
= 0;
1434 unsigned char * slash
= 0;
1435 unsigned char * brack
= 0;
1436 int lbrack
= 0, rbrack
= 0;
1440 CHECK_STRING (name
, 0);
1443 /* Filenames on VMS are always upper case. */
1444 name
= Fupcase (name
);
1447 nm
= XSTRING (name
)->data
;
1449 /* If nm is absolute, flush ...// and detect /./ and /../.
1450 If no /./ or /../ we can return right away. */
1462 if (p
[0] == '/' && p
[1] == '/'
1464 /* // at start of filename is meaningful on Apollo system */
1469 if (p
[0] == '/' && p
[1] == '~')
1470 nm
= p
+ 1, lose
= 1;
1471 if (p
[0] == '/' && p
[1] == '.'
1472 && (p
[2] == '/' || p
[2] == 0
1473 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1479 /* if dev:[dir]/, move nm to / */
1480 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1481 nm
= (brack
? brack
+ 1 : colon
+ 1);
1482 lbrack
= rbrack
= 0;
1490 /* VMS pre V4.4,convert '-'s in filenames. */
1491 if (lbrack
== rbrack
)
1493 if (dots
< 2) /* this is to allow negative version numbers */
1498 if (lbrack
> rbrack
&&
1499 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1500 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1506 /* count open brackets, reset close bracket pointer */
1507 if (p
[0] == '[' || p
[0] == '<')
1508 lbrack
++, brack
= 0;
1509 /* count close brackets, set close bracket pointer */
1510 if (p
[0] == ']' || p
[0] == '>')
1511 rbrack
++, brack
= p
;
1512 /* detect ][ or >< */
1513 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1515 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1516 nm
= p
+ 1, lose
= 1;
1517 if (p
[0] == ':' && (colon
|| slash
))
1518 /* if dev1:[dir]dev2:, move nm to dev2: */
1524 /* If /name/dev:, move nm to dev: */
1527 /* If node::dev:, move colon following dev */
1528 else if (colon
&& colon
[-1] == ':')
1530 /* If dev1:dev2:, move nm to dev2: */
1531 else if (colon
&& colon
[-1] != ':')
1536 if (p
[0] == ':' && !colon
)
1542 if (lbrack
== rbrack
)
1545 else if (p
[0] == '.')
1553 if (index (nm
, '/'))
1554 return build_string (sys_translate_unix (nm
));
1556 if (nm
== XSTRING (name
)->data
)
1558 return build_string (nm
);
1562 /* Now determine directory to start with and put it in NEWDIR */
1566 if (nm
[0] == '~') /* prefix ~ */
1571 || nm
[1] == 0)/* ~/filename */
1573 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1574 newdir
= (unsigned char *) "";
1577 nm
++; /* Don't leave the slash in nm. */
1580 else /* ~user/filename */
1582 /* Get past ~ to user */
1583 unsigned char *user
= nm
+ 1;
1584 /* Find end of name. */
1585 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1586 int len
= ptr
? ptr
- user
: strlen (user
);
1588 unsigned char *ptr1
= index (user
, ':');
1589 if (ptr1
!= 0 && ptr1
- user
< len
)
1592 /* Copy the user name into temp storage. */
1593 o
= (unsigned char *) alloca (len
+ 1);
1594 bcopy ((char *) user
, o
, len
);
1597 /* Look up the user name. */
1598 pw
= (struct passwd
*) getpwnam (o
+ 1);
1600 error ("\"%s\" isn't a registered user", o
+ 1);
1602 newdir
= (unsigned char *) pw
->pw_dir
;
1604 /* Discard the user name from NM. */
1611 #endif /* not VMS */
1615 defalt
= current_buffer
->directory
;
1616 CHECK_STRING (defalt
, 1);
1617 newdir
= XSTRING (defalt
)->data
;
1620 /* Now concatenate the directory and name to new space in the stack frame */
1622 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1623 target
= (unsigned char *) alloca (tlen
);
1629 if (nm
[0] == 0 || nm
[0] == '/')
1630 strcpy (target
, newdir
);
1633 file_name_as_directory (target
, newdir
);
1636 strcat (target
, nm
);
1638 if (index (target
, '/'))
1639 strcpy (target
, sys_translate_unix (target
));
1642 /* Now canonicalize by removing /. and /foo/.. if they appear */
1650 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1656 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1657 /* brackets are offset from each other by 2 */
1660 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1661 /* convert [foo][bar] to [bar] */
1662 while (o
[-1] != '[' && o
[-1] != '<')
1664 else if (*p
== '-' && *o
!= '.')
1667 else if (p
[0] == '-' && o
[-1] == '.' &&
1668 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1669 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1673 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1674 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1676 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1678 /* else [foo.-] ==> [-] */
1684 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1685 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1695 else if (!strncmp (p
, "//", 2)
1697 /* // at start of filename is meaningful in Apollo system */
1705 else if (p
[0] == '/' && p
[1] == '.' &&
1706 (p
[2] == '/' || p
[2] == 0))
1708 else if (!strncmp (p
, "/..", 3)
1709 /* `/../' is the "superroot" on certain file systems. */
1711 && (p
[3] == '/' || p
[3] == 0))
1713 while (o
!= target
&& *--o
!= '/')
1716 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1720 if (o
== target
&& *o
== '/')
1728 #endif /* not VMS */
1731 return make_string (target
, o
- target
);
1735 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1736 Ssubstitute_in_file_name
, 1, 1, 0,
1737 "Substitute environment variables referred to in FILENAME.\n\
1738 `$FOO' where FOO is an environment variable name means to substitute\n\
1739 the value of that variable. The variable name should be terminated\n\
1740 with a character not a letter, digit or underscore; otherwise, enclose\n\
1741 the entire variable name in braces.\n\
1742 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1743 On VMS, `$' substitution is not done; this function does little and only\n\
1744 duplicates what `expand-file-name' does.")
1746 Lisp_Object filename
;
1750 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1751 unsigned char *target
;
1753 int substituted
= 0;
1755 Lisp_Object handler
;
1757 CHECK_STRING (filename
, 0);
1759 /* If the file name has special constructs in it,
1760 call the corresponding file handler. */
1761 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1762 if (!NILP (handler
))
1763 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1765 nm
= XSTRING (filename
)->data
;
1767 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1768 CORRECT_DIR_SEPS (nm
);
1769 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1771 endp
= nm
+ XSTRING (filename
)->size
;
1773 /* If /~ or // appears, discard everything through first slash. */
1775 for (p
= nm
; p
!= endp
; p
++)
1778 #if defined (APOLLO) || defined (WINDOWSNT)
1779 /* // at start of file name is meaningful in Apollo and
1780 WindowsNT systems */
1781 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1782 #else /* not (APOLLO || WINDOWSNT) */
1783 || IS_DIRECTORY_SEP (p
[0])
1784 #endif /* not (APOLLO || WINDOWSNT) */
1789 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1791 || IS_DIRECTORY_SEP (p
[-1])))
1797 /* see comment in expand-file-name about drive specifiers */
1798 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1799 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1808 return build_string (nm
);
1811 /* See if any variables are substituted into the string
1812 and find the total length of their values in `total' */
1814 for (p
= nm
; p
!= endp
;)
1824 /* "$$" means a single "$" */
1833 while (p
!= endp
&& *p
!= '}') p
++;
1834 if (*p
!= '}') goto missingclose
;
1840 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1844 /* Copy out the variable name */
1845 target
= (unsigned char *) alloca (s
- o
+ 1);
1846 strncpy (target
, o
, s
- o
);
1849 strupr (target
); /* $home == $HOME etc. */
1852 /* Get variable value */
1853 o
= (unsigned char *) egetenv (target
);
1854 if (!o
) goto badvar
;
1855 total
+= strlen (o
);
1862 /* If substitution required, recopy the string and do it */
1863 /* Make space in stack frame for the new copy */
1864 xnm
= (unsigned char *) alloca (XSTRING (filename
)->size
+ total
+ 1);
1867 /* Copy the rest of the name through, replacing $ constructs with values */
1884 while (p
!= endp
&& *p
!= '}') p
++;
1885 if (*p
!= '}') goto missingclose
;
1891 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1895 /* Copy out the variable name */
1896 target
= (unsigned char *) alloca (s
- o
+ 1);
1897 strncpy (target
, o
, s
- o
);
1900 strupr (target
); /* $home == $HOME etc. */
1903 /* Get variable value */
1904 o
= (unsigned char *) egetenv (target
);
1914 /* If /~ or // appears, discard everything through first slash. */
1916 for (p
= xnm
; p
!= x
; p
++)
1918 #if defined (APOLLO) || defined (WINDOWSNT)
1919 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1920 #else /* not (APOLLO || WINDOWSNT) */
1921 || IS_DIRECTORY_SEP (p
[0])
1922 #endif /* not (APOLLO || WINDOWSNT) */
1924 && p
!= nm
&& IS_DIRECTORY_SEP (p
[-1]))
1927 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1928 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1932 return make_string (xnm
, x
- xnm
);
1935 error ("Bad format environment-variable substitution");
1937 error ("Missing \"}\" in environment-variable substitution");
1939 error ("Substituting nonexistent environment variable \"%s\"", target
);
1942 #endif /* not VMS */
1945 /* A slightly faster and more convenient way to get
1946 (directory-file-name (expand-file-name FOO)). */
1949 expand_and_dir_to_file (filename
, defdir
)
1950 Lisp_Object filename
, defdir
;
1952 register Lisp_Object absname
;
1954 absname
= Fexpand_file_name (filename
, defdir
);
1957 register int c
= XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1];
1958 if (c
== ':' || c
== ']' || c
== '>')
1959 absname
= Fdirectory_file_name (absname
);
1962 /* Remove final slash, if any (unless this is the root dir).
1963 stat behaves differently depending! */
1964 if (XSTRING (absname
)->size
> 1
1965 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1])
1966 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
-2]))
1967 /* We cannot take shortcuts; they might be wrong for magic file names. */
1968 absname
= Fdirectory_file_name (absname
);
1973 /* Signal an error if the file ABSNAME already exists.
1974 If INTERACTIVE is nonzero, ask the user whether to proceed,
1975 and bypass the error if the user says to go ahead.
1976 QUERYSTRING is a name for the action that is being considered
1978 *STATPTR is used to store the stat information if the file exists.
1979 If the file does not exist, STATPTR->st_mode is set to 0. */
1982 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
1983 Lisp_Object absname
;
1984 unsigned char *querystring
;
1986 struct stat
*statptr
;
1988 register Lisp_Object tem
;
1989 struct stat statbuf
;
1990 struct gcpro gcpro1
;
1992 /* stat is a good way to tell whether the file exists,
1993 regardless of what access permissions it has. */
1994 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1997 Fsignal (Qfile_already_exists
,
1998 Fcons (build_string ("File already exists"),
1999 Fcons (absname
, Qnil
)));
2001 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
2002 XSTRING (absname
)->data
, querystring
));
2005 Fsignal (Qfile_already_exists
,
2006 Fcons (build_string ("File already exists"),
2007 Fcons (absname
, Qnil
)));
2014 statptr
->st_mode
= 0;
2019 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2020 "fCopy file: \nFCopy %s to file: \np\nP",
2021 "Copy FILE to NEWNAME. Both args must be strings.\n\
2022 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2023 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2024 A number as third arg means request confirmation if NEWNAME already exists.\n\
2025 This is what happens in interactive use with M-x.\n\
2026 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2027 last-modified time as the old one. (This works on only some systems.)\n\
2028 A prefix arg makes KEEP-TIME non-nil.")
2029 (file
, newname
, ok_if_already_exists
, keep_date
)
2030 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2033 char buf
[16 * 1024];
2034 struct stat st
, out_st
;
2035 Lisp_Object handler
;
2036 struct gcpro gcpro1
, gcpro2
;
2037 int count
= specpdl_ptr
- specpdl
;
2038 int input_file_statable_p
;
2040 GCPRO2 (file
, newname
);
2041 CHECK_STRING (file
, 0);
2042 CHECK_STRING (newname
, 1);
2043 file
= Fexpand_file_name (file
, Qnil
);
2044 newname
= Fexpand_file_name (newname
, Qnil
);
2046 /* If the input file name has special constructs in it,
2047 call the corresponding file handler. */
2048 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2049 /* Likewise for output file name. */
2051 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2052 if (!NILP (handler
))
2053 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2054 ok_if_already_exists
, keep_date
));
2056 if (NILP (ok_if_already_exists
)
2057 || INTEGERP (ok_if_already_exists
))
2058 barf_or_query_if_file_exists (newname
, "copy to it",
2059 INTEGERP (ok_if_already_exists
), &out_st
);
2060 else if (stat (XSTRING (newname
)->data
, &out_st
) < 0)
2063 ifd
= open (XSTRING (file
)->data
, O_RDONLY
);
2065 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2067 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2069 /* We can only copy regular files and symbolic links. Other files are not
2071 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2073 #if !defined (MSDOS) || __DJGPP__ > 1
2074 if (out_st
.st_mode
!= 0
2075 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2078 report_file_error ("Input and output files are the same",
2079 Fcons (file
, Fcons (newname
, Qnil
)));
2083 #if defined (S_ISREG) && defined (S_ISLNK)
2084 if (input_file_statable_p
)
2086 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2088 #if defined (EISDIR)
2089 /* Get a better looking error message. */
2092 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2095 #endif /* S_ISREG && S_ISLNK */
2098 /* Create the copy file with the same record format as the input file */
2099 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
2102 /* System's default file type was set to binary by _fmode in emacs.c. */
2103 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
2104 #else /* not MSDOS */
2105 ofd
= creat (XSTRING (newname
)->data
, 0666);
2106 #endif /* not MSDOS */
2109 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2111 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2115 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2116 if (write (ofd
, buf
, n
) != n
)
2117 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2120 /* Closing the output clobbers the file times on some systems. */
2121 if (close (ofd
) < 0)
2122 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2124 if (input_file_statable_p
)
2126 if (!NILP (keep_date
))
2128 EMACS_TIME atime
, mtime
;
2129 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2130 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2131 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
2132 Fsignal (Qfile_date_error
,
2133 Fcons (build_string ("File already exists"),
2134 Fcons (newname
, Qnil
)));
2137 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2139 #if defined (__DJGPP__) && __DJGPP__ > 1
2140 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2141 and if it can't, it tells so. Otherwise, under MSDOS we usually
2142 get only the READ bit, which will make the copied file read-only,
2143 so it's better not to chmod at all. */
2144 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2145 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2146 #endif /* DJGPP version 2 or newer */
2152 /* Discard the unwind protects. */
2153 specpdl_ptr
= specpdl
+ count
;
2159 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2160 Smake_directory_internal
, 1, 1, 0,
2161 "Create a new directory named DIRECTORY.")
2163 Lisp_Object directory
;
2166 Lisp_Object handler
;
2168 CHECK_STRING (directory
, 0);
2169 directory
= Fexpand_file_name (directory
, Qnil
);
2171 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2172 if (!NILP (handler
))
2173 return call2 (handler
, Qmake_directory_internal
, directory
);
2175 dir
= XSTRING (directory
)->data
;
2178 if (mkdir (dir
) != 0)
2180 if (mkdir (dir
, 0777) != 0)
2182 report_file_error ("Creating directory", Flist (1, &directory
));
2187 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2188 "Delete the directory named DIRECTORY.")
2190 Lisp_Object directory
;
2193 Lisp_Object handler
;
2195 CHECK_STRING (directory
, 0);
2196 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2197 dir
= XSTRING (directory
)->data
;
2199 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2200 if (!NILP (handler
))
2201 return call2 (handler
, Qdelete_directory
, directory
);
2203 if (rmdir (dir
) != 0)
2204 report_file_error ("Removing directory", Flist (1, &directory
));
2209 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2210 "Delete file named FILENAME.\n\
2211 If file has multiple names, it continues to exist with the other names.")
2213 Lisp_Object filename
;
2215 Lisp_Object handler
;
2216 CHECK_STRING (filename
, 0);
2217 filename
= Fexpand_file_name (filename
, Qnil
);
2219 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2220 if (!NILP (handler
))
2221 return call2 (handler
, Qdelete_file
, filename
);
2223 if (0 > unlink (XSTRING (filename
)->data
))
2224 report_file_error ("Removing old name", Flist (1, &filename
));
2229 internal_delete_file_1 (ignore
)
2235 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2238 internal_delete_file (filename
)
2239 Lisp_Object filename
;
2241 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2242 Qt
, internal_delete_file_1
));
2245 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2246 "fRename file: \nFRename %s to file: \np",
2247 "Rename FILE as NEWNAME. Both args strings.\n\
2248 If file has names other than FILE, it continues to have those names.\n\
2249 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2250 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2251 A number as third arg means request confirmation if NEWNAME already exists.\n\
2252 This is what happens in interactive use with M-x.")
2253 (file
, newname
, ok_if_already_exists
)
2254 Lisp_Object file
, newname
, ok_if_already_exists
;
2257 Lisp_Object args
[2];
2259 Lisp_Object handler
;
2260 struct gcpro gcpro1
, gcpro2
;
2262 GCPRO2 (file
, newname
);
2263 CHECK_STRING (file
, 0);
2264 CHECK_STRING (newname
, 1);
2265 file
= Fexpand_file_name (file
, Qnil
);
2266 newname
= Fexpand_file_name (newname
, Qnil
);
2268 /* If the file name has special constructs in it,
2269 call the corresponding file handler. */
2270 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2272 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2273 if (!NILP (handler
))
2274 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2275 file
, newname
, ok_if_already_exists
));
2277 if (NILP (ok_if_already_exists
)
2278 || INTEGERP (ok_if_already_exists
))
2279 barf_or_query_if_file_exists (newname
, "rename to it",
2280 INTEGERP (ok_if_already_exists
), 0);
2282 if (0 > rename (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2284 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
)
2285 || 0 > unlink (XSTRING (file
)->data
))
2290 Fcopy_file (file
, newname
,
2291 /* We have already prompted if it was an integer,
2292 so don't have copy-file prompt again. */
2293 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2294 Fdelete_file (file
);
2301 report_file_error ("Renaming", Flist (2, args
));
2304 report_file_error ("Renaming", Flist (2, &file
));
2311 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2312 "fAdd name to file: \nFName to add to %s: \np",
2313 "Give FILE additional name NEWNAME. Both args strings.\n\
2314 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2315 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2316 A number as third arg means request confirmation if NEWNAME already exists.\n\
2317 This is what happens in interactive use with M-x.")
2318 (file
, newname
, ok_if_already_exists
)
2319 Lisp_Object file
, newname
, ok_if_already_exists
;
2322 Lisp_Object args
[2];
2324 Lisp_Object handler
;
2325 struct gcpro gcpro1
, gcpro2
;
2327 GCPRO2 (file
, newname
);
2328 CHECK_STRING (file
, 0);
2329 CHECK_STRING (newname
, 1);
2330 file
= Fexpand_file_name (file
, Qnil
);
2331 newname
= Fexpand_file_name (newname
, Qnil
);
2333 /* If the file name has special constructs in it,
2334 call the corresponding file handler. */
2335 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2336 if (!NILP (handler
))
2337 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2338 newname
, ok_if_already_exists
));
2340 /* If the new name has special constructs in it,
2341 call the corresponding file handler. */
2342 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2343 if (!NILP (handler
))
2344 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2345 newname
, ok_if_already_exists
));
2347 if (NILP (ok_if_already_exists
)
2348 || INTEGERP (ok_if_already_exists
))
2349 barf_or_query_if_file_exists (newname
, "make it a new name",
2350 INTEGERP (ok_if_already_exists
), 0);
2352 /* Windows does not support this operation. */
2353 report_file_error ("Adding new name", Flist (2, &file
));
2354 #else /* not WINDOWSNT */
2356 unlink (XSTRING (newname
)->data
);
2357 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2362 report_file_error ("Adding new name", Flist (2, args
));
2364 report_file_error ("Adding new name", Flist (2, &file
));
2367 #endif /* not WINDOWSNT */
2374 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2375 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2376 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2377 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2378 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2379 A number as third arg means request confirmation if LINKNAME already exists.\n\
2380 This happens for interactive use with M-x.")
2381 (filename
, linkname
, ok_if_already_exists
)
2382 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2385 Lisp_Object args
[2];
2387 Lisp_Object handler
;
2388 struct gcpro gcpro1
, gcpro2
;
2390 GCPRO2 (filename
, linkname
);
2391 CHECK_STRING (filename
, 0);
2392 CHECK_STRING (linkname
, 1);
2393 /* If the link target has a ~, we must expand it to get
2394 a truly valid file name. Otherwise, do not expand;
2395 we want to permit links to relative file names. */
2396 if (XSTRING (filename
)->data
[0] == '~')
2397 filename
= Fexpand_file_name (filename
, Qnil
);
2398 linkname
= Fexpand_file_name (linkname
, Qnil
);
2400 /* If the file name has special constructs in it,
2401 call the corresponding file handler. */
2402 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2403 if (!NILP (handler
))
2404 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2405 linkname
, ok_if_already_exists
));
2407 /* If the new link name has special constructs in it,
2408 call the corresponding file handler. */
2409 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2410 if (!NILP (handler
))
2411 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2412 linkname
, ok_if_already_exists
));
2414 if (NILP (ok_if_already_exists
)
2415 || INTEGERP (ok_if_already_exists
))
2416 barf_or_query_if_file_exists (linkname
, "make it a link",
2417 INTEGERP (ok_if_already_exists
), 0);
2418 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2420 /* If we didn't complain already, silently delete existing file. */
2421 if (errno
== EEXIST
)
2423 unlink (XSTRING (linkname
)->data
);
2424 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2434 report_file_error ("Making symbolic link", Flist (2, args
));
2436 report_file_error ("Making symbolic link", Flist (2, &filename
));
2442 #endif /* S_IFLNK */
2446 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2447 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2448 "Define the job-wide logical name NAME to have the value STRING.\n\
2449 If STRING is nil or a null string, the logical name NAME is deleted.")
2454 CHECK_STRING (name
, 0);
2456 delete_logical_name (XSTRING (name
)->data
);
2459 CHECK_STRING (string
, 1);
2461 if (XSTRING (string
)->size
== 0)
2462 delete_logical_name (XSTRING (name
)->data
);
2464 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2473 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2474 "Open a network connection to PATH using LOGIN as the login string.")
2476 Lisp_Object path
, login
;
2480 CHECK_STRING (path
, 0);
2481 CHECK_STRING (login
, 0);
2483 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2485 if (netresult
== -1)
2490 #endif /* HPUX_NET */
2492 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2494 "Return t if file FILENAME specifies an absolute file name.\n\
2495 On Unix, this is a name starting with a `/' or a `~'.")
2497 Lisp_Object filename
;
2501 CHECK_STRING (filename
, 0);
2502 ptr
= XSTRING (filename
)->data
;
2503 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2505 /* ??? This criterion is probably wrong for '<'. */
2506 || index (ptr
, ':') || index (ptr
, '<')
2507 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2511 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2519 /* Return nonzero if file FILENAME exists and can be executed. */
2522 check_executable (filename
)
2526 int len
= strlen (filename
);
2529 if (stat (filename
, &st
) < 0)
2531 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2532 return ((st
.st_mode
& S_IEXEC
) != 0);
2534 return (S_ISREG (st
.st_mode
)
2536 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2537 || stricmp (suffix
, ".exe") == 0
2538 || stricmp (suffix
, ".bat") == 0)
2539 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2540 #endif /* not WINDOWSNT */
2541 #else /* not DOS_NT */
2542 #ifdef HAVE_EUIDACCESS
2543 return (euidaccess (filename
, 1) >= 0);
2545 /* Access isn't quite right because it uses the real uid
2546 and we really want to test with the effective uid.
2547 But Unix doesn't give us a right way to do it. */
2548 return (access (filename
, 1) >= 0);
2550 #endif /* not DOS_NT */
2553 /* Return nonzero if file FILENAME exists and can be written. */
2556 check_writable (filename
)
2561 if (stat (filename
, &st
) < 0)
2563 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2564 #else /* not MSDOS */
2565 #ifdef HAVE_EUIDACCESS
2566 return (euidaccess (filename
, 2) >= 0);
2568 /* Access isn't quite right because it uses the real uid
2569 and we really want to test with the effective uid.
2570 But Unix doesn't give us a right way to do it.
2571 Opening with O_WRONLY could work for an ordinary file,
2572 but would lose for directories. */
2573 return (access (filename
, 2) >= 0);
2575 #endif /* not MSDOS */
2578 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2579 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2580 See also `file-readable-p' and `file-attributes'.")
2582 Lisp_Object filename
;
2584 Lisp_Object absname
;
2585 Lisp_Object handler
;
2586 struct stat statbuf
;
2588 CHECK_STRING (filename
, 0);
2589 absname
= Fexpand_file_name (filename
, Qnil
);
2591 /* If the file name has special constructs in it,
2592 call the corresponding file handler. */
2593 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2594 if (!NILP (handler
))
2595 return call2 (handler
, Qfile_exists_p
, absname
);
2597 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2600 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2601 "Return t if FILENAME can be executed by you.\n\
2602 For a directory, this means you can access files in that directory.")
2604 Lisp_Object filename
;
2607 Lisp_Object absname
;
2608 Lisp_Object handler
;
2610 CHECK_STRING (filename
, 0);
2611 absname
= Fexpand_file_name (filename
, Qnil
);
2613 /* If the file name has special constructs in it,
2614 call the corresponding file handler. */
2615 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2616 if (!NILP (handler
))
2617 return call2 (handler
, Qfile_executable_p
, absname
);
2619 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2622 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2623 "Return t if file FILENAME exists and you can read it.\n\
2624 See also `file-exists-p' and `file-attributes'.")
2626 Lisp_Object filename
;
2628 Lisp_Object absname
;
2629 Lisp_Object handler
;
2632 struct stat statbuf
;
2634 CHECK_STRING (filename
, 0);
2635 absname
= Fexpand_file_name (filename
, Qnil
);
2637 /* If the file name has special constructs in it,
2638 call the corresponding file handler. */
2639 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2640 if (!NILP (handler
))
2641 return call2 (handler
, Qfile_readable_p
, absname
);
2644 /* Under MS-DOS and Windows, open does not work for directories. */
2645 if (access (XSTRING (absname
)->data
, 0) == 0)
2648 #else /* not DOS_NT */
2650 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2651 /* Opening a fifo without O_NONBLOCK can wait.
2652 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2653 except in the case of a fifo, on a system which handles it. */
2654 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2657 if (S_ISFIFO (statbuf
.st_mode
))
2658 flags
|= O_NONBLOCK
;
2660 desc
= open (XSTRING (absname
)->data
, flags
);
2665 #endif /* not DOS_NT */
2668 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2670 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2671 "Return t if file FILENAME can be written or created by you.")
2673 Lisp_Object filename
;
2675 Lisp_Object absname
, dir
;
2676 Lisp_Object handler
;
2677 struct stat statbuf
;
2679 CHECK_STRING (filename
, 0);
2680 absname
= Fexpand_file_name (filename
, Qnil
);
2682 /* If the file name has special constructs in it,
2683 call the corresponding file handler. */
2684 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2685 if (!NILP (handler
))
2686 return call2 (handler
, Qfile_writable_p
, absname
);
2688 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2689 return (check_writable (XSTRING (absname
)->data
)
2691 dir
= Ffile_name_directory (absname
);
2694 dir
= Fdirectory_file_name (dir
);
2698 dir
= Fdirectory_file_name (dir
);
2700 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2704 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2705 "Access file FILENAME, and get an error if that does not work.\n\
2706 The second argument STRING is used in the error message.\n\
2707 If there is no error, we return nil.")
2709 Lisp_Object filename
, string
;
2711 Lisp_Object handler
;
2714 CHECK_STRING (filename
, 0);
2716 /* If the file name has special constructs in it,
2717 call the corresponding file handler. */
2718 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2719 if (!NILP (handler
))
2720 return call3 (handler
, Qaccess_file
, filename
, string
);
2722 fd
= open (XSTRING (filename
)->data
, O_RDONLY
);
2724 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2730 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2731 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2732 The value is the name of the file to which it is linked.\n\
2733 Otherwise returns nil.")
2735 Lisp_Object filename
;
2742 Lisp_Object handler
;
2744 CHECK_STRING (filename
, 0);
2745 filename
= Fexpand_file_name (filename
, Qnil
);
2747 /* If the file name has special constructs in it,
2748 call the corresponding file handler. */
2749 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2750 if (!NILP (handler
))
2751 return call2 (handler
, Qfile_symlink_p
, filename
);
2756 buf
= (char *) xmalloc (bufsize
);
2757 bzero (buf
, bufsize
);
2758 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2759 if (valsize
< bufsize
) break;
2760 /* Buffer was not long enough */
2769 val
= make_string (buf
, valsize
);
2772 #else /* not S_IFLNK */
2774 #endif /* not S_IFLNK */
2777 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2778 "Return t if file FILENAME is the name of a directory as a file.\n\
2779 A directory name spec may be given instead; then the value is t\n\
2780 if the directory so specified exists and really is a directory.")
2782 Lisp_Object filename
;
2784 register Lisp_Object absname
;
2786 Lisp_Object handler
;
2788 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2790 /* If the file name has special constructs in it,
2791 call the corresponding file handler. */
2792 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2793 if (!NILP (handler
))
2794 return call2 (handler
, Qfile_directory_p
, absname
);
2796 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2798 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2801 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2802 "Return t if file FILENAME is the name of a directory as a file,\n\
2803 and files in that directory can be opened by you. In order to use a\n\
2804 directory as a buffer's current directory, this predicate must return true.\n\
2805 A directory name spec may be given instead; then the value is t\n\
2806 if the directory so specified exists and really is a readable and\n\
2807 searchable directory.")
2809 Lisp_Object filename
;
2811 Lisp_Object handler
;
2813 struct gcpro gcpro1
;
2815 /* If the file name has special constructs in it,
2816 call the corresponding file handler. */
2817 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2818 if (!NILP (handler
))
2819 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2821 /* It's an unlikely combination, but yes we really do need to gcpro:
2822 Suppose that file-accessible-directory-p has no handler, but
2823 file-directory-p does have a handler; this handler causes a GC which
2824 relocates the string in `filename'; and finally file-directory-p
2825 returns non-nil. Then we would end up passing a garbaged string
2826 to file-executable-p. */
2828 tem
= (NILP (Ffile_directory_p (filename
))
2829 || NILP (Ffile_executable_p (filename
)));
2831 return tem
? Qnil
: Qt
;
2834 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2835 "Return t if file FILENAME is the name of a regular file.\n\
2836 This is the sort of file that holds an ordinary stream of data bytes.")
2838 Lisp_Object filename
;
2840 register Lisp_Object absname
;
2842 Lisp_Object handler
;
2844 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2846 /* If the file name has special constructs in it,
2847 call the corresponding file handler. */
2848 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2849 if (!NILP (handler
))
2850 return call2 (handler
, Qfile_regular_p
, absname
);
2852 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2854 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2857 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2858 "Return mode bits of file named FILENAME, as an integer.")
2860 Lisp_Object filename
;
2862 Lisp_Object absname
;
2864 Lisp_Object handler
;
2866 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2868 /* If the file name has special constructs in it,
2869 call the corresponding file handler. */
2870 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2871 if (!NILP (handler
))
2872 return call2 (handler
, Qfile_modes
, absname
);
2874 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2876 #if defined (MSDOS) && __DJGPP__ < 2
2877 if (check_executable (XSTRING (absname
)->data
))
2878 st
.st_mode
|= S_IEXEC
;
2879 #endif /* MSDOS && __DJGPP__ < 2 */
2881 return make_number (st
.st_mode
& 07777);
2884 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2885 "Set mode bits of file named FILENAME to MODE (an integer).\n\
2886 Only the 12 low bits of MODE are used.")
2888 Lisp_Object filename
, mode
;
2890 Lisp_Object absname
;
2891 Lisp_Object handler
;
2893 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2894 CHECK_NUMBER (mode
, 1);
2896 /* If the file name has special constructs in it,
2897 call the corresponding file handler. */
2898 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2899 if (!NILP (handler
))
2900 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2902 if (chmod (XSTRING (absname
)->data
, XINT (mode
)) < 0)
2903 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2908 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2909 "Set the file permission bits for newly created files.\n\
2910 The argument MODE should be an integer; only the low 9 bits are used.\n\
2911 This setting is inherited by subprocesses.")
2915 CHECK_NUMBER (mode
, 0);
2917 umask ((~ XINT (mode
)) & 0777);
2922 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2923 "Return the default file protection for created files.\n\
2924 The value is an integer.")
2930 realmask
= umask (0);
2933 XSETINT (value
, (~ realmask
) & 0777);
2939 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2940 "Tell Unix to finish all pending disk updates.")
2949 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2950 "Return t if file FILE1 is newer than file FILE2.\n\
2951 If FILE1 does not exist, the answer is nil;\n\
2952 otherwise, if FILE2 does not exist, the answer is t.")
2954 Lisp_Object file1
, file2
;
2956 Lisp_Object absname1
, absname2
;
2959 Lisp_Object handler
;
2960 struct gcpro gcpro1
, gcpro2
;
2962 CHECK_STRING (file1
, 0);
2963 CHECK_STRING (file2
, 0);
2966 GCPRO2 (absname1
, file2
);
2967 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2968 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2971 /* If the file name has special constructs in it,
2972 call the corresponding file handler. */
2973 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
2975 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
2976 if (!NILP (handler
))
2977 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
2979 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
2982 mtime1
= st
.st_mtime
;
2984 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
2987 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2991 Lisp_Object Qfind_buffer_file_type
;
2994 #ifndef READ_BUF_SIZE
2995 #define READ_BUF_SIZE (64 << 10)
2998 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3000 "Insert contents of file FILENAME after point.\n\
3001 Returns list of absolute file name and length of data inserted.\n\
3002 If second argument VISIT is non-nil, the buffer's visited filename\n\
3003 and last save file modtime are set, and it is marked unmodified.\n\
3004 If visiting and the file does not exist, visiting is completed\n\
3005 before the error is signaled.\n\
3006 The optional third and fourth arguments BEG and END\n\
3007 specify what portion of the file to insert.\n\
3008 If VISIT is non-nil, BEG and END must be nil.\n\
3010 If optional fifth argument REPLACE is non-nil,\n\
3011 it means replace the current buffer contents (in the accessible portion)\n\
3012 with the file contents. This is better than simply deleting and inserting\n\
3013 the whole thing because (1) it preserves some marker positions\n\
3014 and (2) it puts less data in the undo list.\n\
3015 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3016 which is often less than the number of characters to be read.\n\
3017 This does code conversion according to the value of\n\
3018 `coding-system-for-read' or `coding-system-alist', and sets the variable\n\
3019 `last-coding-system-used' to the coding system actually used.")
3020 (filename
, visit
, beg
, end
, replace
)
3021 Lisp_Object filename
, visit
, beg
, end
, replace
;
3025 register int inserted
= 0;
3026 register int how_much
;
3027 register int unprocessed
;
3028 int count
= specpdl_ptr
- specpdl
;
3029 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3030 Lisp_Object handler
, val
, insval
;
3033 int not_regular
= 0;
3034 char read_buf
[READ_BUF_SIZE
];
3035 struct coding_system coding
;
3036 unsigned char buffer
[1 << 14];
3038 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3039 error ("Cannot do file visiting in an indirect buffer");
3041 if (!NILP (current_buffer
->read_only
))
3042 Fbarf_if_buffer_read_only ();
3047 GCPRO3 (filename
, val
, p
);
3049 CHECK_STRING (filename
, 0);
3050 filename
= Fexpand_file_name (filename
, Qnil
);
3052 /* If the file name has special constructs in it,
3053 call the corresponding file handler. */
3054 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3055 if (!NILP (handler
))
3057 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3058 visit
, beg
, end
, replace
);
3062 /* Decide the coding-system of the file. */
3064 Lisp_Object val
= Vcoding_system_for_read
;
3065 if (NILP (current_buffer
->enable_multibyte_characters
))
3067 else if (NILP (val
))
3069 Lisp_Object args
[6], coding_systems
;
3071 args
[0] = Qinsert_file_contents
, args
[1] = filename
, args
[2] = visit
,
3072 args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3073 coding_systems
= Ffind_coding_system (6, args
);
3074 val
= CONSP (coding_systems
) ? XCONS (coding_systems
)->car
: Qnil
;
3076 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3082 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3084 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3085 || fstat (fd
, &st
) < 0)
3086 #endif /* not APOLLO */
3088 if (fd
>= 0) close (fd
);
3091 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3098 /* This code will need to be changed in order to work on named
3099 pipes, and it's probably just not worth it. So we should at
3100 least signal an error. */
3101 if (!S_ISREG (st
.st_mode
))
3104 Fsignal (Qfile_error
,
3105 Fcons (build_string ("not a regular file"),
3106 Fcons (filename
, Qnil
)));
3114 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3117 /* Replacement should preserve point as it preserves markers. */
3118 if (!NILP (replace
))
3119 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3121 record_unwind_protect (close_file_unwind
, make_number (fd
));
3123 /* Supposedly happens on VMS. */
3125 error ("File size is negative");
3127 if (!NILP (beg
) || !NILP (end
))
3129 error ("Attempt to visit less than an entire file");
3132 CHECK_NUMBER (beg
, 0);
3134 XSETFASTINT (beg
, 0);
3137 CHECK_NUMBER (end
, 0);
3140 XSETINT (end
, st
.st_size
);
3141 if (XINT (end
) != st
.st_size
)
3142 error ("maximum buffer size exceeded");
3145 /* Try to determine the character coding now,
3146 hoping we can recognize that no coding is used
3147 and thus enable the REPLACE feature to work. */
3148 if (!NILP (replace
) && (coding
.type
== coding_type_automatic
3149 || coding
.eol_type
== CODING_EOL_AUTOMATIC
))
3153 nread
= read (fd
, buffer
, sizeof buffer
);
3155 error ("IO error reading %s: %s",
3156 XSTRING (filename
)->data
, strerror (errno
));
3159 if (coding
.type
== coding_type_automatic
)
3160 detect_coding (&coding
, buffer
, nread
);
3161 if (coding
.eol_type
== CODING_EOL_AUTOMATIC
)
3162 detect_eol (&coding
, buffer
, nread
);
3163 if (lseek (fd
, 0, 0) < 0)
3164 report_file_error ("Setting file position",
3165 Fcons (filename
, Qnil
));
3166 /* If we still haven't found anything other than
3167 "automatic", change to "no conversion"
3168 so that the replace feature will work. */
3169 if (coding
.type
== coding_type_automatic
)
3170 coding
.type
= coding_type_no_conversion
;
3171 if (coding
.eol_type
== CODING_EOL_AUTOMATIC
)
3172 coding
.eol_type
= CODING_EOL_LF
;
3176 /* If requested, replace the accessible part of the buffer
3177 with the file contents. Avoid replacing text at the
3178 beginning or end of the buffer that matches the file contents;
3179 that preserves markers pointing to the unchanged parts.
3181 Here we implement this feature in an optimized way
3182 for the case where code conversion is NOT needed.
3183 The following if-statement handles the case of conversion
3184 in a less optimal way. */
3186 && ! CODING_REQUIRE_CONVERSION (&coding
))
3188 int same_at_start
= BEGV
;
3189 int same_at_end
= ZV
;
3191 /* There is still a possibility we will find the need to do code
3192 conversion. If that happens, we set this variable to 1 to
3193 give up on the REPLACE feature. */
3194 int giveup_match_end
= 0;
3196 if (XINT (beg
) != 0)
3198 if (lseek (fd
, XINT (beg
), 0) < 0)
3199 report_file_error ("Setting file position",
3200 Fcons (filename
, Qnil
));
3205 /* Count how many chars at the start of the file
3206 match the text at the beginning of the buffer. */
3211 nread
= read (fd
, buffer
, sizeof buffer
);
3213 error ("IO error reading %s: %s",
3214 XSTRING (filename
)->data
, strerror (errno
));
3215 else if (nread
== 0)
3219 while (bufpos
< nread
&& same_at_start
< ZV
3220 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3221 same_at_start
++, bufpos
++;
3222 /* If we found a discrepancy, stop the scan.
3223 Otherwise loop around and scan the next bufferful. */
3224 if (bufpos
!= nread
)
3228 /* If the file matches the buffer completely,
3229 there's no need to replace anything. */
3230 if (same_at_start
- BEGV
== XINT (end
))
3234 /* Truncate the buffer to the size of the file. */
3235 del_range_1 (same_at_start
, same_at_end
, 0);
3240 /* Count how many chars at the end of the file
3241 match the text at the end of the buffer. But, if we have
3242 already found that decoding is necessary, don't waste time. */
3243 while (!giveup_match_end
)
3245 int total_read
, nread
, bufpos
, curpos
, trial
;
3247 /* At what file position are we now scanning? */
3248 curpos
= XINT (end
) - (ZV
- same_at_end
);
3249 /* If the entire file matches the buffer tail, stop the scan. */
3252 /* How much can we scan in the next step? */
3253 trial
= min (curpos
, sizeof buffer
);
3254 if (lseek (fd
, curpos
- trial
, 0) < 0)
3255 report_file_error ("Setting file position",
3256 Fcons (filename
, Qnil
));
3259 while (total_read
< trial
)
3261 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3263 error ("IO error reading %s: %s",
3264 XSTRING (filename
)->data
, strerror (errno
));
3265 total_read
+= nread
;
3267 /* Scan this bufferful from the end, comparing with
3268 the Emacs buffer. */
3269 bufpos
= total_read
;
3270 /* Compare with same_at_start to avoid counting some buffer text
3271 as matching both at the file's beginning and at the end. */
3272 while (bufpos
> 0 && same_at_end
> same_at_start
3273 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3274 same_at_end
--, bufpos
--;
3275 /* If we found a discrepancy, stop the scan.
3276 Otherwise loop around and scan the preceding bufferful. */
3282 /* Don't try to reuse the same piece of text twice. */
3283 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3285 same_at_end
+= overlap
;
3287 /* Arrange to read only the nonmatching middle part of the file. */
3288 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV
));
3289 XSETFASTINT (end
, XINT (end
) - (ZV
- same_at_end
));
3291 del_range_1 (same_at_start
, same_at_end
, 0);
3292 /* Insert from the file at the proper position. */
3293 SET_PT (same_at_start
);
3295 /* If display currently starts at beginning of line,
3296 keep it that way. */
3297 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3298 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3301 /* If requested, replace the accessible part of the buffer
3302 with the file contents. Avoid replacing text at the
3303 beginning or end of the buffer that matches the file contents;
3304 that preserves markers pointing to the unchanged parts.
3306 Here we implement this feature for the case where code conversion
3307 is needed, in a simple way that needs a lot of memory.
3308 The preceding if-statement handles the case of no conversion
3309 in a more optimized way. */
3310 if (!NILP (replace
) && CODING_REQUIRE_CONVERSION (&coding
))
3312 int same_at_start
= BEGV
;
3313 int same_at_end
= ZV
;
3316 /* Make sure that the gap is large enough. */
3317 int bufsize
= 2 * st
.st_size
;
3318 unsigned char *conversion_buffer
= (unsigned char *) malloc (bufsize
);
3320 /* First read the whole file, performing code conversion into
3321 CONVERSION_BUFFER. */
3323 total
= st
.st_size
; /* Total bytes in the file. */
3324 how_much
= 0; /* Bytes read from file so far. */
3325 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3326 unprocessed
= 0; /* Bytes not processed in previous loop. */
3328 while (how_much
< total
)
3330 /* try is reserved in some compilers (Microsoft C) */
3331 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3332 char *destination
= read_buf
+ unprocessed
;
3335 /* Allow quitting out of the actual I/O. */
3338 this = read (fd
, destination
, trytry
);
3341 if (this < 0 || this + unprocessed
== 0)
3349 if (CODING_REQUIRE_CONVERSION (&coding
))
3351 int require
, produced
, consumed
;
3353 this += unprocessed
;
3355 /* If we are using more space than estimated,
3356 make CONVERSION_BUFFER bigger. */
3357 require
= decoding_buffer_size (&coding
, this);
3358 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3360 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3361 conversion_buffer
= (unsigned char *) realloc (conversion_buffer
, bufsize
);
3364 /* Convert this batch with results in CONVERSION_BUFFER. */
3365 if (how_much
>= total
) /* This is the last block. */
3366 coding
.last_block
= 1;
3367 produced
= decode_coding (&coding
, read_buf
,
3368 conversion_buffer
+ inserted
,
3369 this, bufsize
- inserted
,
3372 /* Save for next iteration whatever we didn't convert. */
3373 unprocessed
= this - consumed
;
3374 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3381 /* At this point, INSERTED is how many characters
3382 are present in CONVERSION_BUFFER.
3383 HOW_MUCH should equal TOTAL,
3384 or should be <= 0 if we couldn't read the file. */
3388 free (conversion_buffer
);
3391 error ("IO error reading %s: %s",
3392 XSTRING (filename
)->data
, strerror (errno
));
3393 else if (how_much
== -2)
3394 error ("maximum buffer size exceeded");
3397 /* Compare the beginning of the converted file
3398 with the buffer text. */
3401 while (bufpos
< inserted
&& same_at_start
< same_at_end
3402 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3403 same_at_start
++, bufpos
++;
3405 /* If the file matches the buffer completely,
3406 there's no need to replace anything. */
3408 if (bufpos
== inserted
)
3410 free (conversion_buffer
);
3413 /* Truncate the buffer to the size of the file. */
3414 del_range_1 (same_at_start
, same_at_end
, 0);
3418 /* Scan this bufferful from the end, comparing with
3419 the Emacs buffer. */
3422 /* Compare with same_at_start to avoid counting some buffer text
3423 as matching both at the file's beginning and at the end. */
3424 while (bufpos
> 0 && same_at_end
> same_at_start
3425 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3426 same_at_end
--, bufpos
--;
3428 /* Don't try to reuse the same piece of text twice. */
3429 overlap
= same_at_start
- BEGV
- (same_at_end
+ inserted
- ZV
);
3431 same_at_end
+= overlap
;
3433 /* Replace the chars that we need to replace,
3434 and update INSERTED to equal the number of bytes
3435 we are taking from the file. */
3436 inserted
-= (Z
- same_at_end
) + (same_at_start
- BEG
);
3437 move_gap (same_at_start
);
3438 del_range_1 (same_at_start
, same_at_end
, 0);
3439 make_gap (inserted
);
3440 insert (conversion_buffer
+ same_at_start
- BEG
, inserted
);
3442 free (conversion_buffer
);
3446 /* If display currently starts at beginning of line,
3447 keep it that way. */
3448 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3449 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3453 total
= XINT (end
) - XINT (beg
);
3456 register Lisp_Object temp
;
3458 /* Make sure point-max won't overflow after this insertion. */
3459 XSETINT (temp
, total
);
3460 if (total
!= XINT (temp
))
3461 error ("maximum buffer size exceeded");
3464 if (NILP (visit
) && total
> 0)
3465 prepare_to_modify_buffer (PT
, PT
);
3468 if (GAP_SIZE
< total
)
3469 make_gap (total
- GAP_SIZE
);
3471 if (XINT (beg
) != 0 || !NILP (replace
))
3473 if (lseek (fd
, XINT (beg
), 0) < 0)
3474 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3477 /* In the following loop, HOW_MUCH contains the total bytes read so
3478 far. Before exiting the loop, it is set to -1 if I/O error
3479 occurs, set to -2 if the maximum buffer size is exceeded. */
3481 /* Total bytes inserted. */
3483 /* Bytes not processed in the previous loop because short gap size. */
3485 while (how_much
< total
)
3487 /* try is reserved in some compilers (Microsoft C) */
3488 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3489 char *destination
= (CODING_REQUIRE_CONVERSION (&coding
)
3490 ? read_buf
+ unprocessed
3491 : (char *) (POS_ADDR (PT
+ inserted
- 1) + 1));
3494 /* Allow quitting out of the actual I/O. */
3497 this = read (fd
, destination
, trytry
);
3500 if (this < 0 || this + unprocessed
== 0)
3508 if (CODING_REQUIRE_CONVERSION (&coding
))
3510 int require
, produced
, consumed
;
3512 this += unprocessed
;
3513 /* Make sure that the gap is large enough. */
3514 require
= decoding_buffer_size (&coding
, this);
3515 if (GAP_SIZE
< require
)
3516 make_gap (require
- GAP_SIZE
);
3517 if (how_much
>= total
) /* This is the last block. */
3518 coding
.last_block
= 1;
3519 produced
= decode_coding (&coding
, read_buf
,
3520 POS_ADDR (PT
+ inserted
- 1) + 1,
3521 this, GAP_SIZE
, &consumed
);
3526 XSET (temp
, Lisp_Int
, Z
+ produced
);
3527 if (Z
+ produced
!= XINT (temp
))
3533 unprocessed
= this - consumed
;
3534 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3543 /* Put an anchor to ensure multi-byte form ends at gap. */
3548 /* We don't have to consider file type of MSDOS because all files
3549 are read as binary and end-of-line format has already been
3550 decoded appropriately. */
3553 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3554 /* Determine file type from name and remove LFs from CR-LFs if the file
3555 is deemed to be a text file. */
3557 current_buffer
->buffer_file_type
3558 = call1 (Qfind_buffer_file_type
, filename
);
3559 if (NILP (current_buffer
->buffer_file_type
))
3562 = inserted
- crlf_to_lf (inserted
, POS_ADDR (PT
- 1) + 1);
3565 GPT
-= reduced_size
;
3566 GAP_SIZE
+= reduced_size
;
3567 inserted
-= reduced_size
;
3575 record_insert (PT
, inserted
);
3577 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3578 offset_intervals (current_buffer
, PT
, inserted
);
3584 /* Discard the unwind protect for closing the file. */
3588 error ("IO error reading %s: %s",
3589 XSTRING (filename
)->data
, strerror (errno
));
3590 else if (how_much
== -2)
3591 error ("maximum buffer size exceeded");
3598 if (!EQ (current_buffer
->undo_list
, Qt
))
3599 current_buffer
->undo_list
= Qnil
;
3601 stat (XSTRING (filename
)->data
, &st
);
3606 current_buffer
->modtime
= st
.st_mtime
;
3607 current_buffer
->filename
= filename
;
3610 SAVE_MODIFF
= MODIFF
;
3611 current_buffer
->auto_save_modified
= MODIFF
;
3612 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3613 #ifdef CLASH_DETECTION
3616 if (!NILP (current_buffer
->file_truename
))
3617 unlock_file (current_buffer
->file_truename
);
3618 unlock_file (filename
);
3620 #endif /* CLASH_DETECTION */
3622 Fsignal (Qfile_error
,
3623 Fcons (build_string ("not a regular file"),
3624 Fcons (filename
, Qnil
)));
3626 /* If visiting nonexistent file, return nil. */
3627 if (current_buffer
->modtime
== -1)
3628 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3631 /* Decode file format */
3634 insval
= call3 (Qformat_decode
,
3635 Qnil
, make_number (inserted
), visit
);
3636 CHECK_NUMBER (insval
, 0);
3637 inserted
= XFASTINT (insval
);
3640 if (inserted
> 0 && NILP (visit
) && total
> 0)
3641 signal_after_change (PT
, 0, inserted
);
3645 p
= Vafter_insert_file_functions
;
3646 if (!NILP (coding
.post_read_conversion
))
3647 p
= Fcons (coding
.post_read_conversion
, p
);
3651 insval
= call1 (Fcar (p
), make_number (inserted
));
3654 CHECK_NUMBER (insval
, 0);
3655 inserted
= XFASTINT (insval
);
3663 val
= Fcons (filename
,
3664 Fcons (make_number (inserted
),
3667 RETURN_UNGCPRO (unbind_to (count
, val
));
3670 static Lisp_Object
build_annotations ();
3672 /* If build_annotations switched buffers, switch back to BUF.
3673 Kill the temporary buffer that was selected in the meantime.
3675 Since this kill only the last temporary buffer, some buffers remain
3676 not killed if build_annotations switched buffers more than once.
3680 build_annotations_unwind (buf
)
3685 if (XBUFFER (buf
) == current_buffer
)
3687 tembuf
= Fcurrent_buffer ();
3689 Fkill_buffer (tembuf
);
3693 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3694 "r\nFWrite region to file: ",
3695 "Write current region into specified file.\n\
3696 When called from a program, takes three arguments:\n\
3697 START, END and FILENAME. START and END are buffer positions.\n\
3698 Optional fourth argument APPEND if non-nil means\n\
3699 append to existing file contents (if any).\n\
3700 Optional fifth argument VISIT if t means\n\
3701 set the last-save-file-modtime of buffer to this file's modtime\n\
3702 and mark buffer not modified.\n\
3703 If VISIT is a string, it is a second file name;\n\
3704 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3705 VISIT is also the file name to lock and unlock for clash detection.\n\
3706 If VISIT is neither t nor nil nor a string,\n\
3707 that means do not print the \"Wrote file\" message.\n\
3708 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3709 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3710 Kludgy feature: if START is a string, then that string is written\n\
3711 to the file, instead of any buffer contents, and END is ignored.\n\
3712 This does code conversion according to the value of\n\
3713 `coding-system-for-write' or `coding-system-alist', and sets the variable\n\
3714 `last-coding-system-used' to the coding system actually used.")
3715 (start
, end
, filename
, append
, visit
, lockname
)
3716 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3724 int count
= specpdl_ptr
- specpdl
;
3727 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3729 Lisp_Object handler
;
3730 Lisp_Object visit_file
;
3731 Lisp_Object annotations
;
3732 int visiting
, quietly
;
3733 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3734 struct buffer
*given_buffer
;
3736 int buffer_file_type
3737 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3739 struct coding_system coding
;
3741 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3742 error ("Cannot do file visiting in an indirect buffer");
3744 if (!NILP (start
) && !STRINGP (start
))
3745 validate_region (&start
, &end
);
3747 GCPRO3 (filename
, visit
, lockname
);
3748 filename
= Fexpand_file_name (filename
, Qnil
);
3749 if (STRINGP (visit
))
3750 visit_file
= Fexpand_file_name (visit
, Qnil
);
3752 visit_file
= filename
;
3755 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3756 quietly
= !NILP (visit
);
3760 if (NILP (lockname
))
3761 lockname
= visit_file
;
3763 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3765 /* If the file name has special constructs in it,
3766 call the corresponding file handler. */
3767 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3768 /* If FILENAME has no handler, see if VISIT has one. */
3769 if (NILP (handler
) && STRINGP (visit
))
3770 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3772 if (!NILP (handler
))
3775 val
= call6 (handler
, Qwrite_region
, start
, end
,
3776 filename
, append
, visit
);
3780 SAVE_MODIFF
= MODIFF
;
3781 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3782 current_buffer
->filename
= visit_file
;
3788 /* Decide the coding-system to be encoded to. */
3792 if (auto_saving
|| NILP (current_buffer
->enable_multibyte_characters
))
3794 else if (!NILP (Vcoding_system_for_write
))
3795 val
= Vcoding_system_for_write
;
3796 else if (!NILP (Flocal_variable_if_set_p (Qbuffer_file_coding_system
,
3798 val
= Fsymbol_value (Qbuffer_file_coding_system
);
3801 Lisp_Object args
[7], coding_systems
;
3803 args
[0] = Qwrite_region
, args
[1] = start
, args
[2] = end
,
3804 args
[3] = filename
, args
[4] = append
, args
[5] = visit
,
3806 coding_systems
= Ffind_coding_system (7, args
);
3807 val
= (CONSP (coding_systems
)
3808 ? XCONS (coding_systems
)->cdr
3809 : Fsymbol_value (Qbuffer_file_coding_system
));
3811 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3812 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
3813 coding
.selective
= 1;
3815 if (!NILP (current_buffer
->buffer_file_type
))
3816 coding
.eol_type
= CODING_EOL_LF
;
3820 /* Special kludge to simplify auto-saving. */
3823 XSETFASTINT (start
, BEG
);
3824 XSETFASTINT (end
, Z
);
3827 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3828 count1
= specpdl_ptr
- specpdl
;
3830 given_buffer
= current_buffer
;
3831 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
3832 if (current_buffer
!= given_buffer
)
3838 #ifdef CLASH_DETECTION
3841 /* If we've locked this file for some other buffer,
3842 query before proceeding. */
3843 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
3844 call2 (intern ("ask-user-about-lock"), fn
, Vuser_login_name
);
3846 lock_file (lockname
);
3848 #endif /* CLASH_DETECTION */
3850 fn
= XSTRING (filename
)->data
;
3854 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3855 #else /* not DOS_NT */
3856 desc
= open (fn
, O_WRONLY
);
3857 #endif /* not DOS_NT */
3859 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
) )
3861 if (auto_saving
) /* Overwrite any previous version of autosave file */
3863 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3864 desc
= open (fn
, O_RDWR
);
3866 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3867 ? XSTRING (current_buffer
->filename
)->data
: 0,
3870 else /* Write to temporary name and rename if no errors */
3872 Lisp_Object temp_name
;
3873 temp_name
= Ffile_name_directory (filename
);
3875 if (!NILP (temp_name
))
3877 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3878 build_string ("$$SAVE$$")));
3879 fname
= XSTRING (filename
)->data
;
3880 fn
= XSTRING (temp_name
)->data
;
3881 desc
= creat_copy_attrs (fname
, fn
);
3884 /* If we can't open the temporary file, try creating a new
3885 version of the original file. VMS "creat" creates a
3886 new version rather than truncating an existing file. */
3889 desc
= creat (fn
, 0666);
3890 #if 0 /* This can clobber an existing file and fail to replace it,
3891 if the user runs out of space. */
3894 /* We can't make a new version;
3895 try to truncate and rewrite existing version if any. */
3897 desc
= open (fn
, O_RDWR
);
3903 desc
= creat (fn
, 0666);
3908 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3909 S_IREAD
| S_IWRITE
);
3910 #else /* not DOS_NT */
3911 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3912 #endif /* not DOS_NT */
3913 #endif /* not VMS */
3919 #ifdef CLASH_DETECTION
3921 if (!auto_saving
) unlock_file (lockname
);
3923 #endif /* CLASH_DETECTION */
3924 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3927 record_unwind_protect (close_file_unwind
, make_number (desc
));
3930 if (lseek (desc
, 0, 2) < 0)
3932 #ifdef CLASH_DETECTION
3933 if (!auto_saving
) unlock_file (lockname
);
3934 #endif /* CLASH_DETECTION */
3935 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3940 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3941 * if we do writes that don't end with a carriage return. Furthermore
3942 * it cannot handle writes of more then 16K. The modified
3943 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3944 * this EXCEPT for the last record (iff it doesn't end with a carriage
3945 * return). This implies that if your buffer doesn't end with a carriage
3946 * return, you get one free... tough. However it also means that if
3947 * we make two calls to sys_write (a la the following code) you can
3948 * get one at the gap as well. The easiest way to fix this (honest)
3949 * is to move the gap to the next newline (or the end of the buffer).
3954 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3955 move_gap (find_next_newline (GPT
, 1));
3961 if (STRINGP (start
))
3963 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3964 XSTRING (start
)->size
, 0, &annotations
, &coding
);
3967 else if (XINT (start
) != XINT (end
))
3970 if (XINT (start
) < GPT
)
3972 register int end1
= XINT (end
);
3974 failure
= 0 > a_write (desc
, POS_ADDR (tem
),
3975 min (GPT
, end1
) - tem
, tem
, &annotations
,
3977 nwritten
+= min (GPT
, end1
) - tem
;
3981 if (XINT (end
) > GPT
&& !failure
)
3984 tem
= max (tem
, GPT
);
3985 failure
= 0 > a_write (desc
, POS_ADDR (tem
), XINT (end
) - tem
,
3986 tem
, &annotations
, &coding
);
3987 nwritten
+= XINT (end
) - tem
;
3993 /* If file was empty, still need to write the annotations */
3994 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
3998 if (coding
.require_flushing
)
4000 /* We have to flush out a data. */
4001 coding
.last_block
= 1;
4002 failure
= 0 > e_write (desc
, "", 0, &coding
);
4009 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4010 Disk full in NFS may be reported here. */
4011 /* mib says that closing the file will try to write as fast as NFS can do
4012 it, and that means the fsync here is not crucial for autosave files. */
4013 if (!auto_saving
&& fsync (desc
) < 0)
4015 /* If fsync fails with EINTR, don't treat that as serious. */
4017 failure
= 1, save_errno
= errno
;
4021 /* Spurious "file has changed on disk" warnings have been
4022 observed on Suns as well.
4023 It seems that `close' can change the modtime, under nfs.
4025 (This has supposedly been fixed in Sunos 4,
4026 but who knows about all the other machines with NFS?) */
4029 /* On VMS and APOLLO, must do the stat after the close
4030 since closing changes the modtime. */
4033 /* Recall that #if defined does not work on VMS. */
4040 /* NFS can report a write failure now. */
4041 if (close (desc
) < 0)
4042 failure
= 1, save_errno
= errno
;
4045 /* If we wrote to a temporary name and had no errors, rename to real name. */
4049 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4057 /* Discard the unwind protect for close_file_unwind. */
4058 specpdl_ptr
= specpdl
+ count1
;
4059 /* Restore the original current buffer. */
4060 visit_file
= unbind_to (count
, visit_file
);
4062 #ifdef CLASH_DETECTION
4064 unlock_file (lockname
);
4065 #endif /* CLASH_DETECTION */
4067 /* Do this before reporting IO error
4068 to avoid a "file has changed on disk" warning on
4069 next attempt to save. */
4071 current_buffer
->modtime
= st
.st_mtime
;
4074 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
4078 SAVE_MODIFF
= MODIFF
;
4079 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4080 current_buffer
->filename
= visit_file
;
4081 update_mode_lines
++;
4087 message ("Wrote %s", XSTRING (visit_file
)->data
);
4092 Lisp_Object
merge ();
4094 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4095 "Return t if (car A) is numerically less than (car B).")
4099 return Flss (Fcar (a
), Fcar (b
));
4102 /* Build the complete list of annotations appropriate for writing out
4103 the text between START and END, by calling all the functions in
4104 write-region-annotate-functions and merging the lists they return.
4105 If one of these functions switches to a different buffer, we assume
4106 that buffer contains altered text. Therefore, the caller must
4107 make sure to restore the current buffer in all cases,
4108 as save-excursion would do. */
4111 build_annotations (start
, end
, pre_write_conversion
)
4112 Lisp_Object start
, end
, pre_write_conversion
;
4114 Lisp_Object annotations
;
4116 struct gcpro gcpro1
, gcpro2
;
4117 Lisp_Object original_buffer
;
4119 XSETBUFFER (original_buffer
, current_buffer
);
4122 p
= Vwrite_region_annotate_functions
;
4123 GCPRO2 (annotations
, p
);
4126 struct buffer
*given_buffer
= current_buffer
;
4127 Vwrite_region_annotations_so_far
= annotations
;
4128 res
= call2 (Fcar (p
), start
, end
);
4129 /* If the function makes a different buffer current,
4130 assume that means this buffer contains altered text to be output.
4131 Reset START and END from the buffer bounds
4132 and discard all previous annotations because they should have
4133 been dealt with by this function. */
4134 if (current_buffer
!= given_buffer
)
4140 Flength (res
); /* Check basic validity of return value */
4141 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4145 /* Now do the same for annotation functions implied by the file-format */
4146 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4147 p
= Vauto_save_file_format
;
4149 p
= current_buffer
->file_format
;
4152 struct buffer
*given_buffer
= current_buffer
;
4153 Vwrite_region_annotations_so_far
= annotations
;
4154 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4156 if (current_buffer
!= given_buffer
)
4163 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4167 /* At last, do the same for the function PRE_WRITE_CONVERSION
4168 implied by the current coding-system. */
4169 if (!NILP (pre_write_conversion
))
4171 struct buffer
*given_buffer
= current_buffer
;
4172 Vwrite_region_annotations_so_far
= annotations
;
4173 res
= call2 (pre_write_conversion
, start
, end
);
4174 if (current_buffer
!= given_buffer
)
4181 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4188 /* Write to descriptor DESC the LEN characters starting at ADDR,
4189 assuming they start at position POS in the buffer.
4190 Intersperse with them the annotations from *ANNOT
4191 (those which fall within the range of positions POS to POS + LEN),
4192 each at its appropriate position.
4194 Modify *ANNOT by discarding elements as we output them.
4195 The return value is negative in case of system call failure. */
4198 a_write (desc
, addr
, len
, pos
, annot
, coding
)
4200 register char *addr
;
4204 struct coding_system
*coding
;
4208 int lastpos
= pos
+ len
;
4210 while (NILP (*annot
) || CONSP (*annot
))
4212 tem
= Fcar_safe (Fcar (*annot
));
4213 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
4214 nextpos
= XFASTINT (tem
);
4216 return e_write (desc
, addr
, lastpos
- pos
, coding
);
4219 if (0 > e_write (desc
, addr
, nextpos
- pos
, coding
))
4221 addr
+= nextpos
- pos
;
4224 tem
= Fcdr (Fcar (*annot
));
4227 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
,
4231 *annot
= Fcdr (*annot
);
4235 #ifndef WRITE_BUF_SIZE
4236 #define WRITE_BUF_SIZE (16 * 1024)
4240 e_write (desc
, addr
, len
, coding
)
4242 register char *addr
;
4244 struct coding_system
*coding
;
4246 char buf
[WRITE_BUF_SIZE
];
4247 int produced
, consumed
;
4249 /* We used to have a code for handling selective display here. But,
4250 now it is handled within encode_coding. */
4253 produced
= encode_coding (coding
, addr
, buf
, len
, WRITE_BUF_SIZE
,
4255 len
-= consumed
, addr
+= consumed
;
4256 if (produced
== 0 && len
> 0)
4258 /* There was a carry over because of invalid codes in the source.
4259 We just write out them as is. */
4260 bcopy (addr
, buf
, len
);
4266 produced
-= write (desc
, buf
, produced
);
4267 if (produced
) return -1;
4275 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4276 Sverify_visited_file_modtime
, 1, 1, 0,
4277 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4278 This means that the file has not been changed since it was visited or saved.")
4284 Lisp_Object handler
;
4286 CHECK_BUFFER (buf
, 0);
4289 if (!STRINGP (b
->filename
)) return Qt
;
4290 if (b
->modtime
== 0) return Qt
;
4292 /* If the file name has special constructs in it,
4293 call the corresponding file handler. */
4294 handler
= Ffind_file_name_handler (b
->filename
,
4295 Qverify_visited_file_modtime
);
4296 if (!NILP (handler
))
4297 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4299 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
4301 /* If the file doesn't exist now and didn't exist before,
4302 we say that it isn't modified, provided the error is a tame one. */
4303 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4308 if (st
.st_mtime
== b
->modtime
4309 /* If both are positive, accept them if they are off by one second. */
4310 || (st
.st_mtime
> 0 && b
->modtime
> 0
4311 && (st
.st_mtime
== b
->modtime
+ 1
4312 || st
.st_mtime
== b
->modtime
- 1)))
4317 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4318 Sclear_visited_file_modtime
, 0, 0, 0,
4319 "Clear out records of last mod time of visited file.\n\
4320 Next attempt to save will certainly not complain of a discrepancy.")
4323 current_buffer
->modtime
= 0;
4327 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4328 Svisited_file_modtime
, 0, 0, 0,
4329 "Return the current buffer's recorded visited file modification time.\n\
4330 The value is a list of the form (HIGH . LOW), like the time values\n\
4331 that `file-attributes' returns.")
4334 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4337 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4338 Sset_visited_file_modtime
, 0, 1, 0,
4339 "Update buffer's recorded modification time from the visited file's time.\n\
4340 Useful if the buffer was not read from the file normally\n\
4341 or if the file itself has been changed for some known benign reason.\n\
4342 An argument specifies the modification time value to use\n\
4343 \(instead of that of the visited file), in the form of a list\n\
4344 \(HIGH . LOW) or (HIGH LOW).")
4346 Lisp_Object time_list
;
4348 if (!NILP (time_list
))
4349 current_buffer
->modtime
= cons_to_long (time_list
);
4352 register Lisp_Object filename
;
4354 Lisp_Object handler
;
4356 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4358 /* If the file name has special constructs in it,
4359 call the corresponding file handler. */
4360 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4361 if (!NILP (handler
))
4362 /* The handler can find the file name the same way we did. */
4363 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4364 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4365 current_buffer
->modtime
= st
.st_mtime
;
4375 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4376 Fsleep_for (make_number (1), Qnil
);
4377 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
4378 Fsleep_for (make_number (1), Qnil
);
4379 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4380 Fsleep_for (make_number (1), Qnil
);
4390 /* Get visited file's mode to become the auto save file's mode. */
4391 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4392 /* But make sure we can overwrite it later! */
4393 auto_save_mode_bits
= st
.st_mode
| 0600;
4395 auto_save_mode_bits
= 0666;
4398 Fwrite_region (Qnil
, Qnil
,
4399 current_buffer
->auto_save_file_name
,
4400 Qnil
, Qlambda
, Qnil
);
4404 do_auto_save_unwind (desc
) /* used as unwind-protect function */
4408 if (XINT (desc
) >= 0)
4409 close (XINT (desc
));
4413 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4414 "Auto-save all buffers that need it.\n\
4415 This is all buffers that have auto-saving enabled\n\
4416 and are changed since last auto-saved.\n\
4417 Auto-saving writes the buffer into a file\n\
4418 so that your editing is not lost if the system crashes.\n\
4419 This file is not the file you visited; that changes only when you save.\n\
4420 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4421 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4422 A non-nil CURRENT-ONLY argument means save only current buffer.")
4423 (no_message
, current_only
)
4424 Lisp_Object no_message
, current_only
;
4426 struct buffer
*old
= current_buffer
, *b
;
4427 Lisp_Object tail
, buf
;
4429 char *omessage
= echo_area_glyphs
;
4430 int omessage_length
= echo_area_glyphs_length
;
4431 int do_handled_files
;
4434 int count
= specpdl_ptr
- specpdl
;
4437 /* Ordinarily don't quit within this function,
4438 but don't make it impossible to quit (in case we get hung in I/O). */
4442 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4443 point to non-strings reached from Vbuffer_alist. */
4448 if (!NILP (Vrun_hooks
))
4449 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4451 if (STRINGP (Vauto_save_list_file_name
))
4453 Lisp_Object listfile
;
4454 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4456 listdesc
= open (XSTRING (listfile
)->data
,
4457 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
4458 S_IREAD
| S_IWRITE
);
4459 #else /* not DOS_NT */
4460 listdesc
= creat (XSTRING (listfile
)->data
, 0666);
4461 #endif /* not DOS_NT */
4466 /* Arrange to close that file whether or not we get an error.
4467 Also reset auto_saving to 0. */
4468 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
4472 /* First, save all files which don't have handlers. If Emacs is
4473 crashing, the handlers may tweak what is causing Emacs to crash
4474 in the first place, and it would be a shame if Emacs failed to
4475 autosave perfectly ordinary files because it couldn't handle some
4477 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4478 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4480 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4483 /* Record all the buffers that have auto save mode
4484 in the special file that lists them. For each of these buffers,
4485 Record visited name (if any) and auto save name. */
4486 if (STRINGP (b
->auto_save_file_name
)
4487 && listdesc
>= 0 && do_handled_files
== 0)
4489 if (!NILP (b
->filename
))
4491 write (listdesc
, XSTRING (b
->filename
)->data
,
4492 XSTRING (b
->filename
)->size
);
4494 write (listdesc
, "\n", 1);
4495 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
4496 XSTRING (b
->auto_save_file_name
)->size
);
4497 write (listdesc
, "\n", 1);
4500 if (!NILP (current_only
)
4501 && b
!= current_buffer
)
4504 /* Don't auto-save indirect buffers.
4505 The base buffer takes care of it. */
4509 /* Check for auto save enabled
4510 and file changed since last auto save
4511 and file changed since last real save. */
4512 if (STRINGP (b
->auto_save_file_name
)
4513 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4514 && b
->auto_save_modified
< BUF_MODIFF (b
)
4515 /* -1 means we've turned off autosaving for a while--see below. */
4516 && XINT (b
->save_length
) >= 0
4517 && (do_handled_files
4518 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4521 EMACS_TIME before_time
, after_time
;
4523 EMACS_GET_TIME (before_time
);
4525 /* If we had a failure, don't try again for 20 minutes. */
4526 if (b
->auto_save_failure_time
>= 0
4527 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4530 if ((XFASTINT (b
->save_length
) * 10
4531 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4532 /* A short file is likely to change a large fraction;
4533 spare the user annoying messages. */
4534 && XFASTINT (b
->save_length
) > 5000
4535 /* These messages are frequent and annoying for `*mail*'. */
4536 && !EQ (b
->filename
, Qnil
)
4537 && NILP (no_message
))
4539 /* It has shrunk too much; turn off auto-saving here. */
4540 message ("Buffer %s has shrunk a lot; auto save turned off there",
4541 XSTRING (b
->name
)->data
);
4542 /* Turn off auto-saving until there's a real save,
4543 and prevent any more warnings. */
4544 XSETINT (b
->save_length
, -1);
4545 Fsleep_for (make_number (1), Qnil
);
4548 set_buffer_internal (b
);
4549 if (!auto_saved
&& NILP (no_message
))
4550 message1 ("Auto-saving...");
4551 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4553 b
->auto_save_modified
= BUF_MODIFF (b
);
4554 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4555 set_buffer_internal (old
);
4557 EMACS_GET_TIME (after_time
);
4559 /* If auto-save took more than 60 seconds,
4560 assume it was an NFS failure that got a timeout. */
4561 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4562 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4566 /* Prevent another auto save till enough input events come in. */
4567 record_auto_save ();
4569 if (auto_saved
&& NILP (no_message
))
4573 sit_for (1, 0, 0, 0);
4574 message2 (omessage
, omessage_length
);
4577 message1 ("Auto-saving...done");
4582 unbind_to (count
, Qnil
);
4586 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4587 Sset_buffer_auto_saved
, 0, 0, 0,
4588 "Mark current buffer as auto-saved with its current text.\n\
4589 No auto-save file will be written until the buffer changes again.")
4592 current_buffer
->auto_save_modified
= MODIFF
;
4593 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4594 current_buffer
->auto_save_failure_time
= -1;
4598 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4599 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4600 "Clear any record of a recent auto-save failure in the current buffer.")
4603 current_buffer
->auto_save_failure_time
= -1;
4607 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4609 "Return t if buffer has been auto-saved since last read in or saved.")
4612 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4615 /* Reading and completing file names */
4616 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4618 /* In the string VAL, change each $ to $$ and return the result. */
4621 double_dollars (val
)
4624 register unsigned char *old
, *new;
4628 osize
= XSTRING (val
)->size
;
4629 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4630 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4631 if (*old
++ == '$') count
++;
4634 old
= XSTRING (val
)->data
;
4635 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4636 new = XSTRING (val
)->data
;
4637 for (n
= osize
; n
> 0; n
--)
4650 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4652 "Internal subroutine for read-file-name. Do not call this.")
4653 (string
, dir
, action
)
4654 Lisp_Object string
, dir
, action
;
4655 /* action is nil for complete, t for return list of completions,
4656 lambda for verify final value */
4658 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4660 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4662 CHECK_STRING (string
, 0);
4669 /* No need to protect ACTION--we only compare it with t and nil. */
4670 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4672 if (XSTRING (string
)->size
== 0)
4674 if (EQ (action
, Qlambda
))
4682 orig_string
= string
;
4683 string
= Fsubstitute_in_file_name (string
);
4684 changed
= NILP (Fstring_equal (string
, orig_string
));
4685 name
= Ffile_name_nondirectory (string
);
4686 val
= Ffile_name_directory (string
);
4688 realdir
= Fexpand_file_name (val
, realdir
);
4693 specdir
= Ffile_name_directory (string
);
4694 val
= Ffile_name_completion (name
, realdir
);
4699 return double_dollars (string
);
4703 if (!NILP (specdir
))
4704 val
= concat2 (specdir
, val
);
4706 return double_dollars (val
);
4709 #endif /* not VMS */
4713 if (EQ (action
, Qt
))
4714 return Ffile_name_all_completions (name
, realdir
);
4715 /* Only other case actually used is ACTION = lambda */
4717 /* Supposedly this helps commands such as `cd' that read directory names,
4718 but can someone explain how it helps them? -- RMS */
4719 if (XSTRING (name
)->size
== 0)
4722 return Ffile_exists_p (string
);
4725 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4726 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4727 Value is not expanded---you must call `expand-file-name' yourself.\n\
4728 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4729 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4730 except that if INITIAL is specified, that combined with DIR is used.)\n\
4731 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4732 Non-nil and non-t means also require confirmation after completion.\n\
4733 Fifth arg INITIAL specifies text to start with.\n\
4734 DIR defaults to current buffer's directory default.")
4735 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4736 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4738 Lisp_Object val
, insdef
, insdef1
, tem
;
4739 struct gcpro gcpro1
, gcpro2
;
4740 register char *homedir
;
4744 dir
= current_buffer
->directory
;
4745 if (NILP (default_filename
))
4747 if (! NILP (initial
))
4748 default_filename
= Fexpand_file_name (initial
, dir
);
4750 default_filename
= current_buffer
->filename
;
4753 /* If dir starts with user's homedir, change that to ~. */
4754 homedir
= (char *) egetenv ("HOME");
4756 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
4757 CORRECT_DIR_SEPS (homedir
);
4761 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4762 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4764 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4765 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4766 XSTRING (dir
)->data
[0] = '~';
4769 if (insert_default_directory
&& STRINGP (dir
))
4772 if (!NILP (initial
))
4774 Lisp_Object args
[2], pos
;
4778 insdef
= Fconcat (2, args
);
4779 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4780 insdef1
= Fcons (double_dollars (insdef
), pos
);
4783 insdef1
= double_dollars (insdef
);
4785 else if (STRINGP (initial
))
4788 insdef1
= Fcons (double_dollars (insdef
), 0);
4791 insdef
= Qnil
, insdef1
= Qnil
;
4794 count
= specpdl_ptr
- specpdl
;
4795 specbind (intern ("completion-ignore-case"), Qt
);
4798 GCPRO2 (insdef
, default_filename
);
4799 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4800 dir
, mustmatch
, insdef1
,
4801 Qfile_name_history
);
4804 unbind_to (count
, Qnil
);
4809 error ("No file name specified");
4810 tem
= Fstring_equal (val
, insdef
);
4811 if (!NILP (tem
) && !NILP (default_filename
))
4812 return default_filename
;
4813 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4815 if (!NILP (default_filename
))
4816 return default_filename
;
4818 error ("No default file name");
4820 return Fsubstitute_in_file_name (val
);
4823 #if 0 /* Old version */
4824 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4825 /* Don't confuse make-docfile by having two doc strings for this function.
4826 make-docfile does not pay attention to #if, for good reason! */
4828 (prompt
, dir
, defalt
, mustmatch
, initial
)
4829 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4831 Lisp_Object val
, insdef
, tem
;
4832 struct gcpro gcpro1
, gcpro2
;
4833 register char *homedir
;
4837 dir
= current_buffer
->directory
;
4839 defalt
= current_buffer
->filename
;
4841 /* If dir starts with user's homedir, change that to ~. */
4842 homedir
= (char *) egetenv ("HOME");
4845 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4846 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4848 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4849 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4850 XSTRING (dir
)->data
[0] = '~';
4853 if (!NILP (initial
))
4855 else if (insert_default_directory
)
4858 insdef
= build_string ("");
4861 count
= specpdl_ptr
- specpdl
;
4862 specbind (intern ("completion-ignore-case"), Qt
);
4865 GCPRO2 (insdef
, defalt
);
4866 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4868 insert_default_directory
? insdef
: Qnil
,
4869 Qfile_name_history
);
4872 unbind_to (count
, Qnil
);
4877 error ("No file name specified");
4878 tem
= Fstring_equal (val
, insdef
);
4879 if (!NILP (tem
) && !NILP (defalt
))
4881 return Fsubstitute_in_file_name (val
);
4883 #endif /* Old version */
4887 Qexpand_file_name
= intern ("expand-file-name");
4888 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4889 Qdirectory_file_name
= intern ("directory-file-name");
4890 Qfile_name_directory
= intern ("file-name-directory");
4891 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4892 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4893 Qfile_name_as_directory
= intern ("file-name-as-directory");
4894 Qcopy_file
= intern ("copy-file");
4895 Qmake_directory_internal
= intern ("make-directory-internal");
4896 Qdelete_directory
= intern ("delete-directory");
4897 Qdelete_file
= intern ("delete-file");
4898 Qrename_file
= intern ("rename-file");
4899 Qadd_name_to_file
= intern ("add-name-to-file");
4900 Qmake_symbolic_link
= intern ("make-symbolic-link");
4901 Qfile_exists_p
= intern ("file-exists-p");
4902 Qfile_executable_p
= intern ("file-executable-p");
4903 Qfile_readable_p
= intern ("file-readable-p");
4904 Qfile_writable_p
= intern ("file-writable-p");
4905 Qfile_symlink_p
= intern ("file-symlink-p");
4906 Qaccess_file
= intern ("access-file");
4907 Qfile_directory_p
= intern ("file-directory-p");
4908 Qfile_regular_p
= intern ("file-regular-p");
4909 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4910 Qfile_modes
= intern ("file-modes");
4911 Qset_file_modes
= intern ("set-file-modes");
4912 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4913 Qinsert_file_contents
= intern ("insert-file-contents");
4914 Qwrite_region
= intern ("write-region");
4915 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4916 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4918 staticpro (&Qexpand_file_name
);
4919 staticpro (&Qsubstitute_in_file_name
);
4920 staticpro (&Qdirectory_file_name
);
4921 staticpro (&Qfile_name_directory
);
4922 staticpro (&Qfile_name_nondirectory
);
4923 staticpro (&Qunhandled_file_name_directory
);
4924 staticpro (&Qfile_name_as_directory
);
4925 staticpro (&Qcopy_file
);
4926 staticpro (&Qmake_directory_internal
);
4927 staticpro (&Qdelete_directory
);
4928 staticpro (&Qdelete_file
);
4929 staticpro (&Qrename_file
);
4930 staticpro (&Qadd_name_to_file
);
4931 staticpro (&Qmake_symbolic_link
);
4932 staticpro (&Qfile_exists_p
);
4933 staticpro (&Qfile_executable_p
);
4934 staticpro (&Qfile_readable_p
);
4935 staticpro (&Qfile_writable_p
);
4936 staticpro (&Qaccess_file
);
4937 staticpro (&Qfile_symlink_p
);
4938 staticpro (&Qfile_directory_p
);
4939 staticpro (&Qfile_regular_p
);
4940 staticpro (&Qfile_accessible_directory_p
);
4941 staticpro (&Qfile_modes
);
4942 staticpro (&Qset_file_modes
);
4943 staticpro (&Qfile_newer_than_file_p
);
4944 staticpro (&Qinsert_file_contents
);
4945 staticpro (&Qwrite_region
);
4946 staticpro (&Qverify_visited_file_modtime
);
4947 staticpro (&Qset_visited_file_modtime
);
4949 Qfile_name_history
= intern ("file-name-history");
4950 Fset (Qfile_name_history
, Qnil
);
4951 staticpro (&Qfile_name_history
);
4953 Qfile_error
= intern ("file-error");
4954 staticpro (&Qfile_error
);
4955 Qfile_already_exists
= intern ("file-already-exists");
4956 staticpro (&Qfile_already_exists
);
4957 Qfile_date_error
= intern ("file-date-error");
4958 staticpro (&Qfile_date_error
);
4961 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4962 staticpro (&Qfind_buffer_file_type
);
4965 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
4966 "*Format in which to write auto-save files.\n\
4967 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
4968 If it is t, which is the default, auto-save files are written in the\n\
4969 same format as a regular save would use.");
4970 Vauto_save_file_format
= Qt
;
4972 Qformat_decode
= intern ("format-decode");
4973 staticpro (&Qformat_decode
);
4974 Qformat_annotate_function
= intern ("format-annotate-function");
4975 staticpro (&Qformat_annotate_function
);
4977 Qcar_less_than_car
= intern ("car-less-than-car");
4978 staticpro (&Qcar_less_than_car
);
4980 Fput (Qfile_error
, Qerror_conditions
,
4981 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4982 Fput (Qfile_error
, Qerror_message
,
4983 build_string ("File error"));
4985 Fput (Qfile_already_exists
, Qerror_conditions
,
4986 Fcons (Qfile_already_exists
,
4987 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4988 Fput (Qfile_already_exists
, Qerror_message
,
4989 build_string ("File already exists"));
4991 Fput (Qfile_date_error
, Qerror_conditions
,
4992 Fcons (Qfile_date_error
,
4993 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4994 Fput (Qfile_date_error
, Qerror_message
,
4995 build_string ("Cannot set file date"));
4997 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4998 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4999 insert_default_directory
= 1;
5001 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5002 "*Non-nil means write new files with record format `stmlf'.\n\
5003 nil means use format `var'. This variable is meaningful only on VMS.");
5004 vms_stmlf_recfm
= 0;
5006 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5007 "Directory separator character for built-in functions that return file names.\n\
5008 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5009 This variable affects the built-in functions only on Windows,\n\
5010 on other platforms, it is initialized so that Lisp code can find out\n\
5011 what the normal separator is.");
5012 Vdirectory_sep_char
= '/';
5014 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5015 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5016 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5019 The first argument given to HANDLER is the name of the I/O primitive\n\
5020 to be handled; the remaining arguments are the arguments that were\n\
5021 passed to that primitive. For example, if you do\n\
5022 (file-exists-p FILENAME)\n\
5023 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5024 (funcall HANDLER 'file-exists-p FILENAME)\n\
5025 The function `find-file-name-handler' checks this list for a handler\n\
5026 for its argument.");
5027 Vfile_name_handler_alist
= Qnil
;
5029 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5030 "A list of functions to be called at the end of `insert-file-contents'.\n\
5031 Each is passed one argument, the number of bytes inserted. It should return\n\
5032 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5033 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5034 responsible for calling the after-insert-file-functions if appropriate.");
5035 Vafter_insert_file_functions
= Qnil
;
5037 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5038 "A list of functions to be called at the start of `write-region'.\n\
5039 Each is passed two arguments, START and END as for `write-region'.\n\
5040 These are usually two numbers but not always; see the documentation\n\
5041 for `write-region'. The function should return a list of pairs\n\
5042 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5043 inserted at the specified positions of the file being written (1 means to\n\
5044 insert before the first byte written). The POSITIONs must be sorted into\n\
5045 increasing order. If there are several functions in the list, the several\n\
5046 lists are merged destructively.");
5047 Vwrite_region_annotate_functions
= Qnil
;
5049 DEFVAR_LISP ("write-region-annotations-so-far",
5050 &Vwrite_region_annotations_so_far
,
5051 "When an annotation function is called, this holds the previous annotations.\n\
5052 These are the annotations made by other annotation functions\n\
5053 that were already called. See also `write-region-annotate-functions'.");
5054 Vwrite_region_annotations_so_far
= Qnil
;
5056 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5057 "A list of file name handlers that temporarily should not be used.\n\
5058 This applies only to the operation `inhibit-file-name-operation'.");
5059 Vinhibit_file_name_handlers
= Qnil
;
5061 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5062 "The operation for which `inhibit-file-name-handlers' is applicable.");
5063 Vinhibit_file_name_operation
= Qnil
;
5065 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5066 "File name in which we write a list of all auto save file names.\n\
5067 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5068 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5070 Vauto_save_list_file_name
= Qnil
;
5072 defsubr (&Sfind_file_name_handler
);
5073 defsubr (&Sfile_name_directory
);
5074 defsubr (&Sfile_name_nondirectory
);
5075 defsubr (&Sunhandled_file_name_directory
);
5076 defsubr (&Sfile_name_as_directory
);
5077 defsubr (&Sdirectory_file_name
);
5078 defsubr (&Smake_temp_name
);
5079 defsubr (&Sexpand_file_name
);
5080 defsubr (&Ssubstitute_in_file_name
);
5081 defsubr (&Scopy_file
);
5082 defsubr (&Smake_directory_internal
);
5083 defsubr (&Sdelete_directory
);
5084 defsubr (&Sdelete_file
);
5085 defsubr (&Srename_file
);
5086 defsubr (&Sadd_name_to_file
);
5088 defsubr (&Smake_symbolic_link
);
5089 #endif /* S_IFLNK */
5091 defsubr (&Sdefine_logical_name
);
5094 defsubr (&Ssysnetunam
);
5095 #endif /* HPUX_NET */
5096 defsubr (&Sfile_name_absolute_p
);
5097 defsubr (&Sfile_exists_p
);
5098 defsubr (&Sfile_executable_p
);
5099 defsubr (&Sfile_readable_p
);
5100 defsubr (&Sfile_writable_p
);
5101 defsubr (&Saccess_file
);
5102 defsubr (&Sfile_symlink_p
);
5103 defsubr (&Sfile_directory_p
);
5104 defsubr (&Sfile_accessible_directory_p
);
5105 defsubr (&Sfile_regular_p
);
5106 defsubr (&Sfile_modes
);
5107 defsubr (&Sset_file_modes
);
5108 defsubr (&Sset_default_file_modes
);
5109 defsubr (&Sdefault_file_modes
);
5110 defsubr (&Sfile_newer_than_file_p
);
5111 defsubr (&Sinsert_file_contents
);
5112 defsubr (&Swrite_region
);
5113 defsubr (&Scar_less_than_car
);
5114 defsubr (&Sverify_visited_file_modtime
);
5115 defsubr (&Sclear_visited_file_modtime
);
5116 defsubr (&Svisited_file_modtime
);
5117 defsubr (&Sset_visited_file_modtime
);
5118 defsubr (&Sdo_auto_save
);
5119 defsubr (&Sset_buffer_auto_saved
);
5120 defsubr (&Sclear_buffer_auto_save_failure
);
5121 defsubr (&Srecent_auto_save_p
);
5123 defsubr (&Sread_file_name_internal
);
5124 defsubr (&Sread_file_name
);
5127 defsubr (&Sunix_sync
);