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
));
1998 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1999 "fRename file: \nFRename %s to file: \np",
2000 "Rename FILE as NEWNAME. Both args strings.\n\
2001 If file has names other than FILE, it continues to have those names.\n\
2002 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2003 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2004 A number as third arg means request confirmation if NEWNAME already exists.\n\
2005 This is what happens in interactive use with M-x.")
2006 (filename
, newname
, ok_if_already_exists
)
2007 Lisp_Object filename
, newname
, ok_if_already_exists
;
2010 Lisp_Object args
[2];
2012 Lisp_Object handler
;
2013 struct gcpro gcpro1
, gcpro2
;
2015 GCPRO2 (filename
, newname
);
2016 CHECK_STRING (filename
, 0);
2017 CHECK_STRING (newname
, 1);
2018 filename
= Fexpand_file_name (filename
, Qnil
);
2019 newname
= Fexpand_file_name (newname
, Qnil
);
2021 /* If the file name has special constructs in it,
2022 call the corresponding file handler. */
2023 handler
= Ffind_file_name_handler (filename
, Qrename_file
);
2025 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2026 if (!NILP (handler
))
2027 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2028 filename
, newname
, ok_if_already_exists
));
2030 if (NILP (ok_if_already_exists
)
2031 || INTEGERP (ok_if_already_exists
))
2032 barf_or_query_if_file_exists (newname
, "rename to it",
2033 INTEGERP (ok_if_already_exists
));
2035 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2038 if (!MoveFile (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2039 #else /* not WINDOWSNT */
2040 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
2041 || 0 > unlink (XSTRING (filename
)->data
))
2042 #endif /* not WINDOWSNT */
2046 /* Why two? And why doesn't MS document what MoveFile will return? */
2047 if (GetLastError () == ERROR_FILE_EXISTS
2048 || GetLastError () == ERROR_ALREADY_EXISTS
)
2049 #else /* not WINDOWSNT */
2051 #endif /* not WINDOWSNT */
2053 Fcopy_file (filename
, newname
,
2054 /* We have already prompted if it was an integer,
2055 so don't have copy-file prompt again. */
2056 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2057 Fdelete_file (filename
);
2064 report_file_error ("Renaming", Flist (2, args
));
2067 report_file_error ("Renaming", Flist (2, &filename
));
2074 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2075 "fAdd name to file: \nFName to add to %s: \np",
2076 "Give FILE additional name NEWNAME. Both args strings.\n\
2077 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2078 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2079 A number as third arg means request confirmation if NEWNAME already exists.\n\
2080 This is what happens in interactive use with M-x.")
2081 (filename
, newname
, ok_if_already_exists
)
2082 Lisp_Object filename
, newname
, ok_if_already_exists
;
2085 Lisp_Object args
[2];
2087 Lisp_Object handler
;
2088 struct gcpro gcpro1
, gcpro2
;
2090 GCPRO2 (filename
, newname
);
2091 CHECK_STRING (filename
, 0);
2092 CHECK_STRING (newname
, 1);
2093 filename
= Fexpand_file_name (filename
, Qnil
);
2094 newname
= Fexpand_file_name (newname
, Qnil
);
2096 /* If the file name has special constructs in it,
2097 call the corresponding file handler. */
2098 handler
= Ffind_file_name_handler (filename
, Qadd_name_to_file
);
2099 if (!NILP (handler
))
2100 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
2101 newname
, ok_if_already_exists
));
2103 if (NILP (ok_if_already_exists
)
2104 || INTEGERP (ok_if_already_exists
))
2105 barf_or_query_if_file_exists (newname
, "make it a new name",
2106 INTEGERP (ok_if_already_exists
));
2108 /* Windows does not support this operation. */
2109 report_file_error ("Adding new name", Flist (2, &filename
));
2110 #else /* not WINDOWSNT */
2112 unlink (XSTRING (newname
)->data
);
2113 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2118 report_file_error ("Adding new name", Flist (2, args
));
2120 report_file_error ("Adding new name", Flist (2, &filename
));
2123 #endif /* not WINDOWSNT */
2130 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2131 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2132 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2133 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2134 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2135 A number as third arg means request confirmation if LINKNAME already exists.\n\
2136 This happens for interactive use with M-x.")
2137 (filename
, linkname
, ok_if_already_exists
)
2138 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2141 Lisp_Object args
[2];
2143 Lisp_Object handler
;
2144 struct gcpro gcpro1
, gcpro2
;
2146 GCPRO2 (filename
, linkname
);
2147 CHECK_STRING (filename
, 0);
2148 CHECK_STRING (linkname
, 1);
2149 /* If the link target has a ~, we must expand it to get
2150 a truly valid file name. Otherwise, do not expand;
2151 we want to permit links to relative file names. */
2152 if (XSTRING (filename
)->data
[0] == '~')
2153 filename
= Fexpand_file_name (filename
, Qnil
);
2154 linkname
= Fexpand_file_name (linkname
, Qnil
);
2156 /* If the file name has special constructs in it,
2157 call the corresponding file handler. */
2158 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2159 if (!NILP (handler
))
2160 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2161 linkname
, ok_if_already_exists
));
2163 if (NILP (ok_if_already_exists
)
2164 || INTEGERP (ok_if_already_exists
))
2165 barf_or_query_if_file_exists (linkname
, "make it a link",
2166 INTEGERP (ok_if_already_exists
));
2167 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2169 /* If we didn't complain already, silently delete existing file. */
2170 if (errno
== EEXIST
)
2172 unlink (XSTRING (linkname
)->data
);
2173 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2183 report_file_error ("Making symbolic link", Flist (2, args
));
2185 report_file_error ("Making symbolic link", Flist (2, &filename
));
2191 #endif /* S_IFLNK */
2195 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2196 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2197 "Define the job-wide logical name NAME to have the value STRING.\n\
2198 If STRING is nil or a null string, the logical name NAME is deleted.")
2200 Lisp_Object varname
;
2203 CHECK_STRING (varname
, 0);
2205 delete_logical_name (XSTRING (varname
)->data
);
2208 CHECK_STRING (string
, 1);
2210 if (XSTRING (string
)->size
== 0)
2211 delete_logical_name (XSTRING (varname
)->data
);
2213 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2222 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2223 "Open a network connection to PATH using LOGIN as the login string.")
2225 Lisp_Object path
, login
;
2229 CHECK_STRING (path
, 0);
2230 CHECK_STRING (login
, 0);
2232 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2234 if (netresult
== -1)
2239 #endif /* HPUX_NET */
2241 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2243 "Return t if file FILENAME specifies an absolute path name.\n\
2244 On Unix, this is a name starting with a `/' or a `~'.")
2246 Lisp_Object filename
;
2250 CHECK_STRING (filename
, 0);
2251 ptr
= XSTRING (filename
)->data
;
2252 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2254 /* ??? This criterion is probably wrong for '<'. */
2255 || index (ptr
, ':') || index (ptr
, '<')
2256 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2260 || (*ptr
!= 0 && ptr
[1] == ':' && (ptr
[2] == '/' || ptr
[2] == '\\'))
2268 /* Return nonzero if file FILENAME exists and can be executed. */
2271 check_executable (filename
)
2275 return (eaccess (filename
, 1) >= 0);
2277 /* Access isn't quite right because it uses the real uid
2278 and we really want to test with the effective uid.
2279 But Unix doesn't give us a right way to do it. */
2280 return (access (filename
, 1) >= 0);
2284 /* Return nonzero if file FILENAME exists and can be written. */
2287 check_writable (filename
)
2291 return (eaccess (filename
, 2) >= 0);
2293 /* Access isn't quite right because it uses the real uid
2294 and we really want to test with the effective uid.
2295 But Unix doesn't give us a right way to do it.
2296 Opening with O_WRONLY could work for an ordinary file,
2297 but would lose for directories. */
2298 return (access (filename
, 2) >= 0);
2302 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2303 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2304 See also `file-readable-p' and `file-attributes'.")
2306 Lisp_Object filename
;
2308 Lisp_Object abspath
;
2309 Lisp_Object handler
;
2310 struct stat statbuf
;
2312 CHECK_STRING (filename
, 0);
2313 abspath
= Fexpand_file_name (filename
, Qnil
);
2315 /* If the file name has special constructs in it,
2316 call the corresponding file handler. */
2317 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2318 if (!NILP (handler
))
2319 return call2 (handler
, Qfile_exists_p
, abspath
);
2321 return (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2324 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2325 "Return t if FILENAME can be executed by you.\n\
2326 For a directory, this means you can access files in that directory.")
2328 Lisp_Object filename
;
2331 Lisp_Object abspath
;
2332 Lisp_Object handler
;
2334 CHECK_STRING (filename
, 0);
2335 abspath
= Fexpand_file_name (filename
, Qnil
);
2337 /* If the file name has special constructs in it,
2338 call the corresponding file handler. */
2339 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2340 if (!NILP (handler
))
2341 return call2 (handler
, Qfile_executable_p
, abspath
);
2343 return (check_executable (XSTRING (abspath
)->data
) ? Qt
: Qnil
);
2346 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2347 "Return t if file FILENAME exists and you can read it.\n\
2348 See also `file-exists-p' and `file-attributes'.")
2350 Lisp_Object filename
;
2352 Lisp_Object abspath
;
2353 Lisp_Object handler
;
2356 CHECK_STRING (filename
, 0);
2357 abspath
= Fexpand_file_name (filename
, Qnil
);
2359 /* If the file name has special constructs in it,
2360 call the corresponding file handler. */
2361 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2362 if (!NILP (handler
))
2363 return call2 (handler
, Qfile_readable_p
, abspath
);
2365 desc
= open (XSTRING (abspath
)->data
, O_RDONLY
);
2372 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2374 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2375 "Return t if file FILENAME can be written or created by you.")
2377 Lisp_Object filename
;
2379 Lisp_Object abspath
, dir
;
2380 Lisp_Object handler
;
2381 struct stat statbuf
;
2383 CHECK_STRING (filename
, 0);
2384 abspath
= Fexpand_file_name (filename
, Qnil
);
2386 /* If the file name has special constructs in it,
2387 call the corresponding file handler. */
2388 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2389 if (!NILP (handler
))
2390 return call2 (handler
, Qfile_writable_p
, abspath
);
2392 if (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0)
2393 return (check_writable (XSTRING (abspath
)->data
)
2395 dir
= Ffile_name_directory (abspath
);
2398 dir
= Fdirectory_file_name (dir
);
2402 dir
= Fdirectory_file_name (dir
);
2404 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2408 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2409 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2410 The value is the name of the file to which it is linked.\n\
2411 Otherwise returns nil.")
2413 Lisp_Object filename
;
2420 Lisp_Object handler
;
2422 CHECK_STRING (filename
, 0);
2423 filename
= Fexpand_file_name (filename
, Qnil
);
2425 /* If the file name has special constructs in it,
2426 call the corresponding file handler. */
2427 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2428 if (!NILP (handler
))
2429 return call2 (handler
, Qfile_symlink_p
, filename
);
2434 buf
= (char *) xmalloc (bufsize
);
2435 bzero (buf
, bufsize
);
2436 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2437 if (valsize
< bufsize
) break;
2438 /* Buffer was not long enough */
2447 val
= make_string (buf
, valsize
);
2450 #else /* not S_IFLNK */
2452 #endif /* not S_IFLNK */
2455 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2456 "Return t if file FILENAME is the name of a directory as a file.\n\
2457 A directory name spec may be given instead; then the value is t\n\
2458 if the directory so specified exists and really is a directory.")
2460 Lisp_Object filename
;
2462 register Lisp_Object abspath
;
2464 Lisp_Object handler
;
2466 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2468 /* If the file name has special constructs in it,
2469 call the corresponding file handler. */
2470 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2471 if (!NILP (handler
))
2472 return call2 (handler
, Qfile_directory_p
, abspath
);
2474 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2476 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2479 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2480 "Return t if file FILENAME is the name of a directory as a file,\n\
2481 and files in that directory can be opened by you. In order to use a\n\
2482 directory as a buffer's current directory, this predicate must return true.\n\
2483 A directory name spec may be given instead; then the value is t\n\
2484 if the directory so specified exists and really is a readable and\n\
2485 searchable directory.")
2487 Lisp_Object filename
;
2489 Lisp_Object handler
;
2491 struct gcpro gcpro1
;
2493 /* If the file name has special constructs in it,
2494 call the corresponding file handler. */
2495 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2496 if (!NILP (handler
))
2497 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2499 /* It's an unlikely combination, but yes we really do need to gcpro:
2500 Suppose that file-accessible-directory-p has no handler, but
2501 file-directory-p does have a handler; this handler causes a GC which
2502 relocates the string in `filename'; and finally file-directory-p
2503 returns non-nil. Then we would end up passing a garbaged string
2504 to file-executable-p. */
2506 tem
= (NILP (Ffile_directory_p (filename
))
2507 || NILP (Ffile_executable_p (filename
)));
2509 return tem
? Qnil
: Qt
;
2512 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2513 "Return t if file FILENAME is the name of a regular file.\n\
2514 This is the sort of file that holds an ordinary stream of data bytes.")
2516 Lisp_Object filename
;
2518 register Lisp_Object abspath
;
2520 Lisp_Object handler
;
2522 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2524 /* If the file name has special constructs in it,
2525 call the corresponding file handler. */
2526 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2527 if (!NILP (handler
))
2528 return call2 (handler
, Qfile_directory_p
, abspath
);
2530 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2532 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2535 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2536 "Return mode bits of FILE, as an integer.")
2538 Lisp_Object filename
;
2540 Lisp_Object abspath
;
2542 Lisp_Object handler
;
2544 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2546 /* If the file name has special constructs in it,
2547 call the corresponding file handler. */
2548 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2549 if (!NILP (handler
))
2550 return call2 (handler
, Qfile_modes
, abspath
);
2552 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2558 if (S_ISREG (st
.st_mode
)
2559 && (len
= XSTRING (abspath
)->size
) >= 5
2560 && (stricmp ((suffix
= XSTRING (abspath
)->data
+ len
-4), ".com") == 0
2561 || stricmp (suffix
, ".exe") == 0
2562 || stricmp (suffix
, ".bat") == 0))
2563 st
.st_mode
|= S_IEXEC
;
2567 return make_number (st
.st_mode
& 07777);
2570 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2571 "Set mode bits of FILE to MODE (an integer).\n\
2572 Only the 12 low bits of MODE are used.")
2574 Lisp_Object filename
, mode
;
2576 Lisp_Object abspath
;
2577 Lisp_Object handler
;
2579 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2580 CHECK_NUMBER (mode
, 1);
2582 /* If the file name has special constructs in it,
2583 call the corresponding file handler. */
2584 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2585 if (!NILP (handler
))
2586 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2589 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2590 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2592 if (!egetenv ("USE_DOMAIN_ACLS"))
2595 struct timeval tvp
[2];
2597 /* chmod on apollo also change the file's modtime; need to save the
2598 modtime and then restore it. */
2599 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2601 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2605 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2606 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2608 /* reset the old accessed and modified times. */
2609 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2611 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2614 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2615 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2622 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2623 "Set the file permission bits for newly created files.\n\
2624 The argument MODE should be an integer; only the low 9 bits are used.\n\
2625 This setting is inherited by subprocesses.")
2629 CHECK_NUMBER (mode
, 0);
2631 umask ((~ XINT (mode
)) & 0777);
2636 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2637 "Return the default file protection for created files.\n\
2638 The value is an integer.")
2644 realmask
= umask (0);
2647 XSETINT (value
, (~ realmask
) & 0777);
2653 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2654 "Tell Unix to finish all pending disk updates.")
2663 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2664 "Return t if file FILE1 is newer than file FILE2.\n\
2665 If FILE1 does not exist, the answer is nil;\n\
2666 otherwise, if FILE2 does not exist, the answer is t.")
2668 Lisp_Object file1
, file2
;
2670 Lisp_Object abspath1
, abspath2
;
2673 Lisp_Object handler
;
2674 struct gcpro gcpro1
, gcpro2
;
2676 CHECK_STRING (file1
, 0);
2677 CHECK_STRING (file2
, 0);
2680 GCPRO2 (abspath1
, file2
);
2681 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2682 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2685 /* If the file name has special constructs in it,
2686 call the corresponding file handler. */
2687 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2689 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2690 if (!NILP (handler
))
2691 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2693 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2696 mtime1
= st
.st_mtime
;
2698 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2701 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2705 Lisp_Object Qfind_buffer_file_type
;
2708 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2710 "Insert contents of file FILENAME after point.\n\
2711 Returns list of absolute file name and length of data inserted.\n\
2712 If second argument VISIT is non-nil, the buffer's visited filename\n\
2713 and last save file modtime are set, and it is marked unmodified.\n\
2714 If visiting and the file does not exist, visiting is completed\n\
2715 before the error is signaled.\n\n\
2716 The optional third and fourth arguments BEG and END\n\
2717 specify what portion of the file to insert.\n\
2718 If VISIT is non-nil, BEG and END must be nil.\n\
2719 If optional fifth argument REPLACE is non-nil,\n\
2720 it means replace the current buffer contents (in the accessible portion)\n\
2721 with the file contents. This is better than simply deleting and inserting\n\
2722 the whole thing because (1) it preserves some marker positions\n\
2723 and (2) it puts less data in the undo list.")
2724 (filename
, visit
, beg
, end
, replace
)
2725 Lisp_Object filename
, visit
, beg
, end
, replace
;
2729 register int inserted
= 0;
2730 register int how_much
;
2731 int count
= specpdl_ptr
- specpdl
;
2732 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2733 Lisp_Object handler
, val
, insval
;
2736 int not_regular
= 0;
2741 GCPRO3 (filename
, val
, p
);
2742 if (!NILP (current_buffer
->read_only
))
2743 Fbarf_if_buffer_read_only();
2745 CHECK_STRING (filename
, 0);
2746 filename
= Fexpand_file_name (filename
, Qnil
);
2748 /* If the file name has special constructs in it,
2749 call the corresponding file handler. */
2750 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2751 if (!NILP (handler
))
2753 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2754 visit
, beg
, end
, replace
);
2761 if (stat (XSTRING (filename
)->data
, &st
) < 0)
2763 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
2764 || fstat (fd
, &st
) < 0)
2765 #endif /* not APOLLO */
2767 if (fd
>= 0) close (fd
);
2770 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2777 /* This code will need to be changed in order to work on named
2778 pipes, and it's probably just not worth it. So we should at
2779 least signal an error. */
2780 if (!S_ISREG (st
.st_mode
))
2783 Fsignal (Qfile_error
,
2784 Fcons (build_string ("not a regular file"),
2785 Fcons (filename
, Qnil
)));
2793 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
2796 /* Replacement should preserve point as it preserves markers. */
2797 if (!NILP (replace
))
2798 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2800 record_unwind_protect (close_file_unwind
, make_number (fd
));
2802 /* Supposedly happens on VMS. */
2804 error ("File size is negative");
2806 if (!NILP (beg
) || !NILP (end
))
2808 error ("Attempt to visit less than an entire file");
2811 CHECK_NUMBER (beg
, 0);
2813 XSETFASTINT (beg
, 0);
2816 CHECK_NUMBER (end
, 0);
2819 XSETINT (end
, st
.st_size
);
2820 if (XINT (end
) != st
.st_size
)
2821 error ("maximum buffer size exceeded");
2824 /* If requested, replace the accessible part of the buffer
2825 with the file contents. Avoid replacing text at the
2826 beginning or end of the buffer that matches the file contents;
2827 that preserves markers pointing to the unchanged parts. */
2829 /* On MSDOS, replace mode doesn't really work, except for binary files,
2830 and it's not worth supporting just for them. */
2831 if (!NILP (replace
))
2834 XSETFASTINT (beg
, 0);
2835 XSETFASTINT (end
, st
.st_size
);
2836 del_range_1 (BEGV
, ZV
, 0);
2838 #else /* not DOS_NT */
2839 if (!NILP (replace
))
2841 unsigned char buffer
[1 << 14];
2842 int same_at_start
= BEGV
;
2843 int same_at_end
= ZV
;
2848 /* Count how many chars at the start of the file
2849 match the text at the beginning of the buffer. */
2854 nread
= read (fd
, buffer
, sizeof buffer
);
2856 error ("IO error reading %s: %s",
2857 XSTRING (filename
)->data
, strerror (errno
));
2858 else if (nread
== 0)
2861 while (bufpos
< nread
&& same_at_start
< ZV
2862 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2863 same_at_start
++, bufpos
++;
2864 /* If we found a discrepancy, stop the scan.
2865 Otherwise loop around and scan the next bufferfull. */
2866 if (bufpos
!= nread
)
2870 /* If the file matches the buffer completely,
2871 there's no need to replace anything. */
2872 if (same_at_start
- BEGV
== st
.st_size
)
2876 /* Truncate the buffer to the size of the file. */
2877 del_range_1 (same_at_start
, same_at_end
, 0);
2882 /* Count how many chars at the end of the file
2883 match the text at the end of the buffer. */
2886 int total_read
, nread
, bufpos
, curpos
, trial
;
2888 /* At what file position are we now scanning? */
2889 curpos
= st
.st_size
- (ZV
- same_at_end
);
2890 /* If the entire file matches the buffer tail, stop the scan. */
2893 /* How much can we scan in the next step? */
2894 trial
= min (curpos
, sizeof buffer
);
2895 if (lseek (fd
, curpos
- trial
, 0) < 0)
2896 report_file_error ("Setting file position",
2897 Fcons (filename
, Qnil
));
2900 while (total_read
< trial
)
2902 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2904 error ("IO error reading %s: %s",
2905 XSTRING (filename
)->data
, strerror (errno
));
2906 total_read
+= nread
;
2908 /* Scan this bufferfull from the end, comparing with
2909 the Emacs buffer. */
2910 bufpos
= total_read
;
2911 /* Compare with same_at_start to avoid counting some buffer text
2912 as matching both at the file's beginning and at the end. */
2913 while (bufpos
> 0 && same_at_end
> same_at_start
2914 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2915 same_at_end
--, bufpos
--;
2916 /* If we found a discrepancy, stop the scan.
2917 Otherwise loop around and scan the preceding bufferfull. */
2923 /* Don't try to reuse the same piece of text twice. */
2924 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2926 same_at_end
+= overlap
;
2928 /* Arrange to read only the nonmatching middle part of the file. */
2929 XSETFASTINT (beg
, same_at_start
- BEGV
);
2930 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
2932 del_range_1 (same_at_start
, same_at_end
, 0);
2933 /* Insert from the file at the proper position. */
2934 SET_PT (same_at_start
);
2936 #endif /* not DOS_NT */
2938 total
= XINT (end
) - XINT (beg
);
2941 register Lisp_Object temp
;
2943 /* Make sure point-max won't overflow after this insertion. */
2944 XSETINT (temp
, total
);
2945 if (total
!= XINT (temp
))
2946 error ("maximum buffer size exceeded");
2949 if (NILP (visit
) && total
> 0)
2950 prepare_to_modify_buffer (point
, point
);
2953 if (GAP_SIZE
< total
)
2954 make_gap (total
- GAP_SIZE
);
2956 if (XINT (beg
) != 0 || !NILP (replace
))
2958 if (lseek (fd
, XINT (beg
), 0) < 0)
2959 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2963 while (inserted
< total
)
2965 /* try is reserved in some compilers (Microsoft C) */
2966 int trytry
= min (total
- inserted
, 64 << 10);
2969 /* Allow quitting out of the actual I/O. */
2972 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, trytry
);
2989 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
2990 /* Determine file type from name and remove LFs from CR-LFs if the file
2991 is deemed to be a text file. */
2993 current_buffer
->buffer_file_type
2994 = call1 (Qfind_buffer_file_type
, filename
);
2995 if (NILP (current_buffer
->buffer_file_type
))
2998 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
3001 GPT
-= reduced_size
;
3002 GAP_SIZE
+= reduced_size
;
3003 inserted
-= reduced_size
;
3010 record_insert (point
, inserted
);
3012 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3013 offset_intervals (current_buffer
, point
, inserted
);
3019 /* Discard the unwind protect for closing the file. */
3023 error ("IO error reading %s: %s",
3024 XSTRING (filename
)->data
, strerror (errno
));
3031 if (!EQ (current_buffer
->undo_list
, Qt
))
3032 current_buffer
->undo_list
= Qnil
;
3034 stat (XSTRING (filename
)->data
, &st
);
3039 current_buffer
->modtime
= st
.st_mtime
;
3040 current_buffer
->filename
= filename
;
3043 current_buffer
->save_modified
= MODIFF
;
3044 current_buffer
->auto_save_modified
= MODIFF
;
3045 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3046 #ifdef CLASH_DETECTION
3049 if (!NILP (current_buffer
->filename
))
3050 unlock_file (current_buffer
->filename
);
3051 unlock_file (filename
);
3053 #endif /* CLASH_DETECTION */
3055 Fsignal (Qfile_error
,
3056 Fcons (build_string ("not a regular file"),
3057 Fcons (filename
, Qnil
)));
3059 /* If visiting nonexistent file, return nil. */
3060 if (current_buffer
->modtime
== -1)
3061 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3064 if (inserted
> 0 && NILP (visit
) && total
> 0)
3065 signal_after_change (point
, 0, inserted
);
3069 p
= Vafter_insert_file_functions
;
3072 insval
= call1 (Fcar (p
), make_number (inserted
));
3075 CHECK_NUMBER (insval
, 0);
3076 inserted
= XFASTINT (insval
);
3084 val
= Fcons (filename
,
3085 Fcons (make_number (inserted
),
3088 RETURN_UNGCPRO (unbind_to (count
, val
));
3091 static Lisp_Object
build_annotations ();
3093 /* If build_annotations switched buffers, switch back to BUF.
3094 Kill the temporary buffer that was selected in the meantime. */
3097 build_annotations_unwind (buf
)
3102 if (XBUFFER (buf
) == current_buffer
)
3104 tembuf
= Fcurrent_buffer ();
3106 Fkill_buffer (tembuf
);
3110 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
3111 "r\nFWrite region to file: ",
3112 "Write current region into specified file.\n\
3113 When called from a program, takes three arguments:\n\
3114 START, END and FILENAME. START and END are buffer positions.\n\
3115 Optional fourth argument APPEND if non-nil means\n\
3116 append to existing file contents (if any).\n\
3117 Optional fifth argument VISIT if t means\n\
3118 set the last-save-file-modtime of buffer to this file's modtime\n\
3119 and mark buffer not modified.\n\
3120 If VISIT is a string, it is a second file name;\n\
3121 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3122 VISIT is also the file name to lock and unlock for clash detection.\n\
3123 If VISIT is neither t nor nil nor a string,\n\
3124 that means do not print the \"Wrote file\" message.\n\
3125 Kludgy feature: if START is a string, then that string is written\n\
3126 to the file, instead of any buffer contents, and END is ignored.")
3127 (start
, end
, filename
, append
, visit
)
3128 Lisp_Object start
, end
, filename
, append
, visit
;
3136 int count
= specpdl_ptr
- specpdl
;
3139 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3141 Lisp_Object handler
;
3142 Lisp_Object visit_file
;
3143 Lisp_Object annotations
;
3144 int visiting
, quietly
;
3145 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3146 struct buffer
*given_buffer
;
3148 int buffer_file_type
3149 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3152 if (!NILP (start
) && !STRINGP (start
))
3153 validate_region (&start
, &end
);
3155 GCPRO2 (filename
, visit
);
3156 filename
= Fexpand_file_name (filename
, Qnil
);
3157 if (STRINGP (visit
))
3158 visit_file
= Fexpand_file_name (visit
, Qnil
);
3160 visit_file
= filename
;
3163 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3164 quietly
= !NILP (visit
);
3168 GCPRO4 (start
, filename
, annotations
, visit_file
);
3170 /* If the file name has special constructs in it,
3171 call the corresponding file handler. */
3172 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3173 /* If FILENAME has no handler, see if VISIT has one. */
3174 if (NILP (handler
) && STRINGP (visit
))
3175 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3177 if (!NILP (handler
))
3180 val
= call6 (handler
, Qwrite_region
, start
, end
,
3181 filename
, append
, visit
);
3185 current_buffer
->save_modified
= MODIFF
;
3186 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3187 current_buffer
->filename
= visit_file
;
3193 /* Special kludge to simplify auto-saving. */
3196 XSETFASTINT (start
, BEG
);
3197 XSETFASTINT (end
, Z
);
3200 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3201 count1
= specpdl_ptr
- specpdl
;
3203 given_buffer
= current_buffer
;
3204 annotations
= build_annotations (start
, end
);
3205 if (current_buffer
!= given_buffer
)
3211 #ifdef CLASH_DETECTION
3213 lock_file (visit_file
);
3214 #endif /* CLASH_DETECTION */
3216 fn
= XSTRING (filename
)->data
;
3220 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3221 #else /* not DOS_NT */
3222 desc
= open (fn
, O_WRONLY
);
3223 #endif /* not DOS_NT */
3227 if (auto_saving
) /* Overwrite any previous version of autosave file */
3229 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3230 desc
= open (fn
, O_RDWR
);
3232 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3233 ? XSTRING (current_buffer
->filename
)->data
: 0,
3236 else /* Write to temporary name and rename if no errors */
3238 Lisp_Object temp_name
;
3239 temp_name
= Ffile_name_directory (filename
);
3241 if (!NILP (temp_name
))
3243 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3244 build_string ("$$SAVE$$")));
3245 fname
= XSTRING (filename
)->data
;
3246 fn
= XSTRING (temp_name
)->data
;
3247 desc
= creat_copy_attrs (fname
, fn
);
3250 /* If we can't open the temporary file, try creating a new
3251 version of the original file. VMS "creat" creates a
3252 new version rather than truncating an existing file. */
3255 desc
= creat (fn
, 0666);
3256 #if 0 /* This can clobber an existing file and fail to replace it,
3257 if the user runs out of space. */
3260 /* We can't make a new version;
3261 try to truncate and rewrite existing version if any. */
3263 desc
= open (fn
, O_RDWR
);
3269 desc
= creat (fn
, 0666);
3274 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3275 S_IREAD
| S_IWRITE
);
3276 #else /* not DOS_NT */
3277 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3278 #endif /* not DOS_NT */
3279 #endif /* not VMS */
3285 #ifdef CLASH_DETECTION
3287 if (!auto_saving
) unlock_file (visit_file
);
3289 #endif /* CLASH_DETECTION */
3290 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3293 record_unwind_protect (close_file_unwind
, make_number (desc
));
3296 if (lseek (desc
, 0, 2) < 0)
3298 #ifdef CLASH_DETECTION
3299 if (!auto_saving
) unlock_file (visit_file
);
3300 #endif /* CLASH_DETECTION */
3301 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3306 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3307 * if we do writes that don't end with a carriage return. Furthermore
3308 * it cannot handle writes of more then 16K. The modified
3309 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3310 * this EXCEPT for the last record (iff it doesn't end with a carriage
3311 * return). This implies that if your buffer doesn't end with a carriage
3312 * return, you get one free... tough. However it also means that if
3313 * we make two calls to sys_write (a la the following code) you can
3314 * get one at the gap as well. The easiest way to fix this (honest)
3315 * is to move the gap to the next newline (or the end of the buffer).
3320 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3321 move_gap (find_next_newline (GPT
, 1));
3327 if (STRINGP (start
))
3329 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3330 XSTRING (start
)->size
, 0, &annotations
);
3333 else if (XINT (start
) != XINT (end
))
3336 if (XINT (start
) < GPT
)
3338 register int end1
= XINT (end
);
3340 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3341 min (GPT
, end1
) - tem
, tem
, &annotations
);
3342 nwritten
+= min (GPT
, end1
) - tem
;
3346 if (XINT (end
) > GPT
&& !failure
)
3349 tem
= max (tem
, GPT
);
3350 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3352 nwritten
+= XINT (end
) - tem
;
3358 /* If file was empty, still need to write the annotations */
3359 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3367 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3368 Disk full in NFS may be reported here. */
3369 /* mib says that closing the file will try to write as fast as NFS can do
3370 it, and that means the fsync here is not crucial for autosave files. */
3371 if (!auto_saving
&& fsync (desc
) < 0)
3372 failure
= 1, save_errno
= errno
;
3375 /* Spurious "file has changed on disk" warnings have been
3376 observed on Suns as well.
3377 It seems that `close' can change the modtime, under nfs.
3379 (This has supposedly been fixed in Sunos 4,
3380 but who knows about all the other machines with NFS?) */
3383 /* On VMS and APOLLO, must do the stat after the close
3384 since closing changes the modtime. */
3387 /* Recall that #if defined does not work on VMS. */
3394 /* NFS can report a write failure now. */
3395 if (close (desc
) < 0)
3396 failure
= 1, save_errno
= errno
;
3399 /* If we wrote to a temporary name and had no errors, rename to real name. */
3403 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3411 /* Discard the unwind protect for close_file_unwind. */
3412 specpdl_ptr
= specpdl
+ count1
;
3413 /* Restore the original current buffer. */
3414 visit_file
= unbind_to (count
, visit_file
);
3416 #ifdef CLASH_DETECTION
3418 unlock_file (visit_file
);
3419 #endif /* CLASH_DETECTION */
3421 /* Do this before reporting IO error
3422 to avoid a "file has changed on disk" warning on
3423 next attempt to save. */
3425 current_buffer
->modtime
= st
.st_mtime
;
3428 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3432 current_buffer
->save_modified
= MODIFF
;
3433 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3434 current_buffer
->filename
= visit_file
;
3435 update_mode_lines
++;
3441 message ("Wrote %s", XSTRING (visit_file
)->data
);
3446 Lisp_Object
merge ();
3448 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3449 "Return t if (car A) is numerically less than (car B).")
3453 return Flss (Fcar (a
), Fcar (b
));
3456 /* Build the complete list of annotations appropriate for writing out
3457 the text between START and END, by calling all the functions in
3458 write-region-annotate-functions and merging the lists they return.
3459 If one of these functions switches to a different buffer, we assume
3460 that buffer contains altered text. Therefore, the caller must
3461 make sure to restore the current buffer in all cases,
3462 as save-excursion would do. */
3465 build_annotations (start
, end
)
3466 Lisp_Object start
, end
;
3468 Lisp_Object annotations
;
3470 struct gcpro gcpro1
, gcpro2
;
3473 p
= Vwrite_region_annotate_functions
;
3474 GCPRO2 (annotations
, p
);
3477 struct buffer
*given_buffer
= current_buffer
;
3478 Vwrite_region_annotations_so_far
= annotations
;
3479 res
= call2 (Fcar (p
), start
, end
);
3480 /* If the function makes a different buffer current,
3481 assume that means this buffer contains altered text to be output.
3482 Reset START and END from the buffer bounds
3483 and discard all previous annotations because they should have
3484 been dealt with by this function. */
3485 if (current_buffer
!= given_buffer
)
3491 Flength (res
); /* Check basic validity of return value */
3492 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3499 /* Write to descriptor DESC the LEN characters starting at ADDR,
3500 assuming they start at position POS in the buffer.
3501 Intersperse with them the annotations from *ANNOT
3502 (those which fall within the range of positions POS to POS + LEN),
3503 each at its appropriate position.
3505 Modify *ANNOT by discarding elements as we output them.
3506 The return value is negative in case of system call failure. */
3509 a_write (desc
, addr
, len
, pos
, annot
)
3511 register char *addr
;
3518 int lastpos
= pos
+ len
;
3520 while (NILP (*annot
) || CONSP (*annot
))
3522 tem
= Fcar_safe (Fcar (*annot
));
3523 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3524 nextpos
= XFASTINT (tem
);
3526 return e_write (desc
, addr
, lastpos
- pos
);
3529 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3531 addr
+= nextpos
- pos
;
3534 tem
= Fcdr (Fcar (*annot
));
3537 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3540 *annot
= Fcdr (*annot
);
3545 e_write (desc
, addr
, len
)
3547 register char *addr
;
3550 char buf
[16 * 1024];
3551 register char *p
, *end
;
3553 if (!EQ (current_buffer
->selective_display
, Qt
))
3554 return write (desc
, addr
, len
) - len
;
3558 end
= p
+ sizeof buf
;
3563 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3572 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3578 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3579 Sverify_visited_file_modtime
, 1, 1, 0,
3580 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3581 This means that the file has not been changed since it was visited or saved.")
3587 Lisp_Object handler
;
3589 CHECK_BUFFER (buf
, 0);
3592 if (!STRINGP (b
->filename
)) return Qt
;
3593 if (b
->modtime
== 0) return Qt
;
3595 /* If the file name has special constructs in it,
3596 call the corresponding file handler. */
3597 handler
= Ffind_file_name_handler (b
->filename
,
3598 Qverify_visited_file_modtime
);
3599 if (!NILP (handler
))
3600 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3602 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3604 /* If the file doesn't exist now and didn't exist before,
3605 we say that it isn't modified, provided the error is a tame one. */
3606 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3611 if (st
.st_mtime
== b
->modtime
3612 /* If both are positive, accept them if they are off by one second. */
3613 || (st
.st_mtime
> 0 && b
->modtime
> 0
3614 && (st
.st_mtime
== b
->modtime
+ 1
3615 || st
.st_mtime
== b
->modtime
- 1)))
3620 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3621 Sclear_visited_file_modtime
, 0, 0, 0,
3622 "Clear out records of last mod time of visited file.\n\
3623 Next attempt to save will certainly not complain of a discrepancy.")
3626 current_buffer
->modtime
= 0;
3630 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3631 Svisited_file_modtime
, 0, 0, 0,
3632 "Return the current buffer's recorded visited file modification time.\n\
3633 The value is a list of the form (HIGH . LOW), like the time values\n\
3634 that `file-attributes' returns.")
3637 return long_to_cons (current_buffer
->modtime
);
3640 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3641 Sset_visited_file_modtime
, 0, 1, 0,
3642 "Update buffer's recorded modification time from the visited file's time.\n\
3643 Useful if the buffer was not read from the file normally\n\
3644 or if the file itself has been changed for some known benign reason.\n\
3645 An argument specifies the modification time value to use\n\
3646 \(instead of that of the visited file), in the form of a list\n\
3647 \(HIGH . LOW) or (HIGH LOW).")
3649 Lisp_Object time_list
;
3651 if (!NILP (time_list
))
3652 current_buffer
->modtime
= cons_to_long (time_list
);
3655 register Lisp_Object filename
;
3657 Lisp_Object handler
;
3659 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3661 /* If the file name has special constructs in it,
3662 call the corresponding file handler. */
3663 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3664 if (!NILP (handler
))
3665 /* The handler can find the file name the same way we did. */
3666 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3667 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3668 current_buffer
->modtime
= st
.st_mtime
;
3678 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3679 Fsleep_for (make_number (1), Qnil
);
3680 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3681 Fsleep_for (make_number (1), Qnil
);
3682 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3683 Fsleep_for (make_number (1), Qnil
);
3693 /* Get visited file's mode to become the auto save file's mode. */
3694 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3695 /* But make sure we can overwrite it later! */
3696 auto_save_mode_bits
= st
.st_mode
| 0600;
3698 auto_save_mode_bits
= 0666;
3701 Fwrite_region (Qnil
, Qnil
,
3702 current_buffer
->auto_save_file_name
,
3707 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3710 close (XINT (desc
));
3714 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3715 "Auto-save all buffers that need it.\n\
3716 This is all buffers that have auto-saving enabled\n\
3717 and are changed since last auto-saved.\n\
3718 Auto-saving writes the buffer into a file\n\
3719 so that your editing is not lost if the system crashes.\n\
3720 This file is not the file you visited; that changes only when you save.\n\
3721 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3722 Non-nil first argument means do not print any message if successful.\n\
3723 Non-nil second argument means save only current buffer.")
3724 (no_message
, current_only
)
3725 Lisp_Object no_message
, current_only
;
3727 struct buffer
*old
= current_buffer
, *b
;
3728 Lisp_Object tail
, buf
;
3730 char *omessage
= echo_area_glyphs
;
3731 int omessage_length
= echo_area_glyphs_length
;
3732 extern int minibuf_level
;
3733 int do_handled_files
;
3736 int count
= specpdl_ptr
- specpdl
;
3739 /* Ordinarily don't quit within this function,
3740 but don't make it impossible to quit (in case we get hung in I/O). */
3744 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3745 point to non-strings reached from Vbuffer_alist. */
3751 if (!NILP (Vrun_hooks
))
3752 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3754 if (STRINGP (Vauto_save_list_file_name
))
3757 listdesc
= open (XSTRING (Vauto_save_list_file_name
)->data
,
3758 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3759 S_IREAD
| S_IWRITE
);
3760 #else /* not DOS_NT */
3761 listdesc
= creat (XSTRING (Vauto_save_list_file_name
)->data
, 0666);
3762 #endif /* not DOS_NT */
3767 /* Arrange to close that file whether or not we get an error. */
3769 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3771 /* First, save all files which don't have handlers. If Emacs is
3772 crashing, the handlers may tweak what is causing Emacs to crash
3773 in the first place, and it would be a shame if Emacs failed to
3774 autosave perfectly ordinary files because it couldn't handle some
3776 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3777 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
3779 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3782 /* Record all the buffers that have auto save mode
3783 in the special file that lists them. */
3784 if (STRINGP (b
->auto_save_file_name
)
3785 && listdesc
>= 0 && do_handled_files
== 0)
3787 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3788 XSTRING (b
->auto_save_file_name
)->size
);
3789 write (listdesc
, "\n", 1);
3792 if (!NILP (current_only
)
3793 && b
!= current_buffer
)
3796 /* Check for auto save enabled
3797 and file changed since last auto save
3798 and file changed since last real save. */
3799 if (STRINGP (b
->auto_save_file_name
)
3800 && b
->save_modified
< BUF_MODIFF (b
)
3801 && b
->auto_save_modified
< BUF_MODIFF (b
)
3802 /* -1 means we've turned off autosaving for a while--see below. */
3803 && XINT (b
->save_length
) >= 0
3804 && (do_handled_files
3805 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3808 EMACS_TIME before_time
, after_time
;
3810 EMACS_GET_TIME (before_time
);
3812 /* If we had a failure, don't try again for 20 minutes. */
3813 if (b
->auto_save_failure_time
>= 0
3814 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3817 if ((XFASTINT (b
->save_length
) * 10
3818 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3819 /* A short file is likely to change a large fraction;
3820 spare the user annoying messages. */
3821 && XFASTINT (b
->save_length
) > 5000
3822 /* These messages are frequent and annoying for `*mail*'. */
3823 && !EQ (b
->filename
, Qnil
)
3824 && NILP (no_message
))
3826 /* It has shrunk too much; turn off auto-saving here. */
3827 message ("Buffer %s has shrunk a lot; auto save turned off there",
3828 XSTRING (b
->name
)->data
);
3829 /* Turn off auto-saving until there's a real save,
3830 and prevent any more warnings. */
3831 XSETINT (b
->save_length
, -1);
3832 Fsleep_for (make_number (1), Qnil
);
3835 set_buffer_internal (b
);
3836 if (!auto_saved
&& NILP (no_message
))
3837 message1 ("Auto-saving...");
3838 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3840 b
->auto_save_modified
= BUF_MODIFF (b
);
3841 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3842 set_buffer_internal (old
);
3844 EMACS_GET_TIME (after_time
);
3846 /* If auto-save took more than 60 seconds,
3847 assume it was an NFS failure that got a timeout. */
3848 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3849 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3853 /* Prevent another auto save till enough input events come in. */
3854 record_auto_save ();
3856 if (auto_saved
&& NILP (no_message
))
3859 message2 (omessage
, omessage_length
);
3861 message1 ("Auto-saving...done");
3867 unbind_to (count
, Qnil
);
3871 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3872 Sset_buffer_auto_saved
, 0, 0, 0,
3873 "Mark current buffer as auto-saved with its current text.\n\
3874 No auto-save file will be written until the buffer changes again.")
3877 current_buffer
->auto_save_modified
= MODIFF
;
3878 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3879 current_buffer
->auto_save_failure_time
= -1;
3883 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3884 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3885 "Clear any record of a recent auto-save failure in the current buffer.")
3888 current_buffer
->auto_save_failure_time
= -1;
3892 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3894 "Return t if buffer has been auto-saved since last read in or saved.")
3897 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3900 /* Reading and completing file names */
3901 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3903 /* In the string VAL, change each $ to $$ and return the result. */
3906 double_dollars (val
)
3909 register unsigned char *old
, *new;
3913 osize
= XSTRING (val
)->size
;
3914 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3915 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3916 if (*old
++ == '$') count
++;
3919 old
= XSTRING (val
)->data
;
3920 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3921 new = XSTRING (val
)->data
;
3922 for (n
= osize
; n
> 0; n
--)
3935 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3937 "Internal subroutine for read-file-name. Do not call this.")
3938 (string
, dir
, action
)
3939 Lisp_Object string
, dir
, action
;
3940 /* action is nil for complete, t for return list of completions,
3941 lambda for verify final value */
3943 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3945 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3952 /* No need to protect ACTION--we only compare it with t and nil. */
3953 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
3955 if (XSTRING (string
)->size
== 0)
3957 if (EQ (action
, Qlambda
))
3965 orig_string
= string
;
3966 string
= Fsubstitute_in_file_name (string
);
3967 changed
= NILP (Fstring_equal (string
, orig_string
));
3968 name
= Ffile_name_nondirectory (string
);
3969 val
= Ffile_name_directory (string
);
3971 realdir
= Fexpand_file_name (val
, realdir
);
3976 specdir
= Ffile_name_directory (string
);
3977 val
= Ffile_name_completion (name
, realdir
);
3982 return double_dollars (string
);
3986 if (!NILP (specdir
))
3987 val
= concat2 (specdir
, val
);
3989 return double_dollars (val
);
3992 #endif /* not VMS */
3996 if (EQ (action
, Qt
))
3997 return Ffile_name_all_completions (name
, realdir
);
3998 /* Only other case actually used is ACTION = lambda */
4000 /* Supposedly this helps commands such as `cd' that read directory names,
4001 but can someone explain how it helps them? -- RMS */
4002 if (XSTRING (name
)->size
== 0)
4005 return Ffile_exists_p (string
);
4008 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4009 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4010 Value is not expanded---you must call `expand-file-name' yourself.\n\
4011 Default name to DEFAULT if user enters a null string.\n\
4012 (If DEFAULT is omitted, the visited file name is used,\n\
4013 except that if INITIAL is specified, that combined with DIR is used.)\n\
4014 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4015 Non-nil and non-t means also require confirmation after completion.\n\
4016 Fifth arg INITIAL specifies text to start with.\n\
4017 DIR defaults to current buffer's directory default.")
4018 (prompt
, dir
, defalt
, mustmatch
, initial
)
4019 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4021 Lisp_Object val
, insdef
, insdef1
, tem
;
4022 struct gcpro gcpro1
, gcpro2
;
4023 register char *homedir
;
4027 dir
= current_buffer
->directory
;
4030 if (! NILP (initial
))
4031 defalt
= Fexpand_file_name (initial
, dir
);
4033 defalt
= current_buffer
->filename
;
4036 /* If dir starts with user's homedir, change that to ~. */
4037 homedir
= (char *) egetenv ("HOME");
4040 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4041 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4043 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4044 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4045 XSTRING (dir
)->data
[0] = '~';
4048 if (insert_default_directory
)
4051 if (!NILP (initial
))
4053 Lisp_Object args
[2], pos
;
4057 insdef
= Fconcat (2, args
);
4058 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4059 insdef1
= Fcons (double_dollars (insdef
), pos
);
4062 insdef1
= double_dollars (insdef
);
4064 else if (!NILP (initial
))
4067 insdef1
= Fcons (double_dollars (insdef
), 0);
4070 insdef
= Qnil
, insdef1
= Qnil
;
4073 count
= specpdl_ptr
- specpdl
;
4074 specbind (intern ("completion-ignore-case"), Qt
);
4077 GCPRO2 (insdef
, defalt
);
4078 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4079 dir
, mustmatch
, insdef1
,
4080 Qfile_name_history
);
4083 unbind_to (count
, Qnil
);
4088 error ("No file name specified");
4089 tem
= Fstring_equal (val
, insdef
);
4090 if (!NILP (tem
) && !NILP (defalt
))
4092 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4097 error ("No default file name");
4099 return Fsubstitute_in_file_name (val
);
4102 #if 0 /* Old version */
4103 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4104 /* Don't confuse make-docfile by having two doc strings for this function.
4105 make-docfile does not pay attention to #if, for good reason! */
4107 (prompt
, dir
, defalt
, mustmatch
, initial
)
4108 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4110 Lisp_Object val
, insdef
, tem
;
4111 struct gcpro gcpro1
, gcpro2
;
4112 register char *homedir
;
4116 dir
= current_buffer
->directory
;
4118 defalt
= current_buffer
->filename
;
4120 /* If dir starts with user's homedir, change that to ~. */
4121 homedir
= (char *) egetenv ("HOME");
4124 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4125 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4127 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4128 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4129 XSTRING (dir
)->data
[0] = '~';
4132 if (!NILP (initial
))
4134 else if (insert_default_directory
)
4137 insdef
= build_string ("");
4140 count
= specpdl_ptr
- specpdl
;
4141 specbind (intern ("completion-ignore-case"), Qt
);
4144 GCPRO2 (insdef
, defalt
);
4145 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4147 insert_default_directory
? insdef
: Qnil
,
4148 Qfile_name_history
);
4151 unbind_to (count
, Qnil
);
4156 error ("No file name specified");
4157 tem
= Fstring_equal (val
, insdef
);
4158 if (!NILP (tem
) && !NILP (defalt
))
4160 return Fsubstitute_in_file_name (val
);
4162 #endif /* Old version */
4166 Qexpand_file_name
= intern ("expand-file-name");
4167 Qdirectory_file_name
= intern ("directory-file-name");
4168 Qfile_name_directory
= intern ("file-name-directory");
4169 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4170 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4171 Qfile_name_as_directory
= intern ("file-name-as-directory");
4172 Qcopy_file
= intern ("copy-file");
4173 Qmake_directory_internal
= intern ("make-directory-internal");
4174 Qdelete_directory
= intern ("delete-directory");
4175 Qdelete_file
= intern ("delete-file");
4176 Qrename_file
= intern ("rename-file");
4177 Qadd_name_to_file
= intern ("add-name-to-file");
4178 Qmake_symbolic_link
= intern ("make-symbolic-link");
4179 Qfile_exists_p
= intern ("file-exists-p");
4180 Qfile_executable_p
= intern ("file-executable-p");
4181 Qfile_readable_p
= intern ("file-readable-p");
4182 Qfile_symlink_p
= intern ("file-symlink-p");
4183 Qfile_writable_p
= intern ("file-writable-p");
4184 Qfile_directory_p
= intern ("file-directory-p");
4185 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4186 Qfile_modes
= intern ("file-modes");
4187 Qset_file_modes
= intern ("set-file-modes");
4188 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4189 Qinsert_file_contents
= intern ("insert-file-contents");
4190 Qwrite_region
= intern ("write-region");
4191 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4192 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4193 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4195 staticpro (&Qexpand_file_name
);
4196 staticpro (&Qdirectory_file_name
);
4197 staticpro (&Qfile_name_directory
);
4198 staticpro (&Qfile_name_nondirectory
);
4199 staticpro (&Qunhandled_file_name_directory
);
4200 staticpro (&Qfile_name_as_directory
);
4201 staticpro (&Qcopy_file
);
4202 staticpro (&Qmake_directory_internal
);
4203 staticpro (&Qdelete_directory
);
4204 staticpro (&Qdelete_file
);
4205 staticpro (&Qrename_file
);
4206 staticpro (&Qadd_name_to_file
);
4207 staticpro (&Qmake_symbolic_link
);
4208 staticpro (&Qfile_exists_p
);
4209 staticpro (&Qfile_executable_p
);
4210 staticpro (&Qfile_readable_p
);
4211 staticpro (&Qfile_symlink_p
);
4212 staticpro (&Qfile_writable_p
);
4213 staticpro (&Qfile_directory_p
);
4214 staticpro (&Qfile_accessible_directory_p
);
4215 staticpro (&Qfile_modes
);
4216 staticpro (&Qset_file_modes
);
4217 staticpro (&Qfile_newer_than_file_p
);
4218 staticpro (&Qinsert_file_contents
);
4219 staticpro (&Qwrite_region
);
4220 staticpro (&Qverify_visited_file_modtime
);
4221 staticpro (&Qsubstitute_in_file_name
);
4223 Qfile_name_history
= intern ("file-name-history");
4224 Fset (Qfile_name_history
, Qnil
);
4225 staticpro (&Qfile_name_history
);
4227 Qfile_error
= intern ("file-error");
4228 staticpro (&Qfile_error
);
4229 Qfile_already_exists
= intern("file-already-exists");
4230 staticpro (&Qfile_already_exists
);
4233 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4234 staticpro (&Qfind_buffer_file_type
);
4237 Qcar_less_than_car
= intern ("car-less-than-car");
4238 staticpro (&Qcar_less_than_car
);
4240 Fput (Qfile_error
, Qerror_conditions
,
4241 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4242 Fput (Qfile_error
, Qerror_message
,
4243 build_string ("File error"));
4245 Fput (Qfile_already_exists
, Qerror_conditions
,
4246 Fcons (Qfile_already_exists
,
4247 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4248 Fput (Qfile_already_exists
, Qerror_message
,
4249 build_string ("File already exists"));
4251 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4252 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4253 insert_default_directory
= 1;
4255 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4256 "*Non-nil means write new files with record format `stmlf'.\n\
4257 nil means use format `var'. This variable is meaningful only on VMS.");
4258 vms_stmlf_recfm
= 0;
4260 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4261 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4262 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4265 The first argument given to HANDLER is the name of the I/O primitive\n\
4266 to be handled; the remaining arguments are the arguments that were\n\
4267 passed to that primitive. For example, if you do\n\
4268 (file-exists-p FILENAME)\n\
4269 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4270 (funcall HANDLER 'file-exists-p FILENAME)\n\
4271 The function `find-file-name-handler' checks this list for a handler\n\
4272 for its argument.");
4273 Vfile_name_handler_alist
= Qnil
;
4275 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4276 "A list of functions to be called at the end of `insert-file-contents'.\n\
4277 Each is passed one argument, the number of bytes inserted. It should return\n\
4278 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4279 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4280 responsible for calling the after-insert-file-functions if appropriate.");
4281 Vafter_insert_file_functions
= Qnil
;
4283 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4284 "A list of functions to be called at the start of `write-region'.\n\
4285 Each is passed two arguments, START and END as for `write-region'. It should\n\
4286 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4287 inserted at the specified positions of the file being written (1 means to\n\
4288 insert before the first byte written). The POSITIONs must be sorted into\n\
4289 increasing order. If there are several functions in the list, the several\n\
4290 lists are merged destructively.");
4291 Vwrite_region_annotate_functions
= Qnil
;
4293 DEFVAR_LISP ("write-region-annotations-so-far",
4294 &Vwrite_region_annotations_so_far
,
4295 "When an annotation function is called, this holds the previous annotations.\n\
4296 These are the annotations made by other annotation functions\n\
4297 that were already called. See also `write-region-annotate-functions'.");
4298 Vwrite_region_annotations_so_far
= Qnil
;
4300 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4301 "A list of file name handlers that temporarily should not be used.\n\
4302 This applies only to the operation `inhibit-file-name-operation'.");
4303 Vinhibit_file_name_handlers
= Qnil
;
4305 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4306 "The operation for which `inhibit-file-name-handlers' is applicable.");
4307 Vinhibit_file_name_operation
= Qnil
;
4309 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4310 "File name in which we write a list of all auto save file names.");
4311 Vauto_save_list_file_name
= Qnil
;
4313 defsubr (&Sfind_file_name_handler
);
4314 defsubr (&Sfile_name_directory
);
4315 defsubr (&Sfile_name_nondirectory
);
4316 defsubr (&Sunhandled_file_name_directory
);
4317 defsubr (&Sfile_name_as_directory
);
4318 defsubr (&Sdirectory_file_name
);
4319 defsubr (&Smake_temp_name
);
4320 defsubr (&Sexpand_file_name
);
4321 defsubr (&Ssubstitute_in_file_name
);
4322 defsubr (&Scopy_file
);
4323 defsubr (&Smake_directory_internal
);
4324 defsubr (&Sdelete_directory
);
4325 defsubr (&Sdelete_file
);
4326 defsubr (&Srename_file
);
4327 defsubr (&Sadd_name_to_file
);
4329 defsubr (&Smake_symbolic_link
);
4330 #endif /* S_IFLNK */
4332 defsubr (&Sdefine_logical_name
);
4335 defsubr (&Ssysnetunam
);
4336 #endif /* HPUX_NET */
4337 defsubr (&Sfile_name_absolute_p
);
4338 defsubr (&Sfile_exists_p
);
4339 defsubr (&Sfile_executable_p
);
4340 defsubr (&Sfile_readable_p
);
4341 defsubr (&Sfile_writable_p
);
4342 defsubr (&Sfile_symlink_p
);
4343 defsubr (&Sfile_directory_p
);
4344 defsubr (&Sfile_accessible_directory_p
);
4345 defsubr (&Sfile_regular_p
);
4346 defsubr (&Sfile_modes
);
4347 defsubr (&Sset_file_modes
);
4348 defsubr (&Sset_default_file_modes
);
4349 defsubr (&Sdefault_file_modes
);
4350 defsubr (&Sfile_newer_than_file_p
);
4351 defsubr (&Sinsert_file_contents
);
4352 defsubr (&Swrite_region
);
4353 defsubr (&Scar_less_than_car
);
4354 defsubr (&Sverify_visited_file_modtime
);
4355 defsubr (&Sclear_visited_file_modtime
);
4356 defsubr (&Svisited_file_modtime
);
4357 defsubr (&Sset_visited_file_modtime
);
4358 defsubr (&Sdo_auto_save
);
4359 defsubr (&Sset_buffer_auto_saved
);
4360 defsubr (&Sclear_buffer_auto_save_failure
);
4361 defsubr (&Srecent_auto_save_p
);
4363 defsubr (&Sread_file_name_internal
);
4364 defsubr (&Sread_file_name
);
4367 defsubr (&Sunix_sync
);