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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
23 #include <sys/types.h>
30 #if !defined (S_ISLNK) && defined (S_IFLNK)
31 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
34 #if !defined (S_ISREG) && defined (S_IFREG)
35 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
46 #include <sys/param.h>
68 extern char *strerror ();
85 #include "intervals.h"
94 #endif /* not WINDOWSNT */
122 #define min(a, b) ((a) < (b) ? (a) : (b))
123 #define max(a, b) ((a) > (b) ? (a) : (b))
125 /* Nonzero during writing of auto-save files */
128 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
129 a new file with the same mode as the original */
130 int auto_save_mode_bits
;
132 /* Alist of elements (REGEXP . HANDLER) for file names
133 whose I/O is done with a special handler. */
134 Lisp_Object Vfile_name_handler_alist
;
136 /* Format for auto-save files */
137 Lisp_Object Vauto_save_file_format
;
139 /* Lisp functions for translating file formats */
140 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
142 /* Functions to be called to process text properties in inserted file. */
143 Lisp_Object Vafter_insert_file_functions
;
145 /* Functions to be called to create text property annotations for file. */
146 Lisp_Object Vwrite_region_annotate_functions
;
148 /* During build_annotations, each time an annotation function is called,
149 this holds the annotations made by the previous functions. */
150 Lisp_Object Vwrite_region_annotations_so_far
;
152 /* File name in which we write a list of all our auto save files. */
153 Lisp_Object Vauto_save_list_file_name
;
155 /* Nonzero means, when reading a filename in the minibuffer,
156 start out by inserting the default directory into the minibuffer. */
157 int insert_default_directory
;
159 /* On VMS, nonzero means write new files with record format stmlf.
160 Zero means use var format. */
163 /* These variables describe handlers that have "already" had a chance
164 to handle the current operation.
166 Vinhibit_file_name_handlers is a list of file name handlers.
167 Vinhibit_file_name_operation is the operation being handled.
168 If we try to handle that operation, we ignore those handlers. */
170 static Lisp_Object Vinhibit_file_name_handlers
;
171 static Lisp_Object Vinhibit_file_name_operation
;
173 Lisp_Object Qfile_error
, Qfile_already_exists
;
175 Lisp_Object Qfile_name_history
;
177 Lisp_Object Qcar_less_than_car
;
179 report_file_error (string
, data
)
183 Lisp_Object errstring
;
185 errstring
= build_string (strerror (errno
));
187 /* System error messages are capitalized. Downcase the initial
188 unless it is followed by a slash. */
189 if (XSTRING (errstring
)->data
[1] != '/')
190 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
193 Fsignal (Qfile_error
,
194 Fcons (build_string (string
), Fcons (errstring
, data
)));
197 close_file_unwind (fd
)
200 close (XFASTINT (fd
));
203 /* Restore point, having saved it as a marker. */
205 restore_point_unwind (location
)
206 Lisp_Object location
;
208 SET_PT (marker_position (location
));
209 Fset_marker (location
, Qnil
, Qnil
);
212 Lisp_Object Qexpand_file_name
;
213 Lisp_Object Qsubstitute_in_file_name
;
214 Lisp_Object Qdirectory_file_name
;
215 Lisp_Object Qfile_name_directory
;
216 Lisp_Object Qfile_name_nondirectory
;
217 Lisp_Object Qunhandled_file_name_directory
;
218 Lisp_Object Qfile_name_as_directory
;
219 Lisp_Object Qcopy_file
;
220 Lisp_Object Qmake_directory_internal
;
221 Lisp_Object Qdelete_directory
;
222 Lisp_Object Qdelete_file
;
223 Lisp_Object Qrename_file
;
224 Lisp_Object Qadd_name_to_file
;
225 Lisp_Object Qmake_symbolic_link
;
226 Lisp_Object Qfile_exists_p
;
227 Lisp_Object Qfile_executable_p
;
228 Lisp_Object Qfile_readable_p
;
229 Lisp_Object Qfile_symlink_p
;
230 Lisp_Object Qfile_writable_p
;
231 Lisp_Object Qfile_directory_p
;
232 Lisp_Object Qfile_regular_p
;
233 Lisp_Object Qfile_accessible_directory_p
;
234 Lisp_Object Qfile_modes
;
235 Lisp_Object Qset_file_modes
;
236 Lisp_Object Qfile_newer_than_file_p
;
237 Lisp_Object Qinsert_file_contents
;
238 Lisp_Object Qwrite_region
;
239 Lisp_Object Qverify_visited_file_modtime
;
240 Lisp_Object Qset_visited_file_modtime
;
242 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
243 "Return FILENAME's handler function for OPERATION, if it has one.\n\
244 Otherwise, return nil.\n\
245 A file name is handled if one of the regular expressions in\n\
246 `file-name-handler-alist' matches it.\n\n\
247 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
248 any handlers that are members of `inhibit-file-name-handlers',\n\
249 but we still do run any other handlers. This lets handlers\n\
250 use the standard functions without calling themselves recursively.")
251 (filename
, operation
)
252 Lisp_Object filename
, operation
;
254 /* This function must not munge the match data. */
255 Lisp_Object chain
, inhibited_handlers
;
257 CHECK_STRING (filename
, 0);
259 if (EQ (operation
, Vinhibit_file_name_operation
))
260 inhibited_handlers
= Vinhibit_file_name_handlers
;
262 inhibited_handlers
= Qnil
;
264 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
265 chain
= XCONS (chain
)->cdr
)
268 elt
= XCONS (chain
)->car
;
272 string
= XCONS (elt
)->car
;
273 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
275 Lisp_Object handler
, tem
;
277 handler
= XCONS (elt
)->cdr
;
278 tem
= Fmemq (handler
, inhibited_handlers
);
289 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
291 "Return the directory component in file name FILENAME.\n\
292 Return nil if FILENAME does not include a directory.\n\
293 Otherwise return a directory spec.\n\
294 Given a Unix syntax file name, returns a string ending in slash;\n\
295 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
297 Lisp_Object filename
;
299 register unsigned char *beg
;
300 register unsigned char *p
;
303 CHECK_STRING (filename
, 0);
305 /* If the file name has special constructs in it,
306 call the corresponding file handler. */
307 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
309 return call2 (handler
, Qfile_name_directory
, filename
);
311 #ifdef FILE_SYSTEM_CASE
312 filename
= FILE_SYSTEM_CASE (filename
);
314 beg
= XSTRING (filename
)->data
;
315 p
= beg
+ XSTRING (filename
)->size
;
317 while (p
!= beg
&& !IS_ANY_SEP (p
[-1])
319 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
326 /* Expansion of "c:" to drive and default directory. */
327 /* (NT does the right thing.) */
328 if (p
== beg
+ 2 && beg
[1] == ':')
330 int drive
= (*beg
) - 'a';
331 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
332 unsigned char *res
= alloca (MAXPATHLEN
+ 5);
336 /* The NT version places the drive letter at the beginning already. */
337 #else /* not WINDOWSNT */
338 /* On MSDOG we must put the drive letter in by hand. */
340 #endif /* not WINDOWSNT */
341 if (getdefdir (drive
+ 1, res
))
344 res
[0] = drive
+ 'a';
347 if (IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
350 p
= beg
+ strlen (beg
);
354 return make_string (beg
, p
- beg
);
357 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
359 "Return file name FILENAME sans its directory.\n\
360 For example, in a Unix-syntax file name,\n\
361 this is everything after the last slash,\n\
362 or the entire name if it contains no slash.")
364 Lisp_Object filename
;
366 register unsigned char *beg
, *p
, *end
;
369 CHECK_STRING (filename
, 0);
371 /* If the file name has special constructs in it,
372 call the corresponding file handler. */
373 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
375 return call2 (handler
, Qfile_name_nondirectory
, filename
);
377 beg
= XSTRING (filename
)->data
;
378 end
= p
= beg
+ XSTRING (filename
)->size
;
380 while (p
!= beg
&& !IS_ANY_SEP (p
[-1])
382 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
386 return make_string (p
, end
- p
);
389 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
390 "Return a directly usable directory name somehow associated with FILENAME.\n\
391 A `directly usable' directory name is one that may be used without the\n\
392 intervention of any file handler.\n\
393 If FILENAME is a directly usable file itself, return\n\
394 (file-name-directory FILENAME).\n\
395 The `call-process' and `start-process' functions use this function to\n\
396 get a current directory to run processes in.")
398 Lisp_Object filename
;
402 /* If the file name has special constructs in it,
403 call the corresponding file handler. */
404 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
406 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
408 return Ffile_name_directory (filename
);
413 file_name_as_directory (out
, in
)
416 int size
= strlen (in
) - 1;
421 /* Is it already a directory string? */
422 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
424 /* Is it a VMS directory file name? If so, hack VMS syntax. */
425 else if (! index (in
, '/')
426 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
427 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
428 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
429 || ! strncmp (&in
[size
- 5], ".dir", 4))
430 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
431 && in
[size
] == '1')))
433 register char *p
, *dot
;
437 dir:x.dir --> dir:[x]
438 dir:[x]y.dir --> dir:[x.y] */
440 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
443 strncpy (out
, in
, p
- in
);
462 dot
= index (p
, '.');
465 /* blindly remove any extension */
466 size
= strlen (out
) + (dot
- p
);
467 strncat (out
, p
, dot
- p
);
478 /* For Unix syntax, Append a slash if necessary */
479 if (!IS_ANY_SEP (out
[size
]))
481 out
[size
+ 1] = DIRECTORY_SEP
;
482 out
[size
+ 2] = '\0';
488 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
489 Sfile_name_as_directory
, 1, 1, 0,
490 "Return a string representing file FILENAME interpreted as a directory.\n\
491 This operation exists because a directory is also a file, but its name as\n\
492 a directory is different from its name as a file.\n\
493 The result can be used as the value of `default-directory'\n\
494 or passed as second argument to `expand-file-name'.\n\
495 For a Unix-syntax file name, just appends a slash.\n\
496 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
503 CHECK_STRING (file
, 0);
507 /* If the file name has special constructs in it,
508 call the corresponding file handler. */
509 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
511 return call2 (handler
, Qfile_name_as_directory
, file
);
513 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
514 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
518 * Convert from directory name to filename.
520 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
521 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
522 * On UNIX, it's simple: just make sure there is a terminating /
524 * Value is nonzero if the string output is different from the input.
527 directory_file_name (src
, dst
)
535 struct FAB fab
= cc$rms_fab
;
536 struct NAM nam
= cc$rms_nam
;
537 char esa
[NAM$C_MAXRSS
];
542 if (! index (src
, '/')
543 && (src
[slen
- 1] == ']'
544 || src
[slen
- 1] == ':'
545 || src
[slen
- 1] == '>'))
547 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
549 fab
.fab$b_fns
= slen
;
550 fab
.fab$l_nam
= &nam
;
551 fab
.fab$l_fop
= FAB$M_NAM
;
554 nam
.nam$b_ess
= sizeof esa
;
555 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
557 /* We call SYS$PARSE to handle such things as [--] for us. */
558 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
560 slen
= nam
.nam$b_esl
;
561 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
566 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
568 /* what about when we have logical_name:???? */
569 if (src
[slen
- 1] == ':')
570 { /* Xlate logical name and see what we get */
571 ptr
= strcpy (dst
, src
); /* upper case for getenv */
574 if ('a' <= *ptr
&& *ptr
<= 'z')
578 dst
[slen
- 1] = 0; /* remove colon */
579 if (!(src
= egetenv (dst
)))
581 /* should we jump to the beginning of this procedure?
582 Good points: allows us to use logical names that xlate
584 Bad points: can be a problem if we just translated to a device
586 For now, I'll punt and always expect VMS names, and hope for
589 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
590 { /* no recursion here! */
596 { /* not a directory spec */
601 bracket
= src
[slen
- 1];
603 /* If bracket is ']' or '>', bracket - 2 is the corresponding
605 ptr
= index (src
, bracket
- 2);
607 { /* no opening bracket */
611 if (!(rptr
= rindex (src
, '.')))
614 strncpy (dst
, src
, slen
);
618 dst
[slen
++] = bracket
;
623 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
624 then translate the device and recurse. */
625 if (dst
[slen
- 1] == ':'
626 && dst
[slen
- 2] != ':' /* skip decnet nodes */
627 && strcmp(src
+ slen
, "[000000]") == 0)
629 dst
[slen
- 1] = '\0';
630 if ((ptr
= egetenv (dst
))
631 && (rlen
= strlen (ptr
) - 1) > 0
632 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
633 && ptr
[rlen
- 1] == '.')
635 char * buf
= (char *) alloca (strlen (ptr
) + 1);
639 return directory_file_name (buf
, dst
);
644 strcat (dst
, "[000000]");
648 rlen
= strlen (rptr
) - 1;
649 strncat (dst
, rptr
, rlen
);
650 dst
[slen
+ rlen
] = '\0';
651 strcat (dst
, ".DIR.1");
655 /* Process as Unix format: just remove any final slash.
656 But leave "/" unchanged; do not change it to "". */
659 /* Handle // as root for apollo's. */
660 if ((slen
> 2 && dst
[slen
- 1] == '/')
661 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
665 && IS_DIRECTORY_SEP (dst
[slen
- 1])
667 && !IS_ANY_SEP (dst
[slen
- 2])
675 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
677 "Returns the file name of the directory named DIRECTORY.\n\
678 This is the name of the file that holds the data for the directory DIRECTORY.\n\
679 This operation exists because a directory is also a file, but its name as\n\
680 a directory is different from its name as a file.\n\
681 In Unix-syntax, this function just removes the final slash.\n\
682 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
683 it returns a file name such as \"[X]Y.DIR.1\".")
685 Lisp_Object directory
;
690 CHECK_STRING (directory
, 0);
692 if (NILP (directory
))
695 /* If the file name has special constructs in it,
696 call the corresponding file handler. */
697 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
699 return call2 (handler
, Qdirectory_file_name
, directory
);
702 /* 20 extra chars is insufficient for VMS, since we might perform a
703 logical name translation. an equivalence string can be up to 255
704 chars long, so grab that much extra space... - sss */
705 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
707 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
709 directory_file_name (XSTRING (directory
)->data
, buf
);
710 return build_string (buf
);
713 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
714 "Generate temporary file name (string) starting with PREFIX (a string).\n\
715 The Emacs process number forms part of the result,\n\
716 so there is no danger of generating a name being used by another process.")
722 /* Don't use too many characters of the restricted 8+3 DOS
724 val
= concat2 (prefix
, build_string ("a.XXX"));
726 val
= concat2 (prefix
, build_string ("XXXXXX"));
728 mktemp (XSTRING (val
)->data
);
732 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
733 "Convert filename NAME to absolute, and canonicalize it.\n\
734 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
735 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
736 the current buffer's value of default-directory is used.\n\
737 Path components that are `.' are removed, and \n\
738 path components followed by `..' are removed, along with the `..' itself;\n\
739 note that these simplifications are done without checking the resulting\n\
740 paths in the file system.\n\
741 An initial `~/' expands to your home directory.\n\
742 An initial `~USER/' expands to USER's home directory.\n\
743 See also the function `substitute-in-file-name'.")
744 (name
, default_directory
)
745 Lisp_Object name
, default_directory
;
749 register unsigned char *newdir
, *p
, *o
;
751 unsigned char *target
;
754 unsigned char * colon
= 0;
755 unsigned char * close
= 0;
756 unsigned char * slash
= 0;
757 unsigned char * brack
= 0;
758 int lbrack
= 0, rbrack
= 0;
762 /* Demacs 1.1.2 91/10/20 Manabu Higashida */
765 unsigned char *tmp
, *defdir
;
769 CHECK_STRING (name
, 0);
771 /* If the file name has special constructs in it,
772 call the corresponding file handler. */
773 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
775 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
777 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
778 if (NILP (default_directory
))
779 default_directory
= current_buffer
->directory
;
780 CHECK_STRING (default_directory
, 1);
782 if (!NILP (default_directory
))
784 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
786 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
789 o
= XSTRING (default_directory
)->data
;
791 /* Make sure DEFAULT_DIRECTORY is properly expanded.
792 It would be better to do this down below where we actually use
793 default_directory. Unfortunately, calling Fexpand_file_name recursively
794 could invoke GC, and the strings might be relocated. This would
795 be annoying because we have pointers into strings lying around
796 that would need adjusting, and people would add new pointers to
797 the code and forget to adjust them, resulting in intermittent bugs.
798 Putting this call here avoids all that crud.
800 The EQ test avoids infinite recursion. */
801 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
802 /* Save time in some common cases. */
804 /* Detect MSDOS file names with device names. */
805 && ! (XSTRING (default_directory
)->size
>= 3
806 && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
808 /* Detect Unix absolute file names. */
809 && ! (XSTRING (default_directory
)->size
>= 2
810 && IS_DIRECTORY_SEP (o
[0])))
815 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
820 /* Filenames on VMS are always upper case. */
821 name
= Fupcase (name
);
823 #ifdef FILE_SYSTEM_CASE
824 name
= FILE_SYSTEM_CASE (name
);
827 nm
= XSTRING (name
)->data
;
830 /* First map all backslashes to slashes. */
831 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
835 /* Now strip drive name. */
837 unsigned char *colon
= rindex (nm
, ':');
845 if (!IS_DIRECTORY_SEP (*nm
))
847 defdir
= alloca (MAXPATHLEN
+ 1);
848 relpath
= getdefdir (tolower (drive
) - 'a' + 1, defdir
);
854 /* Handle // and /~ in middle of file name
855 by discarding everything through the first / of that sequence. */
859 /* Since we know the path is absolute, we can assume that each
860 element starts with a "/". */
862 /* "//" anywhere isn't necessarily hairy; we just start afresh
863 with the second slash. */
864 if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
865 #if defined (APOLLO) || defined (WINDOWSNT)
866 /* // at start of filename is meaningful on Apollo
867 and WindowsNT systems */
869 #endif /* APOLLO || WINDOWSNT */
873 /* "~" is hairy as the start of any path element. */
874 if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '~')
880 /* If nm is absolute, flush ...// and detect /./ and /../.
881 If no /./ or /../ we can return right away. */
883 IS_DIRECTORY_SEP (nm
[0])
889 /* If it turns out that the filename we want to return is just a
890 suffix of FILENAME, we don't need to go through and edit
891 things; we just need to construct a new string using data
892 starting at the middle of FILENAME. If we set lose to a
893 non-zero value, that means we've discovered that we can't do
900 /* Since we know the path is absolute, we can assume that each
901 element starts with a "/". */
903 /* "." and ".." are hairy. */
904 if (IS_DIRECTORY_SEP (p
[0])
906 && (IS_DIRECTORY_SEP (p
[2])
908 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
915 /* if dev:[dir]/, move nm to / */
916 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
917 nm
= (brack
? brack
+ 1 : colon
+ 1);
926 /* VMS pre V4.4,convert '-'s in filenames. */
927 if (lbrack
== rbrack
)
929 if (dots
< 2) /* this is to allow negative version numbers */
934 if (lbrack
> rbrack
&&
935 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
936 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
942 /* count open brackets, reset close bracket pointer */
943 if (p
[0] == '[' || p
[0] == '<')
945 /* count close brackets, set close bracket pointer */
946 if (p
[0] == ']' || p
[0] == '>')
948 /* detect ][ or >< */
949 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
951 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
952 nm
= p
+ 1, lose
= 1;
953 if (p
[0] == ':' && (colon
|| slash
))
954 /* if dev1:[dir]dev2:, move nm to dev2: */
960 /* if /pathname/dev:, move nm to dev: */
963 /* if node::dev:, move colon following dev */
964 else if (colon
&& colon
[-1] == ':')
966 /* if dev1:dev2:, move nm to dev2: */
967 else if (colon
&& colon
[-1] != ':')
972 if (p
[0] == ':' && !colon
)
978 if (lbrack
== rbrack
)
981 else if (p
[0] == '.')
990 return build_string (sys_translate_unix (nm
));
993 if (nm
== XSTRING (name
)->data
)
995 return build_string (nm
);
996 #endif /* not DOS_NT */
1000 /* Now determine directory to start with and put it in newdir */
1004 if (nm
[0] == '~') /* prefix ~ */
1006 if (IS_DIRECTORY_SEP (nm
[1])
1010 || nm
[1] == 0) /* ~ by itself */
1012 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1013 newdir
= (unsigned char *) "";
1015 /* Problem when expanding "~\" if HOME is not on current drive.
1016 Ulrich Leodolter, Wed Jan 11 10:20:35 1995 */
1017 if (newdir
[1] == ':')
1019 dostounix_filename (newdir
);
1023 nm
++; /* Don't leave the slash in nm. */
1026 else /* ~user/filename */
1028 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1033 o
= (unsigned char *) alloca (p
- nm
+ 1);
1034 bcopy ((char *) nm
, o
, p
- nm
);
1038 newdir
= (unsigned char *) egetenv ("HOME");
1039 dostounix_filename (newdir
);
1040 #else /* not WINDOWSNT */
1041 pw
= (struct passwd
*) getpwnam (o
+ 1);
1044 newdir
= (unsigned char *) pw
-> pw_dir
;
1046 nm
= p
+ 1; /* skip the terminator */
1051 #endif /* not WINDOWSNT */
1053 /* If we don't find a user of that name, leave the name
1054 unchanged; don't move nm forward to p. */
1058 if (!IS_ANY_SEP (nm
[0])
1061 #endif /* not VMS */
1067 newdir
= XSTRING (default_directory
)->data
;
1071 if (newdir
== 0 && relpath
)
1076 /* Get rid of any slash at the end of newdir. */
1077 int length
= strlen (newdir
);
1078 /* Adding `length > 1 &&' makes ~ expand into / when homedir
1079 is the root dir. People disagree about whether that is right.
1080 Anyway, we can't take the risk of this change now. */
1082 if (newdir
[1] != ':' && length
> 1)
1084 if (IS_DIRECTORY_SEP (newdir
[length
- 1]))
1086 unsigned char *temp
= (unsigned char *) alloca (length
);
1087 bcopy (newdir
, temp
, length
- 1);
1088 temp
[length
- 1] = 0;
1096 /* Now concatenate the directory and name to new space in the stack frame */
1097 tlen
+= strlen (nm
) + 1;
1099 /* Add reserved space for drive name. (The Microsoft x86 compiler
1100 produces incorrect code if the following two lines are combined.) */
1101 target
= (unsigned char *) alloca (tlen
+ 2);
1103 #else /* not DOS_NT */
1104 target
= (unsigned char *) alloca (tlen
);
1105 #endif /* not DOS_NT */
1111 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1112 strcpy (target
, newdir
);
1115 file_name_as_directory (target
, newdir
);
1118 strcat (target
, nm
);
1120 if (index (target
, '/'))
1121 strcpy (target
, sys_translate_unix (target
));
1124 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1132 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1138 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1139 /* brackets are offset from each other by 2 */
1142 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1143 /* convert [foo][bar] to [bar] */
1144 while (o
[-1] != '[' && o
[-1] != '<')
1146 else if (*p
== '-' && *o
!= '.')
1149 else if (p
[0] == '-' && o
[-1] == '.' &&
1150 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1151 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1155 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1156 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1158 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1160 /* else [foo.-] ==> [-] */
1166 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1167 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1173 if (!IS_DIRECTORY_SEP (*p
))
1177 else if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
1178 #if defined (APOLLO) || defined (WINDOWSNT)
1179 /* // at start of filename is meaningful in Apollo
1180 and WindowsNT systems */
1188 else if (IS_DIRECTORY_SEP (p
[0])
1190 && (IS_DIRECTORY_SEP (p
[2])
1193 /* If "/." is the entire filename, keep the "/". Otherwise,
1194 just delete the whole "/.". */
1195 if (o
== target
&& p
[2] == '\0')
1199 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1200 /* `/../' is the "superroot" on certain file systems. */
1202 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1204 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1206 #if defined (APOLLO) || defined (WINDOWSNT)
1208 && IS_DIRECTORY_SEP (o
[-1]) && IS_DIRECTORY_SEP (o
[0]))
1211 #endif /* APOLLO || WINDOWSNT */
1212 if (o
== target
&& IS_ANY_SEP (*o
))
1220 #endif /* not VMS */
1224 /* at last, set drive name. */
1225 if (target
[1] != ':'
1227 /* Allow network paths that look like "\\foo" */
1228 && !(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1]))
1229 #endif /* WINDOWSNT */
1233 target
[0] = (drive
< 0 ? getdisk () + 'A' : drive
);
1238 return make_string (target
, o
- target
);
1242 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1243 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1244 "Convert FILENAME to absolute, and canonicalize it.\n\
1245 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1246 (does not start with slash); if DEFAULT is nil or missing,\n\
1247 the current buffer's value of default-directory is used.\n\
1248 Filenames containing `.' or `..' as components are simplified;\n\
1249 initial `~/' expands to your home directory.\n\
1250 See also the function `substitute-in-file-name'.")
1252 Lisp_Object name
, defalt
;
1256 register unsigned char *newdir
, *p
, *o
;
1258 unsigned char *target
;
1262 unsigned char * colon
= 0;
1263 unsigned char * close
= 0;
1264 unsigned char * slash
= 0;
1265 unsigned char * brack
= 0;
1266 int lbrack
= 0, rbrack
= 0;
1270 CHECK_STRING (name
, 0);
1273 /* Filenames on VMS are always upper case. */
1274 name
= Fupcase (name
);
1277 nm
= XSTRING (name
)->data
;
1279 /* If nm is absolute, flush ...// and detect /./ and /../.
1280 If no /./ or /../ we can return right away. */
1292 if (p
[0] == '/' && p
[1] == '/'
1294 /* // at start of filename is meaningful on Apollo system */
1299 if (p
[0] == '/' && p
[1] == '~')
1300 nm
= p
+ 1, lose
= 1;
1301 if (p
[0] == '/' && p
[1] == '.'
1302 && (p
[2] == '/' || p
[2] == 0
1303 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1309 /* if dev:[dir]/, move nm to / */
1310 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1311 nm
= (brack
? brack
+ 1 : colon
+ 1);
1312 lbrack
= rbrack
= 0;
1320 /* VMS pre V4.4,convert '-'s in filenames. */
1321 if (lbrack
== rbrack
)
1323 if (dots
< 2) /* this is to allow negative version numbers */
1328 if (lbrack
> rbrack
&&
1329 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1330 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1336 /* count open brackets, reset close bracket pointer */
1337 if (p
[0] == '[' || p
[0] == '<')
1338 lbrack
++, brack
= 0;
1339 /* count close brackets, set close bracket pointer */
1340 if (p
[0] == ']' || p
[0] == '>')
1341 rbrack
++, brack
= p
;
1342 /* detect ][ or >< */
1343 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1345 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1346 nm
= p
+ 1, lose
= 1;
1347 if (p
[0] == ':' && (colon
|| slash
))
1348 /* if dev1:[dir]dev2:, move nm to dev2: */
1354 /* if /pathname/dev:, move nm to dev: */
1357 /* if node::dev:, move colon following dev */
1358 else if (colon
&& colon
[-1] == ':')
1360 /* if dev1:dev2:, move nm to dev2: */
1361 else if (colon
&& colon
[-1] != ':')
1366 if (p
[0] == ':' && !colon
)
1372 if (lbrack
== rbrack
)
1375 else if (p
[0] == '.')
1383 if (index (nm
, '/'))
1384 return build_string (sys_translate_unix (nm
));
1386 if (nm
== XSTRING (name
)->data
)
1388 return build_string (nm
);
1392 /* Now determine directory to start with and put it in NEWDIR */
1396 if (nm
[0] == '~') /* prefix ~ */
1401 || nm
[1] == 0)/* ~/filename */
1403 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1404 newdir
= (unsigned char *) "";
1407 nm
++; /* Don't leave the slash in nm. */
1410 else /* ~user/filename */
1412 /* Get past ~ to user */
1413 unsigned char *user
= nm
+ 1;
1414 /* Find end of name. */
1415 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1416 int len
= ptr
? ptr
- user
: strlen (user
);
1418 unsigned char *ptr1
= index (user
, ':');
1419 if (ptr1
!= 0 && ptr1
- user
< len
)
1422 /* Copy the user name into temp storage. */
1423 o
= (unsigned char *) alloca (len
+ 1);
1424 bcopy ((char *) user
, o
, len
);
1427 /* Look up the user name. */
1428 pw
= (struct passwd
*) getpwnam (o
+ 1);
1430 error ("\"%s\" isn't a registered user", o
+ 1);
1432 newdir
= (unsigned char *) pw
->pw_dir
;
1434 /* Discard the user name from NM. */
1441 #endif /* not VMS */
1445 defalt
= current_buffer
->directory
;
1446 CHECK_STRING (defalt
, 1);
1447 newdir
= XSTRING (defalt
)->data
;
1450 /* Now concatenate the directory and name to new space in the stack frame */
1452 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1453 target
= (unsigned char *) alloca (tlen
);
1459 if (nm
[0] == 0 || nm
[0] == '/')
1460 strcpy (target
, newdir
);
1463 file_name_as_directory (target
, newdir
);
1466 strcat (target
, nm
);
1468 if (index (target
, '/'))
1469 strcpy (target
, sys_translate_unix (target
));
1472 /* Now canonicalize by removing /. and /foo/.. if they appear */
1480 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1486 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1487 /* brackets are offset from each other by 2 */
1490 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1491 /* convert [foo][bar] to [bar] */
1492 while (o
[-1] != '[' && o
[-1] != '<')
1494 else if (*p
== '-' && *o
!= '.')
1497 else if (p
[0] == '-' && o
[-1] == '.' &&
1498 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1499 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1503 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1504 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1506 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1508 /* else [foo.-] ==> [-] */
1514 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1515 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1525 else if (!strncmp (p
, "//", 2)
1527 /* // at start of filename is meaningful in Apollo system */
1535 else if (p
[0] == '/' && p
[1] == '.' &&
1536 (p
[2] == '/' || p
[2] == 0))
1538 else if (!strncmp (p
, "/..", 3)
1539 /* `/../' is the "superroot" on certain file systems. */
1541 && (p
[3] == '/' || p
[3] == 0))
1543 while (o
!= target
&& *--o
!= '/')
1546 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1550 if (o
== target
&& *o
== '/')
1558 #endif /* not VMS */
1561 return make_string (target
, o
- target
);
1565 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1566 Ssubstitute_in_file_name
, 1, 1, 0,
1567 "Substitute environment variables referred to in FILENAME.\n\
1568 `$FOO' where FOO is an environment variable name means to substitute\n\
1569 the value of that variable. The variable name should be terminated\n\
1570 with a character not a letter, digit or underscore; otherwise, enclose\n\
1571 the entire variable name in braces.\n\
1572 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1573 On VMS, `$' substitution is not done; this function does little and only\n\
1574 duplicates what `expand-file-name' does.")
1576 Lisp_Object filename
;
1580 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1581 unsigned char *target
;
1583 int substituted
= 0;
1585 Lisp_Object handler
;
1587 CHECK_STRING (filename
, 0);
1589 /* If the file name has special constructs in it,
1590 call the corresponding file handler. */
1591 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1592 if (!NILP (handler
))
1593 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1595 nm
= XSTRING (filename
)->data
;
1597 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
1598 substituted
= !strcmp (nm
, XSTRING (filename
)->data
);
1600 endp
= nm
+ XSTRING (filename
)->size
;
1602 /* If /~ or // appears, discard everything through first slash. */
1604 for (p
= nm
; p
!= endp
; p
++)
1608 /* // at start of file name is meaningful in Apollo system */
1609 (p
[0] == '/' && p
- 1 != nm
)
1610 #else /* not APOLLO */
1612 (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1613 #else /* not WINDOWSNT */
1615 #endif /* not WINDOWSNT */
1616 #endif /* not APOLLO */
1621 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1623 || IS_DIRECTORY_SEP (p
[-1])))
1629 if (p
[0] && p
[1] == ':')
1638 return build_string (nm
);
1641 /* See if any variables are substituted into the string
1642 and find the total length of their values in `total' */
1644 for (p
= nm
; p
!= endp
;)
1654 /* "$$" means a single "$" */
1663 while (p
!= endp
&& *p
!= '}') p
++;
1664 if (*p
!= '}') goto missingclose
;
1670 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1674 /* Copy out the variable name */
1675 target
= (unsigned char *) alloca (s
- o
+ 1);
1676 strncpy (target
, o
, s
- o
);
1679 strupr (target
); /* $home == $HOME etc. */
1682 /* Get variable value */
1683 o
= (unsigned char *) egetenv (target
);
1684 if (!o
) goto badvar
;
1685 total
+= strlen (o
);
1692 /* If substitution required, recopy the string and do it */
1693 /* Make space in stack frame for the new copy */
1694 xnm
= (unsigned char *) alloca (XSTRING (filename
)->size
+ total
+ 1);
1697 /* Copy the rest of the name through, replacing $ constructs with values */
1714 while (p
!= endp
&& *p
!= '}') p
++;
1715 if (*p
!= '}') goto missingclose
;
1721 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1725 /* Copy out the variable name */
1726 target
= (unsigned char *) alloca (s
- o
+ 1);
1727 strncpy (target
, o
, s
- o
);
1730 strupr (target
); /* $home == $HOME etc. */
1733 /* Get variable value */
1734 o
= (unsigned char *) egetenv (target
);
1744 /* If /~ or // appears, discard everything through first slash. */
1746 for (p
= xnm
; p
!= x
; p
++)
1749 /* // at start of file name is meaningful in Apollo system */
1750 || (p
[0] == '/' && p
- 1 != xnm
)
1751 #else /* not APOLLO */
1753 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1754 #else /* not WINDOWSNT */
1756 #endif /* not WINDOWSNT */
1757 #endif /* not APOLLO */
1759 && p
!= nm
&& IS_DIRECTORY_SEP (p
[-1]))
1762 else if (p
[0] && p
[1] == ':')
1766 return make_string (xnm
, x
- xnm
);
1769 error ("Bad format environment-variable substitution");
1771 error ("Missing \"}\" in environment-variable substitution");
1773 error ("Substituting nonexistent environment variable \"%s\"", target
);
1776 #endif /* not VMS */
1779 /* A slightly faster and more convenient way to get
1780 (directory-file-name (expand-file-name FOO)). */
1783 expand_and_dir_to_file (filename
, defdir
)
1784 Lisp_Object filename
, defdir
;
1786 register Lisp_Object abspath
;
1788 abspath
= Fexpand_file_name (filename
, defdir
);
1791 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1792 if (c
== ':' || c
== ']' || c
== '>')
1793 abspath
= Fdirectory_file_name (abspath
);
1796 /* Remove final slash, if any (unless path is root).
1797 stat behaves differently depending! */
1798 if (XSTRING (abspath
)->size
> 1
1799 && IS_DIRECTORY_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1])
1800 && !IS_DEVICE_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
-2]))
1801 /* We cannot take shortcuts; they might be wrong for magic file names. */
1802 abspath
= Fdirectory_file_name (abspath
);
1807 /* Signal an error if the file ABSNAME already exists.
1808 If INTERACTIVE is nonzero, ask the user whether to proceed,
1809 and bypass the error if the user says to go ahead.
1810 QUERYSTRING is a name for the action that is being considered
1812 *STATPTR is used to store the stat information if the file exists.
1813 If the file does not exist, STATPTR->st_mode is set to 0. */
1816 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
1817 Lisp_Object absname
;
1818 unsigned char *querystring
;
1820 struct stat
*statptr
;
1822 register Lisp_Object tem
;
1823 struct stat statbuf
;
1824 struct gcpro gcpro1
;
1826 /* stat is a good way to tell whether the file exists,
1827 regardless of what access permissions it has. */
1828 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1831 Fsignal (Qfile_already_exists
,
1832 Fcons (build_string ("File already exists"),
1833 Fcons (absname
, Qnil
)));
1835 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1836 XSTRING (absname
)->data
, querystring
));
1839 Fsignal (Qfile_already_exists
,
1840 Fcons (build_string ("File already exists"),
1841 Fcons (absname
, Qnil
)));
1848 statptr
->st_mode
= 0;
1853 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1854 "fCopy file: \nFCopy %s to file: \np\nP",
1855 "Copy FILE to NEWNAME. Both args must be strings.\n\
1856 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1857 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1858 A number as third arg means request confirmation if NEWNAME already exists.\n\
1859 This is what happens in interactive use with M-x.\n\
1860 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1861 last-modified time as the old one. (This works on only some systems.)\n\
1862 A prefix arg makes KEEP-TIME non-nil.")
1863 (file
, newname
, ok_if_already_exists
, keep_date
)
1864 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
1867 char buf
[16 * 1024];
1868 struct stat st
, out_st
;
1869 Lisp_Object handler
;
1870 struct gcpro gcpro1
, gcpro2
;
1871 int count
= specpdl_ptr
- specpdl
;
1872 int input_file_statable_p
;
1874 GCPRO2 (file
, newname
);
1875 CHECK_STRING (file
, 0);
1876 CHECK_STRING (newname
, 1);
1877 file
= Fexpand_file_name (file
, Qnil
);
1878 newname
= Fexpand_file_name (newname
, Qnil
);
1880 /* If the input file name has special constructs in it,
1881 call the corresponding file handler. */
1882 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1883 /* Likewise for output file name. */
1885 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1886 if (!NILP (handler
))
1887 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
1888 ok_if_already_exists
, keep_date
));
1890 if (NILP (ok_if_already_exists
)
1891 || INTEGERP (ok_if_already_exists
))
1892 barf_or_query_if_file_exists (newname
, "copy to it",
1893 INTEGERP (ok_if_already_exists
), &out_st
);
1894 else if (stat (XSTRING (newname
)->data
, &out_st
) < 0)
1897 ifd
= open (XSTRING (file
)->data
, O_RDONLY
);
1899 report_file_error ("Opening input file", Fcons (file
, Qnil
));
1901 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1903 /* We can only copy regular files and symbolic links. Other files are not
1905 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1908 if (out_st
.st_mode
!= 0
1909 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
1912 report_file_error ("Input and output files are the same",
1913 Fcons (file
, Fcons (newname
, Qnil
)));
1917 #if defined (S_ISREG) && defined (S_ISLNK)
1918 if (input_file_statable_p
)
1920 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1922 #if defined (EISDIR)
1923 /* Get a better looking error message. */
1926 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
1929 #endif /* S_ISREG && S_ISLNK */
1932 /* Create the copy file with the same record format as the input file */
1933 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1936 /* System's default file type was set to binary by _fmode in emacs.c. */
1937 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1938 #else /* not MSDOS */
1939 ofd
= creat (XSTRING (newname
)->data
, 0666);
1940 #endif /* not MSDOS */
1943 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1945 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1949 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1950 if (write (ofd
, buf
, n
) != n
)
1951 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1954 /* Closing the output clobbers the file times on some systems. */
1955 if (close (ofd
) < 0)
1956 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1958 if (input_file_statable_p
)
1960 if (!NILP (keep_date
))
1962 EMACS_TIME atime
, mtime
;
1963 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1964 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1965 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
1966 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1969 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1971 #if defined (__DJGPP__) && __DJGPP__ > 1
1972 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
1973 and if it can't, it tells so. Otherwise, under MSDOS we usually
1974 get only the READ bit, which will make the copied file read-only,
1975 so it's better not to chmod at all. */
1976 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
1977 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1978 #endif /* DJGPP version 2 or newer */
1984 /* Discard the unwind protects. */
1985 specpdl_ptr
= specpdl
+ count
;
1991 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1992 Smake_directory_internal
, 1, 1, 0,
1993 "Create a new directory named DIRECTORY.")
1995 Lisp_Object directory
;
1998 Lisp_Object handler
;
2000 CHECK_STRING (directory
, 0);
2001 directory
= Fexpand_file_name (directory
, Qnil
);
2003 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2004 if (!NILP (handler
))
2005 return call2 (handler
, Qmake_directory_internal
, directory
);
2007 dir
= XSTRING (directory
)->data
;
2010 if (mkdir (dir
) != 0)
2012 if (mkdir (dir
, 0777) != 0)
2014 report_file_error ("Creating directory", Flist (1, &directory
));
2019 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2020 "Delete the directory named DIRECTORY.")
2022 Lisp_Object directory
;
2025 Lisp_Object handler
;
2027 CHECK_STRING (directory
, 0);
2028 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2029 dir
= XSTRING (directory
)->data
;
2031 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2032 if (!NILP (handler
))
2033 return call2 (handler
, Qdelete_directory
, directory
);
2035 if (rmdir (dir
) != 0)
2036 report_file_error ("Removing directory", Flist (1, &directory
));
2041 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2042 "Delete file named FILENAME.\n\
2043 If file has multiple names, it continues to exist with the other names.")
2045 Lisp_Object filename
;
2047 Lisp_Object handler
;
2048 CHECK_STRING (filename
, 0);
2049 filename
= Fexpand_file_name (filename
, Qnil
);
2051 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2052 if (!NILP (handler
))
2053 return call2 (handler
, Qdelete_file
, filename
);
2055 if (0 > unlink (XSTRING (filename
)->data
))
2056 report_file_error ("Removing old name", Flist (1, &filename
));
2061 internal_delete_file_1 (ignore
)
2067 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2070 internal_delete_file (filename
)
2071 Lisp_Object filename
;
2073 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2074 Qt
, internal_delete_file_1
));
2077 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2078 "fRename file: \nFRename %s to file: \np",
2079 "Rename FILE as NEWNAME. Both args strings.\n\
2080 If file has names other than FILE, it continues to have those names.\n\
2081 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2082 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2083 A number as third arg means request confirmation if NEWNAME already exists.\n\
2084 This is what happens in interactive use with M-x.")
2085 (file
, newname
, ok_if_already_exists
)
2086 Lisp_Object file
, newname
, ok_if_already_exists
;
2089 Lisp_Object args
[2];
2091 Lisp_Object handler
;
2092 struct gcpro gcpro1
, gcpro2
;
2094 GCPRO2 (file
, newname
);
2095 CHECK_STRING (file
, 0);
2096 CHECK_STRING (newname
, 1);
2097 file
= Fexpand_file_name (file
, Qnil
);
2098 newname
= Fexpand_file_name (newname
, Qnil
);
2100 /* If the file name has special constructs in it,
2101 call the corresponding file handler. */
2102 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2104 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2105 if (!NILP (handler
))
2106 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2107 file
, newname
, ok_if_already_exists
));
2109 if (NILP (ok_if_already_exists
)
2110 || INTEGERP (ok_if_already_exists
))
2111 barf_or_query_if_file_exists (newname
, "rename to it",
2112 INTEGERP (ok_if_already_exists
), 0);
2114 if (0 > rename (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2116 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
)
2117 || 0 > unlink (XSTRING (file
)->data
))
2122 Fcopy_file (file
, newname
,
2123 /* We have already prompted if it was an integer,
2124 so don't have copy-file prompt again. */
2125 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2126 Fdelete_file (file
);
2133 report_file_error ("Renaming", Flist (2, args
));
2136 report_file_error ("Renaming", Flist (2, &file
));
2143 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2144 "fAdd name to file: \nFName to add to %s: \np",
2145 "Give FILE additional name NEWNAME. Both args strings.\n\
2146 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2147 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2148 A number as third arg means request confirmation if NEWNAME already exists.\n\
2149 This is what happens in interactive use with M-x.")
2150 (file
, newname
, ok_if_already_exists
)
2151 Lisp_Object file
, newname
, ok_if_already_exists
;
2154 Lisp_Object args
[2];
2156 Lisp_Object handler
;
2157 struct gcpro gcpro1
, gcpro2
;
2159 GCPRO2 (file
, newname
);
2160 CHECK_STRING (file
, 0);
2161 CHECK_STRING (newname
, 1);
2162 file
= Fexpand_file_name (file
, Qnil
);
2163 newname
= Fexpand_file_name (newname
, Qnil
);
2165 /* If the file name has special constructs in it,
2166 call the corresponding file handler. */
2167 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2168 if (!NILP (handler
))
2169 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2170 newname
, ok_if_already_exists
));
2172 /* If the new name has special constructs in it,
2173 call the corresponding file handler. */
2174 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2175 if (!NILP (handler
))
2176 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2177 newname
, ok_if_already_exists
));
2179 if (NILP (ok_if_already_exists
)
2180 || INTEGERP (ok_if_already_exists
))
2181 barf_or_query_if_file_exists (newname
, "make it a new name",
2182 INTEGERP (ok_if_already_exists
), 0);
2184 /* Windows does not support this operation. */
2185 report_file_error ("Adding new name", Flist (2, &file
));
2186 #else /* not WINDOWSNT */
2188 unlink (XSTRING (newname
)->data
);
2189 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2194 report_file_error ("Adding new name", Flist (2, args
));
2196 report_file_error ("Adding new name", Flist (2, &file
));
2199 #endif /* not WINDOWSNT */
2206 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2207 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2208 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2209 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2210 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2211 A number as third arg means request confirmation if LINKNAME already exists.\n\
2212 This happens for interactive use with M-x.")
2213 (filename
, linkname
, ok_if_already_exists
)
2214 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2217 Lisp_Object args
[2];
2219 Lisp_Object handler
;
2220 struct gcpro gcpro1
, gcpro2
;
2222 GCPRO2 (filename
, linkname
);
2223 CHECK_STRING (filename
, 0);
2224 CHECK_STRING (linkname
, 1);
2225 /* If the link target has a ~, we must expand it to get
2226 a truly valid file name. Otherwise, do not expand;
2227 we want to permit links to relative file names. */
2228 if (XSTRING (filename
)->data
[0] == '~')
2229 filename
= Fexpand_file_name (filename
, Qnil
);
2230 linkname
= Fexpand_file_name (linkname
, Qnil
);
2232 /* If the file name has special constructs in it,
2233 call the corresponding file handler. */
2234 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2235 if (!NILP (handler
))
2236 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2237 linkname
, ok_if_already_exists
));
2239 /* If the new link name has special constructs in it,
2240 call the corresponding file handler. */
2241 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2242 if (!NILP (handler
))
2243 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2244 linkname
, ok_if_already_exists
));
2246 if (NILP (ok_if_already_exists
)
2247 || INTEGERP (ok_if_already_exists
))
2248 barf_or_query_if_file_exists (linkname
, "make it a link",
2249 INTEGERP (ok_if_already_exists
), 0);
2250 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2252 /* If we didn't complain already, silently delete existing file. */
2253 if (errno
== EEXIST
)
2255 unlink (XSTRING (linkname
)->data
);
2256 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2266 report_file_error ("Making symbolic link", Flist (2, args
));
2268 report_file_error ("Making symbolic link", Flist (2, &filename
));
2274 #endif /* S_IFLNK */
2278 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2279 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2280 "Define the job-wide logical name NAME to have the value STRING.\n\
2281 If STRING is nil or a null string, the logical name NAME is deleted.")
2286 CHECK_STRING (name
, 0);
2288 delete_logical_name (XSTRING (name
)->data
);
2291 CHECK_STRING (string
, 1);
2293 if (XSTRING (string
)->size
== 0)
2294 delete_logical_name (XSTRING (name
)->data
);
2296 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2305 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2306 "Open a network connection to PATH using LOGIN as the login string.")
2308 Lisp_Object path
, login
;
2312 CHECK_STRING (path
, 0);
2313 CHECK_STRING (login
, 0);
2315 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2317 if (netresult
== -1)
2322 #endif /* HPUX_NET */
2324 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2326 "Return t if file FILENAME specifies an absolute path name.\n\
2327 On Unix, this is a name starting with a `/' or a `~'.")
2329 Lisp_Object filename
;
2333 CHECK_STRING (filename
, 0);
2334 ptr
= XSTRING (filename
)->data
;
2335 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2337 /* ??? This criterion is probably wrong for '<'. */
2338 || index (ptr
, ':') || index (ptr
, '<')
2339 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2343 || (*ptr
!= 0 && ptr
[1] == ':' && (ptr
[2] == '/' || ptr
[2] == '\\'))
2351 /* Return nonzero if file FILENAME exists and can be executed. */
2354 check_executable (filename
)
2358 int len
= strlen (filename
);
2361 if (stat (filename
, &st
) < 0)
2363 return (S_ISREG (st
.st_mode
)
2365 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2366 || stricmp (suffix
, ".exe") == 0
2367 || stricmp (suffix
, ".bat") == 0)
2368 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2369 #else /* not DOS_NT */
2371 return (eaccess (filename
, 1) >= 0);
2373 /* Access isn't quite right because it uses the real uid
2374 and we really want to test with the effective uid.
2375 But Unix doesn't give us a right way to do it. */
2376 return (access (filename
, 1) >= 0);
2378 #endif /* not DOS_NT */
2381 /* Return nonzero if file FILENAME exists and can be written. */
2384 check_writable (filename
)
2389 if (stat (filename
, &st
) < 0)
2391 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2392 #else /* not MSDOS */
2394 return (eaccess (filename
, 2) >= 0);
2396 /* Access isn't quite right because it uses the real uid
2397 and we really want to test with the effective uid.
2398 But Unix doesn't give us a right way to do it.
2399 Opening with O_WRONLY could work for an ordinary file,
2400 but would lose for directories. */
2401 return (access (filename
, 2) >= 0);
2403 #endif /* not MSDOS */
2406 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2407 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2408 See also `file-readable-p' and `file-attributes'.")
2410 Lisp_Object filename
;
2412 Lisp_Object abspath
;
2413 Lisp_Object handler
;
2414 struct stat statbuf
;
2416 CHECK_STRING (filename
, 0);
2417 abspath
= Fexpand_file_name (filename
, Qnil
);
2419 /* If the file name has special constructs in it,
2420 call the corresponding file handler. */
2421 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2422 if (!NILP (handler
))
2423 return call2 (handler
, Qfile_exists_p
, abspath
);
2425 return (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2428 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2429 "Return t if FILENAME can be executed by you.\n\
2430 For a directory, this means you can access files in that directory.")
2432 Lisp_Object filename
;
2435 Lisp_Object abspath
;
2436 Lisp_Object handler
;
2438 CHECK_STRING (filename
, 0);
2439 abspath
= Fexpand_file_name (filename
, Qnil
);
2441 /* If the file name has special constructs in it,
2442 call the corresponding file handler. */
2443 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2444 if (!NILP (handler
))
2445 return call2 (handler
, Qfile_executable_p
, abspath
);
2447 return (check_executable (XSTRING (abspath
)->data
) ? Qt
: Qnil
);
2450 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2451 "Return t if file FILENAME exists and you can read it.\n\
2452 See also `file-exists-p' and `file-attributes'.")
2454 Lisp_Object filename
;
2456 Lisp_Object abspath
;
2457 Lisp_Object handler
;
2460 CHECK_STRING (filename
, 0);
2461 abspath
= Fexpand_file_name (filename
, Qnil
);
2463 /* If the file name has special constructs in it,
2464 call the corresponding file handler. */
2465 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2466 if (!NILP (handler
))
2467 return call2 (handler
, Qfile_readable_p
, abspath
);
2470 /* Under MS-DOS, open does not work't right, because it doesn't work for
2471 directories (MS-DOS won't let you open a directory). */
2472 if (access (XSTRING (abspath
)->data
, 0) == 0)
2475 #else /* not MSDOS */
2476 desc
= open (XSTRING (abspath
)->data
, O_RDONLY
);
2481 #endif /* not MSDOS */
2484 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2486 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2487 "Return t if file FILENAME can be written or created by you.")
2489 Lisp_Object filename
;
2491 Lisp_Object abspath
, dir
;
2492 Lisp_Object handler
;
2493 struct stat statbuf
;
2495 CHECK_STRING (filename
, 0);
2496 abspath
= Fexpand_file_name (filename
, Qnil
);
2498 /* If the file name has special constructs in it,
2499 call the corresponding file handler. */
2500 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2501 if (!NILP (handler
))
2502 return call2 (handler
, Qfile_writable_p
, abspath
);
2504 if (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0)
2505 return (check_writable (XSTRING (abspath
)->data
)
2507 dir
= Ffile_name_directory (abspath
);
2510 dir
= Fdirectory_file_name (dir
);
2514 dir
= Fdirectory_file_name (dir
);
2516 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2520 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2521 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2522 The value is the name of the file to which it is linked.\n\
2523 Otherwise returns nil.")
2525 Lisp_Object filename
;
2532 Lisp_Object handler
;
2534 CHECK_STRING (filename
, 0);
2535 filename
= Fexpand_file_name (filename
, Qnil
);
2537 /* If the file name has special constructs in it,
2538 call the corresponding file handler. */
2539 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2540 if (!NILP (handler
))
2541 return call2 (handler
, Qfile_symlink_p
, filename
);
2546 buf
= (char *) xmalloc (bufsize
);
2547 bzero (buf
, bufsize
);
2548 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2549 if (valsize
< bufsize
) break;
2550 /* Buffer was not long enough */
2559 val
= make_string (buf
, valsize
);
2562 #else /* not S_IFLNK */
2564 #endif /* not S_IFLNK */
2567 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2568 "Return t if file FILENAME is the name of a directory as a file.\n\
2569 A directory name spec may be given instead; then the value is t\n\
2570 if the directory so specified exists and really is a directory.")
2572 Lisp_Object filename
;
2574 register Lisp_Object abspath
;
2576 Lisp_Object handler
;
2578 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2580 /* If the file name has special constructs in it,
2581 call the corresponding file handler. */
2582 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2583 if (!NILP (handler
))
2584 return call2 (handler
, Qfile_directory_p
, abspath
);
2586 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2588 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2591 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2592 "Return t if file FILENAME is the name of a directory as a file,\n\
2593 and files in that directory can be opened by you. In order to use a\n\
2594 directory as a buffer's current directory, this predicate must return true.\n\
2595 A directory name spec may be given instead; then the value is t\n\
2596 if the directory so specified exists and really is a readable and\n\
2597 searchable directory.")
2599 Lisp_Object filename
;
2601 Lisp_Object handler
;
2603 struct gcpro gcpro1
;
2605 /* If the file name has special constructs in it,
2606 call the corresponding file handler. */
2607 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2608 if (!NILP (handler
))
2609 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2611 /* It's an unlikely combination, but yes we really do need to gcpro:
2612 Suppose that file-accessible-directory-p has no handler, but
2613 file-directory-p does have a handler; this handler causes a GC which
2614 relocates the string in `filename'; and finally file-directory-p
2615 returns non-nil. Then we would end up passing a garbaged string
2616 to file-executable-p. */
2618 tem
= (NILP (Ffile_directory_p (filename
))
2619 || NILP (Ffile_executable_p (filename
)));
2621 return tem
? Qnil
: Qt
;
2624 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2625 "Return t if file FILENAME is the name of a regular file.\n\
2626 This is the sort of file that holds an ordinary stream of data bytes.")
2628 Lisp_Object filename
;
2630 register Lisp_Object abspath
;
2632 Lisp_Object handler
;
2634 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2636 /* If the file name has special constructs in it,
2637 call the corresponding file handler. */
2638 handler
= Ffind_file_name_handler (abspath
, Qfile_regular_p
);
2639 if (!NILP (handler
))
2640 return call2 (handler
, Qfile_regular_p
, abspath
);
2642 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2644 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2647 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2648 "Return mode bits of file named FILENAME, as an integer.")
2650 Lisp_Object filename
;
2652 Lisp_Object abspath
;
2654 Lisp_Object handler
;
2656 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2658 /* If the file name has special constructs in it,
2659 call the corresponding file handler. */
2660 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2661 if (!NILP (handler
))
2662 return call2 (handler
, Qfile_modes
, abspath
);
2664 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2667 if (check_executable (XSTRING (abspath
)->data
))
2668 st
.st_mode
|= S_IEXEC
;
2671 return make_number (st
.st_mode
& 07777);
2674 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2675 "Set mode bits of file named FILENAME to MODE (an integer).\n\
2676 Only the 12 low bits of MODE are used.")
2678 Lisp_Object filename
, mode
;
2680 Lisp_Object abspath
;
2681 Lisp_Object handler
;
2683 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2684 CHECK_NUMBER (mode
, 1);
2686 /* If the file name has special constructs in it,
2687 call the corresponding file handler. */
2688 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2689 if (!NILP (handler
))
2690 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2692 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2693 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2698 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2699 "Set the file permission bits for newly created files.\n\
2700 The argument MODE should be an integer; only the low 9 bits are used.\n\
2701 This setting is inherited by subprocesses.")
2705 CHECK_NUMBER (mode
, 0);
2707 umask ((~ XINT (mode
)) & 0777);
2712 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2713 "Return the default file protection for created files.\n\
2714 The value is an integer.")
2720 realmask
= umask (0);
2723 XSETINT (value
, (~ realmask
) & 0777);
2729 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2730 "Tell Unix to finish all pending disk updates.")
2739 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2740 "Return t if file FILE1 is newer than file FILE2.\n\
2741 If FILE1 does not exist, the answer is nil;\n\
2742 otherwise, if FILE2 does not exist, the answer is t.")
2744 Lisp_Object file1
, file2
;
2746 Lisp_Object abspath1
, abspath2
;
2749 Lisp_Object handler
;
2750 struct gcpro gcpro1
, gcpro2
;
2752 CHECK_STRING (file1
, 0);
2753 CHECK_STRING (file2
, 0);
2756 GCPRO2 (abspath1
, file2
);
2757 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2758 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2761 /* If the file name has special constructs in it,
2762 call the corresponding file handler. */
2763 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2765 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2766 if (!NILP (handler
))
2767 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2769 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2772 mtime1
= st
.st_mtime
;
2774 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2777 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2781 Lisp_Object Qfind_buffer_file_type
;
2784 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2786 "Insert contents of file FILENAME after point.\n\
2787 Returns list of absolute file name and length of data inserted.\n\
2788 If second argument VISIT is non-nil, the buffer's visited filename\n\
2789 and last save file modtime are set, and it is marked unmodified.\n\
2790 If visiting and the file does not exist, visiting is completed\n\
2791 before the error is signaled.\n\n\
2792 The optional third and fourth arguments BEG and END\n\
2793 specify what portion of the file to insert.\n\
2794 If VISIT is non-nil, BEG and END must be nil.\n\
2795 If optional fifth argument REPLACE is non-nil,\n\
2796 it means replace the current buffer contents (in the accessible portion)\n\
2797 with the file contents. This is better than simply deleting and inserting\n\
2798 the whole thing because (1) it preserves some marker positions\n\
2799 and (2) it puts less data in the undo list.")
2800 (filename
, visit
, beg
, end
, replace
)
2801 Lisp_Object filename
, visit
, beg
, end
, replace
;
2805 register int inserted
= 0;
2806 register int how_much
;
2807 int count
= specpdl_ptr
- specpdl
;
2808 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2809 Lisp_Object handler
, val
, insval
;
2812 int not_regular
= 0;
2814 if (current_buffer
->base_buffer
&& ! NILP (visit
))
2815 error ("Cannot do file visiting in an indirect buffer");
2817 if (!NILP (current_buffer
->read_only
))
2818 Fbarf_if_buffer_read_only ();
2823 GCPRO3 (filename
, val
, p
);
2825 CHECK_STRING (filename
, 0);
2826 filename
= Fexpand_file_name (filename
, Qnil
);
2828 /* If the file name has special constructs in it,
2829 call the corresponding file handler. */
2830 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2831 if (!NILP (handler
))
2833 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2834 visit
, beg
, end
, replace
);
2841 if (stat (XSTRING (filename
)->data
, &st
) < 0)
2843 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
2844 || fstat (fd
, &st
) < 0)
2845 #endif /* not APOLLO */
2847 if (fd
>= 0) close (fd
);
2850 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2857 /* This code will need to be changed in order to work on named
2858 pipes, and it's probably just not worth it. So we should at
2859 least signal an error. */
2860 if (!S_ISREG (st
.st_mode
))
2863 Fsignal (Qfile_error
,
2864 Fcons (build_string ("not a regular file"),
2865 Fcons (filename
, Qnil
)));
2873 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
2876 /* Replacement should preserve point as it preserves markers. */
2877 if (!NILP (replace
))
2878 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2880 record_unwind_protect (close_file_unwind
, make_number (fd
));
2882 /* Supposedly happens on VMS. */
2884 error ("File size is negative");
2886 if (!NILP (beg
) || !NILP (end
))
2888 error ("Attempt to visit less than an entire file");
2891 CHECK_NUMBER (beg
, 0);
2893 XSETFASTINT (beg
, 0);
2896 CHECK_NUMBER (end
, 0);
2899 XSETINT (end
, st
.st_size
);
2900 if (XINT (end
) != st
.st_size
)
2901 error ("maximum buffer size exceeded");
2904 /* If requested, replace the accessible part of the buffer
2905 with the file contents. Avoid replacing text at the
2906 beginning or end of the buffer that matches the file contents;
2907 that preserves markers pointing to the unchanged parts. */
2909 /* On MSDOS, replace mode doesn't really work, except for binary files,
2910 and it's not worth supporting just for them. */
2911 if (!NILP (replace
))
2914 XSETFASTINT (beg
, 0);
2915 XSETFASTINT (end
, st
.st_size
);
2916 del_range_1 (BEGV
, ZV
, 0);
2918 #else /* not DOS_NT */
2919 if (!NILP (replace
))
2921 unsigned char buffer
[1 << 14];
2922 int same_at_start
= BEGV
;
2923 int same_at_end
= ZV
;
2928 /* Count how many chars at the start of the file
2929 match the text at the beginning of the buffer. */
2934 nread
= read (fd
, buffer
, sizeof buffer
);
2936 error ("IO error reading %s: %s",
2937 XSTRING (filename
)->data
, strerror (errno
));
2938 else if (nread
== 0)
2941 while (bufpos
< nread
&& same_at_start
< ZV
2942 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2943 same_at_start
++, bufpos
++;
2944 /* If we found a discrepancy, stop the scan.
2945 Otherwise loop around and scan the next bufferful. */
2946 if (bufpos
!= nread
)
2950 /* If the file matches the buffer completely,
2951 there's no need to replace anything. */
2952 if (same_at_start
- BEGV
== st
.st_size
)
2956 /* Truncate the buffer to the size of the file. */
2957 del_range_1 (same_at_start
, same_at_end
, 0);
2962 /* Count how many chars at the end of the file
2963 match the text at the end of the buffer. */
2966 int total_read
, nread
, bufpos
, curpos
, trial
;
2968 /* At what file position are we now scanning? */
2969 curpos
= st
.st_size
- (ZV
- same_at_end
);
2970 /* If the entire file matches the buffer tail, stop the scan. */
2973 /* How much can we scan in the next step? */
2974 trial
= min (curpos
, sizeof buffer
);
2975 if (lseek (fd
, curpos
- trial
, 0) < 0)
2976 report_file_error ("Setting file position",
2977 Fcons (filename
, Qnil
));
2980 while (total_read
< trial
)
2982 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2984 error ("IO error reading %s: %s",
2985 XSTRING (filename
)->data
, strerror (errno
));
2986 total_read
+= nread
;
2988 /* Scan this bufferful from the end, comparing with
2989 the Emacs buffer. */
2990 bufpos
= total_read
;
2991 /* Compare with same_at_start to avoid counting some buffer text
2992 as matching both at the file's beginning and at the end. */
2993 while (bufpos
> 0 && same_at_end
> same_at_start
2994 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2995 same_at_end
--, bufpos
--;
2996 /* If we found a discrepancy, stop the scan.
2997 Otherwise loop around and scan the preceding bufferful. */
3000 /* If display current starts at beginning of line,
3001 keep it that way. */
3002 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3003 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3007 /* Don't try to reuse the same piece of text twice. */
3008 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3010 same_at_end
+= overlap
;
3012 /* Arrange to read only the nonmatching middle part of the file. */
3013 XSETFASTINT (beg
, same_at_start
- BEGV
);
3014 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
3016 del_range_1 (same_at_start
, same_at_end
, 0);
3017 /* Insert from the file at the proper position. */
3018 SET_PT (same_at_start
);
3020 #endif /* not DOS_NT */
3022 total
= XINT (end
) - XINT (beg
);
3025 register Lisp_Object temp
;
3027 /* Make sure point-max won't overflow after this insertion. */
3028 XSETINT (temp
, total
);
3029 if (total
!= XINT (temp
))
3030 error ("maximum buffer size exceeded");
3033 if (NILP (visit
) && total
> 0)
3034 prepare_to_modify_buffer (point
, point
);
3037 if (GAP_SIZE
< total
)
3038 make_gap (total
- GAP_SIZE
);
3040 if (XINT (beg
) != 0 || !NILP (replace
))
3042 if (lseek (fd
, XINT (beg
), 0) < 0)
3043 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3047 while (inserted
< total
)
3049 /* try is reserved in some compilers (Microsoft C) */
3050 int trytry
= min (total
- inserted
, 64 << 10);
3053 /* Allow quitting out of the actual I/O. */
3056 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, trytry
);
3073 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3074 /* Determine file type from name and remove LFs from CR-LFs if the file
3075 is deemed to be a text file. */
3077 current_buffer
->buffer_file_type
3078 = call1 (Qfind_buffer_file_type
, filename
);
3079 if (NILP (current_buffer
->buffer_file_type
))
3082 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
3085 GPT
-= reduced_size
;
3086 GAP_SIZE
+= reduced_size
;
3087 inserted
-= reduced_size
;
3094 record_insert (point
, inserted
);
3096 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3097 offset_intervals (current_buffer
, point
, inserted
);
3103 /* Discard the unwind protect for closing the file. */
3107 error ("IO error reading %s: %s",
3108 XSTRING (filename
)->data
, strerror (errno
));
3115 if (!EQ (current_buffer
->undo_list
, Qt
))
3116 current_buffer
->undo_list
= Qnil
;
3118 stat (XSTRING (filename
)->data
, &st
);
3123 current_buffer
->modtime
= st
.st_mtime
;
3124 current_buffer
->filename
= filename
;
3127 SAVE_MODIFF
= MODIFF
;
3128 current_buffer
->auto_save_modified
= MODIFF
;
3129 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3130 #ifdef CLASH_DETECTION
3133 if (!NILP (current_buffer
->file_truename
))
3134 unlock_file (current_buffer
->file_truename
);
3135 unlock_file (filename
);
3137 #endif /* CLASH_DETECTION */
3139 Fsignal (Qfile_error
,
3140 Fcons (build_string ("not a regular file"),
3141 Fcons (filename
, Qnil
)));
3143 /* If visiting nonexistent file, return nil. */
3144 if (current_buffer
->modtime
== -1)
3145 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3148 /* Decode file format */
3151 insval
= call3 (Qformat_decode
,
3152 Qnil
, make_number (inserted
), visit
);
3153 CHECK_NUMBER (insval
, 0);
3154 inserted
= XFASTINT (insval
);
3157 if (inserted
> 0 && NILP (visit
) && total
> 0)
3158 signal_after_change (point
, 0, inserted
);
3162 p
= Vafter_insert_file_functions
;
3165 insval
= call1 (Fcar (p
), make_number (inserted
));
3168 CHECK_NUMBER (insval
, 0);
3169 inserted
= XFASTINT (insval
);
3177 val
= Fcons (filename
,
3178 Fcons (make_number (inserted
),
3181 RETURN_UNGCPRO (unbind_to (count
, val
));
3184 static Lisp_Object
build_annotations ();
3186 /* If build_annotations switched buffers, switch back to BUF.
3187 Kill the temporary buffer that was selected in the meantime. */
3190 build_annotations_unwind (buf
)
3195 if (XBUFFER (buf
) == current_buffer
)
3197 tembuf
= Fcurrent_buffer ();
3199 Fkill_buffer (tembuf
);
3203 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3204 "r\nFWrite region to file: ",
3205 "Write current region into specified file.\n\
3206 When called from a program, takes three arguments:\n\
3207 START, END and FILENAME. START and END are buffer positions.\n\
3208 Optional fourth argument APPEND if non-nil means\n\
3209 append to existing file contents (if any).\n\
3210 Optional fifth argument VISIT if t means\n\
3211 set the last-save-file-modtime of buffer to this file's modtime\n\
3212 and mark buffer not modified.\n\
3213 If VISIT is a string, it is a second file name;\n\
3214 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3215 VISIT is also the file name to lock and unlock for clash detection.\n\
3216 If VISIT is neither t nor nil nor a string,\n\
3217 that means do not print the \"Wrote file\" message.\n\
3218 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3219 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3220 Kludgy feature: if START is a string, then that string is written\n\
3221 to the file, instead of any buffer contents, and END is ignored.")
3222 (start
, end
, filename
, append
, visit
, lockname
)
3223 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3231 int count
= specpdl_ptr
- specpdl
;
3234 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3236 Lisp_Object handler
;
3237 Lisp_Object visit_file
;
3238 Lisp_Object annotations
;
3239 int visiting
, quietly
;
3240 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3241 struct buffer
*given_buffer
;
3243 int buffer_file_type
3244 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3247 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3248 error ("Cannot do file visiting in an indirect buffer");
3250 if (!NILP (start
) && !STRINGP (start
))
3251 validate_region (&start
, &end
);
3253 GCPRO3 (filename
, visit
, lockname
);
3254 filename
= Fexpand_file_name (filename
, Qnil
);
3255 if (STRINGP (visit
))
3256 visit_file
= Fexpand_file_name (visit
, Qnil
);
3258 visit_file
= filename
;
3261 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3262 quietly
= !NILP (visit
);
3266 if (NILP (lockname
))
3267 lockname
= visit_file
;
3269 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3271 /* If the file name has special constructs in it,
3272 call the corresponding file handler. */
3273 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3274 /* If FILENAME has no handler, see if VISIT has one. */
3275 if (NILP (handler
) && STRINGP (visit
))
3276 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3278 if (!NILP (handler
))
3281 val
= call6 (handler
, Qwrite_region
, start
, end
,
3282 filename
, append
, visit
);
3286 SAVE_MODIFF
= MODIFF
;
3287 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3288 current_buffer
->filename
= visit_file
;
3294 /* Special kludge to simplify auto-saving. */
3297 XSETFASTINT (start
, BEG
);
3298 XSETFASTINT (end
, Z
);
3301 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3302 count1
= specpdl_ptr
- specpdl
;
3304 given_buffer
= current_buffer
;
3305 annotations
= build_annotations (start
, end
);
3306 if (current_buffer
!= given_buffer
)
3312 #ifdef CLASH_DETECTION
3314 lock_file (lockname
);
3315 #endif /* CLASH_DETECTION */
3317 fn
= XSTRING (filename
)->data
;
3321 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3322 #else /* not DOS_NT */
3323 desc
= open (fn
, O_WRONLY
);
3324 #endif /* not DOS_NT */
3328 if (auto_saving
) /* Overwrite any previous version of autosave file */
3330 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3331 desc
= open (fn
, O_RDWR
);
3333 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3334 ? XSTRING (current_buffer
->filename
)->data
: 0,
3337 else /* Write to temporary name and rename if no errors */
3339 Lisp_Object temp_name
;
3340 temp_name
= Ffile_name_directory (filename
);
3342 if (!NILP (temp_name
))
3344 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3345 build_string ("$$SAVE$$")));
3346 fname
= XSTRING (filename
)->data
;
3347 fn
= XSTRING (temp_name
)->data
;
3348 desc
= creat_copy_attrs (fname
, fn
);
3351 /* If we can't open the temporary file, try creating a new
3352 version of the original file. VMS "creat" creates a
3353 new version rather than truncating an existing file. */
3356 desc
= creat (fn
, 0666);
3357 #if 0 /* This can clobber an existing file and fail to replace it,
3358 if the user runs out of space. */
3361 /* We can't make a new version;
3362 try to truncate and rewrite existing version if any. */
3364 desc
= open (fn
, O_RDWR
);
3370 desc
= creat (fn
, 0666);
3375 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3376 S_IREAD
| S_IWRITE
);
3377 #else /* not DOS_NT */
3378 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3379 #endif /* not DOS_NT */
3380 #endif /* not VMS */
3386 #ifdef CLASH_DETECTION
3388 if (!auto_saving
) unlock_file (lockname
);
3390 #endif /* CLASH_DETECTION */
3391 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3394 record_unwind_protect (close_file_unwind
, make_number (desc
));
3397 if (lseek (desc
, 0, 2) < 0)
3399 #ifdef CLASH_DETECTION
3400 if (!auto_saving
) unlock_file (lockname
);
3401 #endif /* CLASH_DETECTION */
3402 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3407 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3408 * if we do writes that don't end with a carriage return. Furthermore
3409 * it cannot handle writes of more then 16K. The modified
3410 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3411 * this EXCEPT for the last record (iff it doesn't end with a carriage
3412 * return). This implies that if your buffer doesn't end with a carriage
3413 * return, you get one free... tough. However it also means that if
3414 * we make two calls to sys_write (a la the following code) you can
3415 * get one at the gap as well. The easiest way to fix this (honest)
3416 * is to move the gap to the next newline (or the end of the buffer).
3421 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3422 move_gap (find_next_newline (GPT
, 1));
3428 if (STRINGP (start
))
3430 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3431 XSTRING (start
)->size
, 0, &annotations
);
3434 else if (XINT (start
) != XINT (end
))
3437 if (XINT (start
) < GPT
)
3439 register int end1
= XINT (end
);
3441 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3442 min (GPT
, end1
) - tem
, tem
, &annotations
);
3443 nwritten
+= min (GPT
, end1
) - tem
;
3447 if (XINT (end
) > GPT
&& !failure
)
3450 tem
= max (tem
, GPT
);
3451 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3453 nwritten
+= XINT (end
) - tem
;
3459 /* If file was empty, still need to write the annotations */
3460 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3467 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3468 Disk full in NFS may be reported here. */
3469 /* mib says that closing the file will try to write as fast as NFS can do
3470 it, and that means the fsync here is not crucial for autosave files. */
3471 if (!auto_saving
&& fsync (desc
) < 0)
3473 /* If fsync fails with EINTR, don't treat that as serious. */
3475 failure
= 1, save_errno
= errno
;
3479 /* Spurious "file has changed on disk" warnings have been
3480 observed on Suns as well.
3481 It seems that `close' can change the modtime, under nfs.
3483 (This has supposedly been fixed in Sunos 4,
3484 but who knows about all the other machines with NFS?) */
3487 /* On VMS and APOLLO, must do the stat after the close
3488 since closing changes the modtime. */
3491 /* Recall that #if defined does not work on VMS. */
3498 /* NFS can report a write failure now. */
3499 if (close (desc
) < 0)
3500 failure
= 1, save_errno
= errno
;
3503 /* If we wrote to a temporary name and had no errors, rename to real name. */
3507 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3515 /* Discard the unwind protect for close_file_unwind. */
3516 specpdl_ptr
= specpdl
+ count1
;
3517 /* Restore the original current buffer. */
3518 visit_file
= unbind_to (count
, visit_file
);
3520 #ifdef CLASH_DETECTION
3522 unlock_file (lockname
);
3523 #endif /* CLASH_DETECTION */
3525 /* Do this before reporting IO error
3526 to avoid a "file has changed on disk" warning on
3527 next attempt to save. */
3529 current_buffer
->modtime
= st
.st_mtime
;
3532 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3536 SAVE_MODIFF
= MODIFF
;
3537 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3538 current_buffer
->filename
= visit_file
;
3539 update_mode_lines
++;
3545 message ("Wrote %s", XSTRING (visit_file
)->data
);
3550 Lisp_Object
merge ();
3552 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3553 "Return t if (car A) is numerically less than (car B).")
3557 return Flss (Fcar (a
), Fcar (b
));
3560 /* Build the complete list of annotations appropriate for writing out
3561 the text between START and END, by calling all the functions in
3562 write-region-annotate-functions and merging the lists they return.
3563 If one of these functions switches to a different buffer, we assume
3564 that buffer contains altered text. Therefore, the caller must
3565 make sure to restore the current buffer in all cases,
3566 as save-excursion would do. */
3569 build_annotations (start
, end
)
3570 Lisp_Object start
, end
;
3572 Lisp_Object annotations
;
3574 struct gcpro gcpro1
, gcpro2
;
3577 p
= Vwrite_region_annotate_functions
;
3578 GCPRO2 (annotations
, p
);
3581 struct buffer
*given_buffer
= current_buffer
;
3582 Vwrite_region_annotations_so_far
= annotations
;
3583 res
= call2 (Fcar (p
), start
, end
);
3584 /* If the function makes a different buffer current,
3585 assume that means this buffer contains altered text to be output.
3586 Reset START and END from the buffer bounds
3587 and discard all previous annotations because they should have
3588 been dealt with by this function. */
3589 if (current_buffer
!= given_buffer
)
3595 Flength (res
); /* Check basic validity of return value */
3596 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3600 /* Now do the same for annotation functions implied by the file-format */
3601 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
3602 p
= Vauto_save_file_format
;
3604 p
= current_buffer
->file_format
;
3607 struct buffer
*given_buffer
= current_buffer
;
3608 Vwrite_region_annotations_so_far
= annotations
;
3609 res
= call3 (Qformat_annotate_function
, Fcar (p
), start
, end
);
3610 if (current_buffer
!= given_buffer
)
3617 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3624 /* Write to descriptor DESC the LEN characters starting at ADDR,
3625 assuming they start at position POS in the buffer.
3626 Intersperse with them the annotations from *ANNOT
3627 (those which fall within the range of positions POS to POS + LEN),
3628 each at its appropriate position.
3630 Modify *ANNOT by discarding elements as we output them.
3631 The return value is negative in case of system call failure. */
3634 a_write (desc
, addr
, len
, pos
, annot
)
3636 register char *addr
;
3643 int lastpos
= pos
+ len
;
3645 while (NILP (*annot
) || CONSP (*annot
))
3647 tem
= Fcar_safe (Fcar (*annot
));
3648 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3649 nextpos
= XFASTINT (tem
);
3651 return e_write (desc
, addr
, lastpos
- pos
);
3654 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3656 addr
+= nextpos
- pos
;
3659 tem
= Fcdr (Fcar (*annot
));
3662 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3665 *annot
= Fcdr (*annot
);
3670 e_write (desc
, addr
, len
)
3672 register char *addr
;
3675 char buf
[16 * 1024];
3676 register char *p
, *end
;
3678 if (!EQ (current_buffer
->selective_display
, Qt
))
3679 return write (desc
, addr
, len
) - len
;
3683 end
= p
+ sizeof buf
;
3688 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3697 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3703 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3704 Sverify_visited_file_modtime
, 1, 1, 0,
3705 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3706 This means that the file has not been changed since it was visited or saved.")
3712 Lisp_Object handler
;
3714 CHECK_BUFFER (buf
, 0);
3717 if (!STRINGP (b
->filename
)) return Qt
;
3718 if (b
->modtime
== 0) return Qt
;
3720 /* If the file name has special constructs in it,
3721 call the corresponding file handler. */
3722 handler
= Ffind_file_name_handler (b
->filename
,
3723 Qverify_visited_file_modtime
);
3724 if (!NILP (handler
))
3725 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3727 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3729 /* If the file doesn't exist now and didn't exist before,
3730 we say that it isn't modified, provided the error is a tame one. */
3731 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3736 if (st
.st_mtime
== b
->modtime
3737 /* If both are positive, accept them if they are off by one second. */
3738 || (st
.st_mtime
> 0 && b
->modtime
> 0
3739 && (st
.st_mtime
== b
->modtime
+ 1
3740 || st
.st_mtime
== b
->modtime
- 1)))
3745 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3746 Sclear_visited_file_modtime
, 0, 0, 0,
3747 "Clear out records of last mod time of visited file.\n\
3748 Next attempt to save will certainly not complain of a discrepancy.")
3751 current_buffer
->modtime
= 0;
3755 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3756 Svisited_file_modtime
, 0, 0, 0,
3757 "Return the current buffer's recorded visited file modification time.\n\
3758 The value is a list of the form (HIGH . LOW), like the time values\n\
3759 that `file-attributes' returns.")
3762 return long_to_cons ((unsigned long) current_buffer
->modtime
);
3765 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3766 Sset_visited_file_modtime
, 0, 1, 0,
3767 "Update buffer's recorded modification time from the visited file's time.\n\
3768 Useful if the buffer was not read from the file normally\n\
3769 or if the file itself has been changed for some known benign reason.\n\
3770 An argument specifies the modification time value to use\n\
3771 \(instead of that of the visited file), in the form of a list\n\
3772 \(HIGH . LOW) or (HIGH LOW).")
3774 Lisp_Object time_list
;
3776 if (!NILP (time_list
))
3777 current_buffer
->modtime
= cons_to_long (time_list
);
3780 register Lisp_Object filename
;
3782 Lisp_Object handler
;
3784 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3786 /* If the file name has special constructs in it,
3787 call the corresponding file handler. */
3788 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3789 if (!NILP (handler
))
3790 /* The handler can find the file name the same way we did. */
3791 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3792 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3793 current_buffer
->modtime
= st
.st_mtime
;
3803 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3804 Fsleep_for (make_number (1), Qnil
);
3805 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3806 Fsleep_for (make_number (1), Qnil
);
3807 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3808 Fsleep_for (make_number (1), Qnil
);
3818 /* Get visited file's mode to become the auto save file's mode. */
3819 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3820 /* But make sure we can overwrite it later! */
3821 auto_save_mode_bits
= st
.st_mode
| 0600;
3823 auto_save_mode_bits
= 0666;
3826 Fwrite_region (Qnil
, Qnil
,
3827 current_buffer
->auto_save_file_name
,
3828 Qnil
, Qlambda
, Qnil
);
3832 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3836 if (XINT (desc
) >= 0)
3837 close (XINT (desc
));
3841 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3842 "Auto-save all buffers that need it.\n\
3843 This is all buffers that have auto-saving enabled\n\
3844 and are changed since last auto-saved.\n\
3845 Auto-saving writes the buffer into a file\n\
3846 so that your editing is not lost if the system crashes.\n\
3847 This file is not the file you visited; that changes only when you save.\n\
3848 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3849 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
3850 A non-nil CURRENT-ONLY argument means save only current buffer.")
3851 (no_message
, current_only
)
3852 Lisp_Object no_message
, current_only
;
3854 struct buffer
*old
= current_buffer
, *b
;
3855 Lisp_Object tail
, buf
;
3857 char *omessage
= echo_area_glyphs
;
3858 int omessage_length
= echo_area_glyphs_length
;
3859 extern int minibuf_level
;
3860 int do_handled_files
;
3863 int count
= specpdl_ptr
- specpdl
;
3866 /* Ordinarily don't quit within this function,
3867 but don't make it impossible to quit (in case we get hung in I/O). */
3871 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3872 point to non-strings reached from Vbuffer_alist. */
3877 if (!NILP (Vrun_hooks
))
3878 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3880 if (STRINGP (Vauto_save_list_file_name
))
3882 Lisp_Object listfile
;
3883 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
3885 listdesc
= open (XSTRING (listfile
)->data
,
3886 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3887 S_IREAD
| S_IWRITE
);
3888 #else /* not DOS_NT */
3889 listdesc
= creat (XSTRING (listfile
)->data
, 0666);
3890 #endif /* not DOS_NT */
3895 /* Arrange to close that file whether or not we get an error.
3896 Also reset auto_saving to 0. */
3897 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3901 /* First, save all files which don't have handlers. If Emacs is
3902 crashing, the handlers may tweak what is causing Emacs to crash
3903 in the first place, and it would be a shame if Emacs failed to
3904 autosave perfectly ordinary files because it couldn't handle some
3906 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3907 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
3909 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3912 /* Record all the buffers that have auto save mode
3913 in the special file that lists them. For each of these buffers,
3914 Record visited name (if any) and auto save name. */
3915 if (STRINGP (b
->auto_save_file_name
)
3916 && listdesc
>= 0 && do_handled_files
== 0)
3918 if (!NILP (b
->filename
))
3920 write (listdesc
, XSTRING (b
->filename
)->data
,
3921 XSTRING (b
->filename
)->size
);
3923 write (listdesc
, "\n", 1);
3924 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3925 XSTRING (b
->auto_save_file_name
)->size
);
3926 write (listdesc
, "\n", 1);
3929 if (!NILP (current_only
)
3930 && b
!= current_buffer
)
3933 /* Don't auto-save indirect buffers.
3934 The base buffer takes care of it. */
3938 /* Check for auto save enabled
3939 and file changed since last auto save
3940 and file changed since last real save. */
3941 if (STRINGP (b
->auto_save_file_name
)
3942 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
3943 && b
->auto_save_modified
< BUF_MODIFF (b
)
3944 /* -1 means we've turned off autosaving for a while--see below. */
3945 && XINT (b
->save_length
) >= 0
3946 && (do_handled_files
3947 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3950 EMACS_TIME before_time
, after_time
;
3952 EMACS_GET_TIME (before_time
);
3954 /* If we had a failure, don't try again for 20 minutes. */
3955 if (b
->auto_save_failure_time
>= 0
3956 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3959 if ((XFASTINT (b
->save_length
) * 10
3960 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3961 /* A short file is likely to change a large fraction;
3962 spare the user annoying messages. */
3963 && XFASTINT (b
->save_length
) > 5000
3964 /* These messages are frequent and annoying for `*mail*'. */
3965 && !EQ (b
->filename
, Qnil
)
3966 && NILP (no_message
))
3968 /* It has shrunk too much; turn off auto-saving here. */
3969 message ("Buffer %s has shrunk a lot; auto save turned off there",
3970 XSTRING (b
->name
)->data
);
3971 /* Turn off auto-saving until there's a real save,
3972 and prevent any more warnings. */
3973 XSETINT (b
->save_length
, -1);
3974 Fsleep_for (make_number (1), Qnil
);
3977 set_buffer_internal (b
);
3978 if (!auto_saved
&& NILP (no_message
))
3979 message1 ("Auto-saving...");
3980 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3982 b
->auto_save_modified
= BUF_MODIFF (b
);
3983 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3984 set_buffer_internal (old
);
3986 EMACS_GET_TIME (after_time
);
3988 /* If auto-save took more than 60 seconds,
3989 assume it was an NFS failure that got a timeout. */
3990 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3991 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3995 /* Prevent another auto save till enough input events come in. */
3996 record_auto_save ();
3998 if (auto_saved
&& NILP (no_message
))
4002 sit_for (1, 0, 0, 0);
4003 message2 (omessage
, omessage_length
);
4006 message1 ("Auto-saving...done");
4011 unbind_to (count
, Qnil
);
4015 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4016 Sset_buffer_auto_saved
, 0, 0, 0,
4017 "Mark current buffer as auto-saved with its current text.\n\
4018 No auto-save file will be written until the buffer changes again.")
4021 current_buffer
->auto_save_modified
= MODIFF
;
4022 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4023 current_buffer
->auto_save_failure_time
= -1;
4027 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4028 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4029 "Clear any record of a recent auto-save failure in the current buffer.")
4032 current_buffer
->auto_save_failure_time
= -1;
4036 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4038 "Return t if buffer has been auto-saved since last read in or saved.")
4041 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4044 /* Reading and completing file names */
4045 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4047 /* In the string VAL, change each $ to $$ and return the result. */
4050 double_dollars (val
)
4053 register unsigned char *old
, *new;
4057 osize
= XSTRING (val
)->size
;
4058 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4059 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4060 if (*old
++ == '$') count
++;
4063 old
= XSTRING (val
)->data
;
4064 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4065 new = XSTRING (val
)->data
;
4066 for (n
= osize
; n
> 0; n
--)
4079 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4081 "Internal subroutine for read-file-name. Do not call this.")
4082 (string
, dir
, action
)
4083 Lisp_Object string
, dir
, action
;
4084 /* action is nil for complete, t for return list of completions,
4085 lambda for verify final value */
4087 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4089 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4096 /* No need to protect ACTION--we only compare it with t and nil. */
4097 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4099 if (XSTRING (string
)->size
== 0)
4101 if (EQ (action
, Qlambda
))
4109 orig_string
= string
;
4110 string
= Fsubstitute_in_file_name (string
);
4111 changed
= NILP (Fstring_equal (string
, orig_string
));
4112 name
= Ffile_name_nondirectory (string
);
4113 val
= Ffile_name_directory (string
);
4115 realdir
= Fexpand_file_name (val
, realdir
);
4120 specdir
= Ffile_name_directory (string
);
4121 val
= Ffile_name_completion (name
, realdir
);
4126 return double_dollars (string
);
4130 if (!NILP (specdir
))
4131 val
= concat2 (specdir
, val
);
4133 return double_dollars (val
);
4136 #endif /* not VMS */
4140 if (EQ (action
, Qt
))
4141 return Ffile_name_all_completions (name
, realdir
);
4142 /* Only other case actually used is ACTION = lambda */
4144 /* Supposedly this helps commands such as `cd' that read directory names,
4145 but can someone explain how it helps them? -- RMS */
4146 if (XSTRING (name
)->size
== 0)
4149 return Ffile_exists_p (string
);
4152 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4153 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4154 Value is not expanded---you must call `expand-file-name' yourself.\n\
4155 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4156 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4157 except that if INITIAL is specified, that combined with DIR is used.)\n\
4158 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4159 Non-nil and non-t means also require confirmation after completion.\n\
4160 Fifth arg INITIAL specifies text to start with.\n\
4161 DIR defaults to current buffer's directory default.")
4162 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4163 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4165 Lisp_Object val
, insdef
, insdef1
, tem
;
4166 struct gcpro gcpro1
, gcpro2
;
4167 register char *homedir
;
4171 dir
= current_buffer
->directory
;
4172 if (NILP (default_filename
))
4174 if (! NILP (initial
))
4175 default_filename
= Fexpand_file_name (initial
, dir
);
4177 default_filename
= current_buffer
->filename
;
4180 /* If dir starts with user's homedir, change that to ~. */
4181 homedir
= (char *) egetenv ("HOME");
4184 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4185 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4187 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4188 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4189 XSTRING (dir
)->data
[0] = '~';
4192 if (insert_default_directory
)
4195 if (!NILP (initial
))
4197 Lisp_Object args
[2], pos
;
4201 insdef
= Fconcat (2, args
);
4202 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4203 insdef1
= Fcons (double_dollars (insdef
), pos
);
4206 insdef1
= double_dollars (insdef
);
4208 else if (!NILP (initial
))
4211 insdef1
= Fcons (double_dollars (insdef
), 0);
4214 insdef
= Qnil
, insdef1
= Qnil
;
4217 count
= specpdl_ptr
- specpdl
;
4218 specbind (intern ("completion-ignore-case"), Qt
);
4221 GCPRO2 (insdef
, default_filename
);
4222 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4223 dir
, mustmatch
, insdef1
,
4224 Qfile_name_history
);
4227 unbind_to (count
, Qnil
);
4232 error ("No file name specified");
4233 tem
= Fstring_equal (val
, insdef
);
4234 if (!NILP (tem
) && !NILP (default_filename
))
4235 return default_filename
;
4236 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4238 if (!NILP (default_filename
))
4239 return default_filename
;
4241 error ("No default file name");
4243 return Fsubstitute_in_file_name (val
);
4246 #if 0 /* Old version */
4247 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4248 /* Don't confuse make-docfile by having two doc strings for this function.
4249 make-docfile does not pay attention to #if, for good reason! */
4251 (prompt
, dir
, defalt
, mustmatch
, initial
)
4252 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4254 Lisp_Object val
, insdef
, tem
;
4255 struct gcpro gcpro1
, gcpro2
;
4256 register char *homedir
;
4260 dir
= current_buffer
->directory
;
4262 defalt
= current_buffer
->filename
;
4264 /* If dir starts with user's homedir, change that to ~. */
4265 homedir
= (char *) egetenv ("HOME");
4268 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4269 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4271 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4272 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4273 XSTRING (dir
)->data
[0] = '~';
4276 if (!NILP (initial
))
4278 else if (insert_default_directory
)
4281 insdef
= build_string ("");
4284 count
= specpdl_ptr
- specpdl
;
4285 specbind (intern ("completion-ignore-case"), Qt
);
4288 GCPRO2 (insdef
, defalt
);
4289 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4291 insert_default_directory
? insdef
: Qnil
,
4292 Qfile_name_history
);
4295 unbind_to (count
, Qnil
);
4300 error ("No file name specified");
4301 tem
= Fstring_equal (val
, insdef
);
4302 if (!NILP (tem
) && !NILP (defalt
))
4304 return Fsubstitute_in_file_name (val
);
4306 #endif /* Old version */
4310 Qexpand_file_name
= intern ("expand-file-name");
4311 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4312 Qdirectory_file_name
= intern ("directory-file-name");
4313 Qfile_name_directory
= intern ("file-name-directory");
4314 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4315 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4316 Qfile_name_as_directory
= intern ("file-name-as-directory");
4317 Qcopy_file
= intern ("copy-file");
4318 Qmake_directory_internal
= intern ("make-directory-internal");
4319 Qdelete_directory
= intern ("delete-directory");
4320 Qdelete_file
= intern ("delete-file");
4321 Qrename_file
= intern ("rename-file");
4322 Qadd_name_to_file
= intern ("add-name-to-file");
4323 Qmake_symbolic_link
= intern ("make-symbolic-link");
4324 Qfile_exists_p
= intern ("file-exists-p");
4325 Qfile_executable_p
= intern ("file-executable-p");
4326 Qfile_readable_p
= intern ("file-readable-p");
4327 Qfile_symlink_p
= intern ("file-symlink-p");
4328 Qfile_writable_p
= intern ("file-writable-p");
4329 Qfile_directory_p
= intern ("file-directory-p");
4330 Qfile_regular_p
= intern ("file-regular-p");
4331 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4332 Qfile_modes
= intern ("file-modes");
4333 Qset_file_modes
= intern ("set-file-modes");
4334 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4335 Qinsert_file_contents
= intern ("insert-file-contents");
4336 Qwrite_region
= intern ("write-region");
4337 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4338 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4340 staticpro (&Qexpand_file_name
);
4341 staticpro (&Qsubstitute_in_file_name
);
4342 staticpro (&Qdirectory_file_name
);
4343 staticpro (&Qfile_name_directory
);
4344 staticpro (&Qfile_name_nondirectory
);
4345 staticpro (&Qunhandled_file_name_directory
);
4346 staticpro (&Qfile_name_as_directory
);
4347 staticpro (&Qcopy_file
);
4348 staticpro (&Qmake_directory_internal
);
4349 staticpro (&Qdelete_directory
);
4350 staticpro (&Qdelete_file
);
4351 staticpro (&Qrename_file
);
4352 staticpro (&Qadd_name_to_file
);
4353 staticpro (&Qmake_symbolic_link
);
4354 staticpro (&Qfile_exists_p
);
4355 staticpro (&Qfile_executable_p
);
4356 staticpro (&Qfile_readable_p
);
4357 staticpro (&Qfile_symlink_p
);
4358 staticpro (&Qfile_writable_p
);
4359 staticpro (&Qfile_directory_p
);
4360 staticpro (&Qfile_regular_p
);
4361 staticpro (&Qfile_accessible_directory_p
);
4362 staticpro (&Qfile_modes
);
4363 staticpro (&Qset_file_modes
);
4364 staticpro (&Qfile_newer_than_file_p
);
4365 staticpro (&Qinsert_file_contents
);
4366 staticpro (&Qwrite_region
);
4367 staticpro (&Qverify_visited_file_modtime
);
4369 Qfile_name_history
= intern ("file-name-history");
4370 Fset (Qfile_name_history
, Qnil
);
4371 staticpro (&Qfile_name_history
);
4373 Qfile_error
= intern ("file-error");
4374 staticpro (&Qfile_error
);
4375 Qfile_already_exists
= intern("file-already-exists");
4376 staticpro (&Qfile_already_exists
);
4379 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4380 staticpro (&Qfind_buffer_file_type
);
4383 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
4384 "*Format in which to write auto-save files.\n\
4385 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
4386 If it is t, which is the default, auto-save files are written in the\n\
4387 same format as a regular save would use.");
4388 Vauto_save_file_format
= Qt
;
4390 Qformat_decode
= intern ("format-decode");
4391 staticpro (&Qformat_decode
);
4392 Qformat_annotate_function
= intern ("format-annotate-function");
4393 staticpro (&Qformat_annotate_function
);
4395 Qcar_less_than_car
= intern ("car-less-than-car");
4396 staticpro (&Qcar_less_than_car
);
4398 Fput (Qfile_error
, Qerror_conditions
,
4399 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4400 Fput (Qfile_error
, Qerror_message
,
4401 build_string ("File error"));
4403 Fput (Qfile_already_exists
, Qerror_conditions
,
4404 Fcons (Qfile_already_exists
,
4405 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4406 Fput (Qfile_already_exists
, Qerror_message
,
4407 build_string ("File already exists"));
4409 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4410 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4411 insert_default_directory
= 1;
4413 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4414 "*Non-nil means write new files with record format `stmlf'.\n\
4415 nil means use format `var'. This variable is meaningful only on VMS.");
4416 vms_stmlf_recfm
= 0;
4418 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4419 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4420 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4423 The first argument given to HANDLER is the name of the I/O primitive\n\
4424 to be handled; the remaining arguments are the arguments that were\n\
4425 passed to that primitive. For example, if you do\n\
4426 (file-exists-p FILENAME)\n\
4427 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4428 (funcall HANDLER 'file-exists-p FILENAME)\n\
4429 The function `find-file-name-handler' checks this list for a handler\n\
4430 for its argument.");
4431 Vfile_name_handler_alist
= Qnil
;
4433 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4434 "A list of functions to be called at the end of `insert-file-contents'.\n\
4435 Each is passed one argument, the number of bytes inserted. It should return\n\
4436 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4437 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4438 responsible for calling the after-insert-file-functions if appropriate.");
4439 Vafter_insert_file_functions
= Qnil
;
4441 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4442 "A list of functions to be called at the start of `write-region'.\n\
4443 Each is passed two arguments, START and END as for `write-region'. It should\n\
4444 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4445 inserted at the specified positions of the file being written (1 means to\n\
4446 insert before the first byte written). The POSITIONs must be sorted into\n\
4447 increasing order. If there are several functions in the list, the several\n\
4448 lists are merged destructively.");
4449 Vwrite_region_annotate_functions
= Qnil
;
4451 DEFVAR_LISP ("write-region-annotations-so-far",
4452 &Vwrite_region_annotations_so_far
,
4453 "When an annotation function is called, this holds the previous annotations.\n\
4454 These are the annotations made by other annotation functions\n\
4455 that were already called. See also `write-region-annotate-functions'.");
4456 Vwrite_region_annotations_so_far
= Qnil
;
4458 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4459 "A list of file name handlers that temporarily should not be used.\n\
4460 This applies only to the operation `inhibit-file-name-operation'.");
4461 Vinhibit_file_name_handlers
= Qnil
;
4463 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4464 "The operation for which `inhibit-file-name-handlers' is applicable.");
4465 Vinhibit_file_name_operation
= Qnil
;
4467 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4468 "File name in which we write a list of all auto save file names.\n\
4469 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
4470 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
4472 Vauto_save_list_file_name
= Qnil
;
4474 defsubr (&Sfind_file_name_handler
);
4475 defsubr (&Sfile_name_directory
);
4476 defsubr (&Sfile_name_nondirectory
);
4477 defsubr (&Sunhandled_file_name_directory
);
4478 defsubr (&Sfile_name_as_directory
);
4479 defsubr (&Sdirectory_file_name
);
4480 defsubr (&Smake_temp_name
);
4481 defsubr (&Sexpand_file_name
);
4482 defsubr (&Ssubstitute_in_file_name
);
4483 defsubr (&Scopy_file
);
4484 defsubr (&Smake_directory_internal
);
4485 defsubr (&Sdelete_directory
);
4486 defsubr (&Sdelete_file
);
4487 defsubr (&Srename_file
);
4488 defsubr (&Sadd_name_to_file
);
4490 defsubr (&Smake_symbolic_link
);
4491 #endif /* S_IFLNK */
4493 defsubr (&Sdefine_logical_name
);
4496 defsubr (&Ssysnetunam
);
4497 #endif /* HPUX_NET */
4498 defsubr (&Sfile_name_absolute_p
);
4499 defsubr (&Sfile_exists_p
);
4500 defsubr (&Sfile_executable_p
);
4501 defsubr (&Sfile_readable_p
);
4502 defsubr (&Sfile_writable_p
);
4503 defsubr (&Sfile_symlink_p
);
4504 defsubr (&Sfile_directory_p
);
4505 defsubr (&Sfile_accessible_directory_p
);
4506 defsubr (&Sfile_regular_p
);
4507 defsubr (&Sfile_modes
);
4508 defsubr (&Sset_file_modes
);
4509 defsubr (&Sset_default_file_modes
);
4510 defsubr (&Sdefault_file_modes
);
4511 defsubr (&Sfile_newer_than_file_p
);
4512 defsubr (&Sinsert_file_contents
);
4513 defsubr (&Swrite_region
);
4514 defsubr (&Scar_less_than_car
);
4515 defsubr (&Sverify_visited_file_modtime
);
4516 defsubr (&Sclear_visited_file_modtime
);
4517 defsubr (&Svisited_file_modtime
);
4518 defsubr (&Sset_visited_file_modtime
);
4519 defsubr (&Sdo_auto_save
);
4520 defsubr (&Sset_buffer_auto_saved
);
4521 defsubr (&Sclear_buffer_auto_save_failure
);
4522 defsubr (&Srecent_auto_save_p
);
4524 defsubr (&Sread_file_name_internal
);
4525 defsubr (&Sread_file_name
);
4528 defsubr (&Sunix_sync
);