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
));
1953 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1955 #if defined (__DJGPP__) && __DJGPP__ > 1
1956 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
1957 and if it can't, it tells so. Otherwise, under MSDOS we usually
1958 get only the READ bit, which will make the copied file read-only,
1959 so it's better not to chmod at all. */
1960 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
1961 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1962 #endif /* DJGPP version 2 or newer */
1968 /* Discard the unwind protects. */
1969 specpdl_ptr
= specpdl
+ count
;
1975 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1976 Smake_directory_internal
, 1, 1, 0,
1977 "Create a directory. One argument, a file name string.")
1979 Lisp_Object dirname
;
1982 Lisp_Object handler
;
1984 CHECK_STRING (dirname
, 0);
1985 dirname
= Fexpand_file_name (dirname
, Qnil
);
1987 handler
= Ffind_file_name_handler (dirname
, Qmake_directory_internal
);
1988 if (!NILP (handler
))
1989 return call2 (handler
, Qmake_directory_internal
, dirname
);
1991 dir
= XSTRING (dirname
)->data
;
1994 if (mkdir (dir
) != 0)
1996 if (mkdir (dir
, 0777) != 0)
1998 report_file_error ("Creating directory", Flist (1, &dirname
));
2003 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2004 "Delete a directory. One argument, a file name or directory name string.")
2006 Lisp_Object dirname
;
2009 Lisp_Object handler
;
2011 CHECK_STRING (dirname
, 0);
2012 dirname
= Fdirectory_file_name (Fexpand_file_name (dirname
, Qnil
));
2013 dir
= XSTRING (dirname
)->data
;
2015 handler
= Ffind_file_name_handler (dirname
, Qdelete_directory
);
2016 if (!NILP (handler
))
2017 return call2 (handler
, Qdelete_directory
, dirname
);
2019 if (rmdir (dir
) != 0)
2020 report_file_error ("Removing directory", Flist (1, &dirname
));
2025 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2026 "Delete specified file. One argument, a file name string.\n\
2027 If file has multiple names, it continues to exist with the other names.")
2029 Lisp_Object filename
;
2031 Lisp_Object handler
;
2032 CHECK_STRING (filename
, 0);
2033 filename
= Fexpand_file_name (filename
, Qnil
);
2035 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2036 if (!NILP (handler
))
2037 return call2 (handler
, Qdelete_file
, filename
);
2039 if (0 > unlink (XSTRING (filename
)->data
))
2040 report_file_error ("Removing old name", Flist (1, &filename
));
2045 internal_delete_file_1 (ignore
)
2051 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2054 internal_delete_file (filename
)
2055 Lisp_Object filename
;
2057 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2058 Qt
, internal_delete_file_1
));
2061 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2062 "fRename file: \nFRename %s to file: \np",
2063 "Rename FILE as NEWNAME. Both args strings.\n\
2064 If file has names other than FILE, it continues to have those names.\n\
2065 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2066 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2067 A number as third arg means request confirmation if NEWNAME already exists.\n\
2068 This is what happens in interactive use with M-x.")
2069 (filename
, newname
, ok_if_already_exists
)
2070 Lisp_Object filename
, newname
, ok_if_already_exists
;
2073 Lisp_Object args
[2];
2075 Lisp_Object handler
;
2076 struct gcpro gcpro1
, gcpro2
;
2078 GCPRO2 (filename
, newname
);
2079 CHECK_STRING (filename
, 0);
2080 CHECK_STRING (newname
, 1);
2081 filename
= Fexpand_file_name (filename
, Qnil
);
2082 newname
= Fexpand_file_name (newname
, Qnil
);
2084 /* If the file name has special constructs in it,
2085 call the corresponding file handler. */
2086 handler
= Ffind_file_name_handler (filename
, Qrename_file
);
2088 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2089 if (!NILP (handler
))
2090 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2091 filename
, newname
, ok_if_already_exists
));
2093 if (NILP (ok_if_already_exists
)
2094 || INTEGERP (ok_if_already_exists
))
2095 barf_or_query_if_file_exists (newname
, "rename to it",
2096 INTEGERP (ok_if_already_exists
), 0);
2098 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2101 if (!MoveFile (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2102 #else /* not WINDOWSNT */
2103 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
2104 || 0 > unlink (XSTRING (filename
)->data
))
2105 #endif /* not WINDOWSNT */
2109 /* Why two? And why doesn't MS document what MoveFile will return? */
2110 if (GetLastError () == ERROR_FILE_EXISTS
2111 || GetLastError () == ERROR_ALREADY_EXISTS
)
2112 #else /* not WINDOWSNT */
2114 #endif /* not WINDOWSNT */
2116 Fcopy_file (filename
, newname
,
2117 /* We have already prompted if it was an integer,
2118 so don't have copy-file prompt again. */
2119 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2120 Fdelete_file (filename
);
2127 report_file_error ("Renaming", Flist (2, args
));
2130 report_file_error ("Renaming", Flist (2, &filename
));
2137 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2138 "fAdd name to file: \nFName to add to %s: \np",
2139 "Give FILE additional name NEWNAME. Both args strings.\n\
2140 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2141 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2142 A number as third arg means request confirmation if NEWNAME already exists.\n\
2143 This is what happens in interactive use with M-x.")
2144 (filename
, newname
, ok_if_already_exists
)
2145 Lisp_Object filename
, newname
, ok_if_already_exists
;
2148 Lisp_Object args
[2];
2150 Lisp_Object handler
;
2151 struct gcpro gcpro1
, gcpro2
;
2153 GCPRO2 (filename
, newname
);
2154 CHECK_STRING (filename
, 0);
2155 CHECK_STRING (newname
, 1);
2156 filename
= Fexpand_file_name (filename
, Qnil
);
2157 newname
= Fexpand_file_name (newname
, Qnil
);
2159 /* If the file name has special constructs in it,
2160 call the corresponding file handler. */
2161 handler
= Ffind_file_name_handler (filename
, Qadd_name_to_file
);
2162 if (!NILP (handler
))
2163 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
2164 newname
, ok_if_already_exists
));
2166 /* If the new name has special constructs in it,
2167 call the corresponding file handler. */
2168 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2169 if (!NILP (handler
))
2170 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
2171 newname
, ok_if_already_exists
));
2173 if (NILP (ok_if_already_exists
)
2174 || INTEGERP (ok_if_already_exists
))
2175 barf_or_query_if_file_exists (newname
, "make it a new name",
2176 INTEGERP (ok_if_already_exists
), 0);
2178 /* Windows does not support this operation. */
2179 report_file_error ("Adding new name", Flist (2, &filename
));
2180 #else /* not WINDOWSNT */
2182 unlink (XSTRING (newname
)->data
);
2183 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2188 report_file_error ("Adding new name", Flist (2, args
));
2190 report_file_error ("Adding new name", Flist (2, &filename
));
2193 #endif /* not WINDOWSNT */
2200 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2201 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2202 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2203 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2204 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2205 A number as third arg means request confirmation if LINKNAME already exists.\n\
2206 This happens for interactive use with M-x.")
2207 (filename
, linkname
, ok_if_already_exists
)
2208 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2211 Lisp_Object args
[2];
2213 Lisp_Object handler
;
2214 struct gcpro gcpro1
, gcpro2
;
2216 GCPRO2 (filename
, linkname
);
2217 CHECK_STRING (filename
, 0);
2218 CHECK_STRING (linkname
, 1);
2219 /* If the link target has a ~, we must expand it to get
2220 a truly valid file name. Otherwise, do not expand;
2221 we want to permit links to relative file names. */
2222 if (XSTRING (filename
)->data
[0] == '~')
2223 filename
= Fexpand_file_name (filename
, Qnil
);
2224 linkname
= Fexpand_file_name (linkname
, Qnil
);
2226 /* If the file name has special constructs in it,
2227 call the corresponding file handler. */
2228 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2229 if (!NILP (handler
))
2230 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2231 linkname
, ok_if_already_exists
));
2233 /* If the new link name has special constructs in it,
2234 call the corresponding file handler. */
2235 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2236 if (!NILP (handler
))
2237 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2238 linkname
, ok_if_already_exists
));
2240 if (NILP (ok_if_already_exists
)
2241 || INTEGERP (ok_if_already_exists
))
2242 barf_or_query_if_file_exists (linkname
, "make it a link",
2243 INTEGERP (ok_if_already_exists
), 0);
2244 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2246 /* If we didn't complain already, silently delete existing file. */
2247 if (errno
== EEXIST
)
2249 unlink (XSTRING (linkname
)->data
);
2250 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2260 report_file_error ("Making symbolic link", Flist (2, args
));
2262 report_file_error ("Making symbolic link", Flist (2, &filename
));
2268 #endif /* S_IFLNK */
2272 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2273 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2274 "Define the job-wide logical name NAME to have the value STRING.\n\
2275 If STRING is nil or a null string, the logical name NAME is deleted.")
2277 Lisp_Object varname
;
2280 CHECK_STRING (varname
, 0);
2282 delete_logical_name (XSTRING (varname
)->data
);
2285 CHECK_STRING (string
, 1);
2287 if (XSTRING (string
)->size
== 0)
2288 delete_logical_name (XSTRING (varname
)->data
);
2290 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2299 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2300 "Open a network connection to PATH using LOGIN as the login string.")
2302 Lisp_Object path
, login
;
2306 CHECK_STRING (path
, 0);
2307 CHECK_STRING (login
, 0);
2309 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2311 if (netresult
== -1)
2316 #endif /* HPUX_NET */
2318 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2320 "Return t if file FILENAME specifies an absolute path name.\n\
2321 On Unix, this is a name starting with a `/' or a `~'.")
2323 Lisp_Object filename
;
2327 CHECK_STRING (filename
, 0);
2328 ptr
= XSTRING (filename
)->data
;
2329 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2331 /* ??? This criterion is probably wrong for '<'. */
2332 || index (ptr
, ':') || index (ptr
, '<')
2333 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2337 || (*ptr
!= 0 && ptr
[1] == ':' && (ptr
[2] == '/' || ptr
[2] == '\\'))
2345 /* Return nonzero if file FILENAME exists and can be executed. */
2348 check_executable (filename
)
2352 int len
= strlen (filename
);
2355 if (stat (filename
, &st
) < 0)
2357 return (S_ISREG (st
.st_mode
)
2359 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2360 || stricmp (suffix
, ".exe") == 0
2361 || stricmp (suffix
, ".bat") == 0)
2362 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2363 #else /* not DOS_NT */
2365 return (eaccess (filename
, 1) >= 0);
2367 /* Access isn't quite right because it uses the real uid
2368 and we really want to test with the effective uid.
2369 But Unix doesn't give us a right way to do it. */
2370 return (access (filename
, 1) >= 0);
2372 #endif /* not DOS_NT */
2375 /* Return nonzero if file FILENAME exists and can be written. */
2378 check_writable (filename
)
2383 if (stat (filename
, &st
) < 0)
2385 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2386 #else /* not MSDOS */
2388 return (eaccess (filename
, 2) >= 0);
2390 /* Access isn't quite right because it uses the real uid
2391 and we really want to test with the effective uid.
2392 But Unix doesn't give us a right way to do it.
2393 Opening with O_WRONLY could work for an ordinary file,
2394 but would lose for directories. */
2395 return (access (filename
, 2) >= 0);
2397 #endif /* not MSDOS */
2400 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2401 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2402 See also `file-readable-p' and `file-attributes'.")
2404 Lisp_Object filename
;
2406 Lisp_Object abspath
;
2407 Lisp_Object handler
;
2408 struct stat statbuf
;
2410 CHECK_STRING (filename
, 0);
2411 abspath
= Fexpand_file_name (filename
, Qnil
);
2413 /* If the file name has special constructs in it,
2414 call the corresponding file handler. */
2415 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2416 if (!NILP (handler
))
2417 return call2 (handler
, Qfile_exists_p
, abspath
);
2419 return (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2422 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2423 "Return t if FILENAME can be executed by you.\n\
2424 For a directory, this means you can access files in that directory.")
2426 Lisp_Object filename
;
2429 Lisp_Object abspath
;
2430 Lisp_Object handler
;
2432 CHECK_STRING (filename
, 0);
2433 abspath
= Fexpand_file_name (filename
, Qnil
);
2435 /* If the file name has special constructs in it,
2436 call the corresponding file handler. */
2437 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2438 if (!NILP (handler
))
2439 return call2 (handler
, Qfile_executable_p
, abspath
);
2441 return (check_executable (XSTRING (abspath
)->data
) ? Qt
: Qnil
);
2444 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2445 "Return t if file FILENAME exists and you can read it.\n\
2446 See also `file-exists-p' and `file-attributes'.")
2448 Lisp_Object filename
;
2450 Lisp_Object abspath
;
2451 Lisp_Object handler
;
2454 CHECK_STRING (filename
, 0);
2455 abspath
= Fexpand_file_name (filename
, Qnil
);
2457 /* If the file name has special constructs in it,
2458 call the corresponding file handler. */
2459 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2460 if (!NILP (handler
))
2461 return call2 (handler
, Qfile_readable_p
, abspath
);
2463 desc
= open (XSTRING (abspath
)->data
, O_RDONLY
);
2470 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2472 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2473 "Return t if file FILENAME can be written or created by you.")
2475 Lisp_Object filename
;
2477 Lisp_Object abspath
, dir
;
2478 Lisp_Object handler
;
2479 struct stat statbuf
;
2481 CHECK_STRING (filename
, 0);
2482 abspath
= Fexpand_file_name (filename
, Qnil
);
2484 /* If the file name has special constructs in it,
2485 call the corresponding file handler. */
2486 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2487 if (!NILP (handler
))
2488 return call2 (handler
, Qfile_writable_p
, abspath
);
2490 if (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0)
2491 return (check_writable (XSTRING (abspath
)->data
)
2493 dir
= Ffile_name_directory (abspath
);
2496 dir
= Fdirectory_file_name (dir
);
2500 dir
= Fdirectory_file_name (dir
);
2502 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2506 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2507 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2508 The value is the name of the file to which it is linked.\n\
2509 Otherwise returns nil.")
2511 Lisp_Object filename
;
2518 Lisp_Object handler
;
2520 CHECK_STRING (filename
, 0);
2521 filename
= Fexpand_file_name (filename
, Qnil
);
2523 /* If the file name has special constructs in it,
2524 call the corresponding file handler. */
2525 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2526 if (!NILP (handler
))
2527 return call2 (handler
, Qfile_symlink_p
, filename
);
2532 buf
= (char *) xmalloc (bufsize
);
2533 bzero (buf
, bufsize
);
2534 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2535 if (valsize
< bufsize
) break;
2536 /* Buffer was not long enough */
2545 val
= make_string (buf
, valsize
);
2548 #else /* not S_IFLNK */
2550 #endif /* not S_IFLNK */
2553 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2554 "Return t if file FILENAME is the name of a directory as a file.\n\
2555 A directory name spec may be given instead; then the value is t\n\
2556 if the directory so specified exists and really is a directory.")
2558 Lisp_Object filename
;
2560 register Lisp_Object abspath
;
2562 Lisp_Object handler
;
2564 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2566 /* If the file name has special constructs in it,
2567 call the corresponding file handler. */
2568 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2569 if (!NILP (handler
))
2570 return call2 (handler
, Qfile_directory_p
, abspath
);
2572 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2574 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2577 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2578 "Return t if file FILENAME is the name of a directory as a file,\n\
2579 and files in that directory can be opened by you. In order to use a\n\
2580 directory as a buffer's current directory, this predicate must return true.\n\
2581 A directory name spec may be given instead; then the value is t\n\
2582 if the directory so specified exists and really is a readable and\n\
2583 searchable directory.")
2585 Lisp_Object filename
;
2587 Lisp_Object handler
;
2589 struct gcpro gcpro1
;
2591 /* If the file name has special constructs in it,
2592 call the corresponding file handler. */
2593 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2594 if (!NILP (handler
))
2595 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2597 /* It's an unlikely combination, but yes we really do need to gcpro:
2598 Suppose that file-accessible-directory-p has no handler, but
2599 file-directory-p does have a handler; this handler causes a GC which
2600 relocates the string in `filename'; and finally file-directory-p
2601 returns non-nil. Then we would end up passing a garbaged string
2602 to file-executable-p. */
2604 tem
= (NILP (Ffile_directory_p (filename
))
2605 || NILP (Ffile_executable_p (filename
)));
2607 return tem
? Qnil
: Qt
;
2610 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2611 "Return t if file FILENAME is the name of a regular file.\n\
2612 This is the sort of file that holds an ordinary stream of data bytes.")
2614 Lisp_Object filename
;
2616 register Lisp_Object abspath
;
2618 Lisp_Object handler
;
2620 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2622 /* If the file name has special constructs in it,
2623 call the corresponding file handler. */
2624 handler
= Ffind_file_name_handler (abspath
, Qfile_regular_p
);
2625 if (!NILP (handler
))
2626 return call2 (handler
, Qfile_regular_p
, abspath
);
2628 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2630 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2633 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2634 "Return mode bits of FILE, as an integer.")
2636 Lisp_Object filename
;
2638 Lisp_Object abspath
;
2640 Lisp_Object handler
;
2642 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2644 /* If the file name has special constructs in it,
2645 call the corresponding file handler. */
2646 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2647 if (!NILP (handler
))
2648 return call2 (handler
, Qfile_modes
, abspath
);
2650 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2653 if (check_executable (XSTRING (abspath
)->data
))
2654 st
.st_mode
|= S_IEXEC
;
2657 return make_number (st
.st_mode
& 07777);
2660 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2661 "Set mode bits of FILE to MODE (an integer).\n\
2662 Only the 12 low bits of MODE are used.")
2664 Lisp_Object filename
, mode
;
2666 Lisp_Object abspath
;
2667 Lisp_Object handler
;
2669 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2670 CHECK_NUMBER (mode
, 1);
2672 /* If the file name has special constructs in it,
2673 call the corresponding file handler. */
2674 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2675 if (!NILP (handler
))
2676 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2678 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2679 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2684 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2685 "Set the file permission bits for newly created files.\n\
2686 The argument MODE should be an integer; only the low 9 bits are used.\n\
2687 This setting is inherited by subprocesses.")
2691 CHECK_NUMBER (mode
, 0);
2693 umask ((~ XINT (mode
)) & 0777);
2698 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2699 "Return the default file protection for created files.\n\
2700 The value is an integer.")
2706 realmask
= umask (0);
2709 XSETINT (value
, (~ realmask
) & 0777);
2715 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2716 "Tell Unix to finish all pending disk updates.")
2725 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2726 "Return t if file FILE1 is newer than file FILE2.\n\
2727 If FILE1 does not exist, the answer is nil;\n\
2728 otherwise, if FILE2 does not exist, the answer is t.")
2730 Lisp_Object file1
, file2
;
2732 Lisp_Object abspath1
, abspath2
;
2735 Lisp_Object handler
;
2736 struct gcpro gcpro1
, gcpro2
;
2738 CHECK_STRING (file1
, 0);
2739 CHECK_STRING (file2
, 0);
2742 GCPRO2 (abspath1
, file2
);
2743 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2744 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2747 /* If the file name has special constructs in it,
2748 call the corresponding file handler. */
2749 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2751 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2752 if (!NILP (handler
))
2753 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2755 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2758 mtime1
= st
.st_mtime
;
2760 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2763 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2767 Lisp_Object Qfind_buffer_file_type
;
2770 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2772 "Insert contents of file FILENAME after point.\n\
2773 Returns list of absolute file name and length of data inserted.\n\
2774 If second argument VISIT is non-nil, the buffer's visited filename\n\
2775 and last save file modtime are set, and it is marked unmodified.\n\
2776 If visiting and the file does not exist, visiting is completed\n\
2777 before the error is signaled.\n\n\
2778 The optional third and fourth arguments BEG and END\n\
2779 specify what portion of the file to insert.\n\
2780 If VISIT is non-nil, BEG and END must be nil.\n\
2781 If optional fifth argument REPLACE is non-nil,\n\
2782 it means replace the current buffer contents (in the accessible portion)\n\
2783 with the file contents. This is better than simply deleting and inserting\n\
2784 the whole thing because (1) it preserves some marker positions\n\
2785 and (2) it puts less data in the undo list.")
2786 (filename
, visit
, beg
, end
, replace
)
2787 Lisp_Object filename
, visit
, beg
, end
, replace
;
2791 register int inserted
= 0;
2792 register int how_much
;
2793 int count
= specpdl_ptr
- specpdl
;
2794 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2795 Lisp_Object handler
, val
, insval
;
2798 int not_regular
= 0;
2800 if (current_buffer
->base_buffer
&& ! NILP (visit
))
2801 error ("Cannot do file visiting in an indirect buffer");
2803 if (!NILP (current_buffer
->read_only
))
2804 Fbarf_if_buffer_read_only ();
2809 GCPRO3 (filename
, val
, p
);
2811 CHECK_STRING (filename
, 0);
2812 filename
= Fexpand_file_name (filename
, Qnil
);
2814 /* If the file name has special constructs in it,
2815 call the corresponding file handler. */
2816 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2817 if (!NILP (handler
))
2819 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2820 visit
, beg
, end
, replace
);
2827 if (stat (XSTRING (filename
)->data
, &st
) < 0)
2829 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
2830 || fstat (fd
, &st
) < 0)
2831 #endif /* not APOLLO */
2833 if (fd
>= 0) close (fd
);
2836 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2843 /* This code will need to be changed in order to work on named
2844 pipes, and it's probably just not worth it. So we should at
2845 least signal an error. */
2846 if (!S_ISREG (st
.st_mode
))
2849 Fsignal (Qfile_error
,
2850 Fcons (build_string ("not a regular file"),
2851 Fcons (filename
, Qnil
)));
2859 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
2862 /* Replacement should preserve point as it preserves markers. */
2863 if (!NILP (replace
))
2864 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2866 record_unwind_protect (close_file_unwind
, make_number (fd
));
2868 /* Supposedly happens on VMS. */
2870 error ("File size is negative");
2872 if (!NILP (beg
) || !NILP (end
))
2874 error ("Attempt to visit less than an entire file");
2877 CHECK_NUMBER (beg
, 0);
2879 XSETFASTINT (beg
, 0);
2882 CHECK_NUMBER (end
, 0);
2885 XSETINT (end
, st
.st_size
);
2886 if (XINT (end
) != st
.st_size
)
2887 error ("maximum buffer size exceeded");
2890 /* If requested, replace the accessible part of the buffer
2891 with the file contents. Avoid replacing text at the
2892 beginning or end of the buffer that matches the file contents;
2893 that preserves markers pointing to the unchanged parts. */
2895 /* On MSDOS, replace mode doesn't really work, except for binary files,
2896 and it's not worth supporting just for them. */
2897 if (!NILP (replace
))
2900 XSETFASTINT (beg
, 0);
2901 XSETFASTINT (end
, st
.st_size
);
2902 del_range_1 (BEGV
, ZV
, 0);
2904 #else /* not DOS_NT */
2905 if (!NILP (replace
))
2907 unsigned char buffer
[1 << 14];
2908 int same_at_start
= BEGV
;
2909 int same_at_end
= ZV
;
2914 /* Count how many chars at the start of the file
2915 match the text at the beginning of the buffer. */
2920 nread
= read (fd
, buffer
, sizeof buffer
);
2922 error ("IO error reading %s: %s",
2923 XSTRING (filename
)->data
, strerror (errno
));
2924 else if (nread
== 0)
2927 while (bufpos
< nread
&& same_at_start
< ZV
2928 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2929 same_at_start
++, bufpos
++;
2930 /* If we found a discrepancy, stop the scan.
2931 Otherwise loop around and scan the next bufferfull. */
2932 if (bufpos
!= nread
)
2936 /* If the file matches the buffer completely,
2937 there's no need to replace anything. */
2938 if (same_at_start
- BEGV
== st
.st_size
)
2942 /* Truncate the buffer to the size of the file. */
2943 del_range_1 (same_at_start
, same_at_end
, 0);
2948 /* Count how many chars at the end of the file
2949 match the text at the end of the buffer. */
2952 int total_read
, nread
, bufpos
, curpos
, trial
;
2954 /* At what file position are we now scanning? */
2955 curpos
= st
.st_size
- (ZV
- same_at_end
);
2956 /* If the entire file matches the buffer tail, stop the scan. */
2959 /* How much can we scan in the next step? */
2960 trial
= min (curpos
, sizeof buffer
);
2961 if (lseek (fd
, curpos
- trial
, 0) < 0)
2962 report_file_error ("Setting file position",
2963 Fcons (filename
, Qnil
));
2966 while (total_read
< trial
)
2968 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2970 error ("IO error reading %s: %s",
2971 XSTRING (filename
)->data
, strerror (errno
));
2972 total_read
+= nread
;
2974 /* Scan this bufferfull from the end, comparing with
2975 the Emacs buffer. */
2976 bufpos
= total_read
;
2977 /* Compare with same_at_start to avoid counting some buffer text
2978 as matching both at the file's beginning and at the end. */
2979 while (bufpos
> 0 && same_at_end
> same_at_start
2980 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2981 same_at_end
--, bufpos
--;
2982 /* If we found a discrepancy, stop the scan.
2983 Otherwise loop around and scan the preceding bufferfull. */
2986 /* If display current starts at beginning of line,
2987 keep it that way. */
2988 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
2989 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
2993 /* Don't try to reuse the same piece of text twice. */
2994 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2996 same_at_end
+= overlap
;
2998 /* Arrange to read only the nonmatching middle part of the file. */
2999 XSETFASTINT (beg
, same_at_start
- BEGV
);
3000 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
3002 del_range_1 (same_at_start
, same_at_end
, 0);
3003 /* Insert from the file at the proper position. */
3004 SET_PT (same_at_start
);
3006 #endif /* not DOS_NT */
3008 total
= XINT (end
) - XINT (beg
);
3011 register Lisp_Object temp
;
3013 /* Make sure point-max won't overflow after this insertion. */
3014 XSETINT (temp
, total
);
3015 if (total
!= XINT (temp
))
3016 error ("maximum buffer size exceeded");
3019 if (NILP (visit
) && total
> 0)
3020 prepare_to_modify_buffer (point
, point
);
3023 if (GAP_SIZE
< total
)
3024 make_gap (total
- GAP_SIZE
);
3026 if (XINT (beg
) != 0 || !NILP (replace
))
3028 if (lseek (fd
, XINT (beg
), 0) < 0)
3029 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3033 while (inserted
< total
)
3035 /* try is reserved in some compilers (Microsoft C) */
3036 int trytry
= min (total
- inserted
, 64 << 10);
3039 /* Allow quitting out of the actual I/O. */
3042 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, trytry
);
3059 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3060 /* Determine file type from name and remove LFs from CR-LFs if the file
3061 is deemed to be a text file. */
3063 current_buffer
->buffer_file_type
3064 = call1 (Qfind_buffer_file_type
, filename
);
3065 if (NILP (current_buffer
->buffer_file_type
))
3068 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
3071 GPT
-= reduced_size
;
3072 GAP_SIZE
+= reduced_size
;
3073 inserted
-= reduced_size
;
3080 record_insert (point
, inserted
);
3082 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3083 offset_intervals (current_buffer
, point
, inserted
);
3089 /* Discard the unwind protect for closing the file. */
3093 error ("IO error reading %s: %s",
3094 XSTRING (filename
)->data
, strerror (errno
));
3101 if (!EQ (current_buffer
->undo_list
, Qt
))
3102 current_buffer
->undo_list
= Qnil
;
3104 stat (XSTRING (filename
)->data
, &st
);
3109 current_buffer
->modtime
= st
.st_mtime
;
3110 current_buffer
->filename
= filename
;
3113 SAVE_MODIFF
= MODIFF
;
3114 current_buffer
->auto_save_modified
= MODIFF
;
3115 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3116 #ifdef CLASH_DETECTION
3119 if (!NILP (current_buffer
->file_truename
))
3120 unlock_file (current_buffer
->file_truename
);
3121 unlock_file (filename
);
3123 #endif /* CLASH_DETECTION */
3125 Fsignal (Qfile_error
,
3126 Fcons (build_string ("not a regular file"),
3127 Fcons (filename
, Qnil
)));
3129 /* If visiting nonexistent file, return nil. */
3130 if (current_buffer
->modtime
== -1)
3131 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3134 /* Decode file format */
3137 insval
= call3 (Qformat_decode
,
3138 Qnil
, make_number (inserted
), visit
);
3139 CHECK_NUMBER (insval
, 0);
3140 inserted
= XFASTINT (insval
);
3143 if (inserted
> 0 && NILP (visit
) && total
> 0)
3144 signal_after_change (point
, 0, inserted
);
3148 p
= Vafter_insert_file_functions
;
3151 insval
= call1 (Fcar (p
), make_number (inserted
));
3154 CHECK_NUMBER (insval
, 0);
3155 inserted
= XFASTINT (insval
);
3163 val
= Fcons (filename
,
3164 Fcons (make_number (inserted
),
3167 RETURN_UNGCPRO (unbind_to (count
, val
));
3170 static Lisp_Object
build_annotations ();
3172 /* If build_annotations switched buffers, switch back to BUF.
3173 Kill the temporary buffer that was selected in the meantime. */
3176 build_annotations_unwind (buf
)
3181 if (XBUFFER (buf
) == current_buffer
)
3183 tembuf
= Fcurrent_buffer ();
3185 Fkill_buffer (tembuf
);
3189 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3190 "r\nFWrite region to file: ",
3191 "Write current region into specified file.\n\
3192 When called from a program, takes three arguments:\n\
3193 START, END and FILENAME. START and END are buffer positions.\n\
3194 Optional fourth argument APPEND if non-nil means\n\
3195 append to existing file contents (if any).\n\
3196 Optional fifth argument VISIT if t means\n\
3197 set the last-save-file-modtime of buffer to this file's modtime\n\
3198 and mark buffer not modified.\n\
3199 If VISIT is a string, it is a second file name;\n\
3200 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3201 VISIT is also the file name to lock and unlock for clash detection.\n\
3202 If VISIT is neither t nor nil nor a string,\n\
3203 that means do not print the \"Wrote file\" message.\n\
3204 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3205 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3206 Kludgy feature: if START is a string, then that string is written\n\
3207 to the file, instead of any buffer contents, and END is ignored.")
3208 (start
, end
, filename
, append
, visit
, lockname
)
3209 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3217 int count
= specpdl_ptr
- specpdl
;
3220 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3222 Lisp_Object handler
;
3223 Lisp_Object visit_file
;
3224 Lisp_Object annotations
;
3225 int visiting
, quietly
;
3226 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3227 struct buffer
*given_buffer
;
3229 int buffer_file_type
3230 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3233 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3234 error ("Cannot do file visiting in an indirect buffer");
3236 if (!NILP (start
) && !STRINGP (start
))
3237 validate_region (&start
, &end
);
3239 GCPRO3 (filename
, visit
, lockname
);
3240 filename
= Fexpand_file_name (filename
, Qnil
);
3241 if (STRINGP (visit
))
3242 visit_file
= Fexpand_file_name (visit
, Qnil
);
3244 visit_file
= filename
;
3247 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3248 quietly
= !NILP (visit
);
3252 if (NILP (lockname
))
3253 lockname
= visit_file
;
3255 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3257 /* If the file name has special constructs in it,
3258 call the corresponding file handler. */
3259 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3260 /* If FILENAME has no handler, see if VISIT has one. */
3261 if (NILP (handler
) && STRINGP (visit
))
3262 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3264 if (!NILP (handler
))
3267 val
= call6 (handler
, Qwrite_region
, start
, end
,
3268 filename
, append
, visit
);
3272 SAVE_MODIFF
= MODIFF
;
3273 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3274 current_buffer
->filename
= visit_file
;
3280 /* Special kludge to simplify auto-saving. */
3283 XSETFASTINT (start
, BEG
);
3284 XSETFASTINT (end
, Z
);
3287 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3288 count1
= specpdl_ptr
- specpdl
;
3290 given_buffer
= current_buffer
;
3291 annotations
= build_annotations (start
, end
);
3292 if (current_buffer
!= given_buffer
)
3298 #ifdef CLASH_DETECTION
3300 lock_file (lockname
);
3301 #endif /* CLASH_DETECTION */
3303 fn
= XSTRING (filename
)->data
;
3307 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3308 #else /* not DOS_NT */
3309 desc
= open (fn
, O_WRONLY
);
3310 #endif /* not DOS_NT */
3314 if (auto_saving
) /* Overwrite any previous version of autosave file */
3316 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3317 desc
= open (fn
, O_RDWR
);
3319 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3320 ? XSTRING (current_buffer
->filename
)->data
: 0,
3323 else /* Write to temporary name and rename if no errors */
3325 Lisp_Object temp_name
;
3326 temp_name
= Ffile_name_directory (filename
);
3328 if (!NILP (temp_name
))
3330 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3331 build_string ("$$SAVE$$")));
3332 fname
= XSTRING (filename
)->data
;
3333 fn
= XSTRING (temp_name
)->data
;
3334 desc
= creat_copy_attrs (fname
, fn
);
3337 /* If we can't open the temporary file, try creating a new
3338 version of the original file. VMS "creat" creates a
3339 new version rather than truncating an existing file. */
3342 desc
= creat (fn
, 0666);
3343 #if 0 /* This can clobber an existing file and fail to replace it,
3344 if the user runs out of space. */
3347 /* We can't make a new version;
3348 try to truncate and rewrite existing version if any. */
3350 desc
= open (fn
, O_RDWR
);
3356 desc
= creat (fn
, 0666);
3361 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3362 S_IREAD
| S_IWRITE
);
3363 #else /* not DOS_NT */
3364 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3365 #endif /* not DOS_NT */
3366 #endif /* not VMS */
3372 #ifdef CLASH_DETECTION
3374 if (!auto_saving
) unlock_file (lockname
);
3376 #endif /* CLASH_DETECTION */
3377 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3380 record_unwind_protect (close_file_unwind
, make_number (desc
));
3383 if (lseek (desc
, 0, 2) < 0)
3385 #ifdef CLASH_DETECTION
3386 if (!auto_saving
) unlock_file (lockname
);
3387 #endif /* CLASH_DETECTION */
3388 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3393 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3394 * if we do writes that don't end with a carriage return. Furthermore
3395 * it cannot handle writes of more then 16K. The modified
3396 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3397 * this EXCEPT for the last record (iff it doesn't end with a carriage
3398 * return). This implies that if your buffer doesn't end with a carriage
3399 * return, you get one free... tough. However it also means that if
3400 * we make two calls to sys_write (a la the following code) you can
3401 * get one at the gap as well. The easiest way to fix this (honest)
3402 * is to move the gap to the next newline (or the end of the buffer).
3407 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3408 move_gap (find_next_newline (GPT
, 1));
3414 if (STRINGP (start
))
3416 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3417 XSTRING (start
)->size
, 0, &annotations
);
3420 else if (XINT (start
) != XINT (end
))
3423 if (XINT (start
) < GPT
)
3425 register int end1
= XINT (end
);
3427 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3428 min (GPT
, end1
) - tem
, tem
, &annotations
);
3429 nwritten
+= min (GPT
, end1
) - tem
;
3433 if (XINT (end
) > GPT
&& !failure
)
3436 tem
= max (tem
, GPT
);
3437 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3439 nwritten
+= XINT (end
) - tem
;
3445 /* If file was empty, still need to write the annotations */
3446 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3453 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3454 Disk full in NFS may be reported here. */
3455 /* mib says that closing the file will try to write as fast as NFS can do
3456 it, and that means the fsync here is not crucial for autosave files. */
3457 if (!auto_saving
&& fsync (desc
) < 0)
3459 /* If fsync fails with EINTR, don't treat that as serious. */
3461 failure
= 1, save_errno
= errno
;
3465 /* Spurious "file has changed on disk" warnings have been
3466 observed on Suns as well.
3467 It seems that `close' can change the modtime, under nfs.
3469 (This has supposedly been fixed in Sunos 4,
3470 but who knows about all the other machines with NFS?) */
3473 /* On VMS and APOLLO, must do the stat after the close
3474 since closing changes the modtime. */
3477 /* Recall that #if defined does not work on VMS. */
3484 /* NFS can report a write failure now. */
3485 if (close (desc
) < 0)
3486 failure
= 1, save_errno
= errno
;
3489 /* If we wrote to a temporary name and had no errors, rename to real name. */
3493 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3501 /* Discard the unwind protect for close_file_unwind. */
3502 specpdl_ptr
= specpdl
+ count1
;
3503 /* Restore the original current buffer. */
3504 visit_file
= unbind_to (count
, visit_file
);
3506 #ifdef CLASH_DETECTION
3508 unlock_file (lockname
);
3509 #endif /* CLASH_DETECTION */
3511 /* Do this before reporting IO error
3512 to avoid a "file has changed on disk" warning on
3513 next attempt to save. */
3515 current_buffer
->modtime
= st
.st_mtime
;
3518 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3522 SAVE_MODIFF
= MODIFF
;
3523 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3524 current_buffer
->filename
= visit_file
;
3525 update_mode_lines
++;
3531 message ("Wrote %s", XSTRING (visit_file
)->data
);
3536 Lisp_Object
merge ();
3538 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3539 "Return t if (car A) is numerically less than (car B).")
3543 return Flss (Fcar (a
), Fcar (b
));
3546 /* Build the complete list of annotations appropriate for writing out
3547 the text between START and END, by calling all the functions in
3548 write-region-annotate-functions and merging the lists they return.
3549 If one of these functions switches to a different buffer, we assume
3550 that buffer contains altered text. Therefore, the caller must
3551 make sure to restore the current buffer in all cases,
3552 as save-excursion would do. */
3555 build_annotations (start
, end
)
3556 Lisp_Object start
, end
;
3558 Lisp_Object annotations
;
3560 struct gcpro gcpro1
, gcpro2
;
3563 p
= Vwrite_region_annotate_functions
;
3564 GCPRO2 (annotations
, p
);
3567 struct buffer
*given_buffer
= current_buffer
;
3568 Vwrite_region_annotations_so_far
= annotations
;
3569 res
= call2 (Fcar (p
), start
, end
);
3570 /* If the function makes a different buffer current,
3571 assume that means this buffer contains altered text to be output.
3572 Reset START and END from the buffer bounds
3573 and discard all previous annotations because they should have
3574 been dealt with by this function. */
3575 if (current_buffer
!= given_buffer
)
3581 Flength (res
); /* Check basic validity of return value */
3582 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3586 /* Now do the same for annotation functions implied by the file-format */
3587 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
3588 p
= Vauto_save_file_format
;
3590 p
= current_buffer
->file_format
;
3593 struct buffer
*given_buffer
= current_buffer
;
3594 Vwrite_region_annotations_so_far
= annotations
;
3595 res
= call3 (Qformat_annotate_function
, Fcar (p
), start
, end
);
3596 if (current_buffer
!= given_buffer
)
3603 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3610 /* Write to descriptor DESC the LEN characters starting at ADDR,
3611 assuming they start at position POS in the buffer.
3612 Intersperse with them the annotations from *ANNOT
3613 (those which fall within the range of positions POS to POS + LEN),
3614 each at its appropriate position.
3616 Modify *ANNOT by discarding elements as we output them.
3617 The return value is negative in case of system call failure. */
3620 a_write (desc
, addr
, len
, pos
, annot
)
3622 register char *addr
;
3629 int lastpos
= pos
+ len
;
3631 while (NILP (*annot
) || CONSP (*annot
))
3633 tem
= Fcar_safe (Fcar (*annot
));
3634 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3635 nextpos
= XFASTINT (tem
);
3637 return e_write (desc
, addr
, lastpos
- pos
);
3640 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3642 addr
+= nextpos
- pos
;
3645 tem
= Fcdr (Fcar (*annot
));
3648 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3651 *annot
= Fcdr (*annot
);
3656 e_write (desc
, addr
, len
)
3658 register char *addr
;
3661 char buf
[16 * 1024];
3662 register char *p
, *end
;
3664 if (!EQ (current_buffer
->selective_display
, Qt
))
3665 return write (desc
, addr
, len
) - len
;
3669 end
= p
+ sizeof buf
;
3674 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3683 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3689 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3690 Sverify_visited_file_modtime
, 1, 1, 0,
3691 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3692 This means that the file has not been changed since it was visited or saved.")
3698 Lisp_Object handler
;
3700 CHECK_BUFFER (buf
, 0);
3703 if (!STRINGP (b
->filename
)) return Qt
;
3704 if (b
->modtime
== 0) return Qt
;
3706 /* If the file name has special constructs in it,
3707 call the corresponding file handler. */
3708 handler
= Ffind_file_name_handler (b
->filename
,
3709 Qverify_visited_file_modtime
);
3710 if (!NILP (handler
))
3711 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3713 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3715 /* If the file doesn't exist now and didn't exist before,
3716 we say that it isn't modified, provided the error is a tame one. */
3717 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3722 if (st
.st_mtime
== b
->modtime
3723 /* If both are positive, accept them if they are off by one second. */
3724 || (st
.st_mtime
> 0 && b
->modtime
> 0
3725 && (st
.st_mtime
== b
->modtime
+ 1
3726 || st
.st_mtime
== b
->modtime
- 1)))
3731 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3732 Sclear_visited_file_modtime
, 0, 0, 0,
3733 "Clear out records of last mod time of visited file.\n\
3734 Next attempt to save will certainly not complain of a discrepancy.")
3737 current_buffer
->modtime
= 0;
3741 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3742 Svisited_file_modtime
, 0, 0, 0,
3743 "Return the current buffer's recorded visited file modification time.\n\
3744 The value is a list of the form (HIGH . LOW), like the time values\n\
3745 that `file-attributes' returns.")
3748 return long_to_cons ((unsigned long) current_buffer
->modtime
);
3751 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3752 Sset_visited_file_modtime
, 0, 1, 0,
3753 "Update buffer's recorded modification time from the visited file's time.\n\
3754 Useful if the buffer was not read from the file normally\n\
3755 or if the file itself has been changed for some known benign reason.\n\
3756 An argument specifies the modification time value to use\n\
3757 \(instead of that of the visited file), in the form of a list\n\
3758 \(HIGH . LOW) or (HIGH LOW).")
3760 Lisp_Object time_list
;
3762 if (!NILP (time_list
))
3763 current_buffer
->modtime
= cons_to_long (time_list
);
3766 register Lisp_Object filename
;
3768 Lisp_Object handler
;
3770 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3772 /* If the file name has special constructs in it,
3773 call the corresponding file handler. */
3774 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3775 if (!NILP (handler
))
3776 /* The handler can find the file name the same way we did. */
3777 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3778 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3779 current_buffer
->modtime
= st
.st_mtime
;
3789 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3790 Fsleep_for (make_number (1), Qnil
);
3791 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3792 Fsleep_for (make_number (1), Qnil
);
3793 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3794 Fsleep_for (make_number (1), Qnil
);
3804 /* Get visited file's mode to become the auto save file's mode. */
3805 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3806 /* But make sure we can overwrite it later! */
3807 auto_save_mode_bits
= st
.st_mode
| 0600;
3809 auto_save_mode_bits
= 0666;
3812 Fwrite_region (Qnil
, Qnil
,
3813 current_buffer
->auto_save_file_name
,
3814 Qnil
, Qlambda
, Qnil
);
3818 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3822 close (XINT (desc
));
3826 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3827 "Auto-save all buffers that need it.\n\
3828 This is all buffers that have auto-saving enabled\n\
3829 and are changed since last auto-saved.\n\
3830 Auto-saving writes the buffer into a file\n\
3831 so that your editing is not lost if the system crashes.\n\
3832 This file is not the file you visited; that changes only when you save.\n\
3833 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3834 Non-nil first argument means do not print any message if successful.\n\
3835 Non-nil second argument means save only current buffer.")
3836 (no_message
, current_only
)
3837 Lisp_Object no_message
, current_only
;
3839 struct buffer
*old
= current_buffer
, *b
;
3840 Lisp_Object tail
, buf
;
3842 char *omessage
= echo_area_glyphs
;
3843 int omessage_length
= echo_area_glyphs_length
;
3844 extern int minibuf_level
;
3845 int do_handled_files
;
3848 int count
= specpdl_ptr
- specpdl
;
3851 /* Ordinarily don't quit within this function,
3852 but don't make it impossible to quit (in case we get hung in I/O). */
3856 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3857 point to non-strings reached from Vbuffer_alist. */
3862 if (!NILP (Vrun_hooks
))
3863 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3865 if (STRINGP (Vauto_save_list_file_name
))
3867 Lisp_Object listfile
;
3868 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
3870 listdesc
= open (XSTRING (listfile
)->data
,
3871 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3872 S_IREAD
| S_IWRITE
);
3873 #else /* not DOS_NT */
3874 listdesc
= creat (XSTRING (listfile
)->data
, 0666);
3875 #endif /* not DOS_NT */
3880 /* Arrange to close that file whether or not we get an error.
3881 Also reset auto_saving to 0. */
3883 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3887 /* First, save all files which don't have handlers. If Emacs is
3888 crashing, the handlers may tweak what is causing Emacs to crash
3889 in the first place, and it would be a shame if Emacs failed to
3890 autosave perfectly ordinary files because it couldn't handle some
3892 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3893 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
3895 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3898 /* Record all the buffers that have auto save mode
3899 in the special file that lists them. For each of these buffers,
3900 Record visited name (if any) and auto save name. */
3901 if (STRINGP (b
->auto_save_file_name
)
3902 && listdesc
>= 0 && do_handled_files
== 0)
3904 if (!NILP (b
->filename
))
3906 write (listdesc
, XSTRING (b
->filename
)->data
,
3907 XSTRING (b
->filename
)->size
);
3909 write (listdesc
, "\n", 1);
3910 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3911 XSTRING (b
->auto_save_file_name
)->size
);
3912 write (listdesc
, "\n", 1);
3915 if (!NILP (current_only
)
3916 && b
!= current_buffer
)
3919 /* Don't auto-save indirect buffers.
3920 The base buffer takes care of it. */
3924 /* Check for auto save enabled
3925 and file changed since last auto save
3926 and file changed since last real save. */
3927 if (STRINGP (b
->auto_save_file_name
)
3928 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
3929 && b
->auto_save_modified
< BUF_MODIFF (b
)
3930 /* -1 means we've turned off autosaving for a while--see below. */
3931 && XINT (b
->save_length
) >= 0
3932 && (do_handled_files
3933 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3936 EMACS_TIME before_time
, after_time
;
3938 EMACS_GET_TIME (before_time
);
3940 /* If we had a failure, don't try again for 20 minutes. */
3941 if (b
->auto_save_failure_time
>= 0
3942 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3945 if ((XFASTINT (b
->save_length
) * 10
3946 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3947 /* A short file is likely to change a large fraction;
3948 spare the user annoying messages. */
3949 && XFASTINT (b
->save_length
) > 5000
3950 /* These messages are frequent and annoying for `*mail*'. */
3951 && !EQ (b
->filename
, Qnil
)
3952 && NILP (no_message
))
3954 /* It has shrunk too much; turn off auto-saving here. */
3955 message ("Buffer %s has shrunk a lot; auto save turned off there",
3956 XSTRING (b
->name
)->data
);
3957 /* Turn off auto-saving until there's a real save,
3958 and prevent any more warnings. */
3959 XSETINT (b
->save_length
, -1);
3960 Fsleep_for (make_number (1), Qnil
);
3963 set_buffer_internal (b
);
3964 if (!auto_saved
&& NILP (no_message
))
3965 message1 ("Auto-saving...");
3966 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3968 b
->auto_save_modified
= BUF_MODIFF (b
);
3969 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3970 set_buffer_internal (old
);
3972 EMACS_GET_TIME (after_time
);
3974 /* If auto-save took more than 60 seconds,
3975 assume it was an NFS failure that got a timeout. */
3976 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3977 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3981 /* Prevent another auto save till enough input events come in. */
3982 record_auto_save ();
3984 if (auto_saved
&& NILP (no_message
))
3987 message2 (omessage
, omessage_length
);
3989 message1 ("Auto-saving...done");
3994 unbind_to (count
, Qnil
);
3998 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3999 Sset_buffer_auto_saved
, 0, 0, 0,
4000 "Mark current buffer as auto-saved with its current text.\n\
4001 No auto-save file will be written until the buffer changes again.")
4004 current_buffer
->auto_save_modified
= MODIFF
;
4005 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4006 current_buffer
->auto_save_failure_time
= -1;
4010 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4011 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4012 "Clear any record of a recent auto-save failure in the current buffer.")
4015 current_buffer
->auto_save_failure_time
= -1;
4019 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4021 "Return t if buffer has been auto-saved since last read in or saved.")
4024 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4027 /* Reading and completing file names */
4028 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4030 /* In the string VAL, change each $ to $$ and return the result. */
4033 double_dollars (val
)
4036 register unsigned char *old
, *new;
4040 osize
= XSTRING (val
)->size
;
4041 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4042 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4043 if (*old
++ == '$') count
++;
4046 old
= XSTRING (val
)->data
;
4047 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4048 new = XSTRING (val
)->data
;
4049 for (n
= osize
; n
> 0; n
--)
4062 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4064 "Internal subroutine for read-file-name. Do not call this.")
4065 (string
, dir
, action
)
4066 Lisp_Object string
, dir
, action
;
4067 /* action is nil for complete, t for return list of completions,
4068 lambda for verify final value */
4070 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4072 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4079 /* No need to protect ACTION--we only compare it with t and nil. */
4080 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4082 if (XSTRING (string
)->size
== 0)
4084 if (EQ (action
, Qlambda
))
4092 orig_string
= string
;
4093 string
= Fsubstitute_in_file_name (string
);
4094 changed
= NILP (Fstring_equal (string
, orig_string
));
4095 name
= Ffile_name_nondirectory (string
);
4096 val
= Ffile_name_directory (string
);
4098 realdir
= Fexpand_file_name (val
, realdir
);
4103 specdir
= Ffile_name_directory (string
);
4104 val
= Ffile_name_completion (name
, realdir
);
4109 return double_dollars (string
);
4113 if (!NILP (specdir
))
4114 val
= concat2 (specdir
, val
);
4116 return double_dollars (val
);
4119 #endif /* not VMS */
4123 if (EQ (action
, Qt
))
4124 return Ffile_name_all_completions (name
, realdir
);
4125 /* Only other case actually used is ACTION = lambda */
4127 /* Supposedly this helps commands such as `cd' that read directory names,
4128 but can someone explain how it helps them? -- RMS */
4129 if (XSTRING (name
)->size
== 0)
4132 return Ffile_exists_p (string
);
4135 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4136 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4137 Value is not expanded---you must call `expand-file-name' yourself.\n\
4138 Default name to DEFAULT if user enters a null string.\n\
4139 (If DEFAULT is omitted, the visited file name is used,\n\
4140 except that if INITIAL is specified, that combined with DIR is used.)\n\
4141 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4142 Non-nil and non-t means also require confirmation after completion.\n\
4143 Fifth arg INITIAL specifies text to start with.\n\
4144 DIR defaults to current buffer's directory default.")
4145 (prompt
, dir
, defalt
, mustmatch
, initial
)
4146 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4148 Lisp_Object val
, insdef
, insdef1
, tem
;
4149 struct gcpro gcpro1
, gcpro2
;
4150 register char *homedir
;
4154 dir
= current_buffer
->directory
;
4157 if (! NILP (initial
))
4158 defalt
= Fexpand_file_name (initial
, dir
);
4160 defalt
= current_buffer
->filename
;
4163 /* If dir starts with user's homedir, change that to ~. */
4164 homedir
= (char *) egetenv ("HOME");
4167 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4168 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4170 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4171 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4172 XSTRING (dir
)->data
[0] = '~';
4175 if (insert_default_directory
)
4178 if (!NILP (initial
))
4180 Lisp_Object args
[2], pos
;
4184 insdef
= Fconcat (2, args
);
4185 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4186 insdef1
= Fcons (double_dollars (insdef
), pos
);
4189 insdef1
= double_dollars (insdef
);
4191 else if (!NILP (initial
))
4194 insdef1
= Fcons (double_dollars (insdef
), 0);
4197 insdef
= Qnil
, insdef1
= Qnil
;
4200 count
= specpdl_ptr
- specpdl
;
4201 specbind (intern ("completion-ignore-case"), Qt
);
4204 GCPRO2 (insdef
, defalt
);
4205 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4206 dir
, mustmatch
, insdef1
,
4207 Qfile_name_history
);
4210 unbind_to (count
, Qnil
);
4215 error ("No file name specified");
4216 tem
= Fstring_equal (val
, insdef
);
4217 if (!NILP (tem
) && !NILP (defalt
))
4219 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4224 error ("No default file name");
4226 return Fsubstitute_in_file_name (val
);
4229 #if 0 /* Old version */
4230 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4231 /* Don't confuse make-docfile by having two doc strings for this function.
4232 make-docfile does not pay attention to #if, for good reason! */
4234 (prompt
, dir
, defalt
, mustmatch
, initial
)
4235 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4237 Lisp_Object val
, insdef
, tem
;
4238 struct gcpro gcpro1
, gcpro2
;
4239 register char *homedir
;
4243 dir
= current_buffer
->directory
;
4245 defalt
= current_buffer
->filename
;
4247 /* If dir starts with user's homedir, change that to ~. */
4248 homedir
= (char *) egetenv ("HOME");
4251 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4252 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4254 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4255 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4256 XSTRING (dir
)->data
[0] = '~';
4259 if (!NILP (initial
))
4261 else if (insert_default_directory
)
4264 insdef
= build_string ("");
4267 count
= specpdl_ptr
- specpdl
;
4268 specbind (intern ("completion-ignore-case"), Qt
);
4271 GCPRO2 (insdef
, defalt
);
4272 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4274 insert_default_directory
? insdef
: Qnil
,
4275 Qfile_name_history
);
4278 unbind_to (count
, Qnil
);
4283 error ("No file name specified");
4284 tem
= Fstring_equal (val
, insdef
);
4285 if (!NILP (tem
) && !NILP (defalt
))
4287 return Fsubstitute_in_file_name (val
);
4289 #endif /* Old version */
4293 Qexpand_file_name
= intern ("expand-file-name");
4294 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4295 Qdirectory_file_name
= intern ("directory-file-name");
4296 Qfile_name_directory
= intern ("file-name-directory");
4297 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4298 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4299 Qfile_name_as_directory
= intern ("file-name-as-directory");
4300 Qcopy_file
= intern ("copy-file");
4301 Qmake_directory_internal
= intern ("make-directory-internal");
4302 Qdelete_directory
= intern ("delete-directory");
4303 Qdelete_file
= intern ("delete-file");
4304 Qrename_file
= intern ("rename-file");
4305 Qadd_name_to_file
= intern ("add-name-to-file");
4306 Qmake_symbolic_link
= intern ("make-symbolic-link");
4307 Qfile_exists_p
= intern ("file-exists-p");
4308 Qfile_executable_p
= intern ("file-executable-p");
4309 Qfile_readable_p
= intern ("file-readable-p");
4310 Qfile_symlink_p
= intern ("file-symlink-p");
4311 Qfile_writable_p
= intern ("file-writable-p");
4312 Qfile_directory_p
= intern ("file-directory-p");
4313 Qfile_regular_p
= intern ("file-regular-p");
4314 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4315 Qfile_modes
= intern ("file-modes");
4316 Qset_file_modes
= intern ("set-file-modes");
4317 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4318 Qinsert_file_contents
= intern ("insert-file-contents");
4319 Qwrite_region
= intern ("write-region");
4320 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4321 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4323 staticpro (&Qexpand_file_name
);
4324 staticpro (&Qsubstitute_in_file_name
);
4325 staticpro (&Qdirectory_file_name
);
4326 staticpro (&Qfile_name_directory
);
4327 staticpro (&Qfile_name_nondirectory
);
4328 staticpro (&Qunhandled_file_name_directory
);
4329 staticpro (&Qfile_name_as_directory
);
4330 staticpro (&Qcopy_file
);
4331 staticpro (&Qmake_directory_internal
);
4332 staticpro (&Qdelete_directory
);
4333 staticpro (&Qdelete_file
);
4334 staticpro (&Qrename_file
);
4335 staticpro (&Qadd_name_to_file
);
4336 staticpro (&Qmake_symbolic_link
);
4337 staticpro (&Qfile_exists_p
);
4338 staticpro (&Qfile_executable_p
);
4339 staticpro (&Qfile_readable_p
);
4340 staticpro (&Qfile_symlink_p
);
4341 staticpro (&Qfile_writable_p
);
4342 staticpro (&Qfile_directory_p
);
4343 staticpro (&Qfile_regular_p
);
4344 staticpro (&Qfile_accessible_directory_p
);
4345 staticpro (&Qfile_modes
);
4346 staticpro (&Qset_file_modes
);
4347 staticpro (&Qfile_newer_than_file_p
);
4348 staticpro (&Qinsert_file_contents
);
4349 staticpro (&Qwrite_region
);
4350 staticpro (&Qverify_visited_file_modtime
);
4352 Qfile_name_history
= intern ("file-name-history");
4353 Fset (Qfile_name_history
, Qnil
);
4354 staticpro (&Qfile_name_history
);
4356 Qfile_error
= intern ("file-error");
4357 staticpro (&Qfile_error
);
4358 Qfile_already_exists
= intern("file-already-exists");
4359 staticpro (&Qfile_already_exists
);
4362 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4363 staticpro (&Qfind_buffer_file_type
);
4366 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
4367 "*Format in which to write auto-save files.\n\
4368 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
4369 If it is t, which is the default, auto-save files are written in the\n\
4370 same format as a regular save would use.");
4371 Vauto_save_file_format
= Qt
;
4373 Qformat_decode
= intern ("format-decode");
4374 staticpro (&Qformat_decode
);
4375 Qformat_annotate_function
= intern ("format-annotate-function");
4376 staticpro (&Qformat_annotate_function
);
4378 Qcar_less_than_car
= intern ("car-less-than-car");
4379 staticpro (&Qcar_less_than_car
);
4381 Fput (Qfile_error
, Qerror_conditions
,
4382 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4383 Fput (Qfile_error
, Qerror_message
,
4384 build_string ("File error"));
4386 Fput (Qfile_already_exists
, Qerror_conditions
,
4387 Fcons (Qfile_already_exists
,
4388 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4389 Fput (Qfile_already_exists
, Qerror_message
,
4390 build_string ("File already exists"));
4392 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4393 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4394 insert_default_directory
= 1;
4396 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4397 "*Non-nil means write new files with record format `stmlf'.\n\
4398 nil means use format `var'. This variable is meaningful only on VMS.");
4399 vms_stmlf_recfm
= 0;
4401 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4402 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4403 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4406 The first argument given to HANDLER is the name of the I/O primitive\n\
4407 to be handled; the remaining arguments are the arguments that were\n\
4408 passed to that primitive. For example, if you do\n\
4409 (file-exists-p FILENAME)\n\
4410 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4411 (funcall HANDLER 'file-exists-p FILENAME)\n\
4412 The function `find-file-name-handler' checks this list for a handler\n\
4413 for its argument.");
4414 Vfile_name_handler_alist
= Qnil
;
4416 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4417 "A list of functions to be called at the end of `insert-file-contents'.\n\
4418 Each is passed one argument, the number of bytes inserted. It should return\n\
4419 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4420 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4421 responsible for calling the after-insert-file-functions if appropriate.");
4422 Vafter_insert_file_functions
= Qnil
;
4424 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4425 "A list of functions to be called at the start of `write-region'.\n\
4426 Each is passed two arguments, START and END as for `write-region'. It should\n\
4427 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4428 inserted at the specified positions of the file being written (1 means to\n\
4429 insert before the first byte written). The POSITIONs must be sorted into\n\
4430 increasing order. If there are several functions in the list, the several\n\
4431 lists are merged destructively.");
4432 Vwrite_region_annotate_functions
= Qnil
;
4434 DEFVAR_LISP ("write-region-annotations-so-far",
4435 &Vwrite_region_annotations_so_far
,
4436 "When an annotation function is called, this holds the previous annotations.\n\
4437 These are the annotations made by other annotation functions\n\
4438 that were already called. See also `write-region-annotate-functions'.");
4439 Vwrite_region_annotations_so_far
= Qnil
;
4441 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4442 "A list of file name handlers that temporarily should not be used.\n\
4443 This applies only to the operation `inhibit-file-name-operation'.");
4444 Vinhibit_file_name_handlers
= Qnil
;
4446 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4447 "The operation for which `inhibit-file-name-handlers' is applicable.");
4448 Vinhibit_file_name_operation
= Qnil
;
4450 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4451 "File name in which we write a list of all auto save file names.");
4452 Vauto_save_list_file_name
= Qnil
;
4454 defsubr (&Sfind_file_name_handler
);
4455 defsubr (&Sfile_name_directory
);
4456 defsubr (&Sfile_name_nondirectory
);
4457 defsubr (&Sunhandled_file_name_directory
);
4458 defsubr (&Sfile_name_as_directory
);
4459 defsubr (&Sdirectory_file_name
);
4460 defsubr (&Smake_temp_name
);
4461 defsubr (&Sexpand_file_name
);
4462 defsubr (&Ssubstitute_in_file_name
);
4463 defsubr (&Scopy_file
);
4464 defsubr (&Smake_directory_internal
);
4465 defsubr (&Sdelete_directory
);
4466 defsubr (&Sdelete_file
);
4467 defsubr (&Srename_file
);
4468 defsubr (&Sadd_name_to_file
);
4470 defsubr (&Smake_symbolic_link
);
4471 #endif /* S_IFLNK */
4473 defsubr (&Sdefine_logical_name
);
4476 defsubr (&Ssysnetunam
);
4477 #endif /* HPUX_NET */
4478 defsubr (&Sfile_name_absolute_p
);
4479 defsubr (&Sfile_exists_p
);
4480 defsubr (&Sfile_executable_p
);
4481 defsubr (&Sfile_readable_p
);
4482 defsubr (&Sfile_writable_p
);
4483 defsubr (&Sfile_symlink_p
);
4484 defsubr (&Sfile_directory_p
);
4485 defsubr (&Sfile_accessible_directory_p
);
4486 defsubr (&Sfile_regular_p
);
4487 defsubr (&Sfile_modes
);
4488 defsubr (&Sset_file_modes
);
4489 defsubr (&Sset_default_file_modes
);
4490 defsubr (&Sdefault_file_modes
);
4491 defsubr (&Sfile_newer_than_file_p
);
4492 defsubr (&Sinsert_file_contents
);
4493 defsubr (&Swrite_region
);
4494 defsubr (&Scar_less_than_car
);
4495 defsubr (&Sverify_visited_file_modtime
);
4496 defsubr (&Sclear_visited_file_modtime
);
4497 defsubr (&Svisited_file_modtime
);
4498 defsubr (&Sset_visited_file_modtime
);
4499 defsubr (&Sdo_auto_save
);
4500 defsubr (&Sset_buffer_auto_saved
);
4501 defsubr (&Sclear_buffer_auto_save_failure
);
4502 defsubr (&Srecent_auto_save_p
);
4504 defsubr (&Sread_file_name_internal
);
4505 defsubr (&Sread_file_name
);
4508 defsubr (&Sunix_sync
);