1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 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 /* Functions to be called to process text properties in inserted file. */
132 Lisp_Object Vafter_insert_file_functions
;
134 /* Functions to be called to create text property annotations for file. */
135 Lisp_Object Vwrite_region_annotate_functions
;
137 /* During build_annotations, each time an annotation function is called,
138 this holds the annotations made by the previous functions. */
139 Lisp_Object Vwrite_region_annotations_so_far
;
141 /* File name in which we write a list of all our auto save files. */
142 Lisp_Object Vauto_save_list_file_name
;
144 /* Nonzero means, when reading a filename in the minibuffer,
145 start out by inserting the default directory into the minibuffer. */
146 int insert_default_directory
;
148 /* On VMS, nonzero means write new files with record format stmlf.
149 Zero means use var format. */
152 /* These variables describe handlers that have "already" had a chance
153 to handle the current operation.
155 Vinhibit_file_name_handlers is a list of file name handlers.
156 Vinhibit_file_name_operation is the operation being handled.
157 If we try to handle that operation, we ignore those handlers. */
159 static Lisp_Object Vinhibit_file_name_handlers
;
160 static Lisp_Object Vinhibit_file_name_operation
;
162 Lisp_Object Qfile_error
, Qfile_already_exists
;
164 Lisp_Object Qfile_name_history
;
166 Lisp_Object Qcar_less_than_car
;
168 report_file_error (string
, data
)
172 Lisp_Object errstring
;
174 errstring
= build_string (strerror (errno
));
176 /* System error messages are capitalized. Downcase the initial
177 unless it is followed by a slash. */
178 if (XSTRING (errstring
)->data
[1] != '/')
179 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
182 Fsignal (Qfile_error
,
183 Fcons (build_string (string
), Fcons (errstring
, data
)));
186 close_file_unwind (fd
)
189 close (XFASTINT (fd
));
192 /* Restore point, having saved it as a marker. */
194 restore_point_unwind (location
)
195 Lisp_Object location
;
197 SET_PT (marker_position (location
));
198 Fset_marker (location
, Qnil
, Qnil
);
201 Lisp_Object Qexpand_file_name
;
202 Lisp_Object Qdirectory_file_name
;
203 Lisp_Object Qfile_name_directory
;
204 Lisp_Object Qfile_name_nondirectory
;
205 Lisp_Object Qunhandled_file_name_directory
;
206 Lisp_Object Qfile_name_as_directory
;
207 Lisp_Object Qcopy_file
;
208 Lisp_Object Qmake_directory_internal
;
209 Lisp_Object Qdelete_directory
;
210 Lisp_Object Qdelete_file
;
211 Lisp_Object Qrename_file
;
212 Lisp_Object Qadd_name_to_file
;
213 Lisp_Object Qmake_symbolic_link
;
214 Lisp_Object Qfile_exists_p
;
215 Lisp_Object Qfile_executable_p
;
216 Lisp_Object Qfile_readable_p
;
217 Lisp_Object Qfile_symlink_p
;
218 Lisp_Object Qfile_writable_p
;
219 Lisp_Object Qfile_directory_p
;
220 Lisp_Object Qfile_accessible_directory_p
;
221 Lisp_Object Qfile_modes
;
222 Lisp_Object Qset_file_modes
;
223 Lisp_Object Qfile_newer_than_file_p
;
224 Lisp_Object Qinsert_file_contents
;
225 Lisp_Object Qwrite_region
;
226 Lisp_Object Qverify_visited_file_modtime
;
227 Lisp_Object Qset_visited_file_modtime
;
228 Lisp_Object Qsubstitute_in_file_name
;
230 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
231 "Return FILENAME's handler function for OPERATION, if it has one.\n\
232 Otherwise, return nil.\n\
233 A file name is handled if one of the regular expressions in\n\
234 `file-name-handler-alist' matches it.\n\n\
235 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
236 any handlers that are members of `inhibit-file-name-handlers',\n\
237 but we still do run any other handlers. This lets handlers\n\
238 use the standard functions without calling themselves recursively.")
239 (filename
, operation
)
240 Lisp_Object filename
, operation
;
242 /* This function must not munge the match data. */
243 Lisp_Object chain
, inhibited_handlers
;
245 CHECK_STRING (filename
, 0);
247 if (EQ (operation
, Vinhibit_file_name_operation
))
248 inhibited_handlers
= Vinhibit_file_name_handlers
;
250 inhibited_handlers
= Qnil
;
252 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
253 chain
= XCONS (chain
)->cdr
)
256 elt
= XCONS (chain
)->car
;
260 string
= XCONS (elt
)->car
;
261 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
263 Lisp_Object handler
, tem
;
265 handler
= XCONS (elt
)->cdr
;
266 tem
= Fmemq (handler
, inhibited_handlers
);
277 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
279 "Return the directory component in file name NAME.\n\
280 Return nil if NAME does not include a directory.\n\
281 Otherwise return a directory spec.\n\
282 Given a Unix syntax file name, returns a string ending in slash;\n\
283 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
287 register unsigned char *beg
;
288 register unsigned char *p
;
291 CHECK_STRING (file
, 0);
293 /* If the file name has special constructs in it,
294 call the corresponding file handler. */
295 handler
= Ffind_file_name_handler (file
, Qfile_name_directory
);
297 return call2 (handler
, Qfile_name_directory
, file
);
299 #ifdef FILE_SYSTEM_CASE
300 file
= FILE_SYSTEM_CASE (file
);
302 beg
= XSTRING (file
)->data
;
303 p
= beg
+ XSTRING (file
)->size
;
305 while (p
!= beg
&& !IS_ANY_SEP (p
[-1])
307 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
310 && p
[-1] != ':' && p
[-1] != '\\'
317 /* Expansion of "c:" to drive and default directory. */
318 /* (NT does the right thing.) */
319 if (p
== beg
+ 2 && beg
[1] == ':')
321 int drive
= (*beg
) - 'a';
322 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
323 unsigned char *res
= alloca (MAXPATHLEN
+ 5);
327 /* The NT version places the drive letter at the beginning already. */
328 #else /* not WINDOWSNT */
329 /* On MSDOG we must put the drive letter in by hand. */
331 #endif /* not WINDOWSNT */
332 if (getdefdir (drive
+ 1, res
))
335 res
[0] = drive
+ 'a';
338 if (IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
341 p
= beg
+ strlen (beg
);
345 return make_string (beg
, p
- beg
);
348 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
350 "Return file name NAME sans its directory.\n\
351 For example, in a Unix-syntax file name,\n\
352 this is everything after the last slash,\n\
353 or the entire name if it contains no slash.")
357 register unsigned char *beg
, *p
, *end
;
360 CHECK_STRING (file
, 0);
362 /* If the file name has special constructs in it,
363 call the corresponding file handler. */
364 handler
= Ffind_file_name_handler (file
, Qfile_name_nondirectory
);
366 return call2 (handler
, Qfile_name_nondirectory
, file
);
368 beg
= XSTRING (file
)->data
;
369 end
= p
= beg
+ XSTRING (file
)->size
;
371 while (p
!= beg
&& !IS_ANY_SEP (p
[-1])
373 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
380 return make_string (p
, end
- p
);
383 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
384 "Return a directly usable directory name somehow associated with FILENAME.\n\
385 A `directly usable' directory name is one that may be used without the\n\
386 intervention of any file handler.\n\
387 If FILENAME is a directly usable file itself, return\n\
388 (file-name-directory FILENAME).\n\
389 The `call-process' and `start-process' functions use this function to\n\
390 get a current directory to run processes in.")
392 Lisp_Object filename
;
396 /* If the file name has special constructs in it,
397 call the corresponding file handler. */
398 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
400 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
402 return Ffile_name_directory (filename
);
407 file_name_as_directory (out
, in
)
410 int size
= strlen (in
) - 1;
415 /* Is it already a directory string? */
416 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
418 /* Is it a VMS directory file name? If so, hack VMS syntax. */
419 else if (! index (in
, '/')
420 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
421 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
422 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
423 || ! strncmp (&in
[size
- 5], ".dir", 4))
424 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
425 && in
[size
] == '1')))
427 register char *p
, *dot
;
431 dir:x.dir --> dir:[x]
432 dir:[x]y.dir --> dir:[x.y] */
434 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
437 strncpy (out
, in
, p
- in
);
456 dot
= index (p
, '.');
459 /* blindly remove any extension */
460 size
= strlen (out
) + (dot
- p
);
461 strncat (out
, p
, dot
- p
);
472 /* For Unix syntax, Append a slash if necessary */
474 if (out
[size
] != ':' && out
[size
] != '/' && out
[size
] != '\\')
475 #else /* not MSDOS */
476 if (!IS_ANY_SEP (out
[size
]))
478 out
[size
+ 1] = DIRECTORY_SEP
;
479 out
[size
+ 2] = '\0';
481 #endif /* not MSDOS */
486 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
487 Sfile_name_as_directory
, 1, 1, 0,
488 "Return a string representing file FILENAME interpreted as a directory.\n\
489 This operation exists because a directory is also a file, but its name as\n\
490 a directory is different from its name as a file.\n\
491 The result can be used as the value of `default-directory'\n\
492 or passed as second argument to `expand-file-name'.\n\
493 For a Unix-syntax file name, just appends a slash.\n\
494 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
501 CHECK_STRING (file
, 0);
505 /* If the file name has special constructs in it,
506 call the corresponding file handler. */
507 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
509 return call2 (handler
, Qfile_name_as_directory
, file
);
511 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
512 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
516 * Convert from directory name to filename.
518 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
519 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
520 * On UNIX, it's simple: just make sure there is a terminating /
522 * Value is nonzero if the string output is different from the input.
525 directory_file_name (src
, dst
)
533 struct FAB fab
= cc$rms_fab
;
534 struct NAM nam
= cc$rms_nam
;
535 char esa
[NAM$C_MAXRSS
];
540 if (! index (src
, '/')
541 && (src
[slen
- 1] == ']'
542 || src
[slen
- 1] == ':'
543 || src
[slen
- 1] == '>'))
545 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
547 fab
.fab$b_fns
= slen
;
548 fab
.fab$l_nam
= &nam
;
549 fab
.fab$l_fop
= FAB$M_NAM
;
552 nam
.nam$b_ess
= sizeof esa
;
553 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
555 /* We call SYS$PARSE to handle such things as [--] for us. */
556 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
558 slen
= nam
.nam$b_esl
;
559 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
564 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
566 /* what about when we have logical_name:???? */
567 if (src
[slen
- 1] == ':')
568 { /* Xlate logical name and see what we get */
569 ptr
= strcpy (dst
, src
); /* upper case for getenv */
572 if ('a' <= *ptr
&& *ptr
<= 'z')
576 dst
[slen
- 1] = 0; /* remove colon */
577 if (!(src
= egetenv (dst
)))
579 /* should we jump to the beginning of this procedure?
580 Good points: allows us to use logical names that xlate
582 Bad points: can be a problem if we just translated to a device
584 For now, I'll punt and always expect VMS names, and hope for
587 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
588 { /* no recursion here! */
594 { /* not a directory spec */
599 bracket
= src
[slen
- 1];
601 /* If bracket is ']' or '>', bracket - 2 is the corresponding
603 ptr
= index (src
, bracket
- 2);
605 { /* no opening bracket */
609 if (!(rptr
= rindex (src
, '.')))
612 strncpy (dst
, src
, slen
);
616 dst
[slen
++] = bracket
;
621 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
622 then translate the device and recurse. */
623 if (dst
[slen
- 1] == ':'
624 && dst
[slen
- 2] != ':' /* skip decnet nodes */
625 && strcmp(src
+ slen
, "[000000]") == 0)
627 dst
[slen
- 1] = '\0';
628 if ((ptr
= egetenv (dst
))
629 && (rlen
= strlen (ptr
) - 1) > 0
630 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
631 && ptr
[rlen
- 1] == '.')
633 char * buf
= (char *) alloca (strlen (ptr
) + 1);
637 return directory_file_name (buf
, dst
);
642 strcat (dst
, "[000000]");
646 rlen
= strlen (rptr
) - 1;
647 strncat (dst
, rptr
, rlen
);
648 dst
[slen
+ rlen
] = '\0';
649 strcat (dst
, ".DIR.1");
653 /* Process as Unix format: just remove any final slash.
654 But leave "/" unchanged; do not change it to "". */
657 && IS_DIRECTORY_SEP (dst
[slen
- 1])
658 && !IS_DEVICE_SEP (dst
[slen
- 2]))
663 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
665 "Returns the file name of the directory named DIR.\n\
666 This is the name of the file that holds the data for the directory DIR.\n\
667 This operation exists because a directory is also a file, but its name as\n\
668 a directory is different from its name as a file.\n\
669 In Unix-syntax, this function just removes the final slash.\n\
670 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
671 it returns a file name such as \"[X]Y.DIR.1\".")
673 Lisp_Object directory
;
678 CHECK_STRING (directory
, 0);
680 if (NILP (directory
))
683 /* If the file name has special constructs in it,
684 call the corresponding file handler. */
685 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
687 return call2 (handler
, Qdirectory_file_name
, directory
);
690 /* 20 extra chars is insufficient for VMS, since we might perform a
691 logical name translation. an equivalence string can be up to 255
692 chars long, so grab that much extra space... - sss */
693 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
695 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
697 directory_file_name (XSTRING (directory
)->data
, buf
);
698 return build_string (buf
);
701 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
702 "Generate temporary file name (string) starting with PREFIX (a string).\n\
703 The Emacs process number forms part of the result,\n\
704 so there is no danger of generating a name being used by another process.")
709 val
= concat2 (prefix
, build_string ("XXXXXX"));
710 mktemp (XSTRING (val
)->data
);
714 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
715 "Convert FILENAME to absolute, and canonicalize it.\n\
716 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
717 (does not start with slash); if DEFAULT is nil or missing,\n\
718 the current buffer's value of default-directory is used.\n\
719 Path components that are `.' are removed, and \n\
720 path components followed by `..' are removed, along with the `..' itself;\n\
721 note that these simplifications are done without checking the resulting\n\
722 paths in the file system.\n\
723 An initial `~/' expands to your home directory.\n\
724 An initial `~USER/' expands to USER's home directory.\n\
725 See also the function `substitute-in-file-name'.")
727 Lisp_Object name
, defalt
;
731 register unsigned char *newdir
, *p
, *o
;
733 unsigned char *target
;
736 unsigned char * colon
= 0;
737 unsigned char * close
= 0;
738 unsigned char * slash
= 0;
739 unsigned char * brack
= 0;
740 int lbrack
= 0, rbrack
= 0;
744 /* Demacs 1.1.2 91/10/20 Manabu Higashida */
747 unsigned char *tmp
, *defdir
;
751 CHECK_STRING (name
, 0);
753 /* If the file name has special constructs in it,
754 call the corresponding file handler. */
755 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
757 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
759 /* Use the buffer's default-directory if DEFALT is omitted. */
761 defalt
= current_buffer
->directory
;
762 CHECK_STRING (defalt
, 1);
764 o
= XSTRING (defalt
)->data
;
766 /* Make sure DEFALT is properly expanded.
767 It would be better to do this down below where we actually use
768 defalt. Unfortunately, calling Fexpand_file_name recursively
769 could invoke GC, and the strings might be relocated. This would
770 be annoying because we have pointers into strings lying around
771 that would need adjusting, and people would add new pointers to
772 the code and forget to adjust them, resulting in intermittent bugs.
773 Putting this call here avoids all that crud.
775 The EQ test avoids infinite recursion. */
776 if (! NILP (defalt
) && !EQ (defalt
, name
)
777 /* This saves time in a common case. */
778 && ! (XSTRING (defalt
)->size
>= 3
779 && IS_DIRECTORY_SEP (XSTRING (defalt
)->data
[0])
780 && IS_DEVICE_SEP (XSTRING (defalt
)->data
[1])))
785 defalt
= Fexpand_file_name (defalt
, Qnil
);
790 /* Filenames on VMS are always upper case. */
791 name
= Fupcase (name
);
793 #ifdef FILE_SYSTEM_CASE
794 name
= FILE_SYSTEM_CASE (name
);
797 nm
= XSTRING (name
)->data
;
800 /* First map all backslashes to slashes. */
801 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
805 /* Now strip drive name. */
807 unsigned char *colon
= rindex (nm
, ':');
813 drive
= tolower (colon
[-1]) - 'a';
815 if (!IS_DIRECTORY_SEP (*nm
))
817 defdir
= alloca (MAXPATHLEN
+ 1);
818 relpath
= getdefdir (drive
+ 1, defdir
);
824 /* If nm is absolute, flush ...// and detect /./ and /../.
825 If no /./ or /../ we can return right away. */
827 IS_DIRECTORY_SEP (nm
[0])
833 /* If it turns out that the filename we want to return is just a
834 suffix of FILENAME, we don't need to go through and edit
835 things; we just need to construct a new string using data
836 starting at the middle of FILENAME. If we set lose to a
837 non-zero value, that means we've discovered that we can't do
844 /* Since we know the path is absolute, we can assume that each
845 element starts with a "/". */
847 /* "//" anywhere isn't necessarily hairy; we just start afresh
848 with the second slash. */
849 if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
851 /* // at start of filename is meaningful on Apollo system */
855 /* \\ or // at the start of a pathname is meaningful on NT. */
857 #endif /* WINDOWSNT */
861 /* "~" is hairy as the start of any path element. */
862 if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '~')
863 nm
= p
+ 1, lose
= 1;
865 /* "." and ".." are hairy. */
866 if (IS_DIRECTORY_SEP (p
[0])
868 && (IS_DIRECTORY_SEP (p
[2])
870 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
877 /* if dev:[dir]/, move nm to / */
878 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
879 nm
= (brack
? brack
+ 1 : colon
+ 1);
888 /* VMS pre V4.4,convert '-'s in filenames. */
889 if (lbrack
== rbrack
)
891 if (dots
< 2) /* this is to allow negative version numbers */
896 if (lbrack
> rbrack
&&
897 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
898 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
904 /* count open brackets, reset close bracket pointer */
905 if (p
[0] == '[' || p
[0] == '<')
907 /* count close brackets, set close bracket pointer */
908 if (p
[0] == ']' || p
[0] == '>')
910 /* detect ][ or >< */
911 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
913 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
914 nm
= p
+ 1, lose
= 1;
915 if (p
[0] == ':' && (colon
|| slash
))
916 /* if dev1:[dir]dev2:, move nm to dev2: */
922 /* if /pathname/dev:, move nm to dev: */
925 /* if node::dev:, move colon following dev */
926 else if (colon
&& colon
[-1] == ':')
928 /* if dev1:dev2:, move nm to dev2: */
929 else if (colon
&& colon
[-1] != ':')
934 if (p
[0] == ':' && !colon
)
940 if (lbrack
== rbrack
)
943 else if (p
[0] == '.')
952 return build_string (sys_translate_unix (nm
));
955 if (nm
== XSTRING (name
)->data
)
957 return build_string (nm
);
958 #endif /* not DOS_NT */
962 /* Now determine directory to start with and put it in newdir */
966 if (nm
[0] == '~') /* prefix ~ */
968 if (IS_DIRECTORY_SEP (nm
[1])
972 || nm
[1] == 0) /* ~ by itself */
974 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
975 newdir
= (unsigned char *) "";
977 dostounix_filename (newdir
);
981 nm
++; /* Don't leave the slash in nm. */
984 else /* ~user/filename */
986 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
991 o
= (unsigned char *) alloca (p
- nm
+ 1);
992 bcopy ((char *) nm
, o
, p
- nm
);
996 newdir
= (unsigned char *) egetenv ("HOME");
997 dostounix_filename (newdir
);
998 #else /* not WINDOWSNT */
999 pw
= (struct passwd
*) getpwnam (o
+ 1);
1002 newdir
= (unsigned char *) pw
-> pw_dir
;
1004 nm
= p
+ 1; /* skip the terminator */
1009 #endif /* not WINDOWSNT */
1011 /* If we don't find a user of that name, leave the name
1012 unchanged; don't move nm forward to p. */
1016 if (!IS_ANY_SEP (nm
[0])
1019 #endif /* not VMS */
1025 newdir
= XSTRING (defalt
)->data
;
1029 if (newdir
== 0 && relpath
)
1034 /* Get rid of any slash at the end of newdir. */
1035 int length
= strlen (newdir
);
1036 /* Adding `length > 1 &&' makes ~ expand into / when homedir
1037 is the root dir. People disagree about whether that is right.
1038 Anyway, we can't take the risk of this change now. */
1040 if (newdir
[1] != ':' && length
> 1)
1042 if (IS_DIRECTORY_SEP (newdir
[length
- 1]))
1044 unsigned char *temp
= (unsigned char *) alloca (length
);
1045 bcopy (newdir
, temp
, length
- 1);
1046 temp
[length
- 1] = 0;
1054 /* Now concatenate the directory and name to new space in the stack frame */
1055 tlen
+= strlen (nm
) + 1;
1057 /* Add reserved space for drive name. (The Microsoft x86 compiler
1058 produces incorrect code if the following two lines are combined.) */
1059 target
= (unsigned char *) alloca (tlen
+ 2);
1061 #else /* not DOS_NT */
1062 target
= (unsigned char *) alloca (tlen
);
1063 #endif /* not DOS_NT */
1069 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1070 strcpy (target
, newdir
);
1073 file_name_as_directory (target
, newdir
);
1076 strcat (target
, nm
);
1078 if (index (target
, '/'))
1079 strcpy (target
, sys_translate_unix (target
));
1082 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1090 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1096 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1097 /* brackets are offset from each other by 2 */
1100 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1101 /* convert [foo][bar] to [bar] */
1102 while (o
[-1] != '[' && o
[-1] != '<')
1104 else if (*p
== '-' && *o
!= '.')
1107 else if (p
[0] == '-' && o
[-1] == '.' &&
1108 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1109 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1113 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1114 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1116 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1118 /* else [foo.-] ==> [-] */
1124 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1125 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1131 if (!IS_DIRECTORY_SEP (*p
))
1136 else if (!strncmp (p
, "\\\\", 2) || !strncmp (p
, "//", 2))
1137 #else /* not WINDOWSNT */
1138 else if (!strncmp (p
, "//", 2)
1139 #endif /* not WINDOWSNT */
1141 /* // at start of filename is meaningful in Apollo system */
1145 /* \\ at start of filename is meaningful in Windows-NT */
1147 #endif /* WINDOWSNT */
1153 else if (IS_DIRECTORY_SEP (p
[0])
1155 && (IS_DIRECTORY_SEP (p
[2])
1158 /* If "/." is the entire filename, keep the "/". Otherwise,
1159 just delete the whole "/.". */
1160 if (o
== target
&& p
[2] == '\0')
1165 else if (!strncmp (p
, "\\..", 3) || !strncmp (p
, "/..", 3))
1166 #else /* not WINDOWSNT */
1167 else if (!strncmp (p
, "/..", 3)
1168 #endif /* not WINDOWSNT */
1169 /* `/../' is the "superroot" on certain file systems. */
1171 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1173 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1176 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1181 if (o
== target
+ 1 && (o
[-1] == '/' && o
[0] == '/')
1182 || (o
[-1] == '\\' && o
[0] == '\\'))
1185 #endif /* WINDOWSNT */
1186 if (o
== target
&& IS_ANY_SEP (*o
))
1194 #endif /* not VMS */
1198 /* at last, set drive name. */
1199 if (target
[1] != ':'
1201 /* Allow network paths that look like "\\foo" */
1202 && !(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1]))
1203 #endif /* WINDOWSNT */
1207 target
[0] = (drive
< 0 ? getdisk () : drive
) + 'a';
1212 return make_string (target
, o
- target
);
1216 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1217 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1218 "Convert FILENAME to absolute, and canonicalize it.\n\
1219 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1220 (does not start with slash); if DEFAULT is nil or missing,\n\
1221 the current buffer's value of default-directory is used.\n\
1222 Filenames containing `.' or `..' as components are simplified;\n\
1223 initial `~/' expands to your home directory.\n\
1224 See also the function `substitute-in-file-name'.")
1226 Lisp_Object name
, defalt
;
1230 register unsigned char *newdir
, *p
, *o
;
1232 unsigned char *target
;
1236 unsigned char * colon
= 0;
1237 unsigned char * close
= 0;
1238 unsigned char * slash
= 0;
1239 unsigned char * brack
= 0;
1240 int lbrack
= 0, rbrack
= 0;
1244 CHECK_STRING (name
, 0);
1247 /* Filenames on VMS are always upper case. */
1248 name
= Fupcase (name
);
1251 nm
= XSTRING (name
)->data
;
1253 /* If nm is absolute, flush ...// and detect /./ and /../.
1254 If no /./ or /../ we can return right away. */
1266 if (p
[0] == '/' && p
[1] == '/'
1268 /* // at start of filename is meaningful on Apollo system */
1273 if (p
[0] == '/' && p
[1] == '~')
1274 nm
= p
+ 1, lose
= 1;
1275 if (p
[0] == '/' && p
[1] == '.'
1276 && (p
[2] == '/' || p
[2] == 0
1277 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1283 /* if dev:[dir]/, move nm to / */
1284 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1285 nm
= (brack
? brack
+ 1 : colon
+ 1);
1286 lbrack
= rbrack
= 0;
1294 /* VMS pre V4.4,convert '-'s in filenames. */
1295 if (lbrack
== rbrack
)
1297 if (dots
< 2) /* this is to allow negative version numbers */
1302 if (lbrack
> rbrack
&&
1303 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1304 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1310 /* count open brackets, reset close bracket pointer */
1311 if (p
[0] == '[' || p
[0] == '<')
1312 lbrack
++, brack
= 0;
1313 /* count close brackets, set close bracket pointer */
1314 if (p
[0] == ']' || p
[0] == '>')
1315 rbrack
++, brack
= p
;
1316 /* detect ][ or >< */
1317 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1319 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1320 nm
= p
+ 1, lose
= 1;
1321 if (p
[0] == ':' && (colon
|| slash
))
1322 /* if dev1:[dir]dev2:, move nm to dev2: */
1328 /* if /pathname/dev:, move nm to dev: */
1331 /* if node::dev:, move colon following dev */
1332 else if (colon
&& colon
[-1] == ':')
1334 /* if dev1:dev2:, move nm to dev2: */
1335 else if (colon
&& colon
[-1] != ':')
1340 if (p
[0] == ':' && !colon
)
1346 if (lbrack
== rbrack
)
1349 else if (p
[0] == '.')
1357 if (index (nm
, '/'))
1358 return build_string (sys_translate_unix (nm
));
1360 if (nm
== XSTRING (name
)->data
)
1362 return build_string (nm
);
1366 /* Now determine directory to start with and put it in NEWDIR */
1370 if (nm
[0] == '~') /* prefix ~ */
1375 || nm
[1] == 0)/* ~/filename */
1377 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1378 newdir
= (unsigned char *) "";
1381 nm
++; /* Don't leave the slash in nm. */
1384 else /* ~user/filename */
1386 /* Get past ~ to user */
1387 unsigned char *user
= nm
+ 1;
1388 /* Find end of name. */
1389 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1390 int len
= ptr
? ptr
- user
: strlen (user
);
1392 unsigned char *ptr1
= index (user
, ':');
1393 if (ptr1
!= 0 && ptr1
- user
< len
)
1396 /* Copy the user name into temp storage. */
1397 o
= (unsigned char *) alloca (len
+ 1);
1398 bcopy ((char *) user
, o
, len
);
1401 /* Look up the user name. */
1402 pw
= (struct passwd
*) getpwnam (o
+ 1);
1404 error ("\"%s\" isn't a registered user", o
+ 1);
1406 newdir
= (unsigned char *) pw
->pw_dir
;
1408 /* Discard the user name from NM. */
1415 #endif /* not VMS */
1419 defalt
= current_buffer
->directory
;
1420 CHECK_STRING (defalt
, 1);
1421 newdir
= XSTRING (defalt
)->data
;
1424 /* Now concatenate the directory and name to new space in the stack frame */
1426 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1427 target
= (unsigned char *) alloca (tlen
);
1433 if (nm
[0] == 0 || nm
[0] == '/')
1434 strcpy (target
, newdir
);
1437 file_name_as_directory (target
, newdir
);
1440 strcat (target
, nm
);
1442 if (index (target
, '/'))
1443 strcpy (target
, sys_translate_unix (target
));
1446 /* Now canonicalize by removing /. and /foo/.. if they appear */
1454 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1460 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1461 /* brackets are offset from each other by 2 */
1464 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1465 /* convert [foo][bar] to [bar] */
1466 while (o
[-1] != '[' && o
[-1] != '<')
1468 else if (*p
== '-' && *o
!= '.')
1471 else if (p
[0] == '-' && o
[-1] == '.' &&
1472 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1473 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1477 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1478 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1480 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1482 /* else [foo.-] ==> [-] */
1488 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1489 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1499 else if (!strncmp (p
, "//", 2)
1501 /* // at start of filename is meaningful in Apollo system */
1509 else if (p
[0] == '/' && p
[1] == '.' &&
1510 (p
[2] == '/' || p
[2] == 0))
1512 else if (!strncmp (p
, "/..", 3)
1513 /* `/../' is the "superroot" on certain file systems. */
1515 && (p
[3] == '/' || p
[3] == 0))
1517 while (o
!= target
&& *--o
!= '/')
1520 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1524 if (o
== target
&& *o
== '/')
1532 #endif /* not VMS */
1535 return make_string (target
, o
- target
);
1539 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1540 Ssubstitute_in_file_name
, 1, 1, 0,
1541 "Substitute environment variables referred to in FILENAME.\n\
1542 `$FOO' where FOO is an environment variable name means to substitute\n\
1543 the value of that variable. The variable name should be terminated\n\
1544 with a character not a letter, digit or underscore; otherwise, enclose\n\
1545 the entire variable name in braces.\n\
1546 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1547 On VMS, `$' substitution is not done; this function does little and only\n\
1548 duplicates what `expand-file-name' does.")
1554 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1555 unsigned char *target
;
1557 int substituted
= 0;
1559 Lisp_Object handler
;
1561 CHECK_STRING (string
, 0);
1563 /* If the file name has special constructs in it,
1564 call the corresponding file handler. */
1565 handler
= Ffind_file_name_handler (string
, Qsubstitute_in_file_name
);
1566 if (!NILP (handler
))
1567 return call2 (handler
, Qsubstitute_in_file_name
, string
);
1569 nm
= XSTRING (string
)->data
;
1571 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
1572 substituted
= !strcmp (nm
, XSTRING (string
)->data
);
1574 endp
= nm
+ XSTRING (string
)->size
;
1576 /* If /~ or // appears, discard everything through first slash. */
1578 for (p
= nm
; p
!= endp
; p
++)
1582 /* // at start of file name is meaningful in Apollo system */
1583 (p
[0] == '/' && p
- 1 != nm
)
1584 #else /* not APOLLO */
1586 (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1587 #else /* not WINDOWSNT */
1589 #endif /* not WINDOWSNT */
1590 #endif /* not APOLLO */
1595 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1597 || IS_DIRECTORY_SEP (p
[-1])))
1603 if (p
[0] && p
[1] == ':')
1612 return build_string (nm
);
1615 /* See if any variables are substituted into the string
1616 and find the total length of their values in `total' */
1618 for (p
= nm
; p
!= endp
;)
1628 /* "$$" means a single "$" */
1637 while (p
!= endp
&& *p
!= '}') p
++;
1638 if (*p
!= '}') goto missingclose
;
1644 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1648 /* Copy out the variable name */
1649 target
= (unsigned char *) alloca (s
- o
+ 1);
1650 strncpy (target
, o
, s
- o
);
1653 strupr (target
); /* $home == $HOME etc. */
1656 /* Get variable value */
1657 o
= (unsigned char *) egetenv (target
);
1658 if (!o
) goto badvar
;
1659 total
+= strlen (o
);
1666 /* If substitution required, recopy the string and do it */
1667 /* Make space in stack frame for the new copy */
1668 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1671 /* Copy the rest of the name through, replacing $ constructs with values */
1688 while (p
!= endp
&& *p
!= '}') p
++;
1689 if (*p
!= '}') goto missingclose
;
1695 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1699 /* Copy out the variable name */
1700 target
= (unsigned char *) alloca (s
- o
+ 1);
1701 strncpy (target
, o
, s
- o
);
1704 strupr (target
); /* $home == $HOME etc. */
1707 /* Get variable value */
1708 o
= (unsigned char *) egetenv (target
);
1718 /* If /~ or // appears, discard everything through first slash. */
1720 for (p
= xnm
; p
!= x
; p
++)
1723 /* // at start of file name is meaningful in Apollo system */
1724 || (p
[0] == '/' && p
- 1 != xnm
)
1725 #else /* not APOLLO */
1727 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1728 #else /* not WINDOWSNT */
1730 #endif /* not WINDOWSNT */
1731 #endif /* not APOLLO */
1733 && p
!= nm
&& IS_DIRECTORY_SEP (p
[-1]))
1736 else if (p
[0] && p
[1] == ':')
1740 return make_string (xnm
, x
- xnm
);
1743 error ("Bad format environment-variable substitution");
1745 error ("Missing \"}\" in environment-variable substitution");
1747 error ("Substituting nonexistent environment variable \"%s\"", target
);
1750 #endif /* not VMS */
1753 /* A slightly faster and more convenient way to get
1754 (directory-file-name (expand-file-name FOO)). */
1757 expand_and_dir_to_file (filename
, defdir
)
1758 Lisp_Object filename
, defdir
;
1760 register Lisp_Object abspath
;
1762 abspath
= Fexpand_file_name (filename
, defdir
);
1765 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1766 if (c
== ':' || c
== ']' || c
== '>')
1767 abspath
= Fdirectory_file_name (abspath
);
1770 /* Remove final slash, if any (unless path is root).
1771 stat behaves differently depending! */
1772 if (XSTRING (abspath
)->size
> 1
1773 && IS_DIRECTORY_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1])
1774 && !IS_DEVICE_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
-2]))
1775 /* We cannot take shortcuts; they might be wrong for magic file names. */
1776 abspath
= Fdirectory_file_name (abspath
);
1782 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1783 Lisp_Object absname
;
1784 unsigned char *querystring
;
1787 register Lisp_Object tem
;
1788 struct stat statbuf
;
1789 struct gcpro gcpro1
;
1791 /* stat is a good way to tell whether the file exists,
1792 regardless of what access permissions it has. */
1793 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1796 Fsignal (Qfile_already_exists
,
1797 Fcons (build_string ("File already exists"),
1798 Fcons (absname
, Qnil
)));
1800 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1801 XSTRING (absname
)->data
, querystring
));
1804 Fsignal (Qfile_already_exists
,
1805 Fcons (build_string ("File already exists"),
1806 Fcons (absname
, Qnil
)));
1811 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1812 "fCopy file: \nFCopy %s to file: \np\nP",
1813 "Copy FILE to NEWNAME. Both args must be strings.\n\
1814 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1815 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1816 A number as third arg means request confirmation if NEWNAME already exists.\n\
1817 This is what happens in interactive use with M-x.\n\
1818 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1819 last-modified time as the old one. (This works on only some systems.)\n\
1820 A prefix arg makes KEEP-TIME non-nil.")
1821 (filename
, newname
, ok_if_already_exists
, keep_date
)
1822 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1825 char buf
[16 * 1024];
1827 Lisp_Object handler
;
1828 struct gcpro gcpro1
, gcpro2
;
1829 int count
= specpdl_ptr
- specpdl
;
1830 int input_file_statable_p
;
1832 GCPRO2 (filename
, newname
);
1833 CHECK_STRING (filename
, 0);
1834 CHECK_STRING (newname
, 1);
1835 filename
= Fexpand_file_name (filename
, Qnil
);
1836 newname
= Fexpand_file_name (newname
, Qnil
);
1838 /* If the input file name has special constructs in it,
1839 call the corresponding file handler. */
1840 handler
= Ffind_file_name_handler (filename
, Qcopy_file
);
1841 /* Likewise for output file name. */
1843 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1844 if (!NILP (handler
))
1845 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, filename
, newname
,
1846 ok_if_already_exists
, keep_date
));
1848 if (NILP (ok_if_already_exists
)
1849 || INTEGERP (ok_if_already_exists
))
1850 barf_or_query_if_file_exists (newname
, "copy to it",
1851 INTEGERP (ok_if_already_exists
));
1853 ifd
= open (XSTRING (filename
)->data
, O_RDONLY
);
1855 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1857 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1859 /* We can only copy regular files and symbolic links. Other files are not
1861 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1863 #if defined (S_ISREG) && defined (S_ISLNK)
1864 if (input_file_statable_p
)
1866 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1868 #if defined (EISDIR)
1869 /* Get a better looking error message. */
1872 report_file_error ("Non-regular file", Fcons (filename
, Qnil
));
1875 #endif /* S_ISREG && S_ISLNK */
1878 /* Create the copy file with the same record format as the input file */
1879 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1882 /* System's default file type was set to binary by _fmode in emacs.c. */
1883 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1884 #else /* not MSDOS */
1885 ofd
= creat (XSTRING (newname
)->data
, 0666);
1886 #endif /* not MSDOS */
1889 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1891 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1895 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1896 if (write (ofd
, buf
, n
) != n
)
1897 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1900 /* Closing the output clobbers the file times on some systems. */
1901 if (close (ofd
) < 0)
1902 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1904 if (input_file_statable_p
)
1906 if (!NILP (keep_date
))
1908 EMACS_TIME atime
, mtime
;
1909 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1910 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1911 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
1912 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1915 if (!egetenv ("USE_DOMAIN_ACLS"))
1917 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1922 /* Discard the unwind protects. */
1923 specpdl_ptr
= specpdl
+ count
;
1929 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1930 Smake_directory_internal
, 1, 1, 0,
1931 "Create a directory. One argument, a file name string.")
1933 Lisp_Object dirname
;
1936 Lisp_Object handler
;
1938 CHECK_STRING (dirname
, 0);
1939 dirname
= Fexpand_file_name (dirname
, Qnil
);
1941 handler
= Ffind_file_name_handler (dirname
, Qmake_directory_internal
);
1942 if (!NILP (handler
))
1943 return call2 (handler
, Qmake_directory_internal
, dirname
);
1945 dir
= XSTRING (dirname
)->data
;
1948 if (mkdir (dir
) != 0)
1950 if (mkdir (dir
, 0777) != 0)
1952 report_file_error ("Creating directory", Flist (1, &dirname
));
1957 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1958 "Delete a directory. One argument, a file name or directory name string.")
1960 Lisp_Object dirname
;
1963 Lisp_Object handler
;
1965 CHECK_STRING (dirname
, 0);
1966 dirname
= Fdirectory_file_name (Fexpand_file_name (dirname
, Qnil
));
1967 dir
= XSTRING (dirname
)->data
;
1969 handler
= Ffind_file_name_handler (dirname
, Qdelete_directory
);
1970 if (!NILP (handler
))
1971 return call2 (handler
, Qdelete_directory
, dirname
);
1973 if (rmdir (dir
) != 0)
1974 report_file_error ("Removing directory", Flist (1, &dirname
));
1979 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1980 "Delete specified file. One argument, a file name string.\n\
1981 If file has multiple names, it continues to exist with the other names.")
1983 Lisp_Object filename
;
1985 Lisp_Object handler
;
1986 CHECK_STRING (filename
, 0);
1987 filename
= Fexpand_file_name (filename
, Qnil
);
1989 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
1990 if (!NILP (handler
))
1991 return call2 (handler
, Qdelete_file
, filename
);
1993 if (0 > unlink (XSTRING (filename
)->data
))
1994 report_file_error ("Removing old name", Flist (1, &filename
));
1999 internal_delete_file_1 (ignore
)
2005 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2008 internal_delete_file (filename
)
2009 Lisp_Object filename
;
2011 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2012 Qt
, internal_delete_file_1
));
2015 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2016 "fRename file: \nFRename %s to file: \np",
2017 "Rename FILE as NEWNAME. Both args strings.\n\
2018 If file has names other than FILE, it continues to have those names.\n\
2019 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2020 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2021 A number as third arg means request confirmation if NEWNAME already exists.\n\
2022 This is what happens in interactive use with M-x.")
2023 (filename
, newname
, ok_if_already_exists
)
2024 Lisp_Object filename
, newname
, ok_if_already_exists
;
2027 Lisp_Object args
[2];
2029 Lisp_Object handler
;
2030 struct gcpro gcpro1
, gcpro2
;
2032 GCPRO2 (filename
, newname
);
2033 CHECK_STRING (filename
, 0);
2034 CHECK_STRING (newname
, 1);
2035 filename
= Fexpand_file_name (filename
, Qnil
);
2036 newname
= Fexpand_file_name (newname
, Qnil
);
2038 /* If the file name has special constructs in it,
2039 call the corresponding file handler. */
2040 handler
= Ffind_file_name_handler (filename
, Qrename_file
);
2042 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2043 if (!NILP (handler
))
2044 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2045 filename
, newname
, ok_if_already_exists
));
2047 if (NILP (ok_if_already_exists
)
2048 || INTEGERP (ok_if_already_exists
))
2049 barf_or_query_if_file_exists (newname
, "rename to it",
2050 INTEGERP (ok_if_already_exists
));
2052 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2055 if (!MoveFile (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2056 #else /* not WINDOWSNT */
2057 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
2058 || 0 > unlink (XSTRING (filename
)->data
))
2059 #endif /* not WINDOWSNT */
2063 /* Why two? And why doesn't MS document what MoveFile will return? */
2064 if (GetLastError () == ERROR_FILE_EXISTS
2065 || GetLastError () == ERROR_ALREADY_EXISTS
)
2066 #else /* not WINDOWSNT */
2068 #endif /* not WINDOWSNT */
2070 Fcopy_file (filename
, newname
,
2071 /* We have already prompted if it was an integer,
2072 so don't have copy-file prompt again. */
2073 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2074 Fdelete_file (filename
);
2081 report_file_error ("Renaming", Flist (2, args
));
2084 report_file_error ("Renaming", Flist (2, &filename
));
2091 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2092 "fAdd name to file: \nFName to add to %s: \np",
2093 "Give FILE additional name NEWNAME. Both args strings.\n\
2094 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2095 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2096 A number as third arg means request confirmation if NEWNAME already exists.\n\
2097 This is what happens in interactive use with M-x.")
2098 (filename
, newname
, ok_if_already_exists
)
2099 Lisp_Object filename
, newname
, ok_if_already_exists
;
2102 Lisp_Object args
[2];
2104 Lisp_Object handler
;
2105 struct gcpro gcpro1
, gcpro2
;
2107 GCPRO2 (filename
, newname
);
2108 CHECK_STRING (filename
, 0);
2109 CHECK_STRING (newname
, 1);
2110 filename
= Fexpand_file_name (filename
, Qnil
);
2111 newname
= Fexpand_file_name (newname
, Qnil
);
2113 /* If the file name has special constructs in it,
2114 call the corresponding file handler. */
2115 handler
= Ffind_file_name_handler (filename
, Qadd_name_to_file
);
2116 if (!NILP (handler
))
2117 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
2118 newname
, ok_if_already_exists
));
2120 if (NILP (ok_if_already_exists
)
2121 || INTEGERP (ok_if_already_exists
))
2122 barf_or_query_if_file_exists (newname
, "make it a new name",
2123 INTEGERP (ok_if_already_exists
));
2125 /* Windows does not support this operation. */
2126 report_file_error ("Adding new name", Flist (2, &filename
));
2127 #else /* not WINDOWSNT */
2129 unlink (XSTRING (newname
)->data
);
2130 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2135 report_file_error ("Adding new name", Flist (2, args
));
2137 report_file_error ("Adding new name", Flist (2, &filename
));
2140 #endif /* not WINDOWSNT */
2147 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2148 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2149 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2150 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2151 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2152 A number as third arg means request confirmation if LINKNAME already exists.\n\
2153 This happens for interactive use with M-x.")
2154 (filename
, linkname
, ok_if_already_exists
)
2155 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2158 Lisp_Object args
[2];
2160 Lisp_Object handler
;
2161 struct gcpro gcpro1
, gcpro2
;
2163 GCPRO2 (filename
, linkname
);
2164 CHECK_STRING (filename
, 0);
2165 CHECK_STRING (linkname
, 1);
2166 /* If the link target has a ~, we must expand it to get
2167 a truly valid file name. Otherwise, do not expand;
2168 we want to permit links to relative file names. */
2169 if (XSTRING (filename
)->data
[0] == '~')
2170 filename
= Fexpand_file_name (filename
, Qnil
);
2171 linkname
= Fexpand_file_name (linkname
, Qnil
);
2173 /* If the file name has special constructs in it,
2174 call the corresponding file handler. */
2175 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2176 if (!NILP (handler
))
2177 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2178 linkname
, ok_if_already_exists
));
2180 if (NILP (ok_if_already_exists
)
2181 || INTEGERP (ok_if_already_exists
))
2182 barf_or_query_if_file_exists (linkname
, "make it a link",
2183 INTEGERP (ok_if_already_exists
));
2184 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2186 /* If we didn't complain already, silently delete existing file. */
2187 if (errno
== EEXIST
)
2189 unlink (XSTRING (linkname
)->data
);
2190 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2200 report_file_error ("Making symbolic link", Flist (2, args
));
2202 report_file_error ("Making symbolic link", Flist (2, &filename
));
2208 #endif /* S_IFLNK */
2212 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2213 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2214 "Define the job-wide logical name NAME to have the value STRING.\n\
2215 If STRING is nil or a null string, the logical name NAME is deleted.")
2217 Lisp_Object varname
;
2220 CHECK_STRING (varname
, 0);
2222 delete_logical_name (XSTRING (varname
)->data
);
2225 CHECK_STRING (string
, 1);
2227 if (XSTRING (string
)->size
== 0)
2228 delete_logical_name (XSTRING (varname
)->data
);
2230 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2239 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2240 "Open a network connection to PATH using LOGIN as the login string.")
2242 Lisp_Object path
, login
;
2246 CHECK_STRING (path
, 0);
2247 CHECK_STRING (login
, 0);
2249 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2251 if (netresult
== -1)
2256 #endif /* HPUX_NET */
2258 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2260 "Return t if file FILENAME specifies an absolute path name.\n\
2261 On Unix, this is a name starting with a `/' or a `~'.")
2263 Lisp_Object filename
;
2267 CHECK_STRING (filename
, 0);
2268 ptr
= XSTRING (filename
)->data
;
2269 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2271 /* ??? This criterion is probably wrong for '<'. */
2272 || index (ptr
, ':') || index (ptr
, '<')
2273 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2277 || (*ptr
!= 0 && ptr
[1] == ':' && (ptr
[2] == '/' || ptr
[2] == '\\'))
2285 /* Return nonzero if file FILENAME exists and can be executed. */
2288 check_executable (filename
)
2292 return (eaccess (filename
, 1) >= 0);
2294 /* Access isn't quite right because it uses the real uid
2295 and we really want to test with the effective uid.
2296 But Unix doesn't give us a right way to do it. */
2297 return (access (filename
, 1) >= 0);
2301 /* Return nonzero if file FILENAME exists and can be written. */
2304 check_writable (filename
)
2308 return (eaccess (filename
, 2) >= 0);
2310 /* Access isn't quite right because it uses the real uid
2311 and we really want to test with the effective uid.
2312 But Unix doesn't give us a right way to do it.
2313 Opening with O_WRONLY could work for an ordinary file,
2314 but would lose for directories. */
2315 return (access (filename
, 2) >= 0);
2319 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2320 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2321 See also `file-readable-p' and `file-attributes'.")
2323 Lisp_Object filename
;
2325 Lisp_Object abspath
;
2326 Lisp_Object handler
;
2327 struct stat statbuf
;
2329 CHECK_STRING (filename
, 0);
2330 abspath
= Fexpand_file_name (filename
, Qnil
);
2332 /* If the file name has special constructs in it,
2333 call the corresponding file handler. */
2334 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2335 if (!NILP (handler
))
2336 return call2 (handler
, Qfile_exists_p
, abspath
);
2338 return (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2341 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2342 "Return t if FILENAME can be executed by you.\n\
2343 For a directory, this means you can access files in that directory.")
2345 Lisp_Object filename
;
2348 Lisp_Object abspath
;
2349 Lisp_Object handler
;
2351 CHECK_STRING (filename
, 0);
2352 abspath
= Fexpand_file_name (filename
, Qnil
);
2354 /* If the file name has special constructs in it,
2355 call the corresponding file handler. */
2356 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2357 if (!NILP (handler
))
2358 return call2 (handler
, Qfile_executable_p
, abspath
);
2360 return (check_executable (XSTRING (abspath
)->data
) ? Qt
: Qnil
);
2363 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2364 "Return t if file FILENAME exists and you can read it.\n\
2365 See also `file-exists-p' and `file-attributes'.")
2367 Lisp_Object filename
;
2369 Lisp_Object abspath
;
2370 Lisp_Object handler
;
2373 CHECK_STRING (filename
, 0);
2374 abspath
= Fexpand_file_name (filename
, Qnil
);
2376 /* If the file name has special constructs in it,
2377 call the corresponding file handler. */
2378 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2379 if (!NILP (handler
))
2380 return call2 (handler
, Qfile_readable_p
, abspath
);
2382 desc
= open (XSTRING (abspath
)->data
, O_RDONLY
);
2389 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2391 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2392 "Return t if file FILENAME can be written or created by you.")
2394 Lisp_Object filename
;
2396 Lisp_Object abspath
, dir
;
2397 Lisp_Object handler
;
2398 struct stat statbuf
;
2400 CHECK_STRING (filename
, 0);
2401 abspath
= Fexpand_file_name (filename
, Qnil
);
2403 /* If the file name has special constructs in it,
2404 call the corresponding file handler. */
2405 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2406 if (!NILP (handler
))
2407 return call2 (handler
, Qfile_writable_p
, abspath
);
2409 if (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0)
2410 return (check_writable (XSTRING (abspath
)->data
)
2412 dir
= Ffile_name_directory (abspath
);
2415 dir
= Fdirectory_file_name (dir
);
2419 dir
= Fdirectory_file_name (dir
);
2421 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2425 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2426 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2427 The value is the name of the file to which it is linked.\n\
2428 Otherwise returns nil.")
2430 Lisp_Object filename
;
2437 Lisp_Object handler
;
2439 CHECK_STRING (filename
, 0);
2440 filename
= Fexpand_file_name (filename
, Qnil
);
2442 /* If the file name has special constructs in it,
2443 call the corresponding file handler. */
2444 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2445 if (!NILP (handler
))
2446 return call2 (handler
, Qfile_symlink_p
, filename
);
2451 buf
= (char *) xmalloc (bufsize
);
2452 bzero (buf
, bufsize
);
2453 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2454 if (valsize
< bufsize
) break;
2455 /* Buffer was not long enough */
2464 val
= make_string (buf
, valsize
);
2467 #else /* not S_IFLNK */
2469 #endif /* not S_IFLNK */
2472 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2473 "Return t if file FILENAME is the name of a directory as a file.\n\
2474 A directory name spec may be given instead; then the value is t\n\
2475 if the directory so specified exists and really is a directory.")
2477 Lisp_Object filename
;
2479 register Lisp_Object abspath
;
2481 Lisp_Object handler
;
2483 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2485 /* If the file name has special constructs in it,
2486 call the corresponding file handler. */
2487 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2488 if (!NILP (handler
))
2489 return call2 (handler
, Qfile_directory_p
, abspath
);
2491 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2493 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2496 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2497 "Return t if file FILENAME is the name of a directory as a file,\n\
2498 and files in that directory can be opened by you. In order to use a\n\
2499 directory as a buffer's current directory, this predicate must return true.\n\
2500 A directory name spec may be given instead; then the value is t\n\
2501 if the directory so specified exists and really is a readable and\n\
2502 searchable directory.")
2504 Lisp_Object filename
;
2506 Lisp_Object handler
;
2508 struct gcpro gcpro1
;
2510 /* If the file name has special constructs in it,
2511 call the corresponding file handler. */
2512 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2513 if (!NILP (handler
))
2514 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2516 /* It's an unlikely combination, but yes we really do need to gcpro:
2517 Suppose that file-accessible-directory-p has no handler, but
2518 file-directory-p does have a handler; this handler causes a GC which
2519 relocates the string in `filename'; and finally file-directory-p
2520 returns non-nil. Then we would end up passing a garbaged string
2521 to file-executable-p. */
2523 tem
= (NILP (Ffile_directory_p (filename
))
2524 || NILP (Ffile_executable_p (filename
)));
2526 return tem
? Qnil
: Qt
;
2529 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2530 "Return t if file FILENAME is the name of a regular file.\n\
2531 This is the sort of file that holds an ordinary stream of data bytes.")
2533 Lisp_Object filename
;
2535 register Lisp_Object abspath
;
2537 Lisp_Object handler
;
2539 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2541 /* If the file name has special constructs in it,
2542 call the corresponding file handler. */
2543 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2544 if (!NILP (handler
))
2545 return call2 (handler
, Qfile_directory_p
, abspath
);
2547 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2549 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2552 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2553 "Return mode bits of FILE, as an integer.")
2555 Lisp_Object filename
;
2557 Lisp_Object abspath
;
2559 Lisp_Object handler
;
2561 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2563 /* If the file name has special constructs in it,
2564 call the corresponding file handler. */
2565 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2566 if (!NILP (handler
))
2567 return call2 (handler
, Qfile_modes
, abspath
);
2569 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2575 if (S_ISREG (st
.st_mode
)
2576 && (len
= XSTRING (abspath
)->size
) >= 5
2577 && (stricmp ((suffix
= XSTRING (abspath
)->data
+ len
-4), ".com") == 0
2578 || stricmp (suffix
, ".exe") == 0
2579 || stricmp (suffix
, ".bat") == 0))
2580 st
.st_mode
|= S_IEXEC
;
2584 return make_number (st
.st_mode
& 07777);
2587 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2588 "Set mode bits of FILE to MODE (an integer).\n\
2589 Only the 12 low bits of MODE are used.")
2591 Lisp_Object filename
, mode
;
2593 Lisp_Object abspath
;
2594 Lisp_Object handler
;
2596 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2597 CHECK_NUMBER (mode
, 1);
2599 /* If the file name has special constructs in it,
2600 call the corresponding file handler. */
2601 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2602 if (!NILP (handler
))
2603 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2606 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2607 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2609 if (!egetenv ("USE_DOMAIN_ACLS"))
2612 struct timeval tvp
[2];
2614 /* chmod on apollo also change the file's modtime; need to save the
2615 modtime and then restore it. */
2616 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2618 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2622 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2623 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2625 /* reset the old accessed and modified times. */
2626 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2628 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2631 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2632 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2639 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2640 "Set the file permission bits for newly created files.\n\
2641 The argument MODE should be an integer; only the low 9 bits are used.\n\
2642 This setting is inherited by subprocesses.")
2646 CHECK_NUMBER (mode
, 0);
2648 umask ((~ XINT (mode
)) & 0777);
2653 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2654 "Return the default file protection for created files.\n\
2655 The value is an integer.")
2661 realmask
= umask (0);
2664 XSETINT (value
, (~ realmask
) & 0777);
2670 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2671 "Tell Unix to finish all pending disk updates.")
2680 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2681 "Return t if file FILE1 is newer than file FILE2.\n\
2682 If FILE1 does not exist, the answer is nil;\n\
2683 otherwise, if FILE2 does not exist, the answer is t.")
2685 Lisp_Object file1
, file2
;
2687 Lisp_Object abspath1
, abspath2
;
2690 Lisp_Object handler
;
2691 struct gcpro gcpro1
, gcpro2
;
2693 CHECK_STRING (file1
, 0);
2694 CHECK_STRING (file2
, 0);
2697 GCPRO2 (abspath1
, file2
);
2698 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2699 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2702 /* If the file name has special constructs in it,
2703 call the corresponding file handler. */
2704 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2706 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2707 if (!NILP (handler
))
2708 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2710 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2713 mtime1
= st
.st_mtime
;
2715 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2718 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2722 Lisp_Object Qfind_buffer_file_type
;
2725 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2727 "Insert contents of file FILENAME after point.\n\
2728 Returns list of absolute file name and length of data inserted.\n\
2729 If second argument VISIT is non-nil, the buffer's visited filename\n\
2730 and last save file modtime are set, and it is marked unmodified.\n\
2731 If visiting and the file does not exist, visiting is completed\n\
2732 before the error is signaled.\n\n\
2733 The optional third and fourth arguments BEG and END\n\
2734 specify what portion of the file to insert.\n\
2735 If VISIT is non-nil, BEG and END must be nil.\n\
2736 If optional fifth argument REPLACE is non-nil,\n\
2737 it means replace the current buffer contents (in the accessible portion)\n\
2738 with the file contents. This is better than simply deleting and inserting\n\
2739 the whole thing because (1) it preserves some marker positions\n\
2740 and (2) it puts less data in the undo list.")
2741 (filename
, visit
, beg
, end
, replace
)
2742 Lisp_Object filename
, visit
, beg
, end
, replace
;
2746 register int inserted
= 0;
2747 register int how_much
;
2748 int count
= specpdl_ptr
- specpdl
;
2749 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2750 Lisp_Object handler
, val
, insval
;
2753 int not_regular
= 0;
2755 if (current_buffer
->base_buffer
&& ! NILP (visit
))
2756 error ("Cannot do file visiting in an indirect buffer");
2758 if (!NILP (current_buffer
->read_only
))
2759 Fbarf_if_buffer_read_only ();
2764 GCPRO3 (filename
, val
, p
);
2766 CHECK_STRING (filename
, 0);
2767 filename
= Fexpand_file_name (filename
, Qnil
);
2769 /* If the file name has special constructs in it,
2770 call the corresponding file handler. */
2771 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2772 if (!NILP (handler
))
2774 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2775 visit
, beg
, end
, replace
);
2782 if (stat (XSTRING (filename
)->data
, &st
) < 0)
2784 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
2785 || fstat (fd
, &st
) < 0)
2786 #endif /* not APOLLO */
2788 if (fd
>= 0) close (fd
);
2791 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2798 /* This code will need to be changed in order to work on named
2799 pipes, and it's probably just not worth it. So we should at
2800 least signal an error. */
2801 if (!S_ISREG (st
.st_mode
))
2804 Fsignal (Qfile_error
,
2805 Fcons (build_string ("not a regular file"),
2806 Fcons (filename
, Qnil
)));
2814 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
2817 /* Replacement should preserve point as it preserves markers. */
2818 if (!NILP (replace
))
2819 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2821 record_unwind_protect (close_file_unwind
, make_number (fd
));
2823 /* Supposedly happens on VMS. */
2825 error ("File size is negative");
2827 if (!NILP (beg
) || !NILP (end
))
2829 error ("Attempt to visit less than an entire file");
2832 CHECK_NUMBER (beg
, 0);
2834 XSETFASTINT (beg
, 0);
2837 CHECK_NUMBER (end
, 0);
2840 XSETINT (end
, st
.st_size
);
2841 if (XINT (end
) != st
.st_size
)
2842 error ("maximum buffer size exceeded");
2845 /* If requested, replace the accessible part of the buffer
2846 with the file contents. Avoid replacing text at the
2847 beginning or end of the buffer that matches the file contents;
2848 that preserves markers pointing to the unchanged parts. */
2850 /* On MSDOS, replace mode doesn't really work, except for binary files,
2851 and it's not worth supporting just for them. */
2852 if (!NILP (replace
))
2855 XSETFASTINT (beg
, 0);
2856 XSETFASTINT (end
, st
.st_size
);
2857 del_range_1 (BEGV
, ZV
, 0);
2859 #else /* not DOS_NT */
2860 if (!NILP (replace
))
2862 unsigned char buffer
[1 << 14];
2863 int same_at_start
= BEGV
;
2864 int same_at_end
= ZV
;
2869 /* Count how many chars at the start of the file
2870 match the text at the beginning of the buffer. */
2875 nread
= read (fd
, buffer
, sizeof buffer
);
2877 error ("IO error reading %s: %s",
2878 XSTRING (filename
)->data
, strerror (errno
));
2879 else if (nread
== 0)
2882 while (bufpos
< nread
&& same_at_start
< ZV
2883 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2884 same_at_start
++, bufpos
++;
2885 /* If we found a discrepancy, stop the scan.
2886 Otherwise loop around and scan the next bufferfull. */
2887 if (bufpos
!= nread
)
2891 /* If the file matches the buffer completely,
2892 there's no need to replace anything. */
2893 if (same_at_start
- BEGV
== st
.st_size
)
2897 /* Truncate the buffer to the size of the file. */
2898 del_range_1 (same_at_start
, same_at_end
, 0);
2903 /* Count how many chars at the end of the file
2904 match the text at the end of the buffer. */
2907 int total_read
, nread
, bufpos
, curpos
, trial
;
2909 /* At what file position are we now scanning? */
2910 curpos
= st
.st_size
- (ZV
- same_at_end
);
2911 /* If the entire file matches the buffer tail, stop the scan. */
2914 /* How much can we scan in the next step? */
2915 trial
= min (curpos
, sizeof buffer
);
2916 if (lseek (fd
, curpos
- trial
, 0) < 0)
2917 report_file_error ("Setting file position",
2918 Fcons (filename
, Qnil
));
2921 while (total_read
< trial
)
2923 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2925 error ("IO error reading %s: %s",
2926 XSTRING (filename
)->data
, strerror (errno
));
2927 total_read
+= nread
;
2929 /* Scan this bufferfull from the end, comparing with
2930 the Emacs buffer. */
2931 bufpos
= total_read
;
2932 /* Compare with same_at_start to avoid counting some buffer text
2933 as matching both at the file's beginning and at the end. */
2934 while (bufpos
> 0 && same_at_end
> same_at_start
2935 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2936 same_at_end
--, bufpos
--;
2937 /* If we found a discrepancy, stop the scan.
2938 Otherwise loop around and scan the preceding bufferfull. */
2944 /* Don't try to reuse the same piece of text twice. */
2945 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2947 same_at_end
+= overlap
;
2949 /* Arrange to read only the nonmatching middle part of the file. */
2950 XSETFASTINT (beg
, same_at_start
- BEGV
);
2951 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
2953 del_range_1 (same_at_start
, same_at_end
, 0);
2954 /* Insert from the file at the proper position. */
2955 SET_PT (same_at_start
);
2957 #endif /* not DOS_NT */
2959 total
= XINT (end
) - XINT (beg
);
2962 register Lisp_Object temp
;
2964 /* Make sure point-max won't overflow after this insertion. */
2965 XSETINT (temp
, total
);
2966 if (total
!= XINT (temp
))
2967 error ("maximum buffer size exceeded");
2970 if (NILP (visit
) && total
> 0)
2971 prepare_to_modify_buffer (point
, point
);
2974 if (GAP_SIZE
< total
)
2975 make_gap (total
- GAP_SIZE
);
2977 if (XINT (beg
) != 0 || !NILP (replace
))
2979 if (lseek (fd
, XINT (beg
), 0) < 0)
2980 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2984 while (inserted
< total
)
2986 /* try is reserved in some compilers (Microsoft C) */
2987 int trytry
= min (total
- inserted
, 64 << 10);
2990 /* Allow quitting out of the actual I/O. */
2993 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, trytry
);
3010 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3011 /* Determine file type from name and remove LFs from CR-LFs if the file
3012 is deemed to be a text file. */
3014 current_buffer
->buffer_file_type
3015 = call1 (Qfind_buffer_file_type
, filename
);
3016 if (NILP (current_buffer
->buffer_file_type
))
3019 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
3022 GPT
-= reduced_size
;
3023 GAP_SIZE
+= reduced_size
;
3024 inserted
-= reduced_size
;
3031 record_insert (point
, inserted
);
3033 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3034 offset_intervals (current_buffer
, point
, inserted
);
3040 /* Discard the unwind protect for closing the file. */
3044 error ("IO error reading %s: %s",
3045 XSTRING (filename
)->data
, strerror (errno
));
3052 if (!EQ (current_buffer
->undo_list
, Qt
))
3053 current_buffer
->undo_list
= Qnil
;
3055 stat (XSTRING (filename
)->data
, &st
);
3060 current_buffer
->modtime
= st
.st_mtime
;
3061 current_buffer
->filename
= filename
;
3064 SAVE_MODIFF
= MODIFF
;
3065 current_buffer
->auto_save_modified
= MODIFF
;
3066 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3067 #ifdef CLASH_DETECTION
3070 if (!NILP (current_buffer
->filename
))
3071 unlock_file (current_buffer
->filename
);
3072 unlock_file (filename
);
3074 #endif /* CLASH_DETECTION */
3076 Fsignal (Qfile_error
,
3077 Fcons (build_string ("not a regular file"),
3078 Fcons (filename
, Qnil
)));
3080 /* If visiting nonexistent file, return nil. */
3081 if (current_buffer
->modtime
== -1)
3082 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3085 if (inserted
> 0 && NILP (visit
) && total
> 0)
3086 signal_after_change (point
, 0, inserted
);
3090 p
= Vafter_insert_file_functions
;
3093 insval
= call1 (Fcar (p
), make_number (inserted
));
3096 CHECK_NUMBER (insval
, 0);
3097 inserted
= XFASTINT (insval
);
3105 val
= Fcons (filename
,
3106 Fcons (make_number (inserted
),
3109 RETURN_UNGCPRO (unbind_to (count
, val
));
3112 static Lisp_Object
build_annotations ();
3114 /* If build_annotations switched buffers, switch back to BUF.
3115 Kill the temporary buffer that was selected in the meantime. */
3118 build_annotations_unwind (buf
)
3123 if (XBUFFER (buf
) == current_buffer
)
3125 tembuf
= Fcurrent_buffer ();
3127 Fkill_buffer (tembuf
);
3131 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
3132 "r\nFWrite region to file: ",
3133 "Write current region into specified file.\n\
3134 When called from a program, takes three arguments:\n\
3135 START, END and FILENAME. START and END are buffer positions.\n\
3136 Optional fourth argument APPEND if non-nil means\n\
3137 append to existing file contents (if any).\n\
3138 Optional fifth argument VISIT if t means\n\
3139 set the last-save-file-modtime of buffer to this file's modtime\n\
3140 and mark buffer not modified.\n\
3141 If VISIT is a string, it is a second file name;\n\
3142 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3143 VISIT is also the file name to lock and unlock for clash detection.\n\
3144 If VISIT is neither t nor nil nor a string,\n\
3145 that means do not print the \"Wrote file\" message.\n\
3146 Kludgy feature: if START is a string, then that string is written\n\
3147 to the file, instead of any buffer contents, and END is ignored.")
3148 (start
, end
, filename
, append
, visit
)
3149 Lisp_Object start
, end
, filename
, append
, visit
;
3157 int count
= specpdl_ptr
- specpdl
;
3160 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3162 Lisp_Object handler
;
3163 Lisp_Object visit_file
;
3164 Lisp_Object annotations
;
3165 int visiting
, quietly
;
3166 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3167 struct buffer
*given_buffer
;
3169 int buffer_file_type
3170 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3173 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3174 error ("Cannot do file visiting in an indirect buffer");
3176 if (!NILP (start
) && !STRINGP (start
))
3177 validate_region (&start
, &end
);
3179 GCPRO2 (filename
, visit
);
3180 filename
= Fexpand_file_name (filename
, Qnil
);
3181 if (STRINGP (visit
))
3182 visit_file
= Fexpand_file_name (visit
, Qnil
);
3184 visit_file
= filename
;
3187 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3188 quietly
= !NILP (visit
);
3192 GCPRO4 (start
, filename
, annotations
, visit_file
);
3194 /* If the file name has special constructs in it,
3195 call the corresponding file handler. */
3196 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3197 /* If FILENAME has no handler, see if VISIT has one. */
3198 if (NILP (handler
) && STRINGP (visit
))
3199 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3201 if (!NILP (handler
))
3204 val
= call6 (handler
, Qwrite_region
, start
, end
,
3205 filename
, append
, visit
);
3209 SAVE_MODIFF
= MODIFF
;
3210 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3211 current_buffer
->filename
= visit_file
;
3217 /* Special kludge to simplify auto-saving. */
3220 XSETFASTINT (start
, BEG
);
3221 XSETFASTINT (end
, Z
);
3224 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3225 count1
= specpdl_ptr
- specpdl
;
3227 given_buffer
= current_buffer
;
3228 annotations
= build_annotations (start
, end
);
3229 if (current_buffer
!= given_buffer
)
3235 #ifdef CLASH_DETECTION
3237 lock_file (visit_file
);
3238 #endif /* CLASH_DETECTION */
3240 fn
= XSTRING (filename
)->data
;
3244 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3245 #else /* not DOS_NT */
3246 desc
= open (fn
, O_WRONLY
);
3247 #endif /* not DOS_NT */
3251 if (auto_saving
) /* Overwrite any previous version of autosave file */
3253 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3254 desc
= open (fn
, O_RDWR
);
3256 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3257 ? XSTRING (current_buffer
->filename
)->data
: 0,
3260 else /* Write to temporary name and rename if no errors */
3262 Lisp_Object temp_name
;
3263 temp_name
= Ffile_name_directory (filename
);
3265 if (!NILP (temp_name
))
3267 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3268 build_string ("$$SAVE$$")));
3269 fname
= XSTRING (filename
)->data
;
3270 fn
= XSTRING (temp_name
)->data
;
3271 desc
= creat_copy_attrs (fname
, fn
);
3274 /* If we can't open the temporary file, try creating a new
3275 version of the original file. VMS "creat" creates a
3276 new version rather than truncating an existing file. */
3279 desc
= creat (fn
, 0666);
3280 #if 0 /* This can clobber an existing file and fail to replace it,
3281 if the user runs out of space. */
3284 /* We can't make a new version;
3285 try to truncate and rewrite existing version if any. */
3287 desc
= open (fn
, O_RDWR
);
3293 desc
= creat (fn
, 0666);
3298 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3299 S_IREAD
| S_IWRITE
);
3300 #else /* not DOS_NT */
3301 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3302 #endif /* not DOS_NT */
3303 #endif /* not VMS */
3309 #ifdef CLASH_DETECTION
3311 if (!auto_saving
) unlock_file (visit_file
);
3313 #endif /* CLASH_DETECTION */
3314 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3317 record_unwind_protect (close_file_unwind
, make_number (desc
));
3320 if (lseek (desc
, 0, 2) < 0)
3322 #ifdef CLASH_DETECTION
3323 if (!auto_saving
) unlock_file (visit_file
);
3324 #endif /* CLASH_DETECTION */
3325 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3330 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3331 * if we do writes that don't end with a carriage return. Furthermore
3332 * it cannot handle writes of more then 16K. The modified
3333 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3334 * this EXCEPT for the last record (iff it doesn't end with a carriage
3335 * return). This implies that if your buffer doesn't end with a carriage
3336 * return, you get one free... tough. However it also means that if
3337 * we make two calls to sys_write (a la the following code) you can
3338 * get one at the gap as well. The easiest way to fix this (honest)
3339 * is to move the gap to the next newline (or the end of the buffer).
3344 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3345 move_gap (find_next_newline (GPT
, 1));
3351 if (STRINGP (start
))
3353 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3354 XSTRING (start
)->size
, 0, &annotations
);
3357 else if (XINT (start
) != XINT (end
))
3360 if (XINT (start
) < GPT
)
3362 register int end1
= XINT (end
);
3364 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3365 min (GPT
, end1
) - tem
, tem
, &annotations
);
3366 nwritten
+= min (GPT
, end1
) - tem
;
3370 if (XINT (end
) > GPT
&& !failure
)
3373 tem
= max (tem
, GPT
);
3374 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3376 nwritten
+= XINT (end
) - tem
;
3382 /* If file was empty, still need to write the annotations */
3383 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3391 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3392 Disk full in NFS may be reported here. */
3393 /* mib says that closing the file will try to write as fast as NFS can do
3394 it, and that means the fsync here is not crucial for autosave files. */
3395 if (!auto_saving
&& fsync (desc
) < 0)
3396 failure
= 1, save_errno
= errno
;
3399 /* Spurious "file has changed on disk" warnings have been
3400 observed on Suns as well.
3401 It seems that `close' can change the modtime, under nfs.
3403 (This has supposedly been fixed in Sunos 4,
3404 but who knows about all the other machines with NFS?) */
3407 /* On VMS and APOLLO, must do the stat after the close
3408 since closing changes the modtime. */
3411 /* Recall that #if defined does not work on VMS. */
3418 /* NFS can report a write failure now. */
3419 if (close (desc
) < 0)
3420 failure
= 1, save_errno
= errno
;
3423 /* If we wrote to a temporary name and had no errors, rename to real name. */
3427 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3435 /* Discard the unwind protect for close_file_unwind. */
3436 specpdl_ptr
= specpdl
+ count1
;
3437 /* Restore the original current buffer. */
3438 visit_file
= unbind_to (count
, visit_file
);
3440 #ifdef CLASH_DETECTION
3442 unlock_file (visit_file
);
3443 #endif /* CLASH_DETECTION */
3445 /* Do this before reporting IO error
3446 to avoid a "file has changed on disk" warning on
3447 next attempt to save. */
3449 current_buffer
->modtime
= st
.st_mtime
;
3452 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3456 SAVE_MODIFF
= MODIFF
;
3457 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3458 current_buffer
->filename
= visit_file
;
3459 update_mode_lines
++;
3465 message ("Wrote %s", XSTRING (visit_file
)->data
);
3470 Lisp_Object
merge ();
3472 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3473 "Return t if (car A) is numerically less than (car B).")
3477 return Flss (Fcar (a
), Fcar (b
));
3480 /* Build the complete list of annotations appropriate for writing out
3481 the text between START and END, by calling all the functions in
3482 write-region-annotate-functions and merging the lists they return.
3483 If one of these functions switches to a different buffer, we assume
3484 that buffer contains altered text. Therefore, the caller must
3485 make sure to restore the current buffer in all cases,
3486 as save-excursion would do. */
3489 build_annotations (start
, end
)
3490 Lisp_Object start
, end
;
3492 Lisp_Object annotations
;
3494 struct gcpro gcpro1
, gcpro2
;
3497 p
= Vwrite_region_annotate_functions
;
3498 GCPRO2 (annotations
, p
);
3501 struct buffer
*given_buffer
= current_buffer
;
3502 Vwrite_region_annotations_so_far
= annotations
;
3503 res
= call2 (Fcar (p
), start
, end
);
3504 /* If the function makes a different buffer current,
3505 assume that means this buffer contains altered text to be output.
3506 Reset START and END from the buffer bounds
3507 and discard all previous annotations because they should have
3508 been dealt with by this function. */
3509 if (current_buffer
!= given_buffer
)
3515 Flength (res
); /* Check basic validity of return value */
3516 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3523 /* Write to descriptor DESC the LEN characters starting at ADDR,
3524 assuming they start at position POS in the buffer.
3525 Intersperse with them the annotations from *ANNOT
3526 (those which fall within the range of positions POS to POS + LEN),
3527 each at its appropriate position.
3529 Modify *ANNOT by discarding elements as we output them.
3530 The return value is negative in case of system call failure. */
3533 a_write (desc
, addr
, len
, pos
, annot
)
3535 register char *addr
;
3542 int lastpos
= pos
+ len
;
3544 while (NILP (*annot
) || CONSP (*annot
))
3546 tem
= Fcar_safe (Fcar (*annot
));
3547 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3548 nextpos
= XFASTINT (tem
);
3550 return e_write (desc
, addr
, lastpos
- pos
);
3553 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3555 addr
+= nextpos
- pos
;
3558 tem
= Fcdr (Fcar (*annot
));
3561 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3564 *annot
= Fcdr (*annot
);
3569 e_write (desc
, addr
, len
)
3571 register char *addr
;
3574 char buf
[16 * 1024];
3575 register char *p
, *end
;
3577 if (!EQ (current_buffer
->selective_display
, Qt
))
3578 return write (desc
, addr
, len
) - len
;
3582 end
= p
+ sizeof buf
;
3587 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3596 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3602 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3603 Sverify_visited_file_modtime
, 1, 1, 0,
3604 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3605 This means that the file has not been changed since it was visited or saved.")
3611 Lisp_Object handler
;
3613 CHECK_BUFFER (buf
, 0);
3616 if (!STRINGP (b
->filename
)) return Qt
;
3617 if (b
->modtime
== 0) return Qt
;
3619 /* If the file name has special constructs in it,
3620 call the corresponding file handler. */
3621 handler
= Ffind_file_name_handler (b
->filename
,
3622 Qverify_visited_file_modtime
);
3623 if (!NILP (handler
))
3624 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3626 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3628 /* If the file doesn't exist now and didn't exist before,
3629 we say that it isn't modified, provided the error is a tame one. */
3630 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3635 if (st
.st_mtime
== b
->modtime
3636 /* If both are positive, accept them if they are off by one second. */
3637 || (st
.st_mtime
> 0 && b
->modtime
> 0
3638 && (st
.st_mtime
== b
->modtime
+ 1
3639 || st
.st_mtime
== b
->modtime
- 1)))
3644 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3645 Sclear_visited_file_modtime
, 0, 0, 0,
3646 "Clear out records of last mod time of visited file.\n\
3647 Next attempt to save will certainly not complain of a discrepancy.")
3650 current_buffer
->modtime
= 0;
3654 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3655 Svisited_file_modtime
, 0, 0, 0,
3656 "Return the current buffer's recorded visited file modification time.\n\
3657 The value is a list of the form (HIGH . LOW), like the time values\n\
3658 that `file-attributes' returns.")
3661 return long_to_cons (current_buffer
->modtime
);
3664 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3665 Sset_visited_file_modtime
, 0, 1, 0,
3666 "Update buffer's recorded modification time from the visited file's time.\n\
3667 Useful if the buffer was not read from the file normally\n\
3668 or if the file itself has been changed for some known benign reason.\n\
3669 An argument specifies the modification time value to use\n\
3670 \(instead of that of the visited file), in the form of a list\n\
3671 \(HIGH . LOW) or (HIGH LOW).")
3673 Lisp_Object time_list
;
3675 if (!NILP (time_list
))
3676 current_buffer
->modtime
= cons_to_long (time_list
);
3679 register Lisp_Object filename
;
3681 Lisp_Object handler
;
3683 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3685 /* If the file name has special constructs in it,
3686 call the corresponding file handler. */
3687 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3688 if (!NILP (handler
))
3689 /* The handler can find the file name the same way we did. */
3690 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3691 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3692 current_buffer
->modtime
= st
.st_mtime
;
3702 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3703 Fsleep_for (make_number (1), Qnil
);
3704 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3705 Fsleep_for (make_number (1), Qnil
);
3706 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3707 Fsleep_for (make_number (1), Qnil
);
3717 /* Get visited file's mode to become the auto save file's mode. */
3718 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3719 /* But make sure we can overwrite it later! */
3720 auto_save_mode_bits
= st
.st_mode
| 0600;
3722 auto_save_mode_bits
= 0666;
3725 Fwrite_region (Qnil
, Qnil
,
3726 current_buffer
->auto_save_file_name
,
3731 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3734 close (XINT (desc
));
3738 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3739 "Auto-save all buffers that need it.\n\
3740 This is all buffers that have auto-saving enabled\n\
3741 and are changed since last auto-saved.\n\
3742 Auto-saving writes the buffer into a file\n\
3743 so that your editing is not lost if the system crashes.\n\
3744 This file is not the file you visited; that changes only when you save.\n\
3745 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3746 Non-nil first argument means do not print any message if successful.\n\
3747 Non-nil second argument means save only current buffer.")
3748 (no_message
, current_only
)
3749 Lisp_Object no_message
, current_only
;
3751 struct buffer
*old
= current_buffer
, *b
;
3752 Lisp_Object tail
, buf
;
3754 char *omessage
= echo_area_glyphs
;
3755 int omessage_length
= echo_area_glyphs_length
;
3756 extern int minibuf_level
;
3757 int do_handled_files
;
3760 int count
= specpdl_ptr
- specpdl
;
3763 /* Ordinarily don't quit within this function,
3764 but don't make it impossible to quit (in case we get hung in I/O). */
3768 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3769 point to non-strings reached from Vbuffer_alist. */
3775 if (!NILP (Vrun_hooks
))
3776 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3778 if (STRINGP (Vauto_save_list_file_name
))
3781 listdesc
= open (XSTRING (Vauto_save_list_file_name
)->data
,
3782 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3783 S_IREAD
| S_IWRITE
);
3784 #else /* not DOS_NT */
3785 listdesc
= creat (XSTRING (Vauto_save_list_file_name
)->data
, 0666);
3786 #endif /* not DOS_NT */
3791 /* Arrange to close that file whether or not we get an error. */
3793 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3795 /* First, save all files which don't have handlers. If Emacs is
3796 crashing, the handlers may tweak what is causing Emacs to crash
3797 in the first place, and it would be a shame if Emacs failed to
3798 autosave perfectly ordinary files because it couldn't handle some
3800 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3801 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
3803 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3806 /* Record all the buffers that have auto save mode
3807 in the special file that lists them. */
3808 if (STRINGP (b
->auto_save_file_name
)
3809 && listdesc
>= 0 && do_handled_files
== 0)
3811 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3812 XSTRING (b
->auto_save_file_name
)->size
);
3813 write (listdesc
, "\n", 1);
3816 if (!NILP (current_only
)
3817 && b
!= current_buffer
)
3820 /* Don't auto-save indirect buffers.
3821 The base buffer takes care of it. */
3825 /* Check for auto save enabled
3826 and file changed since last auto save
3827 and file changed since last real save. */
3828 if (STRINGP (b
->auto_save_file_name
)
3829 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
3830 && b
->auto_save_modified
< BUF_MODIFF (b
)
3831 /* -1 means we've turned off autosaving for a while--see below. */
3832 && XINT (b
->save_length
) >= 0
3833 && (do_handled_files
3834 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3837 EMACS_TIME before_time
, after_time
;
3839 EMACS_GET_TIME (before_time
);
3841 /* If we had a failure, don't try again for 20 minutes. */
3842 if (b
->auto_save_failure_time
>= 0
3843 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3846 if ((XFASTINT (b
->save_length
) * 10
3847 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3848 /* A short file is likely to change a large fraction;
3849 spare the user annoying messages. */
3850 && XFASTINT (b
->save_length
) > 5000
3851 /* These messages are frequent and annoying for `*mail*'. */
3852 && !EQ (b
->filename
, Qnil
)
3853 && NILP (no_message
))
3855 /* It has shrunk too much; turn off auto-saving here. */
3856 message ("Buffer %s has shrunk a lot; auto save turned off there",
3857 XSTRING (b
->name
)->data
);
3858 /* Turn off auto-saving until there's a real save,
3859 and prevent any more warnings. */
3860 XSETINT (b
->save_length
, -1);
3861 Fsleep_for (make_number (1), Qnil
);
3864 set_buffer_internal (b
);
3865 if (!auto_saved
&& NILP (no_message
))
3866 message1 ("Auto-saving...");
3867 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3869 b
->auto_save_modified
= BUF_MODIFF (b
);
3870 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3871 set_buffer_internal (old
);
3873 EMACS_GET_TIME (after_time
);
3875 /* If auto-save took more than 60 seconds,
3876 assume it was an NFS failure that got a timeout. */
3877 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3878 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3882 /* Prevent another auto save till enough input events come in. */
3883 record_auto_save ();
3885 if (auto_saved
&& NILP (no_message
))
3888 message2 (omessage
, omessage_length
);
3890 message1 ("Auto-saving...done");
3896 unbind_to (count
, Qnil
);
3900 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3901 Sset_buffer_auto_saved
, 0, 0, 0,
3902 "Mark current buffer as auto-saved with its current text.\n\
3903 No auto-save file will be written until the buffer changes again.")
3906 current_buffer
->auto_save_modified
= MODIFF
;
3907 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3908 current_buffer
->auto_save_failure_time
= -1;
3912 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3913 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3914 "Clear any record of a recent auto-save failure in the current buffer.")
3917 current_buffer
->auto_save_failure_time
= -1;
3921 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3923 "Return t if buffer has been auto-saved since last read in or saved.")
3926 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3929 /* Reading and completing file names */
3930 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3932 /* In the string VAL, change each $ to $$ and return the result. */
3935 double_dollars (val
)
3938 register unsigned char *old
, *new;
3942 osize
= XSTRING (val
)->size
;
3943 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3944 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3945 if (*old
++ == '$') count
++;
3948 old
= XSTRING (val
)->data
;
3949 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3950 new = XSTRING (val
)->data
;
3951 for (n
= osize
; n
> 0; n
--)
3964 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3966 "Internal subroutine for read-file-name. Do not call this.")
3967 (string
, dir
, action
)
3968 Lisp_Object string
, dir
, action
;
3969 /* action is nil for complete, t for return list of completions,
3970 lambda for verify final value */
3972 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3974 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3981 /* No need to protect ACTION--we only compare it with t and nil. */
3982 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
3984 if (XSTRING (string
)->size
== 0)
3986 if (EQ (action
, Qlambda
))
3994 orig_string
= string
;
3995 string
= Fsubstitute_in_file_name (string
);
3996 changed
= NILP (Fstring_equal (string
, orig_string
));
3997 name
= Ffile_name_nondirectory (string
);
3998 val
= Ffile_name_directory (string
);
4000 realdir
= Fexpand_file_name (val
, realdir
);
4005 specdir
= Ffile_name_directory (string
);
4006 val
= Ffile_name_completion (name
, realdir
);
4011 return double_dollars (string
);
4015 if (!NILP (specdir
))
4016 val
= concat2 (specdir
, val
);
4018 return double_dollars (val
);
4021 #endif /* not VMS */
4025 if (EQ (action
, Qt
))
4026 return Ffile_name_all_completions (name
, realdir
);
4027 /* Only other case actually used is ACTION = lambda */
4029 /* Supposedly this helps commands such as `cd' that read directory names,
4030 but can someone explain how it helps them? -- RMS */
4031 if (XSTRING (name
)->size
== 0)
4034 return Ffile_exists_p (string
);
4037 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4038 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4039 Value is not expanded---you must call `expand-file-name' yourself.\n\
4040 Default name to DEFAULT if user enters a null string.\n\
4041 (If DEFAULT is omitted, the visited file name is used,\n\
4042 except that if INITIAL is specified, that combined with DIR is used.)\n\
4043 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4044 Non-nil and non-t means also require confirmation after completion.\n\
4045 Fifth arg INITIAL specifies text to start with.\n\
4046 DIR defaults to current buffer's directory default.")
4047 (prompt
, dir
, defalt
, mustmatch
, initial
)
4048 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4050 Lisp_Object val
, insdef
, insdef1
, tem
;
4051 struct gcpro gcpro1
, gcpro2
;
4052 register char *homedir
;
4056 dir
= current_buffer
->directory
;
4059 if (! NILP (initial
))
4060 defalt
= Fexpand_file_name (initial
, dir
);
4062 defalt
= current_buffer
->filename
;
4065 /* If dir starts with user's homedir, change that to ~. */
4066 homedir
= (char *) egetenv ("HOME");
4069 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4070 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4072 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4073 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4074 XSTRING (dir
)->data
[0] = '~';
4077 if (insert_default_directory
)
4080 if (!NILP (initial
))
4082 Lisp_Object args
[2], pos
;
4086 insdef
= Fconcat (2, args
);
4087 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4088 insdef1
= Fcons (double_dollars (insdef
), pos
);
4091 insdef1
= double_dollars (insdef
);
4093 else if (!NILP (initial
))
4096 insdef1
= Fcons (double_dollars (insdef
), 0);
4099 insdef
= Qnil
, insdef1
= Qnil
;
4102 count
= specpdl_ptr
- specpdl
;
4103 specbind (intern ("completion-ignore-case"), Qt
);
4106 GCPRO2 (insdef
, defalt
);
4107 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4108 dir
, mustmatch
, insdef1
,
4109 Qfile_name_history
);
4112 unbind_to (count
, Qnil
);
4117 error ("No file name specified");
4118 tem
= Fstring_equal (val
, insdef
);
4119 if (!NILP (tem
) && !NILP (defalt
))
4121 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4126 error ("No default file name");
4128 return Fsubstitute_in_file_name (val
);
4131 #if 0 /* Old version */
4132 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4133 /* Don't confuse make-docfile by having two doc strings for this function.
4134 make-docfile does not pay attention to #if, for good reason! */
4136 (prompt
, dir
, defalt
, mustmatch
, initial
)
4137 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4139 Lisp_Object val
, insdef
, tem
;
4140 struct gcpro gcpro1
, gcpro2
;
4141 register char *homedir
;
4145 dir
= current_buffer
->directory
;
4147 defalt
= current_buffer
->filename
;
4149 /* If dir starts with user's homedir, change that to ~. */
4150 homedir
= (char *) egetenv ("HOME");
4153 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4154 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4156 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4157 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4158 XSTRING (dir
)->data
[0] = '~';
4161 if (!NILP (initial
))
4163 else if (insert_default_directory
)
4166 insdef
= build_string ("");
4169 count
= specpdl_ptr
- specpdl
;
4170 specbind (intern ("completion-ignore-case"), Qt
);
4173 GCPRO2 (insdef
, defalt
);
4174 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4176 insert_default_directory
? insdef
: Qnil
,
4177 Qfile_name_history
);
4180 unbind_to (count
, Qnil
);
4185 error ("No file name specified");
4186 tem
= Fstring_equal (val
, insdef
);
4187 if (!NILP (tem
) && !NILP (defalt
))
4189 return Fsubstitute_in_file_name (val
);
4191 #endif /* Old version */
4195 Qexpand_file_name
= intern ("expand-file-name");
4196 Qdirectory_file_name
= intern ("directory-file-name");
4197 Qfile_name_directory
= intern ("file-name-directory");
4198 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4199 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4200 Qfile_name_as_directory
= intern ("file-name-as-directory");
4201 Qcopy_file
= intern ("copy-file");
4202 Qmake_directory_internal
= intern ("make-directory-internal");
4203 Qdelete_directory
= intern ("delete-directory");
4204 Qdelete_file
= intern ("delete-file");
4205 Qrename_file
= intern ("rename-file");
4206 Qadd_name_to_file
= intern ("add-name-to-file");
4207 Qmake_symbolic_link
= intern ("make-symbolic-link");
4208 Qfile_exists_p
= intern ("file-exists-p");
4209 Qfile_executable_p
= intern ("file-executable-p");
4210 Qfile_readable_p
= intern ("file-readable-p");
4211 Qfile_symlink_p
= intern ("file-symlink-p");
4212 Qfile_writable_p
= intern ("file-writable-p");
4213 Qfile_directory_p
= intern ("file-directory-p");
4214 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4215 Qfile_modes
= intern ("file-modes");
4216 Qset_file_modes
= intern ("set-file-modes");
4217 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4218 Qinsert_file_contents
= intern ("insert-file-contents");
4219 Qwrite_region
= intern ("write-region");
4220 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4221 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4222 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4224 staticpro (&Qexpand_file_name
);
4225 staticpro (&Qdirectory_file_name
);
4226 staticpro (&Qfile_name_directory
);
4227 staticpro (&Qfile_name_nondirectory
);
4228 staticpro (&Qunhandled_file_name_directory
);
4229 staticpro (&Qfile_name_as_directory
);
4230 staticpro (&Qcopy_file
);
4231 staticpro (&Qmake_directory_internal
);
4232 staticpro (&Qdelete_directory
);
4233 staticpro (&Qdelete_file
);
4234 staticpro (&Qrename_file
);
4235 staticpro (&Qadd_name_to_file
);
4236 staticpro (&Qmake_symbolic_link
);
4237 staticpro (&Qfile_exists_p
);
4238 staticpro (&Qfile_executable_p
);
4239 staticpro (&Qfile_readable_p
);
4240 staticpro (&Qfile_symlink_p
);
4241 staticpro (&Qfile_writable_p
);
4242 staticpro (&Qfile_directory_p
);
4243 staticpro (&Qfile_accessible_directory_p
);
4244 staticpro (&Qfile_modes
);
4245 staticpro (&Qset_file_modes
);
4246 staticpro (&Qfile_newer_than_file_p
);
4247 staticpro (&Qinsert_file_contents
);
4248 staticpro (&Qwrite_region
);
4249 staticpro (&Qverify_visited_file_modtime
);
4250 staticpro (&Qsubstitute_in_file_name
);
4252 Qfile_name_history
= intern ("file-name-history");
4253 Fset (Qfile_name_history
, Qnil
);
4254 staticpro (&Qfile_name_history
);
4256 Qfile_error
= intern ("file-error");
4257 staticpro (&Qfile_error
);
4258 Qfile_already_exists
= intern("file-already-exists");
4259 staticpro (&Qfile_already_exists
);
4262 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4263 staticpro (&Qfind_buffer_file_type
);
4266 Qcar_less_than_car
= intern ("car-less-than-car");
4267 staticpro (&Qcar_less_than_car
);
4269 Fput (Qfile_error
, Qerror_conditions
,
4270 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4271 Fput (Qfile_error
, Qerror_message
,
4272 build_string ("File error"));
4274 Fput (Qfile_already_exists
, Qerror_conditions
,
4275 Fcons (Qfile_already_exists
,
4276 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4277 Fput (Qfile_already_exists
, Qerror_message
,
4278 build_string ("File already exists"));
4280 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4281 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4282 insert_default_directory
= 1;
4284 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4285 "*Non-nil means write new files with record format `stmlf'.\n\
4286 nil means use format `var'. This variable is meaningful only on VMS.");
4287 vms_stmlf_recfm
= 0;
4289 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4290 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4291 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4294 The first argument given to HANDLER is the name of the I/O primitive\n\
4295 to be handled; the remaining arguments are the arguments that were\n\
4296 passed to that primitive. For example, if you do\n\
4297 (file-exists-p FILENAME)\n\
4298 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4299 (funcall HANDLER 'file-exists-p FILENAME)\n\
4300 The function `find-file-name-handler' checks this list for a handler\n\
4301 for its argument.");
4302 Vfile_name_handler_alist
= Qnil
;
4304 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4305 "A list of functions to be called at the end of `insert-file-contents'.\n\
4306 Each is passed one argument, the number of bytes inserted. It should return\n\
4307 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4308 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4309 responsible for calling the after-insert-file-functions if appropriate.");
4310 Vafter_insert_file_functions
= Qnil
;
4312 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4313 "A list of functions to be called at the start of `write-region'.\n\
4314 Each is passed two arguments, START and END as for `write-region'. It should\n\
4315 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4316 inserted at the specified positions of the file being written (1 means to\n\
4317 insert before the first byte written). The POSITIONs must be sorted into\n\
4318 increasing order. If there are several functions in the list, the several\n\
4319 lists are merged destructively.");
4320 Vwrite_region_annotate_functions
= Qnil
;
4322 DEFVAR_LISP ("write-region-annotations-so-far",
4323 &Vwrite_region_annotations_so_far
,
4324 "When an annotation function is called, this holds the previous annotations.\n\
4325 These are the annotations made by other annotation functions\n\
4326 that were already called. See also `write-region-annotate-functions'.");
4327 Vwrite_region_annotations_so_far
= Qnil
;
4329 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4330 "A list of file name handlers that temporarily should not be used.\n\
4331 This applies only to the operation `inhibit-file-name-operation'.");
4332 Vinhibit_file_name_handlers
= Qnil
;
4334 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4335 "The operation for which `inhibit-file-name-handlers' is applicable.");
4336 Vinhibit_file_name_operation
= Qnil
;
4338 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4339 "File name in which we write a list of all auto save file names.");
4340 Vauto_save_list_file_name
= Qnil
;
4342 defsubr (&Sfind_file_name_handler
);
4343 defsubr (&Sfile_name_directory
);
4344 defsubr (&Sfile_name_nondirectory
);
4345 defsubr (&Sunhandled_file_name_directory
);
4346 defsubr (&Sfile_name_as_directory
);
4347 defsubr (&Sdirectory_file_name
);
4348 defsubr (&Smake_temp_name
);
4349 defsubr (&Sexpand_file_name
);
4350 defsubr (&Ssubstitute_in_file_name
);
4351 defsubr (&Scopy_file
);
4352 defsubr (&Smake_directory_internal
);
4353 defsubr (&Sdelete_directory
);
4354 defsubr (&Sdelete_file
);
4355 defsubr (&Srename_file
);
4356 defsubr (&Sadd_name_to_file
);
4358 defsubr (&Smake_symbolic_link
);
4359 #endif /* S_IFLNK */
4361 defsubr (&Sdefine_logical_name
);
4364 defsubr (&Ssysnetunam
);
4365 #endif /* HPUX_NET */
4366 defsubr (&Sfile_name_absolute_p
);
4367 defsubr (&Sfile_exists_p
);
4368 defsubr (&Sfile_executable_p
);
4369 defsubr (&Sfile_readable_p
);
4370 defsubr (&Sfile_writable_p
);
4371 defsubr (&Sfile_symlink_p
);
4372 defsubr (&Sfile_directory_p
);
4373 defsubr (&Sfile_accessible_directory_p
);
4374 defsubr (&Sfile_regular_p
);
4375 defsubr (&Sfile_modes
);
4376 defsubr (&Sset_file_modes
);
4377 defsubr (&Sset_default_file_modes
);
4378 defsubr (&Sdefault_file_modes
);
4379 defsubr (&Sfile_newer_than_file_p
);
4380 defsubr (&Sinsert_file_contents
);
4381 defsubr (&Swrite_region
);
4382 defsubr (&Scar_less_than_car
);
4383 defsubr (&Sverify_visited_file_modtime
);
4384 defsubr (&Sclear_visited_file_modtime
);
4385 defsubr (&Svisited_file_modtime
);
4386 defsubr (&Sset_visited_file_modtime
);
4387 defsubr (&Sdo_auto_save
);
4388 defsubr (&Sset_buffer_auto_saved
);
4389 defsubr (&Sclear_buffer_auto_save_failure
);
4390 defsubr (&Srecent_auto_save_p
);
4392 defsubr (&Sread_file_name_internal
);
4393 defsubr (&Sread_file_name
);
4396 defsubr (&Sunix_sync
);