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] != '>'
314 /* Expansion of "c:" to drive and default directory. */
315 /* (NT does the right thing.) */
316 if (p
== beg
+ 2 && beg
[1] == ':')
318 int drive
= (*beg
) - 'a';
319 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
320 unsigned char *res
= alloca (MAXPATHLEN
+ 5);
324 /* The NT version places the drive letter at the beginning already. */
325 #else /* not WINDOWSNT */
326 /* On MSDOG we must put the drive letter in by hand. */
328 #endif /* not WINDOWSNT */
329 if (getdefdir (drive
+ 1, res
))
332 res
[0] = drive
+ 'a';
335 if (IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
338 p
= beg
+ strlen (beg
);
342 return make_string (beg
, p
- beg
);
345 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
347 "Return file name NAME sans its directory.\n\
348 For example, in a Unix-syntax file name,\n\
349 this is everything after the last slash,\n\
350 or the entire name if it contains no slash.")
354 register unsigned char *beg
, *p
, *end
;
357 CHECK_STRING (file
, 0);
359 /* If the file name has special constructs in it,
360 call the corresponding file handler. */
361 handler
= Ffind_file_name_handler (file
, Qfile_name_nondirectory
);
363 return call2 (handler
, Qfile_name_nondirectory
, file
);
365 beg
= XSTRING (file
)->data
;
366 end
= p
= beg
+ XSTRING (file
)->size
;
368 while (p
!= beg
&& !IS_ANY_SEP (p
[-1])
370 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
374 return make_string (p
, end
- p
);
377 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
378 "Return a directly usable directory name somehow associated with FILENAME.\n\
379 A `directly usable' directory name is one that may be used without the\n\
380 intervention of any file handler.\n\
381 If FILENAME is a directly usable file itself, return\n\
382 (file-name-directory FILENAME).\n\
383 The `call-process' and `start-process' functions use this function to\n\
384 get a current directory to run processes in.")
386 Lisp_Object filename
;
390 /* If the file name has special constructs in it,
391 call the corresponding file handler. */
392 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
394 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
396 return Ffile_name_directory (filename
);
401 file_name_as_directory (out
, in
)
404 int size
= strlen (in
) - 1;
409 /* Is it already a directory string? */
410 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
412 /* Is it a VMS directory file name? If so, hack VMS syntax. */
413 else if (! index (in
, '/')
414 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
415 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
416 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
417 || ! strncmp (&in
[size
- 5], ".dir", 4))
418 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
419 && in
[size
] == '1')))
421 register char *p
, *dot
;
425 dir:x.dir --> dir:[x]
426 dir:[x]y.dir --> dir:[x.y] */
428 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
431 strncpy (out
, in
, p
- in
);
450 dot
= index (p
, '.');
453 /* blindly remove any extension */
454 size
= strlen (out
) + (dot
- p
);
455 strncat (out
, p
, dot
- p
);
466 /* For Unix syntax, Append a slash if necessary */
467 if (!IS_ANY_SEP (out
[size
]))
469 out
[size
+ 1] = DIRECTORY_SEP
;
470 out
[size
+ 2] = '\0';
476 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
477 Sfile_name_as_directory
, 1, 1, 0,
478 "Return a string representing file FILENAME interpreted as a directory.\n\
479 This operation exists because a directory is also a file, but its name as\n\
480 a directory is different from its name as a file.\n\
481 The result can be used as the value of `default-directory'\n\
482 or passed as second argument to `expand-file-name'.\n\
483 For a Unix-syntax file name, just appends a slash.\n\
484 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
491 CHECK_STRING (file
, 0);
495 /* If the file name has special constructs in it,
496 call the corresponding file handler. */
497 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
499 return call2 (handler
, Qfile_name_as_directory
, file
);
501 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
502 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
506 * Convert from directory name to filename.
508 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
509 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
510 * On UNIX, it's simple: just make sure there is a terminating /
512 * Value is nonzero if the string output is different from the input.
515 directory_file_name (src
, dst
)
523 struct FAB fab
= cc$rms_fab
;
524 struct NAM nam
= cc$rms_nam
;
525 char esa
[NAM$C_MAXRSS
];
530 if (! index (src
, '/')
531 && (src
[slen
- 1] == ']'
532 || src
[slen
- 1] == ':'
533 || src
[slen
- 1] == '>'))
535 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
537 fab
.fab$b_fns
= slen
;
538 fab
.fab$l_nam
= &nam
;
539 fab
.fab$l_fop
= FAB$M_NAM
;
542 nam
.nam$b_ess
= sizeof esa
;
543 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
545 /* We call SYS$PARSE to handle such things as [--] for us. */
546 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
548 slen
= nam
.nam$b_esl
;
549 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
554 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
556 /* what about when we have logical_name:???? */
557 if (src
[slen
- 1] == ':')
558 { /* Xlate logical name and see what we get */
559 ptr
= strcpy (dst
, src
); /* upper case for getenv */
562 if ('a' <= *ptr
&& *ptr
<= 'z')
566 dst
[slen
- 1] = 0; /* remove colon */
567 if (!(src
= egetenv (dst
)))
569 /* should we jump to the beginning of this procedure?
570 Good points: allows us to use logical names that xlate
572 Bad points: can be a problem if we just translated to a device
574 For now, I'll punt and always expect VMS names, and hope for
577 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
578 { /* no recursion here! */
584 { /* not a directory spec */
589 bracket
= src
[slen
- 1];
591 /* If bracket is ']' or '>', bracket - 2 is the corresponding
593 ptr
= index (src
, bracket
- 2);
595 { /* no opening bracket */
599 if (!(rptr
= rindex (src
, '.')))
602 strncpy (dst
, src
, slen
);
606 dst
[slen
++] = bracket
;
611 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
612 then translate the device and recurse. */
613 if (dst
[slen
- 1] == ':'
614 && dst
[slen
- 2] != ':' /* skip decnet nodes */
615 && strcmp(src
+ slen
, "[000000]") == 0)
617 dst
[slen
- 1] = '\0';
618 if ((ptr
= egetenv (dst
))
619 && (rlen
= strlen (ptr
) - 1) > 0
620 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
621 && ptr
[rlen
- 1] == '.')
623 char * buf
= (char *) alloca (strlen (ptr
) + 1);
627 return directory_file_name (buf
, dst
);
632 strcat (dst
, "[000000]");
636 rlen
= strlen (rptr
) - 1;
637 strncat (dst
, rptr
, rlen
);
638 dst
[slen
+ rlen
] = '\0';
639 strcat (dst
, ".DIR.1");
643 /* Process as Unix format: just remove any final slash.
644 But leave "/" unchanged; do not change it to "". */
647 && IS_DIRECTORY_SEP (dst
[slen
- 1])
648 && !IS_DEVICE_SEP (dst
[slen
- 2]))
653 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
655 "Returns the file name of the directory named DIR.\n\
656 This is the name of the file that holds the data for the directory DIR.\n\
657 This operation exists because a directory is also a file, but its name as\n\
658 a directory is different from its name as a file.\n\
659 In Unix-syntax, this function just removes the final slash.\n\
660 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
661 it returns a file name such as \"[X]Y.DIR.1\".")
663 Lisp_Object directory
;
668 CHECK_STRING (directory
, 0);
670 if (NILP (directory
))
673 /* If the file name has special constructs in it,
674 call the corresponding file handler. */
675 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
677 return call2 (handler
, Qdirectory_file_name
, directory
);
680 /* 20 extra chars is insufficient for VMS, since we might perform a
681 logical name translation. an equivalence string can be up to 255
682 chars long, so grab that much extra space... - sss */
683 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
685 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
687 directory_file_name (XSTRING (directory
)->data
, buf
);
688 return build_string (buf
);
691 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
692 "Generate temporary file name (string) starting with PREFIX (a string).\n\
693 The Emacs process number forms part of the result,\n\
694 so there is no danger of generating a name being used by another process.")
699 val
= concat2 (prefix
, build_string ("XXXXXX"));
700 mktemp (XSTRING (val
)->data
);
704 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
705 "Convert FILENAME to absolute, and canonicalize it.\n\
706 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
707 (does not start with slash); if DEFAULT is nil or missing,\n\
708 the current buffer's value of default-directory is used.\n\
709 Path components that are `.' are removed, and \n\
710 path components followed by `..' are removed, along with the `..' itself;\n\
711 note that these simplifications are done without checking the resulting\n\
712 paths in the file system.\n\
713 An initial `~/' expands to your home directory.\n\
714 An initial `~USER/' expands to USER's home directory.\n\
715 See also the function `substitute-in-file-name'.")
717 Lisp_Object name
, defalt
;
721 register unsigned char *newdir
, *p
, *o
;
723 unsigned char *target
;
726 unsigned char * colon
= 0;
727 unsigned char * close
= 0;
728 unsigned char * slash
= 0;
729 unsigned char * brack
= 0;
730 int lbrack
= 0, rbrack
= 0;
734 /* Demacs 1.1.2 91/10/20 Manabu Higashida */
737 unsigned char *tmp
, *defdir
;
741 CHECK_STRING (name
, 0);
743 /* If the file name has special constructs in it,
744 call the corresponding file handler. */
745 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
747 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
749 /* Use the buffer's default-directory if DEFALT is omitted. */
751 defalt
= current_buffer
->directory
;
752 CHECK_STRING (defalt
, 1);
754 o
= XSTRING (defalt
)->data
;
756 /* Make sure DEFALT is properly expanded.
757 It would be better to do this down below where we actually use
758 defalt. Unfortunately, calling Fexpand_file_name recursively
759 could invoke GC, and the strings might be relocated. This would
760 be annoying because we have pointers into strings lying around
761 that would need adjusting, and people would add new pointers to
762 the code and forget to adjust them, resulting in intermittent bugs.
763 Putting this call here avoids all that crud.
765 The EQ test avoids infinite recursion. */
766 if (! NILP (defalt
) && !EQ (defalt
, name
)
767 /* This saves time in a common case. */
768 && ! (XSTRING (defalt
)->size
>= 3
769 && IS_DIRECTORY_SEP (XSTRING (defalt
)->data
[0])
770 && IS_DEVICE_SEP (XSTRING (defalt
)->data
[1])))
775 defalt
= Fexpand_file_name (defalt
, Qnil
);
780 /* Filenames on VMS are always upper case. */
781 name
= Fupcase (name
);
783 #ifdef FILE_SYSTEM_CASE
784 name
= FILE_SYSTEM_CASE (name
);
787 nm
= XSTRING (name
)->data
;
790 /* First map all backslashes to slashes. */
791 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
795 /* Now strip drive name. */
797 unsigned char *colon
= rindex (nm
, ':');
803 drive
= tolower (colon
[-1]) - 'a';
805 if (!IS_DIRECTORY_SEP (*nm
))
807 defdir
= alloca (MAXPATHLEN
+ 1);
808 relpath
= getdefdir (drive
+ 1, defdir
);
814 /* If nm is absolute, flush ...// and detect /./ and /../.
815 If no /./ or /../ we can return right away. */
817 IS_DIRECTORY_SEP (nm
[0])
823 /* If it turns out that the filename we want to return is just a
824 suffix of FILENAME, we don't need to go through and edit
825 things; we just need to construct a new string using data
826 starting at the middle of FILENAME. If we set lose to a
827 non-zero value, that means we've discovered that we can't do
834 /* Since we know the path is absolute, we can assume that each
835 element starts with a "/". */
837 /* "//" anywhere isn't necessarily hairy; we just start afresh
838 with the second slash. */
839 if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
841 /* // at start of filename is meaningful on Apollo system */
845 /* \\ or // at the start of a pathname is meaningful on NT. */
847 #endif /* WINDOWSNT */
851 /* "~" is hairy as the start of any path element. */
852 if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '~')
853 nm
= p
+ 1, lose
= 1;
855 /* "." and ".." are hairy. */
856 if (IS_DIRECTORY_SEP (p
[0])
858 && (IS_DIRECTORY_SEP (p
[2])
860 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
867 /* if dev:[dir]/, move nm to / */
868 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
869 nm
= (brack
? brack
+ 1 : colon
+ 1);
878 /* VMS pre V4.4,convert '-'s in filenames. */
879 if (lbrack
== rbrack
)
881 if (dots
< 2) /* this is to allow negative version numbers */
886 if (lbrack
> rbrack
&&
887 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
888 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
894 /* count open brackets, reset close bracket pointer */
895 if (p
[0] == '[' || p
[0] == '<')
897 /* count close brackets, set close bracket pointer */
898 if (p
[0] == ']' || p
[0] == '>')
900 /* detect ][ or >< */
901 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
903 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
904 nm
= p
+ 1, lose
= 1;
905 if (p
[0] == ':' && (colon
|| slash
))
906 /* if dev1:[dir]dev2:, move nm to dev2: */
912 /* if /pathname/dev:, move nm to dev: */
915 /* if node::dev:, move colon following dev */
916 else if (colon
&& colon
[-1] == ':')
918 /* if dev1:dev2:, move nm to dev2: */
919 else if (colon
&& colon
[-1] != ':')
924 if (p
[0] == ':' && !colon
)
930 if (lbrack
== rbrack
)
933 else if (p
[0] == '.')
942 return build_string (sys_translate_unix (nm
));
945 if (nm
== XSTRING (name
)->data
)
947 return build_string (nm
);
948 #endif /* not DOS_NT */
952 /* Now determine directory to start with and put it in newdir */
956 if (nm
[0] == '~') /* prefix ~ */
958 if (IS_DIRECTORY_SEP (nm
[1])
962 || nm
[1] == 0) /* ~ by itself */
964 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
965 newdir
= (unsigned char *) "";
967 dostounix_filename (newdir
);
971 nm
++; /* Don't leave the slash in nm. */
974 else /* ~user/filename */
976 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
981 o
= (unsigned char *) alloca (p
- nm
+ 1);
982 bcopy ((char *) nm
, o
, p
- nm
);
986 newdir
= (unsigned char *) egetenv ("HOME");
987 dostounix_filename (newdir
);
988 #else /* not WINDOWSNT */
989 pw
= (struct passwd
*) getpwnam (o
+ 1);
992 newdir
= (unsigned char *) pw
-> pw_dir
;
994 nm
= p
+ 1; /* skip the terminator */
999 #endif /* not WINDOWSNT */
1001 /* If we don't find a user of that name, leave the name
1002 unchanged; don't move nm forward to p. */
1006 if (!IS_ANY_SEP (nm
[0])
1009 #endif /* not VMS */
1015 newdir
= XSTRING (defalt
)->data
;
1019 if (newdir
== 0 && relpath
)
1024 /* Get rid of any slash at the end of newdir. */
1025 int length
= strlen (newdir
);
1026 /* Adding `length > 1 &&' makes ~ expand into / when homedir
1027 is the root dir. People disagree about whether that is right.
1028 Anyway, we can't take the risk of this change now. */
1030 if (newdir
[1] != ':' && length
> 1)
1032 if (IS_DIRECTORY_SEP (newdir
[length
- 1]))
1034 unsigned char *temp
= (unsigned char *) alloca (length
);
1035 bcopy (newdir
, temp
, length
- 1);
1036 temp
[length
- 1] = 0;
1044 /* Now concatenate the directory and name to new space in the stack frame */
1045 tlen
+= strlen (nm
) + 1;
1047 /* Add reserved space for drive name. (The Microsoft x86 compiler
1048 produces incorrect code if the following two lines are combined.) */
1049 target
= (unsigned char *) alloca (tlen
+ 2);
1051 #else /* not DOS_NT */
1052 target
= (unsigned char *) alloca (tlen
);
1053 #endif /* not DOS_NT */
1059 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1060 strcpy (target
, newdir
);
1063 file_name_as_directory (target
, newdir
);
1066 strcat (target
, nm
);
1068 if (index (target
, '/'))
1069 strcpy (target
, sys_translate_unix (target
));
1072 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1080 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1086 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1087 /* brackets are offset from each other by 2 */
1090 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1091 /* convert [foo][bar] to [bar] */
1092 while (o
[-1] != '[' && o
[-1] != '<')
1094 else if (*p
== '-' && *o
!= '.')
1097 else if (p
[0] == '-' && o
[-1] == '.' &&
1098 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1099 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1103 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1104 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1106 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1108 /* else [foo.-] ==> [-] */
1114 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1115 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1121 if (!IS_DIRECTORY_SEP (*p
))
1126 else if (!strncmp (p
, "\\\\", 2) || !strncmp (p
, "//", 2))
1127 #else /* not WINDOWSNT */
1128 else if (!strncmp (p
, "//", 2)
1129 #endif /* not WINDOWSNT */
1131 /* // at start of filename is meaningful in Apollo system */
1135 /* \\ at start of filename is meaningful in Windows-NT */
1137 #endif /* WINDOWSNT */
1143 else if (IS_DIRECTORY_SEP (p
[0])
1145 && (IS_DIRECTORY_SEP (p
[2])
1148 /* If "/." is the entire filename, keep the "/". Otherwise,
1149 just delete the whole "/.". */
1150 if (o
== target
&& p
[2] == '\0')
1155 else if (!strncmp (p
, "\\..", 3) || !strncmp (p
, "/..", 3))
1156 #else /* not WINDOWSNT */
1157 else if (!strncmp (p
, "/..", 3)
1158 #endif /* not WINDOWSNT */
1159 /* `/../' is the "superroot" on certain file systems. */
1161 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1163 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1166 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1171 if (o
== target
+ 1 && (o
[-1] == '/' && o
[0] == '/')
1172 || (o
[-1] == '\\' && o
[0] == '\\'))
1175 #endif /* WINDOWSNT */
1176 if (o
== target
&& IS_ANY_SEP (*o
))
1184 #endif /* not VMS */
1188 /* at last, set drive name. */
1189 if (target
[1] != ':'
1191 /* Allow network paths that look like "\\foo" */
1192 && !(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1]))
1193 #endif /* WINDOWSNT */
1197 target
[0] = (drive
< 0 ? getdisk () : drive
) + 'a';
1202 return make_string (target
, o
- target
);
1206 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1207 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1208 "Convert FILENAME to absolute, and canonicalize it.\n\
1209 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1210 (does not start with slash); if DEFAULT is nil or missing,\n\
1211 the current buffer's value of default-directory is used.\n\
1212 Filenames containing `.' or `..' as components are simplified;\n\
1213 initial `~/' expands to your home directory.\n\
1214 See also the function `substitute-in-file-name'.")
1216 Lisp_Object name
, defalt
;
1220 register unsigned char *newdir
, *p
, *o
;
1222 unsigned char *target
;
1226 unsigned char * colon
= 0;
1227 unsigned char * close
= 0;
1228 unsigned char * slash
= 0;
1229 unsigned char * brack
= 0;
1230 int lbrack
= 0, rbrack
= 0;
1234 CHECK_STRING (name
, 0);
1237 /* Filenames on VMS are always upper case. */
1238 name
= Fupcase (name
);
1241 nm
= XSTRING (name
)->data
;
1243 /* If nm is absolute, flush ...// and detect /./ and /../.
1244 If no /./ or /../ we can return right away. */
1256 if (p
[0] == '/' && p
[1] == '/'
1258 /* // at start of filename is meaningful on Apollo system */
1263 if (p
[0] == '/' && p
[1] == '~')
1264 nm
= p
+ 1, lose
= 1;
1265 if (p
[0] == '/' && p
[1] == '.'
1266 && (p
[2] == '/' || p
[2] == 0
1267 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1273 /* if dev:[dir]/, move nm to / */
1274 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1275 nm
= (brack
? brack
+ 1 : colon
+ 1);
1276 lbrack
= rbrack
= 0;
1284 /* VMS pre V4.4,convert '-'s in filenames. */
1285 if (lbrack
== rbrack
)
1287 if (dots
< 2) /* this is to allow negative version numbers */
1292 if (lbrack
> rbrack
&&
1293 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1294 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1300 /* count open brackets, reset close bracket pointer */
1301 if (p
[0] == '[' || p
[0] == '<')
1302 lbrack
++, brack
= 0;
1303 /* count close brackets, set close bracket pointer */
1304 if (p
[0] == ']' || p
[0] == '>')
1305 rbrack
++, brack
= p
;
1306 /* detect ][ or >< */
1307 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1309 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1310 nm
= p
+ 1, lose
= 1;
1311 if (p
[0] == ':' && (colon
|| slash
))
1312 /* if dev1:[dir]dev2:, move nm to dev2: */
1318 /* if /pathname/dev:, move nm to dev: */
1321 /* if node::dev:, move colon following dev */
1322 else if (colon
&& colon
[-1] == ':')
1324 /* if dev1:dev2:, move nm to dev2: */
1325 else if (colon
&& colon
[-1] != ':')
1330 if (p
[0] == ':' && !colon
)
1336 if (lbrack
== rbrack
)
1339 else if (p
[0] == '.')
1347 if (index (nm
, '/'))
1348 return build_string (sys_translate_unix (nm
));
1350 if (nm
== XSTRING (name
)->data
)
1352 return build_string (nm
);
1356 /* Now determine directory to start with and put it in NEWDIR */
1360 if (nm
[0] == '~') /* prefix ~ */
1365 || nm
[1] == 0)/* ~/filename */
1367 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1368 newdir
= (unsigned char *) "";
1371 nm
++; /* Don't leave the slash in nm. */
1374 else /* ~user/filename */
1376 /* Get past ~ to user */
1377 unsigned char *user
= nm
+ 1;
1378 /* Find end of name. */
1379 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1380 int len
= ptr
? ptr
- user
: strlen (user
);
1382 unsigned char *ptr1
= index (user
, ':');
1383 if (ptr1
!= 0 && ptr1
- user
< len
)
1386 /* Copy the user name into temp storage. */
1387 o
= (unsigned char *) alloca (len
+ 1);
1388 bcopy ((char *) user
, o
, len
);
1391 /* Look up the user name. */
1392 pw
= (struct passwd
*) getpwnam (o
+ 1);
1394 error ("\"%s\" isn't a registered user", o
+ 1);
1396 newdir
= (unsigned char *) pw
->pw_dir
;
1398 /* Discard the user name from NM. */
1405 #endif /* not VMS */
1409 defalt
= current_buffer
->directory
;
1410 CHECK_STRING (defalt
, 1);
1411 newdir
= XSTRING (defalt
)->data
;
1414 /* Now concatenate the directory and name to new space in the stack frame */
1416 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1417 target
= (unsigned char *) alloca (tlen
);
1423 if (nm
[0] == 0 || nm
[0] == '/')
1424 strcpy (target
, newdir
);
1427 file_name_as_directory (target
, newdir
);
1430 strcat (target
, nm
);
1432 if (index (target
, '/'))
1433 strcpy (target
, sys_translate_unix (target
));
1436 /* Now canonicalize by removing /. and /foo/.. if they appear */
1444 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1450 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1451 /* brackets are offset from each other by 2 */
1454 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1455 /* convert [foo][bar] to [bar] */
1456 while (o
[-1] != '[' && o
[-1] != '<')
1458 else if (*p
== '-' && *o
!= '.')
1461 else if (p
[0] == '-' && o
[-1] == '.' &&
1462 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1463 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1467 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1468 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1470 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1472 /* else [foo.-] ==> [-] */
1478 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1479 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1489 else if (!strncmp (p
, "//", 2)
1491 /* // at start of filename is meaningful in Apollo system */
1499 else if (p
[0] == '/' && p
[1] == '.' &&
1500 (p
[2] == '/' || p
[2] == 0))
1502 else if (!strncmp (p
, "/..", 3)
1503 /* `/../' is the "superroot" on certain file systems. */
1505 && (p
[3] == '/' || p
[3] == 0))
1507 while (o
!= target
&& *--o
!= '/')
1510 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1514 if (o
== target
&& *o
== '/')
1522 #endif /* not VMS */
1525 return make_string (target
, o
- target
);
1529 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1530 Ssubstitute_in_file_name
, 1, 1, 0,
1531 "Substitute environment variables referred to in FILENAME.\n\
1532 `$FOO' where FOO is an environment variable name means to substitute\n\
1533 the value of that variable. The variable name should be terminated\n\
1534 with a character not a letter, digit or underscore; otherwise, enclose\n\
1535 the entire variable name in braces.\n\
1536 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1537 On VMS, `$' substitution is not done; this function does little and only\n\
1538 duplicates what `expand-file-name' does.")
1544 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1545 unsigned char *target
;
1547 int substituted
= 0;
1549 Lisp_Object handler
;
1551 CHECK_STRING (string
, 0);
1553 /* If the file name has special constructs in it,
1554 call the corresponding file handler. */
1555 handler
= Ffind_file_name_handler (string
, Qsubstitute_in_file_name
);
1556 if (!NILP (handler
))
1557 return call2 (handler
, Qsubstitute_in_file_name
, string
);
1559 nm
= XSTRING (string
)->data
;
1561 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
1562 substituted
= !strcmp (nm
, XSTRING (string
)->data
);
1564 endp
= nm
+ XSTRING (string
)->size
;
1566 /* If /~ or // appears, discard everything through first slash. */
1568 for (p
= nm
; p
!= endp
; p
++)
1572 /* // at start of file name is meaningful in Apollo system */
1573 (p
[0] == '/' && p
- 1 != nm
)
1574 #else /* not APOLLO */
1576 (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1577 #else /* not WINDOWSNT */
1579 #endif /* not WINDOWSNT */
1580 #endif /* not APOLLO */
1585 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1587 || IS_DIRECTORY_SEP (p
[-1])))
1593 if (p
[0] && p
[1] == ':')
1602 return build_string (nm
);
1605 /* See if any variables are substituted into the string
1606 and find the total length of their values in `total' */
1608 for (p
= nm
; p
!= endp
;)
1618 /* "$$" means a single "$" */
1627 while (p
!= endp
&& *p
!= '}') p
++;
1628 if (*p
!= '}') goto missingclose
;
1634 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1638 /* Copy out the variable name */
1639 target
= (unsigned char *) alloca (s
- o
+ 1);
1640 strncpy (target
, o
, s
- o
);
1643 strupr (target
); /* $home == $HOME etc. */
1646 /* Get variable value */
1647 o
= (unsigned char *) egetenv (target
);
1648 if (!o
) goto badvar
;
1649 total
+= strlen (o
);
1656 /* If substitution required, recopy the string and do it */
1657 /* Make space in stack frame for the new copy */
1658 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1661 /* Copy the rest of the name through, replacing $ constructs with values */
1678 while (p
!= endp
&& *p
!= '}') p
++;
1679 if (*p
!= '}') goto missingclose
;
1685 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1689 /* Copy out the variable name */
1690 target
= (unsigned char *) alloca (s
- o
+ 1);
1691 strncpy (target
, o
, s
- o
);
1694 strupr (target
); /* $home == $HOME etc. */
1697 /* Get variable value */
1698 o
= (unsigned char *) egetenv (target
);
1708 /* If /~ or // appears, discard everything through first slash. */
1710 for (p
= xnm
; p
!= x
; p
++)
1713 /* // at start of file name is meaningful in Apollo system */
1714 || (p
[0] == '/' && p
- 1 != xnm
)
1715 #else /* not APOLLO */
1717 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1718 #else /* not WINDOWSNT */
1720 #endif /* not WINDOWSNT */
1721 #endif /* not APOLLO */
1723 && p
!= nm
&& IS_DIRECTORY_SEP (p
[-1]))
1726 else if (p
[0] && p
[1] == ':')
1730 return make_string (xnm
, x
- xnm
);
1733 error ("Bad format environment-variable substitution");
1735 error ("Missing \"}\" in environment-variable substitution");
1737 error ("Substituting nonexistent environment variable \"%s\"", target
);
1740 #endif /* not VMS */
1743 /* A slightly faster and more convenient way to get
1744 (directory-file-name (expand-file-name FOO)). */
1747 expand_and_dir_to_file (filename
, defdir
)
1748 Lisp_Object filename
, defdir
;
1750 register Lisp_Object abspath
;
1752 abspath
= Fexpand_file_name (filename
, defdir
);
1755 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1756 if (c
== ':' || c
== ']' || c
== '>')
1757 abspath
= Fdirectory_file_name (abspath
);
1760 /* Remove final slash, if any (unless path is root).
1761 stat behaves differently depending! */
1762 if (XSTRING (abspath
)->size
> 1
1763 && IS_DIRECTORY_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1])
1764 && !IS_DEVICE_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
-2]))
1765 /* We cannot take shortcuts; they might be wrong for magic file names. */
1766 abspath
= Fdirectory_file_name (abspath
);
1772 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1773 Lisp_Object absname
;
1774 unsigned char *querystring
;
1777 register Lisp_Object tem
;
1778 struct stat statbuf
;
1779 struct gcpro gcpro1
;
1781 /* stat is a good way to tell whether the file exists,
1782 regardless of what access permissions it has. */
1783 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1786 Fsignal (Qfile_already_exists
,
1787 Fcons (build_string ("File already exists"),
1788 Fcons (absname
, Qnil
)));
1790 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1791 XSTRING (absname
)->data
, querystring
));
1794 Fsignal (Qfile_already_exists
,
1795 Fcons (build_string ("File already exists"),
1796 Fcons (absname
, Qnil
)));
1801 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1802 "fCopy file: \nFCopy %s to file: \np\nP",
1803 "Copy FILE to NEWNAME. Both args must be strings.\n\
1804 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1805 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1806 A number as third arg means request confirmation if NEWNAME already exists.\n\
1807 This is what happens in interactive use with M-x.\n\
1808 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1809 last-modified time as the old one. (This works on only some systems.)\n\
1810 A prefix arg makes KEEP-TIME non-nil.")
1811 (filename
, newname
, ok_if_already_exists
, keep_date
)
1812 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1815 char buf
[16 * 1024];
1817 Lisp_Object handler
;
1818 struct gcpro gcpro1
, gcpro2
;
1819 int count
= specpdl_ptr
- specpdl
;
1820 int input_file_statable_p
;
1822 GCPRO2 (filename
, newname
);
1823 CHECK_STRING (filename
, 0);
1824 CHECK_STRING (newname
, 1);
1825 filename
= Fexpand_file_name (filename
, Qnil
);
1826 newname
= Fexpand_file_name (newname
, Qnil
);
1828 /* If the input file name has special constructs in it,
1829 call the corresponding file handler. */
1830 handler
= Ffind_file_name_handler (filename
, Qcopy_file
);
1831 /* Likewise for output file name. */
1833 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1834 if (!NILP (handler
))
1835 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, filename
, newname
,
1836 ok_if_already_exists
, keep_date
));
1838 if (NILP (ok_if_already_exists
)
1839 || INTEGERP (ok_if_already_exists
))
1840 barf_or_query_if_file_exists (newname
, "copy to it",
1841 INTEGERP (ok_if_already_exists
));
1843 ifd
= open (XSTRING (filename
)->data
, O_RDONLY
);
1845 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1847 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1849 /* We can only copy regular files and symbolic links. Other files are not
1851 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1853 #if defined (S_ISREG) && defined (S_ISLNK)
1854 if (input_file_statable_p
)
1856 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1858 #if defined (EISDIR)
1859 /* Get a better looking error message. */
1862 report_file_error ("Non-regular file", Fcons (filename
, Qnil
));
1865 #endif /* S_ISREG && S_ISLNK */
1868 /* Create the copy file with the same record format as the input file */
1869 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1872 /* System's default file type was set to binary by _fmode in emacs.c. */
1873 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1874 #else /* not MSDOS */
1875 ofd
= creat (XSTRING (newname
)->data
, 0666);
1876 #endif /* not MSDOS */
1879 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1881 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1885 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1886 if (write (ofd
, buf
, n
) != n
)
1887 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1890 /* Closing the output clobbers the file times on some systems. */
1891 if (close (ofd
) < 0)
1892 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1894 if (input_file_statable_p
)
1896 if (!NILP (keep_date
))
1898 EMACS_TIME atime
, mtime
;
1899 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1900 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1901 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
1902 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1905 if (!egetenv ("USE_DOMAIN_ACLS"))
1907 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1912 /* Discard the unwind protects. */
1913 specpdl_ptr
= specpdl
+ count
;
1919 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1920 Smake_directory_internal
, 1, 1, 0,
1921 "Create a directory. One argument, a file name string.")
1923 Lisp_Object dirname
;
1926 Lisp_Object handler
;
1928 CHECK_STRING (dirname
, 0);
1929 dirname
= Fexpand_file_name (dirname
, Qnil
);
1931 handler
= Ffind_file_name_handler (dirname
, Qmake_directory_internal
);
1932 if (!NILP (handler
))
1933 return call2 (handler
, Qmake_directory_internal
, dirname
);
1935 dir
= XSTRING (dirname
)->data
;
1938 if (mkdir (dir
) != 0)
1940 if (mkdir (dir
, 0777) != 0)
1942 report_file_error ("Creating directory", Flist (1, &dirname
));
1947 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1948 "Delete a directory. One argument, a file name or directory name string.")
1950 Lisp_Object dirname
;
1953 Lisp_Object handler
;
1955 CHECK_STRING (dirname
, 0);
1956 dirname
= Fdirectory_file_name (Fexpand_file_name (dirname
, Qnil
));
1957 dir
= XSTRING (dirname
)->data
;
1959 handler
= Ffind_file_name_handler (dirname
, Qdelete_directory
);
1960 if (!NILP (handler
))
1961 return call2 (handler
, Qdelete_directory
, dirname
);
1963 if (rmdir (dir
) != 0)
1964 report_file_error ("Removing directory", Flist (1, &dirname
));
1969 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1970 "Delete specified file. One argument, a file name string.\n\
1971 If file has multiple names, it continues to exist with the other names.")
1973 Lisp_Object filename
;
1975 Lisp_Object handler
;
1976 CHECK_STRING (filename
, 0);
1977 filename
= Fexpand_file_name (filename
, Qnil
);
1979 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
1980 if (!NILP (handler
))
1981 return call2 (handler
, Qdelete_file
, filename
);
1983 if (0 > unlink (XSTRING (filename
)->data
))
1984 report_file_error ("Removing old name", Flist (1, &filename
));
1989 internal_delete_file_1 (ignore
)
1995 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1998 internal_delete_file (filename
)
1999 Lisp_Object filename
;
2001 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2002 Qt
, internal_delete_file_1
));
2005 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2006 "fRename file: \nFRename %s to file: \np",
2007 "Rename FILE as NEWNAME. Both args strings.\n\
2008 If file has names other than FILE, it continues to have those names.\n\
2009 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2010 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2011 A number as third arg means request confirmation if NEWNAME already exists.\n\
2012 This is what happens in interactive use with M-x.")
2013 (filename
, newname
, ok_if_already_exists
)
2014 Lisp_Object filename
, newname
, ok_if_already_exists
;
2017 Lisp_Object args
[2];
2019 Lisp_Object handler
;
2020 struct gcpro gcpro1
, gcpro2
;
2022 GCPRO2 (filename
, newname
);
2023 CHECK_STRING (filename
, 0);
2024 CHECK_STRING (newname
, 1);
2025 filename
= Fexpand_file_name (filename
, Qnil
);
2026 newname
= Fexpand_file_name (newname
, Qnil
);
2028 /* If the file name has special constructs in it,
2029 call the corresponding file handler. */
2030 handler
= Ffind_file_name_handler (filename
, Qrename_file
);
2032 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2033 if (!NILP (handler
))
2034 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2035 filename
, newname
, ok_if_already_exists
));
2037 if (NILP (ok_if_already_exists
)
2038 || INTEGERP (ok_if_already_exists
))
2039 barf_or_query_if_file_exists (newname
, "rename to it",
2040 INTEGERP (ok_if_already_exists
));
2042 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2045 if (!MoveFile (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2046 #else /* not WINDOWSNT */
2047 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
2048 || 0 > unlink (XSTRING (filename
)->data
))
2049 #endif /* not WINDOWSNT */
2053 /* Why two? And why doesn't MS document what MoveFile will return? */
2054 if (GetLastError () == ERROR_FILE_EXISTS
2055 || GetLastError () == ERROR_ALREADY_EXISTS
)
2056 #else /* not WINDOWSNT */
2058 #endif /* not WINDOWSNT */
2060 Fcopy_file (filename
, newname
,
2061 /* We have already prompted if it was an integer,
2062 so don't have copy-file prompt again. */
2063 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2064 Fdelete_file (filename
);
2071 report_file_error ("Renaming", Flist (2, args
));
2074 report_file_error ("Renaming", Flist (2, &filename
));
2081 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2082 "fAdd name to file: \nFName to add to %s: \np",
2083 "Give FILE additional name NEWNAME. Both args strings.\n\
2084 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2085 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2086 A number as third arg means request confirmation if NEWNAME already exists.\n\
2087 This is what happens in interactive use with M-x.")
2088 (filename
, newname
, ok_if_already_exists
)
2089 Lisp_Object filename
, newname
, ok_if_already_exists
;
2092 Lisp_Object args
[2];
2094 Lisp_Object handler
;
2095 struct gcpro gcpro1
, gcpro2
;
2097 GCPRO2 (filename
, newname
);
2098 CHECK_STRING (filename
, 0);
2099 CHECK_STRING (newname
, 1);
2100 filename
= Fexpand_file_name (filename
, Qnil
);
2101 newname
= Fexpand_file_name (newname
, Qnil
);
2103 /* If the file name has special constructs in it,
2104 call the corresponding file handler. */
2105 handler
= Ffind_file_name_handler (filename
, Qadd_name_to_file
);
2106 if (!NILP (handler
))
2107 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
2108 newname
, ok_if_already_exists
));
2110 if (NILP (ok_if_already_exists
)
2111 || INTEGERP (ok_if_already_exists
))
2112 barf_or_query_if_file_exists (newname
, "make it a new name",
2113 INTEGERP (ok_if_already_exists
));
2115 /* Windows does not support this operation. */
2116 report_file_error ("Adding new name", Flist (2, &filename
));
2117 #else /* not WINDOWSNT */
2119 unlink (XSTRING (newname
)->data
);
2120 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2125 report_file_error ("Adding new name", Flist (2, args
));
2127 report_file_error ("Adding new name", Flist (2, &filename
));
2130 #endif /* not WINDOWSNT */
2137 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2138 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2139 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2140 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2141 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2142 A number as third arg means request confirmation if LINKNAME already exists.\n\
2143 This happens for interactive use with M-x.")
2144 (filename
, linkname
, ok_if_already_exists
)
2145 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2148 Lisp_Object args
[2];
2150 Lisp_Object handler
;
2151 struct gcpro gcpro1
, gcpro2
;
2153 GCPRO2 (filename
, linkname
);
2154 CHECK_STRING (filename
, 0);
2155 CHECK_STRING (linkname
, 1);
2156 /* If the link target has a ~, we must expand it to get
2157 a truly valid file name. Otherwise, do not expand;
2158 we want to permit links to relative file names. */
2159 if (XSTRING (filename
)->data
[0] == '~')
2160 filename
= Fexpand_file_name (filename
, Qnil
);
2161 linkname
= Fexpand_file_name (linkname
, Qnil
);
2163 /* If the file name has special constructs in it,
2164 call the corresponding file handler. */
2165 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2166 if (!NILP (handler
))
2167 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2168 linkname
, ok_if_already_exists
));
2170 if (NILP (ok_if_already_exists
)
2171 || INTEGERP (ok_if_already_exists
))
2172 barf_or_query_if_file_exists (linkname
, "make it a link",
2173 INTEGERP (ok_if_already_exists
));
2174 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2176 /* If we didn't complain already, silently delete existing file. */
2177 if (errno
== EEXIST
)
2179 unlink (XSTRING (linkname
)->data
);
2180 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2190 report_file_error ("Making symbolic link", Flist (2, args
));
2192 report_file_error ("Making symbolic link", Flist (2, &filename
));
2198 #endif /* S_IFLNK */
2202 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2203 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2204 "Define the job-wide logical name NAME to have the value STRING.\n\
2205 If STRING is nil or a null string, the logical name NAME is deleted.")
2207 Lisp_Object varname
;
2210 CHECK_STRING (varname
, 0);
2212 delete_logical_name (XSTRING (varname
)->data
);
2215 CHECK_STRING (string
, 1);
2217 if (XSTRING (string
)->size
== 0)
2218 delete_logical_name (XSTRING (varname
)->data
);
2220 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2229 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2230 "Open a network connection to PATH using LOGIN as the login string.")
2232 Lisp_Object path
, login
;
2236 CHECK_STRING (path
, 0);
2237 CHECK_STRING (login
, 0);
2239 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2241 if (netresult
== -1)
2246 #endif /* HPUX_NET */
2248 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2250 "Return t if file FILENAME specifies an absolute path name.\n\
2251 On Unix, this is a name starting with a `/' or a `~'.")
2253 Lisp_Object filename
;
2257 CHECK_STRING (filename
, 0);
2258 ptr
= XSTRING (filename
)->data
;
2259 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2261 /* ??? This criterion is probably wrong for '<'. */
2262 || index (ptr
, ':') || index (ptr
, '<')
2263 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2267 || (*ptr
!= 0 && ptr
[1] == ':' && (ptr
[2] == '/' || ptr
[2] == '\\'))
2275 /* Return nonzero if file FILENAME exists and can be executed. */
2278 check_executable (filename
)
2282 return (eaccess (filename
, 1) >= 0);
2284 /* Access isn't quite right because it uses the real uid
2285 and we really want to test with the effective uid.
2286 But Unix doesn't give us a right way to do it. */
2287 return (access (filename
, 1) >= 0);
2291 /* Return nonzero if file FILENAME exists and can be written. */
2294 check_writable (filename
)
2298 return (eaccess (filename
, 2) >= 0);
2300 /* Access isn't quite right because it uses the real uid
2301 and we really want to test with the effective uid.
2302 But Unix doesn't give us a right way to do it.
2303 Opening with O_WRONLY could work for an ordinary file,
2304 but would lose for directories. */
2305 return (access (filename
, 2) >= 0);
2309 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2310 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2311 See also `file-readable-p' and `file-attributes'.")
2313 Lisp_Object filename
;
2315 Lisp_Object abspath
;
2316 Lisp_Object handler
;
2317 struct stat statbuf
;
2319 CHECK_STRING (filename
, 0);
2320 abspath
= Fexpand_file_name (filename
, Qnil
);
2322 /* If the file name has special constructs in it,
2323 call the corresponding file handler. */
2324 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2325 if (!NILP (handler
))
2326 return call2 (handler
, Qfile_exists_p
, abspath
);
2328 return (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2331 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2332 "Return t if FILENAME can be executed by you.\n\
2333 For a directory, this means you can access files in that directory.")
2335 Lisp_Object filename
;
2338 Lisp_Object abspath
;
2339 Lisp_Object handler
;
2341 CHECK_STRING (filename
, 0);
2342 abspath
= Fexpand_file_name (filename
, Qnil
);
2344 /* If the file name has special constructs in it,
2345 call the corresponding file handler. */
2346 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2347 if (!NILP (handler
))
2348 return call2 (handler
, Qfile_executable_p
, abspath
);
2350 return (check_executable (XSTRING (abspath
)->data
) ? Qt
: Qnil
);
2353 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2354 "Return t if file FILENAME exists and you can read it.\n\
2355 See also `file-exists-p' and `file-attributes'.")
2357 Lisp_Object filename
;
2359 Lisp_Object abspath
;
2360 Lisp_Object handler
;
2363 CHECK_STRING (filename
, 0);
2364 abspath
= Fexpand_file_name (filename
, Qnil
);
2366 /* If the file name has special constructs in it,
2367 call the corresponding file handler. */
2368 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2369 if (!NILP (handler
))
2370 return call2 (handler
, Qfile_readable_p
, abspath
);
2372 desc
= open (XSTRING (abspath
)->data
, O_RDONLY
);
2379 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2381 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2382 "Return t if file FILENAME can be written or created by you.")
2384 Lisp_Object filename
;
2386 Lisp_Object abspath
, dir
;
2387 Lisp_Object handler
;
2388 struct stat statbuf
;
2390 CHECK_STRING (filename
, 0);
2391 abspath
= Fexpand_file_name (filename
, Qnil
);
2393 /* If the file name has special constructs in it,
2394 call the corresponding file handler. */
2395 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2396 if (!NILP (handler
))
2397 return call2 (handler
, Qfile_writable_p
, abspath
);
2399 if (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0)
2400 return (check_writable (XSTRING (abspath
)->data
)
2402 dir
= Ffile_name_directory (abspath
);
2405 dir
= Fdirectory_file_name (dir
);
2409 dir
= Fdirectory_file_name (dir
);
2411 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2415 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2416 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2417 The value is the name of the file to which it is linked.\n\
2418 Otherwise returns nil.")
2420 Lisp_Object filename
;
2427 Lisp_Object handler
;
2429 CHECK_STRING (filename
, 0);
2430 filename
= Fexpand_file_name (filename
, Qnil
);
2432 /* If the file name has special constructs in it,
2433 call the corresponding file handler. */
2434 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2435 if (!NILP (handler
))
2436 return call2 (handler
, Qfile_symlink_p
, filename
);
2441 buf
= (char *) xmalloc (bufsize
);
2442 bzero (buf
, bufsize
);
2443 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2444 if (valsize
< bufsize
) break;
2445 /* Buffer was not long enough */
2454 val
= make_string (buf
, valsize
);
2457 #else /* not S_IFLNK */
2459 #endif /* not S_IFLNK */
2462 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2463 "Return t if file FILENAME is the name of a directory as a file.\n\
2464 A directory name spec may be given instead; then the value is t\n\
2465 if the directory so specified exists and really is a directory.")
2467 Lisp_Object filename
;
2469 register Lisp_Object abspath
;
2471 Lisp_Object handler
;
2473 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2475 /* If the file name has special constructs in it,
2476 call the corresponding file handler. */
2477 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2478 if (!NILP (handler
))
2479 return call2 (handler
, Qfile_directory_p
, abspath
);
2481 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2483 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2486 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2487 "Return t if file FILENAME is the name of a directory as a file,\n\
2488 and files in that directory can be opened by you. In order to use a\n\
2489 directory as a buffer's current directory, this predicate must return true.\n\
2490 A directory name spec may be given instead; then the value is t\n\
2491 if the directory so specified exists and really is a readable and\n\
2492 searchable directory.")
2494 Lisp_Object filename
;
2496 Lisp_Object handler
;
2498 struct gcpro gcpro1
;
2500 /* If the file name has special constructs in it,
2501 call the corresponding file handler. */
2502 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2503 if (!NILP (handler
))
2504 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2506 /* It's an unlikely combination, but yes we really do need to gcpro:
2507 Suppose that file-accessible-directory-p has no handler, but
2508 file-directory-p does have a handler; this handler causes a GC which
2509 relocates the string in `filename'; and finally file-directory-p
2510 returns non-nil. Then we would end up passing a garbaged string
2511 to file-executable-p. */
2513 tem
= (NILP (Ffile_directory_p (filename
))
2514 || NILP (Ffile_executable_p (filename
)));
2516 return tem
? Qnil
: Qt
;
2519 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2520 "Return t if file FILENAME is the name of a regular file.\n\
2521 This is the sort of file that holds an ordinary stream of data bytes.")
2523 Lisp_Object filename
;
2525 register Lisp_Object abspath
;
2527 Lisp_Object handler
;
2529 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2531 /* If the file name has special constructs in it,
2532 call the corresponding file handler. */
2533 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2534 if (!NILP (handler
))
2535 return call2 (handler
, Qfile_directory_p
, abspath
);
2537 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2539 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2542 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2543 "Return mode bits of FILE, as an integer.")
2545 Lisp_Object filename
;
2547 Lisp_Object abspath
;
2549 Lisp_Object handler
;
2551 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2553 /* If the file name has special constructs in it,
2554 call the corresponding file handler. */
2555 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2556 if (!NILP (handler
))
2557 return call2 (handler
, Qfile_modes
, abspath
);
2559 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2565 if (S_ISREG (st
.st_mode
)
2566 && (len
= XSTRING (abspath
)->size
) >= 5
2567 && (stricmp ((suffix
= XSTRING (abspath
)->data
+ len
-4), ".com") == 0
2568 || stricmp (suffix
, ".exe") == 0
2569 || stricmp (suffix
, ".bat") == 0))
2570 st
.st_mode
|= S_IEXEC
;
2574 return make_number (st
.st_mode
& 07777);
2577 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2578 "Set mode bits of FILE to MODE (an integer).\n\
2579 Only the 12 low bits of MODE are used.")
2581 Lisp_Object filename
, mode
;
2583 Lisp_Object abspath
;
2584 Lisp_Object handler
;
2586 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2587 CHECK_NUMBER (mode
, 1);
2589 /* If the file name has special constructs in it,
2590 call the corresponding file handler. */
2591 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2592 if (!NILP (handler
))
2593 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2596 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2597 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2599 if (!egetenv ("USE_DOMAIN_ACLS"))
2602 struct timeval tvp
[2];
2604 /* chmod on apollo also change the file's modtime; need to save the
2605 modtime and then restore it. */
2606 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2608 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2612 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2613 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2615 /* reset the old accessed and modified times. */
2616 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2618 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2621 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2622 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2629 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2630 "Set the file permission bits for newly created files.\n\
2631 The argument MODE should be an integer; only the low 9 bits are used.\n\
2632 This setting is inherited by subprocesses.")
2636 CHECK_NUMBER (mode
, 0);
2638 umask ((~ XINT (mode
)) & 0777);
2643 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2644 "Return the default file protection for created files.\n\
2645 The value is an integer.")
2651 realmask
= umask (0);
2654 XSETINT (value
, (~ realmask
) & 0777);
2660 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2661 "Tell Unix to finish all pending disk updates.")
2670 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2671 "Return t if file FILE1 is newer than file FILE2.\n\
2672 If FILE1 does not exist, the answer is nil;\n\
2673 otherwise, if FILE2 does not exist, the answer is t.")
2675 Lisp_Object file1
, file2
;
2677 Lisp_Object abspath1
, abspath2
;
2680 Lisp_Object handler
;
2681 struct gcpro gcpro1
, gcpro2
;
2683 CHECK_STRING (file1
, 0);
2684 CHECK_STRING (file2
, 0);
2687 GCPRO2 (abspath1
, file2
);
2688 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2689 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2692 /* If the file name has special constructs in it,
2693 call the corresponding file handler. */
2694 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2696 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2697 if (!NILP (handler
))
2698 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2700 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2703 mtime1
= st
.st_mtime
;
2705 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2708 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2712 Lisp_Object Qfind_buffer_file_type
;
2715 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2717 "Insert contents of file FILENAME after point.\n\
2718 Returns list of absolute file name and length of data inserted.\n\
2719 If second argument VISIT is non-nil, the buffer's visited filename\n\
2720 and last save file modtime are set, and it is marked unmodified.\n\
2721 If visiting and the file does not exist, visiting is completed\n\
2722 before the error is signaled.\n\n\
2723 The optional third and fourth arguments BEG and END\n\
2724 specify what portion of the file to insert.\n\
2725 If VISIT is non-nil, BEG and END must be nil.\n\
2726 If optional fifth argument REPLACE is non-nil,\n\
2727 it means replace the current buffer contents (in the accessible portion)\n\
2728 with the file contents. This is better than simply deleting and inserting\n\
2729 the whole thing because (1) it preserves some marker positions\n\
2730 and (2) it puts less data in the undo list.")
2731 (filename
, visit
, beg
, end
, replace
)
2732 Lisp_Object filename
, visit
, beg
, end
, replace
;
2736 register int inserted
= 0;
2737 register int how_much
;
2738 int count
= specpdl_ptr
- specpdl
;
2739 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2740 Lisp_Object handler
, val
, insval
;
2743 int not_regular
= 0;
2745 if (current_buffer
->base_buffer
&& ! NILP (visit
))
2746 error ("Cannot do file visiting in an indirect buffer");
2748 if (!NILP (current_buffer
->read_only
))
2749 Fbarf_if_buffer_read_only ();
2754 GCPRO3 (filename
, val
, p
);
2756 CHECK_STRING (filename
, 0);
2757 filename
= Fexpand_file_name (filename
, Qnil
);
2759 /* If the file name has special constructs in it,
2760 call the corresponding file handler. */
2761 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2762 if (!NILP (handler
))
2764 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2765 visit
, beg
, end
, replace
);
2772 if (stat (XSTRING (filename
)->data
, &st
) < 0)
2774 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
2775 || fstat (fd
, &st
) < 0)
2776 #endif /* not APOLLO */
2778 if (fd
>= 0) close (fd
);
2781 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2788 /* This code will need to be changed in order to work on named
2789 pipes, and it's probably just not worth it. So we should at
2790 least signal an error. */
2791 if (!S_ISREG (st
.st_mode
))
2794 Fsignal (Qfile_error
,
2795 Fcons (build_string ("not a regular file"),
2796 Fcons (filename
, Qnil
)));
2804 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
2807 /* Replacement should preserve point as it preserves markers. */
2808 if (!NILP (replace
))
2809 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2811 record_unwind_protect (close_file_unwind
, make_number (fd
));
2813 /* Supposedly happens on VMS. */
2815 error ("File size is negative");
2817 if (!NILP (beg
) || !NILP (end
))
2819 error ("Attempt to visit less than an entire file");
2822 CHECK_NUMBER (beg
, 0);
2824 XSETFASTINT (beg
, 0);
2827 CHECK_NUMBER (end
, 0);
2830 XSETINT (end
, st
.st_size
);
2831 if (XINT (end
) != st
.st_size
)
2832 error ("maximum buffer size exceeded");
2835 /* If requested, replace the accessible part of the buffer
2836 with the file contents. Avoid replacing text at the
2837 beginning or end of the buffer that matches the file contents;
2838 that preserves markers pointing to the unchanged parts. */
2840 /* On MSDOS, replace mode doesn't really work, except for binary files,
2841 and it's not worth supporting just for them. */
2842 if (!NILP (replace
))
2845 XSETFASTINT (beg
, 0);
2846 XSETFASTINT (end
, st
.st_size
);
2847 del_range_1 (BEGV
, ZV
, 0);
2849 #else /* not DOS_NT */
2850 if (!NILP (replace
))
2852 unsigned char buffer
[1 << 14];
2853 int same_at_start
= BEGV
;
2854 int same_at_end
= ZV
;
2859 /* Count how many chars at the start of the file
2860 match the text at the beginning of the buffer. */
2865 nread
= read (fd
, buffer
, sizeof buffer
);
2867 error ("IO error reading %s: %s",
2868 XSTRING (filename
)->data
, strerror (errno
));
2869 else if (nread
== 0)
2872 while (bufpos
< nread
&& same_at_start
< ZV
2873 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2874 same_at_start
++, bufpos
++;
2875 /* If we found a discrepancy, stop the scan.
2876 Otherwise loop around and scan the next bufferfull. */
2877 if (bufpos
!= nread
)
2881 /* If the file matches the buffer completely,
2882 there's no need to replace anything. */
2883 if (same_at_start
- BEGV
== st
.st_size
)
2887 /* Truncate the buffer to the size of the file. */
2888 del_range_1 (same_at_start
, same_at_end
, 0);
2893 /* Count how many chars at the end of the file
2894 match the text at the end of the buffer. */
2897 int total_read
, nread
, bufpos
, curpos
, trial
;
2899 /* At what file position are we now scanning? */
2900 curpos
= st
.st_size
- (ZV
- same_at_end
);
2901 /* If the entire file matches the buffer tail, stop the scan. */
2904 /* How much can we scan in the next step? */
2905 trial
= min (curpos
, sizeof buffer
);
2906 if (lseek (fd
, curpos
- trial
, 0) < 0)
2907 report_file_error ("Setting file position",
2908 Fcons (filename
, Qnil
));
2911 while (total_read
< trial
)
2913 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2915 error ("IO error reading %s: %s",
2916 XSTRING (filename
)->data
, strerror (errno
));
2917 total_read
+= nread
;
2919 /* Scan this bufferfull from the end, comparing with
2920 the Emacs buffer. */
2921 bufpos
= total_read
;
2922 /* Compare with same_at_start to avoid counting some buffer text
2923 as matching both at the file's beginning and at the end. */
2924 while (bufpos
> 0 && same_at_end
> same_at_start
2925 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2926 same_at_end
--, bufpos
--;
2927 /* If we found a discrepancy, stop the scan.
2928 Otherwise loop around and scan the preceding bufferfull. */
2934 /* Don't try to reuse the same piece of text twice. */
2935 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2937 same_at_end
+= overlap
;
2939 /* Arrange to read only the nonmatching middle part of the file. */
2940 XSETFASTINT (beg
, same_at_start
- BEGV
);
2941 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
2943 del_range_1 (same_at_start
, same_at_end
, 0);
2944 /* Insert from the file at the proper position. */
2945 SET_PT (same_at_start
);
2947 #endif /* not DOS_NT */
2949 total
= XINT (end
) - XINT (beg
);
2952 register Lisp_Object temp
;
2954 /* Make sure point-max won't overflow after this insertion. */
2955 XSETINT (temp
, total
);
2956 if (total
!= XINT (temp
))
2957 error ("maximum buffer size exceeded");
2960 if (NILP (visit
) && total
> 0)
2961 prepare_to_modify_buffer (point
, point
);
2964 if (GAP_SIZE
< total
)
2965 make_gap (total
- GAP_SIZE
);
2967 if (XINT (beg
) != 0 || !NILP (replace
))
2969 if (lseek (fd
, XINT (beg
), 0) < 0)
2970 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2974 while (inserted
< total
)
2976 /* try is reserved in some compilers (Microsoft C) */
2977 int trytry
= min (total
- inserted
, 64 << 10);
2980 /* Allow quitting out of the actual I/O. */
2983 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, trytry
);
3000 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3001 /* Determine file type from name and remove LFs from CR-LFs if the file
3002 is deemed to be a text file. */
3004 current_buffer
->buffer_file_type
3005 = call1 (Qfind_buffer_file_type
, filename
);
3006 if (NILP (current_buffer
->buffer_file_type
))
3009 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
3012 GPT
-= reduced_size
;
3013 GAP_SIZE
+= reduced_size
;
3014 inserted
-= reduced_size
;
3021 record_insert (point
, inserted
);
3023 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3024 offset_intervals (current_buffer
, point
, inserted
);
3030 /* Discard the unwind protect for closing the file. */
3034 error ("IO error reading %s: %s",
3035 XSTRING (filename
)->data
, strerror (errno
));
3042 if (!EQ (current_buffer
->undo_list
, Qt
))
3043 current_buffer
->undo_list
= Qnil
;
3045 stat (XSTRING (filename
)->data
, &st
);
3050 current_buffer
->modtime
= st
.st_mtime
;
3051 current_buffer
->filename
= filename
;
3054 SAVE_MODIFF
= MODIFF
;
3055 current_buffer
->auto_save_modified
= MODIFF
;
3056 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3057 #ifdef CLASH_DETECTION
3060 if (!NILP (current_buffer
->filename
))
3061 unlock_file (current_buffer
->filename
);
3062 unlock_file (filename
);
3064 #endif /* CLASH_DETECTION */
3066 Fsignal (Qfile_error
,
3067 Fcons (build_string ("not a regular file"),
3068 Fcons (filename
, Qnil
)));
3070 /* If visiting nonexistent file, return nil. */
3071 if (current_buffer
->modtime
== -1)
3072 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3075 if (inserted
> 0 && NILP (visit
) && total
> 0)
3076 signal_after_change (point
, 0, inserted
);
3080 p
= Vafter_insert_file_functions
;
3083 insval
= call1 (Fcar (p
), make_number (inserted
));
3086 CHECK_NUMBER (insval
, 0);
3087 inserted
= XFASTINT (insval
);
3095 val
= Fcons (filename
,
3096 Fcons (make_number (inserted
),
3099 RETURN_UNGCPRO (unbind_to (count
, val
));
3102 static Lisp_Object
build_annotations ();
3104 /* If build_annotations switched buffers, switch back to BUF.
3105 Kill the temporary buffer that was selected in the meantime. */
3108 build_annotations_unwind (buf
)
3113 if (XBUFFER (buf
) == current_buffer
)
3115 tembuf
= Fcurrent_buffer ();
3117 Fkill_buffer (tembuf
);
3121 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
3122 "r\nFWrite region to file: ",
3123 "Write current region into specified file.\n\
3124 When called from a program, takes three arguments:\n\
3125 START, END and FILENAME. START and END are buffer positions.\n\
3126 Optional fourth argument APPEND if non-nil means\n\
3127 append to existing file contents (if any).\n\
3128 Optional fifth argument VISIT if t means\n\
3129 set the last-save-file-modtime of buffer to this file's modtime\n\
3130 and mark buffer not modified.\n\
3131 If VISIT is a string, it is a second file name;\n\
3132 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3133 VISIT is also the file name to lock and unlock for clash detection.\n\
3134 If VISIT is neither t nor nil nor a string,\n\
3135 that means do not print the \"Wrote file\" message.\n\
3136 Kludgy feature: if START is a string, then that string is written\n\
3137 to the file, instead of any buffer contents, and END is ignored.")
3138 (start
, end
, filename
, append
, visit
)
3139 Lisp_Object start
, end
, filename
, append
, visit
;
3147 int count
= specpdl_ptr
- specpdl
;
3150 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3152 Lisp_Object handler
;
3153 Lisp_Object visit_file
;
3154 Lisp_Object annotations
;
3155 int visiting
, quietly
;
3156 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3157 struct buffer
*given_buffer
;
3159 int buffer_file_type
3160 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3163 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3164 error ("Cannot do file visiting in an indirect buffer");
3166 if (!NILP (start
) && !STRINGP (start
))
3167 validate_region (&start
, &end
);
3169 GCPRO2 (filename
, visit
);
3170 filename
= Fexpand_file_name (filename
, Qnil
);
3171 if (STRINGP (visit
))
3172 visit_file
= Fexpand_file_name (visit
, Qnil
);
3174 visit_file
= filename
;
3177 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3178 quietly
= !NILP (visit
);
3182 GCPRO4 (start
, filename
, annotations
, visit_file
);
3184 /* If the file name has special constructs in it,
3185 call the corresponding file handler. */
3186 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3187 /* If FILENAME has no handler, see if VISIT has one. */
3188 if (NILP (handler
) && STRINGP (visit
))
3189 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3191 if (!NILP (handler
))
3194 val
= call6 (handler
, Qwrite_region
, start
, end
,
3195 filename
, append
, visit
);
3199 SAVE_MODIFF
= MODIFF
;
3200 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3201 current_buffer
->filename
= visit_file
;
3207 /* Special kludge to simplify auto-saving. */
3210 XSETFASTINT (start
, BEG
);
3211 XSETFASTINT (end
, Z
);
3214 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3215 count1
= specpdl_ptr
- specpdl
;
3217 given_buffer
= current_buffer
;
3218 annotations
= build_annotations (start
, end
);
3219 if (current_buffer
!= given_buffer
)
3225 #ifdef CLASH_DETECTION
3227 lock_file (visit_file
);
3228 #endif /* CLASH_DETECTION */
3230 fn
= XSTRING (filename
)->data
;
3234 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3235 #else /* not DOS_NT */
3236 desc
= open (fn
, O_WRONLY
);
3237 #endif /* not DOS_NT */
3241 if (auto_saving
) /* Overwrite any previous version of autosave file */
3243 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3244 desc
= open (fn
, O_RDWR
);
3246 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3247 ? XSTRING (current_buffer
->filename
)->data
: 0,
3250 else /* Write to temporary name and rename if no errors */
3252 Lisp_Object temp_name
;
3253 temp_name
= Ffile_name_directory (filename
);
3255 if (!NILP (temp_name
))
3257 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3258 build_string ("$$SAVE$$")));
3259 fname
= XSTRING (filename
)->data
;
3260 fn
= XSTRING (temp_name
)->data
;
3261 desc
= creat_copy_attrs (fname
, fn
);
3264 /* If we can't open the temporary file, try creating a new
3265 version of the original file. VMS "creat" creates a
3266 new version rather than truncating an existing file. */
3269 desc
= creat (fn
, 0666);
3270 #if 0 /* This can clobber an existing file and fail to replace it,
3271 if the user runs out of space. */
3274 /* We can't make a new version;
3275 try to truncate and rewrite existing version if any. */
3277 desc
= open (fn
, O_RDWR
);
3283 desc
= creat (fn
, 0666);
3288 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3289 S_IREAD
| S_IWRITE
);
3290 #else /* not DOS_NT */
3291 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3292 #endif /* not DOS_NT */
3293 #endif /* not VMS */
3299 #ifdef CLASH_DETECTION
3301 if (!auto_saving
) unlock_file (visit_file
);
3303 #endif /* CLASH_DETECTION */
3304 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3307 record_unwind_protect (close_file_unwind
, make_number (desc
));
3310 if (lseek (desc
, 0, 2) < 0)
3312 #ifdef CLASH_DETECTION
3313 if (!auto_saving
) unlock_file (visit_file
);
3314 #endif /* CLASH_DETECTION */
3315 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3320 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3321 * if we do writes that don't end with a carriage return. Furthermore
3322 * it cannot handle writes of more then 16K. The modified
3323 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3324 * this EXCEPT for the last record (iff it doesn't end with a carriage
3325 * return). This implies that if your buffer doesn't end with a carriage
3326 * return, you get one free... tough. However it also means that if
3327 * we make two calls to sys_write (a la the following code) you can
3328 * get one at the gap as well. The easiest way to fix this (honest)
3329 * is to move the gap to the next newline (or the end of the buffer).
3334 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3335 move_gap (find_next_newline (GPT
, 1));
3341 if (STRINGP (start
))
3343 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3344 XSTRING (start
)->size
, 0, &annotations
);
3347 else if (XINT (start
) != XINT (end
))
3350 if (XINT (start
) < GPT
)
3352 register int end1
= XINT (end
);
3354 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3355 min (GPT
, end1
) - tem
, tem
, &annotations
);
3356 nwritten
+= min (GPT
, end1
) - tem
;
3360 if (XINT (end
) > GPT
&& !failure
)
3363 tem
= max (tem
, GPT
);
3364 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3366 nwritten
+= XINT (end
) - tem
;
3372 /* If file was empty, still need to write the annotations */
3373 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3381 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3382 Disk full in NFS may be reported here. */
3383 /* mib says that closing the file will try to write as fast as NFS can do
3384 it, and that means the fsync here is not crucial for autosave files. */
3385 if (!auto_saving
&& fsync (desc
) < 0)
3386 failure
= 1, save_errno
= errno
;
3389 /* Spurious "file has changed on disk" warnings have been
3390 observed on Suns as well.
3391 It seems that `close' can change the modtime, under nfs.
3393 (This has supposedly been fixed in Sunos 4,
3394 but who knows about all the other machines with NFS?) */
3397 /* On VMS and APOLLO, must do the stat after the close
3398 since closing changes the modtime. */
3401 /* Recall that #if defined does not work on VMS. */
3408 /* NFS can report a write failure now. */
3409 if (close (desc
) < 0)
3410 failure
= 1, save_errno
= errno
;
3413 /* If we wrote to a temporary name and had no errors, rename to real name. */
3417 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3425 /* Discard the unwind protect for close_file_unwind. */
3426 specpdl_ptr
= specpdl
+ count1
;
3427 /* Restore the original current buffer. */
3428 visit_file
= unbind_to (count
, visit_file
);
3430 #ifdef CLASH_DETECTION
3432 unlock_file (visit_file
);
3433 #endif /* CLASH_DETECTION */
3435 /* Do this before reporting IO error
3436 to avoid a "file has changed on disk" warning on
3437 next attempt to save. */
3439 current_buffer
->modtime
= st
.st_mtime
;
3442 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3446 SAVE_MODIFF
= MODIFF
;
3447 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3448 current_buffer
->filename
= visit_file
;
3449 update_mode_lines
++;
3455 message ("Wrote %s", XSTRING (visit_file
)->data
);
3460 Lisp_Object
merge ();
3462 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3463 "Return t if (car A) is numerically less than (car B).")
3467 return Flss (Fcar (a
), Fcar (b
));
3470 /* Build the complete list of annotations appropriate for writing out
3471 the text between START and END, by calling all the functions in
3472 write-region-annotate-functions and merging the lists they return.
3473 If one of these functions switches to a different buffer, we assume
3474 that buffer contains altered text. Therefore, the caller must
3475 make sure to restore the current buffer in all cases,
3476 as save-excursion would do. */
3479 build_annotations (start
, end
)
3480 Lisp_Object start
, end
;
3482 Lisp_Object annotations
;
3484 struct gcpro gcpro1
, gcpro2
;
3487 p
= Vwrite_region_annotate_functions
;
3488 GCPRO2 (annotations
, p
);
3491 struct buffer
*given_buffer
= current_buffer
;
3492 Vwrite_region_annotations_so_far
= annotations
;
3493 res
= call2 (Fcar (p
), start
, end
);
3494 /* If the function makes a different buffer current,
3495 assume that means this buffer contains altered text to be output.
3496 Reset START and END from the buffer bounds
3497 and discard all previous annotations because they should have
3498 been dealt with by this function. */
3499 if (current_buffer
!= given_buffer
)
3505 Flength (res
); /* Check basic validity of return value */
3506 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3513 /* Write to descriptor DESC the LEN characters starting at ADDR,
3514 assuming they start at position POS in the buffer.
3515 Intersperse with them the annotations from *ANNOT
3516 (those which fall within the range of positions POS to POS + LEN),
3517 each at its appropriate position.
3519 Modify *ANNOT by discarding elements as we output them.
3520 The return value is negative in case of system call failure. */
3523 a_write (desc
, addr
, len
, pos
, annot
)
3525 register char *addr
;
3532 int lastpos
= pos
+ len
;
3534 while (NILP (*annot
) || CONSP (*annot
))
3536 tem
= Fcar_safe (Fcar (*annot
));
3537 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3538 nextpos
= XFASTINT (tem
);
3540 return e_write (desc
, addr
, lastpos
- pos
);
3543 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3545 addr
+= nextpos
- pos
;
3548 tem
= Fcdr (Fcar (*annot
));
3551 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3554 *annot
= Fcdr (*annot
);
3559 e_write (desc
, addr
, len
)
3561 register char *addr
;
3564 char buf
[16 * 1024];
3565 register char *p
, *end
;
3567 if (!EQ (current_buffer
->selective_display
, Qt
))
3568 return write (desc
, addr
, len
) - len
;
3572 end
= p
+ sizeof buf
;
3577 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3586 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3592 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3593 Sverify_visited_file_modtime
, 1, 1, 0,
3594 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3595 This means that the file has not been changed since it was visited or saved.")
3601 Lisp_Object handler
;
3603 CHECK_BUFFER (buf
, 0);
3606 if (!STRINGP (b
->filename
)) return Qt
;
3607 if (b
->modtime
== 0) return Qt
;
3609 /* If the file name has special constructs in it,
3610 call the corresponding file handler. */
3611 handler
= Ffind_file_name_handler (b
->filename
,
3612 Qverify_visited_file_modtime
);
3613 if (!NILP (handler
))
3614 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3616 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3618 /* If the file doesn't exist now and didn't exist before,
3619 we say that it isn't modified, provided the error is a tame one. */
3620 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3625 if (st
.st_mtime
== b
->modtime
3626 /* If both are positive, accept them if they are off by one second. */
3627 || (st
.st_mtime
> 0 && b
->modtime
> 0
3628 && (st
.st_mtime
== b
->modtime
+ 1
3629 || st
.st_mtime
== b
->modtime
- 1)))
3634 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3635 Sclear_visited_file_modtime
, 0, 0, 0,
3636 "Clear out records of last mod time of visited file.\n\
3637 Next attempt to save will certainly not complain of a discrepancy.")
3640 current_buffer
->modtime
= 0;
3644 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3645 Svisited_file_modtime
, 0, 0, 0,
3646 "Return the current buffer's recorded visited file modification time.\n\
3647 The value is a list of the form (HIGH . LOW), like the time values\n\
3648 that `file-attributes' returns.")
3651 return long_to_cons (current_buffer
->modtime
);
3654 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3655 Sset_visited_file_modtime
, 0, 1, 0,
3656 "Update buffer's recorded modification time from the visited file's time.\n\
3657 Useful if the buffer was not read from the file normally\n\
3658 or if the file itself has been changed for some known benign reason.\n\
3659 An argument specifies the modification time value to use\n\
3660 \(instead of that of the visited file), in the form of a list\n\
3661 \(HIGH . LOW) or (HIGH LOW).")
3663 Lisp_Object time_list
;
3665 if (!NILP (time_list
))
3666 current_buffer
->modtime
= cons_to_long (time_list
);
3669 register Lisp_Object filename
;
3671 Lisp_Object handler
;
3673 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3675 /* If the file name has special constructs in it,
3676 call the corresponding file handler. */
3677 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3678 if (!NILP (handler
))
3679 /* The handler can find the file name the same way we did. */
3680 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3681 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3682 current_buffer
->modtime
= st
.st_mtime
;
3692 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3693 Fsleep_for (make_number (1), Qnil
);
3694 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3695 Fsleep_for (make_number (1), Qnil
);
3696 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3697 Fsleep_for (make_number (1), Qnil
);
3707 /* Get visited file's mode to become the auto save file's mode. */
3708 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3709 /* But make sure we can overwrite it later! */
3710 auto_save_mode_bits
= st
.st_mode
| 0600;
3712 auto_save_mode_bits
= 0666;
3715 Fwrite_region (Qnil
, Qnil
,
3716 current_buffer
->auto_save_file_name
,
3721 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3724 close (XINT (desc
));
3728 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3729 "Auto-save all buffers that need it.\n\
3730 This is all buffers that have auto-saving enabled\n\
3731 and are changed since last auto-saved.\n\
3732 Auto-saving writes the buffer into a file\n\
3733 so that your editing is not lost if the system crashes.\n\
3734 This file is not the file you visited; that changes only when you save.\n\
3735 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3736 Non-nil first argument means do not print any message if successful.\n\
3737 Non-nil second argument means save only current buffer.")
3738 (no_message
, current_only
)
3739 Lisp_Object no_message
, current_only
;
3741 struct buffer
*old
= current_buffer
, *b
;
3742 Lisp_Object tail
, buf
;
3744 char *omessage
= echo_area_glyphs
;
3745 int omessage_length
= echo_area_glyphs_length
;
3746 extern int minibuf_level
;
3747 int do_handled_files
;
3750 int count
= specpdl_ptr
- specpdl
;
3753 /* Ordinarily don't quit within this function,
3754 but don't make it impossible to quit (in case we get hung in I/O). */
3758 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3759 point to non-strings reached from Vbuffer_alist. */
3765 if (!NILP (Vrun_hooks
))
3766 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3768 if (STRINGP (Vauto_save_list_file_name
))
3771 listdesc
= open (XSTRING (Vauto_save_list_file_name
)->data
,
3772 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3773 S_IREAD
| S_IWRITE
);
3774 #else /* not DOS_NT */
3775 listdesc
= creat (XSTRING (Vauto_save_list_file_name
)->data
, 0666);
3776 #endif /* not DOS_NT */
3781 /* Arrange to close that file whether or not we get an error. */
3783 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3785 /* First, save all files which don't have handlers. If Emacs is
3786 crashing, the handlers may tweak what is causing Emacs to crash
3787 in the first place, and it would be a shame if Emacs failed to
3788 autosave perfectly ordinary files because it couldn't handle some
3790 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3791 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
3793 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3796 /* Record all the buffers that have auto save mode
3797 in the special file that lists them. */
3798 if (STRINGP (b
->auto_save_file_name
)
3799 && listdesc
>= 0 && do_handled_files
== 0)
3801 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3802 XSTRING (b
->auto_save_file_name
)->size
);
3803 write (listdesc
, "\n", 1);
3806 if (!NILP (current_only
)
3807 && b
!= current_buffer
)
3810 /* Don't auto-save indirect buffers.
3811 The base buffer takes care of it. */
3815 /* Check for auto save enabled
3816 and file changed since last auto save
3817 and file changed since last real save. */
3818 if (STRINGP (b
->auto_save_file_name
)
3819 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
3820 && b
->auto_save_modified
< BUF_MODIFF (b
)
3821 /* -1 means we've turned off autosaving for a while--see below. */
3822 && XINT (b
->save_length
) >= 0
3823 && (do_handled_files
3824 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3827 EMACS_TIME before_time
, after_time
;
3829 EMACS_GET_TIME (before_time
);
3831 /* If we had a failure, don't try again for 20 minutes. */
3832 if (b
->auto_save_failure_time
>= 0
3833 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3836 if ((XFASTINT (b
->save_length
) * 10
3837 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3838 /* A short file is likely to change a large fraction;
3839 spare the user annoying messages. */
3840 && XFASTINT (b
->save_length
) > 5000
3841 /* These messages are frequent and annoying for `*mail*'. */
3842 && !EQ (b
->filename
, Qnil
)
3843 && NILP (no_message
))
3845 /* It has shrunk too much; turn off auto-saving here. */
3846 message ("Buffer %s has shrunk a lot; auto save turned off there",
3847 XSTRING (b
->name
)->data
);
3848 /* Turn off auto-saving until there's a real save,
3849 and prevent any more warnings. */
3850 XSETINT (b
->save_length
, -1);
3851 Fsleep_for (make_number (1), Qnil
);
3854 set_buffer_internal (b
);
3855 if (!auto_saved
&& NILP (no_message
))
3856 message1 ("Auto-saving...");
3857 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3859 b
->auto_save_modified
= BUF_MODIFF (b
);
3860 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3861 set_buffer_internal (old
);
3863 EMACS_GET_TIME (after_time
);
3865 /* If auto-save took more than 60 seconds,
3866 assume it was an NFS failure that got a timeout. */
3867 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3868 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3872 /* Prevent another auto save till enough input events come in. */
3873 record_auto_save ();
3875 if (auto_saved
&& NILP (no_message
))
3878 message2 (omessage
, omessage_length
);
3880 message1 ("Auto-saving...done");
3886 unbind_to (count
, Qnil
);
3890 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3891 Sset_buffer_auto_saved
, 0, 0, 0,
3892 "Mark current buffer as auto-saved with its current text.\n\
3893 No auto-save file will be written until the buffer changes again.")
3896 current_buffer
->auto_save_modified
= MODIFF
;
3897 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3898 current_buffer
->auto_save_failure_time
= -1;
3902 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3903 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3904 "Clear any record of a recent auto-save failure in the current buffer.")
3907 current_buffer
->auto_save_failure_time
= -1;
3911 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3913 "Return t if buffer has been auto-saved since last read in or saved.")
3916 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3919 /* Reading and completing file names */
3920 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3922 /* In the string VAL, change each $ to $$ and return the result. */
3925 double_dollars (val
)
3928 register unsigned char *old
, *new;
3932 osize
= XSTRING (val
)->size
;
3933 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3934 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3935 if (*old
++ == '$') count
++;
3938 old
= XSTRING (val
)->data
;
3939 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3940 new = XSTRING (val
)->data
;
3941 for (n
= osize
; n
> 0; n
--)
3954 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3956 "Internal subroutine for read-file-name. Do not call this.")
3957 (string
, dir
, action
)
3958 Lisp_Object string
, dir
, action
;
3959 /* action is nil for complete, t for return list of completions,
3960 lambda for verify final value */
3962 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3964 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3971 /* No need to protect ACTION--we only compare it with t and nil. */
3972 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
3974 if (XSTRING (string
)->size
== 0)
3976 if (EQ (action
, Qlambda
))
3984 orig_string
= string
;
3985 string
= Fsubstitute_in_file_name (string
);
3986 changed
= NILP (Fstring_equal (string
, orig_string
));
3987 name
= Ffile_name_nondirectory (string
);
3988 val
= Ffile_name_directory (string
);
3990 realdir
= Fexpand_file_name (val
, realdir
);
3995 specdir
= Ffile_name_directory (string
);
3996 val
= Ffile_name_completion (name
, realdir
);
4001 return double_dollars (string
);
4005 if (!NILP (specdir
))
4006 val
= concat2 (specdir
, val
);
4008 return double_dollars (val
);
4011 #endif /* not VMS */
4015 if (EQ (action
, Qt
))
4016 return Ffile_name_all_completions (name
, realdir
);
4017 /* Only other case actually used is ACTION = lambda */
4019 /* Supposedly this helps commands such as `cd' that read directory names,
4020 but can someone explain how it helps them? -- RMS */
4021 if (XSTRING (name
)->size
== 0)
4024 return Ffile_exists_p (string
);
4027 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4028 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4029 Value is not expanded---you must call `expand-file-name' yourself.\n\
4030 Default name to DEFAULT if user enters a null string.\n\
4031 (If DEFAULT is omitted, the visited file name is used,\n\
4032 except that if INITIAL is specified, that combined with DIR is used.)\n\
4033 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4034 Non-nil and non-t means also require confirmation after completion.\n\
4035 Fifth arg INITIAL specifies text to start with.\n\
4036 DIR defaults to current buffer's directory default.")
4037 (prompt
, dir
, defalt
, mustmatch
, initial
)
4038 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4040 Lisp_Object val
, insdef
, insdef1
, tem
;
4041 struct gcpro gcpro1
, gcpro2
;
4042 register char *homedir
;
4046 dir
= current_buffer
->directory
;
4049 if (! NILP (initial
))
4050 defalt
= Fexpand_file_name (initial
, dir
);
4052 defalt
= current_buffer
->filename
;
4055 /* If dir starts with user's homedir, change that to ~. */
4056 homedir
= (char *) egetenv ("HOME");
4059 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4060 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4062 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4063 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4064 XSTRING (dir
)->data
[0] = '~';
4067 if (insert_default_directory
)
4070 if (!NILP (initial
))
4072 Lisp_Object args
[2], pos
;
4076 insdef
= Fconcat (2, args
);
4077 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4078 insdef1
= Fcons (double_dollars (insdef
), pos
);
4081 insdef1
= double_dollars (insdef
);
4083 else if (!NILP (initial
))
4086 insdef1
= Fcons (double_dollars (insdef
), 0);
4089 insdef
= Qnil
, insdef1
= Qnil
;
4092 count
= specpdl_ptr
- specpdl
;
4093 specbind (intern ("completion-ignore-case"), Qt
);
4096 GCPRO2 (insdef
, defalt
);
4097 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4098 dir
, mustmatch
, insdef1
,
4099 Qfile_name_history
);
4102 unbind_to (count
, Qnil
);
4107 error ("No file name specified");
4108 tem
= Fstring_equal (val
, insdef
);
4109 if (!NILP (tem
) && !NILP (defalt
))
4111 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4116 error ("No default file name");
4118 return Fsubstitute_in_file_name (val
);
4121 #if 0 /* Old version */
4122 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4123 /* Don't confuse make-docfile by having two doc strings for this function.
4124 make-docfile does not pay attention to #if, for good reason! */
4126 (prompt
, dir
, defalt
, mustmatch
, initial
)
4127 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4129 Lisp_Object val
, insdef
, tem
;
4130 struct gcpro gcpro1
, gcpro2
;
4131 register char *homedir
;
4135 dir
= current_buffer
->directory
;
4137 defalt
= current_buffer
->filename
;
4139 /* If dir starts with user's homedir, change that to ~. */
4140 homedir
= (char *) egetenv ("HOME");
4143 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4144 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4146 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4147 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4148 XSTRING (dir
)->data
[0] = '~';
4151 if (!NILP (initial
))
4153 else if (insert_default_directory
)
4156 insdef
= build_string ("");
4159 count
= specpdl_ptr
- specpdl
;
4160 specbind (intern ("completion-ignore-case"), Qt
);
4163 GCPRO2 (insdef
, defalt
);
4164 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4166 insert_default_directory
? insdef
: Qnil
,
4167 Qfile_name_history
);
4170 unbind_to (count
, Qnil
);
4175 error ("No file name specified");
4176 tem
= Fstring_equal (val
, insdef
);
4177 if (!NILP (tem
) && !NILP (defalt
))
4179 return Fsubstitute_in_file_name (val
);
4181 #endif /* Old version */
4185 Qexpand_file_name
= intern ("expand-file-name");
4186 Qdirectory_file_name
= intern ("directory-file-name");
4187 Qfile_name_directory
= intern ("file-name-directory");
4188 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4189 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4190 Qfile_name_as_directory
= intern ("file-name-as-directory");
4191 Qcopy_file
= intern ("copy-file");
4192 Qmake_directory_internal
= intern ("make-directory-internal");
4193 Qdelete_directory
= intern ("delete-directory");
4194 Qdelete_file
= intern ("delete-file");
4195 Qrename_file
= intern ("rename-file");
4196 Qadd_name_to_file
= intern ("add-name-to-file");
4197 Qmake_symbolic_link
= intern ("make-symbolic-link");
4198 Qfile_exists_p
= intern ("file-exists-p");
4199 Qfile_executable_p
= intern ("file-executable-p");
4200 Qfile_readable_p
= intern ("file-readable-p");
4201 Qfile_symlink_p
= intern ("file-symlink-p");
4202 Qfile_writable_p
= intern ("file-writable-p");
4203 Qfile_directory_p
= intern ("file-directory-p");
4204 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4205 Qfile_modes
= intern ("file-modes");
4206 Qset_file_modes
= intern ("set-file-modes");
4207 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4208 Qinsert_file_contents
= intern ("insert-file-contents");
4209 Qwrite_region
= intern ("write-region");
4210 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4211 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4212 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4214 staticpro (&Qexpand_file_name
);
4215 staticpro (&Qdirectory_file_name
);
4216 staticpro (&Qfile_name_directory
);
4217 staticpro (&Qfile_name_nondirectory
);
4218 staticpro (&Qunhandled_file_name_directory
);
4219 staticpro (&Qfile_name_as_directory
);
4220 staticpro (&Qcopy_file
);
4221 staticpro (&Qmake_directory_internal
);
4222 staticpro (&Qdelete_directory
);
4223 staticpro (&Qdelete_file
);
4224 staticpro (&Qrename_file
);
4225 staticpro (&Qadd_name_to_file
);
4226 staticpro (&Qmake_symbolic_link
);
4227 staticpro (&Qfile_exists_p
);
4228 staticpro (&Qfile_executable_p
);
4229 staticpro (&Qfile_readable_p
);
4230 staticpro (&Qfile_symlink_p
);
4231 staticpro (&Qfile_writable_p
);
4232 staticpro (&Qfile_directory_p
);
4233 staticpro (&Qfile_accessible_directory_p
);
4234 staticpro (&Qfile_modes
);
4235 staticpro (&Qset_file_modes
);
4236 staticpro (&Qfile_newer_than_file_p
);
4237 staticpro (&Qinsert_file_contents
);
4238 staticpro (&Qwrite_region
);
4239 staticpro (&Qverify_visited_file_modtime
);
4240 staticpro (&Qsubstitute_in_file_name
);
4242 Qfile_name_history
= intern ("file-name-history");
4243 Fset (Qfile_name_history
, Qnil
);
4244 staticpro (&Qfile_name_history
);
4246 Qfile_error
= intern ("file-error");
4247 staticpro (&Qfile_error
);
4248 Qfile_already_exists
= intern("file-already-exists");
4249 staticpro (&Qfile_already_exists
);
4252 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4253 staticpro (&Qfind_buffer_file_type
);
4256 Qcar_less_than_car
= intern ("car-less-than-car");
4257 staticpro (&Qcar_less_than_car
);
4259 Fput (Qfile_error
, Qerror_conditions
,
4260 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4261 Fput (Qfile_error
, Qerror_message
,
4262 build_string ("File error"));
4264 Fput (Qfile_already_exists
, Qerror_conditions
,
4265 Fcons (Qfile_already_exists
,
4266 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4267 Fput (Qfile_already_exists
, Qerror_message
,
4268 build_string ("File already exists"));
4270 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4271 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4272 insert_default_directory
= 1;
4274 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4275 "*Non-nil means write new files with record format `stmlf'.\n\
4276 nil means use format `var'. This variable is meaningful only on VMS.");
4277 vms_stmlf_recfm
= 0;
4279 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4280 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4281 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4284 The first argument given to HANDLER is the name of the I/O primitive\n\
4285 to be handled; the remaining arguments are the arguments that were\n\
4286 passed to that primitive. For example, if you do\n\
4287 (file-exists-p FILENAME)\n\
4288 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4289 (funcall HANDLER 'file-exists-p FILENAME)\n\
4290 The function `find-file-name-handler' checks this list for a handler\n\
4291 for its argument.");
4292 Vfile_name_handler_alist
= Qnil
;
4294 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4295 "A list of functions to be called at the end of `insert-file-contents'.\n\
4296 Each is passed one argument, the number of bytes inserted. It should return\n\
4297 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4298 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4299 responsible for calling the after-insert-file-functions if appropriate.");
4300 Vafter_insert_file_functions
= Qnil
;
4302 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4303 "A list of functions to be called at the start of `write-region'.\n\
4304 Each is passed two arguments, START and END as for `write-region'. It should\n\
4305 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4306 inserted at the specified positions of the file being written (1 means to\n\
4307 insert before the first byte written). The POSITIONs must be sorted into\n\
4308 increasing order. If there are several functions in the list, the several\n\
4309 lists are merged destructively.");
4310 Vwrite_region_annotate_functions
= Qnil
;
4312 DEFVAR_LISP ("write-region-annotations-so-far",
4313 &Vwrite_region_annotations_so_far
,
4314 "When an annotation function is called, this holds the previous annotations.\n\
4315 These are the annotations made by other annotation functions\n\
4316 that were already called. See also `write-region-annotate-functions'.");
4317 Vwrite_region_annotations_so_far
= Qnil
;
4319 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4320 "A list of file name handlers that temporarily should not be used.\n\
4321 This applies only to the operation `inhibit-file-name-operation'.");
4322 Vinhibit_file_name_handlers
= Qnil
;
4324 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4325 "The operation for which `inhibit-file-name-handlers' is applicable.");
4326 Vinhibit_file_name_operation
= Qnil
;
4328 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4329 "File name in which we write a list of all auto save file names.");
4330 Vauto_save_list_file_name
= Qnil
;
4332 defsubr (&Sfind_file_name_handler
);
4333 defsubr (&Sfile_name_directory
);
4334 defsubr (&Sfile_name_nondirectory
);
4335 defsubr (&Sunhandled_file_name_directory
);
4336 defsubr (&Sfile_name_as_directory
);
4337 defsubr (&Sdirectory_file_name
);
4338 defsubr (&Smake_temp_name
);
4339 defsubr (&Sexpand_file_name
);
4340 defsubr (&Ssubstitute_in_file_name
);
4341 defsubr (&Scopy_file
);
4342 defsubr (&Smake_directory_internal
);
4343 defsubr (&Sdelete_directory
);
4344 defsubr (&Sdelete_file
);
4345 defsubr (&Srename_file
);
4346 defsubr (&Sadd_name_to_file
);
4348 defsubr (&Smake_symbolic_link
);
4349 #endif /* S_IFLNK */
4351 defsubr (&Sdefine_logical_name
);
4354 defsubr (&Ssysnetunam
);
4355 #endif /* HPUX_NET */
4356 defsubr (&Sfile_name_absolute_p
);
4357 defsubr (&Sfile_exists_p
);
4358 defsubr (&Sfile_executable_p
);
4359 defsubr (&Sfile_readable_p
);
4360 defsubr (&Sfile_writable_p
);
4361 defsubr (&Sfile_symlink_p
);
4362 defsubr (&Sfile_directory_p
);
4363 defsubr (&Sfile_accessible_directory_p
);
4364 defsubr (&Sfile_regular_p
);
4365 defsubr (&Sfile_modes
);
4366 defsubr (&Sset_file_modes
);
4367 defsubr (&Sset_default_file_modes
);
4368 defsubr (&Sdefault_file_modes
);
4369 defsubr (&Sfile_newer_than_file_p
);
4370 defsubr (&Sinsert_file_contents
);
4371 defsubr (&Swrite_region
);
4372 defsubr (&Scar_less_than_car
);
4373 defsubr (&Sverify_visited_file_modtime
);
4374 defsubr (&Sclear_visited_file_modtime
);
4375 defsubr (&Svisited_file_modtime
);
4376 defsubr (&Sset_visited_file_modtime
);
4377 defsubr (&Sdo_auto_save
);
4378 defsubr (&Sset_buffer_auto_saved
);
4379 defsubr (&Sclear_buffer_auto_save_failure
);
4380 defsubr (&Srecent_auto_save_p
);
4382 defsubr (&Sread_file_name_internal
);
4383 defsubr (&Sread_file_name
);
4386 defsubr (&Sunix_sync
);