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])
662 && !IS_ANY_SEP (dst
[slen
- 2])
670 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
672 "Returns the file name of the directory named DIR.\n\
673 This is the name of the file that holds the data for the directory DIR.\n\
674 This operation exists because a directory is also a file, but its name as\n\
675 a directory is different from its name as a file.\n\
676 In Unix-syntax, this function just removes the final slash.\n\
677 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
678 it returns a file name such as \"[X]Y.DIR.1\".")
680 Lisp_Object directory
;
685 CHECK_STRING (directory
, 0);
687 if (NILP (directory
))
690 /* If the file name has special constructs in it,
691 call the corresponding file handler. */
692 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
694 return call2 (handler
, Qdirectory_file_name
, directory
);
697 /* 20 extra chars is insufficient for VMS, since we might perform a
698 logical name translation. an equivalence string can be up to 255
699 chars long, so grab that much extra space... - sss */
700 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
702 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
704 directory_file_name (XSTRING (directory
)->data
, buf
);
705 return build_string (buf
);
708 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
709 "Generate temporary file name (string) starting with PREFIX (a string).\n\
710 The Emacs process number forms part of the result,\n\
711 so there is no danger of generating a name being used by another process.")
716 val
= concat2 (prefix
, build_string ("XXXXXX"));
717 mktemp (XSTRING (val
)->data
);
721 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
722 "Convert FILENAME to absolute, and canonicalize it.\n\
723 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
724 (does not start with slash); if DEFAULT is nil or missing,\n\
725 the current buffer's value of default-directory is used.\n\
726 Path components that are `.' are removed, and \n\
727 path components followed by `..' are removed, along with the `..' itself;\n\
728 note that these simplifications are done without checking the resulting\n\
729 paths in the file system.\n\
730 An initial `~/' expands to your home directory.\n\
731 An initial `~USER/' expands to USER's home directory.\n\
732 See also the function `substitute-in-file-name'.")
734 Lisp_Object name
, defalt
;
738 register unsigned char *newdir
, *p
, *o
;
740 unsigned char *target
;
743 unsigned char * colon
= 0;
744 unsigned char * close
= 0;
745 unsigned char * slash
= 0;
746 unsigned char * brack
= 0;
747 int lbrack
= 0, rbrack
= 0;
751 /* Demacs 1.1.2 91/10/20 Manabu Higashida */
754 unsigned char *tmp
, *defdir
;
758 CHECK_STRING (name
, 0);
760 /* If the file name has special constructs in it,
761 call the corresponding file handler. */
762 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
764 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
766 /* Use the buffer's default-directory if DEFALT is omitted. */
768 defalt
= current_buffer
->directory
;
769 CHECK_STRING (defalt
, 1);
773 handler
= Ffind_file_name_handler (defalt
, Qexpand_file_name
);
775 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
778 o
= XSTRING (defalt
)->data
;
780 /* Make sure DEFALT is properly expanded.
781 It would be better to do this down below where we actually use
782 defalt. Unfortunately, calling Fexpand_file_name recursively
783 could invoke GC, and the strings might be relocated. This would
784 be annoying because we have pointers into strings lying around
785 that would need adjusting, and people would add new pointers to
786 the code and forget to adjust them, resulting in intermittent bugs.
787 Putting this call here avoids all that crud.
789 The EQ test avoids infinite recursion. */
790 if (! NILP (defalt
) && !EQ (defalt
, name
)
791 /* This saves time in a common case. */
792 && ! (XSTRING (defalt
)->size
>= 3
793 && IS_DIRECTORY_SEP (XSTRING (defalt
)->data
[0])
794 && IS_DEVICE_SEP (XSTRING (defalt
)->data
[1])))
799 defalt
= Fexpand_file_name (defalt
, Qnil
);
804 /* Filenames on VMS are always upper case. */
805 name
= Fupcase (name
);
807 #ifdef FILE_SYSTEM_CASE
808 name
= FILE_SYSTEM_CASE (name
);
811 nm
= XSTRING (name
)->data
;
814 /* First map all backslashes to slashes. */
815 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
819 /* Now strip drive name. */
821 unsigned char *colon
= rindex (nm
, ':');
829 if (!IS_DIRECTORY_SEP (*nm
))
831 defdir
= alloca (MAXPATHLEN
+ 1);
832 relpath
= getdefdir (tolower (drive
) - 'a' + 1, defdir
);
838 /* Handle // and /~ in middle of file name
839 by discarding everything through the first / of that sequence. */
843 /* Since we know the path is absolute, we can assume that each
844 element starts with a "/". */
846 /* "//" anywhere isn't necessarily hairy; we just start afresh
847 with the second slash. */
848 if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
849 #if defined (APOLLO) || defined (WINDOWSNT)
850 /* // at start of filename is meaningful on Apollo
851 and WindowsNT systems */
853 #endif /* APOLLO || WINDOWSNT */
857 /* "~" is hairy as the start of any path element. */
858 if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '~')
864 /* If nm is absolute, flush ...// and detect /./ and /../.
865 If no /./ or /../ we can return right away. */
867 IS_DIRECTORY_SEP (nm
[0])
873 /* If it turns out that the filename we want to return is just a
874 suffix of FILENAME, we don't need to go through and edit
875 things; we just need to construct a new string using data
876 starting at the middle of FILENAME. If we set lose to a
877 non-zero value, that means we've discovered that we can't do
884 /* Since we know the path is absolute, we can assume that each
885 element starts with a "/". */
887 /* "." and ".." are hairy. */
888 if (IS_DIRECTORY_SEP (p
[0])
890 && (IS_DIRECTORY_SEP (p
[2])
892 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
899 /* if dev:[dir]/, move nm to / */
900 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
901 nm
= (brack
? brack
+ 1 : colon
+ 1);
910 /* VMS pre V4.4,convert '-'s in filenames. */
911 if (lbrack
== rbrack
)
913 if (dots
< 2) /* this is to allow negative version numbers */
918 if (lbrack
> rbrack
&&
919 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
920 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
926 /* count open brackets, reset close bracket pointer */
927 if (p
[0] == '[' || p
[0] == '<')
929 /* count close brackets, set close bracket pointer */
930 if (p
[0] == ']' || p
[0] == '>')
932 /* detect ][ or >< */
933 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
935 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
936 nm
= p
+ 1, lose
= 1;
937 if (p
[0] == ':' && (colon
|| slash
))
938 /* if dev1:[dir]dev2:, move nm to dev2: */
944 /* if /pathname/dev:, move nm to dev: */
947 /* if node::dev:, move colon following dev */
948 else if (colon
&& colon
[-1] == ':')
950 /* if dev1:dev2:, move nm to dev2: */
951 else if (colon
&& colon
[-1] != ':')
956 if (p
[0] == ':' && !colon
)
962 if (lbrack
== rbrack
)
965 else if (p
[0] == '.')
974 return build_string (sys_translate_unix (nm
));
977 if (nm
== XSTRING (name
)->data
)
979 return build_string (nm
);
980 #endif /* not DOS_NT */
984 /* Now determine directory to start with and put it in newdir */
988 if (nm
[0] == '~') /* prefix ~ */
990 if (IS_DIRECTORY_SEP (nm
[1])
994 || nm
[1] == 0) /* ~ by itself */
996 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
997 newdir
= (unsigned char *) "";
999 /* Problem when expanding "~\" if HOME is not on current drive.
1000 Ulrich Leodolter, Wed Jan 11 10:20:35 1995 */
1001 if (newdir
[1] == ':')
1003 dostounix_filename (newdir
);
1007 nm
++; /* Don't leave the slash in nm. */
1010 else /* ~user/filename */
1012 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1017 o
= (unsigned char *) alloca (p
- nm
+ 1);
1018 bcopy ((char *) nm
, o
, p
- nm
);
1022 newdir
= (unsigned char *) egetenv ("HOME");
1023 dostounix_filename (newdir
);
1024 #else /* not WINDOWSNT */
1025 pw
= (struct passwd
*) getpwnam (o
+ 1);
1028 newdir
= (unsigned char *) pw
-> pw_dir
;
1030 nm
= p
+ 1; /* skip the terminator */
1035 #endif /* not WINDOWSNT */
1037 /* If we don't find a user of that name, leave the name
1038 unchanged; don't move nm forward to p. */
1042 if (!IS_ANY_SEP (nm
[0])
1045 #endif /* not VMS */
1051 newdir
= XSTRING (defalt
)->data
;
1055 if (newdir
== 0 && relpath
)
1060 /* Get rid of any slash at the end of newdir. */
1061 int length
= strlen (newdir
);
1062 /* Adding `length > 1 &&' makes ~ expand into / when homedir
1063 is the root dir. People disagree about whether that is right.
1064 Anyway, we can't take the risk of this change now. */
1066 if (newdir
[1] != ':' && length
> 1)
1068 if (IS_DIRECTORY_SEP (newdir
[length
- 1]))
1070 unsigned char *temp
= (unsigned char *) alloca (length
);
1071 bcopy (newdir
, temp
, length
- 1);
1072 temp
[length
- 1] = 0;
1080 /* Now concatenate the directory and name to new space in the stack frame */
1081 tlen
+= strlen (nm
) + 1;
1083 /* Add reserved space for drive name. (The Microsoft x86 compiler
1084 produces incorrect code if the following two lines are combined.) */
1085 target
= (unsigned char *) alloca (tlen
+ 2);
1087 #else /* not DOS_NT */
1088 target
= (unsigned char *) alloca (tlen
);
1089 #endif /* not DOS_NT */
1095 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1096 strcpy (target
, newdir
);
1099 file_name_as_directory (target
, newdir
);
1102 strcat (target
, nm
);
1104 if (index (target
, '/'))
1105 strcpy (target
, sys_translate_unix (target
));
1108 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1116 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1122 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1123 /* brackets are offset from each other by 2 */
1126 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1127 /* convert [foo][bar] to [bar] */
1128 while (o
[-1] != '[' && o
[-1] != '<')
1130 else if (*p
== '-' && *o
!= '.')
1133 else if (p
[0] == '-' && o
[-1] == '.' &&
1134 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1135 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1139 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1140 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1142 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1144 /* else [foo.-] ==> [-] */
1150 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1151 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1157 if (!IS_DIRECTORY_SEP (*p
))
1161 else if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
1162 #if defined (APOLLO) || defined (WINDOWSNT)
1163 /* // at start of filename is meaningful in Apollo
1164 and WindowsNT systems */
1172 else if (IS_DIRECTORY_SEP (p
[0])
1174 && (IS_DIRECTORY_SEP (p
[2])
1177 /* If "/." is the entire filename, keep the "/". Otherwise,
1178 just delete the whole "/.". */
1179 if (o
== target
&& p
[2] == '\0')
1183 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1184 /* `/../' is the "superroot" on certain file systems. */
1186 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1188 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1190 #if defined (APOLLO) || defined (WINDOWSNT)
1192 && IS_DIRECTORY_SEP (o
[-1]) && IS_DIRECTORY_SEP (o
[0]))
1195 #endif /* APOLLO || WINDOWSNT */
1196 if (o
== target
&& IS_ANY_SEP (*o
))
1204 #endif /* not VMS */
1208 /* at last, set drive name. */
1209 if (target
[1] != ':'
1211 /* Allow network paths that look like "\\foo" */
1212 && !(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1]))
1213 #endif /* WINDOWSNT */
1217 target
[0] = (drive
< 0 ? getdisk () + 'A' : drive
);
1222 return make_string (target
, o
- target
);
1226 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1227 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1228 "Convert FILENAME to absolute, and canonicalize it.\n\
1229 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1230 (does not start with slash); if DEFAULT is nil or missing,\n\
1231 the current buffer's value of default-directory is used.\n\
1232 Filenames containing `.' or `..' as components are simplified;\n\
1233 initial `~/' expands to your home directory.\n\
1234 See also the function `substitute-in-file-name'.")
1236 Lisp_Object name
, defalt
;
1240 register unsigned char *newdir
, *p
, *o
;
1242 unsigned char *target
;
1246 unsigned char * colon
= 0;
1247 unsigned char * close
= 0;
1248 unsigned char * slash
= 0;
1249 unsigned char * brack
= 0;
1250 int lbrack
= 0, rbrack
= 0;
1254 CHECK_STRING (name
, 0);
1257 /* Filenames on VMS are always upper case. */
1258 name
= Fupcase (name
);
1261 nm
= XSTRING (name
)->data
;
1263 /* If nm is absolute, flush ...// and detect /./ and /../.
1264 If no /./ or /../ we can return right away. */
1276 if (p
[0] == '/' && p
[1] == '/'
1278 /* // at start of filename is meaningful on Apollo system */
1283 if (p
[0] == '/' && p
[1] == '~')
1284 nm
= p
+ 1, lose
= 1;
1285 if (p
[0] == '/' && p
[1] == '.'
1286 && (p
[2] == '/' || p
[2] == 0
1287 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1293 /* if dev:[dir]/, move nm to / */
1294 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1295 nm
= (brack
? brack
+ 1 : colon
+ 1);
1296 lbrack
= rbrack
= 0;
1304 /* VMS pre V4.4,convert '-'s in filenames. */
1305 if (lbrack
== rbrack
)
1307 if (dots
< 2) /* this is to allow negative version numbers */
1312 if (lbrack
> rbrack
&&
1313 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1314 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1320 /* count open brackets, reset close bracket pointer */
1321 if (p
[0] == '[' || p
[0] == '<')
1322 lbrack
++, brack
= 0;
1323 /* count close brackets, set close bracket pointer */
1324 if (p
[0] == ']' || p
[0] == '>')
1325 rbrack
++, brack
= p
;
1326 /* detect ][ or >< */
1327 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1329 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1330 nm
= p
+ 1, lose
= 1;
1331 if (p
[0] == ':' && (colon
|| slash
))
1332 /* if dev1:[dir]dev2:, move nm to dev2: */
1338 /* if /pathname/dev:, move nm to dev: */
1341 /* if node::dev:, move colon following dev */
1342 else if (colon
&& colon
[-1] == ':')
1344 /* if dev1:dev2:, move nm to dev2: */
1345 else if (colon
&& colon
[-1] != ':')
1350 if (p
[0] == ':' && !colon
)
1356 if (lbrack
== rbrack
)
1359 else if (p
[0] == '.')
1367 if (index (nm
, '/'))
1368 return build_string (sys_translate_unix (nm
));
1370 if (nm
== XSTRING (name
)->data
)
1372 return build_string (nm
);
1376 /* Now determine directory to start with and put it in NEWDIR */
1380 if (nm
[0] == '~') /* prefix ~ */
1385 || nm
[1] == 0)/* ~/filename */
1387 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1388 newdir
= (unsigned char *) "";
1391 nm
++; /* Don't leave the slash in nm. */
1394 else /* ~user/filename */
1396 /* Get past ~ to user */
1397 unsigned char *user
= nm
+ 1;
1398 /* Find end of name. */
1399 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1400 int len
= ptr
? ptr
- user
: strlen (user
);
1402 unsigned char *ptr1
= index (user
, ':');
1403 if (ptr1
!= 0 && ptr1
- user
< len
)
1406 /* Copy the user name into temp storage. */
1407 o
= (unsigned char *) alloca (len
+ 1);
1408 bcopy ((char *) user
, o
, len
);
1411 /* Look up the user name. */
1412 pw
= (struct passwd
*) getpwnam (o
+ 1);
1414 error ("\"%s\" isn't a registered user", o
+ 1);
1416 newdir
= (unsigned char *) pw
->pw_dir
;
1418 /* Discard the user name from NM. */
1425 #endif /* not VMS */
1429 defalt
= current_buffer
->directory
;
1430 CHECK_STRING (defalt
, 1);
1431 newdir
= XSTRING (defalt
)->data
;
1434 /* Now concatenate the directory and name to new space in the stack frame */
1436 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1437 target
= (unsigned char *) alloca (tlen
);
1443 if (nm
[0] == 0 || nm
[0] == '/')
1444 strcpy (target
, newdir
);
1447 file_name_as_directory (target
, newdir
);
1450 strcat (target
, nm
);
1452 if (index (target
, '/'))
1453 strcpy (target
, sys_translate_unix (target
));
1456 /* Now canonicalize by removing /. and /foo/.. if they appear */
1464 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1470 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1471 /* brackets are offset from each other by 2 */
1474 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1475 /* convert [foo][bar] to [bar] */
1476 while (o
[-1] != '[' && o
[-1] != '<')
1478 else if (*p
== '-' && *o
!= '.')
1481 else if (p
[0] == '-' && o
[-1] == '.' &&
1482 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1483 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1487 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1488 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1490 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1492 /* else [foo.-] ==> [-] */
1498 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1499 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1509 else if (!strncmp (p
, "//", 2)
1511 /* // at start of filename is meaningful in Apollo system */
1519 else if (p
[0] == '/' && p
[1] == '.' &&
1520 (p
[2] == '/' || p
[2] == 0))
1522 else if (!strncmp (p
, "/..", 3)
1523 /* `/../' is the "superroot" on certain file systems. */
1525 && (p
[3] == '/' || p
[3] == 0))
1527 while (o
!= target
&& *--o
!= '/')
1530 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1534 if (o
== target
&& *o
== '/')
1542 #endif /* not VMS */
1545 return make_string (target
, o
- target
);
1549 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1550 Ssubstitute_in_file_name
, 1, 1, 0,
1551 "Substitute environment variables referred to in FILENAME.\n\
1552 `$FOO' where FOO is an environment variable name means to substitute\n\
1553 the value of that variable. The variable name should be terminated\n\
1554 with a character not a letter, digit or underscore; otherwise, enclose\n\
1555 the entire variable name in braces.\n\
1556 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1557 On VMS, `$' substitution is not done; this function does little and only\n\
1558 duplicates what `expand-file-name' does.")
1564 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1565 unsigned char *target
;
1567 int substituted
= 0;
1569 Lisp_Object handler
;
1571 CHECK_STRING (string
, 0);
1573 /* If the file name has special constructs in it,
1574 call the corresponding file handler. */
1575 handler
= Ffind_file_name_handler (string
, Qsubstitute_in_file_name
);
1576 if (!NILP (handler
))
1577 return call2 (handler
, Qsubstitute_in_file_name
, string
);
1579 nm
= XSTRING (string
)->data
;
1581 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
1582 substituted
= !strcmp (nm
, XSTRING (string
)->data
);
1584 endp
= nm
+ XSTRING (string
)->size
;
1586 /* If /~ or // appears, discard everything through first slash. */
1588 for (p
= nm
; p
!= endp
; p
++)
1592 /* // at start of file name is meaningful in Apollo system */
1593 (p
[0] == '/' && p
- 1 != nm
)
1594 #else /* not APOLLO */
1596 (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1597 #else /* not WINDOWSNT */
1599 #endif /* not WINDOWSNT */
1600 #endif /* not APOLLO */
1605 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1607 || IS_DIRECTORY_SEP (p
[-1])))
1613 if (p
[0] && p
[1] == ':')
1622 return build_string (nm
);
1625 /* See if any variables are substituted into the string
1626 and find the total length of their values in `total' */
1628 for (p
= nm
; p
!= endp
;)
1638 /* "$$" means a single "$" */
1647 while (p
!= endp
&& *p
!= '}') p
++;
1648 if (*p
!= '}') goto missingclose
;
1654 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1658 /* Copy out the variable name */
1659 target
= (unsigned char *) alloca (s
- o
+ 1);
1660 strncpy (target
, o
, s
- o
);
1663 strupr (target
); /* $home == $HOME etc. */
1666 /* Get variable value */
1667 o
= (unsigned char *) egetenv (target
);
1668 if (!o
) goto badvar
;
1669 total
+= strlen (o
);
1676 /* If substitution required, recopy the string and do it */
1677 /* Make space in stack frame for the new copy */
1678 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1681 /* Copy the rest of the name through, replacing $ constructs with values */
1698 while (p
!= endp
&& *p
!= '}') p
++;
1699 if (*p
!= '}') goto missingclose
;
1705 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1709 /* Copy out the variable name */
1710 target
= (unsigned char *) alloca (s
- o
+ 1);
1711 strncpy (target
, o
, s
- o
);
1714 strupr (target
); /* $home == $HOME etc. */
1717 /* Get variable value */
1718 o
= (unsigned char *) egetenv (target
);
1728 /* If /~ or // appears, discard everything through first slash. */
1730 for (p
= xnm
; p
!= x
; p
++)
1733 /* // at start of file name is meaningful in Apollo system */
1734 || (p
[0] == '/' && p
- 1 != xnm
)
1735 #else /* not APOLLO */
1737 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1738 #else /* not WINDOWSNT */
1740 #endif /* not WINDOWSNT */
1741 #endif /* not APOLLO */
1743 && p
!= nm
&& IS_DIRECTORY_SEP (p
[-1]))
1746 else if (p
[0] && p
[1] == ':')
1750 return make_string (xnm
, x
- xnm
);
1753 error ("Bad format environment-variable substitution");
1755 error ("Missing \"}\" in environment-variable substitution");
1757 error ("Substituting nonexistent environment variable \"%s\"", target
);
1760 #endif /* not VMS */
1763 /* A slightly faster and more convenient way to get
1764 (directory-file-name (expand-file-name FOO)). */
1767 expand_and_dir_to_file (filename
, defdir
)
1768 Lisp_Object filename
, defdir
;
1770 register Lisp_Object abspath
;
1772 abspath
= Fexpand_file_name (filename
, defdir
);
1775 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1776 if (c
== ':' || c
== ']' || c
== '>')
1777 abspath
= Fdirectory_file_name (abspath
);
1780 /* Remove final slash, if any (unless path is root).
1781 stat behaves differently depending! */
1782 if (XSTRING (abspath
)->size
> 1
1783 && IS_DIRECTORY_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1])
1784 && !IS_DEVICE_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
-2]))
1785 /* We cannot take shortcuts; they might be wrong for magic file names. */
1786 abspath
= Fdirectory_file_name (abspath
);
1791 /* Signal an error if the file ABSNAME already exists.
1792 If INTERACTIVE is nonzero, ask the user whether to proceed,
1793 and bypass the error if the user says to go ahead.
1794 QUERYSTRING is a name for the action that is being considered
1796 *STATPTR is used to store the stat information if the file exists.
1797 If the file does not exist, STATPTR->st_mode is set to 0. */
1800 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
1801 Lisp_Object absname
;
1802 unsigned char *querystring
;
1804 struct stat
*statptr
;
1806 register Lisp_Object tem
;
1807 struct stat statbuf
;
1808 struct gcpro gcpro1
;
1810 /* stat is a good way to tell whether the file exists,
1811 regardless of what access permissions it has. */
1812 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1815 Fsignal (Qfile_already_exists
,
1816 Fcons (build_string ("File already exists"),
1817 Fcons (absname
, Qnil
)));
1819 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1820 XSTRING (absname
)->data
, querystring
));
1823 Fsignal (Qfile_already_exists
,
1824 Fcons (build_string ("File already exists"),
1825 Fcons (absname
, Qnil
)));
1832 statptr
->st_mode
= 0;
1837 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1838 "fCopy file: \nFCopy %s to file: \np\nP",
1839 "Copy FILE to NEWNAME. Both args must be strings.\n\
1840 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1841 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1842 A number as third arg means request confirmation if NEWNAME already exists.\n\
1843 This is what happens in interactive use with M-x.\n\
1844 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1845 last-modified time as the old one. (This works on only some systems.)\n\
1846 A prefix arg makes KEEP-TIME non-nil.")
1847 (filename
, newname
, ok_if_already_exists
, keep_date
)
1848 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1851 char buf
[16 * 1024];
1852 struct stat st
, out_st
;
1853 Lisp_Object handler
;
1854 struct gcpro gcpro1
, gcpro2
;
1855 int count
= specpdl_ptr
- specpdl
;
1856 int input_file_statable_p
;
1858 GCPRO2 (filename
, newname
);
1859 CHECK_STRING (filename
, 0);
1860 CHECK_STRING (newname
, 1);
1861 filename
= Fexpand_file_name (filename
, Qnil
);
1862 newname
= Fexpand_file_name (newname
, Qnil
);
1864 /* If the input file name has special constructs in it,
1865 call the corresponding file handler. */
1866 handler
= Ffind_file_name_handler (filename
, Qcopy_file
);
1867 /* Likewise for output file name. */
1869 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1870 if (!NILP (handler
))
1871 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, filename
, newname
,
1872 ok_if_already_exists
, keep_date
));
1874 if (NILP (ok_if_already_exists
)
1875 || INTEGERP (ok_if_already_exists
))
1876 barf_or_query_if_file_exists (newname
, "copy to it",
1877 INTEGERP (ok_if_already_exists
), &out_st
);
1878 else if (stat (XSTRING (newname
)->data
, &out_st
) < 0)
1881 ifd
= open (XSTRING (filename
)->data
, O_RDONLY
);
1883 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1885 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1887 /* We can only copy regular files and symbolic links. Other files are not
1889 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1892 if (out_st
.st_mode
!= 0
1893 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
1896 report_file_error ("Input and output files are the same",
1897 Fcons (filename
, Fcons (newname
, Qnil
)));
1901 #if defined (S_ISREG) && defined (S_ISLNK)
1902 if (input_file_statable_p
)
1904 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1906 #if defined (EISDIR)
1907 /* Get a better looking error message. */
1910 report_file_error ("Non-regular file", Fcons (filename
, Qnil
));
1913 #endif /* S_ISREG && S_ISLNK */
1916 /* Create the copy file with the same record format as the input file */
1917 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1920 /* System's default file type was set to binary by _fmode in emacs.c. */
1921 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1922 #else /* not MSDOS */
1923 ofd
= creat (XSTRING (newname
)->data
, 0666);
1924 #endif /* not MSDOS */
1927 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1929 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1933 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1934 if (write (ofd
, buf
, n
) != n
)
1935 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1938 /* Closing the output clobbers the file times on some systems. */
1939 if (close (ofd
) < 0)
1940 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1942 if (input_file_statable_p
)
1944 if (!NILP (keep_date
))
1946 EMACS_TIME atime
, mtime
;
1947 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1948 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1949 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
1950 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1952 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1957 /* Discard the unwind protects. */
1958 specpdl_ptr
= specpdl
+ count
;
1964 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1965 Smake_directory_internal
, 1, 1, 0,
1966 "Create a directory. One argument, a file name string.")
1968 Lisp_Object dirname
;
1971 Lisp_Object handler
;
1973 CHECK_STRING (dirname
, 0);
1974 dirname
= Fexpand_file_name (dirname
, Qnil
);
1976 handler
= Ffind_file_name_handler (dirname
, Qmake_directory_internal
);
1977 if (!NILP (handler
))
1978 return call2 (handler
, Qmake_directory_internal
, dirname
);
1980 dir
= XSTRING (dirname
)->data
;
1983 if (mkdir (dir
) != 0)
1985 if (mkdir (dir
, 0777) != 0)
1987 report_file_error ("Creating directory", Flist (1, &dirname
));
1992 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1993 "Delete a directory. One argument, a file name or directory name string.")
1995 Lisp_Object dirname
;
1998 Lisp_Object handler
;
2000 CHECK_STRING (dirname
, 0);
2001 dirname
= Fdirectory_file_name (Fexpand_file_name (dirname
, Qnil
));
2002 dir
= XSTRING (dirname
)->data
;
2004 handler
= Ffind_file_name_handler (dirname
, Qdelete_directory
);
2005 if (!NILP (handler
))
2006 return call2 (handler
, Qdelete_directory
, dirname
);
2008 if (rmdir (dir
) != 0)
2009 report_file_error ("Removing directory", Flist (1, &dirname
));
2014 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2015 "Delete specified file. One argument, a file name string.\n\
2016 If file has multiple names, it continues to exist with the other names.")
2018 Lisp_Object filename
;
2020 Lisp_Object handler
;
2021 CHECK_STRING (filename
, 0);
2022 filename
= Fexpand_file_name (filename
, Qnil
);
2024 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2025 if (!NILP (handler
))
2026 return call2 (handler
, Qdelete_file
, filename
);
2028 if (0 > unlink (XSTRING (filename
)->data
))
2029 report_file_error ("Removing old name", Flist (1, &filename
));
2034 internal_delete_file_1 (ignore
)
2040 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2043 internal_delete_file (filename
)
2044 Lisp_Object filename
;
2046 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2047 Qt
, internal_delete_file_1
));
2050 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2051 "fRename file: \nFRename %s to file: \np",
2052 "Rename FILE as NEWNAME. Both args strings.\n\
2053 If file has names other than FILE, it continues to have those names.\n\
2054 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2055 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2056 A number as third arg means request confirmation if NEWNAME already exists.\n\
2057 This is what happens in interactive use with M-x.")
2058 (filename
, newname
, ok_if_already_exists
)
2059 Lisp_Object filename
, newname
, ok_if_already_exists
;
2062 Lisp_Object args
[2];
2064 Lisp_Object handler
;
2065 struct gcpro gcpro1
, gcpro2
;
2067 GCPRO2 (filename
, newname
);
2068 CHECK_STRING (filename
, 0);
2069 CHECK_STRING (newname
, 1);
2070 filename
= Fexpand_file_name (filename
, Qnil
);
2071 newname
= Fexpand_file_name (newname
, Qnil
);
2073 /* If the file name has special constructs in it,
2074 call the corresponding file handler. */
2075 handler
= Ffind_file_name_handler (filename
, Qrename_file
);
2077 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2078 if (!NILP (handler
))
2079 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2080 filename
, newname
, ok_if_already_exists
));
2082 if (NILP (ok_if_already_exists
)
2083 || INTEGERP (ok_if_already_exists
))
2084 barf_or_query_if_file_exists (newname
, "rename to it",
2085 INTEGERP (ok_if_already_exists
), 0);
2087 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2090 if (!MoveFile (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2091 #else /* not WINDOWSNT */
2092 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
2093 || 0 > unlink (XSTRING (filename
)->data
))
2094 #endif /* not WINDOWSNT */
2098 /* Why two? And why doesn't MS document what MoveFile will return? */
2099 if (GetLastError () == ERROR_FILE_EXISTS
2100 || GetLastError () == ERROR_ALREADY_EXISTS
)
2101 #else /* not WINDOWSNT */
2103 #endif /* not WINDOWSNT */
2105 Fcopy_file (filename
, newname
,
2106 /* We have already prompted if it was an integer,
2107 so don't have copy-file prompt again. */
2108 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2109 Fdelete_file (filename
);
2116 report_file_error ("Renaming", Flist (2, args
));
2119 report_file_error ("Renaming", Flist (2, &filename
));
2126 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2127 "fAdd name to file: \nFName to add to %s: \np",
2128 "Give FILE additional name NEWNAME. Both args strings.\n\
2129 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2130 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2131 A number as third arg means request confirmation if NEWNAME already exists.\n\
2132 This is what happens in interactive use with M-x.")
2133 (filename
, newname
, ok_if_already_exists
)
2134 Lisp_Object filename
, newname
, ok_if_already_exists
;
2137 Lisp_Object args
[2];
2139 Lisp_Object handler
;
2140 struct gcpro gcpro1
, gcpro2
;
2142 GCPRO2 (filename
, newname
);
2143 CHECK_STRING (filename
, 0);
2144 CHECK_STRING (newname
, 1);
2145 filename
= Fexpand_file_name (filename
, Qnil
);
2146 newname
= Fexpand_file_name (newname
, Qnil
);
2148 /* If the file name has special constructs in it,
2149 call the corresponding file handler. */
2150 handler
= Ffind_file_name_handler (filename
, Qadd_name_to_file
);
2151 if (!NILP (handler
))
2152 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
2153 newname
, ok_if_already_exists
));
2155 /* If the new name has special constructs in it,
2156 call the corresponding file handler. */
2157 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2158 if (!NILP (handler
))
2159 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
2160 newname
, ok_if_already_exists
));
2162 if (NILP (ok_if_already_exists
)
2163 || INTEGERP (ok_if_already_exists
))
2164 barf_or_query_if_file_exists (newname
, "make it a new name",
2165 INTEGERP (ok_if_already_exists
), 0);
2167 /* Windows does not support this operation. */
2168 report_file_error ("Adding new name", Flist (2, &filename
));
2169 #else /* not WINDOWSNT */
2171 unlink (XSTRING (newname
)->data
);
2172 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2177 report_file_error ("Adding new name", Flist (2, args
));
2179 report_file_error ("Adding new name", Flist (2, &filename
));
2182 #endif /* not WINDOWSNT */
2189 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2190 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2191 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2192 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2193 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2194 A number as third arg means request confirmation if LINKNAME already exists.\n\
2195 This happens for interactive use with M-x.")
2196 (filename
, linkname
, ok_if_already_exists
)
2197 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2200 Lisp_Object args
[2];
2202 Lisp_Object handler
;
2203 struct gcpro gcpro1
, gcpro2
;
2205 GCPRO2 (filename
, linkname
);
2206 CHECK_STRING (filename
, 0);
2207 CHECK_STRING (linkname
, 1);
2208 /* If the link target has a ~, we must expand it to get
2209 a truly valid file name. Otherwise, do not expand;
2210 we want to permit links to relative file names. */
2211 if (XSTRING (filename
)->data
[0] == '~')
2212 filename
= Fexpand_file_name (filename
, Qnil
);
2213 linkname
= Fexpand_file_name (linkname
, Qnil
);
2215 /* If the file name has special constructs in it,
2216 call the corresponding file handler. */
2217 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2218 if (!NILP (handler
))
2219 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2220 linkname
, ok_if_already_exists
));
2222 /* If the new link name has special constructs in it,
2223 call the corresponding file handler. */
2224 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2225 if (!NILP (handler
))
2226 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2227 linkname
, ok_if_already_exists
));
2229 if (NILP (ok_if_already_exists
)
2230 || INTEGERP (ok_if_already_exists
))
2231 barf_or_query_if_file_exists (linkname
, "make it a link",
2232 INTEGERP (ok_if_already_exists
), 0);
2233 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2235 /* If we didn't complain already, silently delete existing file. */
2236 if (errno
== EEXIST
)
2238 unlink (XSTRING (linkname
)->data
);
2239 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2249 report_file_error ("Making symbolic link", Flist (2, args
));
2251 report_file_error ("Making symbolic link", Flist (2, &filename
));
2257 #endif /* S_IFLNK */
2261 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2262 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2263 "Define the job-wide logical name NAME to have the value STRING.\n\
2264 If STRING is nil or a null string, the logical name NAME is deleted.")
2266 Lisp_Object varname
;
2269 CHECK_STRING (varname
, 0);
2271 delete_logical_name (XSTRING (varname
)->data
);
2274 CHECK_STRING (string
, 1);
2276 if (XSTRING (string
)->size
== 0)
2277 delete_logical_name (XSTRING (varname
)->data
);
2279 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2288 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2289 "Open a network connection to PATH using LOGIN as the login string.")
2291 Lisp_Object path
, login
;
2295 CHECK_STRING (path
, 0);
2296 CHECK_STRING (login
, 0);
2298 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2300 if (netresult
== -1)
2305 #endif /* HPUX_NET */
2307 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2309 "Return t if file FILENAME specifies an absolute path name.\n\
2310 On Unix, this is a name starting with a `/' or a `~'.")
2312 Lisp_Object filename
;
2316 CHECK_STRING (filename
, 0);
2317 ptr
= XSTRING (filename
)->data
;
2318 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2320 /* ??? This criterion is probably wrong for '<'. */
2321 || index (ptr
, ':') || index (ptr
, '<')
2322 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2326 || (*ptr
!= 0 && ptr
[1] == ':' && (ptr
[2] == '/' || ptr
[2] == '\\'))
2334 /* Return nonzero if file FILENAME exists and can be executed. */
2337 check_executable (filename
)
2341 int len
= strlen (filename
);
2344 if (stat (filename
, &st
) < 0)
2346 return (S_ISREG (st
.st_mode
)
2348 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2349 || stricmp (suffix
, ".exe") == 0
2350 || stricmp (suffix
, ".bat") == 0));
2351 #else /* not DOS_NT */
2353 return (eaccess (filename
, 1) >= 0);
2355 /* Access isn't quite right because it uses the real uid
2356 and we really want to test with the effective uid.
2357 But Unix doesn't give us a right way to do it. */
2358 return (access (filename
, 1) >= 0);
2360 #endif /* not DOS_NT */
2363 /* Return nonzero if file FILENAME exists and can be written. */
2366 check_writable (filename
)
2371 if (stat (filename
, &st
) < 0)
2373 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2374 #else /* not MSDOS */
2376 return (eaccess (filename
, 2) >= 0);
2378 /* Access isn't quite right because it uses the real uid
2379 and we really want to test with the effective uid.
2380 But Unix doesn't give us a right way to do it.
2381 Opening with O_WRONLY could work for an ordinary file,
2382 but would lose for directories. */
2383 return (access (filename
, 2) >= 0);
2385 #endif /* not MSDOS */
2388 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2389 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2390 See also `file-readable-p' and `file-attributes'.")
2392 Lisp_Object filename
;
2394 Lisp_Object abspath
;
2395 Lisp_Object handler
;
2396 struct stat statbuf
;
2398 CHECK_STRING (filename
, 0);
2399 abspath
= Fexpand_file_name (filename
, Qnil
);
2401 /* If the file name has special constructs in it,
2402 call the corresponding file handler. */
2403 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2404 if (!NILP (handler
))
2405 return call2 (handler
, Qfile_exists_p
, abspath
);
2407 return (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2410 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2411 "Return t if FILENAME can be executed by you.\n\
2412 For a directory, this means you can access files in that directory.")
2414 Lisp_Object filename
;
2417 Lisp_Object abspath
;
2418 Lisp_Object handler
;
2420 CHECK_STRING (filename
, 0);
2421 abspath
= Fexpand_file_name (filename
, Qnil
);
2423 /* If the file name has special constructs in it,
2424 call the corresponding file handler. */
2425 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2426 if (!NILP (handler
))
2427 return call2 (handler
, Qfile_executable_p
, abspath
);
2429 return (check_executable (XSTRING (abspath
)->data
) ? Qt
: Qnil
);
2432 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2433 "Return t if file FILENAME exists and you can read it.\n\
2434 See also `file-exists-p' and `file-attributes'.")
2436 Lisp_Object filename
;
2438 Lisp_Object abspath
;
2439 Lisp_Object handler
;
2442 CHECK_STRING (filename
, 0);
2443 abspath
= Fexpand_file_name (filename
, Qnil
);
2445 /* If the file name has special constructs in it,
2446 call the corresponding file handler. */
2447 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2448 if (!NILP (handler
))
2449 return call2 (handler
, Qfile_readable_p
, abspath
);
2451 desc
= open (XSTRING (abspath
)->data
, O_RDONLY
);
2458 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2460 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2461 "Return t if file FILENAME can be written or created by you.")
2463 Lisp_Object filename
;
2465 Lisp_Object abspath
, dir
;
2466 Lisp_Object handler
;
2467 struct stat statbuf
;
2469 CHECK_STRING (filename
, 0);
2470 abspath
= Fexpand_file_name (filename
, Qnil
);
2472 /* If the file name has special constructs in it,
2473 call the corresponding file handler. */
2474 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2475 if (!NILP (handler
))
2476 return call2 (handler
, Qfile_writable_p
, abspath
);
2478 if (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0)
2479 return (check_writable (XSTRING (abspath
)->data
)
2481 dir
= Ffile_name_directory (abspath
);
2484 dir
= Fdirectory_file_name (dir
);
2488 dir
= Fdirectory_file_name (dir
);
2490 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2494 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2495 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2496 The value is the name of the file to which it is linked.\n\
2497 Otherwise returns nil.")
2499 Lisp_Object filename
;
2506 Lisp_Object handler
;
2508 CHECK_STRING (filename
, 0);
2509 filename
= Fexpand_file_name (filename
, Qnil
);
2511 /* If the file name has special constructs in it,
2512 call the corresponding file handler. */
2513 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2514 if (!NILP (handler
))
2515 return call2 (handler
, Qfile_symlink_p
, filename
);
2520 buf
= (char *) xmalloc (bufsize
);
2521 bzero (buf
, bufsize
);
2522 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2523 if (valsize
< bufsize
) break;
2524 /* Buffer was not long enough */
2533 val
= make_string (buf
, valsize
);
2536 #else /* not S_IFLNK */
2538 #endif /* not S_IFLNK */
2541 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2542 "Return t if file FILENAME is the name of a directory as a file.\n\
2543 A directory name spec may be given instead; then the value is t\n\
2544 if the directory so specified exists and really is a directory.")
2546 Lisp_Object filename
;
2548 register Lisp_Object abspath
;
2550 Lisp_Object handler
;
2552 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2554 /* If the file name has special constructs in it,
2555 call the corresponding file handler. */
2556 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2557 if (!NILP (handler
))
2558 return call2 (handler
, Qfile_directory_p
, abspath
);
2560 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2562 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2565 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2566 "Return t if file FILENAME is the name of a directory as a file,\n\
2567 and files in that directory can be opened by you. In order to use a\n\
2568 directory as a buffer's current directory, this predicate must return true.\n\
2569 A directory name spec may be given instead; then the value is t\n\
2570 if the directory so specified exists and really is a readable and\n\
2571 searchable directory.")
2573 Lisp_Object filename
;
2575 Lisp_Object handler
;
2577 struct gcpro gcpro1
;
2579 /* If the file name has special constructs in it,
2580 call the corresponding file handler. */
2581 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2582 if (!NILP (handler
))
2583 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2585 /* It's an unlikely combination, but yes we really do need to gcpro:
2586 Suppose that file-accessible-directory-p has no handler, but
2587 file-directory-p does have a handler; this handler causes a GC which
2588 relocates the string in `filename'; and finally file-directory-p
2589 returns non-nil. Then we would end up passing a garbaged string
2590 to file-executable-p. */
2592 tem
= (NILP (Ffile_directory_p (filename
))
2593 || NILP (Ffile_executable_p (filename
)));
2595 return tem
? Qnil
: Qt
;
2598 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2599 "Return t if file FILENAME is the name of a regular file.\n\
2600 This is the sort of file that holds an ordinary stream of data bytes.")
2602 Lisp_Object filename
;
2604 register Lisp_Object abspath
;
2606 Lisp_Object handler
;
2608 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2610 /* If the file name has special constructs in it,
2611 call the corresponding file handler. */
2612 handler
= Ffind_file_name_handler (abspath
, Qfile_regular_p
);
2613 if (!NILP (handler
))
2614 return call2 (handler
, Qfile_regular_p
, abspath
);
2616 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2618 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2621 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2622 "Return mode bits of FILE, as an integer.")
2624 Lisp_Object filename
;
2626 Lisp_Object abspath
;
2628 Lisp_Object handler
;
2630 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2632 /* If the file name has special constructs in it,
2633 call the corresponding file handler. */
2634 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2635 if (!NILP (handler
))
2636 return call2 (handler
, Qfile_modes
, abspath
);
2638 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2641 if (check_executable (XSTRING (abspath
)->data
))
2642 st
.st_mode
|= S_IEXEC
;
2645 return make_number (st
.st_mode
& 07777);
2648 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2649 "Set mode bits of FILE to MODE (an integer).\n\
2650 Only the 12 low bits of MODE are used.")
2652 Lisp_Object filename
, mode
;
2654 Lisp_Object abspath
;
2655 Lisp_Object handler
;
2657 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2658 CHECK_NUMBER (mode
, 1);
2660 /* If the file name has special constructs in it,
2661 call the corresponding file handler. */
2662 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2663 if (!NILP (handler
))
2664 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2666 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2667 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2672 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2673 "Set the file permission bits for newly created files.\n\
2674 The argument MODE should be an integer; only the low 9 bits are used.\n\
2675 This setting is inherited by subprocesses.")
2679 CHECK_NUMBER (mode
, 0);
2681 umask ((~ XINT (mode
)) & 0777);
2686 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2687 "Return the default file protection for created files.\n\
2688 The value is an integer.")
2694 realmask
= umask (0);
2697 XSETINT (value
, (~ realmask
) & 0777);
2703 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2704 "Tell Unix to finish all pending disk updates.")
2713 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2714 "Return t if file FILE1 is newer than file FILE2.\n\
2715 If FILE1 does not exist, the answer is nil;\n\
2716 otherwise, if FILE2 does not exist, the answer is t.")
2718 Lisp_Object file1
, file2
;
2720 Lisp_Object abspath1
, abspath2
;
2723 Lisp_Object handler
;
2724 struct gcpro gcpro1
, gcpro2
;
2726 CHECK_STRING (file1
, 0);
2727 CHECK_STRING (file2
, 0);
2730 GCPRO2 (abspath1
, file2
);
2731 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2732 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2735 /* If the file name has special constructs in it,
2736 call the corresponding file handler. */
2737 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2739 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2740 if (!NILP (handler
))
2741 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2743 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2746 mtime1
= st
.st_mtime
;
2748 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2751 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2755 Lisp_Object Qfind_buffer_file_type
;
2758 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2760 "Insert contents of file FILENAME after point.\n\
2761 Returns list of absolute file name and length of data inserted.\n\
2762 If second argument VISIT is non-nil, the buffer's visited filename\n\
2763 and last save file modtime are set, and it is marked unmodified.\n\
2764 If visiting and the file does not exist, visiting is completed\n\
2765 before the error is signaled.\n\n\
2766 The optional third and fourth arguments BEG and END\n\
2767 specify what portion of the file to insert.\n\
2768 If VISIT is non-nil, BEG and END must be nil.\n\
2769 If optional fifth argument REPLACE is non-nil,\n\
2770 it means replace the current buffer contents (in the accessible portion)\n\
2771 with the file contents. This is better than simply deleting and inserting\n\
2772 the whole thing because (1) it preserves some marker positions\n\
2773 and (2) it puts less data in the undo list.")
2774 (filename
, visit
, beg
, end
, replace
)
2775 Lisp_Object filename
, visit
, beg
, end
, replace
;
2779 register int inserted
= 0;
2780 register int how_much
;
2781 int count
= specpdl_ptr
- specpdl
;
2782 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2783 Lisp_Object handler
, val
, insval
;
2786 int not_regular
= 0;
2788 if (current_buffer
->base_buffer
&& ! NILP (visit
))
2789 error ("Cannot do file visiting in an indirect buffer");
2791 if (!NILP (current_buffer
->read_only
))
2792 Fbarf_if_buffer_read_only ();
2797 GCPRO3 (filename
, val
, p
);
2799 CHECK_STRING (filename
, 0);
2800 filename
= Fexpand_file_name (filename
, Qnil
);
2802 /* If the file name has special constructs in it,
2803 call the corresponding file handler. */
2804 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2805 if (!NILP (handler
))
2807 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2808 visit
, beg
, end
, replace
);
2815 if (stat (XSTRING (filename
)->data
, &st
) < 0)
2817 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
2818 || fstat (fd
, &st
) < 0)
2819 #endif /* not APOLLO */
2821 if (fd
>= 0) close (fd
);
2824 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2831 /* This code will need to be changed in order to work on named
2832 pipes, and it's probably just not worth it. So we should at
2833 least signal an error. */
2834 if (!S_ISREG (st
.st_mode
))
2837 Fsignal (Qfile_error
,
2838 Fcons (build_string ("not a regular file"),
2839 Fcons (filename
, Qnil
)));
2847 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
2850 /* Replacement should preserve point as it preserves markers. */
2851 if (!NILP (replace
))
2852 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2854 record_unwind_protect (close_file_unwind
, make_number (fd
));
2856 /* Supposedly happens on VMS. */
2858 error ("File size is negative");
2860 if (!NILP (beg
) || !NILP (end
))
2862 error ("Attempt to visit less than an entire file");
2865 CHECK_NUMBER (beg
, 0);
2867 XSETFASTINT (beg
, 0);
2870 CHECK_NUMBER (end
, 0);
2873 XSETINT (end
, st
.st_size
);
2874 if (XINT (end
) != st
.st_size
)
2875 error ("maximum buffer size exceeded");
2878 /* If requested, replace the accessible part of the buffer
2879 with the file contents. Avoid replacing text at the
2880 beginning or end of the buffer that matches the file contents;
2881 that preserves markers pointing to the unchanged parts. */
2883 /* On MSDOS, replace mode doesn't really work, except for binary files,
2884 and it's not worth supporting just for them. */
2885 if (!NILP (replace
))
2888 XSETFASTINT (beg
, 0);
2889 XSETFASTINT (end
, st
.st_size
);
2890 del_range_1 (BEGV
, ZV
, 0);
2892 #else /* not DOS_NT */
2893 if (!NILP (replace
))
2895 unsigned char buffer
[1 << 14];
2896 int same_at_start
= BEGV
;
2897 int same_at_end
= ZV
;
2902 /* Count how many chars at the start of the file
2903 match the text at the beginning of the buffer. */
2908 nread
= read (fd
, buffer
, sizeof buffer
);
2910 error ("IO error reading %s: %s",
2911 XSTRING (filename
)->data
, strerror (errno
));
2912 else if (nread
== 0)
2915 while (bufpos
< nread
&& same_at_start
< ZV
2916 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2917 same_at_start
++, bufpos
++;
2918 /* If we found a discrepancy, stop the scan.
2919 Otherwise loop around and scan the next bufferfull. */
2920 if (bufpos
!= nread
)
2924 /* If the file matches the buffer completely,
2925 there's no need to replace anything. */
2926 if (same_at_start
- BEGV
== st
.st_size
)
2930 /* Truncate the buffer to the size of the file. */
2931 del_range_1 (same_at_start
, same_at_end
, 0);
2936 /* Count how many chars at the end of the file
2937 match the text at the end of the buffer. */
2940 int total_read
, nread
, bufpos
, curpos
, trial
;
2942 /* At what file position are we now scanning? */
2943 curpos
= st
.st_size
- (ZV
- same_at_end
);
2944 /* If the entire file matches the buffer tail, stop the scan. */
2947 /* How much can we scan in the next step? */
2948 trial
= min (curpos
, sizeof buffer
);
2949 if (lseek (fd
, curpos
- trial
, 0) < 0)
2950 report_file_error ("Setting file position",
2951 Fcons (filename
, Qnil
));
2954 while (total_read
< trial
)
2956 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2958 error ("IO error reading %s: %s",
2959 XSTRING (filename
)->data
, strerror (errno
));
2960 total_read
+= nread
;
2962 /* Scan this bufferfull from the end, comparing with
2963 the Emacs buffer. */
2964 bufpos
= total_read
;
2965 /* Compare with same_at_start to avoid counting some buffer text
2966 as matching both at the file's beginning and at the end. */
2967 while (bufpos
> 0 && same_at_end
> same_at_start
2968 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2969 same_at_end
--, bufpos
--;
2970 /* If we found a discrepancy, stop the scan.
2971 Otherwise loop around and scan the preceding bufferfull. */
2974 /* If display current starts at beginning of line,
2975 keep it that way. */
2976 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
2977 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
2981 /* Don't try to reuse the same piece of text twice. */
2982 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2984 same_at_end
+= overlap
;
2986 /* Arrange to read only the nonmatching middle part of the file. */
2987 XSETFASTINT (beg
, same_at_start
- BEGV
);
2988 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
2990 del_range_1 (same_at_start
, same_at_end
, 0);
2991 /* Insert from the file at the proper position. */
2992 SET_PT (same_at_start
);
2994 #endif /* not DOS_NT */
2996 total
= XINT (end
) - XINT (beg
);
2999 register Lisp_Object temp
;
3001 /* Make sure point-max won't overflow after this insertion. */
3002 XSETINT (temp
, total
);
3003 if (total
!= XINT (temp
))
3004 error ("maximum buffer size exceeded");
3007 if (NILP (visit
) && total
> 0)
3008 prepare_to_modify_buffer (point
, point
);
3011 if (GAP_SIZE
< total
)
3012 make_gap (total
- GAP_SIZE
);
3014 if (XINT (beg
) != 0 || !NILP (replace
))
3016 if (lseek (fd
, XINT (beg
), 0) < 0)
3017 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3021 while (inserted
< total
)
3023 /* try is reserved in some compilers (Microsoft C) */
3024 int trytry
= min (total
- inserted
, 64 << 10);
3027 /* Allow quitting out of the actual I/O. */
3030 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, trytry
);
3047 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3048 /* Determine file type from name and remove LFs from CR-LFs if the file
3049 is deemed to be a text file. */
3051 current_buffer
->buffer_file_type
3052 = call1 (Qfind_buffer_file_type
, filename
);
3053 if (NILP (current_buffer
->buffer_file_type
))
3056 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
3059 GPT
-= reduced_size
;
3060 GAP_SIZE
+= reduced_size
;
3061 inserted
-= reduced_size
;
3068 record_insert (point
, inserted
);
3070 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3071 offset_intervals (current_buffer
, point
, inserted
);
3077 /* Discard the unwind protect for closing the file. */
3081 error ("IO error reading %s: %s",
3082 XSTRING (filename
)->data
, strerror (errno
));
3089 if (!EQ (current_buffer
->undo_list
, Qt
))
3090 current_buffer
->undo_list
= Qnil
;
3092 stat (XSTRING (filename
)->data
, &st
);
3097 current_buffer
->modtime
= st
.st_mtime
;
3098 current_buffer
->filename
= filename
;
3101 SAVE_MODIFF
= MODIFF
;
3102 current_buffer
->auto_save_modified
= MODIFF
;
3103 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3104 #ifdef CLASH_DETECTION
3107 if (!NILP (current_buffer
->file_truename
))
3108 unlock_file (current_buffer
->file_truename
);
3109 unlock_file (filename
);
3111 #endif /* CLASH_DETECTION */
3113 Fsignal (Qfile_error
,
3114 Fcons (build_string ("not a regular file"),
3115 Fcons (filename
, Qnil
)));
3117 /* If visiting nonexistent file, return nil. */
3118 if (current_buffer
->modtime
== -1)
3119 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3122 /* Decode file format */
3125 insval
= call3 (Qformat_decode
,
3126 Qnil
, make_number (inserted
), visit
);
3127 CHECK_NUMBER (insval
, 0);
3128 inserted
= XFASTINT (insval
);
3131 if (inserted
> 0 && NILP (visit
) && total
> 0)
3132 signal_after_change (point
, 0, inserted
);
3136 p
= Vafter_insert_file_functions
;
3139 insval
= call1 (Fcar (p
), make_number (inserted
));
3142 CHECK_NUMBER (insval
, 0);
3143 inserted
= XFASTINT (insval
);
3151 val
= Fcons (filename
,
3152 Fcons (make_number (inserted
),
3155 RETURN_UNGCPRO (unbind_to (count
, val
));
3158 static Lisp_Object
build_annotations ();
3160 /* If build_annotations switched buffers, switch back to BUF.
3161 Kill the temporary buffer that was selected in the meantime. */
3164 build_annotations_unwind (buf
)
3169 if (XBUFFER (buf
) == current_buffer
)
3171 tembuf
= Fcurrent_buffer ();
3173 Fkill_buffer (tembuf
);
3177 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3178 "r\nFWrite region to file: ",
3179 "Write current region into specified file.\n\
3180 When called from a program, takes three arguments:\n\
3181 START, END and FILENAME. START and END are buffer positions.\n\
3182 Optional fourth argument APPEND if non-nil means\n\
3183 append to existing file contents (if any).\n\
3184 Optional fifth argument VISIT if t means\n\
3185 set the last-save-file-modtime of buffer to this file's modtime\n\
3186 and mark buffer not modified.\n\
3187 If VISIT is a string, it is a second file name;\n\
3188 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3189 VISIT is also the file name to lock and unlock for clash detection.\n\
3190 If VISIT is neither t nor nil nor a string,\n\
3191 that means do not print the \"Wrote file\" message.\n\
3192 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3193 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3194 Kludgy feature: if START is a string, then that string is written\n\
3195 to the file, instead of any buffer contents, and END is ignored.")
3196 (start
, end
, filename
, append
, visit
, lockname
)
3197 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3205 int count
= specpdl_ptr
- specpdl
;
3208 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3210 Lisp_Object handler
;
3211 Lisp_Object visit_file
;
3212 Lisp_Object annotations
;
3213 int visiting
, quietly
;
3214 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3215 struct buffer
*given_buffer
;
3217 int buffer_file_type
3218 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3221 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3222 error ("Cannot do file visiting in an indirect buffer");
3224 if (!NILP (start
) && !STRINGP (start
))
3225 validate_region (&start
, &end
);
3227 GCPRO3 (filename
, visit
, lockname
);
3228 filename
= Fexpand_file_name (filename
, Qnil
);
3229 if (STRINGP (visit
))
3230 visit_file
= Fexpand_file_name (visit
, Qnil
);
3232 visit_file
= filename
;
3235 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3236 quietly
= !NILP (visit
);
3240 if (NILP (lockname
))
3241 lockname
= visit_file
;
3243 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3245 /* If the file name has special constructs in it,
3246 call the corresponding file handler. */
3247 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3248 /* If FILENAME has no handler, see if VISIT has one. */
3249 if (NILP (handler
) && STRINGP (visit
))
3250 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3252 if (!NILP (handler
))
3255 val
= call6 (handler
, Qwrite_region
, start
, end
,
3256 filename
, append
, visit
);
3260 SAVE_MODIFF
= MODIFF
;
3261 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3262 current_buffer
->filename
= visit_file
;
3268 /* Special kludge to simplify auto-saving. */
3271 XSETFASTINT (start
, BEG
);
3272 XSETFASTINT (end
, Z
);
3275 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3276 count1
= specpdl_ptr
- specpdl
;
3278 given_buffer
= current_buffer
;
3279 annotations
= build_annotations (start
, end
);
3280 if (current_buffer
!= given_buffer
)
3286 #ifdef CLASH_DETECTION
3288 lock_file (lockname
);
3289 #endif /* CLASH_DETECTION */
3291 fn
= XSTRING (filename
)->data
;
3295 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3296 #else /* not DOS_NT */
3297 desc
= open (fn
, O_WRONLY
);
3298 #endif /* not DOS_NT */
3302 if (auto_saving
) /* Overwrite any previous version of autosave file */
3304 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3305 desc
= open (fn
, O_RDWR
);
3307 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3308 ? XSTRING (current_buffer
->filename
)->data
: 0,
3311 else /* Write to temporary name and rename if no errors */
3313 Lisp_Object temp_name
;
3314 temp_name
= Ffile_name_directory (filename
);
3316 if (!NILP (temp_name
))
3318 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3319 build_string ("$$SAVE$$")));
3320 fname
= XSTRING (filename
)->data
;
3321 fn
= XSTRING (temp_name
)->data
;
3322 desc
= creat_copy_attrs (fname
, fn
);
3325 /* If we can't open the temporary file, try creating a new
3326 version of the original file. VMS "creat" creates a
3327 new version rather than truncating an existing file. */
3330 desc
= creat (fn
, 0666);
3331 #if 0 /* This can clobber an existing file and fail to replace it,
3332 if the user runs out of space. */
3335 /* We can't make a new version;
3336 try to truncate and rewrite existing version if any. */
3338 desc
= open (fn
, O_RDWR
);
3344 desc
= creat (fn
, 0666);
3349 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3350 S_IREAD
| S_IWRITE
);
3351 #else /* not DOS_NT */
3352 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3353 #endif /* not DOS_NT */
3354 #endif /* not VMS */
3360 #ifdef CLASH_DETECTION
3362 if (!auto_saving
) unlock_file (lockname
);
3364 #endif /* CLASH_DETECTION */
3365 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3368 record_unwind_protect (close_file_unwind
, make_number (desc
));
3371 if (lseek (desc
, 0, 2) < 0)
3373 #ifdef CLASH_DETECTION
3374 if (!auto_saving
) unlock_file (lockname
);
3375 #endif /* CLASH_DETECTION */
3376 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3381 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3382 * if we do writes that don't end with a carriage return. Furthermore
3383 * it cannot handle writes of more then 16K. The modified
3384 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3385 * this EXCEPT for the last record (iff it doesn't end with a carriage
3386 * return). This implies that if your buffer doesn't end with a carriage
3387 * return, you get one free... tough. However it also means that if
3388 * we make two calls to sys_write (a la the following code) you can
3389 * get one at the gap as well. The easiest way to fix this (honest)
3390 * is to move the gap to the next newline (or the end of the buffer).
3395 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3396 move_gap (find_next_newline (GPT
, 1));
3402 if (STRINGP (start
))
3404 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3405 XSTRING (start
)->size
, 0, &annotations
);
3408 else if (XINT (start
) != XINT (end
))
3411 if (XINT (start
) < GPT
)
3413 register int end1
= XINT (end
);
3415 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3416 min (GPT
, end1
) - tem
, tem
, &annotations
);
3417 nwritten
+= min (GPT
, end1
) - tem
;
3421 if (XINT (end
) > GPT
&& !failure
)
3424 tem
= max (tem
, GPT
);
3425 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3427 nwritten
+= XINT (end
) - tem
;
3433 /* If file was empty, still need to write the annotations */
3434 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3442 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3443 Disk full in NFS may be reported here. */
3444 /* mib says that closing the file will try to write as fast as NFS can do
3445 it, and that means the fsync here is not crucial for autosave files. */
3446 if (!auto_saving
&& fsync (desc
) < 0)
3448 /* If fsync fails with EINTR, don't treat that as serious. */
3450 failure
= 1, save_errno
= errno
;
3454 /* Spurious "file has changed on disk" warnings have been
3455 observed on Suns as well.
3456 It seems that `close' can change the modtime, under nfs.
3458 (This has supposedly been fixed in Sunos 4,
3459 but who knows about all the other machines with NFS?) */
3462 /* On VMS and APOLLO, must do the stat after the close
3463 since closing changes the modtime. */
3466 /* Recall that #if defined does not work on VMS. */
3473 /* NFS can report a write failure now. */
3474 if (close (desc
) < 0)
3475 failure
= 1, save_errno
= errno
;
3478 /* If we wrote to a temporary name and had no errors, rename to real name. */
3482 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3490 /* Discard the unwind protect for close_file_unwind. */
3491 specpdl_ptr
= specpdl
+ count1
;
3492 /* Restore the original current buffer. */
3493 visit_file
= unbind_to (count
, visit_file
);
3495 #ifdef CLASH_DETECTION
3497 unlock_file (lockname
);
3498 #endif /* CLASH_DETECTION */
3500 /* Do this before reporting IO error
3501 to avoid a "file has changed on disk" warning on
3502 next attempt to save. */
3504 current_buffer
->modtime
= st
.st_mtime
;
3507 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3511 SAVE_MODIFF
= MODIFF
;
3512 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3513 current_buffer
->filename
= visit_file
;
3514 update_mode_lines
++;
3520 message ("Wrote %s", XSTRING (visit_file
)->data
);
3525 Lisp_Object
merge ();
3527 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3528 "Return t if (car A) is numerically less than (car B).")
3532 return Flss (Fcar (a
), Fcar (b
));
3535 /* Build the complete list of annotations appropriate for writing out
3536 the text between START and END, by calling all the functions in
3537 write-region-annotate-functions and merging the lists they return.
3538 If one of these functions switches to a different buffer, we assume
3539 that buffer contains altered text. Therefore, the caller must
3540 make sure to restore the current buffer in all cases,
3541 as save-excursion would do. */
3544 build_annotations (start
, end
)
3545 Lisp_Object start
, end
;
3547 Lisp_Object annotations
;
3549 struct gcpro gcpro1
, gcpro2
;
3552 p
= Vwrite_region_annotate_functions
;
3553 GCPRO2 (annotations
, p
);
3556 struct buffer
*given_buffer
= current_buffer
;
3557 Vwrite_region_annotations_so_far
= annotations
;
3558 res
= call2 (Fcar (p
), start
, end
);
3559 /* If the function makes a different buffer current,
3560 assume that means this buffer contains altered text to be output.
3561 Reset START and END from the buffer bounds
3562 and discard all previous annotations because they should have
3563 been dealt with by this function. */
3564 if (current_buffer
!= given_buffer
)
3570 Flength (res
); /* Check basic validity of return value */
3571 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3575 /* Now do the same for annotation functions implied by the file-format */
3576 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
3577 p
= Vauto_save_file_format
;
3579 p
= current_buffer
->file_format
;
3582 struct buffer
*given_buffer
= current_buffer
;
3583 Vwrite_region_annotations_so_far
= annotations
;
3584 res
= call3 (Qformat_annotate_function
, Fcar (p
), start
, end
);
3585 if (current_buffer
!= given_buffer
)
3592 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3599 /* Write to descriptor DESC the LEN characters starting at ADDR,
3600 assuming they start at position POS in the buffer.
3601 Intersperse with them the annotations from *ANNOT
3602 (those which fall within the range of positions POS to POS + LEN),
3603 each at its appropriate position.
3605 Modify *ANNOT by discarding elements as we output them.
3606 The return value is negative in case of system call failure. */
3609 a_write (desc
, addr
, len
, pos
, annot
)
3611 register char *addr
;
3618 int lastpos
= pos
+ len
;
3620 while (NILP (*annot
) || CONSP (*annot
))
3622 tem
= Fcar_safe (Fcar (*annot
));
3623 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3624 nextpos
= XFASTINT (tem
);
3626 return e_write (desc
, addr
, lastpos
- pos
);
3629 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3631 addr
+= nextpos
- pos
;
3634 tem
= Fcdr (Fcar (*annot
));
3637 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3640 *annot
= Fcdr (*annot
);
3645 e_write (desc
, addr
, len
)
3647 register char *addr
;
3650 char buf
[16 * 1024];
3651 register char *p
, *end
;
3653 if (!EQ (current_buffer
->selective_display
, Qt
))
3654 return write (desc
, addr
, len
) - len
;
3658 end
= p
+ sizeof buf
;
3663 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3672 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3678 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3679 Sverify_visited_file_modtime
, 1, 1, 0,
3680 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3681 This means that the file has not been changed since it was visited or saved.")
3687 Lisp_Object handler
;
3689 CHECK_BUFFER (buf
, 0);
3692 if (!STRINGP (b
->filename
)) return Qt
;
3693 if (b
->modtime
== 0) return Qt
;
3695 /* If the file name has special constructs in it,
3696 call the corresponding file handler. */
3697 handler
= Ffind_file_name_handler (b
->filename
,
3698 Qverify_visited_file_modtime
);
3699 if (!NILP (handler
))
3700 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3702 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3704 /* If the file doesn't exist now and didn't exist before,
3705 we say that it isn't modified, provided the error is a tame one. */
3706 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3711 if (st
.st_mtime
== b
->modtime
3712 /* If both are positive, accept them if they are off by one second. */
3713 || (st
.st_mtime
> 0 && b
->modtime
> 0
3714 && (st
.st_mtime
== b
->modtime
+ 1
3715 || st
.st_mtime
== b
->modtime
- 1)))
3720 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3721 Sclear_visited_file_modtime
, 0, 0, 0,
3722 "Clear out records of last mod time of visited file.\n\
3723 Next attempt to save will certainly not complain of a discrepancy.")
3726 current_buffer
->modtime
= 0;
3730 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3731 Svisited_file_modtime
, 0, 0, 0,
3732 "Return the current buffer's recorded visited file modification time.\n\
3733 The value is a list of the form (HIGH . LOW), like the time values\n\
3734 that `file-attributes' returns.")
3737 return long_to_cons ((unsigned long) current_buffer
->modtime
);
3740 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3741 Sset_visited_file_modtime
, 0, 1, 0,
3742 "Update buffer's recorded modification time from the visited file's time.\n\
3743 Useful if the buffer was not read from the file normally\n\
3744 or if the file itself has been changed for some known benign reason.\n\
3745 An argument specifies the modification time value to use\n\
3746 \(instead of that of the visited file), in the form of a list\n\
3747 \(HIGH . LOW) or (HIGH LOW).")
3749 Lisp_Object time_list
;
3751 if (!NILP (time_list
))
3752 current_buffer
->modtime
= cons_to_long (time_list
);
3755 register Lisp_Object filename
;
3757 Lisp_Object handler
;
3759 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3761 /* If the file name has special constructs in it,
3762 call the corresponding file handler. */
3763 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3764 if (!NILP (handler
))
3765 /* The handler can find the file name the same way we did. */
3766 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3767 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3768 current_buffer
->modtime
= st
.st_mtime
;
3778 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3779 Fsleep_for (make_number (1), Qnil
);
3780 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3781 Fsleep_for (make_number (1), Qnil
);
3782 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3783 Fsleep_for (make_number (1), Qnil
);
3793 /* Get visited file's mode to become the auto save file's mode. */
3794 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3795 /* But make sure we can overwrite it later! */
3796 auto_save_mode_bits
= st
.st_mode
| 0600;
3798 auto_save_mode_bits
= 0666;
3801 Fwrite_region (Qnil
, Qnil
,
3802 current_buffer
->auto_save_file_name
,
3803 Qnil
, Qlambda
, Qnil
);
3807 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3811 close (XINT (desc
));
3815 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3816 "Auto-save all buffers that need it.\n\
3817 This is all buffers that have auto-saving enabled\n\
3818 and are changed since last auto-saved.\n\
3819 Auto-saving writes the buffer into a file\n\
3820 so that your editing is not lost if the system crashes.\n\
3821 This file is not the file you visited; that changes only when you save.\n\
3822 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3823 Non-nil first argument means do not print any message if successful.\n\
3824 Non-nil second argument means save only current buffer.")
3825 (no_message
, current_only
)
3826 Lisp_Object no_message
, current_only
;
3828 struct buffer
*old
= current_buffer
, *b
;
3829 Lisp_Object tail
, buf
;
3831 char *omessage
= echo_area_glyphs
;
3832 int omessage_length
= echo_area_glyphs_length
;
3833 extern int minibuf_level
;
3834 int do_handled_files
;
3837 int count
= specpdl_ptr
- specpdl
;
3840 /* Ordinarily don't quit within this function,
3841 but don't make it impossible to quit (in case we get hung in I/O). */
3845 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3846 point to non-strings reached from Vbuffer_alist. */
3851 if (!NILP (Vrun_hooks
))
3852 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3854 if (STRINGP (Vauto_save_list_file_name
))
3856 Lisp_Object listfile
;
3857 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
3859 listdesc
= open (XSTRING (listfile
)->data
,
3860 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3861 S_IREAD
| S_IWRITE
);
3862 #else /* not DOS_NT */
3863 listdesc
= creat (XSTRING (listfile
)->data
, 0666);
3864 #endif /* not DOS_NT */
3869 /* Arrange to close that file whether or not we get an error.
3870 Also reset auto_saving to 0. */
3872 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3876 /* First, save all files which don't have handlers. If Emacs is
3877 crashing, the handlers may tweak what is causing Emacs to crash
3878 in the first place, and it would be a shame if Emacs failed to
3879 autosave perfectly ordinary files because it couldn't handle some
3881 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3882 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
3884 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3887 /* Record all the buffers that have auto save mode
3888 in the special file that lists them. For each of these buffers,
3889 Record visited name (if any) and auto save name. */
3890 if (STRINGP (b
->auto_save_file_name
)
3891 && listdesc
>= 0 && do_handled_files
== 0)
3893 if (!NILP (b
->filename
))
3895 write (listdesc
, XSTRING (b
->filename
)->data
,
3896 XSTRING (b
->filename
)->size
);
3898 write (listdesc
, "\n", 1);
3899 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3900 XSTRING (b
->auto_save_file_name
)->size
);
3901 write (listdesc
, "\n", 1);
3904 if (!NILP (current_only
)
3905 && b
!= current_buffer
)
3908 /* Don't auto-save indirect buffers.
3909 The base buffer takes care of it. */
3913 /* Check for auto save enabled
3914 and file changed since last auto save
3915 and file changed since last real save. */
3916 if (STRINGP (b
->auto_save_file_name
)
3917 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
3918 && b
->auto_save_modified
< BUF_MODIFF (b
)
3919 /* -1 means we've turned off autosaving for a while--see below. */
3920 && XINT (b
->save_length
) >= 0
3921 && (do_handled_files
3922 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3925 EMACS_TIME before_time
, after_time
;
3927 EMACS_GET_TIME (before_time
);
3929 /* If we had a failure, don't try again for 20 minutes. */
3930 if (b
->auto_save_failure_time
>= 0
3931 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3934 if ((XFASTINT (b
->save_length
) * 10
3935 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3936 /* A short file is likely to change a large fraction;
3937 spare the user annoying messages. */
3938 && XFASTINT (b
->save_length
) > 5000
3939 /* These messages are frequent and annoying for `*mail*'. */
3940 && !EQ (b
->filename
, Qnil
)
3941 && NILP (no_message
))
3943 /* It has shrunk too much; turn off auto-saving here. */
3944 message ("Buffer %s has shrunk a lot; auto save turned off there",
3945 XSTRING (b
->name
)->data
);
3946 /* Turn off auto-saving until there's a real save,
3947 and prevent any more warnings. */
3948 XSETINT (b
->save_length
, -1);
3949 Fsleep_for (make_number (1), Qnil
);
3952 set_buffer_internal (b
);
3953 if (!auto_saved
&& NILP (no_message
))
3954 message1 ("Auto-saving...");
3955 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3957 b
->auto_save_modified
= BUF_MODIFF (b
);
3958 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3959 set_buffer_internal (old
);
3961 EMACS_GET_TIME (after_time
);
3963 /* If auto-save took more than 60 seconds,
3964 assume it was an NFS failure that got a timeout. */
3965 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3966 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3970 /* Prevent another auto save till enough input events come in. */
3971 record_auto_save ();
3973 if (auto_saved
&& NILP (no_message
))
3976 message2 (omessage
, omessage_length
);
3978 message1 ("Auto-saving...done");
3983 unbind_to (count
, Qnil
);
3987 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3988 Sset_buffer_auto_saved
, 0, 0, 0,
3989 "Mark current buffer as auto-saved with its current text.\n\
3990 No auto-save file will be written until the buffer changes again.")
3993 current_buffer
->auto_save_modified
= MODIFF
;
3994 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3995 current_buffer
->auto_save_failure_time
= -1;
3999 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4000 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4001 "Clear any record of a recent auto-save failure in the current buffer.")
4004 current_buffer
->auto_save_failure_time
= -1;
4008 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4010 "Return t if buffer has been auto-saved since last read in or saved.")
4013 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4016 /* Reading and completing file names */
4017 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4019 /* In the string VAL, change each $ to $$ and return the result. */
4022 double_dollars (val
)
4025 register unsigned char *old
, *new;
4029 osize
= XSTRING (val
)->size
;
4030 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4031 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4032 if (*old
++ == '$') count
++;
4035 old
= XSTRING (val
)->data
;
4036 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4037 new = XSTRING (val
)->data
;
4038 for (n
= osize
; n
> 0; n
--)
4051 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4053 "Internal subroutine for read-file-name. Do not call this.")
4054 (string
, dir
, action
)
4055 Lisp_Object string
, dir
, action
;
4056 /* action is nil for complete, t for return list of completions,
4057 lambda for verify final value */
4059 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4061 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4068 /* No need to protect ACTION--we only compare it with t and nil. */
4069 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4071 if (XSTRING (string
)->size
== 0)
4073 if (EQ (action
, Qlambda
))
4081 orig_string
= string
;
4082 string
= Fsubstitute_in_file_name (string
);
4083 changed
= NILP (Fstring_equal (string
, orig_string
));
4084 name
= Ffile_name_nondirectory (string
);
4085 val
= Ffile_name_directory (string
);
4087 realdir
= Fexpand_file_name (val
, realdir
);
4092 specdir
= Ffile_name_directory (string
);
4093 val
= Ffile_name_completion (name
, realdir
);
4098 return double_dollars (string
);
4102 if (!NILP (specdir
))
4103 val
= concat2 (specdir
, val
);
4105 return double_dollars (val
);
4108 #endif /* not VMS */
4112 if (EQ (action
, Qt
))
4113 return Ffile_name_all_completions (name
, realdir
);
4114 /* Only other case actually used is ACTION = lambda */
4116 /* Supposedly this helps commands such as `cd' that read directory names,
4117 but can someone explain how it helps them? -- RMS */
4118 if (XSTRING (name
)->size
== 0)
4121 return Ffile_exists_p (string
);
4124 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4125 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4126 Value is not expanded---you must call `expand-file-name' yourself.\n\
4127 Default name to DEFAULT if user enters a null string.\n\
4128 (If DEFAULT is omitted, the visited file name is used,\n\
4129 except that if INITIAL is specified, that combined with DIR is used.)\n\
4130 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4131 Non-nil and non-t means also require confirmation after completion.\n\
4132 Fifth arg INITIAL specifies text to start with.\n\
4133 DIR defaults to current buffer's directory default.")
4134 (prompt
, dir
, defalt
, mustmatch
, initial
)
4135 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4137 Lisp_Object val
, insdef
, insdef1
, tem
;
4138 struct gcpro gcpro1
, gcpro2
;
4139 register char *homedir
;
4143 dir
= current_buffer
->directory
;
4146 if (! NILP (initial
))
4147 defalt
= Fexpand_file_name (initial
, dir
);
4149 defalt
= current_buffer
->filename
;
4152 /* If dir starts with user's homedir, change that to ~. */
4153 homedir
= (char *) egetenv ("HOME");
4156 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4157 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4159 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4160 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4161 XSTRING (dir
)->data
[0] = '~';
4164 if (insert_default_directory
)
4167 if (!NILP (initial
))
4169 Lisp_Object args
[2], pos
;
4173 insdef
= Fconcat (2, args
);
4174 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4175 insdef1
= Fcons (double_dollars (insdef
), pos
);
4178 insdef1
= double_dollars (insdef
);
4180 else if (!NILP (initial
))
4183 insdef1
= Fcons (double_dollars (insdef
), 0);
4186 insdef
= Qnil
, insdef1
= Qnil
;
4189 count
= specpdl_ptr
- specpdl
;
4190 specbind (intern ("completion-ignore-case"), Qt
);
4193 GCPRO2 (insdef
, defalt
);
4194 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4195 dir
, mustmatch
, insdef1
,
4196 Qfile_name_history
);
4199 unbind_to (count
, Qnil
);
4204 error ("No file name specified");
4205 tem
= Fstring_equal (val
, insdef
);
4206 if (!NILP (tem
) && !NILP (defalt
))
4208 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4213 error ("No default file name");
4215 return Fsubstitute_in_file_name (val
);
4218 #if 0 /* Old version */
4219 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4220 /* Don't confuse make-docfile by having two doc strings for this function.
4221 make-docfile does not pay attention to #if, for good reason! */
4223 (prompt
, dir
, defalt
, mustmatch
, initial
)
4224 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4226 Lisp_Object val
, insdef
, tem
;
4227 struct gcpro gcpro1
, gcpro2
;
4228 register char *homedir
;
4232 dir
= current_buffer
->directory
;
4234 defalt
= current_buffer
->filename
;
4236 /* If dir starts with user's homedir, change that to ~. */
4237 homedir
= (char *) egetenv ("HOME");
4240 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4241 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4243 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4244 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4245 XSTRING (dir
)->data
[0] = '~';
4248 if (!NILP (initial
))
4250 else if (insert_default_directory
)
4253 insdef
= build_string ("");
4256 count
= specpdl_ptr
- specpdl
;
4257 specbind (intern ("completion-ignore-case"), Qt
);
4260 GCPRO2 (insdef
, defalt
);
4261 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4263 insert_default_directory
? insdef
: Qnil
,
4264 Qfile_name_history
);
4267 unbind_to (count
, Qnil
);
4272 error ("No file name specified");
4273 tem
= Fstring_equal (val
, insdef
);
4274 if (!NILP (tem
) && !NILP (defalt
))
4276 return Fsubstitute_in_file_name (val
);
4278 #endif /* Old version */
4282 Qexpand_file_name
= intern ("expand-file-name");
4283 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4284 Qdirectory_file_name
= intern ("directory-file-name");
4285 Qfile_name_directory
= intern ("file-name-directory");
4286 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4287 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4288 Qfile_name_as_directory
= intern ("file-name-as-directory");
4289 Qcopy_file
= intern ("copy-file");
4290 Qmake_directory_internal
= intern ("make-directory-internal");
4291 Qdelete_directory
= intern ("delete-directory");
4292 Qdelete_file
= intern ("delete-file");
4293 Qrename_file
= intern ("rename-file");
4294 Qadd_name_to_file
= intern ("add-name-to-file");
4295 Qmake_symbolic_link
= intern ("make-symbolic-link");
4296 Qfile_exists_p
= intern ("file-exists-p");
4297 Qfile_executable_p
= intern ("file-executable-p");
4298 Qfile_readable_p
= intern ("file-readable-p");
4299 Qfile_symlink_p
= intern ("file-symlink-p");
4300 Qfile_writable_p
= intern ("file-writable-p");
4301 Qfile_directory_p
= intern ("file-directory-p");
4302 Qfile_regular_p
= intern ("file-regular-p");
4303 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4304 Qfile_modes
= intern ("file-modes");
4305 Qset_file_modes
= intern ("set-file-modes");
4306 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4307 Qinsert_file_contents
= intern ("insert-file-contents");
4308 Qwrite_region
= intern ("write-region");
4309 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4310 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4312 staticpro (&Qexpand_file_name
);
4313 staticpro (&Qsubstitute_in_file_name
);
4314 staticpro (&Qdirectory_file_name
);
4315 staticpro (&Qfile_name_directory
);
4316 staticpro (&Qfile_name_nondirectory
);
4317 staticpro (&Qunhandled_file_name_directory
);
4318 staticpro (&Qfile_name_as_directory
);
4319 staticpro (&Qcopy_file
);
4320 staticpro (&Qmake_directory_internal
);
4321 staticpro (&Qdelete_directory
);
4322 staticpro (&Qdelete_file
);
4323 staticpro (&Qrename_file
);
4324 staticpro (&Qadd_name_to_file
);
4325 staticpro (&Qmake_symbolic_link
);
4326 staticpro (&Qfile_exists_p
);
4327 staticpro (&Qfile_executable_p
);
4328 staticpro (&Qfile_readable_p
);
4329 staticpro (&Qfile_symlink_p
);
4330 staticpro (&Qfile_writable_p
);
4331 staticpro (&Qfile_directory_p
);
4332 staticpro (&Qfile_regular_p
);
4333 staticpro (&Qfile_accessible_directory_p
);
4334 staticpro (&Qfile_modes
);
4335 staticpro (&Qset_file_modes
);
4336 staticpro (&Qfile_newer_than_file_p
);
4337 staticpro (&Qinsert_file_contents
);
4338 staticpro (&Qwrite_region
);
4339 staticpro (&Qverify_visited_file_modtime
);
4341 Qfile_name_history
= intern ("file-name-history");
4342 Fset (Qfile_name_history
, Qnil
);
4343 staticpro (&Qfile_name_history
);
4345 Qfile_error
= intern ("file-error");
4346 staticpro (&Qfile_error
);
4347 Qfile_already_exists
= intern("file-already-exists");
4348 staticpro (&Qfile_already_exists
);
4351 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4352 staticpro (&Qfind_buffer_file_type
);
4355 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
4356 "*Format in which to write auto-save files.\n\
4357 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
4358 If it is t, which is the default, auto-save files are written in the\n\
4359 same format as a regular save would use.");
4360 Vauto_save_file_format
= Qt
;
4362 Qformat_decode
= intern ("format-decode");
4363 staticpro (&Qformat_decode
);
4364 Qformat_annotate_function
= intern ("format-annotate-function");
4365 staticpro (&Qformat_annotate_function
);
4367 Qcar_less_than_car
= intern ("car-less-than-car");
4368 staticpro (&Qcar_less_than_car
);
4370 Fput (Qfile_error
, Qerror_conditions
,
4371 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4372 Fput (Qfile_error
, Qerror_message
,
4373 build_string ("File error"));
4375 Fput (Qfile_already_exists
, Qerror_conditions
,
4376 Fcons (Qfile_already_exists
,
4377 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4378 Fput (Qfile_already_exists
, Qerror_message
,
4379 build_string ("File already exists"));
4381 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4382 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4383 insert_default_directory
= 1;
4385 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4386 "*Non-nil means write new files with record format `stmlf'.\n\
4387 nil means use format `var'. This variable is meaningful only on VMS.");
4388 vms_stmlf_recfm
= 0;
4390 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4391 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4392 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4395 The first argument given to HANDLER is the name of the I/O primitive\n\
4396 to be handled; the remaining arguments are the arguments that were\n\
4397 passed to that primitive. For example, if you do\n\
4398 (file-exists-p FILENAME)\n\
4399 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4400 (funcall HANDLER 'file-exists-p FILENAME)\n\
4401 The function `find-file-name-handler' checks this list for a handler\n\
4402 for its argument.");
4403 Vfile_name_handler_alist
= Qnil
;
4405 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4406 "A list of functions to be called at the end of `insert-file-contents'.\n\
4407 Each is passed one argument, the number of bytes inserted. It should return\n\
4408 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4409 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4410 responsible for calling the after-insert-file-functions if appropriate.");
4411 Vafter_insert_file_functions
= Qnil
;
4413 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4414 "A list of functions to be called at the start of `write-region'.\n\
4415 Each is passed two arguments, START and END as for `write-region'. It should\n\
4416 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4417 inserted at the specified positions of the file being written (1 means to\n\
4418 insert before the first byte written). The POSITIONs must be sorted into\n\
4419 increasing order. If there are several functions in the list, the several\n\
4420 lists are merged destructively.");
4421 Vwrite_region_annotate_functions
= Qnil
;
4423 DEFVAR_LISP ("write-region-annotations-so-far",
4424 &Vwrite_region_annotations_so_far
,
4425 "When an annotation function is called, this holds the previous annotations.\n\
4426 These are the annotations made by other annotation functions\n\
4427 that were already called. See also `write-region-annotate-functions'.");
4428 Vwrite_region_annotations_so_far
= Qnil
;
4430 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4431 "A list of file name handlers that temporarily should not be used.\n\
4432 This applies only to the operation `inhibit-file-name-operation'.");
4433 Vinhibit_file_name_handlers
= Qnil
;
4435 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4436 "The operation for which `inhibit-file-name-handlers' is applicable.");
4437 Vinhibit_file_name_operation
= Qnil
;
4439 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4440 "File name in which we write a list of all auto save file names.");
4441 Vauto_save_list_file_name
= Qnil
;
4443 defsubr (&Sfind_file_name_handler
);
4444 defsubr (&Sfile_name_directory
);
4445 defsubr (&Sfile_name_nondirectory
);
4446 defsubr (&Sunhandled_file_name_directory
);
4447 defsubr (&Sfile_name_as_directory
);
4448 defsubr (&Sdirectory_file_name
);
4449 defsubr (&Smake_temp_name
);
4450 defsubr (&Sexpand_file_name
);
4451 defsubr (&Ssubstitute_in_file_name
);
4452 defsubr (&Scopy_file
);
4453 defsubr (&Smake_directory_internal
);
4454 defsubr (&Sdelete_directory
);
4455 defsubr (&Sdelete_file
);
4456 defsubr (&Srename_file
);
4457 defsubr (&Sadd_name_to_file
);
4459 defsubr (&Smake_symbolic_link
);
4460 #endif /* S_IFLNK */
4462 defsubr (&Sdefine_logical_name
);
4465 defsubr (&Ssysnetunam
);
4466 #endif /* HPUX_NET */
4467 defsubr (&Sfile_name_absolute_p
);
4468 defsubr (&Sfile_exists_p
);
4469 defsubr (&Sfile_executable_p
);
4470 defsubr (&Sfile_readable_p
);
4471 defsubr (&Sfile_writable_p
);
4472 defsubr (&Sfile_symlink_p
);
4473 defsubr (&Sfile_directory_p
);
4474 defsubr (&Sfile_accessible_directory_p
);
4475 defsubr (&Sfile_regular_p
);
4476 defsubr (&Sfile_modes
);
4477 defsubr (&Sset_file_modes
);
4478 defsubr (&Sset_default_file_modes
);
4479 defsubr (&Sdefault_file_modes
);
4480 defsubr (&Sfile_newer_than_file_p
);
4481 defsubr (&Sinsert_file_contents
);
4482 defsubr (&Swrite_region
);
4483 defsubr (&Scar_less_than_car
);
4484 defsubr (&Sverify_visited_file_modtime
);
4485 defsubr (&Sclear_visited_file_modtime
);
4486 defsubr (&Svisited_file_modtime
);
4487 defsubr (&Sset_visited_file_modtime
);
4488 defsubr (&Sdo_auto_save
);
4489 defsubr (&Sset_buffer_auto_saved
);
4490 defsubr (&Sclear_buffer_auto_save_failure
);
4491 defsubr (&Srecent_auto_save_p
);
4493 defsubr (&Sread_file_name_internal
);
4494 defsubr (&Sread_file_name
);
4497 defsubr (&Sunix_sync
);