1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95 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, 675 Mass Ave, Cambridge, MA 02139, USA. */
22 #include <sys/types.h>
29 #if !defined (S_ISLNK) && defined (S_IFLNK)
30 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
33 #if !defined (S_ISREG) && defined (S_IFREG)
34 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
45 #include <sys/param.h>
63 extern char *strerror ();
80 #include "intervals.h"
89 #endif /* not WINDOWSNT */
117 #define min(a, b) ((a) < (b) ? (a) : (b))
118 #define max(a, b) ((a) > (b) ? (a) : (b))
120 /* Nonzero during writing of auto-save files */
123 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
124 a new file with the same mode as the original */
125 int auto_save_mode_bits
;
127 /* Alist of elements (REGEXP . HANDLER) for file names
128 whose I/O is done with a special handler. */
129 Lisp_Object Vfile_name_handler_alist
;
131 /* Format for auto-save files */
132 Lisp_Object Vauto_save_file_format
;
134 /* Lisp functions for translating file formats */
135 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
137 /* Functions to be called to process text properties in inserted file. */
138 Lisp_Object Vafter_insert_file_functions
;
140 /* Functions to be called to create text property annotations for file. */
141 Lisp_Object Vwrite_region_annotate_functions
;
143 /* During build_annotations, each time an annotation function is called,
144 this holds the annotations made by the previous functions. */
145 Lisp_Object Vwrite_region_annotations_so_far
;
147 /* File name in which we write a list of all our auto save files. */
148 Lisp_Object Vauto_save_list_file_name
;
150 /* Nonzero means, when reading a filename in the minibuffer,
151 start out by inserting the default directory into the minibuffer. */
152 int insert_default_directory
;
154 /* On VMS, nonzero means write new files with record format stmlf.
155 Zero means use var format. */
158 /* These variables describe handlers that have "already" had a chance
159 to handle the current operation.
161 Vinhibit_file_name_handlers is a list of file name handlers.
162 Vinhibit_file_name_operation is the operation being handled.
163 If we try to handle that operation, we ignore those handlers. */
165 static Lisp_Object Vinhibit_file_name_handlers
;
166 static Lisp_Object Vinhibit_file_name_operation
;
168 Lisp_Object Qfile_error
, Qfile_already_exists
;
170 Lisp_Object Qfile_name_history
;
172 Lisp_Object Qcar_less_than_car
;
174 report_file_error (string
, data
)
178 Lisp_Object errstring
;
180 errstring
= build_string (strerror (errno
));
182 /* System error messages are capitalized. Downcase the initial
183 unless it is followed by a slash. */
184 if (XSTRING (errstring
)->data
[1] != '/')
185 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
188 Fsignal (Qfile_error
,
189 Fcons (build_string (string
), Fcons (errstring
, data
)));
192 close_file_unwind (fd
)
195 close (XFASTINT (fd
));
198 /* Restore point, having saved it as a marker. */
200 restore_point_unwind (location
)
201 Lisp_Object location
;
203 SET_PT (marker_position (location
));
204 Fset_marker (location
, Qnil
, Qnil
);
207 Lisp_Object Qexpand_file_name
;
208 Lisp_Object Qsubstitute_in_file_name
;
209 Lisp_Object Qdirectory_file_name
;
210 Lisp_Object Qfile_name_directory
;
211 Lisp_Object Qfile_name_nondirectory
;
212 Lisp_Object Qunhandled_file_name_directory
;
213 Lisp_Object Qfile_name_as_directory
;
214 Lisp_Object Qcopy_file
;
215 Lisp_Object Qmake_directory_internal
;
216 Lisp_Object Qdelete_directory
;
217 Lisp_Object Qdelete_file
;
218 Lisp_Object Qrename_file
;
219 Lisp_Object Qadd_name_to_file
;
220 Lisp_Object Qmake_symbolic_link
;
221 Lisp_Object Qfile_exists_p
;
222 Lisp_Object Qfile_executable_p
;
223 Lisp_Object Qfile_readable_p
;
224 Lisp_Object Qfile_symlink_p
;
225 Lisp_Object Qfile_writable_p
;
226 Lisp_Object Qfile_directory_p
;
227 Lisp_Object Qfile_regular_p
;
228 Lisp_Object Qfile_accessible_directory_p
;
229 Lisp_Object Qfile_modes
;
230 Lisp_Object Qset_file_modes
;
231 Lisp_Object Qfile_newer_than_file_p
;
232 Lisp_Object Qinsert_file_contents
;
233 Lisp_Object Qwrite_region
;
234 Lisp_Object Qverify_visited_file_modtime
;
235 Lisp_Object Qset_visited_file_modtime
;
237 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
238 "Return FILENAME's handler function for OPERATION, if it has one.\n\
239 Otherwise, return nil.\n\
240 A file name is handled if one of the regular expressions in\n\
241 `file-name-handler-alist' matches it.\n\n\
242 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
243 any handlers that are members of `inhibit-file-name-handlers',\n\
244 but we still do run any other handlers. This lets handlers\n\
245 use the standard functions without calling themselves recursively.")
246 (filename
, operation
)
247 Lisp_Object filename
, operation
;
249 /* This function must not munge the match data. */
250 Lisp_Object chain
, inhibited_handlers
;
252 CHECK_STRING (filename
, 0);
254 if (EQ (operation
, Vinhibit_file_name_operation
))
255 inhibited_handlers
= Vinhibit_file_name_handlers
;
257 inhibited_handlers
= Qnil
;
259 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
260 chain
= XCONS (chain
)->cdr
)
263 elt
= XCONS (chain
)->car
;
267 string
= XCONS (elt
)->car
;
268 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
270 Lisp_Object handler
, tem
;
272 handler
= XCONS (elt
)->cdr
;
273 tem
= Fmemq (handler
, inhibited_handlers
);
284 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
286 "Return the directory component in file name NAME.\n\
287 Return nil if NAME does not include a directory.\n\
288 Otherwise return a directory spec.\n\
289 Given a Unix syntax file name, returns a string ending in slash;\n\
290 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
294 register unsigned char *beg
;
295 register unsigned char *p
;
298 CHECK_STRING (file
, 0);
300 /* If the file name has special constructs in it,
301 call the corresponding file handler. */
302 handler
= Ffind_file_name_handler (file
, Qfile_name_directory
);
304 return call2 (handler
, Qfile_name_directory
, file
);
306 #ifdef FILE_SYSTEM_CASE
307 file
= FILE_SYSTEM_CASE (file
);
309 beg
= XSTRING (file
)->data
;
310 p
= beg
+ XSTRING (file
)->size
;
312 while (p
!= beg
&& !IS_ANY_SEP (p
[-1])
314 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
321 /* Expansion of "c:" to drive and default directory. */
322 /* (NT does the right thing.) */
323 if (p
== beg
+ 2 && beg
[1] == ':')
325 int drive
= (*beg
) - 'a';
326 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
327 unsigned char *res
= alloca (MAXPATHLEN
+ 5);
331 /* The NT version places the drive letter at the beginning already. */
332 #else /* not WINDOWSNT */
333 /* On MSDOG we must put the drive letter in by hand. */
335 #endif /* not WINDOWSNT */
336 if (getdefdir (drive
+ 1, res
))
339 res
[0] = drive
+ 'a';
342 if (IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
345 p
= beg
+ strlen (beg
);
349 return make_string (beg
, p
- beg
);
352 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
354 "Return file name NAME sans its directory.\n\
355 For example, in a Unix-syntax file name,\n\
356 this is everything after the last slash,\n\
357 or the entire name if it contains no slash.")
361 register unsigned char *beg
, *p
, *end
;
364 CHECK_STRING (file
, 0);
366 /* If the file name has special constructs in it,
367 call the corresponding file handler. */
368 handler
= Ffind_file_name_handler (file
, Qfile_name_nondirectory
);
370 return call2 (handler
, Qfile_name_nondirectory
, file
);
372 beg
= XSTRING (file
)->data
;
373 end
= p
= beg
+ XSTRING (file
)->size
;
375 while (p
!= beg
&& !IS_ANY_SEP (p
[-1])
377 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
381 return make_string (p
, end
- p
);
384 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
385 "Return a directly usable directory name somehow associated with FILENAME.\n\
386 A `directly usable' directory name is one that may be used without the\n\
387 intervention of any file handler.\n\
388 If FILENAME is a directly usable file itself, return\n\
389 (file-name-directory FILENAME).\n\
390 The `call-process' and `start-process' functions use this function to\n\
391 get a current directory to run processes in.")
393 Lisp_Object filename
;
397 /* If the file name has special constructs in it,
398 call the corresponding file handler. */
399 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
401 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
403 return Ffile_name_directory (filename
);
408 file_name_as_directory (out
, in
)
411 int size
= strlen (in
) - 1;
416 /* Is it already a directory string? */
417 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
419 /* Is it a VMS directory file name? If so, hack VMS syntax. */
420 else if (! index (in
, '/')
421 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
422 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
423 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
424 || ! strncmp (&in
[size
- 5], ".dir", 4))
425 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
426 && in
[size
] == '1')))
428 register char *p
, *dot
;
432 dir:x.dir --> dir:[x]
433 dir:[x]y.dir --> dir:[x.y] */
435 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
438 strncpy (out
, in
, p
- in
);
457 dot
= index (p
, '.');
460 /* blindly remove any extension */
461 size
= strlen (out
) + (dot
- p
);
462 strncat (out
, p
, dot
- p
);
473 /* For Unix syntax, Append a slash if necessary */
474 if (!IS_ANY_SEP (out
[size
]))
476 out
[size
+ 1] = DIRECTORY_SEP
;
477 out
[size
+ 2] = '\0';
483 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
484 Sfile_name_as_directory
, 1, 1, 0,
485 "Return a string representing file FILENAME interpreted as a directory.\n\
486 This operation exists because a directory is also a file, but its name as\n\
487 a directory is different from its name as a file.\n\
488 The result can be used as the value of `default-directory'\n\
489 or passed as second argument to `expand-file-name'.\n\
490 For a Unix-syntax file name, just appends a slash.\n\
491 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
498 CHECK_STRING (file
, 0);
502 /* If the file name has special constructs in it,
503 call the corresponding file handler. */
504 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
506 return call2 (handler
, Qfile_name_as_directory
, file
);
508 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
509 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
513 * Convert from directory name to filename.
515 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
516 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
517 * On UNIX, it's simple: just make sure there is a terminating /
519 * Value is nonzero if the string output is different from the input.
522 directory_file_name (src
, dst
)
530 struct FAB fab
= cc$rms_fab
;
531 struct NAM nam
= cc$rms_nam
;
532 char esa
[NAM$C_MAXRSS
];
537 if (! index (src
, '/')
538 && (src
[slen
- 1] == ']'
539 || src
[slen
- 1] == ':'
540 || src
[slen
- 1] == '>'))
542 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
544 fab
.fab$b_fns
= slen
;
545 fab
.fab$l_nam
= &nam
;
546 fab
.fab$l_fop
= FAB$M_NAM
;
549 nam
.nam$b_ess
= sizeof esa
;
550 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
552 /* We call SYS$PARSE to handle such things as [--] for us. */
553 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
555 slen
= nam
.nam$b_esl
;
556 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
561 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
563 /* what about when we have logical_name:???? */
564 if (src
[slen
- 1] == ':')
565 { /* Xlate logical name and see what we get */
566 ptr
= strcpy (dst
, src
); /* upper case for getenv */
569 if ('a' <= *ptr
&& *ptr
<= 'z')
573 dst
[slen
- 1] = 0; /* remove colon */
574 if (!(src
= egetenv (dst
)))
576 /* should we jump to the beginning of this procedure?
577 Good points: allows us to use logical names that xlate
579 Bad points: can be a problem if we just translated to a device
581 For now, I'll punt and always expect VMS names, and hope for
584 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
585 { /* no recursion here! */
591 { /* not a directory spec */
596 bracket
= src
[slen
- 1];
598 /* If bracket is ']' or '>', bracket - 2 is the corresponding
600 ptr
= index (src
, bracket
- 2);
602 { /* no opening bracket */
606 if (!(rptr
= rindex (src
, '.')))
609 strncpy (dst
, src
, slen
);
613 dst
[slen
++] = bracket
;
618 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
619 then translate the device and recurse. */
620 if (dst
[slen
- 1] == ':'
621 && dst
[slen
- 2] != ':' /* skip decnet nodes */
622 && strcmp(src
+ slen
, "[000000]") == 0)
624 dst
[slen
- 1] = '\0';
625 if ((ptr
= egetenv (dst
))
626 && (rlen
= strlen (ptr
) - 1) > 0
627 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
628 && ptr
[rlen
- 1] == '.')
630 char * buf
= (char *) alloca (strlen (ptr
) + 1);
634 return directory_file_name (buf
, dst
);
639 strcat (dst
, "[000000]");
643 rlen
= strlen (rptr
) - 1;
644 strncat (dst
, rptr
, rlen
);
645 dst
[slen
+ rlen
] = '\0';
646 strcat (dst
, ".DIR.1");
650 /* Process as Unix format: just remove any final slash.
651 But leave "/" unchanged; do not change it to "". */
654 /* Handle // as root for apollo's. */
655 if ((slen
> 2 && dst
[slen
- 1] == '/')
656 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
660 && IS_DIRECTORY_SEP (dst
[slen
- 1])
661 && !IS_ANY_SEP (dst
[slen
- 2]))
667 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
669 "Returns the file name of the directory named DIR.\n\
670 This is the name of the file that holds the data for the directory DIR.\n\
671 This operation exists because a directory is also a file, but its name as\n\
672 a directory is different from its name as a file.\n\
673 In Unix-syntax, this function just removes the final slash.\n\
674 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
675 it returns a file name such as \"[X]Y.DIR.1\".")
677 Lisp_Object directory
;
682 CHECK_STRING (directory
, 0);
684 if (NILP (directory
))
687 /* If the file name has special constructs in it,
688 call the corresponding file handler. */
689 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
691 return call2 (handler
, Qdirectory_file_name
, directory
);
694 /* 20 extra chars is insufficient for VMS, since we might perform a
695 logical name translation. an equivalence string can be up to 255
696 chars long, so grab that much extra space... - sss */
697 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
699 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
701 directory_file_name (XSTRING (directory
)->data
, buf
);
702 return build_string (buf
);
705 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
706 "Generate temporary file name (string) starting with PREFIX (a string).\n\
707 The Emacs process number forms part of the result,\n\
708 so there is no danger of generating a name being used by another process.")
713 val
= concat2 (prefix
, build_string ("XXXXXX"));
714 mktemp (XSTRING (val
)->data
);
718 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
719 "Convert FILENAME to absolute, and canonicalize it.\n\
720 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
721 (does not start with slash); if DEFAULT is nil or missing,\n\
722 the current buffer's value of default-directory is used.\n\
723 Path components that are `.' are removed, and \n\
724 path components followed by `..' are removed, along with the `..' itself;\n\
725 note that these simplifications are done without checking the resulting\n\
726 paths in the file system.\n\
727 An initial `~/' expands to your home directory.\n\
728 An initial `~USER/' expands to USER's home directory.\n\
729 See also the function `substitute-in-file-name'.")
731 Lisp_Object name
, defalt
;
735 register unsigned char *newdir
, *p
, *o
;
737 unsigned char *target
;
740 unsigned char * colon
= 0;
741 unsigned char * close
= 0;
742 unsigned char * slash
= 0;
743 unsigned char * brack
= 0;
744 int lbrack
= 0, rbrack
= 0;
748 /* Demacs 1.1.2 91/10/20 Manabu Higashida */
751 unsigned char *tmp
, *defdir
;
755 CHECK_STRING (name
, 0);
757 /* If the file name has special constructs in it,
758 call the corresponding file handler. */
759 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
761 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
763 /* Use the buffer's default-directory if DEFALT is omitted. */
765 defalt
= current_buffer
->directory
;
766 CHECK_STRING (defalt
, 1);
770 handler
= Ffind_file_name_handler (defalt
, Qexpand_file_name
);
772 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
775 o
= XSTRING (defalt
)->data
;
777 /* Make sure DEFALT is properly expanded.
778 It would be better to do this down below where we actually use
779 defalt. Unfortunately, calling Fexpand_file_name recursively
780 could invoke GC, and the strings might be relocated. This would
781 be annoying because we have pointers into strings lying around
782 that would need adjusting, and people would add new pointers to
783 the code and forget to adjust them, resulting in intermittent bugs.
784 Putting this call here avoids all that crud.
786 The EQ test avoids infinite recursion. */
787 if (! NILP (defalt
) && !EQ (defalt
, name
)
788 /* This saves time in a common case. */
789 && ! (XSTRING (defalt
)->size
>= 3
790 && IS_DIRECTORY_SEP (XSTRING (defalt
)->data
[0])
791 && IS_DEVICE_SEP (XSTRING (defalt
)->data
[1])))
796 defalt
= Fexpand_file_name (defalt
, Qnil
);
801 /* Filenames on VMS are always upper case. */
802 name
= Fupcase (name
);
804 #ifdef FILE_SYSTEM_CASE
805 name
= FILE_SYSTEM_CASE (name
);
808 nm
= XSTRING (name
)->data
;
811 /* First map all backslashes to slashes. */
812 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
816 /* Now strip drive name. */
818 unsigned char *colon
= rindex (nm
, ':');
826 if (!IS_DIRECTORY_SEP (*nm
))
828 defdir
= alloca (MAXPATHLEN
+ 1);
829 relpath
= getdefdir (tolower (drive
) - 'a' + 1, defdir
);
835 /* If nm is absolute, flush ...// and detect /./ and /../.
836 If no /./ or /../ we can return right away. */
838 IS_DIRECTORY_SEP (nm
[0])
844 /* If it turns out that the filename we want to return is just a
845 suffix of FILENAME, we don't need to go through and edit
846 things; we just need to construct a new string using data
847 starting at the middle of FILENAME. If we set lose to a
848 non-zero value, that means we've discovered that we can't do
855 /* Since we know the path is absolute, we can assume that each
856 element starts with a "/". */
858 /* "//" anywhere isn't necessarily hairy; we just start afresh
859 with the second slash. */
860 if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
861 #if defined (APOLLO) || defined (WINDOWSNT)
862 /* // at start of filename is meaningful on Apollo
863 and WindowsNT systems */
865 #endif /* APOLLO || WINDOWSNT */
869 /* "~" is hairy as the start of any path element. */
870 if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '~')
871 nm
= p
+ 1, lose
= 1;
873 /* "." and ".." are hairy. */
874 if (IS_DIRECTORY_SEP (p
[0])
876 && (IS_DIRECTORY_SEP (p
[2])
878 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
885 /* if dev:[dir]/, move nm to / */
886 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
887 nm
= (brack
? brack
+ 1 : colon
+ 1);
896 /* VMS pre V4.4,convert '-'s in filenames. */
897 if (lbrack
== rbrack
)
899 if (dots
< 2) /* this is to allow negative version numbers */
904 if (lbrack
> rbrack
&&
905 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
906 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
912 /* count open brackets, reset close bracket pointer */
913 if (p
[0] == '[' || p
[0] == '<')
915 /* count close brackets, set close bracket pointer */
916 if (p
[0] == ']' || p
[0] == '>')
918 /* detect ][ or >< */
919 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
921 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
922 nm
= p
+ 1, lose
= 1;
923 if (p
[0] == ':' && (colon
|| slash
))
924 /* if dev1:[dir]dev2:, move nm to dev2: */
930 /* if /pathname/dev:, move nm to dev: */
933 /* if node::dev:, move colon following dev */
934 else if (colon
&& colon
[-1] == ':')
936 /* if dev1:dev2:, move nm to dev2: */
937 else if (colon
&& colon
[-1] != ':')
942 if (p
[0] == ':' && !colon
)
948 if (lbrack
== rbrack
)
951 else if (p
[0] == '.')
960 return build_string (sys_translate_unix (nm
));
963 if (nm
== XSTRING (name
)->data
)
965 return build_string (nm
);
966 #endif /* not DOS_NT */
970 /* Now determine directory to start with and put it in newdir */
974 if (nm
[0] == '~') /* prefix ~ */
976 if (IS_DIRECTORY_SEP (nm
[1])
980 || nm
[1] == 0) /* ~ by itself */
982 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
983 newdir
= (unsigned char *) "";
985 /* Problem when expanding "~\" if HOME is not on current drive.
986 Ulrich Leodolter, Wed Jan 11 10:20:35 1995 */
987 if (newdir
[1] == ':')
989 dostounix_filename (newdir
);
993 nm
++; /* Don't leave the slash in nm. */
996 else /* ~user/filename */
998 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1003 o
= (unsigned char *) alloca (p
- nm
+ 1);
1004 bcopy ((char *) nm
, o
, p
- nm
);
1008 newdir
= (unsigned char *) egetenv ("HOME");
1009 dostounix_filename (newdir
);
1010 #else /* not WINDOWSNT */
1011 pw
= (struct passwd
*) getpwnam (o
+ 1);
1014 newdir
= (unsigned char *) pw
-> pw_dir
;
1016 nm
= p
+ 1; /* skip the terminator */
1021 #endif /* not WINDOWSNT */
1023 /* If we don't find a user of that name, leave the name
1024 unchanged; don't move nm forward to p. */
1028 if (!IS_ANY_SEP (nm
[0])
1031 #endif /* not VMS */
1037 newdir
= XSTRING (defalt
)->data
;
1041 if (newdir
== 0 && relpath
)
1046 /* Get rid of any slash at the end of newdir. */
1047 int length
= strlen (newdir
);
1048 /* Adding `length > 1 &&' makes ~ expand into / when homedir
1049 is the root dir. People disagree about whether that is right.
1050 Anyway, we can't take the risk of this change now. */
1052 if (newdir
[1] != ':' && length
> 1)
1054 if (IS_DIRECTORY_SEP (newdir
[length
- 1]))
1056 unsigned char *temp
= (unsigned char *) alloca (length
);
1057 bcopy (newdir
, temp
, length
- 1);
1058 temp
[length
- 1] = 0;
1066 /* Now concatenate the directory and name to new space in the stack frame */
1067 tlen
+= strlen (nm
) + 1;
1069 /* Add reserved space for drive name. (The Microsoft x86 compiler
1070 produces incorrect code if the following two lines are combined.) */
1071 target
= (unsigned char *) alloca (tlen
+ 2);
1073 #else /* not DOS_NT */
1074 target
= (unsigned char *) alloca (tlen
);
1075 #endif /* not DOS_NT */
1081 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1082 strcpy (target
, newdir
);
1085 file_name_as_directory (target
, newdir
);
1088 strcat (target
, nm
);
1090 if (index (target
, '/'))
1091 strcpy (target
, sys_translate_unix (target
));
1094 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1102 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1108 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1109 /* brackets are offset from each other by 2 */
1112 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1113 /* convert [foo][bar] to [bar] */
1114 while (o
[-1] != '[' && o
[-1] != '<')
1116 else if (*p
== '-' && *o
!= '.')
1119 else if (p
[0] == '-' && o
[-1] == '.' &&
1120 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1121 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1125 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1126 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1128 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1130 /* else [foo.-] ==> [-] */
1136 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1137 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1143 if (!IS_DIRECTORY_SEP (*p
))
1147 else if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
1148 #if defined (APOLLO) || defined (WINDOWSNT)
1149 /* // at start of filename is meaningful in Apollo
1150 and WindowsNT systems */
1158 else if (IS_DIRECTORY_SEP (p
[0])
1160 && (IS_DIRECTORY_SEP (p
[2])
1163 /* If "/." is the entire filename, keep the "/". Otherwise,
1164 just delete the whole "/.". */
1165 if (o
== target
&& p
[2] == '\0')
1169 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1170 /* `/../' is the "superroot" on certain file systems. */
1172 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1174 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1176 #if defined (APOLLO) || defined (WINDOWSNT)
1178 && IS_DIRECTORY_SEP (o
[-1]) && IS_DIRECTORY_SEP (o
[0]))
1181 #endif /* APOLLO || WINDOWSNT */
1182 if (o
== target
&& IS_ANY_SEP (*o
))
1190 #endif /* not VMS */
1194 /* at last, set drive name. */
1195 if (target
[1] != ':'
1197 /* Allow network paths that look like "\\foo" */
1198 && !(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1]))
1199 #endif /* WINDOWSNT */
1203 target
[0] = (drive
< 0 ? getdisk () + 'A' : drive
);
1208 return make_string (target
, o
- target
);
1212 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1213 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1214 "Convert FILENAME to absolute, and canonicalize it.\n\
1215 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1216 (does not start with slash); if DEFAULT is nil or missing,\n\
1217 the current buffer's value of default-directory is used.\n\
1218 Filenames containing `.' or `..' as components are simplified;\n\
1219 initial `~/' expands to your home directory.\n\
1220 See also the function `substitute-in-file-name'.")
1222 Lisp_Object name
, defalt
;
1226 register unsigned char *newdir
, *p
, *o
;
1228 unsigned char *target
;
1232 unsigned char * colon
= 0;
1233 unsigned char * close
= 0;
1234 unsigned char * slash
= 0;
1235 unsigned char * brack
= 0;
1236 int lbrack
= 0, rbrack
= 0;
1240 CHECK_STRING (name
, 0);
1243 /* Filenames on VMS are always upper case. */
1244 name
= Fupcase (name
);
1247 nm
= XSTRING (name
)->data
;
1249 /* If nm is absolute, flush ...// and detect /./ and /../.
1250 If no /./ or /../ we can return right away. */
1262 if (p
[0] == '/' && p
[1] == '/'
1264 /* // at start of filename is meaningful on Apollo system */
1269 if (p
[0] == '/' && p
[1] == '~')
1270 nm
= p
+ 1, lose
= 1;
1271 if (p
[0] == '/' && p
[1] == '.'
1272 && (p
[2] == '/' || p
[2] == 0
1273 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1279 /* if dev:[dir]/, move nm to / */
1280 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1281 nm
= (brack
? brack
+ 1 : colon
+ 1);
1282 lbrack
= rbrack
= 0;
1290 /* VMS pre V4.4,convert '-'s in filenames. */
1291 if (lbrack
== rbrack
)
1293 if (dots
< 2) /* this is to allow negative version numbers */
1298 if (lbrack
> rbrack
&&
1299 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1300 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1306 /* count open brackets, reset close bracket pointer */
1307 if (p
[0] == '[' || p
[0] == '<')
1308 lbrack
++, brack
= 0;
1309 /* count close brackets, set close bracket pointer */
1310 if (p
[0] == ']' || p
[0] == '>')
1311 rbrack
++, brack
= p
;
1312 /* detect ][ or >< */
1313 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1315 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1316 nm
= p
+ 1, lose
= 1;
1317 if (p
[0] == ':' && (colon
|| slash
))
1318 /* if dev1:[dir]dev2:, move nm to dev2: */
1324 /* if /pathname/dev:, move nm to dev: */
1327 /* if node::dev:, move colon following dev */
1328 else if (colon
&& colon
[-1] == ':')
1330 /* if dev1:dev2:, move nm to dev2: */
1331 else if (colon
&& colon
[-1] != ':')
1336 if (p
[0] == ':' && !colon
)
1342 if (lbrack
== rbrack
)
1345 else if (p
[0] == '.')
1353 if (index (nm
, '/'))
1354 return build_string (sys_translate_unix (nm
));
1356 if (nm
== XSTRING (name
)->data
)
1358 return build_string (nm
);
1362 /* Now determine directory to start with and put it in NEWDIR */
1366 if (nm
[0] == '~') /* prefix ~ */
1371 || nm
[1] == 0)/* ~/filename */
1373 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1374 newdir
= (unsigned char *) "";
1377 nm
++; /* Don't leave the slash in nm. */
1380 else /* ~user/filename */
1382 /* Get past ~ to user */
1383 unsigned char *user
= nm
+ 1;
1384 /* Find end of name. */
1385 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1386 int len
= ptr
? ptr
- user
: strlen (user
);
1388 unsigned char *ptr1
= index (user
, ':');
1389 if (ptr1
!= 0 && ptr1
- user
< len
)
1392 /* Copy the user name into temp storage. */
1393 o
= (unsigned char *) alloca (len
+ 1);
1394 bcopy ((char *) user
, o
, len
);
1397 /* Look up the user name. */
1398 pw
= (struct passwd
*) getpwnam (o
+ 1);
1400 error ("\"%s\" isn't a registered user", o
+ 1);
1402 newdir
= (unsigned char *) pw
->pw_dir
;
1404 /* Discard the user name from NM. */
1411 #endif /* not VMS */
1415 defalt
= current_buffer
->directory
;
1416 CHECK_STRING (defalt
, 1);
1417 newdir
= XSTRING (defalt
)->data
;
1420 /* Now concatenate the directory and name to new space in the stack frame */
1422 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1423 target
= (unsigned char *) alloca (tlen
);
1429 if (nm
[0] == 0 || nm
[0] == '/')
1430 strcpy (target
, newdir
);
1433 file_name_as_directory (target
, newdir
);
1436 strcat (target
, nm
);
1438 if (index (target
, '/'))
1439 strcpy (target
, sys_translate_unix (target
));
1442 /* Now canonicalize by removing /. and /foo/.. if they appear */
1450 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1456 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1457 /* brackets are offset from each other by 2 */
1460 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1461 /* convert [foo][bar] to [bar] */
1462 while (o
[-1] != '[' && o
[-1] != '<')
1464 else if (*p
== '-' && *o
!= '.')
1467 else if (p
[0] == '-' && o
[-1] == '.' &&
1468 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1469 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1473 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1474 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1476 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1478 /* else [foo.-] ==> [-] */
1484 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1485 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1495 else if (!strncmp (p
, "//", 2)
1497 /* // at start of filename is meaningful in Apollo system */
1505 else if (p
[0] == '/' && p
[1] == '.' &&
1506 (p
[2] == '/' || p
[2] == 0))
1508 else if (!strncmp (p
, "/..", 3)
1509 /* `/../' is the "superroot" on certain file systems. */
1511 && (p
[3] == '/' || p
[3] == 0))
1513 while (o
!= target
&& *--o
!= '/')
1516 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1520 if (o
== target
&& *o
== '/')
1528 #endif /* not VMS */
1531 return make_string (target
, o
- target
);
1535 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1536 Ssubstitute_in_file_name
, 1, 1, 0,
1537 "Substitute environment variables referred to in FILENAME.\n\
1538 `$FOO' where FOO is an environment variable name means to substitute\n\
1539 the value of that variable. The variable name should be terminated\n\
1540 with a character not a letter, digit or underscore; otherwise, enclose\n\
1541 the entire variable name in braces.\n\
1542 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1543 On VMS, `$' substitution is not done; this function does little and only\n\
1544 duplicates what `expand-file-name' does.")
1550 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1551 unsigned char *target
;
1553 int substituted
= 0;
1555 Lisp_Object handler
;
1557 CHECK_STRING (string
, 0);
1559 /* If the file name has special constructs in it,
1560 call the corresponding file handler. */
1561 handler
= Ffind_file_name_handler (string
, Qsubstitute_in_file_name
);
1562 if (!NILP (handler
))
1563 return call2 (handler
, Qsubstitute_in_file_name
, string
);
1565 nm
= XSTRING (string
)->data
;
1567 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
1568 substituted
= !strcmp (nm
, XSTRING (string
)->data
);
1570 endp
= nm
+ XSTRING (string
)->size
;
1572 /* If /~ or // appears, discard everything through first slash. */
1574 for (p
= nm
; p
!= endp
; p
++)
1578 /* // at start of file name is meaningful in Apollo system */
1579 (p
[0] == '/' && p
- 1 != nm
)
1580 #else /* not APOLLO */
1582 (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1583 #else /* not WINDOWSNT */
1585 #endif /* not WINDOWSNT */
1586 #endif /* not APOLLO */
1591 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1593 || IS_DIRECTORY_SEP (p
[-1])))
1599 if (p
[0] && p
[1] == ':')
1608 return build_string (nm
);
1611 /* See if any variables are substituted into the string
1612 and find the total length of their values in `total' */
1614 for (p
= nm
; p
!= endp
;)
1624 /* "$$" means a single "$" */
1633 while (p
!= endp
&& *p
!= '}') p
++;
1634 if (*p
!= '}') goto missingclose
;
1640 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1644 /* Copy out the variable name */
1645 target
= (unsigned char *) alloca (s
- o
+ 1);
1646 strncpy (target
, o
, s
- o
);
1649 strupr (target
); /* $home == $HOME etc. */
1652 /* Get variable value */
1653 o
= (unsigned char *) egetenv (target
);
1654 if (!o
) goto badvar
;
1655 total
+= strlen (o
);
1662 /* If substitution required, recopy the string and do it */
1663 /* Make space in stack frame for the new copy */
1664 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1667 /* Copy the rest of the name through, replacing $ constructs with values */
1684 while (p
!= endp
&& *p
!= '}') p
++;
1685 if (*p
!= '}') goto missingclose
;
1691 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1695 /* Copy out the variable name */
1696 target
= (unsigned char *) alloca (s
- o
+ 1);
1697 strncpy (target
, o
, s
- o
);
1700 strupr (target
); /* $home == $HOME etc. */
1703 /* Get variable value */
1704 o
= (unsigned char *) egetenv (target
);
1714 /* If /~ or // appears, discard everything through first slash. */
1716 for (p
= xnm
; p
!= x
; p
++)
1719 /* // at start of file name is meaningful in Apollo system */
1720 || (p
[0] == '/' && p
- 1 != xnm
)
1721 #else /* not APOLLO */
1723 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1724 #else /* not WINDOWSNT */
1726 #endif /* not WINDOWSNT */
1727 #endif /* not APOLLO */
1729 && p
!= nm
&& IS_DIRECTORY_SEP (p
[-1]))
1732 else if (p
[0] && p
[1] == ':')
1736 return make_string (xnm
, x
- xnm
);
1739 error ("Bad format environment-variable substitution");
1741 error ("Missing \"}\" in environment-variable substitution");
1743 error ("Substituting nonexistent environment variable \"%s\"", target
);
1746 #endif /* not VMS */
1749 /* A slightly faster and more convenient way to get
1750 (directory-file-name (expand-file-name FOO)). */
1753 expand_and_dir_to_file (filename
, defdir
)
1754 Lisp_Object filename
, defdir
;
1756 register Lisp_Object abspath
;
1758 abspath
= Fexpand_file_name (filename
, defdir
);
1761 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1762 if (c
== ':' || c
== ']' || c
== '>')
1763 abspath
= Fdirectory_file_name (abspath
);
1766 /* Remove final slash, if any (unless path is root).
1767 stat behaves differently depending! */
1768 if (XSTRING (abspath
)->size
> 1
1769 && IS_DIRECTORY_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1])
1770 && !IS_DEVICE_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
-2]))
1771 /* We cannot take shortcuts; they might be wrong for magic file names. */
1772 abspath
= Fdirectory_file_name (abspath
);
1778 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1779 Lisp_Object absname
;
1780 unsigned char *querystring
;
1783 register Lisp_Object tem
;
1784 struct stat statbuf
;
1785 struct gcpro gcpro1
;
1787 /* stat is a good way to tell whether the file exists,
1788 regardless of what access permissions it has. */
1789 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1792 Fsignal (Qfile_already_exists
,
1793 Fcons (build_string ("File already exists"),
1794 Fcons (absname
, Qnil
)));
1796 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1797 XSTRING (absname
)->data
, querystring
));
1800 Fsignal (Qfile_already_exists
,
1801 Fcons (build_string ("File already exists"),
1802 Fcons (absname
, Qnil
)));
1807 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1808 "fCopy file: \nFCopy %s to file: \np\nP",
1809 "Copy FILE to NEWNAME. Both args must be strings.\n\
1810 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1811 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1812 A number as third arg means request confirmation if NEWNAME already exists.\n\
1813 This is what happens in interactive use with M-x.\n\
1814 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1815 last-modified time as the old one. (This works on only some systems.)\n\
1816 A prefix arg makes KEEP-TIME non-nil.")
1817 (filename
, newname
, ok_if_already_exists
, keep_date
)
1818 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1821 char buf
[16 * 1024];
1823 Lisp_Object handler
;
1824 struct gcpro gcpro1
, gcpro2
;
1825 int count
= specpdl_ptr
- specpdl
;
1826 int input_file_statable_p
;
1828 GCPRO2 (filename
, newname
);
1829 CHECK_STRING (filename
, 0);
1830 CHECK_STRING (newname
, 1);
1831 filename
= Fexpand_file_name (filename
, Qnil
);
1832 newname
= Fexpand_file_name (newname
, Qnil
);
1834 /* If the input file name has special constructs in it,
1835 call the corresponding file handler. */
1836 handler
= Ffind_file_name_handler (filename
, Qcopy_file
);
1837 /* Likewise for output file name. */
1839 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1840 if (!NILP (handler
))
1841 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, filename
, newname
,
1842 ok_if_already_exists
, keep_date
));
1844 if (NILP (ok_if_already_exists
)
1845 || INTEGERP (ok_if_already_exists
))
1846 barf_or_query_if_file_exists (newname
, "copy to it",
1847 INTEGERP (ok_if_already_exists
));
1849 ifd
= open (XSTRING (filename
)->data
, O_RDONLY
);
1851 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1853 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1855 /* We can only copy regular files and symbolic links. Other files are not
1857 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1859 #if defined (S_ISREG) && defined (S_ISLNK)
1860 if (input_file_statable_p
)
1862 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1864 #if defined (EISDIR)
1865 /* Get a better looking error message. */
1868 report_file_error ("Non-regular file", Fcons (filename
, Qnil
));
1871 #endif /* S_ISREG && S_ISLNK */
1874 /* Create the copy file with the same record format as the input file */
1875 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1878 /* System's default file type was set to binary by _fmode in emacs.c. */
1879 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1880 #else /* not MSDOS */
1881 ofd
= creat (XSTRING (newname
)->data
, 0666);
1882 #endif /* not MSDOS */
1885 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1887 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1891 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1892 if (write (ofd
, buf
, n
) != n
)
1893 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1896 /* Closing the output clobbers the file times on some systems. */
1897 if (close (ofd
) < 0)
1898 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1900 if (input_file_statable_p
)
1902 if (!NILP (keep_date
))
1904 EMACS_TIME atime
, mtime
;
1905 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1906 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1907 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
1908 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1910 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1915 /* Discard the unwind protects. */
1916 specpdl_ptr
= specpdl
+ count
;
1922 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1923 Smake_directory_internal
, 1, 1, 0,
1924 "Create a directory. One argument, a file name string.")
1926 Lisp_Object dirname
;
1929 Lisp_Object handler
;
1931 CHECK_STRING (dirname
, 0);
1932 dirname
= Fexpand_file_name (dirname
, Qnil
);
1934 handler
= Ffind_file_name_handler (dirname
, Qmake_directory_internal
);
1935 if (!NILP (handler
))
1936 return call2 (handler
, Qmake_directory_internal
, dirname
);
1938 dir
= XSTRING (dirname
)->data
;
1941 if (mkdir (dir
) != 0)
1943 if (mkdir (dir
, 0777) != 0)
1945 report_file_error ("Creating directory", Flist (1, &dirname
));
1950 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1951 "Delete a directory. One argument, a file name or directory name string.")
1953 Lisp_Object dirname
;
1956 Lisp_Object handler
;
1958 CHECK_STRING (dirname
, 0);
1959 dirname
= Fdirectory_file_name (Fexpand_file_name (dirname
, Qnil
));
1960 dir
= XSTRING (dirname
)->data
;
1962 handler
= Ffind_file_name_handler (dirname
, Qdelete_directory
);
1963 if (!NILP (handler
))
1964 return call2 (handler
, Qdelete_directory
, dirname
);
1966 if (rmdir (dir
) != 0)
1967 report_file_error ("Removing directory", Flist (1, &dirname
));
1972 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1973 "Delete specified file. One argument, a file name string.\n\
1974 If file has multiple names, it continues to exist with the other names.")
1976 Lisp_Object filename
;
1978 Lisp_Object handler
;
1979 CHECK_STRING (filename
, 0);
1980 filename
= Fexpand_file_name (filename
, Qnil
);
1982 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
1983 if (!NILP (handler
))
1984 return call2 (handler
, Qdelete_file
, filename
);
1986 if (0 > unlink (XSTRING (filename
)->data
))
1987 report_file_error ("Removing old name", Flist (1, &filename
));
1992 internal_delete_file_1 (ignore
)
1998 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2001 internal_delete_file (filename
)
2002 Lisp_Object filename
;
2004 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2005 Qt
, internal_delete_file_1
));
2008 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2009 "fRename file: \nFRename %s to file: \np",
2010 "Rename FILE as NEWNAME. Both args strings.\n\
2011 If file has names other than FILE, it continues to have those names.\n\
2012 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2013 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2014 A number as third arg means request confirmation if NEWNAME already exists.\n\
2015 This is what happens in interactive use with M-x.")
2016 (filename
, newname
, ok_if_already_exists
)
2017 Lisp_Object filename
, newname
, ok_if_already_exists
;
2020 Lisp_Object args
[2];
2022 Lisp_Object handler
;
2023 struct gcpro gcpro1
, gcpro2
;
2025 GCPRO2 (filename
, newname
);
2026 CHECK_STRING (filename
, 0);
2027 CHECK_STRING (newname
, 1);
2028 filename
= Fexpand_file_name (filename
, Qnil
);
2029 newname
= Fexpand_file_name (newname
, Qnil
);
2031 /* If the file name has special constructs in it,
2032 call the corresponding file handler. */
2033 handler
= Ffind_file_name_handler (filename
, Qrename_file
);
2035 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2036 if (!NILP (handler
))
2037 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2038 filename
, newname
, ok_if_already_exists
));
2040 if (NILP (ok_if_already_exists
)
2041 || INTEGERP (ok_if_already_exists
))
2042 barf_or_query_if_file_exists (newname
, "rename to it",
2043 INTEGERP (ok_if_already_exists
));
2045 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2048 if (!MoveFile (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2049 #else /* not WINDOWSNT */
2050 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
2051 || 0 > unlink (XSTRING (filename
)->data
))
2052 #endif /* not WINDOWSNT */
2056 /* Why two? And why doesn't MS document what MoveFile will return? */
2057 if (GetLastError () == ERROR_FILE_EXISTS
2058 || GetLastError () == ERROR_ALREADY_EXISTS
)
2059 #else /* not WINDOWSNT */
2061 #endif /* not WINDOWSNT */
2063 Fcopy_file (filename
, newname
,
2064 /* We have already prompted if it was an integer,
2065 so don't have copy-file prompt again. */
2066 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2067 Fdelete_file (filename
);
2074 report_file_error ("Renaming", Flist (2, args
));
2077 report_file_error ("Renaming", Flist (2, &filename
));
2084 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2085 "fAdd name to file: \nFName to add to %s: \np",
2086 "Give FILE additional name NEWNAME. Both args strings.\n\
2087 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2088 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2089 A number as third arg means request confirmation if NEWNAME already exists.\n\
2090 This is what happens in interactive use with M-x.")
2091 (filename
, newname
, ok_if_already_exists
)
2092 Lisp_Object filename
, newname
, ok_if_already_exists
;
2095 Lisp_Object args
[2];
2097 Lisp_Object handler
;
2098 struct gcpro gcpro1
, gcpro2
;
2100 GCPRO2 (filename
, newname
);
2101 CHECK_STRING (filename
, 0);
2102 CHECK_STRING (newname
, 1);
2103 filename
= Fexpand_file_name (filename
, Qnil
);
2104 newname
= Fexpand_file_name (newname
, Qnil
);
2106 /* If the file name has special constructs in it,
2107 call the corresponding file handler. */
2108 handler
= Ffind_file_name_handler (filename
, Qadd_name_to_file
);
2109 if (!NILP (handler
))
2110 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
2111 newname
, ok_if_already_exists
));
2113 if (NILP (ok_if_already_exists
)
2114 || INTEGERP (ok_if_already_exists
))
2115 barf_or_query_if_file_exists (newname
, "make it a new name",
2116 INTEGERP (ok_if_already_exists
));
2118 /* Windows does not support this operation. */
2119 report_file_error ("Adding new name", Flist (2, &filename
));
2120 #else /* not WINDOWSNT */
2122 unlink (XSTRING (newname
)->data
);
2123 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2128 report_file_error ("Adding new name", Flist (2, args
));
2130 report_file_error ("Adding new name", Flist (2, &filename
));
2133 #endif /* not WINDOWSNT */
2140 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2141 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2142 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2143 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2144 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2145 A number as third arg means request confirmation if LINKNAME already exists.\n\
2146 This happens for interactive use with M-x.")
2147 (filename
, linkname
, ok_if_already_exists
)
2148 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2151 Lisp_Object args
[2];
2153 Lisp_Object handler
;
2154 struct gcpro gcpro1
, gcpro2
;
2156 GCPRO2 (filename
, linkname
);
2157 CHECK_STRING (filename
, 0);
2158 CHECK_STRING (linkname
, 1);
2159 /* If the link target has a ~, we must expand it to get
2160 a truly valid file name. Otherwise, do not expand;
2161 we want to permit links to relative file names. */
2162 if (XSTRING (filename
)->data
[0] == '~')
2163 filename
= Fexpand_file_name (filename
, Qnil
);
2164 linkname
= Fexpand_file_name (linkname
, Qnil
);
2166 /* If the file name has special constructs in it,
2167 call the corresponding file handler. */
2168 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2169 if (!NILP (handler
))
2170 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2171 linkname
, ok_if_already_exists
));
2173 if (NILP (ok_if_already_exists
)
2174 || INTEGERP (ok_if_already_exists
))
2175 barf_or_query_if_file_exists (linkname
, "make it a link",
2176 INTEGERP (ok_if_already_exists
));
2177 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2179 /* If we didn't complain already, silently delete existing file. */
2180 if (errno
== EEXIST
)
2182 unlink (XSTRING (linkname
)->data
);
2183 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2193 report_file_error ("Making symbolic link", Flist (2, args
));
2195 report_file_error ("Making symbolic link", Flist (2, &filename
));
2201 #endif /* S_IFLNK */
2205 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2206 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2207 "Define the job-wide logical name NAME to have the value STRING.\n\
2208 If STRING is nil or a null string, the logical name NAME is deleted.")
2210 Lisp_Object varname
;
2213 CHECK_STRING (varname
, 0);
2215 delete_logical_name (XSTRING (varname
)->data
);
2218 CHECK_STRING (string
, 1);
2220 if (XSTRING (string
)->size
== 0)
2221 delete_logical_name (XSTRING (varname
)->data
);
2223 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2232 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2233 "Open a network connection to PATH using LOGIN as the login string.")
2235 Lisp_Object path
, login
;
2239 CHECK_STRING (path
, 0);
2240 CHECK_STRING (login
, 0);
2242 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2244 if (netresult
== -1)
2249 #endif /* HPUX_NET */
2251 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2253 "Return t if file FILENAME specifies an absolute path name.\n\
2254 On Unix, this is a name starting with a `/' or a `~'.")
2256 Lisp_Object filename
;
2260 CHECK_STRING (filename
, 0);
2261 ptr
= XSTRING (filename
)->data
;
2262 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2264 /* ??? This criterion is probably wrong for '<'. */
2265 || index (ptr
, ':') || index (ptr
, '<')
2266 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2270 || (*ptr
!= 0 && ptr
[1] == ':' && (ptr
[2] == '/' || ptr
[2] == '\\'))
2278 /* Return nonzero if file FILENAME exists and can be executed. */
2281 check_executable (filename
)
2285 return (eaccess (filename
, 1) >= 0);
2287 /* Access isn't quite right because it uses the real uid
2288 and we really want to test with the effective uid.
2289 But Unix doesn't give us a right way to do it. */
2290 return (access (filename
, 1) >= 0);
2294 /* Return nonzero if file FILENAME exists and can be written. */
2297 check_writable (filename
)
2301 return (eaccess (filename
, 2) >= 0);
2303 /* Access isn't quite right because it uses the real uid
2304 and we really want to test with the effective uid.
2305 But Unix doesn't give us a right way to do it.
2306 Opening with O_WRONLY could work for an ordinary file,
2307 but would lose for directories. */
2308 return (access (filename
, 2) >= 0);
2312 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2313 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2314 See also `file-readable-p' and `file-attributes'.")
2316 Lisp_Object filename
;
2318 Lisp_Object abspath
;
2319 Lisp_Object handler
;
2320 struct stat statbuf
;
2322 CHECK_STRING (filename
, 0);
2323 abspath
= Fexpand_file_name (filename
, Qnil
);
2325 /* If the file name has special constructs in it,
2326 call the corresponding file handler. */
2327 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2328 if (!NILP (handler
))
2329 return call2 (handler
, Qfile_exists_p
, abspath
);
2331 return (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2334 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2335 "Return t if FILENAME can be executed by you.\n\
2336 For a directory, this means you can access files in that directory.")
2338 Lisp_Object filename
;
2341 Lisp_Object abspath
;
2342 Lisp_Object handler
;
2344 CHECK_STRING (filename
, 0);
2345 abspath
= Fexpand_file_name (filename
, Qnil
);
2347 /* If the file name has special constructs in it,
2348 call the corresponding file handler. */
2349 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2350 if (!NILP (handler
))
2351 return call2 (handler
, Qfile_executable_p
, abspath
);
2353 return (check_executable (XSTRING (abspath
)->data
) ? Qt
: Qnil
);
2356 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2357 "Return t if file FILENAME exists and you can read it.\n\
2358 See also `file-exists-p' and `file-attributes'.")
2360 Lisp_Object filename
;
2362 Lisp_Object abspath
;
2363 Lisp_Object handler
;
2366 CHECK_STRING (filename
, 0);
2367 abspath
= Fexpand_file_name (filename
, Qnil
);
2369 /* If the file name has special constructs in it,
2370 call the corresponding file handler. */
2371 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2372 if (!NILP (handler
))
2373 return call2 (handler
, Qfile_readable_p
, abspath
);
2375 desc
= open (XSTRING (abspath
)->data
, O_RDONLY
);
2382 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2384 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2385 "Return t if file FILENAME can be written or created by you.")
2387 Lisp_Object filename
;
2389 Lisp_Object abspath
, dir
;
2390 Lisp_Object handler
;
2391 struct stat statbuf
;
2393 CHECK_STRING (filename
, 0);
2394 abspath
= Fexpand_file_name (filename
, Qnil
);
2396 /* If the file name has special constructs in it,
2397 call the corresponding file handler. */
2398 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2399 if (!NILP (handler
))
2400 return call2 (handler
, Qfile_writable_p
, abspath
);
2402 if (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0)
2403 return (check_writable (XSTRING (abspath
)->data
)
2405 dir
= Ffile_name_directory (abspath
);
2408 dir
= Fdirectory_file_name (dir
);
2412 dir
= Fdirectory_file_name (dir
);
2414 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2418 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2419 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2420 The value is the name of the file to which it is linked.\n\
2421 Otherwise returns nil.")
2423 Lisp_Object filename
;
2430 Lisp_Object handler
;
2432 CHECK_STRING (filename
, 0);
2433 filename
= Fexpand_file_name (filename
, Qnil
);
2435 /* If the file name has special constructs in it,
2436 call the corresponding file handler. */
2437 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2438 if (!NILP (handler
))
2439 return call2 (handler
, Qfile_symlink_p
, filename
);
2444 buf
= (char *) xmalloc (bufsize
);
2445 bzero (buf
, bufsize
);
2446 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2447 if (valsize
< bufsize
) break;
2448 /* Buffer was not long enough */
2457 val
= make_string (buf
, valsize
);
2460 #else /* not S_IFLNK */
2462 #endif /* not S_IFLNK */
2465 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2466 "Return t if file FILENAME is the name of a directory as a file.\n\
2467 A directory name spec may be given instead; then the value is t\n\
2468 if the directory so specified exists and really is a directory.")
2470 Lisp_Object filename
;
2472 register Lisp_Object abspath
;
2474 Lisp_Object handler
;
2476 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2478 /* If the file name has special constructs in it,
2479 call the corresponding file handler. */
2480 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2481 if (!NILP (handler
))
2482 return call2 (handler
, Qfile_directory_p
, abspath
);
2484 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2486 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2489 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2490 "Return t if file FILENAME is the name of a directory as a file,\n\
2491 and files in that directory can be opened by you. In order to use a\n\
2492 directory as a buffer's current directory, this predicate must return true.\n\
2493 A directory name spec may be given instead; then the value is t\n\
2494 if the directory so specified exists and really is a readable and\n\
2495 searchable directory.")
2497 Lisp_Object filename
;
2499 Lisp_Object handler
;
2501 struct gcpro gcpro1
;
2503 /* If the file name has special constructs in it,
2504 call the corresponding file handler. */
2505 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2506 if (!NILP (handler
))
2507 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2509 /* It's an unlikely combination, but yes we really do need to gcpro:
2510 Suppose that file-accessible-directory-p has no handler, but
2511 file-directory-p does have a handler; this handler causes a GC which
2512 relocates the string in `filename'; and finally file-directory-p
2513 returns non-nil. Then we would end up passing a garbaged string
2514 to file-executable-p. */
2516 tem
= (NILP (Ffile_directory_p (filename
))
2517 || NILP (Ffile_executable_p (filename
)));
2519 return tem
? Qnil
: Qt
;
2522 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2523 "Return t if file FILENAME is the name of a regular file.\n\
2524 This is the sort of file that holds an ordinary stream of data bytes.")
2526 Lisp_Object filename
;
2528 register Lisp_Object abspath
;
2530 Lisp_Object handler
;
2532 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2534 /* If the file name has special constructs in it,
2535 call the corresponding file handler. */
2536 handler
= Ffind_file_name_handler (abspath
, Qfile_regular_p
);
2537 if (!NILP (handler
))
2538 return call2 (handler
, Qfile_regular_p
, abspath
);
2540 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2542 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2545 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2546 "Return mode bits of FILE, as an integer.")
2548 Lisp_Object filename
;
2550 Lisp_Object abspath
;
2552 Lisp_Object handler
;
2554 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2556 /* If the file name has special constructs in it,
2557 call the corresponding file handler. */
2558 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2559 if (!NILP (handler
))
2560 return call2 (handler
, Qfile_modes
, abspath
);
2562 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2568 if (S_ISREG (st
.st_mode
)
2569 && (len
= XSTRING (abspath
)->size
) >= 5
2570 && (stricmp ((suffix
= XSTRING (abspath
)->data
+ len
-4), ".com") == 0
2571 || stricmp (suffix
, ".exe") == 0
2572 || stricmp (suffix
, ".bat") == 0))
2573 st
.st_mode
|= S_IEXEC
;
2577 return make_number (st
.st_mode
& 07777);
2580 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2581 "Set mode bits of FILE to MODE (an integer).\n\
2582 Only the 12 low bits of MODE are used.")
2584 Lisp_Object filename
, mode
;
2586 Lisp_Object abspath
;
2587 Lisp_Object handler
;
2589 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2590 CHECK_NUMBER (mode
, 1);
2592 /* If the file name has special constructs in it,
2593 call the corresponding file handler. */
2594 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2595 if (!NILP (handler
))
2596 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2598 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2599 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2604 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2605 "Set the file permission bits for newly created files.\n\
2606 The argument MODE should be an integer; only the low 9 bits are used.\n\
2607 This setting is inherited by subprocesses.")
2611 CHECK_NUMBER (mode
, 0);
2613 umask ((~ XINT (mode
)) & 0777);
2618 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2619 "Return the default file protection for created files.\n\
2620 The value is an integer.")
2626 realmask
= umask (0);
2629 XSETINT (value
, (~ realmask
) & 0777);
2635 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2636 "Tell Unix to finish all pending disk updates.")
2645 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2646 "Return t if file FILE1 is newer than file FILE2.\n\
2647 If FILE1 does not exist, the answer is nil;\n\
2648 otherwise, if FILE2 does not exist, the answer is t.")
2650 Lisp_Object file1
, file2
;
2652 Lisp_Object abspath1
, abspath2
;
2655 Lisp_Object handler
;
2656 struct gcpro gcpro1
, gcpro2
;
2658 CHECK_STRING (file1
, 0);
2659 CHECK_STRING (file2
, 0);
2662 GCPRO2 (abspath1
, file2
);
2663 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2664 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2667 /* If the file name has special constructs in it,
2668 call the corresponding file handler. */
2669 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2671 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2672 if (!NILP (handler
))
2673 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2675 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2678 mtime1
= st
.st_mtime
;
2680 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2683 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2687 Lisp_Object Qfind_buffer_file_type
;
2690 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2692 "Insert contents of file FILENAME after point.\n\
2693 Returns list of absolute file name and length of data inserted.\n\
2694 If second argument VISIT is non-nil, the buffer's visited filename\n\
2695 and last save file modtime are set, and it is marked unmodified.\n\
2696 If visiting and the file does not exist, visiting is completed\n\
2697 before the error is signaled.\n\n\
2698 The optional third and fourth arguments BEG and END\n\
2699 specify what portion of the file to insert.\n\
2700 If VISIT is non-nil, BEG and END must be nil.\n\
2701 If optional fifth argument REPLACE is non-nil,\n\
2702 it means replace the current buffer contents (in the accessible portion)\n\
2703 with the file contents. This is better than simply deleting and inserting\n\
2704 the whole thing because (1) it preserves some marker positions\n\
2705 and (2) it puts less data in the undo list.")
2706 (filename
, visit
, beg
, end
, replace
)
2707 Lisp_Object filename
, visit
, beg
, end
, replace
;
2711 register int inserted
= 0;
2712 register int how_much
;
2713 int count
= specpdl_ptr
- specpdl
;
2714 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2715 Lisp_Object handler
, val
, insval
;
2718 int not_regular
= 0;
2720 if (current_buffer
->base_buffer
&& ! NILP (visit
))
2721 error ("Cannot do file visiting in an indirect buffer");
2723 if (!NILP (current_buffer
->read_only
))
2724 Fbarf_if_buffer_read_only ();
2729 GCPRO3 (filename
, val
, p
);
2731 CHECK_STRING (filename
, 0);
2732 filename
= Fexpand_file_name (filename
, Qnil
);
2734 /* If the file name has special constructs in it,
2735 call the corresponding file handler. */
2736 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2737 if (!NILP (handler
))
2739 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2740 visit
, beg
, end
, replace
);
2747 if (stat (XSTRING (filename
)->data
, &st
) < 0)
2749 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
2750 || fstat (fd
, &st
) < 0)
2751 #endif /* not APOLLO */
2753 if (fd
>= 0) close (fd
);
2756 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2763 /* This code will need to be changed in order to work on named
2764 pipes, and it's probably just not worth it. So we should at
2765 least signal an error. */
2766 if (!S_ISREG (st
.st_mode
))
2769 Fsignal (Qfile_error
,
2770 Fcons (build_string ("not a regular file"),
2771 Fcons (filename
, Qnil
)));
2779 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
2782 /* Replacement should preserve point as it preserves markers. */
2783 if (!NILP (replace
))
2784 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2786 record_unwind_protect (close_file_unwind
, make_number (fd
));
2788 /* Supposedly happens on VMS. */
2790 error ("File size is negative");
2792 if (!NILP (beg
) || !NILP (end
))
2794 error ("Attempt to visit less than an entire file");
2797 CHECK_NUMBER (beg
, 0);
2799 XSETFASTINT (beg
, 0);
2802 CHECK_NUMBER (end
, 0);
2805 XSETINT (end
, st
.st_size
);
2806 if (XINT (end
) != st
.st_size
)
2807 error ("maximum buffer size exceeded");
2810 /* If requested, replace the accessible part of the buffer
2811 with the file contents. Avoid replacing text at the
2812 beginning or end of the buffer that matches the file contents;
2813 that preserves markers pointing to the unchanged parts. */
2815 /* On MSDOS, replace mode doesn't really work, except for binary files,
2816 and it's not worth supporting just for them. */
2817 if (!NILP (replace
))
2820 XSETFASTINT (beg
, 0);
2821 XSETFASTINT (end
, st
.st_size
);
2822 del_range_1 (BEGV
, ZV
, 0);
2824 #else /* not DOS_NT */
2825 if (!NILP (replace
))
2827 unsigned char buffer
[1 << 14];
2828 int same_at_start
= BEGV
;
2829 int same_at_end
= ZV
;
2834 /* Count how many chars at the start of the file
2835 match the text at the beginning of the buffer. */
2840 nread
= read (fd
, buffer
, sizeof buffer
);
2842 error ("IO error reading %s: %s",
2843 XSTRING (filename
)->data
, strerror (errno
));
2844 else if (nread
== 0)
2847 while (bufpos
< nread
&& same_at_start
< ZV
2848 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2849 same_at_start
++, bufpos
++;
2850 /* If we found a discrepancy, stop the scan.
2851 Otherwise loop around and scan the next bufferfull. */
2852 if (bufpos
!= nread
)
2856 /* If the file matches the buffer completely,
2857 there's no need to replace anything. */
2858 if (same_at_start
- BEGV
== st
.st_size
)
2862 /* Truncate the buffer to the size of the file. */
2863 del_range_1 (same_at_start
, same_at_end
, 0);
2868 /* Count how many chars at the end of the file
2869 match the text at the end of the buffer. */
2872 int total_read
, nread
, bufpos
, curpos
, trial
;
2874 /* At what file position are we now scanning? */
2875 curpos
= st
.st_size
- (ZV
- same_at_end
);
2876 /* If the entire file matches the buffer tail, stop the scan. */
2879 /* How much can we scan in the next step? */
2880 trial
= min (curpos
, sizeof buffer
);
2881 if (lseek (fd
, curpos
- trial
, 0) < 0)
2882 report_file_error ("Setting file position",
2883 Fcons (filename
, Qnil
));
2886 while (total_read
< trial
)
2888 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2890 error ("IO error reading %s: %s",
2891 XSTRING (filename
)->data
, strerror (errno
));
2892 total_read
+= nread
;
2894 /* Scan this bufferfull from the end, comparing with
2895 the Emacs buffer. */
2896 bufpos
= total_read
;
2897 /* Compare with same_at_start to avoid counting some buffer text
2898 as matching both at the file's beginning and at the end. */
2899 while (bufpos
> 0 && same_at_end
> same_at_start
2900 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2901 same_at_end
--, bufpos
--;
2902 /* If we found a discrepancy, stop the scan.
2903 Otherwise loop around and scan the preceding bufferfull. */
2909 /* Don't try to reuse the same piece of text twice. */
2910 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2912 same_at_end
+= overlap
;
2914 /* Arrange to read only the nonmatching middle part of the file. */
2915 XSETFASTINT (beg
, same_at_start
- BEGV
);
2916 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
2918 del_range_1 (same_at_start
, same_at_end
, 0);
2919 /* Insert from the file at the proper position. */
2920 SET_PT (same_at_start
);
2922 #endif /* not DOS_NT */
2924 total
= XINT (end
) - XINT (beg
);
2927 register Lisp_Object temp
;
2929 /* Make sure point-max won't overflow after this insertion. */
2930 XSETINT (temp
, total
);
2931 if (total
!= XINT (temp
))
2932 error ("maximum buffer size exceeded");
2935 if (NILP (visit
) && total
> 0)
2936 prepare_to_modify_buffer (point
, point
);
2939 if (GAP_SIZE
< total
)
2940 make_gap (total
- GAP_SIZE
);
2942 if (XINT (beg
) != 0 || !NILP (replace
))
2944 if (lseek (fd
, XINT (beg
), 0) < 0)
2945 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2949 while (inserted
< total
)
2951 /* try is reserved in some compilers (Microsoft C) */
2952 int trytry
= min (total
- inserted
, 64 << 10);
2955 /* Allow quitting out of the actual I/O. */
2958 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, trytry
);
2975 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
2976 /* Determine file type from name and remove LFs from CR-LFs if the file
2977 is deemed to be a text file. */
2979 current_buffer
->buffer_file_type
2980 = call1 (Qfind_buffer_file_type
, filename
);
2981 if (NILP (current_buffer
->buffer_file_type
))
2984 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
2987 GPT
-= reduced_size
;
2988 GAP_SIZE
+= reduced_size
;
2989 inserted
-= reduced_size
;
2996 record_insert (point
, inserted
);
2998 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2999 offset_intervals (current_buffer
, point
, inserted
);
3005 /* Discard the unwind protect for closing the file. */
3009 error ("IO error reading %s: %s",
3010 XSTRING (filename
)->data
, strerror (errno
));
3017 if (!EQ (current_buffer
->undo_list
, Qt
))
3018 current_buffer
->undo_list
= Qnil
;
3020 stat (XSTRING (filename
)->data
, &st
);
3025 current_buffer
->modtime
= st
.st_mtime
;
3026 current_buffer
->filename
= filename
;
3029 SAVE_MODIFF
= MODIFF
;
3030 current_buffer
->auto_save_modified
= MODIFF
;
3031 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3032 #ifdef CLASH_DETECTION
3035 if (!NILP (current_buffer
->file_truename
))
3036 unlock_file (current_buffer
->file_truename
);
3037 unlock_file (filename
);
3039 #endif /* CLASH_DETECTION */
3041 Fsignal (Qfile_error
,
3042 Fcons (build_string ("not a regular file"),
3043 Fcons (filename
, Qnil
)));
3045 /* If visiting nonexistent file, return nil. */
3046 if (current_buffer
->modtime
== -1)
3047 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3050 /* Decode file format */
3053 insval
= call3 (Qformat_decode
,
3054 Qnil
, make_number (inserted
), visit
);
3055 CHECK_NUMBER (insval
, 0);
3056 inserted
= XFASTINT (insval
);
3059 if (inserted
> 0 && NILP (visit
) && total
> 0)
3060 signal_after_change (point
, 0, inserted
);
3064 p
= Vafter_insert_file_functions
;
3067 insval
= call1 (Fcar (p
), make_number (inserted
));
3070 CHECK_NUMBER (insval
, 0);
3071 inserted
= XFASTINT (insval
);
3079 val
= Fcons (filename
,
3080 Fcons (make_number (inserted
),
3083 RETURN_UNGCPRO (unbind_to (count
, val
));
3086 static Lisp_Object
build_annotations ();
3088 /* If build_annotations switched buffers, switch back to BUF.
3089 Kill the temporary buffer that was selected in the meantime. */
3092 build_annotations_unwind (buf
)
3097 if (XBUFFER (buf
) == current_buffer
)
3099 tembuf
= Fcurrent_buffer ();
3101 Fkill_buffer (tembuf
);
3105 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
3106 "r\nFWrite region to file: ",
3107 "Write current region into specified file.\n\
3108 When called from a program, takes three arguments:\n\
3109 START, END and FILENAME. START and END are buffer positions.\n\
3110 Optional fourth argument APPEND if non-nil means\n\
3111 append to existing file contents (if any).\n\
3112 Optional fifth argument VISIT if t means\n\
3113 set the last-save-file-modtime of buffer to this file's modtime\n\
3114 and mark buffer not modified.\n\
3115 If VISIT is a string, it is a second file name;\n\
3116 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3117 VISIT is also the file name to lock and unlock for clash detection.\n\
3118 If VISIT is neither t nor nil nor a string,\n\
3119 that means do not print the \"Wrote file\" message.\n\
3120 Kludgy feature: if START is a string, then that string is written\n\
3121 to the file, instead of any buffer contents, and END is ignored.")
3122 (start
, end
, filename
, append
, visit
)
3123 Lisp_Object start
, end
, filename
, append
, visit
;
3131 int count
= specpdl_ptr
- specpdl
;
3134 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3136 Lisp_Object handler
;
3137 Lisp_Object visit_file
;
3138 Lisp_Object annotations
;
3139 int visiting
, quietly
;
3140 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3141 struct buffer
*given_buffer
;
3143 int buffer_file_type
3144 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3147 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3148 error ("Cannot do file visiting in an indirect buffer");
3150 if (!NILP (start
) && !STRINGP (start
))
3151 validate_region (&start
, &end
);
3153 GCPRO2 (filename
, visit
);
3154 filename
= Fexpand_file_name (filename
, Qnil
);
3155 if (STRINGP (visit
))
3156 visit_file
= Fexpand_file_name (visit
, Qnil
);
3158 visit_file
= filename
;
3161 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3162 quietly
= !NILP (visit
);
3166 GCPRO4 (start
, filename
, annotations
, visit_file
);
3168 /* If the file name has special constructs in it,
3169 call the corresponding file handler. */
3170 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3171 /* If FILENAME has no handler, see if VISIT has one. */
3172 if (NILP (handler
) && STRINGP (visit
))
3173 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3175 if (!NILP (handler
))
3178 val
= call6 (handler
, Qwrite_region
, start
, end
,
3179 filename
, append
, visit
);
3183 SAVE_MODIFF
= MODIFF
;
3184 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3185 current_buffer
->filename
= visit_file
;
3191 /* Special kludge to simplify auto-saving. */
3194 XSETFASTINT (start
, BEG
);
3195 XSETFASTINT (end
, Z
);
3198 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3199 count1
= specpdl_ptr
- specpdl
;
3201 given_buffer
= current_buffer
;
3202 annotations
= build_annotations (start
, end
);
3203 if (current_buffer
!= given_buffer
)
3209 #ifdef CLASH_DETECTION
3211 lock_file (visit_file
);
3212 #endif /* CLASH_DETECTION */
3214 fn
= XSTRING (filename
)->data
;
3218 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3219 #else /* not DOS_NT */
3220 desc
= open (fn
, O_WRONLY
);
3221 #endif /* not DOS_NT */
3225 if (auto_saving
) /* Overwrite any previous version of autosave file */
3227 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3228 desc
= open (fn
, O_RDWR
);
3230 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3231 ? XSTRING (current_buffer
->filename
)->data
: 0,
3234 else /* Write to temporary name and rename if no errors */
3236 Lisp_Object temp_name
;
3237 temp_name
= Ffile_name_directory (filename
);
3239 if (!NILP (temp_name
))
3241 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3242 build_string ("$$SAVE$$")));
3243 fname
= XSTRING (filename
)->data
;
3244 fn
= XSTRING (temp_name
)->data
;
3245 desc
= creat_copy_attrs (fname
, fn
);
3248 /* If we can't open the temporary file, try creating a new
3249 version of the original file. VMS "creat" creates a
3250 new version rather than truncating an existing file. */
3253 desc
= creat (fn
, 0666);
3254 #if 0 /* This can clobber an existing file and fail to replace it,
3255 if the user runs out of space. */
3258 /* We can't make a new version;
3259 try to truncate and rewrite existing version if any. */
3261 desc
= open (fn
, O_RDWR
);
3267 desc
= creat (fn
, 0666);
3272 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3273 S_IREAD
| S_IWRITE
);
3274 #else /* not DOS_NT */
3275 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3276 #endif /* not DOS_NT */
3277 #endif /* not VMS */
3283 #ifdef CLASH_DETECTION
3285 if (!auto_saving
) unlock_file (visit_file
);
3287 #endif /* CLASH_DETECTION */
3288 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3291 record_unwind_protect (close_file_unwind
, make_number (desc
));
3294 if (lseek (desc
, 0, 2) < 0)
3296 #ifdef CLASH_DETECTION
3297 if (!auto_saving
) unlock_file (visit_file
);
3298 #endif /* CLASH_DETECTION */
3299 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3304 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3305 * if we do writes that don't end with a carriage return. Furthermore
3306 * it cannot handle writes of more then 16K. The modified
3307 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3308 * this EXCEPT for the last record (iff it doesn't end with a carriage
3309 * return). This implies that if your buffer doesn't end with a carriage
3310 * return, you get one free... tough. However it also means that if
3311 * we make two calls to sys_write (a la the following code) you can
3312 * get one at the gap as well. The easiest way to fix this (honest)
3313 * is to move the gap to the next newline (or the end of the buffer).
3318 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3319 move_gap (find_next_newline (GPT
, 1));
3325 if (STRINGP (start
))
3327 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3328 XSTRING (start
)->size
, 0, &annotations
);
3331 else if (XINT (start
) != XINT (end
))
3334 if (XINT (start
) < GPT
)
3336 register int end1
= XINT (end
);
3338 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3339 min (GPT
, end1
) - tem
, tem
, &annotations
);
3340 nwritten
+= min (GPT
, end1
) - tem
;
3344 if (XINT (end
) > GPT
&& !failure
)
3347 tem
= max (tem
, GPT
);
3348 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3350 nwritten
+= XINT (end
) - tem
;
3356 /* If file was empty, still need to write the annotations */
3357 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3365 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3366 Disk full in NFS may be reported here. */
3367 /* mib says that closing the file will try to write as fast as NFS can do
3368 it, and that means the fsync here is not crucial for autosave files. */
3369 if (!auto_saving
&& fsync (desc
) < 0)
3370 failure
= 1, save_errno
= errno
;
3373 /* Spurious "file has changed on disk" warnings have been
3374 observed on Suns as well.
3375 It seems that `close' can change the modtime, under nfs.
3377 (This has supposedly been fixed in Sunos 4,
3378 but who knows about all the other machines with NFS?) */
3381 /* On VMS and APOLLO, must do the stat after the close
3382 since closing changes the modtime. */
3385 /* Recall that #if defined does not work on VMS. */
3392 /* NFS can report a write failure now. */
3393 if (close (desc
) < 0)
3394 failure
= 1, save_errno
= errno
;
3397 /* If we wrote to a temporary name and had no errors, rename to real name. */
3401 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3409 /* Discard the unwind protect for close_file_unwind. */
3410 specpdl_ptr
= specpdl
+ count1
;
3411 /* Restore the original current buffer. */
3412 visit_file
= unbind_to (count
, visit_file
);
3414 #ifdef CLASH_DETECTION
3416 unlock_file (visit_file
);
3417 #endif /* CLASH_DETECTION */
3419 /* Do this before reporting IO error
3420 to avoid a "file has changed on disk" warning on
3421 next attempt to save. */
3423 current_buffer
->modtime
= st
.st_mtime
;
3426 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3430 SAVE_MODIFF
= MODIFF
;
3431 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3432 current_buffer
->filename
= visit_file
;
3433 update_mode_lines
++;
3439 message ("Wrote %s", XSTRING (visit_file
)->data
);
3444 Lisp_Object
merge ();
3446 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3447 "Return t if (car A) is numerically less than (car B).")
3451 return Flss (Fcar (a
), Fcar (b
));
3454 /* Build the complete list of annotations appropriate for writing out
3455 the text between START and END, by calling all the functions in
3456 write-region-annotate-functions and merging the lists they return.
3457 If one of these functions switches to a different buffer, we assume
3458 that buffer contains altered text. Therefore, the caller must
3459 make sure to restore the current buffer in all cases,
3460 as save-excursion would do. */
3463 build_annotations (start
, end
)
3464 Lisp_Object start
, end
;
3466 Lisp_Object annotations
;
3468 struct gcpro gcpro1
, gcpro2
;
3471 p
= Vwrite_region_annotate_functions
;
3472 GCPRO2 (annotations
, p
);
3475 struct buffer
*given_buffer
= current_buffer
;
3476 Vwrite_region_annotations_so_far
= annotations
;
3477 res
= call2 (Fcar (p
), start
, end
);
3478 /* If the function makes a different buffer current,
3479 assume that means this buffer contains altered text to be output.
3480 Reset START and END from the buffer bounds
3481 and discard all previous annotations because they should have
3482 been dealt with by this function. */
3483 if (current_buffer
!= given_buffer
)
3489 Flength (res
); /* Check basic validity of return value */
3490 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3494 /* Now do the same for annotation functions implied by the file-format */
3495 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
3496 p
= Vauto_save_file_format
;
3498 p
= current_buffer
->file_format
;
3501 struct buffer
*given_buffer
= current_buffer
;
3502 Vwrite_region_annotations_so_far
= annotations
;
3503 res
= call3 (Qformat_annotate_function
, Fcar (p
), start
, end
);
3504 if (current_buffer
!= given_buffer
)
3511 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3518 /* Write to descriptor DESC the LEN characters starting at ADDR,
3519 assuming they start at position POS in the buffer.
3520 Intersperse with them the annotations from *ANNOT
3521 (those which fall within the range of positions POS to POS + LEN),
3522 each at its appropriate position.
3524 Modify *ANNOT by discarding elements as we output them.
3525 The return value is negative in case of system call failure. */
3528 a_write (desc
, addr
, len
, pos
, annot
)
3530 register char *addr
;
3537 int lastpos
= pos
+ len
;
3539 while (NILP (*annot
) || CONSP (*annot
))
3541 tem
= Fcar_safe (Fcar (*annot
));
3542 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3543 nextpos
= XFASTINT (tem
);
3545 return e_write (desc
, addr
, lastpos
- pos
);
3548 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3550 addr
+= nextpos
- pos
;
3553 tem
= Fcdr (Fcar (*annot
));
3556 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3559 *annot
= Fcdr (*annot
);
3564 e_write (desc
, addr
, len
)
3566 register char *addr
;
3569 char buf
[16 * 1024];
3570 register char *p
, *end
;
3572 if (!EQ (current_buffer
->selective_display
, Qt
))
3573 return write (desc
, addr
, len
) - len
;
3577 end
= p
+ sizeof buf
;
3582 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3591 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3597 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3598 Sverify_visited_file_modtime
, 1, 1, 0,
3599 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3600 This means that the file has not been changed since it was visited or saved.")
3606 Lisp_Object handler
;
3608 CHECK_BUFFER (buf
, 0);
3611 if (!STRINGP (b
->filename
)) return Qt
;
3612 if (b
->modtime
== 0) return Qt
;
3614 /* If the file name has special constructs in it,
3615 call the corresponding file handler. */
3616 handler
= Ffind_file_name_handler (b
->filename
,
3617 Qverify_visited_file_modtime
);
3618 if (!NILP (handler
))
3619 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3621 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3623 /* If the file doesn't exist now and didn't exist before,
3624 we say that it isn't modified, provided the error is a tame one. */
3625 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3630 if (st
.st_mtime
== b
->modtime
3631 /* If both are positive, accept them if they are off by one second. */
3632 || (st
.st_mtime
> 0 && b
->modtime
> 0
3633 && (st
.st_mtime
== b
->modtime
+ 1
3634 || st
.st_mtime
== b
->modtime
- 1)))
3639 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3640 Sclear_visited_file_modtime
, 0, 0, 0,
3641 "Clear out records of last mod time of visited file.\n\
3642 Next attempt to save will certainly not complain of a discrepancy.")
3645 current_buffer
->modtime
= 0;
3649 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3650 Svisited_file_modtime
, 0, 0, 0,
3651 "Return the current buffer's recorded visited file modification time.\n\
3652 The value is a list of the form (HIGH . LOW), like the time values\n\
3653 that `file-attributes' returns.")
3656 return long_to_cons (current_buffer
->modtime
);
3659 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3660 Sset_visited_file_modtime
, 0, 1, 0,
3661 "Update buffer's recorded modification time from the visited file's time.\n\
3662 Useful if the buffer was not read from the file normally\n\
3663 or if the file itself has been changed for some known benign reason.\n\
3664 An argument specifies the modification time value to use\n\
3665 \(instead of that of the visited file), in the form of a list\n\
3666 \(HIGH . LOW) or (HIGH LOW).")
3668 Lisp_Object time_list
;
3670 if (!NILP (time_list
))
3671 current_buffer
->modtime
= cons_to_long (time_list
);
3674 register Lisp_Object filename
;
3676 Lisp_Object handler
;
3678 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3680 /* If the file name has special constructs in it,
3681 call the corresponding file handler. */
3682 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3683 if (!NILP (handler
))
3684 /* The handler can find the file name the same way we did. */
3685 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3686 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3687 current_buffer
->modtime
= st
.st_mtime
;
3697 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3698 Fsleep_for (make_number (1), Qnil
);
3699 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3700 Fsleep_for (make_number (1), Qnil
);
3701 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3702 Fsleep_for (make_number (1), Qnil
);
3712 /* Get visited file's mode to become the auto save file's mode. */
3713 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3714 /* But make sure we can overwrite it later! */
3715 auto_save_mode_bits
= st
.st_mode
| 0600;
3717 auto_save_mode_bits
= 0666;
3720 Fwrite_region (Qnil
, Qnil
,
3721 current_buffer
->auto_save_file_name
,
3726 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3729 close (XINT (desc
));
3733 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3734 "Auto-save all buffers that need it.\n\
3735 This is all buffers that have auto-saving enabled\n\
3736 and are changed since last auto-saved.\n\
3737 Auto-saving writes the buffer into a file\n\
3738 so that your editing is not lost if the system crashes.\n\
3739 This file is not the file you visited; that changes only when you save.\n\
3740 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3741 Non-nil first argument means do not print any message if successful.\n\
3742 Non-nil second argument means save only current buffer.")
3743 (no_message
, current_only
)
3744 Lisp_Object no_message
, current_only
;
3746 struct buffer
*old
= current_buffer
, *b
;
3747 Lisp_Object tail
, buf
;
3749 char *omessage
= echo_area_glyphs
;
3750 int omessage_length
= echo_area_glyphs_length
;
3751 extern int minibuf_level
;
3752 int do_handled_files
;
3755 int count
= specpdl_ptr
- specpdl
;
3758 /* Ordinarily don't quit within this function,
3759 but don't make it impossible to quit (in case we get hung in I/O). */
3763 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3764 point to non-strings reached from Vbuffer_alist. */
3770 if (!NILP (Vrun_hooks
))
3771 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3773 if (STRINGP (Vauto_save_list_file_name
))
3775 Lisp_Object listfile
;
3776 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
3778 listdesc
= open (XSTRING (listfile
)->data
,
3779 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3780 S_IREAD
| S_IWRITE
);
3781 #else /* not DOS_NT */
3782 listdesc
= creat (XSTRING (listfile
)->data
, 0666);
3783 #endif /* not DOS_NT */
3788 /* Arrange to close that file whether or not we get an error. */
3790 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3792 /* First, save all files which don't have handlers. If Emacs is
3793 crashing, the handlers may tweak what is causing Emacs to crash
3794 in the first place, and it would be a shame if Emacs failed to
3795 autosave perfectly ordinary files because it couldn't handle some
3797 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3798 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
3800 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3803 /* Record all the buffers that have auto save mode
3804 in the special file that lists them. For each of these buffers,
3805 Record visited name (if any) and auto save name. */
3806 if (STRINGP (b
->auto_save_file_name
)
3807 && listdesc
>= 0 && do_handled_files
== 0)
3809 if (!NILP (b
->filename
))
3811 write (listdesc
, XSTRING (b
->filename
)->data
,
3812 XSTRING (b
->filename
)->size
);
3814 write (listdesc
, "\n", 1);
3815 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3816 XSTRING (b
->auto_save_file_name
)->size
);
3817 write (listdesc
, "\n", 1);
3820 if (!NILP (current_only
)
3821 && b
!= current_buffer
)
3824 /* Don't auto-save indirect buffers.
3825 The base buffer takes care of it. */
3829 /* Check for auto save enabled
3830 and file changed since last auto save
3831 and file changed since last real save. */
3832 if (STRINGP (b
->auto_save_file_name
)
3833 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
3834 && b
->auto_save_modified
< BUF_MODIFF (b
)
3835 /* -1 means we've turned off autosaving for a while--see below. */
3836 && XINT (b
->save_length
) >= 0
3837 && (do_handled_files
3838 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3841 EMACS_TIME before_time
, after_time
;
3843 EMACS_GET_TIME (before_time
);
3845 /* If we had a failure, don't try again for 20 minutes. */
3846 if (b
->auto_save_failure_time
>= 0
3847 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3850 if ((XFASTINT (b
->save_length
) * 10
3851 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3852 /* A short file is likely to change a large fraction;
3853 spare the user annoying messages. */
3854 && XFASTINT (b
->save_length
) > 5000
3855 /* These messages are frequent and annoying for `*mail*'. */
3856 && !EQ (b
->filename
, Qnil
)
3857 && NILP (no_message
))
3859 /* It has shrunk too much; turn off auto-saving here. */
3860 message ("Buffer %s has shrunk a lot; auto save turned off there",
3861 XSTRING (b
->name
)->data
);
3862 /* Turn off auto-saving until there's a real save,
3863 and prevent any more warnings. */
3864 XSETINT (b
->save_length
, -1);
3865 Fsleep_for (make_number (1), Qnil
);
3868 set_buffer_internal (b
);
3869 if (!auto_saved
&& NILP (no_message
))
3870 message1 ("Auto-saving...");
3871 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3873 b
->auto_save_modified
= BUF_MODIFF (b
);
3874 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3875 set_buffer_internal (old
);
3877 EMACS_GET_TIME (after_time
);
3879 /* If auto-save took more than 60 seconds,
3880 assume it was an NFS failure that got a timeout. */
3881 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3882 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3886 /* Prevent another auto save till enough input events come in. */
3887 record_auto_save ();
3889 if (auto_saved
&& NILP (no_message
))
3892 message2 (omessage
, omessage_length
);
3894 message1 ("Auto-saving...done");
3900 unbind_to (count
, Qnil
);
3904 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3905 Sset_buffer_auto_saved
, 0, 0, 0,
3906 "Mark current buffer as auto-saved with its current text.\n\
3907 No auto-save file will be written until the buffer changes again.")
3910 current_buffer
->auto_save_modified
= MODIFF
;
3911 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3912 current_buffer
->auto_save_failure_time
= -1;
3916 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3917 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3918 "Clear any record of a recent auto-save failure in the current buffer.")
3921 current_buffer
->auto_save_failure_time
= -1;
3925 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3927 "Return t if buffer has been auto-saved since last read in or saved.")
3930 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3933 /* Reading and completing file names */
3934 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3936 /* In the string VAL, change each $ to $$ and return the result. */
3939 double_dollars (val
)
3942 register unsigned char *old
, *new;
3946 osize
= XSTRING (val
)->size
;
3947 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3948 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3949 if (*old
++ == '$') count
++;
3952 old
= XSTRING (val
)->data
;
3953 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3954 new = XSTRING (val
)->data
;
3955 for (n
= osize
; n
> 0; n
--)
3968 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3970 "Internal subroutine for read-file-name. Do not call this.")
3971 (string
, dir
, action
)
3972 Lisp_Object string
, dir
, action
;
3973 /* action is nil for complete, t for return list of completions,
3974 lambda for verify final value */
3976 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3978 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3985 /* No need to protect ACTION--we only compare it with t and nil. */
3986 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
3988 if (XSTRING (string
)->size
== 0)
3990 if (EQ (action
, Qlambda
))
3998 orig_string
= string
;
3999 string
= Fsubstitute_in_file_name (string
);
4000 changed
= NILP (Fstring_equal (string
, orig_string
));
4001 name
= Ffile_name_nondirectory (string
);
4002 val
= Ffile_name_directory (string
);
4004 realdir
= Fexpand_file_name (val
, realdir
);
4009 specdir
= Ffile_name_directory (string
);
4010 val
= Ffile_name_completion (name
, realdir
);
4015 return double_dollars (string
);
4019 if (!NILP (specdir
))
4020 val
= concat2 (specdir
, val
);
4022 return double_dollars (val
);
4025 #endif /* not VMS */
4029 if (EQ (action
, Qt
))
4030 return Ffile_name_all_completions (name
, realdir
);
4031 /* Only other case actually used is ACTION = lambda */
4033 /* Supposedly this helps commands such as `cd' that read directory names,
4034 but can someone explain how it helps them? -- RMS */
4035 if (XSTRING (name
)->size
== 0)
4038 return Ffile_exists_p (string
);
4041 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4042 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4043 Value is not expanded---you must call `expand-file-name' yourself.\n\
4044 Default name to DEFAULT if user enters a null string.\n\
4045 (If DEFAULT is omitted, the visited file name is used,\n\
4046 except that if INITIAL is specified, that combined with DIR is used.)\n\
4047 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4048 Non-nil and non-t means also require confirmation after completion.\n\
4049 Fifth arg INITIAL specifies text to start with.\n\
4050 DIR defaults to current buffer's directory default.")
4051 (prompt
, dir
, defalt
, mustmatch
, initial
)
4052 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4054 Lisp_Object val
, insdef
, insdef1
, tem
;
4055 struct gcpro gcpro1
, gcpro2
;
4056 register char *homedir
;
4060 dir
= current_buffer
->directory
;
4063 if (! NILP (initial
))
4064 defalt
= Fexpand_file_name (initial
, dir
);
4066 defalt
= current_buffer
->filename
;
4069 /* If dir starts with user's homedir, change that to ~. */
4070 homedir
= (char *) egetenv ("HOME");
4073 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4074 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4076 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4077 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4078 XSTRING (dir
)->data
[0] = '~';
4081 if (insert_default_directory
)
4084 if (!NILP (initial
))
4086 Lisp_Object args
[2], pos
;
4090 insdef
= Fconcat (2, args
);
4091 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4092 insdef1
= Fcons (double_dollars (insdef
), pos
);
4095 insdef1
= double_dollars (insdef
);
4097 else if (!NILP (initial
))
4100 insdef1
= Fcons (double_dollars (insdef
), 0);
4103 insdef
= Qnil
, insdef1
= Qnil
;
4106 count
= specpdl_ptr
- specpdl
;
4107 specbind (intern ("completion-ignore-case"), Qt
);
4110 GCPRO2 (insdef
, defalt
);
4111 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4112 dir
, mustmatch
, insdef1
,
4113 Qfile_name_history
);
4116 unbind_to (count
, Qnil
);
4121 error ("No file name specified");
4122 tem
= Fstring_equal (val
, insdef
);
4123 if (!NILP (tem
) && !NILP (defalt
))
4125 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4130 error ("No default file name");
4132 return Fsubstitute_in_file_name (val
);
4135 #if 0 /* Old version */
4136 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4137 /* Don't confuse make-docfile by having two doc strings for this function.
4138 make-docfile does not pay attention to #if, for good reason! */
4140 (prompt
, dir
, defalt
, mustmatch
, initial
)
4141 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4143 Lisp_Object val
, insdef
, tem
;
4144 struct gcpro gcpro1
, gcpro2
;
4145 register char *homedir
;
4149 dir
= current_buffer
->directory
;
4151 defalt
= current_buffer
->filename
;
4153 /* If dir starts with user's homedir, change that to ~. */
4154 homedir
= (char *) egetenv ("HOME");
4157 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4158 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4160 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4161 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4162 XSTRING (dir
)->data
[0] = '~';
4165 if (!NILP (initial
))
4167 else if (insert_default_directory
)
4170 insdef
= build_string ("");
4173 count
= specpdl_ptr
- specpdl
;
4174 specbind (intern ("completion-ignore-case"), Qt
);
4177 GCPRO2 (insdef
, defalt
);
4178 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4180 insert_default_directory
? insdef
: Qnil
,
4181 Qfile_name_history
);
4184 unbind_to (count
, Qnil
);
4189 error ("No file name specified");
4190 tem
= Fstring_equal (val
, insdef
);
4191 if (!NILP (tem
) && !NILP (defalt
))
4193 return Fsubstitute_in_file_name (val
);
4195 #endif /* Old version */
4199 Qexpand_file_name
= intern ("expand-file-name");
4200 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4201 Qdirectory_file_name
= intern ("directory-file-name");
4202 Qfile_name_directory
= intern ("file-name-directory");
4203 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4204 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4205 Qfile_name_as_directory
= intern ("file-name-as-directory");
4206 Qcopy_file
= intern ("copy-file");
4207 Qmake_directory_internal
= intern ("make-directory-internal");
4208 Qdelete_directory
= intern ("delete-directory");
4209 Qdelete_file
= intern ("delete-file");
4210 Qrename_file
= intern ("rename-file");
4211 Qadd_name_to_file
= intern ("add-name-to-file");
4212 Qmake_symbolic_link
= intern ("make-symbolic-link");
4213 Qfile_exists_p
= intern ("file-exists-p");
4214 Qfile_executable_p
= intern ("file-executable-p");
4215 Qfile_readable_p
= intern ("file-readable-p");
4216 Qfile_symlink_p
= intern ("file-symlink-p");
4217 Qfile_writable_p
= intern ("file-writable-p");
4218 Qfile_directory_p
= intern ("file-directory-p");
4219 Qfile_regular_p
= intern ("file-regular-p");
4220 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4221 Qfile_modes
= intern ("file-modes");
4222 Qset_file_modes
= intern ("set-file-modes");
4223 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4224 Qinsert_file_contents
= intern ("insert-file-contents");
4225 Qwrite_region
= intern ("write-region");
4226 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4227 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4229 staticpro (&Qexpand_file_name
);
4230 staticpro (&Qsubstitute_in_file_name
);
4231 staticpro (&Qdirectory_file_name
);
4232 staticpro (&Qfile_name_directory
);
4233 staticpro (&Qfile_name_nondirectory
);
4234 staticpro (&Qunhandled_file_name_directory
);
4235 staticpro (&Qfile_name_as_directory
);
4236 staticpro (&Qcopy_file
);
4237 staticpro (&Qmake_directory_internal
);
4238 staticpro (&Qdelete_directory
);
4239 staticpro (&Qdelete_file
);
4240 staticpro (&Qrename_file
);
4241 staticpro (&Qadd_name_to_file
);
4242 staticpro (&Qmake_symbolic_link
);
4243 staticpro (&Qfile_exists_p
);
4244 staticpro (&Qfile_executable_p
);
4245 staticpro (&Qfile_readable_p
);
4246 staticpro (&Qfile_symlink_p
);
4247 staticpro (&Qfile_writable_p
);
4248 staticpro (&Qfile_directory_p
);
4249 staticpro (&Qfile_regular_p
);
4250 staticpro (&Qfile_accessible_directory_p
);
4251 staticpro (&Qfile_modes
);
4252 staticpro (&Qset_file_modes
);
4253 staticpro (&Qfile_newer_than_file_p
);
4254 staticpro (&Qinsert_file_contents
);
4255 staticpro (&Qwrite_region
);
4256 staticpro (&Qverify_visited_file_modtime
);
4258 Qfile_name_history
= intern ("file-name-history");
4259 Fset (Qfile_name_history
, Qnil
);
4260 staticpro (&Qfile_name_history
);
4262 Qfile_error
= intern ("file-error");
4263 staticpro (&Qfile_error
);
4264 Qfile_already_exists
= intern("file-already-exists");
4265 staticpro (&Qfile_already_exists
);
4268 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4269 staticpro (&Qfind_buffer_file_type
);
4272 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
4273 "*Format in which to write auto-save files.\n\
4274 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
4275 If it is t, which is the default, auto-save files are written in the\n\
4276 same format as a regular save would use.");
4277 Vauto_save_file_format
= Qt
;
4279 Qformat_decode
= intern ("format-decode");
4280 staticpro (&Qformat_decode
);
4281 Qformat_annotate_function
= intern ("format-annotate-function");
4282 staticpro (&Qformat_annotate_function
);
4284 Qcar_less_than_car
= intern ("car-less-than-car");
4285 staticpro (&Qcar_less_than_car
);
4287 Fput (Qfile_error
, Qerror_conditions
,
4288 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4289 Fput (Qfile_error
, Qerror_message
,
4290 build_string ("File error"));
4292 Fput (Qfile_already_exists
, Qerror_conditions
,
4293 Fcons (Qfile_already_exists
,
4294 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4295 Fput (Qfile_already_exists
, Qerror_message
,
4296 build_string ("File already exists"));
4298 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4299 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4300 insert_default_directory
= 1;
4302 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4303 "*Non-nil means write new files with record format `stmlf'.\n\
4304 nil means use format `var'. This variable is meaningful only on VMS.");
4305 vms_stmlf_recfm
= 0;
4307 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4308 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4309 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4312 The first argument given to HANDLER is the name of the I/O primitive\n\
4313 to be handled; the remaining arguments are the arguments that were\n\
4314 passed to that primitive. For example, if you do\n\
4315 (file-exists-p FILENAME)\n\
4316 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4317 (funcall HANDLER 'file-exists-p FILENAME)\n\
4318 The function `find-file-name-handler' checks this list for a handler\n\
4319 for its argument.");
4320 Vfile_name_handler_alist
= Qnil
;
4322 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4323 "A list of functions to be called at the end of `insert-file-contents'.\n\
4324 Each is passed one argument, the number of bytes inserted. It should return\n\
4325 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4326 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4327 responsible for calling the after-insert-file-functions if appropriate.");
4328 Vafter_insert_file_functions
= Qnil
;
4330 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4331 "A list of functions to be called at the start of `write-region'.\n\
4332 Each is passed two arguments, START and END as for `write-region'. It should\n\
4333 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4334 inserted at the specified positions of the file being written (1 means to\n\
4335 insert before the first byte written). The POSITIONs must be sorted into\n\
4336 increasing order. If there are several functions in the list, the several\n\
4337 lists are merged destructively.");
4338 Vwrite_region_annotate_functions
= Qnil
;
4340 DEFVAR_LISP ("write-region-annotations-so-far",
4341 &Vwrite_region_annotations_so_far
,
4342 "When an annotation function is called, this holds the previous annotations.\n\
4343 These are the annotations made by other annotation functions\n\
4344 that were already called. See also `write-region-annotate-functions'.");
4345 Vwrite_region_annotations_so_far
= Qnil
;
4347 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4348 "A list of file name handlers that temporarily should not be used.\n\
4349 This applies only to the operation `inhibit-file-name-operation'.");
4350 Vinhibit_file_name_handlers
= Qnil
;
4352 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4353 "The operation for which `inhibit-file-name-handlers' is applicable.");
4354 Vinhibit_file_name_operation
= Qnil
;
4356 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4357 "File name in which we write a list of all auto save file names.");
4358 Vauto_save_list_file_name
= Qnil
;
4360 defsubr (&Sfind_file_name_handler
);
4361 defsubr (&Sfile_name_directory
);
4362 defsubr (&Sfile_name_nondirectory
);
4363 defsubr (&Sunhandled_file_name_directory
);
4364 defsubr (&Sfile_name_as_directory
);
4365 defsubr (&Sdirectory_file_name
);
4366 defsubr (&Smake_temp_name
);
4367 defsubr (&Sexpand_file_name
);
4368 defsubr (&Ssubstitute_in_file_name
);
4369 defsubr (&Scopy_file
);
4370 defsubr (&Smake_directory_internal
);
4371 defsubr (&Sdelete_directory
);
4372 defsubr (&Sdelete_file
);
4373 defsubr (&Srename_file
);
4374 defsubr (&Sadd_name_to_file
);
4376 defsubr (&Smake_symbolic_link
);
4377 #endif /* S_IFLNK */
4379 defsubr (&Sdefine_logical_name
);
4382 defsubr (&Ssysnetunam
);
4383 #endif /* HPUX_NET */
4384 defsubr (&Sfile_name_absolute_p
);
4385 defsubr (&Sfile_exists_p
);
4386 defsubr (&Sfile_executable_p
);
4387 defsubr (&Sfile_readable_p
);
4388 defsubr (&Sfile_writable_p
);
4389 defsubr (&Sfile_symlink_p
);
4390 defsubr (&Sfile_directory_p
);
4391 defsubr (&Sfile_accessible_directory_p
);
4392 defsubr (&Sfile_regular_p
);
4393 defsubr (&Sfile_modes
);
4394 defsubr (&Sset_file_modes
);
4395 defsubr (&Sset_default_file_modes
);
4396 defsubr (&Sdefault_file_modes
);
4397 defsubr (&Sfile_newer_than_file_p
);
4398 defsubr (&Sinsert_file_contents
);
4399 defsubr (&Swrite_region
);
4400 defsubr (&Scar_less_than_car
);
4401 defsubr (&Sverify_visited_file_modtime
);
4402 defsubr (&Sclear_visited_file_modtime
);
4403 defsubr (&Svisited_file_modtime
);
4404 defsubr (&Sset_visited_file_modtime
);
4405 defsubr (&Sdo_auto_save
);
4406 defsubr (&Sset_buffer_auto_saved
);
4407 defsubr (&Sclear_buffer_auto_save_failure
);
4408 defsubr (&Srecent_auto_save_p
);
4410 defsubr (&Sread_file_name_internal
);
4411 defsubr (&Sread_file_name
);
4414 defsubr (&Sunix_sync
);