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_DEVICE_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
, ':');
816 drive
= tolower (colon
[-1]) - 'a';
818 if (!IS_DIRECTORY_SEP (*nm
))
820 defdir
= alloca (MAXPATHLEN
+ 1);
821 relpath
= getdefdir (drive
+ 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 dostounix_filename (newdir
);
984 nm
++; /* Don't leave the slash in nm. */
987 else /* ~user/filename */
989 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
994 o
= (unsigned char *) alloca (p
- nm
+ 1);
995 bcopy ((char *) nm
, o
, p
- nm
);
999 newdir
= (unsigned char *) egetenv ("HOME");
1000 dostounix_filename (newdir
);
1001 #else /* not WINDOWSNT */
1002 pw
= (struct passwd
*) getpwnam (o
+ 1);
1005 newdir
= (unsigned char *) pw
-> pw_dir
;
1007 nm
= p
+ 1; /* skip the terminator */
1012 #endif /* not WINDOWSNT */
1014 /* If we don't find a user of that name, leave the name
1015 unchanged; don't move nm forward to p. */
1019 if (!IS_ANY_SEP (nm
[0])
1022 #endif /* not VMS */
1028 newdir
= XSTRING (defalt
)->data
;
1032 if (newdir
== 0 && relpath
)
1037 /* Get rid of any slash at the end of newdir. */
1038 int length
= strlen (newdir
);
1039 /* Adding `length > 1 &&' makes ~ expand into / when homedir
1040 is the root dir. People disagree about whether that is right.
1041 Anyway, we can't take the risk of this change now. */
1043 if (newdir
[1] != ':' && length
> 1)
1045 if (IS_DIRECTORY_SEP (newdir
[length
- 1]))
1047 unsigned char *temp
= (unsigned char *) alloca (length
);
1048 bcopy (newdir
, temp
, length
- 1);
1049 temp
[length
- 1] = 0;
1057 /* Now concatenate the directory and name to new space in the stack frame */
1058 tlen
+= strlen (nm
) + 1;
1060 /* Add reserved space for drive name. (The Microsoft x86 compiler
1061 produces incorrect code if the following two lines are combined.) */
1062 target
= (unsigned char *) alloca (tlen
+ 2);
1064 #else /* not DOS_NT */
1065 target
= (unsigned char *) alloca (tlen
);
1066 #endif /* not DOS_NT */
1072 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1073 strcpy (target
, newdir
);
1076 file_name_as_directory (target
, newdir
);
1079 strcat (target
, nm
);
1081 if (index (target
, '/'))
1082 strcpy (target
, sys_translate_unix (target
));
1085 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1093 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1099 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1100 /* brackets are offset from each other by 2 */
1103 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1104 /* convert [foo][bar] to [bar] */
1105 while (o
[-1] != '[' && o
[-1] != '<')
1107 else if (*p
== '-' && *o
!= '.')
1110 else if (p
[0] == '-' && o
[-1] == '.' &&
1111 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1112 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1116 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1117 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1119 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1121 /* else [foo.-] ==> [-] */
1127 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1128 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1134 if (!IS_DIRECTORY_SEP (*p
))
1139 else if (!strncmp (p
, "\\\\", 2) || !strncmp (p
, "//", 2))
1140 #else /* not WINDOWSNT */
1141 else if (!strncmp (p
, "//", 2)
1142 #endif /* not WINDOWSNT */
1144 /* // at start of filename is meaningful in Apollo system */
1148 /* \\ at start of filename is meaningful in Windows-NT */
1150 #endif /* WINDOWSNT */
1156 else if (IS_DIRECTORY_SEP (p
[0])
1158 && (IS_DIRECTORY_SEP (p
[2])
1161 /* If "/." is the entire filename, keep the "/". Otherwise,
1162 just delete the whole "/.". */
1163 if (o
== target
&& p
[2] == '\0')
1168 else if (!strncmp (p
, "\\..", 3) || !strncmp (p
, "/..", 3))
1169 #else /* not WINDOWSNT */
1170 else if (!strncmp (p
, "/..", 3)
1171 #endif /* not WINDOWSNT */
1172 /* `/../' is the "superroot" on certain file systems. */
1174 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1176 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1179 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1184 if (o
== target
+ 1 && (o
[-1] == '/' && o
[0] == '/')
1185 || (o
[-1] == '\\' && o
[0] == '\\'))
1188 #endif /* WINDOWSNT */
1189 if (o
== target
&& IS_ANY_SEP (*o
))
1197 #endif /* not VMS */
1201 /* at last, set drive name. */
1202 if (target
[1] != ':'
1204 /* Allow network paths that look like "\\foo" */
1205 && !(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1]))
1206 #endif /* WINDOWSNT */
1210 target
[0] = (drive
< 0 ? getdisk () : drive
) + 'a';
1215 return make_string (target
, o
- target
);
1219 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1220 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1221 "Convert FILENAME to absolute, and canonicalize it.\n\
1222 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1223 (does not start with slash); if DEFAULT is nil or missing,\n\
1224 the current buffer's value of default-directory is used.\n\
1225 Filenames containing `.' or `..' as components are simplified;\n\
1226 initial `~/' expands to your home directory.\n\
1227 See also the function `substitute-in-file-name'.")
1229 Lisp_Object name
, defalt
;
1233 register unsigned char *newdir
, *p
, *o
;
1235 unsigned char *target
;
1239 unsigned char * colon
= 0;
1240 unsigned char * close
= 0;
1241 unsigned char * slash
= 0;
1242 unsigned char * brack
= 0;
1243 int lbrack
= 0, rbrack
= 0;
1247 CHECK_STRING (name
, 0);
1250 /* Filenames on VMS are always upper case. */
1251 name
= Fupcase (name
);
1254 nm
= XSTRING (name
)->data
;
1256 /* If nm is absolute, flush ...// and detect /./ and /../.
1257 If no /./ or /../ we can return right away. */
1269 if (p
[0] == '/' && p
[1] == '/'
1271 /* // at start of filename is meaningful on Apollo system */
1276 if (p
[0] == '/' && p
[1] == '~')
1277 nm
= p
+ 1, lose
= 1;
1278 if (p
[0] == '/' && p
[1] == '.'
1279 && (p
[2] == '/' || p
[2] == 0
1280 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1286 /* if dev:[dir]/, move nm to / */
1287 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1288 nm
= (brack
? brack
+ 1 : colon
+ 1);
1289 lbrack
= rbrack
= 0;
1297 /* VMS pre V4.4,convert '-'s in filenames. */
1298 if (lbrack
== rbrack
)
1300 if (dots
< 2) /* this is to allow negative version numbers */
1305 if (lbrack
> rbrack
&&
1306 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1307 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1313 /* count open brackets, reset close bracket pointer */
1314 if (p
[0] == '[' || p
[0] == '<')
1315 lbrack
++, brack
= 0;
1316 /* count close brackets, set close bracket pointer */
1317 if (p
[0] == ']' || p
[0] == '>')
1318 rbrack
++, brack
= p
;
1319 /* detect ][ or >< */
1320 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1322 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1323 nm
= p
+ 1, lose
= 1;
1324 if (p
[0] == ':' && (colon
|| slash
))
1325 /* if dev1:[dir]dev2:, move nm to dev2: */
1331 /* if /pathname/dev:, move nm to dev: */
1334 /* if node::dev:, move colon following dev */
1335 else if (colon
&& colon
[-1] == ':')
1337 /* if dev1:dev2:, move nm to dev2: */
1338 else if (colon
&& colon
[-1] != ':')
1343 if (p
[0] == ':' && !colon
)
1349 if (lbrack
== rbrack
)
1352 else if (p
[0] == '.')
1360 if (index (nm
, '/'))
1361 return build_string (sys_translate_unix (nm
));
1363 if (nm
== XSTRING (name
)->data
)
1365 return build_string (nm
);
1369 /* Now determine directory to start with and put it in NEWDIR */
1373 if (nm
[0] == '~') /* prefix ~ */
1378 || nm
[1] == 0)/* ~/filename */
1380 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1381 newdir
= (unsigned char *) "";
1384 nm
++; /* Don't leave the slash in nm. */
1387 else /* ~user/filename */
1389 /* Get past ~ to user */
1390 unsigned char *user
= nm
+ 1;
1391 /* Find end of name. */
1392 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1393 int len
= ptr
? ptr
- user
: strlen (user
);
1395 unsigned char *ptr1
= index (user
, ':');
1396 if (ptr1
!= 0 && ptr1
- user
< len
)
1399 /* Copy the user name into temp storage. */
1400 o
= (unsigned char *) alloca (len
+ 1);
1401 bcopy ((char *) user
, o
, len
);
1404 /* Look up the user name. */
1405 pw
= (struct passwd
*) getpwnam (o
+ 1);
1407 error ("\"%s\" isn't a registered user", o
+ 1);
1409 newdir
= (unsigned char *) pw
->pw_dir
;
1411 /* Discard the user name from NM. */
1418 #endif /* not VMS */
1422 defalt
= current_buffer
->directory
;
1423 CHECK_STRING (defalt
, 1);
1424 newdir
= XSTRING (defalt
)->data
;
1427 /* Now concatenate the directory and name to new space in the stack frame */
1429 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1430 target
= (unsigned char *) alloca (tlen
);
1436 if (nm
[0] == 0 || nm
[0] == '/')
1437 strcpy (target
, newdir
);
1440 file_name_as_directory (target
, newdir
);
1443 strcat (target
, nm
);
1445 if (index (target
, '/'))
1446 strcpy (target
, sys_translate_unix (target
));
1449 /* Now canonicalize by removing /. and /foo/.. if they appear */
1457 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1463 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1464 /* brackets are offset from each other by 2 */
1467 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1468 /* convert [foo][bar] to [bar] */
1469 while (o
[-1] != '[' && o
[-1] != '<')
1471 else if (*p
== '-' && *o
!= '.')
1474 else if (p
[0] == '-' && o
[-1] == '.' &&
1475 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1476 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1480 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1481 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1483 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1485 /* else [foo.-] ==> [-] */
1491 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1492 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1502 else if (!strncmp (p
, "//", 2)
1504 /* // at start of filename is meaningful in Apollo system */
1512 else if (p
[0] == '/' && p
[1] == '.' &&
1513 (p
[2] == '/' || p
[2] == 0))
1515 else if (!strncmp (p
, "/..", 3)
1516 /* `/../' is the "superroot" on certain file systems. */
1518 && (p
[3] == '/' || p
[3] == 0))
1520 while (o
!= target
&& *--o
!= '/')
1523 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1527 if (o
== target
&& *o
== '/')
1535 #endif /* not VMS */
1538 return make_string (target
, o
- target
);
1542 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1543 Ssubstitute_in_file_name
, 1, 1, 0,
1544 "Substitute environment variables referred to in FILENAME.\n\
1545 `$FOO' where FOO is an environment variable name means to substitute\n\
1546 the value of that variable. The variable name should be terminated\n\
1547 with a character not a letter, digit or underscore; otherwise, enclose\n\
1548 the entire variable name in braces.\n\
1549 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1550 On VMS, `$' substitution is not done; this function does little and only\n\
1551 duplicates what `expand-file-name' does.")
1557 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1558 unsigned char *target
;
1560 int substituted
= 0;
1562 Lisp_Object handler
;
1564 CHECK_STRING (string
, 0);
1566 /* If the file name has special constructs in it,
1567 call the corresponding file handler. */
1568 handler
= Ffind_file_name_handler (string
, Qsubstitute_in_file_name
);
1569 if (!NILP (handler
))
1570 return call2 (handler
, Qsubstitute_in_file_name
, string
);
1572 nm
= XSTRING (string
)->data
;
1574 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
1575 substituted
= !strcmp (nm
, XSTRING (string
)->data
);
1577 endp
= nm
+ XSTRING (string
)->size
;
1579 /* If /~ or // appears, discard everything through first slash. */
1581 for (p
= nm
; p
!= endp
; p
++)
1585 /* // at start of file name is meaningful in Apollo system */
1586 (p
[0] == '/' && p
- 1 != nm
)
1587 #else /* not APOLLO */
1589 (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1590 #else /* not WINDOWSNT */
1592 #endif /* not WINDOWSNT */
1593 #endif /* not APOLLO */
1598 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1600 || IS_DIRECTORY_SEP (p
[-1])))
1606 if (p
[0] && p
[1] == ':')
1615 return build_string (nm
);
1618 /* See if any variables are substituted into the string
1619 and find the total length of their values in `total' */
1621 for (p
= nm
; p
!= endp
;)
1631 /* "$$" means a single "$" */
1640 while (p
!= endp
&& *p
!= '}') p
++;
1641 if (*p
!= '}') goto missingclose
;
1647 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1651 /* Copy out the variable name */
1652 target
= (unsigned char *) alloca (s
- o
+ 1);
1653 strncpy (target
, o
, s
- o
);
1656 strupr (target
); /* $home == $HOME etc. */
1659 /* Get variable value */
1660 o
= (unsigned char *) egetenv (target
);
1661 if (!o
) goto badvar
;
1662 total
+= strlen (o
);
1669 /* If substitution required, recopy the string and do it */
1670 /* Make space in stack frame for the new copy */
1671 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1674 /* Copy the rest of the name through, replacing $ constructs with values */
1691 while (p
!= endp
&& *p
!= '}') p
++;
1692 if (*p
!= '}') goto missingclose
;
1698 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1702 /* Copy out the variable name */
1703 target
= (unsigned char *) alloca (s
- o
+ 1);
1704 strncpy (target
, o
, s
- o
);
1707 strupr (target
); /* $home == $HOME etc. */
1710 /* Get variable value */
1711 o
= (unsigned char *) egetenv (target
);
1721 /* If /~ or // appears, discard everything through first slash. */
1723 for (p
= xnm
; p
!= x
; p
++)
1726 /* // at start of file name is meaningful in Apollo system */
1727 || (p
[0] == '/' && p
- 1 != xnm
)
1728 #else /* not APOLLO */
1730 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1731 #else /* not WINDOWSNT */
1733 #endif /* not WINDOWSNT */
1734 #endif /* not APOLLO */
1736 && p
!= nm
&& IS_DIRECTORY_SEP (p
[-1]))
1739 else if (p
[0] && p
[1] == ':')
1743 return make_string (xnm
, x
- xnm
);
1746 error ("Bad format environment-variable substitution");
1748 error ("Missing \"}\" in environment-variable substitution");
1750 error ("Substituting nonexistent environment variable \"%s\"", target
);
1753 #endif /* not VMS */
1756 /* A slightly faster and more convenient way to get
1757 (directory-file-name (expand-file-name FOO)). */
1760 expand_and_dir_to_file (filename
, defdir
)
1761 Lisp_Object filename
, defdir
;
1763 register Lisp_Object abspath
;
1765 abspath
= Fexpand_file_name (filename
, defdir
);
1768 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1769 if (c
== ':' || c
== ']' || c
== '>')
1770 abspath
= Fdirectory_file_name (abspath
);
1773 /* Remove final slash, if any (unless path is root).
1774 stat behaves differently depending! */
1775 if (XSTRING (abspath
)->size
> 1
1776 && IS_DIRECTORY_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1])
1777 && !IS_DEVICE_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
-2]))
1778 /* We cannot take shortcuts; they might be wrong for magic file names. */
1779 abspath
= Fdirectory_file_name (abspath
);
1785 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1786 Lisp_Object absname
;
1787 unsigned char *querystring
;
1790 register Lisp_Object tem
;
1791 struct stat statbuf
;
1792 struct gcpro gcpro1
;
1794 /* stat is a good way to tell whether the file exists,
1795 regardless of what access permissions it has. */
1796 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1799 Fsignal (Qfile_already_exists
,
1800 Fcons (build_string ("File already exists"),
1801 Fcons (absname
, Qnil
)));
1803 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1804 XSTRING (absname
)->data
, querystring
));
1807 Fsignal (Qfile_already_exists
,
1808 Fcons (build_string ("File already exists"),
1809 Fcons (absname
, Qnil
)));
1814 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1815 "fCopy file: \nFCopy %s to file: \np\nP",
1816 "Copy FILE to NEWNAME. Both args must be strings.\n\
1817 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1818 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1819 A number as third arg means request confirmation if NEWNAME already exists.\n\
1820 This is what happens in interactive use with M-x.\n\
1821 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1822 last-modified time as the old one. (This works on only some systems.)\n\
1823 A prefix arg makes KEEP-TIME non-nil.")
1824 (filename
, newname
, ok_if_already_exists
, keep_date
)
1825 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1828 char buf
[16 * 1024];
1830 Lisp_Object handler
;
1831 struct gcpro gcpro1
, gcpro2
;
1832 int count
= specpdl_ptr
- specpdl
;
1833 int input_file_statable_p
;
1835 GCPRO2 (filename
, newname
);
1836 CHECK_STRING (filename
, 0);
1837 CHECK_STRING (newname
, 1);
1838 filename
= Fexpand_file_name (filename
, Qnil
);
1839 newname
= Fexpand_file_name (newname
, Qnil
);
1841 /* If the input file name has special constructs in it,
1842 call the corresponding file handler. */
1843 handler
= Ffind_file_name_handler (filename
, Qcopy_file
);
1844 /* Likewise for output file name. */
1846 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1847 if (!NILP (handler
))
1848 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, filename
, newname
,
1849 ok_if_already_exists
, keep_date
));
1851 if (NILP (ok_if_already_exists
)
1852 || INTEGERP (ok_if_already_exists
))
1853 barf_or_query_if_file_exists (newname
, "copy to it",
1854 INTEGERP (ok_if_already_exists
));
1856 ifd
= open (XSTRING (filename
)->data
, O_RDONLY
);
1858 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1860 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1862 /* We can only copy regular files and symbolic links. Other files are not
1864 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1866 #if defined (S_ISREG) && defined (S_ISLNK)
1867 if (input_file_statable_p
)
1869 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1871 #if defined (EISDIR)
1872 /* Get a better looking error message. */
1875 report_file_error ("Non-regular file", Fcons (filename
, Qnil
));
1878 #endif /* S_ISREG && S_ISLNK */
1881 /* Create the copy file with the same record format as the input file */
1882 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1885 /* System's default file type was set to binary by _fmode in emacs.c. */
1886 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1887 #else /* not MSDOS */
1888 ofd
= creat (XSTRING (newname
)->data
, 0666);
1889 #endif /* not MSDOS */
1892 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1894 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1898 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1899 if (write (ofd
, buf
, n
) != n
)
1900 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1903 /* Closing the output clobbers the file times on some systems. */
1904 if (close (ofd
) < 0)
1905 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1907 if (input_file_statable_p
)
1909 if (!NILP (keep_date
))
1911 EMACS_TIME atime
, mtime
;
1912 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1913 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1914 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
1915 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1918 if (!egetenv ("USE_DOMAIN_ACLS"))
1920 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1925 /* Discard the unwind protects. */
1926 specpdl_ptr
= specpdl
+ count
;
1932 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1933 Smake_directory_internal
, 1, 1, 0,
1934 "Create a directory. One argument, a file name string.")
1936 Lisp_Object dirname
;
1939 Lisp_Object handler
;
1941 CHECK_STRING (dirname
, 0);
1942 dirname
= Fexpand_file_name (dirname
, Qnil
);
1944 handler
= Ffind_file_name_handler (dirname
, Qmake_directory_internal
);
1945 if (!NILP (handler
))
1946 return call2 (handler
, Qmake_directory_internal
, dirname
);
1948 dir
= XSTRING (dirname
)->data
;
1951 if (mkdir (dir
) != 0)
1953 if (mkdir (dir
, 0777) != 0)
1955 report_file_error ("Creating directory", Flist (1, &dirname
));
1960 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1961 "Delete a directory. One argument, a file name or directory name string.")
1963 Lisp_Object dirname
;
1966 Lisp_Object handler
;
1968 CHECK_STRING (dirname
, 0);
1969 dirname
= Fdirectory_file_name (Fexpand_file_name (dirname
, Qnil
));
1970 dir
= XSTRING (dirname
)->data
;
1972 handler
= Ffind_file_name_handler (dirname
, Qdelete_directory
);
1973 if (!NILP (handler
))
1974 return call2 (handler
, Qdelete_directory
, dirname
);
1976 if (rmdir (dir
) != 0)
1977 report_file_error ("Removing directory", Flist (1, &dirname
));
1982 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1983 "Delete specified file. One argument, a file name string.\n\
1984 If file has multiple names, it continues to exist with the other names.")
1986 Lisp_Object filename
;
1988 Lisp_Object handler
;
1989 CHECK_STRING (filename
, 0);
1990 filename
= Fexpand_file_name (filename
, Qnil
);
1992 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
1993 if (!NILP (handler
))
1994 return call2 (handler
, Qdelete_file
, filename
);
1996 if (0 > unlink (XSTRING (filename
)->data
))
1997 report_file_error ("Removing old name", Flist (1, &filename
));
2002 internal_delete_file_1 (ignore
)
2008 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2011 internal_delete_file (filename
)
2012 Lisp_Object filename
;
2014 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2015 Qt
, internal_delete_file_1
));
2018 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2019 "fRename file: \nFRename %s to file: \np",
2020 "Rename FILE as NEWNAME. Both args strings.\n\
2021 If file has names other than FILE, it continues to have those names.\n\
2022 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2023 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2024 A number as third arg means request confirmation if NEWNAME already exists.\n\
2025 This is what happens in interactive use with M-x.")
2026 (filename
, newname
, ok_if_already_exists
)
2027 Lisp_Object filename
, newname
, ok_if_already_exists
;
2030 Lisp_Object args
[2];
2032 Lisp_Object handler
;
2033 struct gcpro gcpro1
, gcpro2
;
2035 GCPRO2 (filename
, newname
);
2036 CHECK_STRING (filename
, 0);
2037 CHECK_STRING (newname
, 1);
2038 filename
= Fexpand_file_name (filename
, Qnil
);
2039 newname
= Fexpand_file_name (newname
, Qnil
);
2041 /* If the file name has special constructs in it,
2042 call the corresponding file handler. */
2043 handler
= Ffind_file_name_handler (filename
, Qrename_file
);
2045 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2046 if (!NILP (handler
))
2047 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2048 filename
, newname
, ok_if_already_exists
));
2050 if (NILP (ok_if_already_exists
)
2051 || INTEGERP (ok_if_already_exists
))
2052 barf_or_query_if_file_exists (newname
, "rename to it",
2053 INTEGERP (ok_if_already_exists
));
2055 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2058 if (!MoveFile (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2059 #else /* not WINDOWSNT */
2060 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
2061 || 0 > unlink (XSTRING (filename
)->data
))
2062 #endif /* not WINDOWSNT */
2066 /* Why two? And why doesn't MS document what MoveFile will return? */
2067 if (GetLastError () == ERROR_FILE_EXISTS
2068 || GetLastError () == ERROR_ALREADY_EXISTS
)
2069 #else /* not WINDOWSNT */
2071 #endif /* not WINDOWSNT */
2073 Fcopy_file (filename
, newname
,
2074 /* We have already prompted if it was an integer,
2075 so don't have copy-file prompt again. */
2076 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2077 Fdelete_file (filename
);
2084 report_file_error ("Renaming", Flist (2, args
));
2087 report_file_error ("Renaming", Flist (2, &filename
));
2094 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2095 "fAdd name to file: \nFName to add to %s: \np",
2096 "Give FILE additional name NEWNAME. Both args strings.\n\
2097 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2098 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2099 A number as third arg means request confirmation if NEWNAME already exists.\n\
2100 This is what happens in interactive use with M-x.")
2101 (filename
, newname
, ok_if_already_exists
)
2102 Lisp_Object filename
, newname
, ok_if_already_exists
;
2105 Lisp_Object args
[2];
2107 Lisp_Object handler
;
2108 struct gcpro gcpro1
, gcpro2
;
2110 GCPRO2 (filename
, newname
);
2111 CHECK_STRING (filename
, 0);
2112 CHECK_STRING (newname
, 1);
2113 filename
= Fexpand_file_name (filename
, Qnil
);
2114 newname
= Fexpand_file_name (newname
, Qnil
);
2116 /* If the file name has special constructs in it,
2117 call the corresponding file handler. */
2118 handler
= Ffind_file_name_handler (filename
, Qadd_name_to_file
);
2119 if (!NILP (handler
))
2120 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
2121 newname
, ok_if_already_exists
));
2123 if (NILP (ok_if_already_exists
)
2124 || INTEGERP (ok_if_already_exists
))
2125 barf_or_query_if_file_exists (newname
, "make it a new name",
2126 INTEGERP (ok_if_already_exists
));
2128 /* Windows does not support this operation. */
2129 report_file_error ("Adding new name", Flist (2, &filename
));
2130 #else /* not WINDOWSNT */
2132 unlink (XSTRING (newname
)->data
);
2133 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2138 report_file_error ("Adding new name", Flist (2, args
));
2140 report_file_error ("Adding new name", Flist (2, &filename
));
2143 #endif /* not WINDOWSNT */
2150 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2151 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2152 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2153 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2154 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2155 A number as third arg means request confirmation if LINKNAME already exists.\n\
2156 This happens for interactive use with M-x.")
2157 (filename
, linkname
, ok_if_already_exists
)
2158 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2161 Lisp_Object args
[2];
2163 Lisp_Object handler
;
2164 struct gcpro gcpro1
, gcpro2
;
2166 GCPRO2 (filename
, linkname
);
2167 CHECK_STRING (filename
, 0);
2168 CHECK_STRING (linkname
, 1);
2169 /* If the link target has a ~, we must expand it to get
2170 a truly valid file name. Otherwise, do not expand;
2171 we want to permit links to relative file names. */
2172 if (XSTRING (filename
)->data
[0] == '~')
2173 filename
= Fexpand_file_name (filename
, Qnil
);
2174 linkname
= Fexpand_file_name (linkname
, Qnil
);
2176 /* If the file name has special constructs in it,
2177 call the corresponding file handler. */
2178 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2179 if (!NILP (handler
))
2180 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2181 linkname
, ok_if_already_exists
));
2183 if (NILP (ok_if_already_exists
)
2184 || INTEGERP (ok_if_already_exists
))
2185 barf_or_query_if_file_exists (linkname
, "make it a link",
2186 INTEGERP (ok_if_already_exists
));
2187 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2189 /* If we didn't complain already, silently delete existing file. */
2190 if (errno
== EEXIST
)
2192 unlink (XSTRING (linkname
)->data
);
2193 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2203 report_file_error ("Making symbolic link", Flist (2, args
));
2205 report_file_error ("Making symbolic link", Flist (2, &filename
));
2211 #endif /* S_IFLNK */
2215 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2216 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2217 "Define the job-wide logical name NAME to have the value STRING.\n\
2218 If STRING is nil or a null string, the logical name NAME is deleted.")
2220 Lisp_Object varname
;
2223 CHECK_STRING (varname
, 0);
2225 delete_logical_name (XSTRING (varname
)->data
);
2228 CHECK_STRING (string
, 1);
2230 if (XSTRING (string
)->size
== 0)
2231 delete_logical_name (XSTRING (varname
)->data
);
2233 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2242 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2243 "Open a network connection to PATH using LOGIN as the login string.")
2245 Lisp_Object path
, login
;
2249 CHECK_STRING (path
, 0);
2250 CHECK_STRING (login
, 0);
2252 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2254 if (netresult
== -1)
2259 #endif /* HPUX_NET */
2261 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2263 "Return t if file FILENAME specifies an absolute path name.\n\
2264 On Unix, this is a name starting with a `/' or a `~'.")
2266 Lisp_Object filename
;
2270 CHECK_STRING (filename
, 0);
2271 ptr
= XSTRING (filename
)->data
;
2272 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2274 /* ??? This criterion is probably wrong for '<'. */
2275 || index (ptr
, ':') || index (ptr
, '<')
2276 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2280 || (*ptr
!= 0 && ptr
[1] == ':' && (ptr
[2] == '/' || ptr
[2] == '\\'))
2288 /* Return nonzero if file FILENAME exists and can be executed. */
2291 check_executable (filename
)
2295 return (eaccess (filename
, 1) >= 0);
2297 /* Access isn't quite right because it uses the real uid
2298 and we really want to test with the effective uid.
2299 But Unix doesn't give us a right way to do it. */
2300 return (access (filename
, 1) >= 0);
2304 /* Return nonzero if file FILENAME exists and can be written. */
2307 check_writable (filename
)
2311 return (eaccess (filename
, 2) >= 0);
2313 /* Access isn't quite right because it uses the real uid
2314 and we really want to test with the effective uid.
2315 But Unix doesn't give us a right way to do it.
2316 Opening with O_WRONLY could work for an ordinary file,
2317 but would lose for directories. */
2318 return (access (filename
, 2) >= 0);
2322 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2323 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2324 See also `file-readable-p' and `file-attributes'.")
2326 Lisp_Object filename
;
2328 Lisp_Object abspath
;
2329 Lisp_Object handler
;
2330 struct stat statbuf
;
2332 CHECK_STRING (filename
, 0);
2333 abspath
= Fexpand_file_name (filename
, Qnil
);
2335 /* If the file name has special constructs in it,
2336 call the corresponding file handler. */
2337 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2338 if (!NILP (handler
))
2339 return call2 (handler
, Qfile_exists_p
, abspath
);
2341 return (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2344 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2345 "Return t if FILENAME can be executed by you.\n\
2346 For a directory, this means you can access files in that directory.")
2348 Lisp_Object filename
;
2351 Lisp_Object abspath
;
2352 Lisp_Object handler
;
2354 CHECK_STRING (filename
, 0);
2355 abspath
= Fexpand_file_name (filename
, Qnil
);
2357 /* If the file name has special constructs in it,
2358 call the corresponding file handler. */
2359 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2360 if (!NILP (handler
))
2361 return call2 (handler
, Qfile_executable_p
, abspath
);
2363 return (check_executable (XSTRING (abspath
)->data
) ? Qt
: Qnil
);
2366 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2367 "Return t if file FILENAME exists and you can read it.\n\
2368 See also `file-exists-p' and `file-attributes'.")
2370 Lisp_Object filename
;
2372 Lisp_Object abspath
;
2373 Lisp_Object handler
;
2376 CHECK_STRING (filename
, 0);
2377 abspath
= Fexpand_file_name (filename
, Qnil
);
2379 /* If the file name has special constructs in it,
2380 call the corresponding file handler. */
2381 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2382 if (!NILP (handler
))
2383 return call2 (handler
, Qfile_readable_p
, abspath
);
2385 desc
= open (XSTRING (abspath
)->data
, O_RDONLY
);
2392 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2394 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2395 "Return t if file FILENAME can be written or created by you.")
2397 Lisp_Object filename
;
2399 Lisp_Object abspath
, dir
;
2400 Lisp_Object handler
;
2401 struct stat statbuf
;
2403 CHECK_STRING (filename
, 0);
2404 abspath
= Fexpand_file_name (filename
, Qnil
);
2406 /* If the file name has special constructs in it,
2407 call the corresponding file handler. */
2408 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2409 if (!NILP (handler
))
2410 return call2 (handler
, Qfile_writable_p
, abspath
);
2412 if (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0)
2413 return (check_writable (XSTRING (abspath
)->data
)
2415 dir
= Ffile_name_directory (abspath
);
2418 dir
= Fdirectory_file_name (dir
);
2422 dir
= Fdirectory_file_name (dir
);
2424 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2428 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2429 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2430 The value is the name of the file to which it is linked.\n\
2431 Otherwise returns nil.")
2433 Lisp_Object filename
;
2440 Lisp_Object handler
;
2442 CHECK_STRING (filename
, 0);
2443 filename
= Fexpand_file_name (filename
, Qnil
);
2445 /* If the file name has special constructs in it,
2446 call the corresponding file handler. */
2447 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2448 if (!NILP (handler
))
2449 return call2 (handler
, Qfile_symlink_p
, filename
);
2454 buf
= (char *) xmalloc (bufsize
);
2455 bzero (buf
, bufsize
);
2456 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2457 if (valsize
< bufsize
) break;
2458 /* Buffer was not long enough */
2467 val
= make_string (buf
, valsize
);
2470 #else /* not S_IFLNK */
2472 #endif /* not S_IFLNK */
2475 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2476 "Return t if file FILENAME is the name of a directory as a file.\n\
2477 A directory name spec may be given instead; then the value is t\n\
2478 if the directory so specified exists and really is a directory.")
2480 Lisp_Object filename
;
2482 register Lisp_Object abspath
;
2484 Lisp_Object handler
;
2486 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2488 /* If the file name has special constructs in it,
2489 call the corresponding file handler. */
2490 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2491 if (!NILP (handler
))
2492 return call2 (handler
, Qfile_directory_p
, abspath
);
2494 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2496 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2499 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2500 "Return t if file FILENAME is the name of a directory as a file,\n\
2501 and files in that directory can be opened by you. In order to use a\n\
2502 directory as a buffer's current directory, this predicate must return true.\n\
2503 A directory name spec may be given instead; then the value is t\n\
2504 if the directory so specified exists and really is a readable and\n\
2505 searchable directory.")
2507 Lisp_Object filename
;
2509 Lisp_Object handler
;
2511 struct gcpro gcpro1
;
2513 /* If the file name has special constructs in it,
2514 call the corresponding file handler. */
2515 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2516 if (!NILP (handler
))
2517 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2519 /* It's an unlikely combination, but yes we really do need to gcpro:
2520 Suppose that file-accessible-directory-p has no handler, but
2521 file-directory-p does have a handler; this handler causes a GC which
2522 relocates the string in `filename'; and finally file-directory-p
2523 returns non-nil. Then we would end up passing a garbaged string
2524 to file-executable-p. */
2526 tem
= (NILP (Ffile_directory_p (filename
))
2527 || NILP (Ffile_executable_p (filename
)));
2529 return tem
? Qnil
: Qt
;
2532 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2533 "Return t if file FILENAME is the name of a regular file.\n\
2534 This is the sort of file that holds an ordinary stream of data bytes.")
2536 Lisp_Object filename
;
2538 register Lisp_Object abspath
;
2540 Lisp_Object handler
;
2542 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2544 /* If the file name has special constructs in it,
2545 call the corresponding file handler. */
2546 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2547 if (!NILP (handler
))
2548 return call2 (handler
, Qfile_directory_p
, abspath
);
2550 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2552 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2555 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2556 "Return mode bits of FILE, as an integer.")
2558 Lisp_Object filename
;
2560 Lisp_Object abspath
;
2562 Lisp_Object handler
;
2564 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2566 /* If the file name has special constructs in it,
2567 call the corresponding file handler. */
2568 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2569 if (!NILP (handler
))
2570 return call2 (handler
, Qfile_modes
, abspath
);
2572 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2578 if (S_ISREG (st
.st_mode
)
2579 && (len
= XSTRING (abspath
)->size
) >= 5
2580 && (stricmp ((suffix
= XSTRING (abspath
)->data
+ len
-4), ".com") == 0
2581 || stricmp (suffix
, ".exe") == 0
2582 || stricmp (suffix
, ".bat") == 0))
2583 st
.st_mode
|= S_IEXEC
;
2587 return make_number (st
.st_mode
& 07777);
2590 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2591 "Set mode bits of FILE to MODE (an integer).\n\
2592 Only the 12 low bits of MODE are used.")
2594 Lisp_Object filename
, mode
;
2596 Lisp_Object abspath
;
2597 Lisp_Object handler
;
2599 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2600 CHECK_NUMBER (mode
, 1);
2602 /* If the file name has special constructs in it,
2603 call the corresponding file handler. */
2604 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2605 if (!NILP (handler
))
2606 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2609 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2610 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2612 if (!egetenv ("USE_DOMAIN_ACLS"))
2615 struct timeval tvp
[2];
2617 /* chmod on apollo also change the file's modtime; need to save the
2618 modtime and then restore it. */
2619 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2621 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2625 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2626 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2628 /* reset the old accessed and modified times. */
2629 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2631 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2634 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2635 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2642 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2643 "Set the file permission bits for newly created files.\n\
2644 The argument MODE should be an integer; only the low 9 bits are used.\n\
2645 This setting is inherited by subprocesses.")
2649 CHECK_NUMBER (mode
, 0);
2651 umask ((~ XINT (mode
)) & 0777);
2656 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2657 "Return the default file protection for created files.\n\
2658 The value is an integer.")
2664 realmask
= umask (0);
2667 XSETINT (value
, (~ realmask
) & 0777);
2673 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2674 "Tell Unix to finish all pending disk updates.")
2683 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2684 "Return t if file FILE1 is newer than file FILE2.\n\
2685 If FILE1 does not exist, the answer is nil;\n\
2686 otherwise, if FILE2 does not exist, the answer is t.")
2688 Lisp_Object file1
, file2
;
2690 Lisp_Object abspath1
, abspath2
;
2693 Lisp_Object handler
;
2694 struct gcpro gcpro1
, gcpro2
;
2696 CHECK_STRING (file1
, 0);
2697 CHECK_STRING (file2
, 0);
2700 GCPRO2 (abspath1
, file2
);
2701 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2702 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2705 /* If the file name has special constructs in it,
2706 call the corresponding file handler. */
2707 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2709 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2710 if (!NILP (handler
))
2711 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2713 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2716 mtime1
= st
.st_mtime
;
2718 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2721 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2725 Lisp_Object Qfind_buffer_file_type
;
2728 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2730 "Insert contents of file FILENAME after point.\n\
2731 Returns list of absolute file name and length of data inserted.\n\
2732 If second argument VISIT is non-nil, the buffer's visited filename\n\
2733 and last save file modtime are set, and it is marked unmodified.\n\
2734 If visiting and the file does not exist, visiting is completed\n\
2735 before the error is signaled.\n\n\
2736 The optional third and fourth arguments BEG and END\n\
2737 specify what portion of the file to insert.\n\
2738 If VISIT is non-nil, BEG and END must be nil.\n\
2739 If optional fifth argument REPLACE is non-nil,\n\
2740 it means replace the current buffer contents (in the accessible portion)\n\
2741 with the file contents. This is better than simply deleting and inserting\n\
2742 the whole thing because (1) it preserves some marker positions\n\
2743 and (2) it puts less data in the undo list.")
2744 (filename
, visit
, beg
, end
, replace
)
2745 Lisp_Object filename
, visit
, beg
, end
, replace
;
2749 register int inserted
= 0;
2750 register int how_much
;
2751 int count
= specpdl_ptr
- specpdl
;
2752 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2753 Lisp_Object handler
, val
, insval
;
2756 int not_regular
= 0;
2758 if (current_buffer
->base_buffer
&& ! NILP (visit
))
2759 error ("Cannot do file visiting in an indirect buffer");
2761 if (!NILP (current_buffer
->read_only
))
2762 Fbarf_if_buffer_read_only ();
2767 GCPRO3 (filename
, val
, p
);
2769 CHECK_STRING (filename
, 0);
2770 filename
= Fexpand_file_name (filename
, Qnil
);
2772 /* If the file name has special constructs in it,
2773 call the corresponding file handler. */
2774 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2775 if (!NILP (handler
))
2777 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2778 visit
, beg
, end
, replace
);
2785 if (stat (XSTRING (filename
)->data
, &st
) < 0)
2787 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
2788 || fstat (fd
, &st
) < 0)
2789 #endif /* not APOLLO */
2791 if (fd
>= 0) close (fd
);
2794 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2801 /* This code will need to be changed in order to work on named
2802 pipes, and it's probably just not worth it. So we should at
2803 least signal an error. */
2804 if (!S_ISREG (st
.st_mode
))
2807 Fsignal (Qfile_error
,
2808 Fcons (build_string ("not a regular file"),
2809 Fcons (filename
, Qnil
)));
2817 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
2820 /* Replacement should preserve point as it preserves markers. */
2821 if (!NILP (replace
))
2822 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2824 record_unwind_protect (close_file_unwind
, make_number (fd
));
2826 /* Supposedly happens on VMS. */
2828 error ("File size is negative");
2830 if (!NILP (beg
) || !NILP (end
))
2832 error ("Attempt to visit less than an entire file");
2835 CHECK_NUMBER (beg
, 0);
2837 XSETFASTINT (beg
, 0);
2840 CHECK_NUMBER (end
, 0);
2843 XSETINT (end
, st
.st_size
);
2844 if (XINT (end
) != st
.st_size
)
2845 error ("maximum buffer size exceeded");
2848 /* If requested, replace the accessible part of the buffer
2849 with the file contents. Avoid replacing text at the
2850 beginning or end of the buffer that matches the file contents;
2851 that preserves markers pointing to the unchanged parts. */
2853 /* On MSDOS, replace mode doesn't really work, except for binary files,
2854 and it's not worth supporting just for them. */
2855 if (!NILP (replace
))
2858 XSETFASTINT (beg
, 0);
2859 XSETFASTINT (end
, st
.st_size
);
2860 del_range_1 (BEGV
, ZV
, 0);
2862 #else /* not DOS_NT */
2863 if (!NILP (replace
))
2865 unsigned char buffer
[1 << 14];
2866 int same_at_start
= BEGV
;
2867 int same_at_end
= ZV
;
2872 /* Count how many chars at the start of the file
2873 match the text at the beginning of the buffer. */
2878 nread
= read (fd
, buffer
, sizeof buffer
);
2880 error ("IO error reading %s: %s",
2881 XSTRING (filename
)->data
, strerror (errno
));
2882 else if (nread
== 0)
2885 while (bufpos
< nread
&& same_at_start
< ZV
2886 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2887 same_at_start
++, bufpos
++;
2888 /* If we found a discrepancy, stop the scan.
2889 Otherwise loop around and scan the next bufferfull. */
2890 if (bufpos
!= nread
)
2894 /* If the file matches the buffer completely,
2895 there's no need to replace anything. */
2896 if (same_at_start
- BEGV
== st
.st_size
)
2900 /* Truncate the buffer to the size of the file. */
2901 del_range_1 (same_at_start
, same_at_end
, 0);
2906 /* Count how many chars at the end of the file
2907 match the text at the end of the buffer. */
2910 int total_read
, nread
, bufpos
, curpos
, trial
;
2912 /* At what file position are we now scanning? */
2913 curpos
= st
.st_size
- (ZV
- same_at_end
);
2914 /* If the entire file matches the buffer tail, stop the scan. */
2917 /* How much can we scan in the next step? */
2918 trial
= min (curpos
, sizeof buffer
);
2919 if (lseek (fd
, curpos
- trial
, 0) < 0)
2920 report_file_error ("Setting file position",
2921 Fcons (filename
, Qnil
));
2924 while (total_read
< trial
)
2926 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2928 error ("IO error reading %s: %s",
2929 XSTRING (filename
)->data
, strerror (errno
));
2930 total_read
+= nread
;
2932 /* Scan this bufferfull from the end, comparing with
2933 the Emacs buffer. */
2934 bufpos
= total_read
;
2935 /* Compare with same_at_start to avoid counting some buffer text
2936 as matching both at the file's beginning and at the end. */
2937 while (bufpos
> 0 && same_at_end
> same_at_start
2938 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2939 same_at_end
--, bufpos
--;
2940 /* If we found a discrepancy, stop the scan.
2941 Otherwise loop around and scan the preceding bufferfull. */
2947 /* Don't try to reuse the same piece of text twice. */
2948 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2950 same_at_end
+= overlap
;
2952 /* Arrange to read only the nonmatching middle part of the file. */
2953 XSETFASTINT (beg
, same_at_start
- BEGV
);
2954 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
2956 del_range_1 (same_at_start
, same_at_end
, 0);
2957 /* Insert from the file at the proper position. */
2958 SET_PT (same_at_start
);
2960 #endif /* not DOS_NT */
2962 total
= XINT (end
) - XINT (beg
);
2965 register Lisp_Object temp
;
2967 /* Make sure point-max won't overflow after this insertion. */
2968 XSETINT (temp
, total
);
2969 if (total
!= XINT (temp
))
2970 error ("maximum buffer size exceeded");
2973 if (NILP (visit
) && total
> 0)
2974 prepare_to_modify_buffer (point
, point
);
2977 if (GAP_SIZE
< total
)
2978 make_gap (total
- GAP_SIZE
);
2980 if (XINT (beg
) != 0 || !NILP (replace
))
2982 if (lseek (fd
, XINT (beg
), 0) < 0)
2983 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2987 while (inserted
< total
)
2989 /* try is reserved in some compilers (Microsoft C) */
2990 int trytry
= min (total
- inserted
, 64 << 10);
2993 /* Allow quitting out of the actual I/O. */
2996 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, trytry
);
3013 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3014 /* Determine file type from name and remove LFs from CR-LFs if the file
3015 is deemed to be a text file. */
3017 current_buffer
->buffer_file_type
3018 = call1 (Qfind_buffer_file_type
, filename
);
3019 if (NILP (current_buffer
->buffer_file_type
))
3022 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
3025 GPT
-= reduced_size
;
3026 GAP_SIZE
+= reduced_size
;
3027 inserted
-= reduced_size
;
3034 record_insert (point
, inserted
);
3036 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3037 offset_intervals (current_buffer
, point
, inserted
);
3043 /* Discard the unwind protect for closing the file. */
3047 error ("IO error reading %s: %s",
3048 XSTRING (filename
)->data
, strerror (errno
));
3055 if (!EQ (current_buffer
->undo_list
, Qt
))
3056 current_buffer
->undo_list
= Qnil
;
3058 stat (XSTRING (filename
)->data
, &st
);
3063 current_buffer
->modtime
= st
.st_mtime
;
3064 current_buffer
->filename
= filename
;
3067 SAVE_MODIFF
= MODIFF
;
3068 current_buffer
->auto_save_modified
= MODIFF
;
3069 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3070 #ifdef CLASH_DETECTION
3073 if (!NILP (current_buffer
->filename
))
3074 unlock_file (current_buffer
->filename
);
3075 unlock_file (filename
);
3077 #endif /* CLASH_DETECTION */
3079 Fsignal (Qfile_error
,
3080 Fcons (build_string ("not a regular file"),
3081 Fcons (filename
, Qnil
)));
3083 /* If visiting nonexistent file, return nil. */
3084 if (current_buffer
->modtime
== -1)
3085 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3088 /* Decode file format */
3091 insval
= call3 (Qformat_decode
,
3092 Qnil
, make_number (inserted
), visit
);
3093 CHECK_NUMBER (insval
, 0);
3094 inserted
= XFASTINT (insval
);
3097 if (inserted
> 0 && NILP (visit
) && total
> 0)
3098 signal_after_change (point
, 0, inserted
);
3102 p
= Vafter_insert_file_functions
;
3105 insval
= call1 (Fcar (p
), make_number (inserted
));
3108 CHECK_NUMBER (insval
, 0);
3109 inserted
= XFASTINT (insval
);
3117 val
= Fcons (filename
,
3118 Fcons (make_number (inserted
),
3121 RETURN_UNGCPRO (unbind_to (count
, val
));
3124 static Lisp_Object
build_annotations ();
3126 /* If build_annotations switched buffers, switch back to BUF.
3127 Kill the temporary buffer that was selected in the meantime. */
3130 build_annotations_unwind (buf
)
3135 if (XBUFFER (buf
) == current_buffer
)
3137 tembuf
= Fcurrent_buffer ();
3139 Fkill_buffer (tembuf
);
3143 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
3144 "r\nFWrite region to file: ",
3145 "Write current region into specified file.\n\
3146 When called from a program, takes three arguments:\n\
3147 START, END and FILENAME. START and END are buffer positions.\n\
3148 Optional fourth argument APPEND if non-nil means\n\
3149 append to existing file contents (if any).\n\
3150 Optional fifth argument VISIT if t means\n\
3151 set the last-save-file-modtime of buffer to this file's modtime\n\
3152 and mark buffer not modified.\n\
3153 If VISIT is a string, it is a second file name;\n\
3154 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3155 VISIT is also the file name to lock and unlock for clash detection.\n\
3156 If VISIT is neither t nor nil nor a string,\n\
3157 that means do not print the \"Wrote file\" message.\n\
3158 Kludgy feature: if START is a string, then that string is written\n\
3159 to the file, instead of any buffer contents, and END is ignored.")
3160 (start
, end
, filename
, append
, visit
)
3161 Lisp_Object start
, end
, filename
, append
, visit
;
3169 int count
= specpdl_ptr
- specpdl
;
3172 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3174 Lisp_Object handler
;
3175 Lisp_Object visit_file
;
3176 Lisp_Object annotations
;
3177 int visiting
, quietly
;
3178 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3179 struct buffer
*given_buffer
;
3181 int buffer_file_type
3182 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3185 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3186 error ("Cannot do file visiting in an indirect buffer");
3188 if (!NILP (start
) && !STRINGP (start
))
3189 validate_region (&start
, &end
);
3191 GCPRO2 (filename
, visit
);
3192 filename
= Fexpand_file_name (filename
, Qnil
);
3193 if (STRINGP (visit
))
3194 visit_file
= Fexpand_file_name (visit
, Qnil
);
3196 visit_file
= filename
;
3199 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3200 quietly
= !NILP (visit
);
3204 GCPRO4 (start
, filename
, annotations
, visit_file
);
3206 /* If the file name has special constructs in it,
3207 call the corresponding file handler. */
3208 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3209 /* If FILENAME has no handler, see if VISIT has one. */
3210 if (NILP (handler
) && STRINGP (visit
))
3211 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3213 if (!NILP (handler
))
3216 val
= call6 (handler
, Qwrite_region
, start
, end
,
3217 filename
, append
, visit
);
3221 SAVE_MODIFF
= MODIFF
;
3222 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3223 current_buffer
->filename
= visit_file
;
3229 /* Special kludge to simplify auto-saving. */
3232 XSETFASTINT (start
, BEG
);
3233 XSETFASTINT (end
, Z
);
3236 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3237 count1
= specpdl_ptr
- specpdl
;
3239 given_buffer
= current_buffer
;
3240 annotations
= build_annotations (start
, end
);
3241 if (current_buffer
!= given_buffer
)
3247 #ifdef CLASH_DETECTION
3249 lock_file (visit_file
);
3250 #endif /* CLASH_DETECTION */
3252 fn
= XSTRING (filename
)->data
;
3256 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3257 #else /* not DOS_NT */
3258 desc
= open (fn
, O_WRONLY
);
3259 #endif /* not DOS_NT */
3263 if (auto_saving
) /* Overwrite any previous version of autosave file */
3265 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3266 desc
= open (fn
, O_RDWR
);
3268 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3269 ? XSTRING (current_buffer
->filename
)->data
: 0,
3272 else /* Write to temporary name and rename if no errors */
3274 Lisp_Object temp_name
;
3275 temp_name
= Ffile_name_directory (filename
);
3277 if (!NILP (temp_name
))
3279 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3280 build_string ("$$SAVE$$")));
3281 fname
= XSTRING (filename
)->data
;
3282 fn
= XSTRING (temp_name
)->data
;
3283 desc
= creat_copy_attrs (fname
, fn
);
3286 /* If we can't open the temporary file, try creating a new
3287 version of the original file. VMS "creat" creates a
3288 new version rather than truncating an existing file. */
3291 desc
= creat (fn
, 0666);
3292 #if 0 /* This can clobber an existing file and fail to replace it,
3293 if the user runs out of space. */
3296 /* We can't make a new version;
3297 try to truncate and rewrite existing version if any. */
3299 desc
= open (fn
, O_RDWR
);
3305 desc
= creat (fn
, 0666);
3310 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3311 S_IREAD
| S_IWRITE
);
3312 #else /* not DOS_NT */
3313 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3314 #endif /* not DOS_NT */
3315 #endif /* not VMS */
3321 #ifdef CLASH_DETECTION
3323 if (!auto_saving
) unlock_file (visit_file
);
3325 #endif /* CLASH_DETECTION */
3326 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3329 record_unwind_protect (close_file_unwind
, make_number (desc
));
3332 if (lseek (desc
, 0, 2) < 0)
3334 #ifdef CLASH_DETECTION
3335 if (!auto_saving
) unlock_file (visit_file
);
3336 #endif /* CLASH_DETECTION */
3337 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3342 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3343 * if we do writes that don't end with a carriage return. Furthermore
3344 * it cannot handle writes of more then 16K. The modified
3345 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3346 * this EXCEPT for the last record (iff it doesn't end with a carriage
3347 * return). This implies that if your buffer doesn't end with a carriage
3348 * return, you get one free... tough. However it also means that if
3349 * we make two calls to sys_write (a la the following code) you can
3350 * get one at the gap as well. The easiest way to fix this (honest)
3351 * is to move the gap to the next newline (or the end of the buffer).
3356 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3357 move_gap (find_next_newline (GPT
, 1));
3363 if (STRINGP (start
))
3365 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3366 XSTRING (start
)->size
, 0, &annotations
);
3369 else if (XINT (start
) != XINT (end
))
3372 if (XINT (start
) < GPT
)
3374 register int end1
= XINT (end
);
3376 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3377 min (GPT
, end1
) - tem
, tem
, &annotations
);
3378 nwritten
+= min (GPT
, end1
) - tem
;
3382 if (XINT (end
) > GPT
&& !failure
)
3385 tem
= max (tem
, GPT
);
3386 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3388 nwritten
+= XINT (end
) - tem
;
3394 /* If file was empty, still need to write the annotations */
3395 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3403 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3404 Disk full in NFS may be reported here. */
3405 /* mib says that closing the file will try to write as fast as NFS can do
3406 it, and that means the fsync here is not crucial for autosave files. */
3407 if (!auto_saving
&& fsync (desc
) < 0)
3408 failure
= 1, save_errno
= errno
;
3411 /* Spurious "file has changed on disk" warnings have been
3412 observed on Suns as well.
3413 It seems that `close' can change the modtime, under nfs.
3415 (This has supposedly been fixed in Sunos 4,
3416 but who knows about all the other machines with NFS?) */
3419 /* On VMS and APOLLO, must do the stat after the close
3420 since closing changes the modtime. */
3423 /* Recall that #if defined does not work on VMS. */
3430 /* NFS can report a write failure now. */
3431 if (close (desc
) < 0)
3432 failure
= 1, save_errno
= errno
;
3435 /* If we wrote to a temporary name and had no errors, rename to real name. */
3439 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3447 /* Discard the unwind protect for close_file_unwind. */
3448 specpdl_ptr
= specpdl
+ count1
;
3449 /* Restore the original current buffer. */
3450 visit_file
= unbind_to (count
, visit_file
);
3452 #ifdef CLASH_DETECTION
3454 unlock_file (visit_file
);
3455 #endif /* CLASH_DETECTION */
3457 /* Do this before reporting IO error
3458 to avoid a "file has changed on disk" warning on
3459 next attempt to save. */
3461 current_buffer
->modtime
= st
.st_mtime
;
3464 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3468 SAVE_MODIFF
= MODIFF
;
3469 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3470 current_buffer
->filename
= visit_file
;
3471 update_mode_lines
++;
3477 message ("Wrote %s", XSTRING (visit_file
)->data
);
3482 Lisp_Object
merge ();
3484 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3485 "Return t if (car A) is numerically less than (car B).")
3489 return Flss (Fcar (a
), Fcar (b
));
3492 /* Build the complete list of annotations appropriate for writing out
3493 the text between START and END, by calling all the functions in
3494 write-region-annotate-functions and merging the lists they return.
3495 If one of these functions switches to a different buffer, we assume
3496 that buffer contains altered text. Therefore, the caller must
3497 make sure to restore the current buffer in all cases,
3498 as save-excursion would do. */
3501 build_annotations (start
, end
)
3502 Lisp_Object start
, end
;
3504 Lisp_Object annotations
;
3506 struct gcpro gcpro1
, gcpro2
;
3509 p
= Vwrite_region_annotate_functions
;
3510 GCPRO2 (annotations
, p
);
3513 struct buffer
*given_buffer
= current_buffer
;
3514 Vwrite_region_annotations_so_far
= annotations
;
3515 res
= call2 (Fcar (p
), start
, end
);
3516 /* If the function makes a different buffer current,
3517 assume that means this buffer contains altered text to be output.
3518 Reset START and END from the buffer bounds
3519 and discard all previous annotations because they should have
3520 been dealt with by this function. */
3521 if (current_buffer
!= given_buffer
)
3527 Flength (res
); /* Check basic validity of return value */
3528 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3532 /* Now do the same for annotation functions implied by the file-format */
3533 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
3534 p
= Vauto_save_file_format
;
3536 p
= current_buffer
->file_format
;
3539 struct buffer
*given_buffer
= current_buffer
;
3540 Vwrite_region_annotations_so_far
= annotations
;
3541 res
= call3 (Qformat_annotate_function
, Fcar (p
), start
, end
);
3542 if (current_buffer
!= given_buffer
)
3549 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3556 /* Write to descriptor DESC the LEN characters starting at ADDR,
3557 assuming they start at position POS in the buffer.
3558 Intersperse with them the annotations from *ANNOT
3559 (those which fall within the range of positions POS to POS + LEN),
3560 each at its appropriate position.
3562 Modify *ANNOT by discarding elements as we output them.
3563 The return value is negative in case of system call failure. */
3566 a_write (desc
, addr
, len
, pos
, annot
)
3568 register char *addr
;
3575 int lastpos
= pos
+ len
;
3577 while (NILP (*annot
) || CONSP (*annot
))
3579 tem
= Fcar_safe (Fcar (*annot
));
3580 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3581 nextpos
= XFASTINT (tem
);
3583 return e_write (desc
, addr
, lastpos
- pos
);
3586 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3588 addr
+= nextpos
- pos
;
3591 tem
= Fcdr (Fcar (*annot
));
3594 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3597 *annot
= Fcdr (*annot
);
3602 e_write (desc
, addr
, len
)
3604 register char *addr
;
3607 char buf
[16 * 1024];
3608 register char *p
, *end
;
3610 if (!EQ (current_buffer
->selective_display
, Qt
))
3611 return write (desc
, addr
, len
) - len
;
3615 end
= p
+ sizeof buf
;
3620 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3629 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3635 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3636 Sverify_visited_file_modtime
, 1, 1, 0,
3637 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3638 This means that the file has not been changed since it was visited or saved.")
3644 Lisp_Object handler
;
3646 CHECK_BUFFER (buf
, 0);
3649 if (!STRINGP (b
->filename
)) return Qt
;
3650 if (b
->modtime
== 0) return Qt
;
3652 /* If the file name has special constructs in it,
3653 call the corresponding file handler. */
3654 handler
= Ffind_file_name_handler (b
->filename
,
3655 Qverify_visited_file_modtime
);
3656 if (!NILP (handler
))
3657 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3659 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3661 /* If the file doesn't exist now and didn't exist before,
3662 we say that it isn't modified, provided the error is a tame one. */
3663 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3668 if (st
.st_mtime
== b
->modtime
3669 /* If both are positive, accept them if they are off by one second. */
3670 || (st
.st_mtime
> 0 && b
->modtime
> 0
3671 && (st
.st_mtime
== b
->modtime
+ 1
3672 || st
.st_mtime
== b
->modtime
- 1)))
3677 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3678 Sclear_visited_file_modtime
, 0, 0, 0,
3679 "Clear out records of last mod time of visited file.\n\
3680 Next attempt to save will certainly not complain of a discrepancy.")
3683 current_buffer
->modtime
= 0;
3687 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3688 Svisited_file_modtime
, 0, 0, 0,
3689 "Return the current buffer's recorded visited file modification time.\n\
3690 The value is a list of the form (HIGH . LOW), like the time values\n\
3691 that `file-attributes' returns.")
3694 return long_to_cons (current_buffer
->modtime
);
3697 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3698 Sset_visited_file_modtime
, 0, 1, 0,
3699 "Update buffer's recorded modification time from the visited file's time.\n\
3700 Useful if the buffer was not read from the file normally\n\
3701 or if the file itself has been changed for some known benign reason.\n\
3702 An argument specifies the modification time value to use\n\
3703 \(instead of that of the visited file), in the form of a list\n\
3704 \(HIGH . LOW) or (HIGH LOW).")
3706 Lisp_Object time_list
;
3708 if (!NILP (time_list
))
3709 current_buffer
->modtime
= cons_to_long (time_list
);
3712 register Lisp_Object filename
;
3714 Lisp_Object handler
;
3716 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3718 /* If the file name has special constructs in it,
3719 call the corresponding file handler. */
3720 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3721 if (!NILP (handler
))
3722 /* The handler can find the file name the same way we did. */
3723 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3724 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3725 current_buffer
->modtime
= st
.st_mtime
;
3735 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3736 Fsleep_for (make_number (1), Qnil
);
3737 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3738 Fsleep_for (make_number (1), Qnil
);
3739 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3740 Fsleep_for (make_number (1), Qnil
);
3750 /* Get visited file's mode to become the auto save file's mode. */
3751 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3752 /* But make sure we can overwrite it later! */
3753 auto_save_mode_bits
= st
.st_mode
| 0600;
3755 auto_save_mode_bits
= 0666;
3758 Fwrite_region (Qnil
, Qnil
,
3759 current_buffer
->auto_save_file_name
,
3764 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3767 close (XINT (desc
));
3771 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3772 "Auto-save all buffers that need it.\n\
3773 This is all buffers that have auto-saving enabled\n\
3774 and are changed since last auto-saved.\n\
3775 Auto-saving writes the buffer into a file\n\
3776 so that your editing is not lost if the system crashes.\n\
3777 This file is not the file you visited; that changes only when you save.\n\
3778 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3779 Non-nil first argument means do not print any message if successful.\n\
3780 Non-nil second argument means save only current buffer.")
3781 (no_message
, current_only
)
3782 Lisp_Object no_message
, current_only
;
3784 struct buffer
*old
= current_buffer
, *b
;
3785 Lisp_Object tail
, buf
;
3787 char *omessage
= echo_area_glyphs
;
3788 int omessage_length
= echo_area_glyphs_length
;
3789 extern int minibuf_level
;
3790 int do_handled_files
;
3793 int count
= specpdl_ptr
- specpdl
;
3796 /* Ordinarily don't quit within this function,
3797 but don't make it impossible to quit (in case we get hung in I/O). */
3801 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3802 point to non-strings reached from Vbuffer_alist. */
3808 if (!NILP (Vrun_hooks
))
3809 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3811 if (STRINGP (Vauto_save_list_file_name
))
3814 listdesc
= open (XSTRING (Vauto_save_list_file_name
)->data
,
3815 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3816 S_IREAD
| S_IWRITE
);
3817 #else /* not DOS_NT */
3818 listdesc
= creat (XSTRING (Vauto_save_list_file_name
)->data
, 0666);
3819 #endif /* not DOS_NT */
3824 /* Arrange to close that file whether or not we get an error. */
3826 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3828 /* First, save all files which don't have handlers. If Emacs is
3829 crashing, the handlers may tweak what is causing Emacs to crash
3830 in the first place, and it would be a shame if Emacs failed to
3831 autosave perfectly ordinary files because it couldn't handle some
3833 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3834 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
3836 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3839 /* Record all the buffers that have auto save mode
3840 in the special file that lists them. */
3841 if (STRINGP (b
->auto_save_file_name
)
3842 && listdesc
>= 0 && do_handled_files
== 0)
3844 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3845 XSTRING (b
->auto_save_file_name
)->size
);
3846 write (listdesc
, "\n", 1);
3849 if (!NILP (current_only
)
3850 && b
!= current_buffer
)
3853 /* Don't auto-save indirect buffers.
3854 The base buffer takes care of it. */
3858 /* Check for auto save enabled
3859 and file changed since last auto save
3860 and file changed since last real save. */
3861 if (STRINGP (b
->auto_save_file_name
)
3862 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
3863 && b
->auto_save_modified
< BUF_MODIFF (b
)
3864 /* -1 means we've turned off autosaving for a while--see below. */
3865 && XINT (b
->save_length
) >= 0
3866 && (do_handled_files
3867 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3870 EMACS_TIME before_time
, after_time
;
3872 EMACS_GET_TIME (before_time
);
3874 /* If we had a failure, don't try again for 20 minutes. */
3875 if (b
->auto_save_failure_time
>= 0
3876 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3879 if ((XFASTINT (b
->save_length
) * 10
3880 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3881 /* A short file is likely to change a large fraction;
3882 spare the user annoying messages. */
3883 && XFASTINT (b
->save_length
) > 5000
3884 /* These messages are frequent and annoying for `*mail*'. */
3885 && !EQ (b
->filename
, Qnil
)
3886 && NILP (no_message
))
3888 /* It has shrunk too much; turn off auto-saving here. */
3889 message ("Buffer %s has shrunk a lot; auto save turned off there",
3890 XSTRING (b
->name
)->data
);
3891 /* Turn off auto-saving until there's a real save,
3892 and prevent any more warnings. */
3893 XSETINT (b
->save_length
, -1);
3894 Fsleep_for (make_number (1), Qnil
);
3897 set_buffer_internal (b
);
3898 if (!auto_saved
&& NILP (no_message
))
3899 message1 ("Auto-saving...");
3900 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3902 b
->auto_save_modified
= BUF_MODIFF (b
);
3903 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3904 set_buffer_internal (old
);
3906 EMACS_GET_TIME (after_time
);
3908 /* If auto-save took more than 60 seconds,
3909 assume it was an NFS failure that got a timeout. */
3910 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3911 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3915 /* Prevent another auto save till enough input events come in. */
3916 record_auto_save ();
3918 if (auto_saved
&& NILP (no_message
))
3921 message2 (omessage
, omessage_length
);
3923 message1 ("Auto-saving...done");
3929 unbind_to (count
, Qnil
);
3933 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3934 Sset_buffer_auto_saved
, 0, 0, 0,
3935 "Mark current buffer as auto-saved with its current text.\n\
3936 No auto-save file will be written until the buffer changes again.")
3939 current_buffer
->auto_save_modified
= MODIFF
;
3940 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3941 current_buffer
->auto_save_failure_time
= -1;
3945 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3946 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3947 "Clear any record of a recent auto-save failure in the current buffer.")
3950 current_buffer
->auto_save_failure_time
= -1;
3954 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3956 "Return t if buffer has been auto-saved since last read in or saved.")
3959 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3962 /* Reading and completing file names */
3963 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3965 /* In the string VAL, change each $ to $$ and return the result. */
3968 double_dollars (val
)
3971 register unsigned char *old
, *new;
3975 osize
= XSTRING (val
)->size
;
3976 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3977 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3978 if (*old
++ == '$') count
++;
3981 old
= XSTRING (val
)->data
;
3982 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3983 new = XSTRING (val
)->data
;
3984 for (n
= osize
; n
> 0; n
--)
3997 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3999 "Internal subroutine for read-file-name. Do not call this.")
4000 (string
, dir
, action
)
4001 Lisp_Object string
, dir
, action
;
4002 /* action is nil for complete, t for return list of completions,
4003 lambda for verify final value */
4005 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4007 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4014 /* No need to protect ACTION--we only compare it with t and nil. */
4015 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4017 if (XSTRING (string
)->size
== 0)
4019 if (EQ (action
, Qlambda
))
4027 orig_string
= string
;
4028 string
= Fsubstitute_in_file_name (string
);
4029 changed
= NILP (Fstring_equal (string
, orig_string
));
4030 name
= Ffile_name_nondirectory (string
);
4031 val
= Ffile_name_directory (string
);
4033 realdir
= Fexpand_file_name (val
, realdir
);
4038 specdir
= Ffile_name_directory (string
);
4039 val
= Ffile_name_completion (name
, realdir
);
4044 return double_dollars (string
);
4048 if (!NILP (specdir
))
4049 val
= concat2 (specdir
, val
);
4051 return double_dollars (val
);
4054 #endif /* not VMS */
4058 if (EQ (action
, Qt
))
4059 return Ffile_name_all_completions (name
, realdir
);
4060 /* Only other case actually used is ACTION = lambda */
4062 /* Supposedly this helps commands such as `cd' that read directory names,
4063 but can someone explain how it helps them? -- RMS */
4064 if (XSTRING (name
)->size
== 0)
4067 return Ffile_exists_p (string
);
4070 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4071 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4072 Value is not expanded---you must call `expand-file-name' yourself.\n\
4073 Default name to DEFAULT if user enters a null string.\n\
4074 (If DEFAULT is omitted, the visited file name is used,\n\
4075 except that if INITIAL is specified, that combined with DIR is used.)\n\
4076 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4077 Non-nil and non-t means also require confirmation after completion.\n\
4078 Fifth arg INITIAL specifies text to start with.\n\
4079 DIR defaults to current buffer's directory default.")
4080 (prompt
, dir
, defalt
, mustmatch
, initial
)
4081 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4083 Lisp_Object val
, insdef
, insdef1
, tem
;
4084 struct gcpro gcpro1
, gcpro2
;
4085 register char *homedir
;
4089 dir
= current_buffer
->directory
;
4092 if (! NILP (initial
))
4093 defalt
= Fexpand_file_name (initial
, dir
);
4095 defalt
= current_buffer
->filename
;
4098 /* If dir starts with user's homedir, change that to ~. */
4099 homedir
= (char *) egetenv ("HOME");
4102 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4103 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4105 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4106 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4107 XSTRING (dir
)->data
[0] = '~';
4110 if (insert_default_directory
)
4113 if (!NILP (initial
))
4115 Lisp_Object args
[2], pos
;
4119 insdef
= Fconcat (2, args
);
4120 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4121 insdef1
= Fcons (double_dollars (insdef
), pos
);
4124 insdef1
= double_dollars (insdef
);
4126 else if (!NILP (initial
))
4129 insdef1
= Fcons (double_dollars (insdef
), 0);
4132 insdef
= Qnil
, insdef1
= Qnil
;
4135 count
= specpdl_ptr
- specpdl
;
4136 specbind (intern ("completion-ignore-case"), Qt
);
4139 GCPRO2 (insdef
, defalt
);
4140 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4141 dir
, mustmatch
, insdef1
,
4142 Qfile_name_history
);
4145 unbind_to (count
, Qnil
);
4150 error ("No file name specified");
4151 tem
= Fstring_equal (val
, insdef
);
4152 if (!NILP (tem
) && !NILP (defalt
))
4154 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4159 error ("No default file name");
4161 return Fsubstitute_in_file_name (val
);
4164 #if 0 /* Old version */
4165 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4166 /* Don't confuse make-docfile by having two doc strings for this function.
4167 make-docfile does not pay attention to #if, for good reason! */
4169 (prompt
, dir
, defalt
, mustmatch
, initial
)
4170 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4172 Lisp_Object val
, insdef
, tem
;
4173 struct gcpro gcpro1
, gcpro2
;
4174 register char *homedir
;
4178 dir
= current_buffer
->directory
;
4180 defalt
= current_buffer
->filename
;
4182 /* If dir starts with user's homedir, change that to ~. */
4183 homedir
= (char *) egetenv ("HOME");
4186 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4187 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4189 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4190 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4191 XSTRING (dir
)->data
[0] = '~';
4194 if (!NILP (initial
))
4196 else if (insert_default_directory
)
4199 insdef
= build_string ("");
4202 count
= specpdl_ptr
- specpdl
;
4203 specbind (intern ("completion-ignore-case"), Qt
);
4206 GCPRO2 (insdef
, defalt
);
4207 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4209 insert_default_directory
? insdef
: Qnil
,
4210 Qfile_name_history
);
4213 unbind_to (count
, Qnil
);
4218 error ("No file name specified");
4219 tem
= Fstring_equal (val
, insdef
);
4220 if (!NILP (tem
) && !NILP (defalt
))
4222 return Fsubstitute_in_file_name (val
);
4224 #endif /* Old version */
4228 Qexpand_file_name
= intern ("expand-file-name");
4229 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4230 Qdirectory_file_name
= intern ("directory-file-name");
4231 Qfile_name_directory
= intern ("file-name-directory");
4232 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4233 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4234 Qfile_name_as_directory
= intern ("file-name-as-directory");
4235 Qcopy_file
= intern ("copy-file");
4236 Qmake_directory_internal
= intern ("make-directory-internal");
4237 Qdelete_directory
= intern ("delete-directory");
4238 Qdelete_file
= intern ("delete-file");
4239 Qrename_file
= intern ("rename-file");
4240 Qadd_name_to_file
= intern ("add-name-to-file");
4241 Qmake_symbolic_link
= intern ("make-symbolic-link");
4242 Qfile_exists_p
= intern ("file-exists-p");
4243 Qfile_executable_p
= intern ("file-executable-p");
4244 Qfile_readable_p
= intern ("file-readable-p");
4245 Qfile_symlink_p
= intern ("file-symlink-p");
4246 Qfile_writable_p
= intern ("file-writable-p");
4247 Qfile_directory_p
= intern ("file-directory-p");
4248 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4249 Qfile_modes
= intern ("file-modes");
4250 Qset_file_modes
= intern ("set-file-modes");
4251 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4252 Qinsert_file_contents
= intern ("insert-file-contents");
4253 Qwrite_region
= intern ("write-region");
4254 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4255 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4257 staticpro (&Qexpand_file_name
);
4258 staticpro (&Qsubstitute_in_file_name
);
4259 staticpro (&Qdirectory_file_name
);
4260 staticpro (&Qfile_name_directory
);
4261 staticpro (&Qfile_name_nondirectory
);
4262 staticpro (&Qunhandled_file_name_directory
);
4263 staticpro (&Qfile_name_as_directory
);
4264 staticpro (&Qcopy_file
);
4265 staticpro (&Qmake_directory_internal
);
4266 staticpro (&Qdelete_directory
);
4267 staticpro (&Qdelete_file
);
4268 staticpro (&Qrename_file
);
4269 staticpro (&Qadd_name_to_file
);
4270 staticpro (&Qmake_symbolic_link
);
4271 staticpro (&Qfile_exists_p
);
4272 staticpro (&Qfile_executable_p
);
4273 staticpro (&Qfile_readable_p
);
4274 staticpro (&Qfile_symlink_p
);
4275 staticpro (&Qfile_writable_p
);
4276 staticpro (&Qfile_directory_p
);
4277 staticpro (&Qfile_accessible_directory_p
);
4278 staticpro (&Qfile_modes
);
4279 staticpro (&Qset_file_modes
);
4280 staticpro (&Qfile_newer_than_file_p
);
4281 staticpro (&Qinsert_file_contents
);
4282 staticpro (&Qwrite_region
);
4283 staticpro (&Qverify_visited_file_modtime
);
4285 Qfile_name_history
= intern ("file-name-history");
4286 Fset (Qfile_name_history
, Qnil
);
4287 staticpro (&Qfile_name_history
);
4289 Qfile_error
= intern ("file-error");
4290 staticpro (&Qfile_error
);
4291 Qfile_already_exists
= intern("file-already-exists");
4292 staticpro (&Qfile_already_exists
);
4295 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4296 staticpro (&Qfind_buffer_file_type
);
4299 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
4300 "*Format in which to write auto-save files.\n\
4301 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
4302 If it is t, which is the default, auto-save files are written in the\n\
4303 same format as a regular save would use.");
4304 Vauto_save_file_format
= Qt
;
4306 Qformat_decode
= intern ("format-decode");
4307 staticpro (&Qformat_decode
);
4308 Qformat_annotate_function
= intern ("format-annotate-function");
4309 staticpro (&Qformat_annotate_function
);
4311 Qcar_less_than_car
= intern ("car-less-than-car");
4312 staticpro (&Qcar_less_than_car
);
4314 Fput (Qfile_error
, Qerror_conditions
,
4315 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4316 Fput (Qfile_error
, Qerror_message
,
4317 build_string ("File error"));
4319 Fput (Qfile_already_exists
, Qerror_conditions
,
4320 Fcons (Qfile_already_exists
,
4321 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4322 Fput (Qfile_already_exists
, Qerror_message
,
4323 build_string ("File already exists"));
4325 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4326 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4327 insert_default_directory
= 1;
4329 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4330 "*Non-nil means write new files with record format `stmlf'.\n\
4331 nil means use format `var'. This variable is meaningful only on VMS.");
4332 vms_stmlf_recfm
= 0;
4334 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4335 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4336 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4339 The first argument given to HANDLER is the name of the I/O primitive\n\
4340 to be handled; the remaining arguments are the arguments that were\n\
4341 passed to that primitive. For example, if you do\n\
4342 (file-exists-p FILENAME)\n\
4343 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4344 (funcall HANDLER 'file-exists-p FILENAME)\n\
4345 The function `find-file-name-handler' checks this list for a handler\n\
4346 for its argument.");
4347 Vfile_name_handler_alist
= Qnil
;
4349 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4350 "A list of functions to be called at the end of `insert-file-contents'.\n\
4351 Each is passed one argument, the number of bytes inserted. It should return\n\
4352 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4353 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4354 responsible for calling the after-insert-file-functions if appropriate.");
4355 Vafter_insert_file_functions
= Qnil
;
4357 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4358 "A list of functions to be called at the start of `write-region'.\n\
4359 Each is passed two arguments, START and END as for `write-region'. It should\n\
4360 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4361 inserted at the specified positions of the file being written (1 means to\n\
4362 insert before the first byte written). The POSITIONs must be sorted into\n\
4363 increasing order. If there are several functions in the list, the several\n\
4364 lists are merged destructively.");
4365 Vwrite_region_annotate_functions
= Qnil
;
4367 DEFVAR_LISP ("write-region-annotations-so-far",
4368 &Vwrite_region_annotations_so_far
,
4369 "When an annotation function is called, this holds the previous annotations.\n\
4370 These are the annotations made by other annotation functions\n\
4371 that were already called. See also `write-region-annotate-functions'.");
4372 Vwrite_region_annotations_so_far
= Qnil
;
4374 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4375 "A list of file name handlers that temporarily should not be used.\n\
4376 This applies only to the operation `inhibit-file-name-operation'.");
4377 Vinhibit_file_name_handlers
= Qnil
;
4379 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4380 "The operation for which `inhibit-file-name-handlers' is applicable.");
4381 Vinhibit_file_name_operation
= Qnil
;
4383 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4384 "File name in which we write a list of all auto save file names.");
4385 Vauto_save_list_file_name
= Qnil
;
4387 defsubr (&Sfind_file_name_handler
);
4388 defsubr (&Sfile_name_directory
);
4389 defsubr (&Sfile_name_nondirectory
);
4390 defsubr (&Sunhandled_file_name_directory
);
4391 defsubr (&Sfile_name_as_directory
);
4392 defsubr (&Sdirectory_file_name
);
4393 defsubr (&Smake_temp_name
);
4394 defsubr (&Sexpand_file_name
);
4395 defsubr (&Ssubstitute_in_file_name
);
4396 defsubr (&Scopy_file
);
4397 defsubr (&Smake_directory_internal
);
4398 defsubr (&Sdelete_directory
);
4399 defsubr (&Sdelete_file
);
4400 defsubr (&Srename_file
);
4401 defsubr (&Sadd_name_to_file
);
4403 defsubr (&Smake_symbolic_link
);
4404 #endif /* S_IFLNK */
4406 defsubr (&Sdefine_logical_name
);
4409 defsubr (&Ssysnetunam
);
4410 #endif /* HPUX_NET */
4411 defsubr (&Sfile_name_absolute_p
);
4412 defsubr (&Sfile_exists_p
);
4413 defsubr (&Sfile_executable_p
);
4414 defsubr (&Sfile_readable_p
);
4415 defsubr (&Sfile_writable_p
);
4416 defsubr (&Sfile_symlink_p
);
4417 defsubr (&Sfile_directory_p
);
4418 defsubr (&Sfile_accessible_directory_p
);
4419 defsubr (&Sfile_regular_p
);
4420 defsubr (&Sfile_modes
);
4421 defsubr (&Sset_file_modes
);
4422 defsubr (&Sset_default_file_modes
);
4423 defsubr (&Sdefault_file_modes
);
4424 defsubr (&Sfile_newer_than_file_p
);
4425 defsubr (&Sinsert_file_contents
);
4426 defsubr (&Swrite_region
);
4427 defsubr (&Scar_less_than_car
);
4428 defsubr (&Sverify_visited_file_modtime
);
4429 defsubr (&Sclear_visited_file_modtime
);
4430 defsubr (&Svisited_file_modtime
);
4431 defsubr (&Sset_visited_file_modtime
);
4432 defsubr (&Sdo_auto_save
);
4433 defsubr (&Sset_buffer_auto_saved
);
4434 defsubr (&Sclear_buffer_auto_save_failure
);
4435 defsubr (&Srecent_auto_save_p
);
4437 defsubr (&Sread_file_name_internal
);
4438 defsubr (&Sread_file_name
);
4441 defsubr (&Sunix_sync
);