1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
22 #include <sys/types.h>
29 #if !defined (S_ISLNK) && defined (S_IFLNK)
30 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
33 #if !defined (S_ISREG) && defined (S_IFREG)
34 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
45 #include <sys/param.h>
63 extern char *strerror ();
80 #include "intervals.h"
89 #endif /* not WINDOWSNT */
117 #define min(a, b) ((a) < (b) ? (a) : (b))
118 #define max(a, b) ((a) > (b) ? (a) : (b))
120 /* Nonzero during writing of auto-save files */
123 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
124 a new file with the same mode as the original */
125 int auto_save_mode_bits
;
127 /* Alist of elements (REGEXP . HANDLER) for file names
128 whose I/O is done with a special handler. */
129 Lisp_Object Vfile_name_handler_alist
;
131 /* Format for auto-save files */
132 Lisp_Object Vauto_save_file_format
;
134 /* Lisp functions for translating file formats */
135 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
137 /* Functions to be called to process text properties in inserted file. */
138 Lisp_Object Vafter_insert_file_functions
;
140 /* Functions to be called to create text property annotations for file. */
141 Lisp_Object Vwrite_region_annotate_functions
;
143 /* During build_annotations, each time an annotation function is called,
144 this holds the annotations made by the previous functions. */
145 Lisp_Object Vwrite_region_annotations_so_far
;
147 /* File name in which we write a list of all our auto save files. */
148 Lisp_Object Vauto_save_list_file_name
;
150 /* Nonzero means, when reading a filename in the minibuffer,
151 start out by inserting the default directory into the minibuffer. */
152 int insert_default_directory
;
154 /* On VMS, nonzero means write new files with record format stmlf.
155 Zero means use var format. */
158 /* These variables describe handlers that have "already" had a chance
159 to handle the current operation.
161 Vinhibit_file_name_handlers is a list of file name handlers.
162 Vinhibit_file_name_operation is the operation being handled.
163 If we try to handle that operation, we ignore those handlers. */
165 static Lisp_Object Vinhibit_file_name_handlers
;
166 static Lisp_Object Vinhibit_file_name_operation
;
168 Lisp_Object Qfile_error
, Qfile_already_exists
;
170 Lisp_Object Qfile_name_history
;
172 Lisp_Object Qcar_less_than_car
;
174 report_file_error (string
, data
)
178 Lisp_Object errstring
;
180 errstring
= build_string (strerror (errno
));
182 /* System error messages are capitalized. Downcase the initial
183 unless it is followed by a slash. */
184 if (XSTRING (errstring
)->data
[1] != '/')
185 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
188 Fsignal (Qfile_error
,
189 Fcons (build_string (string
), Fcons (errstring
, data
)));
192 close_file_unwind (fd
)
195 close (XFASTINT (fd
));
198 /* Restore point, having saved it as a marker. */
200 restore_point_unwind (location
)
201 Lisp_Object location
;
203 SET_PT (marker_position (location
));
204 Fset_marker (location
, Qnil
, Qnil
);
207 Lisp_Object Qexpand_file_name
;
208 Lisp_Object Qsubstitute_in_file_name
;
209 Lisp_Object Qdirectory_file_name
;
210 Lisp_Object Qfile_name_directory
;
211 Lisp_Object Qfile_name_nondirectory
;
212 Lisp_Object Qunhandled_file_name_directory
;
213 Lisp_Object Qfile_name_as_directory
;
214 Lisp_Object Qcopy_file
;
215 Lisp_Object Qmake_directory_internal
;
216 Lisp_Object Qdelete_directory
;
217 Lisp_Object Qdelete_file
;
218 Lisp_Object Qrename_file
;
219 Lisp_Object Qadd_name_to_file
;
220 Lisp_Object Qmake_symbolic_link
;
221 Lisp_Object Qfile_exists_p
;
222 Lisp_Object Qfile_executable_p
;
223 Lisp_Object Qfile_readable_p
;
224 Lisp_Object Qfile_symlink_p
;
225 Lisp_Object Qfile_writable_p
;
226 Lisp_Object Qfile_directory_p
;
227 Lisp_Object Qfile_accessible_directory_p
;
228 Lisp_Object Qfile_modes
;
229 Lisp_Object Qset_file_modes
;
230 Lisp_Object Qfile_newer_than_file_p
;
231 Lisp_Object Qinsert_file_contents
;
232 Lisp_Object Qwrite_region
;
233 Lisp_Object Qverify_visited_file_modtime
;
234 Lisp_Object Qset_visited_file_modtime
;
236 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
237 "Return FILENAME's handler function for OPERATION, if it has one.\n\
238 Otherwise, return nil.\n\
239 A file name is handled if one of the regular expressions in\n\
240 `file-name-handler-alist' matches it.\n\n\
241 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
242 any handlers that are members of `inhibit-file-name-handlers',\n\
243 but we still do run any other handlers. This lets handlers\n\
244 use the standard functions without calling themselves recursively.")
245 (filename
, operation
)
246 Lisp_Object filename
, operation
;
248 /* This function must not munge the match data. */
249 Lisp_Object chain
, inhibited_handlers
;
251 CHECK_STRING (filename
, 0);
253 if (EQ (operation
, Vinhibit_file_name_operation
))
254 inhibited_handlers
= Vinhibit_file_name_handlers
;
256 inhibited_handlers
= Qnil
;
258 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
259 chain
= XCONS (chain
)->cdr
)
262 elt
= XCONS (chain
)->car
;
266 string
= XCONS (elt
)->car
;
267 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
269 Lisp_Object handler
, tem
;
271 handler
= XCONS (elt
)->cdr
;
272 tem
= Fmemq (handler
, inhibited_handlers
);
283 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
285 "Return the directory component in file name NAME.\n\
286 Return nil if NAME does not include a directory.\n\
287 Otherwise return a directory spec.\n\
288 Given a Unix syntax file name, returns a string ending in slash;\n\
289 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
293 register unsigned char *beg
;
294 register unsigned char *p
;
297 CHECK_STRING (file
, 0);
299 /* If the file name has special constructs in it,
300 call the corresponding file handler. */
301 handler
= Ffind_file_name_handler (file
, Qfile_name_directory
);
303 return call2 (handler
, Qfile_name_directory
, file
);
305 #ifdef FILE_SYSTEM_CASE
306 file
= FILE_SYSTEM_CASE (file
);
308 beg
= XSTRING (file
)->data
;
309 p
= beg
+ XSTRING (file
)->size
;
311 while (p
!= beg
&& !IS_ANY_SEP (p
[-1])
313 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
320 /* Expansion of "c:" to drive and default directory. */
321 /* (NT does the right thing.) */
322 if (p
== beg
+ 2 && beg
[1] == ':')
324 int drive
= (*beg
) - 'a';
325 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
326 unsigned char *res
= alloca (MAXPATHLEN
+ 5);
330 /* The NT version places the drive letter at the beginning already. */
331 #else /* not WINDOWSNT */
332 /* On MSDOG we must put the drive letter in by hand. */
334 #endif /* not WINDOWSNT */
335 if (getdefdir (drive
+ 1, res
))
338 res
[0] = drive
+ 'a';
341 if (IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
344 p
= beg
+ strlen (beg
);
348 return make_string (beg
, p
- beg
);
351 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
353 "Return file name NAME sans its directory.\n\
354 For example, in a Unix-syntax file name,\n\
355 this is everything after the last slash,\n\
356 or the entire name if it contains no slash.")
360 register unsigned char *beg
, *p
, *end
;
363 CHECK_STRING (file
, 0);
365 /* If the file name has special constructs in it,
366 call the corresponding file handler. */
367 handler
= Ffind_file_name_handler (file
, Qfile_name_nondirectory
);
369 return call2 (handler
, Qfile_name_nondirectory
, file
);
371 beg
= XSTRING (file
)->data
;
372 end
= p
= beg
+ XSTRING (file
)->size
;
374 while (p
!= beg
&& !IS_ANY_SEP (p
[-1])
376 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
380 return make_string (p
, end
- p
);
383 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
384 "Return a directly usable directory name somehow associated with FILENAME.\n\
385 A `directly usable' directory name is one that may be used without the\n\
386 intervention of any file handler.\n\
387 If FILENAME is a directly usable file itself, return\n\
388 (file-name-directory FILENAME).\n\
389 The `call-process' and `start-process' functions use this function to\n\
390 get a current directory to run processes in.")
392 Lisp_Object filename
;
396 /* If the file name has special constructs in it,
397 call the corresponding file handler. */
398 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
400 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
402 return Ffile_name_directory (filename
);
407 file_name_as_directory (out
, in
)
410 int size
= strlen (in
) - 1;
415 /* Is it already a directory string? */
416 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
418 /* Is it a VMS directory file name? If so, hack VMS syntax. */
419 else if (! index (in
, '/')
420 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
421 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
422 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
423 || ! strncmp (&in
[size
- 5], ".dir", 4))
424 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
425 && in
[size
] == '1')))
427 register char *p
, *dot
;
431 dir:x.dir --> dir:[x]
432 dir:[x]y.dir --> dir:[x.y] */
434 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
437 strncpy (out
, in
, p
- in
);
456 dot
= index (p
, '.');
459 /* blindly remove any extension */
460 size
= strlen (out
) + (dot
- p
);
461 strncat (out
, p
, dot
- p
);
472 /* For Unix syntax, Append a slash if necessary */
473 if (!IS_ANY_SEP (out
[size
]))
475 out
[size
+ 1] = DIRECTORY_SEP
;
476 out
[size
+ 2] = '\0';
482 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
483 Sfile_name_as_directory
, 1, 1, 0,
484 "Return a string representing file FILENAME interpreted as a directory.\n\
485 This operation exists because a directory is also a file, but its name as\n\
486 a directory is different from its name as a file.\n\
487 The result can be used as the value of `default-directory'\n\
488 or passed as second argument to `expand-file-name'.\n\
489 For a Unix-syntax file name, just appends a slash.\n\
490 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
497 CHECK_STRING (file
, 0);
501 /* If the file name has special constructs in it,
502 call the corresponding file handler. */
503 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
505 return call2 (handler
, Qfile_name_as_directory
, file
);
507 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
508 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
512 * Convert from directory name to filename.
514 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
515 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
516 * On UNIX, it's simple: just make sure there is a terminating /
518 * Value is nonzero if the string output is different from the input.
521 directory_file_name (src
, dst
)
529 struct FAB fab
= cc$rms_fab
;
530 struct NAM nam
= cc$rms_nam
;
531 char esa
[NAM$C_MAXRSS
];
536 if (! index (src
, '/')
537 && (src
[slen
- 1] == ']'
538 || src
[slen
- 1] == ':'
539 || src
[slen
- 1] == '>'))
541 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
543 fab
.fab$b_fns
= slen
;
544 fab
.fab$l_nam
= &nam
;
545 fab
.fab$l_fop
= FAB$M_NAM
;
548 nam
.nam$b_ess
= sizeof esa
;
549 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
551 /* We call SYS$PARSE to handle such things as [--] for us. */
552 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
554 slen
= nam
.nam$b_esl
;
555 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
560 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
562 /* what about when we have logical_name:???? */
563 if (src
[slen
- 1] == ':')
564 { /* Xlate logical name and see what we get */
565 ptr
= strcpy (dst
, src
); /* upper case for getenv */
568 if ('a' <= *ptr
&& *ptr
<= 'z')
572 dst
[slen
- 1] = 0; /* remove colon */
573 if (!(src
= egetenv (dst
)))
575 /* should we jump to the beginning of this procedure?
576 Good points: allows us to use logical names that xlate
578 Bad points: can be a problem if we just translated to a device
580 For now, I'll punt and always expect VMS names, and hope for
583 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
584 { /* no recursion here! */
590 { /* not a directory spec */
595 bracket
= src
[slen
- 1];
597 /* If bracket is ']' or '>', bracket - 2 is the corresponding
599 ptr
= index (src
, bracket
- 2);
601 { /* no opening bracket */
605 if (!(rptr
= rindex (src
, '.')))
608 strncpy (dst
, src
, slen
);
612 dst
[slen
++] = bracket
;
617 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
618 then translate the device and recurse. */
619 if (dst
[slen
- 1] == ':'
620 && dst
[slen
- 2] != ':' /* skip decnet nodes */
621 && strcmp(src
+ slen
, "[000000]") == 0)
623 dst
[slen
- 1] = '\0';
624 if ((ptr
= egetenv (dst
))
625 && (rlen
= strlen (ptr
) - 1) > 0
626 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
627 && ptr
[rlen
- 1] == '.')
629 char * buf
= (char *) alloca (strlen (ptr
) + 1);
633 return directory_file_name (buf
, dst
);
638 strcat (dst
, "[000000]");
642 rlen
= strlen (rptr
) - 1;
643 strncat (dst
, rptr
, rlen
);
644 dst
[slen
+ rlen
] = '\0';
645 strcat (dst
, ".DIR.1");
649 /* Process as Unix format: just remove any final slash.
650 But leave "/" unchanged; do not change it to "". */
653 && IS_DIRECTORY_SEP (dst
[slen
- 1])
654 && !IS_ANY_SEP (dst
[slen
- 2]))
659 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
661 "Returns the file name of the directory named DIR.\n\
662 This is the name of the file that holds the data for the directory DIR.\n\
663 This operation exists because a directory is also a file, but its name as\n\
664 a directory is different from its name as a file.\n\
665 In Unix-syntax, this function just removes the final slash.\n\
666 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
667 it returns a file name such as \"[X]Y.DIR.1\".")
669 Lisp_Object directory
;
674 CHECK_STRING (directory
, 0);
676 if (NILP (directory
))
679 /* If the file name has special constructs in it,
680 call the corresponding file handler. */
681 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
683 return call2 (handler
, Qdirectory_file_name
, directory
);
686 /* 20 extra chars is insufficient for VMS, since we might perform a
687 logical name translation. an equivalence string can be up to 255
688 chars long, so grab that much extra space... - sss */
689 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
691 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
693 directory_file_name (XSTRING (directory
)->data
, buf
);
694 return build_string (buf
);
697 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
698 "Generate temporary file name (string) starting with PREFIX (a string).\n\
699 The Emacs process number forms part of the result,\n\
700 so there is no danger of generating a name being used by another process.")
705 val
= concat2 (prefix
, build_string ("XXXXXX"));
706 mktemp (XSTRING (val
)->data
);
710 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
711 "Convert FILENAME to absolute, and canonicalize it.\n\
712 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
713 (does not start with slash); if DEFAULT is nil or missing,\n\
714 the current buffer's value of default-directory is used.\n\
715 Path components that are `.' are removed, and \n\
716 path components followed by `..' are removed, along with the `..' itself;\n\
717 note that these simplifications are done without checking the resulting\n\
718 paths in the file system.\n\
719 An initial `~/' expands to your home directory.\n\
720 An initial `~USER/' expands to USER's home directory.\n\
721 See also the function `substitute-in-file-name'.")
723 Lisp_Object name
, defalt
;
727 register unsigned char *newdir
, *p
, *o
;
729 unsigned char *target
;
732 unsigned char * colon
= 0;
733 unsigned char * close
= 0;
734 unsigned char * slash
= 0;
735 unsigned char * brack
= 0;
736 int lbrack
= 0, rbrack
= 0;
740 /* Demacs 1.1.2 91/10/20 Manabu Higashida */
743 unsigned char *tmp
, *defdir
;
747 CHECK_STRING (name
, 0);
749 /* If the file name has special constructs in it,
750 call the corresponding file handler. */
751 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
753 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
755 /* Use the buffer's default-directory if DEFALT is omitted. */
757 defalt
= current_buffer
->directory
;
758 CHECK_STRING (defalt
, 1);
762 handler
= Ffind_file_name_handler (defalt
, Qexpand_file_name
);
764 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
767 o
= XSTRING (defalt
)->data
;
769 /* Make sure DEFALT is properly expanded.
770 It would be better to do this down below where we actually use
771 defalt. Unfortunately, calling Fexpand_file_name recursively
772 could invoke GC, and the strings might be relocated. This would
773 be annoying because we have pointers into strings lying around
774 that would need adjusting, and people would add new pointers to
775 the code and forget to adjust them, resulting in intermittent bugs.
776 Putting this call here avoids all that crud.
778 The EQ test avoids infinite recursion. */
779 if (! NILP (defalt
) && !EQ (defalt
, name
)
780 /* This saves time in a common case. */
781 && ! (XSTRING (defalt
)->size
>= 3
782 && IS_DIRECTORY_SEP (XSTRING (defalt
)->data
[0])
783 && IS_DEVICE_SEP (XSTRING (defalt
)->data
[1])))
788 defalt
= Fexpand_file_name (defalt
, Qnil
);
793 /* Filenames on VMS are always upper case. */
794 name
= Fupcase (name
);
796 #ifdef FILE_SYSTEM_CASE
797 name
= FILE_SYSTEM_CASE (name
);
800 nm
= XSTRING (name
)->data
;
803 /* First map all backslashes to slashes. */
804 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
808 /* Now strip drive name. */
810 unsigned char *colon
= rindex (nm
, ':');
818 if (!IS_DIRECTORY_SEP (*nm
))
820 defdir
= alloca (MAXPATHLEN
+ 1);
821 relpath
= getdefdir (tolower (drive
) - 'a' + 1, defdir
);
827 /* If nm is absolute, flush ...// and detect /./ and /../.
828 If no /./ or /../ we can return right away. */
830 IS_DIRECTORY_SEP (nm
[0])
836 /* If it turns out that the filename we want to return is just a
837 suffix of FILENAME, we don't need to go through and edit
838 things; we just need to construct a new string using data
839 starting at the middle of FILENAME. If we set lose to a
840 non-zero value, that means we've discovered that we can't do
847 /* Since we know the path is absolute, we can assume that each
848 element starts with a "/". */
850 /* "//" anywhere isn't necessarily hairy; we just start afresh
851 with the second slash. */
852 if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
854 /* // at start of filename is meaningful on Apollo system */
858 /* \\ or // at the start of a pathname is meaningful on NT. */
860 #endif /* WINDOWSNT */
864 /* "~" is hairy as the start of any path element. */
865 if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '~')
866 nm
= p
+ 1, lose
= 1;
868 /* "." and ".." are hairy. */
869 if (IS_DIRECTORY_SEP (p
[0])
871 && (IS_DIRECTORY_SEP (p
[2])
873 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
880 /* if dev:[dir]/, move nm to / */
881 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
882 nm
= (brack
? brack
+ 1 : colon
+ 1);
891 /* VMS pre V4.4,convert '-'s in filenames. */
892 if (lbrack
== rbrack
)
894 if (dots
< 2) /* this is to allow negative version numbers */
899 if (lbrack
> rbrack
&&
900 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
901 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
907 /* count open brackets, reset close bracket pointer */
908 if (p
[0] == '[' || p
[0] == '<')
910 /* count close brackets, set close bracket pointer */
911 if (p
[0] == ']' || p
[0] == '>')
913 /* detect ][ or >< */
914 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
916 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
917 nm
= p
+ 1, lose
= 1;
918 if (p
[0] == ':' && (colon
|| slash
))
919 /* if dev1:[dir]dev2:, move nm to dev2: */
925 /* if /pathname/dev:, move nm to dev: */
928 /* if node::dev:, move colon following dev */
929 else if (colon
&& colon
[-1] == ':')
931 /* if dev1:dev2:, move nm to dev2: */
932 else if (colon
&& colon
[-1] != ':')
937 if (p
[0] == ':' && !colon
)
943 if (lbrack
== rbrack
)
946 else if (p
[0] == '.')
955 return build_string (sys_translate_unix (nm
));
958 if (nm
== XSTRING (name
)->data
)
960 return build_string (nm
);
961 #endif /* not DOS_NT */
965 /* Now determine directory to start with and put it in newdir */
969 if (nm
[0] == '~') /* prefix ~ */
971 if (IS_DIRECTORY_SEP (nm
[1])
975 || nm
[1] == 0) /* ~ by itself */
977 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
978 newdir
= (unsigned char *) "";
980 /* Problem when expanding "~\" if HOME is not on current drive.
981 Ulrich Leodolter, Wed Jan 11 10:20:35 1995 */
982 if (newdir
[1] == ':')
984 dostounix_filename (newdir
);
988 nm
++; /* Don't leave the slash in nm. */
991 else /* ~user/filename */
993 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
998 o
= (unsigned char *) alloca (p
- nm
+ 1);
999 bcopy ((char *) nm
, o
, p
- nm
);
1003 newdir
= (unsigned char *) egetenv ("HOME");
1004 dostounix_filename (newdir
);
1005 #else /* not WINDOWSNT */
1006 pw
= (struct passwd
*) getpwnam (o
+ 1);
1009 newdir
= (unsigned char *) pw
-> pw_dir
;
1011 nm
= p
+ 1; /* skip the terminator */
1016 #endif /* not WINDOWSNT */
1018 /* If we don't find a user of that name, leave the name
1019 unchanged; don't move nm forward to p. */
1023 if (!IS_ANY_SEP (nm
[0])
1026 #endif /* not VMS */
1032 newdir
= XSTRING (defalt
)->data
;
1036 if (newdir
== 0 && relpath
)
1041 /* Get rid of any slash at the end of newdir. */
1042 int length
= strlen (newdir
);
1043 /* Adding `length > 1 &&' makes ~ expand into / when homedir
1044 is the root dir. People disagree about whether that is right.
1045 Anyway, we can't take the risk of this change now. */
1047 if (newdir
[1] != ':' && length
> 1)
1049 if (IS_DIRECTORY_SEP (newdir
[length
- 1]))
1051 unsigned char *temp
= (unsigned char *) alloca (length
);
1052 bcopy (newdir
, temp
, length
- 1);
1053 temp
[length
- 1] = 0;
1061 /* Now concatenate the directory and name to new space in the stack frame */
1062 tlen
+= strlen (nm
) + 1;
1064 /* Add reserved space for drive name. (The Microsoft x86 compiler
1065 produces incorrect code if the following two lines are combined.) */
1066 target
= (unsigned char *) alloca (tlen
+ 2);
1068 #else /* not DOS_NT */
1069 target
= (unsigned char *) alloca (tlen
);
1070 #endif /* not DOS_NT */
1076 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1077 strcpy (target
, newdir
);
1080 file_name_as_directory (target
, newdir
);
1083 strcat (target
, nm
);
1085 if (index (target
, '/'))
1086 strcpy (target
, sys_translate_unix (target
));
1089 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1097 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1103 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1104 /* brackets are offset from each other by 2 */
1107 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1108 /* convert [foo][bar] to [bar] */
1109 while (o
[-1] != '[' && o
[-1] != '<')
1111 else if (*p
== '-' && *o
!= '.')
1114 else if (p
[0] == '-' && o
[-1] == '.' &&
1115 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1116 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1120 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1121 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1123 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1125 /* else [foo.-] ==> [-] */
1131 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1132 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1138 if (!IS_DIRECTORY_SEP (*p
))
1144 (!strncmp (p
, "\\\\", 2) || !strncmp (p
, "//", 2))
1145 #else /* not WINDOWSNT */
1146 !strncmp (p
, "//", 2)
1147 #endif /* not WINDOWSNT */
1149 /* // at start of filename is meaningful in Apollo system */
1153 /* \\ at start of filename is meaningful in Windows-NT */
1155 #endif /* WINDOWSNT */
1161 else if (IS_DIRECTORY_SEP (p
[0])
1163 && (IS_DIRECTORY_SEP (p
[2])
1166 /* If "/." is the entire filename, keep the "/". Otherwise,
1167 just delete the whole "/.". */
1168 if (o
== target
&& p
[2] == '\0')
1174 (!strncmp (p
, "\\..", 3) || !strncmp (p
, "/..", 3))
1175 #else /* not WINDOWSNT */
1176 !strncmp (p
, "/..", 3)
1177 #endif /* not WINDOWSNT */
1178 /* `/../' is the "superroot" on certain file systems. */
1180 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1182 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1185 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1190 if (o
== target
+ 1 && (o
[-1] == '/' && o
[0] == '/')
1191 || (o
[-1] == '\\' && o
[0] == '\\'))
1194 #endif /* WINDOWSNT */
1195 if (o
== target
&& IS_ANY_SEP (*o
))
1203 #endif /* not VMS */
1207 /* at last, set drive name. */
1208 if (target
[1] != ':'
1210 /* Allow network paths that look like "\\foo" */
1211 && !(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1]))
1212 #endif /* WINDOWSNT */
1216 target
[0] = (drive
< 0 ? getdisk () + 'A' : drive
);
1221 return make_string (target
, o
- target
);
1225 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1226 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1227 "Convert FILENAME to absolute, and canonicalize it.\n\
1228 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1229 (does not start with slash); if DEFAULT is nil or missing,\n\
1230 the current buffer's value of default-directory is used.\n\
1231 Filenames containing `.' or `..' as components are simplified;\n\
1232 initial `~/' expands to your home directory.\n\
1233 See also the function `substitute-in-file-name'.")
1235 Lisp_Object name
, defalt
;
1239 register unsigned char *newdir
, *p
, *o
;
1241 unsigned char *target
;
1245 unsigned char * colon
= 0;
1246 unsigned char * close
= 0;
1247 unsigned char * slash
= 0;
1248 unsigned char * brack
= 0;
1249 int lbrack
= 0, rbrack
= 0;
1253 CHECK_STRING (name
, 0);
1256 /* Filenames on VMS are always upper case. */
1257 name
= Fupcase (name
);
1260 nm
= XSTRING (name
)->data
;
1262 /* If nm is absolute, flush ...// and detect /./ and /../.
1263 If no /./ or /../ we can return right away. */
1275 if (p
[0] == '/' && p
[1] == '/'
1277 /* // at start of filename is meaningful on Apollo system */
1282 if (p
[0] == '/' && p
[1] == '~')
1283 nm
= p
+ 1, lose
= 1;
1284 if (p
[0] == '/' && p
[1] == '.'
1285 && (p
[2] == '/' || p
[2] == 0
1286 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1292 /* if dev:[dir]/, move nm to / */
1293 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1294 nm
= (brack
? brack
+ 1 : colon
+ 1);
1295 lbrack
= rbrack
= 0;
1303 /* VMS pre V4.4,convert '-'s in filenames. */
1304 if (lbrack
== rbrack
)
1306 if (dots
< 2) /* this is to allow negative version numbers */
1311 if (lbrack
> rbrack
&&
1312 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1313 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1319 /* count open brackets, reset close bracket pointer */
1320 if (p
[0] == '[' || p
[0] == '<')
1321 lbrack
++, brack
= 0;
1322 /* count close brackets, set close bracket pointer */
1323 if (p
[0] == ']' || p
[0] == '>')
1324 rbrack
++, brack
= p
;
1325 /* detect ][ or >< */
1326 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1328 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1329 nm
= p
+ 1, lose
= 1;
1330 if (p
[0] == ':' && (colon
|| slash
))
1331 /* if dev1:[dir]dev2:, move nm to dev2: */
1337 /* if /pathname/dev:, move nm to dev: */
1340 /* if node::dev:, move colon following dev */
1341 else if (colon
&& colon
[-1] == ':')
1343 /* if dev1:dev2:, move nm to dev2: */
1344 else if (colon
&& colon
[-1] != ':')
1349 if (p
[0] == ':' && !colon
)
1355 if (lbrack
== rbrack
)
1358 else if (p
[0] == '.')
1366 if (index (nm
, '/'))
1367 return build_string (sys_translate_unix (nm
));
1369 if (nm
== XSTRING (name
)->data
)
1371 return build_string (nm
);
1375 /* Now determine directory to start with and put it in NEWDIR */
1379 if (nm
[0] == '~') /* prefix ~ */
1384 || nm
[1] == 0)/* ~/filename */
1386 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1387 newdir
= (unsigned char *) "";
1390 nm
++; /* Don't leave the slash in nm. */
1393 else /* ~user/filename */
1395 /* Get past ~ to user */
1396 unsigned char *user
= nm
+ 1;
1397 /* Find end of name. */
1398 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1399 int len
= ptr
? ptr
- user
: strlen (user
);
1401 unsigned char *ptr1
= index (user
, ':');
1402 if (ptr1
!= 0 && ptr1
- user
< len
)
1405 /* Copy the user name into temp storage. */
1406 o
= (unsigned char *) alloca (len
+ 1);
1407 bcopy ((char *) user
, o
, len
);
1410 /* Look up the user name. */
1411 pw
= (struct passwd
*) getpwnam (o
+ 1);
1413 error ("\"%s\" isn't a registered user", o
+ 1);
1415 newdir
= (unsigned char *) pw
->pw_dir
;
1417 /* Discard the user name from NM. */
1424 #endif /* not VMS */
1428 defalt
= current_buffer
->directory
;
1429 CHECK_STRING (defalt
, 1);
1430 newdir
= XSTRING (defalt
)->data
;
1433 /* Now concatenate the directory and name to new space in the stack frame */
1435 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1436 target
= (unsigned char *) alloca (tlen
);
1442 if (nm
[0] == 0 || nm
[0] == '/')
1443 strcpy (target
, newdir
);
1446 file_name_as_directory (target
, newdir
);
1449 strcat (target
, nm
);
1451 if (index (target
, '/'))
1452 strcpy (target
, sys_translate_unix (target
));
1455 /* Now canonicalize by removing /. and /foo/.. if they appear */
1463 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1469 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1470 /* brackets are offset from each other by 2 */
1473 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1474 /* convert [foo][bar] to [bar] */
1475 while (o
[-1] != '[' && o
[-1] != '<')
1477 else if (*p
== '-' && *o
!= '.')
1480 else if (p
[0] == '-' && o
[-1] == '.' &&
1481 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1482 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1486 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1487 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1489 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1491 /* else [foo.-] ==> [-] */
1497 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1498 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1508 else if (!strncmp (p
, "//", 2)
1510 /* // at start of filename is meaningful in Apollo system */
1518 else if (p
[0] == '/' && p
[1] == '.' &&
1519 (p
[2] == '/' || p
[2] == 0))
1521 else if (!strncmp (p
, "/..", 3)
1522 /* `/../' is the "superroot" on certain file systems. */
1524 && (p
[3] == '/' || p
[3] == 0))
1526 while (o
!= target
&& *--o
!= '/')
1529 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1533 if (o
== target
&& *o
== '/')
1541 #endif /* not VMS */
1544 return make_string (target
, o
- target
);
1548 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1549 Ssubstitute_in_file_name
, 1, 1, 0,
1550 "Substitute environment variables referred to in FILENAME.\n\
1551 `$FOO' where FOO is an environment variable name means to substitute\n\
1552 the value of that variable. The variable name should be terminated\n\
1553 with a character not a letter, digit or underscore; otherwise, enclose\n\
1554 the entire variable name in braces.\n\
1555 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1556 On VMS, `$' substitution is not done; this function does little and only\n\
1557 duplicates what `expand-file-name' does.")
1563 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1564 unsigned char *target
;
1566 int substituted
= 0;
1568 Lisp_Object handler
;
1570 CHECK_STRING (string
, 0);
1572 /* If the file name has special constructs in it,
1573 call the corresponding file handler. */
1574 handler
= Ffind_file_name_handler (string
, Qsubstitute_in_file_name
);
1575 if (!NILP (handler
))
1576 return call2 (handler
, Qsubstitute_in_file_name
, string
);
1578 nm
= XSTRING (string
)->data
;
1580 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
1581 substituted
= !strcmp (nm
, XSTRING (string
)->data
);
1583 endp
= nm
+ XSTRING (string
)->size
;
1585 /* If /~ or // appears, discard everything through first slash. */
1587 for (p
= nm
; p
!= endp
; p
++)
1591 /* // at start of file name is meaningful in Apollo system */
1592 (p
[0] == '/' && p
- 1 != nm
)
1593 #else /* not APOLLO */
1595 (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1596 #else /* not WINDOWSNT */
1598 #endif /* not WINDOWSNT */
1599 #endif /* not APOLLO */
1604 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1606 || IS_DIRECTORY_SEP (p
[-1])))
1612 if (p
[0] && p
[1] == ':')
1621 return build_string (nm
);
1624 /* See if any variables are substituted into the string
1625 and find the total length of their values in `total' */
1627 for (p
= nm
; p
!= endp
;)
1637 /* "$$" means a single "$" */
1646 while (p
!= endp
&& *p
!= '}') p
++;
1647 if (*p
!= '}') goto missingclose
;
1653 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1657 /* Copy out the variable name */
1658 target
= (unsigned char *) alloca (s
- o
+ 1);
1659 strncpy (target
, o
, s
- o
);
1662 strupr (target
); /* $home == $HOME etc. */
1665 /* Get variable value */
1666 o
= (unsigned char *) egetenv (target
);
1667 if (!o
) goto badvar
;
1668 total
+= strlen (o
);
1675 /* If substitution required, recopy the string and do it */
1676 /* Make space in stack frame for the new copy */
1677 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1680 /* Copy the rest of the name through, replacing $ constructs with values */
1697 while (p
!= endp
&& *p
!= '}') p
++;
1698 if (*p
!= '}') goto missingclose
;
1704 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1708 /* Copy out the variable name */
1709 target
= (unsigned char *) alloca (s
- o
+ 1);
1710 strncpy (target
, o
, s
- o
);
1713 strupr (target
); /* $home == $HOME etc. */
1716 /* Get variable value */
1717 o
= (unsigned char *) egetenv (target
);
1727 /* If /~ or // appears, discard everything through first slash. */
1729 for (p
= xnm
; p
!= x
; p
++)
1732 /* // at start of file name is meaningful in Apollo system */
1733 || (p
[0] == '/' && p
- 1 != xnm
)
1734 #else /* not APOLLO */
1736 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1737 #else /* not WINDOWSNT */
1739 #endif /* not WINDOWSNT */
1740 #endif /* not APOLLO */
1742 && p
!= nm
&& IS_DIRECTORY_SEP (p
[-1]))
1745 else if (p
[0] && p
[1] == ':')
1749 return make_string (xnm
, x
- xnm
);
1752 error ("Bad format environment-variable substitution");
1754 error ("Missing \"}\" in environment-variable substitution");
1756 error ("Substituting nonexistent environment variable \"%s\"", target
);
1759 #endif /* not VMS */
1762 /* A slightly faster and more convenient way to get
1763 (directory-file-name (expand-file-name FOO)). */
1766 expand_and_dir_to_file (filename
, defdir
)
1767 Lisp_Object filename
, defdir
;
1769 register Lisp_Object abspath
;
1771 abspath
= Fexpand_file_name (filename
, defdir
);
1774 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1775 if (c
== ':' || c
== ']' || c
== '>')
1776 abspath
= Fdirectory_file_name (abspath
);
1779 /* Remove final slash, if any (unless path is root).
1780 stat behaves differently depending! */
1781 if (XSTRING (abspath
)->size
> 1
1782 && IS_DIRECTORY_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1])
1783 && !IS_DEVICE_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
-2]))
1784 /* We cannot take shortcuts; they might be wrong for magic file names. */
1785 abspath
= Fdirectory_file_name (abspath
);
1791 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1792 Lisp_Object absname
;
1793 unsigned char *querystring
;
1796 register Lisp_Object tem
;
1797 struct stat statbuf
;
1798 struct gcpro gcpro1
;
1800 /* stat is a good way to tell whether the file exists,
1801 regardless of what access permissions it has. */
1802 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1805 Fsignal (Qfile_already_exists
,
1806 Fcons (build_string ("File already exists"),
1807 Fcons (absname
, Qnil
)));
1809 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1810 XSTRING (absname
)->data
, querystring
));
1813 Fsignal (Qfile_already_exists
,
1814 Fcons (build_string ("File already exists"),
1815 Fcons (absname
, Qnil
)));
1820 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1821 "fCopy file: \nFCopy %s to file: \np\nP",
1822 "Copy FILE to NEWNAME. Both args must be strings.\n\
1823 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1824 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1825 A number as third arg means request confirmation if NEWNAME already exists.\n\
1826 This is what happens in interactive use with M-x.\n\
1827 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1828 last-modified time as the old one. (This works on only some systems.)\n\
1829 A prefix arg makes KEEP-TIME non-nil.")
1830 (filename
, newname
, ok_if_already_exists
, keep_date
)
1831 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1834 char buf
[16 * 1024];
1836 Lisp_Object handler
;
1837 struct gcpro gcpro1
, gcpro2
;
1838 int count
= specpdl_ptr
- specpdl
;
1839 int input_file_statable_p
;
1841 GCPRO2 (filename
, newname
);
1842 CHECK_STRING (filename
, 0);
1843 CHECK_STRING (newname
, 1);
1844 filename
= Fexpand_file_name (filename
, Qnil
);
1845 newname
= Fexpand_file_name (newname
, Qnil
);
1847 /* If the input file name has special constructs in it,
1848 call the corresponding file handler. */
1849 handler
= Ffind_file_name_handler (filename
, Qcopy_file
);
1850 /* Likewise for output file name. */
1852 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1853 if (!NILP (handler
))
1854 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, filename
, newname
,
1855 ok_if_already_exists
, keep_date
));
1857 if (NILP (ok_if_already_exists
)
1858 || INTEGERP (ok_if_already_exists
))
1859 barf_or_query_if_file_exists (newname
, "copy to it",
1860 INTEGERP (ok_if_already_exists
));
1862 ifd
= open (XSTRING (filename
)->data
, O_RDONLY
);
1864 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1866 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1868 /* We can only copy regular files and symbolic links. Other files are not
1870 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1872 #if defined (S_ISREG) && defined (S_ISLNK)
1873 if (input_file_statable_p
)
1875 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1877 #if defined (EISDIR)
1878 /* Get a better looking error message. */
1881 report_file_error ("Non-regular file", Fcons (filename
, Qnil
));
1884 #endif /* S_ISREG && S_ISLNK */
1887 /* Create the copy file with the same record format as the input file */
1888 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1891 /* System's default file type was set to binary by _fmode in emacs.c. */
1892 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1893 #else /* not MSDOS */
1894 ofd
= creat (XSTRING (newname
)->data
, 0666);
1895 #endif /* not MSDOS */
1898 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1900 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1904 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1905 if (write (ofd
, buf
, n
) != n
)
1906 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1909 /* Closing the output clobbers the file times on some systems. */
1910 if (close (ofd
) < 0)
1911 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1913 if (input_file_statable_p
)
1915 if (!NILP (keep_date
))
1917 EMACS_TIME atime
, mtime
;
1918 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1919 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1920 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
1921 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1924 if (!egetenv ("USE_DOMAIN_ACLS"))
1926 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1931 /* Discard the unwind protects. */
1932 specpdl_ptr
= specpdl
+ count
;
1938 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1939 Smake_directory_internal
, 1, 1, 0,
1940 "Create a directory. One argument, a file name string.")
1942 Lisp_Object dirname
;
1945 Lisp_Object handler
;
1947 CHECK_STRING (dirname
, 0);
1948 dirname
= Fexpand_file_name (dirname
, Qnil
);
1950 handler
= Ffind_file_name_handler (dirname
, Qmake_directory_internal
);
1951 if (!NILP (handler
))
1952 return call2 (handler
, Qmake_directory_internal
, dirname
);
1954 dir
= XSTRING (dirname
)->data
;
1957 if (mkdir (dir
) != 0)
1959 if (mkdir (dir
, 0777) != 0)
1961 report_file_error ("Creating directory", Flist (1, &dirname
));
1966 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1967 "Delete a directory. One argument, a file name or directory name string.")
1969 Lisp_Object dirname
;
1972 Lisp_Object handler
;
1974 CHECK_STRING (dirname
, 0);
1975 dirname
= Fdirectory_file_name (Fexpand_file_name (dirname
, Qnil
));
1976 dir
= XSTRING (dirname
)->data
;
1978 handler
= Ffind_file_name_handler (dirname
, Qdelete_directory
);
1979 if (!NILP (handler
))
1980 return call2 (handler
, Qdelete_directory
, dirname
);
1982 if (rmdir (dir
) != 0)
1983 report_file_error ("Removing directory", Flist (1, &dirname
));
1988 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1989 "Delete specified file. One argument, a file name string.\n\
1990 If file has multiple names, it continues to exist with the other names.")
1992 Lisp_Object filename
;
1994 Lisp_Object handler
;
1995 CHECK_STRING (filename
, 0);
1996 filename
= Fexpand_file_name (filename
, Qnil
);
1998 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
1999 if (!NILP (handler
))
2000 return call2 (handler
, Qdelete_file
, filename
);
2002 if (0 > unlink (XSTRING (filename
)->data
))
2003 report_file_error ("Removing old name", Flist (1, &filename
));
2008 internal_delete_file_1 (ignore
)
2014 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2017 internal_delete_file (filename
)
2018 Lisp_Object filename
;
2020 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2021 Qt
, internal_delete_file_1
));
2024 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2025 "fRename file: \nFRename %s to file: \np",
2026 "Rename FILE as NEWNAME. Both args strings.\n\
2027 If file has names other than FILE, it continues to have those names.\n\
2028 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2029 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2030 A number as third arg means request confirmation if NEWNAME already exists.\n\
2031 This is what happens in interactive use with M-x.")
2032 (filename
, newname
, ok_if_already_exists
)
2033 Lisp_Object filename
, newname
, ok_if_already_exists
;
2036 Lisp_Object args
[2];
2038 Lisp_Object handler
;
2039 struct gcpro gcpro1
, gcpro2
;
2041 GCPRO2 (filename
, newname
);
2042 CHECK_STRING (filename
, 0);
2043 CHECK_STRING (newname
, 1);
2044 filename
= Fexpand_file_name (filename
, Qnil
);
2045 newname
= Fexpand_file_name (newname
, Qnil
);
2047 /* If the file name has special constructs in it,
2048 call the corresponding file handler. */
2049 handler
= Ffind_file_name_handler (filename
, Qrename_file
);
2051 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2052 if (!NILP (handler
))
2053 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2054 filename
, newname
, ok_if_already_exists
));
2056 if (NILP (ok_if_already_exists
)
2057 || INTEGERP (ok_if_already_exists
))
2058 barf_or_query_if_file_exists (newname
, "rename to it",
2059 INTEGERP (ok_if_already_exists
));
2061 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2064 if (!MoveFile (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2065 #else /* not WINDOWSNT */
2066 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
2067 || 0 > unlink (XSTRING (filename
)->data
))
2068 #endif /* not WINDOWSNT */
2072 /* Why two? And why doesn't MS document what MoveFile will return? */
2073 if (GetLastError () == ERROR_FILE_EXISTS
2074 || GetLastError () == ERROR_ALREADY_EXISTS
)
2075 #else /* not WINDOWSNT */
2077 #endif /* not WINDOWSNT */
2079 Fcopy_file (filename
, newname
,
2080 /* We have already prompted if it was an integer,
2081 so don't have copy-file prompt again. */
2082 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2083 Fdelete_file (filename
);
2090 report_file_error ("Renaming", Flist (2, args
));
2093 report_file_error ("Renaming", Flist (2, &filename
));
2100 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2101 "fAdd name to file: \nFName to add to %s: \np",
2102 "Give FILE additional name NEWNAME. Both args strings.\n\
2103 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2104 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2105 A number as third arg means request confirmation if NEWNAME already exists.\n\
2106 This is what happens in interactive use with M-x.")
2107 (filename
, newname
, ok_if_already_exists
)
2108 Lisp_Object filename
, newname
, ok_if_already_exists
;
2111 Lisp_Object args
[2];
2113 Lisp_Object handler
;
2114 struct gcpro gcpro1
, gcpro2
;
2116 GCPRO2 (filename
, newname
);
2117 CHECK_STRING (filename
, 0);
2118 CHECK_STRING (newname
, 1);
2119 filename
= Fexpand_file_name (filename
, Qnil
);
2120 newname
= Fexpand_file_name (newname
, Qnil
);
2122 /* If the file name has special constructs in it,
2123 call the corresponding file handler. */
2124 handler
= Ffind_file_name_handler (filename
, Qadd_name_to_file
);
2125 if (!NILP (handler
))
2126 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
2127 newname
, ok_if_already_exists
));
2129 if (NILP (ok_if_already_exists
)
2130 || INTEGERP (ok_if_already_exists
))
2131 barf_or_query_if_file_exists (newname
, "make it a new name",
2132 INTEGERP (ok_if_already_exists
));
2134 /* Windows does not support this operation. */
2135 report_file_error ("Adding new name", Flist (2, &filename
));
2136 #else /* not WINDOWSNT */
2138 unlink (XSTRING (newname
)->data
);
2139 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2144 report_file_error ("Adding new name", Flist (2, args
));
2146 report_file_error ("Adding new name", Flist (2, &filename
));
2149 #endif /* not WINDOWSNT */
2156 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2157 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2158 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2159 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2160 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2161 A number as third arg means request confirmation if LINKNAME already exists.\n\
2162 This happens for interactive use with M-x.")
2163 (filename
, linkname
, ok_if_already_exists
)
2164 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2167 Lisp_Object args
[2];
2169 Lisp_Object handler
;
2170 struct gcpro gcpro1
, gcpro2
;
2172 GCPRO2 (filename
, linkname
);
2173 CHECK_STRING (filename
, 0);
2174 CHECK_STRING (linkname
, 1);
2175 /* If the link target has a ~, we must expand it to get
2176 a truly valid file name. Otherwise, do not expand;
2177 we want to permit links to relative file names. */
2178 if (XSTRING (filename
)->data
[0] == '~')
2179 filename
= Fexpand_file_name (filename
, Qnil
);
2180 linkname
= Fexpand_file_name (linkname
, Qnil
);
2182 /* If the file name has special constructs in it,
2183 call the corresponding file handler. */
2184 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2185 if (!NILP (handler
))
2186 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2187 linkname
, ok_if_already_exists
));
2189 if (NILP (ok_if_already_exists
)
2190 || INTEGERP (ok_if_already_exists
))
2191 barf_or_query_if_file_exists (linkname
, "make it a link",
2192 INTEGERP (ok_if_already_exists
));
2193 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2195 /* If we didn't complain already, silently delete existing file. */
2196 if (errno
== EEXIST
)
2198 unlink (XSTRING (linkname
)->data
);
2199 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2209 report_file_error ("Making symbolic link", Flist (2, args
));
2211 report_file_error ("Making symbolic link", Flist (2, &filename
));
2217 #endif /* S_IFLNK */
2221 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2222 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2223 "Define the job-wide logical name NAME to have the value STRING.\n\
2224 If STRING is nil or a null string, the logical name NAME is deleted.")
2226 Lisp_Object varname
;
2229 CHECK_STRING (varname
, 0);
2231 delete_logical_name (XSTRING (varname
)->data
);
2234 CHECK_STRING (string
, 1);
2236 if (XSTRING (string
)->size
== 0)
2237 delete_logical_name (XSTRING (varname
)->data
);
2239 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2248 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2249 "Open a network connection to PATH using LOGIN as the login string.")
2251 Lisp_Object path
, login
;
2255 CHECK_STRING (path
, 0);
2256 CHECK_STRING (login
, 0);
2258 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2260 if (netresult
== -1)
2265 #endif /* HPUX_NET */
2267 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2269 "Return t if file FILENAME specifies an absolute path name.\n\
2270 On Unix, this is a name starting with a `/' or a `~'.")
2272 Lisp_Object filename
;
2276 CHECK_STRING (filename
, 0);
2277 ptr
= XSTRING (filename
)->data
;
2278 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2280 /* ??? This criterion is probably wrong for '<'. */
2281 || index (ptr
, ':') || index (ptr
, '<')
2282 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2286 || (*ptr
!= 0 && ptr
[1] == ':' && (ptr
[2] == '/' || ptr
[2] == '\\'))
2294 /* Return nonzero if file FILENAME exists and can be executed. */
2297 check_executable (filename
)
2301 return (eaccess (filename
, 1) >= 0);
2303 /* Access isn't quite right because it uses the real uid
2304 and we really want to test with the effective uid.
2305 But Unix doesn't give us a right way to do it. */
2306 return (access (filename
, 1) >= 0);
2310 /* Return nonzero if file FILENAME exists and can be written. */
2313 check_writable (filename
)
2317 return (eaccess (filename
, 2) >= 0);
2319 /* Access isn't quite right because it uses the real uid
2320 and we really want to test with the effective uid.
2321 But Unix doesn't give us a right way to do it.
2322 Opening with O_WRONLY could work for an ordinary file,
2323 but would lose for directories. */
2324 return (access (filename
, 2) >= 0);
2328 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2329 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2330 See also `file-readable-p' and `file-attributes'.")
2332 Lisp_Object filename
;
2334 Lisp_Object abspath
;
2335 Lisp_Object handler
;
2336 struct stat statbuf
;
2338 CHECK_STRING (filename
, 0);
2339 abspath
= Fexpand_file_name (filename
, Qnil
);
2341 /* If the file name has special constructs in it,
2342 call the corresponding file handler. */
2343 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2344 if (!NILP (handler
))
2345 return call2 (handler
, Qfile_exists_p
, abspath
);
2347 return (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2350 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2351 "Return t if FILENAME can be executed by you.\n\
2352 For a directory, this means you can access files in that directory.")
2354 Lisp_Object filename
;
2357 Lisp_Object abspath
;
2358 Lisp_Object handler
;
2360 CHECK_STRING (filename
, 0);
2361 abspath
= Fexpand_file_name (filename
, Qnil
);
2363 /* If the file name has special constructs in it,
2364 call the corresponding file handler. */
2365 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2366 if (!NILP (handler
))
2367 return call2 (handler
, Qfile_executable_p
, abspath
);
2369 return (check_executable (XSTRING (abspath
)->data
) ? Qt
: Qnil
);
2372 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2373 "Return t if file FILENAME exists and you can read it.\n\
2374 See also `file-exists-p' and `file-attributes'.")
2376 Lisp_Object filename
;
2378 Lisp_Object abspath
;
2379 Lisp_Object handler
;
2382 CHECK_STRING (filename
, 0);
2383 abspath
= Fexpand_file_name (filename
, Qnil
);
2385 /* If the file name has special constructs in it,
2386 call the corresponding file handler. */
2387 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2388 if (!NILP (handler
))
2389 return call2 (handler
, Qfile_readable_p
, abspath
);
2391 desc
= open (XSTRING (abspath
)->data
, O_RDONLY
);
2398 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2400 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2401 "Return t if file FILENAME can be written or created by you.")
2403 Lisp_Object filename
;
2405 Lisp_Object abspath
, dir
;
2406 Lisp_Object handler
;
2407 struct stat statbuf
;
2409 CHECK_STRING (filename
, 0);
2410 abspath
= Fexpand_file_name (filename
, Qnil
);
2412 /* If the file name has special constructs in it,
2413 call the corresponding file handler. */
2414 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2415 if (!NILP (handler
))
2416 return call2 (handler
, Qfile_writable_p
, abspath
);
2418 if (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0)
2419 return (check_writable (XSTRING (abspath
)->data
)
2421 dir
= Ffile_name_directory (abspath
);
2424 dir
= Fdirectory_file_name (dir
);
2428 dir
= Fdirectory_file_name (dir
);
2430 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2434 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2435 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2436 The value is the name of the file to which it is linked.\n\
2437 Otherwise returns nil.")
2439 Lisp_Object filename
;
2446 Lisp_Object handler
;
2448 CHECK_STRING (filename
, 0);
2449 filename
= Fexpand_file_name (filename
, Qnil
);
2451 /* If the file name has special constructs in it,
2452 call the corresponding file handler. */
2453 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2454 if (!NILP (handler
))
2455 return call2 (handler
, Qfile_symlink_p
, filename
);
2460 buf
= (char *) xmalloc (bufsize
);
2461 bzero (buf
, bufsize
);
2462 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2463 if (valsize
< bufsize
) break;
2464 /* Buffer was not long enough */
2473 val
= make_string (buf
, valsize
);
2476 #else /* not S_IFLNK */
2478 #endif /* not S_IFLNK */
2481 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2482 "Return t if file FILENAME is the name of a directory as a file.\n\
2483 A directory name spec may be given instead; then the value is t\n\
2484 if the directory so specified exists and really is a directory.")
2486 Lisp_Object filename
;
2488 register Lisp_Object abspath
;
2490 Lisp_Object handler
;
2492 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2494 /* If the file name has special constructs in it,
2495 call the corresponding file handler. */
2496 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2497 if (!NILP (handler
))
2498 return call2 (handler
, Qfile_directory_p
, abspath
);
2500 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2502 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2505 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2506 "Return t if file FILENAME is the name of a directory as a file,\n\
2507 and files in that directory can be opened by you. In order to use a\n\
2508 directory as a buffer's current directory, this predicate must return true.\n\
2509 A directory name spec may be given instead; then the value is t\n\
2510 if the directory so specified exists and really is a readable and\n\
2511 searchable directory.")
2513 Lisp_Object filename
;
2515 Lisp_Object handler
;
2517 struct gcpro gcpro1
;
2519 /* If the file name has special constructs in it,
2520 call the corresponding file handler. */
2521 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2522 if (!NILP (handler
))
2523 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2525 /* It's an unlikely combination, but yes we really do need to gcpro:
2526 Suppose that file-accessible-directory-p has no handler, but
2527 file-directory-p does have a handler; this handler causes a GC which
2528 relocates the string in `filename'; and finally file-directory-p
2529 returns non-nil. Then we would end up passing a garbaged string
2530 to file-executable-p. */
2532 tem
= (NILP (Ffile_directory_p (filename
))
2533 || NILP (Ffile_executable_p (filename
)));
2535 return tem
? Qnil
: Qt
;
2538 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2539 "Return t if file FILENAME is the name of a regular file.\n\
2540 This is the sort of file that holds an ordinary stream of data bytes.")
2542 Lisp_Object filename
;
2544 register Lisp_Object abspath
;
2546 Lisp_Object handler
;
2548 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2550 /* If the file name has special constructs in it,
2551 call the corresponding file handler. */
2552 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2553 if (!NILP (handler
))
2554 return call2 (handler
, Qfile_directory_p
, abspath
);
2556 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2558 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2561 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2562 "Return mode bits of FILE, as an integer.")
2564 Lisp_Object filename
;
2566 Lisp_Object abspath
;
2568 Lisp_Object handler
;
2570 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2572 /* If the file name has special constructs in it,
2573 call the corresponding file handler. */
2574 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2575 if (!NILP (handler
))
2576 return call2 (handler
, Qfile_modes
, abspath
);
2578 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2584 if (S_ISREG (st
.st_mode
)
2585 && (len
= XSTRING (abspath
)->size
) >= 5
2586 && (stricmp ((suffix
= XSTRING (abspath
)->data
+ len
-4), ".com") == 0
2587 || stricmp (suffix
, ".exe") == 0
2588 || stricmp (suffix
, ".bat") == 0))
2589 st
.st_mode
|= S_IEXEC
;
2593 return make_number (st
.st_mode
& 07777);
2596 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2597 "Set mode bits of FILE to MODE (an integer).\n\
2598 Only the 12 low bits of MODE are used.")
2600 Lisp_Object filename
, mode
;
2602 Lisp_Object abspath
;
2603 Lisp_Object handler
;
2605 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2606 CHECK_NUMBER (mode
, 1);
2608 /* If the file name has special constructs in it,
2609 call the corresponding file handler. */
2610 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2611 if (!NILP (handler
))
2612 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2615 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2616 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2618 if (!egetenv ("USE_DOMAIN_ACLS"))
2621 struct timeval tvp
[2];
2623 /* chmod on apollo also change the file's modtime; need to save the
2624 modtime and then restore it. */
2625 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2627 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2631 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2632 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2634 /* reset the old accessed and modified times. */
2635 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2637 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2640 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2641 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2648 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2649 "Set the file permission bits for newly created files.\n\
2650 The argument MODE should be an integer; only the low 9 bits are used.\n\
2651 This setting is inherited by subprocesses.")
2655 CHECK_NUMBER (mode
, 0);
2657 umask ((~ XINT (mode
)) & 0777);
2662 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2663 "Return the default file protection for created files.\n\
2664 The value is an integer.")
2670 realmask
= umask (0);
2673 XSETINT (value
, (~ realmask
) & 0777);
2679 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2680 "Tell Unix to finish all pending disk updates.")
2689 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2690 "Return t if file FILE1 is newer than file FILE2.\n\
2691 If FILE1 does not exist, the answer is nil;\n\
2692 otherwise, if FILE2 does not exist, the answer is t.")
2694 Lisp_Object file1
, file2
;
2696 Lisp_Object abspath1
, abspath2
;
2699 Lisp_Object handler
;
2700 struct gcpro gcpro1
, gcpro2
;
2702 CHECK_STRING (file1
, 0);
2703 CHECK_STRING (file2
, 0);
2706 GCPRO2 (abspath1
, file2
);
2707 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2708 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2711 /* If the file name has special constructs in it,
2712 call the corresponding file handler. */
2713 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2715 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2716 if (!NILP (handler
))
2717 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2719 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2722 mtime1
= st
.st_mtime
;
2724 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2727 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2731 Lisp_Object Qfind_buffer_file_type
;
2734 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2736 "Insert contents of file FILENAME after point.\n\
2737 Returns list of absolute file name and length of data inserted.\n\
2738 If second argument VISIT is non-nil, the buffer's visited filename\n\
2739 and last save file modtime are set, and it is marked unmodified.\n\
2740 If visiting and the file does not exist, visiting is completed\n\
2741 before the error is signaled.\n\n\
2742 The optional third and fourth arguments BEG and END\n\
2743 specify what portion of the file to insert.\n\
2744 If VISIT is non-nil, BEG and END must be nil.\n\
2745 If optional fifth argument REPLACE is non-nil,\n\
2746 it means replace the current buffer contents (in the accessible portion)\n\
2747 with the file contents. This is better than simply deleting and inserting\n\
2748 the whole thing because (1) it preserves some marker positions\n\
2749 and (2) it puts less data in the undo list.")
2750 (filename
, visit
, beg
, end
, replace
)
2751 Lisp_Object filename
, visit
, beg
, end
, replace
;
2755 register int inserted
= 0;
2756 register int how_much
;
2757 int count
= specpdl_ptr
- specpdl
;
2758 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2759 Lisp_Object handler
, val
, insval
;
2762 int not_regular
= 0;
2764 if (current_buffer
->base_buffer
&& ! NILP (visit
))
2765 error ("Cannot do file visiting in an indirect buffer");
2767 if (!NILP (current_buffer
->read_only
))
2768 Fbarf_if_buffer_read_only ();
2773 GCPRO3 (filename
, val
, p
);
2775 CHECK_STRING (filename
, 0);
2776 filename
= Fexpand_file_name (filename
, Qnil
);
2778 /* If the file name has special constructs in it,
2779 call the corresponding file handler. */
2780 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2781 if (!NILP (handler
))
2783 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2784 visit
, beg
, end
, replace
);
2791 if (stat (XSTRING (filename
)->data
, &st
) < 0)
2793 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
2794 || fstat (fd
, &st
) < 0)
2795 #endif /* not APOLLO */
2797 if (fd
>= 0) close (fd
);
2800 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2807 /* This code will need to be changed in order to work on named
2808 pipes, and it's probably just not worth it. So we should at
2809 least signal an error. */
2810 if (!S_ISREG (st
.st_mode
))
2813 Fsignal (Qfile_error
,
2814 Fcons (build_string ("not a regular file"),
2815 Fcons (filename
, Qnil
)));
2823 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
2826 /* Replacement should preserve point as it preserves markers. */
2827 if (!NILP (replace
))
2828 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2830 record_unwind_protect (close_file_unwind
, make_number (fd
));
2832 /* Supposedly happens on VMS. */
2834 error ("File size is negative");
2836 if (!NILP (beg
) || !NILP (end
))
2838 error ("Attempt to visit less than an entire file");
2841 CHECK_NUMBER (beg
, 0);
2843 XSETFASTINT (beg
, 0);
2846 CHECK_NUMBER (end
, 0);
2849 XSETINT (end
, st
.st_size
);
2850 if (XINT (end
) != st
.st_size
)
2851 error ("maximum buffer size exceeded");
2854 /* If requested, replace the accessible part of the buffer
2855 with the file contents. Avoid replacing text at the
2856 beginning or end of the buffer that matches the file contents;
2857 that preserves markers pointing to the unchanged parts. */
2859 /* On MSDOS, replace mode doesn't really work, except for binary files,
2860 and it's not worth supporting just for them. */
2861 if (!NILP (replace
))
2864 XSETFASTINT (beg
, 0);
2865 XSETFASTINT (end
, st
.st_size
);
2866 del_range_1 (BEGV
, ZV
, 0);
2868 #else /* not DOS_NT */
2869 if (!NILP (replace
))
2871 unsigned char buffer
[1 << 14];
2872 int same_at_start
= BEGV
;
2873 int same_at_end
= ZV
;
2878 /* Count how many chars at the start of the file
2879 match the text at the beginning of the buffer. */
2884 nread
= read (fd
, buffer
, sizeof buffer
);
2886 error ("IO error reading %s: %s",
2887 XSTRING (filename
)->data
, strerror (errno
));
2888 else if (nread
== 0)
2891 while (bufpos
< nread
&& same_at_start
< ZV
2892 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2893 same_at_start
++, bufpos
++;
2894 /* If we found a discrepancy, stop the scan.
2895 Otherwise loop around and scan the next bufferfull. */
2896 if (bufpos
!= nread
)
2900 /* If the file matches the buffer completely,
2901 there's no need to replace anything. */
2902 if (same_at_start
- BEGV
== st
.st_size
)
2906 /* Truncate the buffer to the size of the file. */
2907 del_range_1 (same_at_start
, same_at_end
, 0);
2912 /* Count how many chars at the end of the file
2913 match the text at the end of the buffer. */
2916 int total_read
, nread
, bufpos
, curpos
, trial
;
2918 /* At what file position are we now scanning? */
2919 curpos
= st
.st_size
- (ZV
- same_at_end
);
2920 /* If the entire file matches the buffer tail, stop the scan. */
2923 /* How much can we scan in the next step? */
2924 trial
= min (curpos
, sizeof buffer
);
2925 if (lseek (fd
, curpos
- trial
, 0) < 0)
2926 report_file_error ("Setting file position",
2927 Fcons (filename
, Qnil
));
2930 while (total_read
< trial
)
2932 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2934 error ("IO error reading %s: %s",
2935 XSTRING (filename
)->data
, strerror (errno
));
2936 total_read
+= nread
;
2938 /* Scan this bufferfull from the end, comparing with
2939 the Emacs buffer. */
2940 bufpos
= total_read
;
2941 /* Compare with same_at_start to avoid counting some buffer text
2942 as matching both at the file's beginning and at the end. */
2943 while (bufpos
> 0 && same_at_end
> same_at_start
2944 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2945 same_at_end
--, bufpos
--;
2946 /* If we found a discrepancy, stop the scan.
2947 Otherwise loop around and scan the preceding bufferfull. */
2953 /* Don't try to reuse the same piece of text twice. */
2954 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2956 same_at_end
+= overlap
;
2958 /* Arrange to read only the nonmatching middle part of the file. */
2959 XSETFASTINT (beg
, same_at_start
- BEGV
);
2960 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
2962 del_range_1 (same_at_start
, same_at_end
, 0);
2963 /* Insert from the file at the proper position. */
2964 SET_PT (same_at_start
);
2966 #endif /* not DOS_NT */
2968 total
= XINT (end
) - XINT (beg
);
2971 register Lisp_Object temp
;
2973 /* Make sure point-max won't overflow after this insertion. */
2974 XSETINT (temp
, total
);
2975 if (total
!= XINT (temp
))
2976 error ("maximum buffer size exceeded");
2979 if (NILP (visit
) && total
> 0)
2980 prepare_to_modify_buffer (point
, point
);
2983 if (GAP_SIZE
< total
)
2984 make_gap (total
- GAP_SIZE
);
2986 if (XINT (beg
) != 0 || !NILP (replace
))
2988 if (lseek (fd
, XINT (beg
), 0) < 0)
2989 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2993 while (inserted
< total
)
2995 /* try is reserved in some compilers (Microsoft C) */
2996 int trytry
= min (total
- inserted
, 64 << 10);
2999 /* Allow quitting out of the actual I/O. */
3002 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, trytry
);
3019 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3020 /* Determine file type from name and remove LFs from CR-LFs if the file
3021 is deemed to be a text file. */
3023 current_buffer
->buffer_file_type
3024 = call1 (Qfind_buffer_file_type
, filename
);
3025 if (NILP (current_buffer
->buffer_file_type
))
3028 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
3031 GPT
-= reduced_size
;
3032 GAP_SIZE
+= reduced_size
;
3033 inserted
-= reduced_size
;
3040 record_insert (point
, inserted
);
3042 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3043 offset_intervals (current_buffer
, point
, inserted
);
3049 /* Discard the unwind protect for closing the file. */
3053 error ("IO error reading %s: %s",
3054 XSTRING (filename
)->data
, strerror (errno
));
3061 if (!EQ (current_buffer
->undo_list
, Qt
))
3062 current_buffer
->undo_list
= Qnil
;
3064 stat (XSTRING (filename
)->data
, &st
);
3069 current_buffer
->modtime
= st
.st_mtime
;
3070 current_buffer
->filename
= filename
;
3073 SAVE_MODIFF
= MODIFF
;
3074 current_buffer
->auto_save_modified
= MODIFF
;
3075 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3076 #ifdef CLASH_DETECTION
3079 if (!NILP (current_buffer
->filename
))
3080 unlock_file (current_buffer
->filename
);
3081 unlock_file (filename
);
3083 #endif /* CLASH_DETECTION */
3085 Fsignal (Qfile_error
,
3086 Fcons (build_string ("not a regular file"),
3087 Fcons (filename
, Qnil
)));
3089 /* If visiting nonexistent file, return nil. */
3090 if (current_buffer
->modtime
== -1)
3091 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3094 /* Decode file format */
3097 insval
= call3 (Qformat_decode
,
3098 Qnil
, make_number (inserted
), visit
);
3099 CHECK_NUMBER (insval
, 0);
3100 inserted
= XFASTINT (insval
);
3103 if (inserted
> 0 && NILP (visit
) && total
> 0)
3104 signal_after_change (point
, 0, inserted
);
3108 p
= Vafter_insert_file_functions
;
3111 insval
= call1 (Fcar (p
), make_number (inserted
));
3114 CHECK_NUMBER (insval
, 0);
3115 inserted
= XFASTINT (insval
);
3123 val
= Fcons (filename
,
3124 Fcons (make_number (inserted
),
3127 RETURN_UNGCPRO (unbind_to (count
, val
));
3130 static Lisp_Object
build_annotations ();
3132 /* If build_annotations switched buffers, switch back to BUF.
3133 Kill the temporary buffer that was selected in the meantime. */
3136 build_annotations_unwind (buf
)
3141 if (XBUFFER (buf
) == current_buffer
)
3143 tembuf
= Fcurrent_buffer ();
3145 Fkill_buffer (tembuf
);
3149 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
3150 "r\nFWrite region to file: ",
3151 "Write current region into specified file.\n\
3152 When called from a program, takes three arguments:\n\
3153 START, END and FILENAME. START and END are buffer positions.\n\
3154 Optional fourth argument APPEND if non-nil means\n\
3155 append to existing file contents (if any).\n\
3156 Optional fifth argument VISIT if t means\n\
3157 set the last-save-file-modtime of buffer to this file's modtime\n\
3158 and mark buffer not modified.\n\
3159 If VISIT is a string, it is a second file name;\n\
3160 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3161 VISIT is also the file name to lock and unlock for clash detection.\n\
3162 If VISIT is neither t nor nil nor a string,\n\
3163 that means do not print the \"Wrote file\" message.\n\
3164 Kludgy feature: if START is a string, then that string is written\n\
3165 to the file, instead of any buffer contents, and END is ignored.")
3166 (start
, end
, filename
, append
, visit
)
3167 Lisp_Object start
, end
, filename
, append
, visit
;
3175 int count
= specpdl_ptr
- specpdl
;
3178 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3180 Lisp_Object handler
;
3181 Lisp_Object visit_file
;
3182 Lisp_Object annotations
;
3183 int visiting
, quietly
;
3184 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3185 struct buffer
*given_buffer
;
3187 int buffer_file_type
3188 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3191 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3192 error ("Cannot do file visiting in an indirect buffer");
3194 if (!NILP (start
) && !STRINGP (start
))
3195 validate_region (&start
, &end
);
3197 GCPRO2 (filename
, visit
);
3198 filename
= Fexpand_file_name (filename
, Qnil
);
3199 if (STRINGP (visit
))
3200 visit_file
= Fexpand_file_name (visit
, Qnil
);
3202 visit_file
= filename
;
3205 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3206 quietly
= !NILP (visit
);
3210 GCPRO4 (start
, filename
, annotations
, visit_file
);
3212 /* If the file name has special constructs in it,
3213 call the corresponding file handler. */
3214 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3215 /* If FILENAME has no handler, see if VISIT has one. */
3216 if (NILP (handler
) && STRINGP (visit
))
3217 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3219 if (!NILP (handler
))
3222 val
= call6 (handler
, Qwrite_region
, start
, end
,
3223 filename
, append
, visit
);
3227 SAVE_MODIFF
= MODIFF
;
3228 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3229 current_buffer
->filename
= visit_file
;
3235 /* Special kludge to simplify auto-saving. */
3238 XSETFASTINT (start
, BEG
);
3239 XSETFASTINT (end
, Z
);
3242 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3243 count1
= specpdl_ptr
- specpdl
;
3245 given_buffer
= current_buffer
;
3246 annotations
= build_annotations (start
, end
);
3247 if (current_buffer
!= given_buffer
)
3253 #ifdef CLASH_DETECTION
3255 lock_file (visit_file
);
3256 #endif /* CLASH_DETECTION */
3258 fn
= XSTRING (filename
)->data
;
3262 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3263 #else /* not DOS_NT */
3264 desc
= open (fn
, O_WRONLY
);
3265 #endif /* not DOS_NT */
3269 if (auto_saving
) /* Overwrite any previous version of autosave file */
3271 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3272 desc
= open (fn
, O_RDWR
);
3274 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3275 ? XSTRING (current_buffer
->filename
)->data
: 0,
3278 else /* Write to temporary name and rename if no errors */
3280 Lisp_Object temp_name
;
3281 temp_name
= Ffile_name_directory (filename
);
3283 if (!NILP (temp_name
))
3285 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3286 build_string ("$$SAVE$$")));
3287 fname
= XSTRING (filename
)->data
;
3288 fn
= XSTRING (temp_name
)->data
;
3289 desc
= creat_copy_attrs (fname
, fn
);
3292 /* If we can't open the temporary file, try creating a new
3293 version of the original file. VMS "creat" creates a
3294 new version rather than truncating an existing file. */
3297 desc
= creat (fn
, 0666);
3298 #if 0 /* This can clobber an existing file and fail to replace it,
3299 if the user runs out of space. */
3302 /* We can't make a new version;
3303 try to truncate and rewrite existing version if any. */
3305 desc
= open (fn
, O_RDWR
);
3311 desc
= creat (fn
, 0666);
3316 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3317 S_IREAD
| S_IWRITE
);
3318 #else /* not DOS_NT */
3319 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3320 #endif /* not DOS_NT */
3321 #endif /* not VMS */
3327 #ifdef CLASH_DETECTION
3329 if (!auto_saving
) unlock_file (visit_file
);
3331 #endif /* CLASH_DETECTION */
3332 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3335 record_unwind_protect (close_file_unwind
, make_number (desc
));
3338 if (lseek (desc
, 0, 2) < 0)
3340 #ifdef CLASH_DETECTION
3341 if (!auto_saving
) unlock_file (visit_file
);
3342 #endif /* CLASH_DETECTION */
3343 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3348 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3349 * if we do writes that don't end with a carriage return. Furthermore
3350 * it cannot handle writes of more then 16K. The modified
3351 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3352 * this EXCEPT for the last record (iff it doesn't end with a carriage
3353 * return). This implies that if your buffer doesn't end with a carriage
3354 * return, you get one free... tough. However it also means that if
3355 * we make two calls to sys_write (a la the following code) you can
3356 * get one at the gap as well. The easiest way to fix this (honest)
3357 * is to move the gap to the next newline (or the end of the buffer).
3362 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3363 move_gap (find_next_newline (GPT
, 1));
3369 if (STRINGP (start
))
3371 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3372 XSTRING (start
)->size
, 0, &annotations
);
3375 else if (XINT (start
) != XINT (end
))
3378 if (XINT (start
) < GPT
)
3380 register int end1
= XINT (end
);
3382 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3383 min (GPT
, end1
) - tem
, tem
, &annotations
);
3384 nwritten
+= min (GPT
, end1
) - tem
;
3388 if (XINT (end
) > GPT
&& !failure
)
3391 tem
= max (tem
, GPT
);
3392 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3394 nwritten
+= XINT (end
) - tem
;
3400 /* If file was empty, still need to write the annotations */
3401 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3409 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3410 Disk full in NFS may be reported here. */
3411 /* mib says that closing the file will try to write as fast as NFS can do
3412 it, and that means the fsync here is not crucial for autosave files. */
3413 if (!auto_saving
&& fsync (desc
) < 0)
3414 failure
= 1, save_errno
= errno
;
3417 /* Spurious "file has changed on disk" warnings have been
3418 observed on Suns as well.
3419 It seems that `close' can change the modtime, under nfs.
3421 (This has supposedly been fixed in Sunos 4,
3422 but who knows about all the other machines with NFS?) */
3425 /* On VMS and APOLLO, must do the stat after the close
3426 since closing changes the modtime. */
3429 /* Recall that #if defined does not work on VMS. */
3436 /* NFS can report a write failure now. */
3437 if (close (desc
) < 0)
3438 failure
= 1, save_errno
= errno
;
3441 /* If we wrote to a temporary name and had no errors, rename to real name. */
3445 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3453 /* Discard the unwind protect for close_file_unwind. */
3454 specpdl_ptr
= specpdl
+ count1
;
3455 /* Restore the original current buffer. */
3456 visit_file
= unbind_to (count
, visit_file
);
3458 #ifdef CLASH_DETECTION
3460 unlock_file (visit_file
);
3461 #endif /* CLASH_DETECTION */
3463 /* Do this before reporting IO error
3464 to avoid a "file has changed on disk" warning on
3465 next attempt to save. */
3467 current_buffer
->modtime
= st
.st_mtime
;
3470 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3474 SAVE_MODIFF
= MODIFF
;
3475 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3476 current_buffer
->filename
= visit_file
;
3477 update_mode_lines
++;
3483 message ("Wrote %s", XSTRING (visit_file
)->data
);
3488 Lisp_Object
merge ();
3490 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3491 "Return t if (car A) is numerically less than (car B).")
3495 return Flss (Fcar (a
), Fcar (b
));
3498 /* Build the complete list of annotations appropriate for writing out
3499 the text between START and END, by calling all the functions in
3500 write-region-annotate-functions and merging the lists they return.
3501 If one of these functions switches to a different buffer, we assume
3502 that buffer contains altered text. Therefore, the caller must
3503 make sure to restore the current buffer in all cases,
3504 as save-excursion would do. */
3507 build_annotations (start
, end
)
3508 Lisp_Object start
, end
;
3510 Lisp_Object annotations
;
3512 struct gcpro gcpro1
, gcpro2
;
3515 p
= Vwrite_region_annotate_functions
;
3516 GCPRO2 (annotations
, p
);
3519 struct buffer
*given_buffer
= current_buffer
;
3520 Vwrite_region_annotations_so_far
= annotations
;
3521 res
= call2 (Fcar (p
), start
, end
);
3522 /* If the function makes a different buffer current,
3523 assume that means this buffer contains altered text to be output.
3524 Reset START and END from the buffer bounds
3525 and discard all previous annotations because they should have
3526 been dealt with by this function. */
3527 if (current_buffer
!= given_buffer
)
3533 Flength (res
); /* Check basic validity of return value */
3534 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3538 /* Now do the same for annotation functions implied by the file-format */
3539 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
3540 p
= Vauto_save_file_format
;
3542 p
= current_buffer
->file_format
;
3545 struct buffer
*given_buffer
= current_buffer
;
3546 Vwrite_region_annotations_so_far
= annotations
;
3547 res
= call3 (Qformat_annotate_function
, Fcar (p
), start
, end
);
3548 if (current_buffer
!= given_buffer
)
3555 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3562 /* Write to descriptor DESC the LEN characters starting at ADDR,
3563 assuming they start at position POS in the buffer.
3564 Intersperse with them the annotations from *ANNOT
3565 (those which fall within the range of positions POS to POS + LEN),
3566 each at its appropriate position.
3568 Modify *ANNOT by discarding elements as we output them.
3569 The return value is negative in case of system call failure. */
3572 a_write (desc
, addr
, len
, pos
, annot
)
3574 register char *addr
;
3581 int lastpos
= pos
+ len
;
3583 while (NILP (*annot
) || CONSP (*annot
))
3585 tem
= Fcar_safe (Fcar (*annot
));
3586 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3587 nextpos
= XFASTINT (tem
);
3589 return e_write (desc
, addr
, lastpos
- pos
);
3592 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3594 addr
+= nextpos
- pos
;
3597 tem
= Fcdr (Fcar (*annot
));
3600 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3603 *annot
= Fcdr (*annot
);
3608 e_write (desc
, addr
, len
)
3610 register char *addr
;
3613 char buf
[16 * 1024];
3614 register char *p
, *end
;
3616 if (!EQ (current_buffer
->selective_display
, Qt
))
3617 return write (desc
, addr
, len
) - len
;
3621 end
= p
+ sizeof buf
;
3626 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3635 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3641 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3642 Sverify_visited_file_modtime
, 1, 1, 0,
3643 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3644 This means that the file has not been changed since it was visited or saved.")
3650 Lisp_Object handler
;
3652 CHECK_BUFFER (buf
, 0);
3655 if (!STRINGP (b
->filename
)) return Qt
;
3656 if (b
->modtime
== 0) return Qt
;
3658 /* If the file name has special constructs in it,
3659 call the corresponding file handler. */
3660 handler
= Ffind_file_name_handler (b
->filename
,
3661 Qverify_visited_file_modtime
);
3662 if (!NILP (handler
))
3663 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3665 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3667 /* If the file doesn't exist now and didn't exist before,
3668 we say that it isn't modified, provided the error is a tame one. */
3669 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3674 if (st
.st_mtime
== b
->modtime
3675 /* If both are positive, accept them if they are off by one second. */
3676 || (st
.st_mtime
> 0 && b
->modtime
> 0
3677 && (st
.st_mtime
== b
->modtime
+ 1
3678 || st
.st_mtime
== b
->modtime
- 1)))
3683 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3684 Sclear_visited_file_modtime
, 0, 0, 0,
3685 "Clear out records of last mod time of visited file.\n\
3686 Next attempt to save will certainly not complain of a discrepancy.")
3689 current_buffer
->modtime
= 0;
3693 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3694 Svisited_file_modtime
, 0, 0, 0,
3695 "Return the current buffer's recorded visited file modification time.\n\
3696 The value is a list of the form (HIGH . LOW), like the time values\n\
3697 that `file-attributes' returns.")
3700 return long_to_cons (current_buffer
->modtime
);
3703 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3704 Sset_visited_file_modtime
, 0, 1, 0,
3705 "Update buffer's recorded modification time from the visited file's time.\n\
3706 Useful if the buffer was not read from the file normally\n\
3707 or if the file itself has been changed for some known benign reason.\n\
3708 An argument specifies the modification time value to use\n\
3709 \(instead of that of the visited file), in the form of a list\n\
3710 \(HIGH . LOW) or (HIGH LOW).")
3712 Lisp_Object time_list
;
3714 if (!NILP (time_list
))
3715 current_buffer
->modtime
= cons_to_long (time_list
);
3718 register Lisp_Object filename
;
3720 Lisp_Object handler
;
3722 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3724 /* If the file name has special constructs in it,
3725 call the corresponding file handler. */
3726 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3727 if (!NILP (handler
))
3728 /* The handler can find the file name the same way we did. */
3729 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3730 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3731 current_buffer
->modtime
= st
.st_mtime
;
3741 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3742 Fsleep_for (make_number (1), Qnil
);
3743 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3744 Fsleep_for (make_number (1), Qnil
);
3745 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3746 Fsleep_for (make_number (1), Qnil
);
3756 /* Get visited file's mode to become the auto save file's mode. */
3757 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3758 /* But make sure we can overwrite it later! */
3759 auto_save_mode_bits
= st
.st_mode
| 0600;
3761 auto_save_mode_bits
= 0666;
3764 Fwrite_region (Qnil
, Qnil
,
3765 current_buffer
->auto_save_file_name
,
3770 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3773 close (XINT (desc
));
3777 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3778 "Auto-save all buffers that need it.\n\
3779 This is all buffers that have auto-saving enabled\n\
3780 and are changed since last auto-saved.\n\
3781 Auto-saving writes the buffer into a file\n\
3782 so that your editing is not lost if the system crashes.\n\
3783 This file is not the file you visited; that changes only when you save.\n\
3784 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3785 Non-nil first argument means do not print any message if successful.\n\
3786 Non-nil second argument means save only current buffer.")
3787 (no_message
, current_only
)
3788 Lisp_Object no_message
, current_only
;
3790 struct buffer
*old
= current_buffer
, *b
;
3791 Lisp_Object tail
, buf
;
3793 char *omessage
= echo_area_glyphs
;
3794 int omessage_length
= echo_area_glyphs_length
;
3795 extern int minibuf_level
;
3796 int do_handled_files
;
3799 int count
= specpdl_ptr
- specpdl
;
3802 /* Ordinarily don't quit within this function,
3803 but don't make it impossible to quit (in case we get hung in I/O). */
3807 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3808 point to non-strings reached from Vbuffer_alist. */
3814 if (!NILP (Vrun_hooks
))
3815 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3817 if (STRINGP (Vauto_save_list_file_name
))
3820 listdesc
= open (XSTRING (Vauto_save_list_file_name
)->data
,
3821 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3822 S_IREAD
| S_IWRITE
);
3823 #else /* not DOS_NT */
3824 listdesc
= creat (XSTRING (Vauto_save_list_file_name
)->data
, 0666);
3825 #endif /* not DOS_NT */
3830 /* Arrange to close that file whether or not we get an error. */
3832 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3834 /* First, save all files which don't have handlers. If Emacs is
3835 crashing, the handlers may tweak what is causing Emacs to crash
3836 in the first place, and it would be a shame if Emacs failed to
3837 autosave perfectly ordinary files because it couldn't handle some
3839 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3840 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
3842 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3845 /* Record all the buffers that have auto save mode
3846 in the special file that lists them. */
3847 if (STRINGP (b
->auto_save_file_name
)
3848 && listdesc
>= 0 && do_handled_files
== 0)
3850 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3851 XSTRING (b
->auto_save_file_name
)->size
);
3852 write (listdesc
, "\n", 1);
3855 if (!NILP (current_only
)
3856 && b
!= current_buffer
)
3859 /* Don't auto-save indirect buffers.
3860 The base buffer takes care of it. */
3864 /* Check for auto save enabled
3865 and file changed since last auto save
3866 and file changed since last real save. */
3867 if (STRINGP (b
->auto_save_file_name
)
3868 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
3869 && b
->auto_save_modified
< BUF_MODIFF (b
)
3870 /* -1 means we've turned off autosaving for a while--see below. */
3871 && XINT (b
->save_length
) >= 0
3872 && (do_handled_files
3873 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3876 EMACS_TIME before_time
, after_time
;
3878 EMACS_GET_TIME (before_time
);
3880 /* If we had a failure, don't try again for 20 minutes. */
3881 if (b
->auto_save_failure_time
>= 0
3882 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3885 if ((XFASTINT (b
->save_length
) * 10
3886 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3887 /* A short file is likely to change a large fraction;
3888 spare the user annoying messages. */
3889 && XFASTINT (b
->save_length
) > 5000
3890 /* These messages are frequent and annoying for `*mail*'. */
3891 && !EQ (b
->filename
, Qnil
)
3892 && NILP (no_message
))
3894 /* It has shrunk too much; turn off auto-saving here. */
3895 message ("Buffer %s has shrunk a lot; auto save turned off there",
3896 XSTRING (b
->name
)->data
);
3897 /* Turn off auto-saving until there's a real save,
3898 and prevent any more warnings. */
3899 XSETINT (b
->save_length
, -1);
3900 Fsleep_for (make_number (1), Qnil
);
3903 set_buffer_internal (b
);
3904 if (!auto_saved
&& NILP (no_message
))
3905 message1 ("Auto-saving...");
3906 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3908 b
->auto_save_modified
= BUF_MODIFF (b
);
3909 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3910 set_buffer_internal (old
);
3912 EMACS_GET_TIME (after_time
);
3914 /* If auto-save took more than 60 seconds,
3915 assume it was an NFS failure that got a timeout. */
3916 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3917 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3921 /* Prevent another auto save till enough input events come in. */
3922 record_auto_save ();
3924 if (auto_saved
&& NILP (no_message
))
3927 message2 (omessage
, omessage_length
);
3929 message1 ("Auto-saving...done");
3935 unbind_to (count
, Qnil
);
3939 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3940 Sset_buffer_auto_saved
, 0, 0, 0,
3941 "Mark current buffer as auto-saved with its current text.\n\
3942 No auto-save file will be written until the buffer changes again.")
3945 current_buffer
->auto_save_modified
= MODIFF
;
3946 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3947 current_buffer
->auto_save_failure_time
= -1;
3951 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3952 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3953 "Clear any record of a recent auto-save failure in the current buffer.")
3956 current_buffer
->auto_save_failure_time
= -1;
3960 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3962 "Return t if buffer has been auto-saved since last read in or saved.")
3965 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3968 /* Reading and completing file names */
3969 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3971 /* In the string VAL, change each $ to $$ and return the result. */
3974 double_dollars (val
)
3977 register unsigned char *old
, *new;
3981 osize
= XSTRING (val
)->size
;
3982 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3983 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3984 if (*old
++ == '$') count
++;
3987 old
= XSTRING (val
)->data
;
3988 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3989 new = XSTRING (val
)->data
;
3990 for (n
= osize
; n
> 0; n
--)
4003 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4005 "Internal subroutine for read-file-name. Do not call this.")
4006 (string
, dir
, action
)
4007 Lisp_Object string
, dir
, action
;
4008 /* action is nil for complete, t for return list of completions,
4009 lambda for verify final value */
4011 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4013 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4020 /* No need to protect ACTION--we only compare it with t and nil. */
4021 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4023 if (XSTRING (string
)->size
== 0)
4025 if (EQ (action
, Qlambda
))
4033 orig_string
= string
;
4034 string
= Fsubstitute_in_file_name (string
);
4035 changed
= NILP (Fstring_equal (string
, orig_string
));
4036 name
= Ffile_name_nondirectory (string
);
4037 val
= Ffile_name_directory (string
);
4039 realdir
= Fexpand_file_name (val
, realdir
);
4044 specdir
= Ffile_name_directory (string
);
4045 val
= Ffile_name_completion (name
, realdir
);
4050 return double_dollars (string
);
4054 if (!NILP (specdir
))
4055 val
= concat2 (specdir
, val
);
4057 return double_dollars (val
);
4060 #endif /* not VMS */
4064 if (EQ (action
, Qt
))
4065 return Ffile_name_all_completions (name
, realdir
);
4066 /* Only other case actually used is ACTION = lambda */
4068 /* Supposedly this helps commands such as `cd' that read directory names,
4069 but can someone explain how it helps them? -- RMS */
4070 if (XSTRING (name
)->size
== 0)
4073 return Ffile_exists_p (string
);
4076 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4077 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4078 Value is not expanded---you must call `expand-file-name' yourself.\n\
4079 Default name to DEFAULT if user enters a null string.\n\
4080 (If DEFAULT is omitted, the visited file name is used,\n\
4081 except that if INITIAL is specified, that combined with DIR is used.)\n\
4082 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4083 Non-nil and non-t means also require confirmation after completion.\n\
4084 Fifth arg INITIAL specifies text to start with.\n\
4085 DIR defaults to current buffer's directory default.")
4086 (prompt
, dir
, defalt
, mustmatch
, initial
)
4087 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4089 Lisp_Object val
, insdef
, insdef1
, tem
;
4090 struct gcpro gcpro1
, gcpro2
;
4091 register char *homedir
;
4095 dir
= current_buffer
->directory
;
4098 if (! NILP (initial
))
4099 defalt
= Fexpand_file_name (initial
, dir
);
4101 defalt
= current_buffer
->filename
;
4104 /* If dir starts with user's homedir, change that to ~. */
4105 homedir
= (char *) egetenv ("HOME");
4108 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4109 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4111 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4112 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4113 XSTRING (dir
)->data
[0] = '~';
4116 if (insert_default_directory
)
4119 if (!NILP (initial
))
4121 Lisp_Object args
[2], pos
;
4125 insdef
= Fconcat (2, args
);
4126 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4127 insdef1
= Fcons (double_dollars (insdef
), pos
);
4130 insdef1
= double_dollars (insdef
);
4132 else if (!NILP (initial
))
4135 insdef1
= Fcons (double_dollars (insdef
), 0);
4138 insdef
= Qnil
, insdef1
= Qnil
;
4141 count
= specpdl_ptr
- specpdl
;
4142 specbind (intern ("completion-ignore-case"), Qt
);
4145 GCPRO2 (insdef
, defalt
);
4146 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4147 dir
, mustmatch
, insdef1
,
4148 Qfile_name_history
);
4151 unbind_to (count
, Qnil
);
4156 error ("No file name specified");
4157 tem
= Fstring_equal (val
, insdef
);
4158 if (!NILP (tem
) && !NILP (defalt
))
4160 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4165 error ("No default file name");
4167 return Fsubstitute_in_file_name (val
);
4170 #if 0 /* Old version */
4171 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4172 /* Don't confuse make-docfile by having two doc strings for this function.
4173 make-docfile does not pay attention to #if, for good reason! */
4175 (prompt
, dir
, defalt
, mustmatch
, initial
)
4176 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4178 Lisp_Object val
, insdef
, tem
;
4179 struct gcpro gcpro1
, gcpro2
;
4180 register char *homedir
;
4184 dir
= current_buffer
->directory
;
4186 defalt
= current_buffer
->filename
;
4188 /* If dir starts with user's homedir, change that to ~. */
4189 homedir
= (char *) egetenv ("HOME");
4192 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4193 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4195 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4196 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4197 XSTRING (dir
)->data
[0] = '~';
4200 if (!NILP (initial
))
4202 else if (insert_default_directory
)
4205 insdef
= build_string ("");
4208 count
= specpdl_ptr
- specpdl
;
4209 specbind (intern ("completion-ignore-case"), Qt
);
4212 GCPRO2 (insdef
, defalt
);
4213 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4215 insert_default_directory
? insdef
: Qnil
,
4216 Qfile_name_history
);
4219 unbind_to (count
, Qnil
);
4224 error ("No file name specified");
4225 tem
= Fstring_equal (val
, insdef
);
4226 if (!NILP (tem
) && !NILP (defalt
))
4228 return Fsubstitute_in_file_name (val
);
4230 #endif /* Old version */
4234 Qexpand_file_name
= intern ("expand-file-name");
4235 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4236 Qdirectory_file_name
= intern ("directory-file-name");
4237 Qfile_name_directory
= intern ("file-name-directory");
4238 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4239 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4240 Qfile_name_as_directory
= intern ("file-name-as-directory");
4241 Qcopy_file
= intern ("copy-file");
4242 Qmake_directory_internal
= intern ("make-directory-internal");
4243 Qdelete_directory
= intern ("delete-directory");
4244 Qdelete_file
= intern ("delete-file");
4245 Qrename_file
= intern ("rename-file");
4246 Qadd_name_to_file
= intern ("add-name-to-file");
4247 Qmake_symbolic_link
= intern ("make-symbolic-link");
4248 Qfile_exists_p
= intern ("file-exists-p");
4249 Qfile_executable_p
= intern ("file-executable-p");
4250 Qfile_readable_p
= intern ("file-readable-p");
4251 Qfile_symlink_p
= intern ("file-symlink-p");
4252 Qfile_writable_p
= intern ("file-writable-p");
4253 Qfile_directory_p
= intern ("file-directory-p");
4254 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4255 Qfile_modes
= intern ("file-modes");
4256 Qset_file_modes
= intern ("set-file-modes");
4257 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4258 Qinsert_file_contents
= intern ("insert-file-contents");
4259 Qwrite_region
= intern ("write-region");
4260 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4261 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4263 staticpro (&Qexpand_file_name
);
4264 staticpro (&Qsubstitute_in_file_name
);
4265 staticpro (&Qdirectory_file_name
);
4266 staticpro (&Qfile_name_directory
);
4267 staticpro (&Qfile_name_nondirectory
);
4268 staticpro (&Qunhandled_file_name_directory
);
4269 staticpro (&Qfile_name_as_directory
);
4270 staticpro (&Qcopy_file
);
4271 staticpro (&Qmake_directory_internal
);
4272 staticpro (&Qdelete_directory
);
4273 staticpro (&Qdelete_file
);
4274 staticpro (&Qrename_file
);
4275 staticpro (&Qadd_name_to_file
);
4276 staticpro (&Qmake_symbolic_link
);
4277 staticpro (&Qfile_exists_p
);
4278 staticpro (&Qfile_executable_p
);
4279 staticpro (&Qfile_readable_p
);
4280 staticpro (&Qfile_symlink_p
);
4281 staticpro (&Qfile_writable_p
);
4282 staticpro (&Qfile_directory_p
);
4283 staticpro (&Qfile_accessible_directory_p
);
4284 staticpro (&Qfile_modes
);
4285 staticpro (&Qset_file_modes
);
4286 staticpro (&Qfile_newer_than_file_p
);
4287 staticpro (&Qinsert_file_contents
);
4288 staticpro (&Qwrite_region
);
4289 staticpro (&Qverify_visited_file_modtime
);
4291 Qfile_name_history
= intern ("file-name-history");
4292 Fset (Qfile_name_history
, Qnil
);
4293 staticpro (&Qfile_name_history
);
4295 Qfile_error
= intern ("file-error");
4296 staticpro (&Qfile_error
);
4297 Qfile_already_exists
= intern("file-already-exists");
4298 staticpro (&Qfile_already_exists
);
4301 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4302 staticpro (&Qfind_buffer_file_type
);
4305 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
4306 "*Format in which to write auto-save files.\n\
4307 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
4308 If it is t, which is the default, auto-save files are written in the\n\
4309 same format as a regular save would use.");
4310 Vauto_save_file_format
= Qt
;
4312 Qformat_decode
= intern ("format-decode");
4313 staticpro (&Qformat_decode
);
4314 Qformat_annotate_function
= intern ("format-annotate-function");
4315 staticpro (&Qformat_annotate_function
);
4317 Qcar_less_than_car
= intern ("car-less-than-car");
4318 staticpro (&Qcar_less_than_car
);
4320 Fput (Qfile_error
, Qerror_conditions
,
4321 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4322 Fput (Qfile_error
, Qerror_message
,
4323 build_string ("File error"));
4325 Fput (Qfile_already_exists
, Qerror_conditions
,
4326 Fcons (Qfile_already_exists
,
4327 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4328 Fput (Qfile_already_exists
, Qerror_message
,
4329 build_string ("File already exists"));
4331 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4332 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4333 insert_default_directory
= 1;
4335 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4336 "*Non-nil means write new files with record format `stmlf'.\n\
4337 nil means use format `var'. This variable is meaningful only on VMS.");
4338 vms_stmlf_recfm
= 0;
4340 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4341 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4342 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4345 The first argument given to HANDLER is the name of the I/O primitive\n\
4346 to be handled; the remaining arguments are the arguments that were\n\
4347 passed to that primitive. For example, if you do\n\
4348 (file-exists-p FILENAME)\n\
4349 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4350 (funcall HANDLER 'file-exists-p FILENAME)\n\
4351 The function `find-file-name-handler' checks this list for a handler\n\
4352 for its argument.");
4353 Vfile_name_handler_alist
= Qnil
;
4355 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4356 "A list of functions to be called at the end of `insert-file-contents'.\n\
4357 Each is passed one argument, the number of bytes inserted. It should return\n\
4358 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4359 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4360 responsible for calling the after-insert-file-functions if appropriate.");
4361 Vafter_insert_file_functions
= Qnil
;
4363 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4364 "A list of functions to be called at the start of `write-region'.\n\
4365 Each is passed two arguments, START and END as for `write-region'. It should\n\
4366 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4367 inserted at the specified positions of the file being written (1 means to\n\
4368 insert before the first byte written). The POSITIONs must be sorted into\n\
4369 increasing order. If there are several functions in the list, the several\n\
4370 lists are merged destructively.");
4371 Vwrite_region_annotate_functions
= Qnil
;
4373 DEFVAR_LISP ("write-region-annotations-so-far",
4374 &Vwrite_region_annotations_so_far
,
4375 "When an annotation function is called, this holds the previous annotations.\n\
4376 These are the annotations made by other annotation functions\n\
4377 that were already called. See also `write-region-annotate-functions'.");
4378 Vwrite_region_annotations_so_far
= Qnil
;
4380 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4381 "A list of file name handlers that temporarily should not be used.\n\
4382 This applies only to the operation `inhibit-file-name-operation'.");
4383 Vinhibit_file_name_handlers
= Qnil
;
4385 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4386 "The operation for which `inhibit-file-name-handlers' is applicable.");
4387 Vinhibit_file_name_operation
= Qnil
;
4389 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4390 "File name in which we write a list of all auto save file names.");
4391 Vauto_save_list_file_name
= Qnil
;
4393 defsubr (&Sfind_file_name_handler
);
4394 defsubr (&Sfile_name_directory
);
4395 defsubr (&Sfile_name_nondirectory
);
4396 defsubr (&Sunhandled_file_name_directory
);
4397 defsubr (&Sfile_name_as_directory
);
4398 defsubr (&Sdirectory_file_name
);
4399 defsubr (&Smake_temp_name
);
4400 defsubr (&Sexpand_file_name
);
4401 defsubr (&Ssubstitute_in_file_name
);
4402 defsubr (&Scopy_file
);
4403 defsubr (&Smake_directory_internal
);
4404 defsubr (&Sdelete_directory
);
4405 defsubr (&Sdelete_file
);
4406 defsubr (&Srename_file
);
4407 defsubr (&Sadd_name_to_file
);
4409 defsubr (&Smake_symbolic_link
);
4410 #endif /* S_IFLNK */
4412 defsubr (&Sdefine_logical_name
);
4415 defsubr (&Ssysnetunam
);
4416 #endif /* HPUX_NET */
4417 defsubr (&Sfile_name_absolute_p
);
4418 defsubr (&Sfile_exists_p
);
4419 defsubr (&Sfile_executable_p
);
4420 defsubr (&Sfile_readable_p
);
4421 defsubr (&Sfile_writable_p
);
4422 defsubr (&Sfile_symlink_p
);
4423 defsubr (&Sfile_directory_p
);
4424 defsubr (&Sfile_accessible_directory_p
);
4425 defsubr (&Sfile_regular_p
);
4426 defsubr (&Sfile_modes
);
4427 defsubr (&Sset_file_modes
);
4428 defsubr (&Sset_default_file_modes
);
4429 defsubr (&Sdefault_file_modes
);
4430 defsubr (&Sfile_newer_than_file_p
);
4431 defsubr (&Sinsert_file_contents
);
4432 defsubr (&Swrite_region
);
4433 defsubr (&Scar_less_than_car
);
4434 defsubr (&Sverify_visited_file_modtime
);
4435 defsubr (&Sclear_visited_file_modtime
);
4436 defsubr (&Svisited_file_modtime
);
4437 defsubr (&Sset_visited_file_modtime
);
4438 defsubr (&Sdo_auto_save
);
4439 defsubr (&Sset_buffer_auto_saved
);
4440 defsubr (&Sclear_buffer_auto_save_failure
);
4441 defsubr (&Srecent_auto_save_p
);
4443 defsubr (&Sread_file_name_internal
);
4444 defsubr (&Sread_file_name
);
4447 defsubr (&Sunix_sync
);