1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
22 #include <sys/types.h>
29 #if !defined (S_ISLNK) && defined (S_IFLNK)
30 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
33 #if !defined (S_ISREG) && defined (S_IFREG)
34 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
45 #include <sys/param.h>
63 extern char *strerror ();
80 #include "intervals.h"
89 #endif /* not WINDOWSNT */
117 #define min(a, b) ((a) < (b) ? (a) : (b))
118 #define max(a, b) ((a) > (b) ? (a) : (b))
120 /* Nonzero during writing of auto-save files */
123 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
124 a new file with the same mode as the original */
125 int auto_save_mode_bits
;
127 /* Alist of elements (REGEXP . HANDLER) for file names
128 whose I/O is done with a special handler. */
129 Lisp_Object Vfile_name_handler_alist
;
131 /* Functions to be called to process text properties in inserted file. */
132 Lisp_Object Vafter_insert_file_functions
;
134 /* Functions to be called to create text property annotations for file. */
135 Lisp_Object Vwrite_region_annotate_functions
;
137 /* During build_annotations, each time an annotation function is called,
138 this holds the annotations made by the previous functions. */
139 Lisp_Object Vwrite_region_annotations_so_far
;
141 /* File name in which we write a list of all our auto save files. */
142 Lisp_Object Vauto_save_list_file_name
;
144 /* Nonzero means, when reading a filename in the minibuffer,
145 start out by inserting the default directory into the minibuffer. */
146 int insert_default_directory
;
148 /* On VMS, nonzero means write new files with record format stmlf.
149 Zero means use var format. */
152 /* These variables describe handlers that have "already" had a chance
153 to handle the current operation.
155 Vinhibit_file_name_handlers is a list of file name handlers.
156 Vinhibit_file_name_operation is the operation being handled.
157 If we try to handle that operation, we ignore those handlers. */
159 static Lisp_Object Vinhibit_file_name_handlers
;
160 static Lisp_Object Vinhibit_file_name_operation
;
162 Lisp_Object Qfile_error
, Qfile_already_exists
;
164 Lisp_Object Qfile_name_history
;
166 Lisp_Object Qcar_less_than_car
;
168 report_file_error (string
, data
)
172 Lisp_Object errstring
;
174 errstring
= build_string (strerror (errno
));
176 /* System error messages are capitalized. Downcase the initial
177 unless it is followed by a slash. */
178 if (XSTRING (errstring
)->data
[1] != '/')
179 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
182 Fsignal (Qfile_error
,
183 Fcons (build_string (string
), Fcons (errstring
, data
)));
186 close_file_unwind (fd
)
189 close (XFASTINT (fd
));
192 /* Restore point, having saved it as a marker. */
194 restore_point_unwind (location
)
195 Lisp_Object location
;
197 SET_PT (marker_position (location
));
198 Fset_marker (location
, Qnil
, Qnil
);
201 Lisp_Object Qexpand_file_name
;
202 Lisp_Object Qdirectory_file_name
;
203 Lisp_Object Qfile_name_directory
;
204 Lisp_Object Qfile_name_nondirectory
;
205 Lisp_Object Qunhandled_file_name_directory
;
206 Lisp_Object Qfile_name_as_directory
;
207 Lisp_Object Qcopy_file
;
208 Lisp_Object Qmake_directory_internal
;
209 Lisp_Object Qdelete_directory
;
210 Lisp_Object Qdelete_file
;
211 Lisp_Object Qrename_file
;
212 Lisp_Object Qadd_name_to_file
;
213 Lisp_Object Qmake_symbolic_link
;
214 Lisp_Object Qfile_exists_p
;
215 Lisp_Object Qfile_executable_p
;
216 Lisp_Object Qfile_readable_p
;
217 Lisp_Object Qfile_symlink_p
;
218 Lisp_Object Qfile_writable_p
;
219 Lisp_Object Qfile_directory_p
;
220 Lisp_Object Qfile_accessible_directory_p
;
221 Lisp_Object Qfile_modes
;
222 Lisp_Object Qset_file_modes
;
223 Lisp_Object Qfile_newer_than_file_p
;
224 Lisp_Object Qinsert_file_contents
;
225 Lisp_Object Qwrite_region
;
226 Lisp_Object Qverify_visited_file_modtime
;
227 Lisp_Object Qset_visited_file_modtime
;
229 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
230 "Return FILENAME's handler function for OPERATION, if it has one.\n\
231 Otherwise, return nil.\n\
232 A file name is handled if one of the regular expressions in\n\
233 `file-name-handler-alist' matches it.\n\n\
234 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
235 any handlers that are members of `inhibit-file-name-handlers',\n\
236 but we still do run any other handlers. This lets handlers\n\
237 use the standard functions without calling themselves recursively.")
238 (filename
, operation
)
239 Lisp_Object filename
, operation
;
241 /* This function must not munge the match data. */
242 Lisp_Object chain
, inhibited_handlers
;
244 CHECK_STRING (filename
, 0);
246 if (EQ (operation
, Vinhibit_file_name_operation
))
247 inhibited_handlers
= Vinhibit_file_name_handlers
;
249 inhibited_handlers
= Qnil
;
251 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
252 chain
= XCONS (chain
)->cdr
)
255 elt
= XCONS (chain
)->car
;
259 string
= XCONS (elt
)->car
;
260 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
262 Lisp_Object handler
, tem
;
264 handler
= XCONS (elt
)->cdr
;
265 tem
= Fmemq (handler
, inhibited_handlers
);
276 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
278 "Return the directory component in file name NAME.\n\
279 Return nil if NAME does not include a directory.\n\
280 Otherwise return a directory spec.\n\
281 Given a Unix syntax file name, returns a string ending in slash;\n\
282 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
286 register unsigned char *beg
;
287 register unsigned char *p
;
290 CHECK_STRING (file
, 0);
292 /* If the file name has special constructs in it,
293 call the corresponding file handler. */
294 handler
= Ffind_file_name_handler (file
, Qfile_name_directory
);
296 return call2 (handler
, Qfile_name_directory
, file
);
298 #ifdef FILE_SYSTEM_CASE
299 file
= FILE_SYSTEM_CASE (file
);
301 beg
= XSTRING (file
)->data
;
302 p
= beg
+ XSTRING (file
)->size
;
304 while (p
!= beg
&& !IS_ANY_SEP (p
[-1])
306 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
309 && p
[-1] != ':' && p
[-1] != '\\'
316 /* Expansion of "c:" to drive and default directory. */
317 /* (NT does the right thing.) */
318 if (p
== beg
+ 2 && beg
[1] == ':')
320 int drive
= (*beg
) - 'a';
321 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
322 unsigned char *res
= alloca (MAXPATHLEN
+ 5);
326 /* The NT version places the drive letter at the beginning already. */
327 #else /* not WINDOWSNT */
328 /* On MSDOG we must put the drive letter in by hand. */
330 #endif /* not WINDOWSNT */
331 if (getdefdir (drive
+ 1, res
))
334 res
[0] = drive
+ 'a';
337 if (IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
340 p
= beg
+ strlen (beg
);
344 return make_string (beg
, p
- beg
);
347 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
349 "Return file name NAME sans its directory.\n\
350 For example, in a Unix-syntax file name,\n\
351 this is everything after the last slash,\n\
352 or the entire name if it contains no slash.")
356 register unsigned char *beg
, *p
, *end
;
359 CHECK_STRING (file
, 0);
361 /* If the file name has special constructs in it,
362 call the corresponding file handler. */
363 handler
= Ffind_file_name_handler (file
, Qfile_name_nondirectory
);
365 return call2 (handler
, Qfile_name_nondirectory
, file
);
367 beg
= XSTRING (file
)->data
;
368 end
= p
= beg
+ XSTRING (file
)->size
;
370 while (p
!= beg
&& !IS_ANY_SEP (p
[-1])
372 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
379 return make_string (p
, end
- p
);
382 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
383 "Return a directly usable directory name somehow associated with FILENAME.\n\
384 A `directly usable' directory name is one that may be used without the\n\
385 intervention of any file handler.\n\
386 If FILENAME is a directly usable file itself, return\n\
387 (file-name-directory FILENAME).\n\
388 The `call-process' and `start-process' functions use this function to\n\
389 get a current directory to run processes in.")
391 Lisp_Object filename
;
395 /* If the file name has special constructs in it,
396 call the corresponding file handler. */
397 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
399 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
401 return Ffile_name_directory (filename
);
406 file_name_as_directory (out
, in
)
409 int size
= strlen (in
) - 1;
414 /* Is it already a directory string? */
415 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
417 /* Is it a VMS directory file name? If so, hack VMS syntax. */
418 else if (! index (in
, '/')
419 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
420 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
421 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
422 || ! strncmp (&in
[size
- 5], ".dir", 4))
423 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
424 && in
[size
] == '1')))
426 register char *p
, *dot
;
430 dir:x.dir --> dir:[x]
431 dir:[x]y.dir --> dir:[x.y] */
433 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
436 strncpy (out
, in
, p
- in
);
455 dot
= index (p
, '.');
458 /* blindly remove any extension */
459 size
= strlen (out
) + (dot
- p
);
460 strncat (out
, p
, dot
- p
);
471 /* For Unix syntax, Append a slash if necessary */
473 if (out
[size
] != ':' && out
[size
] != '/' && out
[size
] != '\\')
474 #else /* not MSDOS */
475 if (!IS_ANY_SEP (out
[size
]))
477 out
[size
+ 1] = DIRECTORY_SEP
;
478 out
[size
+ 2] = '\0';
480 #endif /* not MSDOS */
485 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
486 Sfile_name_as_directory
, 1, 1, 0,
487 "Return a string representing file FILENAME interpreted as a directory.\n\
488 This operation exists because a directory is also a file, but its name as\n\
489 a directory is different from its name as a file.\n\
490 The result can be used as the value of `default-directory'\n\
491 or passed as second argument to `expand-file-name'.\n\
492 For a Unix-syntax file name, just appends a slash.\n\
493 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
500 CHECK_STRING (file
, 0);
504 /* If the file name has special constructs in it,
505 call the corresponding file handler. */
506 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
508 return call2 (handler
, Qfile_name_as_directory
, file
);
510 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
511 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
515 * Convert from directory name to filename.
517 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
518 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
519 * On UNIX, it's simple: just make sure there is a terminating /
521 * Value is nonzero if the string output is different from the input.
524 directory_file_name (src
, dst
)
532 struct FAB fab
= cc$rms_fab
;
533 struct NAM nam
= cc$rms_nam
;
534 char esa
[NAM$C_MAXRSS
];
539 if (! index (src
, '/')
540 && (src
[slen
- 1] == ']'
541 || src
[slen
- 1] == ':'
542 || src
[slen
- 1] == '>'))
544 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
546 fab
.fab$b_fns
= slen
;
547 fab
.fab$l_nam
= &nam
;
548 fab
.fab$l_fop
= FAB$M_NAM
;
551 nam
.nam$b_ess
= sizeof esa
;
552 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
554 /* We call SYS$PARSE to handle such things as [--] for us. */
555 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
557 slen
= nam
.nam$b_esl
;
558 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
563 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
565 /* what about when we have logical_name:???? */
566 if (src
[slen
- 1] == ':')
567 { /* Xlate logical name and see what we get */
568 ptr
= strcpy (dst
, src
); /* upper case for getenv */
571 if ('a' <= *ptr
&& *ptr
<= 'z')
575 dst
[slen
- 1] = 0; /* remove colon */
576 if (!(src
= egetenv (dst
)))
578 /* should we jump to the beginning of this procedure?
579 Good points: allows us to use logical names that xlate
581 Bad points: can be a problem if we just translated to a device
583 For now, I'll punt and always expect VMS names, and hope for
586 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
587 { /* no recursion here! */
593 { /* not a directory spec */
598 bracket
= src
[slen
- 1];
600 /* If bracket is ']' or '>', bracket - 2 is the corresponding
602 ptr
= index (src
, bracket
- 2);
604 { /* no opening bracket */
608 if (!(rptr
= rindex (src
, '.')))
611 strncpy (dst
, src
, slen
);
615 dst
[slen
++] = bracket
;
620 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
621 then translate the device and recurse. */
622 if (dst
[slen
- 1] == ':'
623 && dst
[slen
- 2] != ':' /* skip decnet nodes */
624 && strcmp(src
+ slen
, "[000000]") == 0)
626 dst
[slen
- 1] = '\0';
627 if ((ptr
= egetenv (dst
))
628 && (rlen
= strlen (ptr
) - 1) > 0
629 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
630 && ptr
[rlen
- 1] == '.')
632 char * buf
= (char *) alloca (strlen (ptr
) + 1);
636 return directory_file_name (buf
, dst
);
641 strcat (dst
, "[000000]");
645 rlen
= strlen (rptr
) - 1;
646 strncat (dst
, rptr
, rlen
);
647 dst
[slen
+ rlen
] = '\0';
648 strcat (dst
, ".DIR.1");
652 /* Process as Unix format: just remove any final slash.
653 But leave "/" unchanged; do not change it to "". */
656 && IS_DIRECTORY_SEP (dst
[slen
- 1])
657 && !IS_DEVICE_SEP (dst
[slen
- 2]))
662 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
664 "Returns the file name of the directory named DIR.\n\
665 This is the name of the file that holds the data for the directory DIR.\n\
666 This operation exists because a directory is also a file, but its name as\n\
667 a directory is different from its name as a file.\n\
668 In Unix-syntax, this function just removes the final slash.\n\
669 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
670 it returns a file name such as \"[X]Y.DIR.1\".")
672 Lisp_Object directory
;
677 CHECK_STRING (directory
, 0);
679 if (NILP (directory
))
682 /* If the file name has special constructs in it,
683 call the corresponding file handler. */
684 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
686 return call2 (handler
, Qdirectory_file_name
, directory
);
689 /* 20 extra chars is insufficient for VMS, since we might perform a
690 logical name translation. an equivalence string can be up to 255
691 chars long, so grab that much extra space... - sss */
692 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
694 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
696 directory_file_name (XSTRING (directory
)->data
, buf
);
697 return build_string (buf
);
700 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
701 "Generate temporary file name (string) starting with PREFIX (a string).\n\
702 The Emacs process number forms part of the result,\n\
703 so there is no danger of generating a name being used by another process.")
708 val
= concat2 (prefix
, build_string ("XXXXXX"));
709 mktemp (XSTRING (val
)->data
);
713 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
714 "Convert FILENAME to absolute, and canonicalize it.\n\
715 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
716 (does not start with slash); if DEFAULT is nil or missing,\n\
717 the current buffer's value of default-directory is used.\n\
718 Path components that are `.' are removed, and \n\
719 path components followed by `..' are removed, along with the `..' itself;\n\
720 note that these simplifications are done without checking the resulting\n\
721 paths in the file system.\n\
722 An initial `~/' expands to your home directory.\n\
723 An initial `~USER/' expands to USER's home directory.\n\
724 See also the function `substitute-in-file-name'.")
726 Lisp_Object name
, defalt
;
730 register unsigned char *newdir
, *p
, *o
;
732 unsigned char *target
;
735 unsigned char * colon
= 0;
736 unsigned char * close
= 0;
737 unsigned char * slash
= 0;
738 unsigned char * brack
= 0;
739 int lbrack
= 0, rbrack
= 0;
743 /* Demacs 1.1.2 91/10/20 Manabu Higashida */
746 unsigned char *tmp
, *defdir
;
750 CHECK_STRING (name
, 0);
752 /* If the file name has special constructs in it,
753 call the corresponding file handler. */
754 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
756 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
758 /* Use the buffer's default-directory if DEFALT is omitted. */
760 defalt
= current_buffer
->directory
;
761 CHECK_STRING (defalt
, 1);
763 o
= XSTRING (defalt
)->data
;
765 /* Make sure DEFALT is properly expanded.
766 It would be better to do this down below where we actually use
767 defalt. Unfortunately, calling Fexpand_file_name recursively
768 could invoke GC, and the strings might be relocated. This would
769 be annoying because we have pointers into strings lying around
770 that would need adjusting, and people would add new pointers to
771 the code and forget to adjust them, resulting in intermittent bugs.
772 Putting this call here avoids all that crud.
774 The EQ test avoids infinite recursion. */
775 if (! NILP (defalt
) && !EQ (defalt
, name
)
776 /* This saves time in a common case. */
777 && ! (XSTRING (defalt
)->size
>= 3
778 && IS_DIRECTORY_SEP (XSTRING (defalt
)->data
[0])
779 && IS_DEVICE_SEP (XSTRING (defalt
)->data
[1])))
784 defalt
= Fexpand_file_name (defalt
, Qnil
);
789 /* Filenames on VMS are always upper case. */
790 name
= Fupcase (name
);
792 #ifdef FILE_SYSTEM_CASE
793 name
= FILE_SYSTEM_CASE (name
);
796 nm
= XSTRING (name
)->data
;
799 /* First map all backslashes to slashes. */
800 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
804 /* Now strip drive name. */
806 unsigned char *colon
= rindex (nm
, ':');
812 drive
= tolower (colon
[-1]) - 'a';
814 if (!IS_DIRECTORY_SEP (*nm
))
816 defdir
= alloca (MAXPATHLEN
+ 1);
817 relpath
= getdefdir (drive
+ 1, defdir
);
823 /* If nm is absolute, flush ...// and detect /./ and /../.
824 If no /./ or /../ we can return right away. */
826 IS_DIRECTORY_SEP (nm
[0])
832 /* If it turns out that the filename we want to return is just a
833 suffix of FILENAME, we don't need to go through and edit
834 things; we just need to construct a new string using data
835 starting at the middle of FILENAME. If we set lose to a
836 non-zero value, that means we've discovered that we can't do
843 /* Since we know the path is absolute, we can assume that each
844 element starts with a "/". */
846 /* "//" anywhere isn't necessarily hairy; we just start afresh
847 with the second slash. */
848 if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
850 /* // at start of filename is meaningful on Apollo system */
854 /* \\ or // at the start of a pathname is meaningful on NT. */
856 #endif /* WINDOWSNT */
860 /* "~" is hairy as the start of any path element. */
861 if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '~')
862 nm
= p
+ 1, lose
= 1;
864 /* "." and ".." are hairy. */
865 if (IS_DIRECTORY_SEP (p
[0])
867 && (IS_DIRECTORY_SEP (p
[2])
869 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
876 /* if dev:[dir]/, move nm to / */
877 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
878 nm
= (brack
? brack
+ 1 : colon
+ 1);
887 /* VMS pre V4.4,convert '-'s in filenames. */
888 if (lbrack
== rbrack
)
890 if (dots
< 2) /* this is to allow negative version numbers */
895 if (lbrack
> rbrack
&&
896 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
897 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
903 /* count open brackets, reset close bracket pointer */
904 if (p
[0] == '[' || p
[0] == '<')
906 /* count close brackets, set close bracket pointer */
907 if (p
[0] == ']' || p
[0] == '>')
909 /* detect ][ or >< */
910 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
912 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
913 nm
= p
+ 1, lose
= 1;
914 if (p
[0] == ':' && (colon
|| slash
))
915 /* if dev1:[dir]dev2:, move nm to dev2: */
921 /* if /pathname/dev:, move nm to dev: */
924 /* if node::dev:, move colon following dev */
925 else if (colon
&& colon
[-1] == ':')
927 /* if dev1:dev2:, move nm to dev2: */
928 else if (colon
&& colon
[-1] != ':')
933 if (p
[0] == ':' && !colon
)
939 if (lbrack
== rbrack
)
942 else if (p
[0] == '.')
951 return build_string (sys_translate_unix (nm
));
954 if (nm
== XSTRING (name
)->data
)
956 return build_string (nm
);
957 #endif /* not DOS_NT */
961 /* Now determine directory to start with and put it in newdir */
965 if (nm
[0] == '~') /* prefix ~ */
967 if (IS_DIRECTORY_SEP (nm
[1])
971 || nm
[1] == 0) /* ~ by itself */
973 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
974 newdir
= (unsigned char *) "";
976 dostounix_filename (newdir
);
980 nm
++; /* Don't leave the slash in nm. */
983 else /* ~user/filename */
985 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
990 o
= (unsigned char *) alloca (p
- nm
+ 1);
991 bcopy ((char *) nm
, o
, p
- nm
);
995 newdir
= (unsigned char *) egetenv ("HOME");
996 dostounix_filename (newdir
);
997 #else /* not WINDOWSNT */
998 pw
= (struct passwd
*) getpwnam (o
+ 1);
1001 newdir
= (unsigned char *) pw
-> pw_dir
;
1003 nm
= p
+ 1; /* skip the terminator */
1008 #endif /* not WINDOWSNT */
1010 /* If we don't find a user of that name, leave the name
1011 unchanged; don't move nm forward to p. */
1015 if (!IS_ANY_SEP (nm
[0])
1018 #endif /* not VMS */
1024 newdir
= XSTRING (defalt
)->data
;
1028 if (newdir
== 0 && relpath
)
1033 /* Get rid of any slash at the end of newdir. */
1034 int length
= strlen (newdir
);
1035 /* Adding `length > 1 &&' makes ~ expand into / when homedir
1036 is the root dir. People disagree about whether that is right.
1037 Anyway, we can't take the risk of this change now. */
1039 if (newdir
[1] != ':' && length
> 1)
1041 if (IS_DIRECTORY_SEP (newdir
[length
- 1]))
1043 unsigned char *temp
= (unsigned char *) alloca (length
);
1044 bcopy (newdir
, temp
, length
- 1);
1045 temp
[length
- 1] = 0;
1053 /* Now concatenate the directory and name to new space in the stack frame */
1054 tlen
+= strlen (nm
) + 1;
1056 /* Add reserved space for drive name. (The Microsoft x86 compiler
1057 produces incorrect code if the following two lines are combined.) */
1058 target
= (unsigned char *) alloca (tlen
+ 2);
1060 #else /* not DOS_NT */
1061 target
= (unsigned char *) alloca (tlen
);
1062 #endif /* not DOS_NT */
1068 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1069 strcpy (target
, newdir
);
1072 file_name_as_directory (target
, newdir
);
1075 strcat (target
, nm
);
1077 if (index (target
, '/'))
1078 strcpy (target
, sys_translate_unix (target
));
1081 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1089 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1095 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1096 /* brackets are offset from each other by 2 */
1099 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1100 /* convert [foo][bar] to [bar] */
1101 while (o
[-1] != '[' && o
[-1] != '<')
1103 else if (*p
== '-' && *o
!= '.')
1106 else if (p
[0] == '-' && o
[-1] == '.' &&
1107 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1108 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1112 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1113 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1115 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1117 /* else [foo.-] ==> [-] */
1123 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1124 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1130 if (!IS_DIRECTORY_SEP (*p
))
1135 else if (!strncmp (p
, "\\\\", 2) || !strncmp (p
, "//", 2))
1136 #else /* not WINDOWSNT */
1137 else if (!strncmp (p
, "//", 2)
1138 #endif /* not WINDOWSNT */
1140 /* // at start of filename is meaningful in Apollo system */
1144 /* \\ at start of filename is meaningful in Windows-NT */
1146 #endif /* WINDOWSNT */
1152 else if (IS_DIRECTORY_SEP (p
[0])
1154 && (IS_DIRECTORY_SEP (p
[2])
1157 /* If "/." is the entire filename, keep the "/". Otherwise,
1158 just delete the whole "/.". */
1159 if (o
== target
&& p
[2] == '\0')
1164 else if (!strncmp (p
, "\\..", 3) || !strncmp (p
, "/..", 3))
1165 #else /* not WINDOWSNT */
1166 else if (!strncmp (p
, "/..", 3)
1167 #endif /* not WINDOWSNT */
1168 /* `/../' is the "superroot" on certain file systems. */
1170 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1172 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1175 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1180 if (o
== target
+ 1 && (o
[-1] == '/' && o
[0] == '/')
1181 || (o
[-1] == '\\' && o
[0] == '\\'))
1184 #endif /* WINDOWSNT */
1185 if (o
== target
&& IS_ANY_SEP (*o
))
1193 #endif /* not VMS */
1197 /* at last, set drive name. */
1198 if (target
[1] != ':'
1200 /* Allow network paths that look like "\\foo" */
1201 && !(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1]))
1202 #endif /* WINDOWSNT */
1206 target
[0] = (drive
< 0 ? getdisk () : drive
) + 'a';
1211 return make_string (target
, o
- target
);
1215 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1216 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1217 "Convert FILENAME to absolute, and canonicalize it.\n\
1218 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1219 (does not start with slash); if DEFAULT is nil or missing,\n\
1220 the current buffer's value of default-directory is used.\n\
1221 Filenames containing `.' or `..' as components are simplified;\n\
1222 initial `~/' expands to your home directory.\n\
1223 See also the function `substitute-in-file-name'.")
1225 Lisp_Object name
, defalt
;
1229 register unsigned char *newdir
, *p
, *o
;
1231 unsigned char *target
;
1235 unsigned char * colon
= 0;
1236 unsigned char * close
= 0;
1237 unsigned char * slash
= 0;
1238 unsigned char * brack
= 0;
1239 int lbrack
= 0, rbrack
= 0;
1243 CHECK_STRING (name
, 0);
1246 /* Filenames on VMS are always upper case. */
1247 name
= Fupcase (name
);
1250 nm
= XSTRING (name
)->data
;
1252 /* If nm is absolute, flush ...// and detect /./ and /../.
1253 If no /./ or /../ we can return right away. */
1265 if (p
[0] == '/' && p
[1] == '/'
1267 /* // at start of filename is meaningful on Apollo system */
1272 if (p
[0] == '/' && p
[1] == '~')
1273 nm
= p
+ 1, lose
= 1;
1274 if (p
[0] == '/' && p
[1] == '.'
1275 && (p
[2] == '/' || p
[2] == 0
1276 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1282 /* if dev:[dir]/, move nm to / */
1283 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1284 nm
= (brack
? brack
+ 1 : colon
+ 1);
1285 lbrack
= rbrack
= 0;
1293 /* VMS pre V4.4,convert '-'s in filenames. */
1294 if (lbrack
== rbrack
)
1296 if (dots
< 2) /* this is to allow negative version numbers */
1301 if (lbrack
> rbrack
&&
1302 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1303 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1309 /* count open brackets, reset close bracket pointer */
1310 if (p
[0] == '[' || p
[0] == '<')
1311 lbrack
++, brack
= 0;
1312 /* count close brackets, set close bracket pointer */
1313 if (p
[0] == ']' || p
[0] == '>')
1314 rbrack
++, brack
= p
;
1315 /* detect ][ or >< */
1316 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1318 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1319 nm
= p
+ 1, lose
= 1;
1320 if (p
[0] == ':' && (colon
|| slash
))
1321 /* if dev1:[dir]dev2:, move nm to dev2: */
1327 /* if /pathname/dev:, move nm to dev: */
1330 /* if node::dev:, move colon following dev */
1331 else if (colon
&& colon
[-1] == ':')
1333 /* if dev1:dev2:, move nm to dev2: */
1334 else if (colon
&& colon
[-1] != ':')
1339 if (p
[0] == ':' && !colon
)
1345 if (lbrack
== rbrack
)
1348 else if (p
[0] == '.')
1356 if (index (nm
, '/'))
1357 return build_string (sys_translate_unix (nm
));
1359 if (nm
== XSTRING (name
)->data
)
1361 return build_string (nm
);
1365 /* Now determine directory to start with and put it in NEWDIR */
1369 if (nm
[0] == '~') /* prefix ~ */
1374 || nm
[1] == 0)/* ~/filename */
1376 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1377 newdir
= (unsigned char *) "";
1380 nm
++; /* Don't leave the slash in nm. */
1383 else /* ~user/filename */
1385 /* Get past ~ to user */
1386 unsigned char *user
= nm
+ 1;
1387 /* Find end of name. */
1388 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1389 int len
= ptr
? ptr
- user
: strlen (user
);
1391 unsigned char *ptr1
= index (user
, ':');
1392 if (ptr1
!= 0 && ptr1
- user
< len
)
1395 /* Copy the user name into temp storage. */
1396 o
= (unsigned char *) alloca (len
+ 1);
1397 bcopy ((char *) user
, o
, len
);
1400 /* Look up the user name. */
1401 pw
= (struct passwd
*) getpwnam (o
+ 1);
1403 error ("\"%s\" isn't a registered user", o
+ 1);
1405 newdir
= (unsigned char *) pw
->pw_dir
;
1407 /* Discard the user name from NM. */
1414 #endif /* not VMS */
1418 defalt
= current_buffer
->directory
;
1419 CHECK_STRING (defalt
, 1);
1420 newdir
= XSTRING (defalt
)->data
;
1423 /* Now concatenate the directory and name to new space in the stack frame */
1425 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1426 target
= (unsigned char *) alloca (tlen
);
1432 if (nm
[0] == 0 || nm
[0] == '/')
1433 strcpy (target
, newdir
);
1436 file_name_as_directory (target
, newdir
);
1439 strcat (target
, nm
);
1441 if (index (target
, '/'))
1442 strcpy (target
, sys_translate_unix (target
));
1445 /* Now canonicalize by removing /. and /foo/.. if they appear */
1453 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1459 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1460 /* brackets are offset from each other by 2 */
1463 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1464 /* convert [foo][bar] to [bar] */
1465 while (o
[-1] != '[' && o
[-1] != '<')
1467 else if (*p
== '-' && *o
!= '.')
1470 else if (p
[0] == '-' && o
[-1] == '.' &&
1471 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1472 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1476 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1477 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1479 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1481 /* else [foo.-] ==> [-] */
1487 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1488 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1498 else if (!strncmp (p
, "//", 2)
1500 /* // at start of filename is meaningful in Apollo system */
1508 else if (p
[0] == '/' && p
[1] == '.' &&
1509 (p
[2] == '/' || p
[2] == 0))
1511 else if (!strncmp (p
, "/..", 3)
1512 /* `/../' is the "superroot" on certain file systems. */
1514 && (p
[3] == '/' || p
[3] == 0))
1516 while (o
!= target
&& *--o
!= '/')
1519 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1523 if (o
== target
&& *o
== '/')
1531 #endif /* not VMS */
1534 return make_string (target
, o
- target
);
1538 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1539 Ssubstitute_in_file_name
, 1, 1, 0,
1540 "Substitute environment variables referred to in FILENAME.\n\
1541 `$FOO' where FOO is an environment variable name means to substitute\n\
1542 the value of that variable. The variable name should be terminated\n\
1543 with a character not a letter, digit or underscore; otherwise, enclose\n\
1544 the entire variable name in braces.\n\
1545 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1546 On VMS, `$' substitution is not done; this function does little and only\n\
1547 duplicates what `expand-file-name' does.")
1553 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1554 unsigned char *target
;
1556 int substituted
= 0;
1559 CHECK_STRING (string
, 0);
1561 nm
= XSTRING (string
)->data
;
1563 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
1564 substituted
= !strcmp (nm
, XSTRING (string
)->data
);
1566 endp
= nm
+ XSTRING (string
)->size
;
1568 /* If /~ or // appears, discard everything through first slash. */
1570 for (p
= nm
; p
!= endp
; p
++)
1574 /* // at start of file name is meaningful in Apollo system */
1575 (p
[0] == '/' && p
- 1 != nm
)
1576 #else /* not APOLLO */
1578 (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1579 #else /* not WINDOWSNT */
1581 #endif /* not WINDOWSNT */
1582 #endif /* not APOLLO */
1587 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1589 || IS_DIRECTORY_SEP (p
[-1])))
1595 if (p
[0] && p
[1] == ':')
1604 return build_string (nm
);
1607 /* See if any variables are substituted into the string
1608 and find the total length of their values in `total' */
1610 for (p
= nm
; p
!= endp
;)
1620 /* "$$" means a single "$" */
1629 while (p
!= endp
&& *p
!= '}') p
++;
1630 if (*p
!= '}') goto missingclose
;
1636 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1640 /* Copy out the variable name */
1641 target
= (unsigned char *) alloca (s
- o
+ 1);
1642 strncpy (target
, o
, s
- o
);
1645 strupr (target
); /* $home == $HOME etc. */
1648 /* Get variable value */
1649 o
= (unsigned char *) egetenv (target
);
1650 if (!o
) goto badvar
;
1651 total
+= strlen (o
);
1658 /* If substitution required, recopy the string and do it */
1659 /* Make space in stack frame for the new copy */
1660 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1663 /* Copy the rest of the name through, replacing $ constructs with values */
1680 while (p
!= endp
&& *p
!= '}') p
++;
1681 if (*p
!= '}') goto missingclose
;
1687 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1691 /* Copy out the variable name */
1692 target
= (unsigned char *) alloca (s
- o
+ 1);
1693 strncpy (target
, o
, s
- o
);
1696 strupr (target
); /* $home == $HOME etc. */
1699 /* Get variable value */
1700 o
= (unsigned char *) egetenv (target
);
1710 /* If /~ or // appears, discard everything through first slash. */
1712 for (p
= xnm
; p
!= x
; p
++)
1715 /* // at start of file name is meaningful in Apollo system */
1716 || (p
[0] == '/' && p
- 1 != xnm
)
1717 #else /* not APOLLO */
1719 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1720 #else /* not WINDOWSNT */
1722 #endif /* not WINDOWSNT */
1724 && p
!= nm
&& IS_DIRECTORY_SEP (p
[-1]))
1727 else if (p
[0] && p
[1] == ':')
1731 return make_string (xnm
, x
- xnm
);
1734 error ("Bad format environment-variable substitution");
1736 error ("Missing \"}\" in environment-variable substitution");
1738 error ("Substituting nonexistent environment variable \"%s\"", target
);
1741 #endif /* not VMS */
1744 /* A slightly faster and more convenient way to get
1745 (directory-file-name (expand-file-name FOO)). */
1748 expand_and_dir_to_file (filename
, defdir
)
1749 Lisp_Object filename
, defdir
;
1751 register Lisp_Object abspath
;
1753 abspath
= Fexpand_file_name (filename
, defdir
);
1756 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1757 if (c
== ':' || c
== ']' || c
== '>')
1758 abspath
= Fdirectory_file_name (abspath
);
1761 /* Remove final slash, if any (unless path is root).
1762 stat behaves differently depending! */
1763 if (XSTRING (abspath
)->size
> 1
1764 && IS_DIRECTORY_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1])
1765 && !IS_DEVICE_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
-2]))
1766 /* We cannot take shortcuts; they might be wrong for magic file names. */
1767 abspath
= Fdirectory_file_name (abspath
);
1773 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1774 Lisp_Object absname
;
1775 unsigned char *querystring
;
1778 register Lisp_Object tem
;
1779 struct stat statbuf
;
1780 struct gcpro gcpro1
;
1782 /* stat is a good way to tell whether the file exists,
1783 regardless of what access permissions it has. */
1784 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1787 Fsignal (Qfile_already_exists
,
1788 Fcons (build_string ("File already exists"),
1789 Fcons (absname
, Qnil
)));
1791 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1792 XSTRING (absname
)->data
, querystring
));
1795 Fsignal (Qfile_already_exists
,
1796 Fcons (build_string ("File already exists"),
1797 Fcons (absname
, Qnil
)));
1802 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1803 "fCopy file: \nFCopy %s to file: \np\nP",
1804 "Copy FILE to NEWNAME. Both args must be strings.\n\
1805 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1806 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1807 A number as third arg means request confirmation if NEWNAME already exists.\n\
1808 This is what happens in interactive use with M-x.\n\
1809 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1810 last-modified time as the old one. (This works on only some systems.)\n\
1811 A prefix arg makes KEEP-TIME non-nil.")
1812 (filename
, newname
, ok_if_already_exists
, keep_date
)
1813 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1816 char buf
[16 * 1024];
1818 Lisp_Object handler
;
1819 struct gcpro gcpro1
, gcpro2
;
1820 int count
= specpdl_ptr
- specpdl
;
1821 int input_file_statable_p
;
1823 GCPRO2 (filename
, newname
);
1824 CHECK_STRING (filename
, 0);
1825 CHECK_STRING (newname
, 1);
1826 filename
= Fexpand_file_name (filename
, Qnil
);
1827 newname
= Fexpand_file_name (newname
, Qnil
);
1829 /* If the input file name has special constructs in it,
1830 call the corresponding file handler. */
1831 handler
= Ffind_file_name_handler (filename
, Qcopy_file
);
1832 /* Likewise for output file name. */
1834 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1835 if (!NILP (handler
))
1836 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, filename
, newname
,
1837 ok_if_already_exists
, keep_date
));
1839 if (NILP (ok_if_already_exists
)
1840 || INTEGERP (ok_if_already_exists
))
1841 barf_or_query_if_file_exists (newname
, "copy to it",
1842 INTEGERP (ok_if_already_exists
));
1844 ifd
= open (XSTRING (filename
)->data
, O_RDONLY
);
1846 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1848 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1850 /* We can only copy regular files and symbolic links. Other files are not
1852 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1854 #if defined (S_ISREG) && defined (S_ISLNK)
1855 if (input_file_statable_p
)
1857 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1859 #if defined (EISDIR)
1860 /* Get a better looking error message. */
1863 report_file_error ("Non-regular file", Fcons (filename
, Qnil
));
1866 #endif /* S_ISREG && S_ISLNK */
1869 /* Create the copy file with the same record format as the input file */
1870 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1873 /* System's default file type was set to binary by _fmode in emacs.c. */
1874 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1875 #else /* not MSDOS */
1876 ofd
= creat (XSTRING (newname
)->data
, 0666);
1877 #endif /* not MSDOS */
1880 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1882 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1886 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1887 if (write (ofd
, buf
, n
) != n
)
1888 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1891 /* Closing the output clobbers the file times on some systems. */
1892 if (close (ofd
) < 0)
1893 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1895 if (input_file_statable_p
)
1897 if (!NILP (keep_date
))
1899 EMACS_TIME atime
, mtime
;
1900 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1901 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1902 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
1903 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1906 if (!egetenv ("USE_DOMAIN_ACLS"))
1908 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1913 /* Discard the unwind protects. */
1914 specpdl_ptr
= specpdl
+ count
;
1920 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1921 Smake_directory_internal
, 1, 1, 0,
1922 "Create a directory. One argument, a file name string.")
1924 Lisp_Object dirname
;
1927 Lisp_Object handler
;
1929 CHECK_STRING (dirname
, 0);
1930 dirname
= Fexpand_file_name (dirname
, Qnil
);
1932 handler
= Ffind_file_name_handler (dirname
, Qmake_directory_internal
);
1933 if (!NILP (handler
))
1934 return call2 (handler
, Qmake_directory_internal
, dirname
);
1936 dir
= XSTRING (dirname
)->data
;
1939 if (mkdir (dir
) != 0)
1941 if (mkdir (dir
, 0777) != 0)
1943 report_file_error ("Creating directory", Flist (1, &dirname
));
1948 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1949 "Delete a directory. One argument, a file name or directory name string.")
1951 Lisp_Object dirname
;
1954 Lisp_Object handler
;
1956 CHECK_STRING (dirname
, 0);
1957 dirname
= Fdirectory_file_name (Fexpand_file_name (dirname
, Qnil
));
1958 dir
= XSTRING (dirname
)->data
;
1960 handler
= Ffind_file_name_handler (dirname
, Qdelete_directory
);
1961 if (!NILP (handler
))
1962 return call2 (handler
, Qdelete_directory
, dirname
);
1964 if (rmdir (dir
) != 0)
1965 report_file_error ("Removing directory", Flist (1, &dirname
));
1970 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1971 "Delete specified file. One argument, a file name string.\n\
1972 If file has multiple names, it continues to exist with the other names.")
1974 Lisp_Object filename
;
1976 Lisp_Object handler
;
1977 CHECK_STRING (filename
, 0);
1978 filename
= Fexpand_file_name (filename
, Qnil
);
1980 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
1981 if (!NILP (handler
))
1982 return call2 (handler
, Qdelete_file
, filename
);
1984 if (0 > unlink (XSTRING (filename
)->data
))
1985 report_file_error ("Removing old name", Flist (1, &filename
));
1989 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1990 "fRename file: \nFRename %s to file: \np",
1991 "Rename FILE as NEWNAME. Both args strings.\n\
1992 If file has names other than FILE, it continues to have those names.\n\
1993 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1994 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1995 A number as third arg means request confirmation if NEWNAME already exists.\n\
1996 This is what happens in interactive use with M-x.")
1997 (filename
, newname
, ok_if_already_exists
)
1998 Lisp_Object filename
, newname
, ok_if_already_exists
;
2001 Lisp_Object args
[2];
2003 Lisp_Object handler
;
2004 struct gcpro gcpro1
, gcpro2
;
2006 GCPRO2 (filename
, newname
);
2007 CHECK_STRING (filename
, 0);
2008 CHECK_STRING (newname
, 1);
2009 filename
= Fexpand_file_name (filename
, Qnil
);
2010 newname
= Fexpand_file_name (newname
, Qnil
);
2012 /* If the file name has special constructs in it,
2013 call the corresponding file handler. */
2014 handler
= Ffind_file_name_handler (filename
, Qrename_file
);
2016 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2017 if (!NILP (handler
))
2018 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2019 filename
, newname
, ok_if_already_exists
));
2021 if (NILP (ok_if_already_exists
)
2022 || INTEGERP (ok_if_already_exists
))
2023 barf_or_query_if_file_exists (newname
, "rename to it",
2024 INTEGERP (ok_if_already_exists
));
2026 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2029 if (!MoveFile (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2030 #else /* not WINDOWSNT */
2031 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
2032 || 0 > unlink (XSTRING (filename
)->data
))
2033 #endif /* not WINDOWSNT */
2037 /* Why two? And why doesn't MS document what MoveFile will return? */
2038 if (GetLastError () == ERROR_FILE_EXISTS
2039 || GetLastError () == ERROR_ALREADY_EXISTS
)
2040 #else /* not WINDOWSNT */
2042 #endif /* not WINDOWSNT */
2044 Fcopy_file (filename
, newname
,
2045 /* We have already prompted if it was an integer,
2046 so don't have copy-file prompt again. */
2047 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2048 Fdelete_file (filename
);
2055 report_file_error ("Renaming", Flist (2, args
));
2058 report_file_error ("Renaming", Flist (2, &filename
));
2065 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2066 "fAdd name to file: \nFName to add to %s: \np",
2067 "Give FILE additional name NEWNAME. Both args strings.\n\
2068 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2069 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2070 A number as third arg means request confirmation if NEWNAME already exists.\n\
2071 This is what happens in interactive use with M-x.")
2072 (filename
, newname
, ok_if_already_exists
)
2073 Lisp_Object filename
, newname
, ok_if_already_exists
;
2076 Lisp_Object args
[2];
2078 Lisp_Object handler
;
2079 struct gcpro gcpro1
, gcpro2
;
2081 GCPRO2 (filename
, newname
);
2082 CHECK_STRING (filename
, 0);
2083 CHECK_STRING (newname
, 1);
2084 filename
= Fexpand_file_name (filename
, Qnil
);
2085 newname
= Fexpand_file_name (newname
, Qnil
);
2087 /* If the file name has special constructs in it,
2088 call the corresponding file handler. */
2089 handler
= Ffind_file_name_handler (filename
, Qadd_name_to_file
);
2090 if (!NILP (handler
))
2091 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
2092 newname
, ok_if_already_exists
));
2094 if (NILP (ok_if_already_exists
)
2095 || INTEGERP (ok_if_already_exists
))
2096 barf_or_query_if_file_exists (newname
, "make it a new name",
2097 INTEGERP (ok_if_already_exists
));
2099 /* Windows does not support this operation. */
2100 report_file_error ("Adding new name", Flist (2, &filename
));
2101 #else /* not WINDOWSNT */
2103 unlink (XSTRING (newname
)->data
);
2104 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2109 report_file_error ("Adding new name", Flist (2, args
));
2111 report_file_error ("Adding new name", Flist (2, &filename
));
2114 #endif /* not WINDOWSNT */
2121 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2122 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2123 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2124 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2125 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2126 A number as third arg means request confirmation if LINKNAME already exists.\n\
2127 This happens for interactive use with M-x.")
2128 (filename
, linkname
, ok_if_already_exists
)
2129 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2132 Lisp_Object args
[2];
2134 Lisp_Object handler
;
2135 struct gcpro gcpro1
, gcpro2
;
2137 GCPRO2 (filename
, linkname
);
2138 CHECK_STRING (filename
, 0);
2139 CHECK_STRING (linkname
, 1);
2140 /* If the link target has a ~, we must expand it to get
2141 a truly valid file name. Otherwise, do not expand;
2142 we want to permit links to relative file names. */
2143 if (XSTRING (filename
)->data
[0] == '~')
2144 filename
= Fexpand_file_name (filename
, Qnil
);
2145 linkname
= Fexpand_file_name (linkname
, Qnil
);
2147 /* If the file name has special constructs in it,
2148 call the corresponding file handler. */
2149 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2150 if (!NILP (handler
))
2151 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2152 linkname
, ok_if_already_exists
));
2154 if (NILP (ok_if_already_exists
)
2155 || INTEGERP (ok_if_already_exists
))
2156 barf_or_query_if_file_exists (linkname
, "make it a link",
2157 INTEGERP (ok_if_already_exists
));
2158 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2160 /* If we didn't complain already, silently delete existing file. */
2161 if (errno
== EEXIST
)
2163 unlink (XSTRING (linkname
)->data
);
2164 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2174 report_file_error ("Making symbolic link", Flist (2, args
));
2176 report_file_error ("Making symbolic link", Flist (2, &filename
));
2182 #endif /* S_IFLNK */
2186 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2187 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2188 "Define the job-wide logical name NAME to have the value STRING.\n\
2189 If STRING is nil or a null string, the logical name NAME is deleted.")
2191 Lisp_Object varname
;
2194 CHECK_STRING (varname
, 0);
2196 delete_logical_name (XSTRING (varname
)->data
);
2199 CHECK_STRING (string
, 1);
2201 if (XSTRING (string
)->size
== 0)
2202 delete_logical_name (XSTRING (varname
)->data
);
2204 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2213 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2214 "Open a network connection to PATH using LOGIN as the login string.")
2216 Lisp_Object path
, login
;
2220 CHECK_STRING (path
, 0);
2221 CHECK_STRING (login
, 0);
2223 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2225 if (netresult
== -1)
2230 #endif /* HPUX_NET */
2232 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2234 "Return t if file FILENAME specifies an absolute path name.\n\
2235 On Unix, this is a name starting with a `/' or a `~'.")
2237 Lisp_Object filename
;
2241 CHECK_STRING (filename
, 0);
2242 ptr
= XSTRING (filename
)->data
;
2243 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2245 /* ??? This criterion is probably wrong for '<'. */
2246 || index (ptr
, ':') || index (ptr
, '<')
2247 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2251 || (*ptr
!= 0 && ptr
[1] == ':' && (ptr
[2] == '/' || ptr
[2] == '\\'))
2259 /* Return nonzero if file FILENAME exists and can be executed. */
2262 check_executable (filename
)
2266 return (eaccess (filename
, 1) >= 0);
2268 /* Access isn't quite right because it uses the real uid
2269 and we really want to test with the effective uid.
2270 But Unix doesn't give us a right way to do it. */
2271 return (access (filename
, 1) >= 0);
2275 /* Return nonzero if file FILENAME exists and can be written. */
2278 check_writable (filename
)
2282 return (eaccess (filename
, 2) >= 0);
2284 /* Access isn't quite right because it uses the real uid
2285 and we really want to test with the effective uid.
2286 But Unix doesn't give us a right way to do it.
2287 Opening with O_WRONLY could work for an ordinary file,
2288 but would lose for directories. */
2289 return (access (filename
, 2) >= 0);
2293 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2294 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2295 See also `file-readable-p' and `file-attributes'.")
2297 Lisp_Object filename
;
2299 Lisp_Object abspath
;
2300 Lisp_Object handler
;
2301 struct stat statbuf
;
2303 CHECK_STRING (filename
, 0);
2304 abspath
= Fexpand_file_name (filename
, Qnil
);
2306 /* If the file name has special constructs in it,
2307 call the corresponding file handler. */
2308 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2309 if (!NILP (handler
))
2310 return call2 (handler
, Qfile_exists_p
, abspath
);
2312 return (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2315 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2316 "Return t if FILENAME can be executed by you.\n\
2317 For a directory, this means you can access files in that directory.")
2319 Lisp_Object filename
;
2322 Lisp_Object abspath
;
2323 Lisp_Object handler
;
2325 CHECK_STRING (filename
, 0);
2326 abspath
= Fexpand_file_name (filename
, Qnil
);
2328 /* If the file name has special constructs in it,
2329 call the corresponding file handler. */
2330 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2331 if (!NILP (handler
))
2332 return call2 (handler
, Qfile_executable_p
, abspath
);
2334 return (check_executable (XSTRING (abspath
)->data
) ? Qt
: Qnil
);
2337 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2338 "Return t if file FILENAME exists and you can read it.\n\
2339 See also `file-exists-p' and `file-attributes'.")
2341 Lisp_Object filename
;
2343 Lisp_Object abspath
;
2344 Lisp_Object handler
;
2347 CHECK_STRING (filename
, 0);
2348 abspath
= Fexpand_file_name (filename
, Qnil
);
2350 /* If the file name has special constructs in it,
2351 call the corresponding file handler. */
2352 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2353 if (!NILP (handler
))
2354 return call2 (handler
, Qfile_readable_p
, abspath
);
2356 desc
= open (XSTRING (abspath
)->data
, O_RDONLY
);
2363 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2365 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2366 "Return t if file FILENAME can be written or created by you.")
2368 Lisp_Object filename
;
2370 Lisp_Object abspath
, dir
;
2371 Lisp_Object handler
;
2372 struct stat statbuf
;
2374 CHECK_STRING (filename
, 0);
2375 abspath
= Fexpand_file_name (filename
, Qnil
);
2377 /* If the file name has special constructs in it,
2378 call the corresponding file handler. */
2379 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2380 if (!NILP (handler
))
2381 return call2 (handler
, Qfile_writable_p
, abspath
);
2383 if (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0)
2384 return (check_writable (XSTRING (abspath
)->data
)
2386 dir
= Ffile_name_directory (abspath
);
2389 dir
= Fdirectory_file_name (dir
);
2393 dir
= Fdirectory_file_name (dir
);
2395 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2399 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2400 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2401 The value is the name of the file to which it is linked.\n\
2402 Otherwise returns nil.")
2404 Lisp_Object filename
;
2411 Lisp_Object handler
;
2413 CHECK_STRING (filename
, 0);
2414 filename
= Fexpand_file_name (filename
, Qnil
);
2416 /* If the file name has special constructs in it,
2417 call the corresponding file handler. */
2418 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2419 if (!NILP (handler
))
2420 return call2 (handler
, Qfile_symlink_p
, filename
);
2425 buf
= (char *) xmalloc (bufsize
);
2426 bzero (buf
, bufsize
);
2427 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2428 if (valsize
< bufsize
) break;
2429 /* Buffer was not long enough */
2438 val
= make_string (buf
, valsize
);
2441 #else /* not S_IFLNK */
2443 #endif /* not S_IFLNK */
2446 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2447 "Return t if file FILENAME is the name of a directory as a file.\n\
2448 A directory name spec may be given instead; then the value is t\n\
2449 if the directory so specified exists and really is a directory.")
2451 Lisp_Object filename
;
2453 register Lisp_Object abspath
;
2455 Lisp_Object handler
;
2457 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2459 /* If the file name has special constructs in it,
2460 call the corresponding file handler. */
2461 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2462 if (!NILP (handler
))
2463 return call2 (handler
, Qfile_directory_p
, abspath
);
2465 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2467 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2470 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2471 "Return t if file FILENAME is the name of a directory as a file,\n\
2472 and files in that directory can be opened by you. In order to use a\n\
2473 directory as a buffer's current directory, this predicate must return true.\n\
2474 A directory name spec may be given instead; then the value is t\n\
2475 if the directory so specified exists and really is a readable and\n\
2476 searchable directory.")
2478 Lisp_Object filename
;
2480 Lisp_Object handler
;
2482 struct gcpro gcpro1
;
2484 /* If the file name has special constructs in it,
2485 call the corresponding file handler. */
2486 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2487 if (!NILP (handler
))
2488 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2490 /* It's an unlikely combination, but yes we really do need to gcpro:
2491 Suppose that file-accessible-directory-p has no handler, but
2492 file-directory-p does have a handler; this handler causes a GC which
2493 relocates the string in `filename'; and finally file-directory-p
2494 returns non-nil. Then we would end up passing a garbaged string
2495 to file-executable-p. */
2497 tem
= (NILP (Ffile_directory_p (filename
))
2498 || NILP (Ffile_executable_p (filename
)));
2500 return tem
? Qnil
: Qt
;
2503 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2504 "Return t if file FILENAME is the name of a regular file.\n\
2505 This is the sort of file that holds an ordinary stream of data bytes.")
2507 Lisp_Object filename
;
2509 register Lisp_Object abspath
;
2511 Lisp_Object handler
;
2513 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2515 /* If the file name has special constructs in it,
2516 call the corresponding file handler. */
2517 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2518 if (!NILP (handler
))
2519 return call2 (handler
, Qfile_directory_p
, abspath
);
2521 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2523 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2526 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2527 "Return mode bits of FILE, as an integer.")
2529 Lisp_Object filename
;
2531 Lisp_Object abspath
;
2533 Lisp_Object handler
;
2535 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2537 /* If the file name has special constructs in it,
2538 call the corresponding file handler. */
2539 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2540 if (!NILP (handler
))
2541 return call2 (handler
, Qfile_modes
, abspath
);
2543 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2549 if (S_ISREG (st
.st_mode
)
2550 && (len
= XSTRING (abspath
)->size
) >= 5
2551 && (stricmp ((suffix
= XSTRING (abspath
)->data
+ len
-4), ".com") == 0
2552 || stricmp (suffix
, ".exe") == 0
2553 || stricmp (suffix
, ".bat") == 0))
2554 st
.st_mode
|= S_IEXEC
;
2558 return make_number (st
.st_mode
& 07777);
2561 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2562 "Set mode bits of FILE to MODE (an integer).\n\
2563 Only the 12 low bits of MODE are used.")
2565 Lisp_Object filename
, mode
;
2567 Lisp_Object abspath
;
2568 Lisp_Object handler
;
2570 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2571 CHECK_NUMBER (mode
, 1);
2573 /* If the file name has special constructs in it,
2574 call the corresponding file handler. */
2575 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2576 if (!NILP (handler
))
2577 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2580 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2581 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2583 if (!egetenv ("USE_DOMAIN_ACLS"))
2586 struct timeval tvp
[2];
2588 /* chmod on apollo also change the file's modtime; need to save the
2589 modtime and then restore it. */
2590 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2592 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2596 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2597 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2599 /* reset the old accessed and modified times. */
2600 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2602 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2605 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2606 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2613 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2614 "Set the file permission bits for newly created files.\n\
2615 The argument MODE should be an integer; only the low 9 bits are used.\n\
2616 This setting is inherited by subprocesses.")
2620 CHECK_NUMBER (mode
, 0);
2622 umask ((~ XINT (mode
)) & 0777);
2627 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2628 "Return the default file protection for created files.\n\
2629 The value is an integer.")
2635 realmask
= umask (0);
2638 XSETINT (value
, (~ realmask
) & 0777);
2644 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2645 "Tell Unix to finish all pending disk updates.")
2654 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2655 "Return t if file FILE1 is newer than file FILE2.\n\
2656 If FILE1 does not exist, the answer is nil;\n\
2657 otherwise, if FILE2 does not exist, the answer is t.")
2659 Lisp_Object file1
, file2
;
2661 Lisp_Object abspath1
, abspath2
;
2664 Lisp_Object handler
;
2665 struct gcpro gcpro1
, gcpro2
;
2667 CHECK_STRING (file1
, 0);
2668 CHECK_STRING (file2
, 0);
2671 GCPRO2 (abspath1
, file2
);
2672 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2673 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2676 /* If the file name has special constructs in it,
2677 call the corresponding file handler. */
2678 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2680 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2681 if (!NILP (handler
))
2682 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2684 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2687 mtime1
= st
.st_mtime
;
2689 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2692 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2696 Lisp_Object Qfind_buffer_file_type
;
2699 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2701 "Insert contents of file FILENAME after point.\n\
2702 Returns list of absolute file name and length of data inserted.\n\
2703 If second argument VISIT is non-nil, the buffer's visited filename\n\
2704 and last save file modtime are set, and it is marked unmodified.\n\
2705 If visiting and the file does not exist, visiting is completed\n\
2706 before the error is signaled.\n\n\
2707 The optional third and fourth arguments BEG and END\n\
2708 specify what portion of the file to insert.\n\
2709 If VISIT is non-nil, BEG and END must be nil.\n\
2710 If optional fifth argument REPLACE is non-nil,\n\
2711 it means replace the current buffer contents (in the accessible portion)\n\
2712 with the file contents. This is better than simply deleting and inserting\n\
2713 the whole thing because (1) it preserves some marker positions\n\
2714 and (2) it puts less data in the undo list.")
2715 (filename
, visit
, beg
, end
, replace
)
2716 Lisp_Object filename
, visit
, beg
, end
, replace
;
2720 register int inserted
= 0;
2721 register int how_much
;
2722 int count
= specpdl_ptr
- specpdl
;
2723 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2724 Lisp_Object handler
, val
, insval
;
2731 GCPRO3 (filename
, val
, p
);
2732 if (!NILP (current_buffer
->read_only
))
2733 Fbarf_if_buffer_read_only();
2735 CHECK_STRING (filename
, 0);
2736 filename
= Fexpand_file_name (filename
, Qnil
);
2738 /* If the file name has special constructs in it,
2739 call the corresponding file handler. */
2740 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2741 if (!NILP (handler
))
2743 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2744 visit
, beg
, end
, replace
);
2751 if (stat (XSTRING (filename
)->data
, &st
) < 0)
2753 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
2754 || fstat (fd
, &st
) < 0)
2755 #endif /* not APOLLO */
2757 if (fd
>= 0) close (fd
);
2760 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2767 /* This code will need to be changed in order to work on named
2768 pipes, and it's probably just not worth it. So we should at
2769 least signal an error. */
2770 if (!S_ISREG (st
.st_mode
))
2771 Fsignal (Qfile_error
,
2772 Fcons (build_string ("not a regular file"),
2773 Fcons (filename
, Qnil
)));
2777 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
2780 /* Replacement should preserve point as it preserves markers. */
2781 if (!NILP (replace
))
2782 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2784 record_unwind_protect (close_file_unwind
, make_number (fd
));
2786 /* Supposedly happens on VMS. */
2788 error ("File size is negative");
2790 if (!NILP (beg
) || !NILP (end
))
2792 error ("Attempt to visit less than an entire file");
2795 CHECK_NUMBER (beg
, 0);
2797 XSETFASTINT (beg
, 0);
2800 CHECK_NUMBER (end
, 0);
2803 XSETINT (end
, st
.st_size
);
2804 if (XINT (end
) != st
.st_size
)
2805 error ("maximum buffer size exceeded");
2808 /* If requested, replace the accessible part of the buffer
2809 with the file contents. Avoid replacing text at the
2810 beginning or end of the buffer that matches the file contents;
2811 that preserves markers pointing to the unchanged parts. */
2813 /* On MSDOS, replace mode doesn't really work, except for binary files,
2814 and it's not worth supporting just for them. */
2815 if (!NILP (replace
))
2818 XSETFASTINT (beg
, 0);
2819 XSETFASTINT (end
, st
.st_size
);
2820 del_range_1 (BEGV
, ZV
, 0);
2822 #else /* not DOS_NT */
2823 if (!NILP (replace
))
2825 unsigned char buffer
[1 << 14];
2826 int same_at_start
= BEGV
;
2827 int same_at_end
= ZV
;
2832 /* Count how many chars at the start of the file
2833 match the text at the beginning of the buffer. */
2838 nread
= read (fd
, buffer
, sizeof buffer
);
2840 error ("IO error reading %s: %s",
2841 XSTRING (filename
)->data
, strerror (errno
));
2842 else if (nread
== 0)
2845 while (bufpos
< nread
&& same_at_start
< ZV
2846 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2847 same_at_start
++, bufpos
++;
2848 /* If we found a discrepancy, stop the scan.
2849 Otherwise loop around and scan the next bufferfull. */
2850 if (bufpos
!= nread
)
2854 /* If the file matches the buffer completely,
2855 there's no need to replace anything. */
2856 if (same_at_start
- BEGV
== st
.st_size
)
2860 /* Truncate the buffer to the size of the file. */
2861 del_range_1 (same_at_start
, same_at_end
, 0);
2866 /* Count how many chars at the end of the file
2867 match the text at the end of the buffer. */
2870 int total_read
, nread
, bufpos
, curpos
, trial
;
2872 /* At what file position are we now scanning? */
2873 curpos
= st
.st_size
- (ZV
- same_at_end
);
2874 /* If the entire file matches the buffer tail, stop the scan. */
2877 /* How much can we scan in the next step? */
2878 trial
= min (curpos
, sizeof buffer
);
2879 if (lseek (fd
, curpos
- trial
, 0) < 0)
2880 report_file_error ("Setting file position",
2881 Fcons (filename
, Qnil
));
2884 while (total_read
< trial
)
2886 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2888 error ("IO error reading %s: %s",
2889 XSTRING (filename
)->data
, strerror (errno
));
2890 total_read
+= nread
;
2892 /* Scan this bufferfull from the end, comparing with
2893 the Emacs buffer. */
2894 bufpos
= total_read
;
2895 /* Compare with same_at_start to avoid counting some buffer text
2896 as matching both at the file's beginning and at the end. */
2897 while (bufpos
> 0 && same_at_end
> same_at_start
2898 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2899 same_at_end
--, bufpos
--;
2900 /* If we found a discrepancy, stop the scan.
2901 Otherwise loop around and scan the preceding bufferfull. */
2907 /* Don't try to reuse the same piece of text twice. */
2908 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2910 same_at_end
+= overlap
;
2912 /* Arrange to read only the nonmatching middle part of the file. */
2913 XSETFASTINT (beg
, same_at_start
- BEGV
);
2914 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
2916 del_range_1 (same_at_start
, same_at_end
, 0);
2917 /* Insert from the file at the proper position. */
2918 SET_PT (same_at_start
);
2920 #endif /* not DOS_NT */
2922 total
= XINT (end
) - XINT (beg
);
2925 register Lisp_Object temp
;
2927 /* Make sure point-max won't overflow after this insertion. */
2928 XSETINT (temp
, total
);
2929 if (total
!= XINT (temp
))
2930 error ("maximum buffer size exceeded");
2933 if (NILP (visit
) && total
> 0)
2934 prepare_to_modify_buffer (point
, point
);
2937 if (GAP_SIZE
< total
)
2938 make_gap (total
- GAP_SIZE
);
2940 if (XINT (beg
) != 0 || !NILP (replace
))
2942 if (lseek (fd
, XINT (beg
), 0) < 0)
2943 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2947 while (inserted
< total
)
2949 /* try is reserved in some compilers (Microsoft C) */
2950 int trytry
= min (total
- inserted
, 64 << 10);
2953 /* Allow quitting out of the actual I/O. */
2956 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, trytry
);
2973 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
2974 /* Determine file type from name and remove LFs from CR-LFs if the file
2975 is deemed to be a text file. */
2977 current_buffer
->buffer_file_type
2978 = call1 (Qfind_buffer_file_type
, filename
);
2979 if (NILP (current_buffer
->buffer_file_type
))
2982 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
2985 GPT
-= reduced_size
;
2986 GAP_SIZE
+= reduced_size
;
2987 inserted
-= reduced_size
;
2994 record_insert (point
, inserted
);
2996 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2997 offset_intervals (current_buffer
, point
, inserted
);
3003 /* Discard the unwind protect for closing the file. */
3007 error ("IO error reading %s: %s",
3008 XSTRING (filename
)->data
, strerror (errno
));
3015 if (!EQ (current_buffer
->undo_list
, Qt
))
3016 current_buffer
->undo_list
= Qnil
;
3018 stat (XSTRING (filename
)->data
, &st
);
3023 current_buffer
->modtime
= st
.st_mtime
;
3024 current_buffer
->filename
= filename
;
3027 current_buffer
->save_modified
= MODIFF
;
3028 current_buffer
->auto_save_modified
= MODIFF
;
3029 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3030 #ifdef CLASH_DETECTION
3033 if (!NILP (current_buffer
->filename
))
3034 unlock_file (current_buffer
->filename
);
3035 unlock_file (filename
);
3037 #endif /* CLASH_DETECTION */
3038 /* If visiting nonexistent file, return nil. */
3039 if (current_buffer
->modtime
== -1)
3040 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3043 if (inserted
> 0 && NILP (visit
) && total
> 0)
3044 signal_after_change (point
, 0, inserted
);
3048 p
= Vafter_insert_file_functions
;
3051 insval
= call1 (Fcar (p
), make_number (inserted
));
3054 CHECK_NUMBER (insval
, 0);
3055 inserted
= XFASTINT (insval
);
3063 val
= Fcons (filename
,
3064 Fcons (make_number (inserted
),
3067 RETURN_UNGCPRO (unbind_to (count
, val
));
3070 static Lisp_Object
build_annotations ();
3072 /* If build_annotations switched buffers, switch back to BUF.
3073 Kill the temporary buffer that was selected in the meantime. */
3076 build_annotations_unwind (buf
)
3081 if (XBUFFER (buf
) == current_buffer
)
3083 tembuf
= Fcurrent_buffer ();
3085 Fkill_buffer (tembuf
);
3089 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
3090 "r\nFWrite region to file: ",
3091 "Write current region into specified file.\n\
3092 When called from a program, takes three arguments:\n\
3093 START, END and FILENAME. START and END are buffer positions.\n\
3094 Optional fourth argument APPEND if non-nil means\n\
3095 append to existing file contents (if any).\n\
3096 Optional fifth argument VISIT if t means\n\
3097 set the last-save-file-modtime of buffer to this file's modtime\n\
3098 and mark buffer not modified.\n\
3099 If VISIT is a string, it is a second file name;\n\
3100 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3101 VISIT is also the file name to lock and unlock for clash detection.\n\
3102 If VISIT is neither t nor nil nor a string,\n\
3103 that means do not print the \"Wrote file\" message.\n\
3104 Kludgy feature: if START is a string, then that string is written\n\
3105 to the file, instead of any buffer contents, and END is ignored.")
3106 (start
, end
, filename
, append
, visit
)
3107 Lisp_Object start
, end
, filename
, append
, visit
;
3115 int count
= specpdl_ptr
- specpdl
;
3118 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3120 Lisp_Object handler
;
3121 Lisp_Object visit_file
;
3122 Lisp_Object annotations
;
3123 int visiting
, quietly
;
3124 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3125 struct buffer
*given_buffer
;
3127 int buffer_file_type
3128 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3131 if (!NILP (start
) && !STRINGP (start
))
3132 validate_region (&start
, &end
);
3134 GCPRO2 (filename
, visit
);
3135 filename
= Fexpand_file_name (filename
, Qnil
);
3136 if (STRINGP (visit
))
3137 visit_file
= Fexpand_file_name (visit
, Qnil
);
3139 visit_file
= filename
;
3142 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3143 quietly
= !NILP (visit
);
3147 GCPRO4 (start
, filename
, annotations
, visit_file
);
3149 /* If the file name has special constructs in it,
3150 call the corresponding file handler. */
3151 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3152 /* If FILENAME has no handler, see if VISIT has one. */
3153 if (NILP (handler
) && STRINGP (visit
))
3154 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3156 if (!NILP (handler
))
3159 val
= call6 (handler
, Qwrite_region
, start
, end
,
3160 filename
, append
, visit
);
3164 current_buffer
->save_modified
= MODIFF
;
3165 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3166 current_buffer
->filename
= visit_file
;
3172 /* Special kludge to simplify auto-saving. */
3175 XSETFASTINT (start
, BEG
);
3176 XSETFASTINT (end
, Z
);
3179 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3180 count1
= specpdl_ptr
- specpdl
;
3182 given_buffer
= current_buffer
;
3183 annotations
= build_annotations (start
, end
);
3184 if (current_buffer
!= given_buffer
)
3190 #ifdef CLASH_DETECTION
3192 lock_file (visit_file
);
3193 #endif /* CLASH_DETECTION */
3195 fn
= XSTRING (filename
)->data
;
3199 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3200 #else /* not DOS_NT */
3201 desc
= open (fn
, O_WRONLY
);
3202 #endif /* not DOS_NT */
3206 if (auto_saving
) /* Overwrite any previous version of autosave file */
3208 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3209 desc
= open (fn
, O_RDWR
);
3211 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3212 ? XSTRING (current_buffer
->filename
)->data
: 0,
3215 else /* Write to temporary name and rename if no errors */
3217 Lisp_Object temp_name
;
3218 temp_name
= Ffile_name_directory (filename
);
3220 if (!NILP (temp_name
))
3222 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3223 build_string ("$$SAVE$$")));
3224 fname
= XSTRING (filename
)->data
;
3225 fn
= XSTRING (temp_name
)->data
;
3226 desc
= creat_copy_attrs (fname
, fn
);
3229 /* If we can't open the temporary file, try creating a new
3230 version of the original file. VMS "creat" creates a
3231 new version rather than truncating an existing file. */
3234 desc
= creat (fn
, 0666);
3235 #if 0 /* This can clobber an existing file and fail to replace it,
3236 if the user runs out of space. */
3239 /* We can't make a new version;
3240 try to truncate and rewrite existing version if any. */
3242 desc
= open (fn
, O_RDWR
);
3248 desc
= creat (fn
, 0666);
3253 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3254 S_IREAD
| S_IWRITE
);
3255 #else /* not DOS_NT */
3256 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3257 #endif /* not DOS_NT */
3258 #endif /* not VMS */
3264 #ifdef CLASH_DETECTION
3266 if (!auto_saving
) unlock_file (visit_file
);
3268 #endif /* CLASH_DETECTION */
3269 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3272 record_unwind_protect (close_file_unwind
, make_number (desc
));
3275 if (lseek (desc
, 0, 2) < 0)
3277 #ifdef CLASH_DETECTION
3278 if (!auto_saving
) unlock_file (visit_file
);
3279 #endif /* CLASH_DETECTION */
3280 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3285 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3286 * if we do writes that don't end with a carriage return. Furthermore
3287 * it cannot handle writes of more then 16K. The modified
3288 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3289 * this EXCEPT for the last record (iff it doesn't end with a carriage
3290 * return). This implies that if your buffer doesn't end with a carriage
3291 * return, you get one free... tough. However it also means that if
3292 * we make two calls to sys_write (a la the following code) you can
3293 * get one at the gap as well. The easiest way to fix this (honest)
3294 * is to move the gap to the next newline (or the end of the buffer).
3299 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3300 move_gap (find_next_newline (GPT
, 1));
3306 if (STRINGP (start
))
3308 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3309 XSTRING (start
)->size
, 0, &annotations
);
3312 else if (XINT (start
) != XINT (end
))
3315 if (XINT (start
) < GPT
)
3317 register int end1
= XINT (end
);
3319 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3320 min (GPT
, end1
) - tem
, tem
, &annotations
);
3321 nwritten
+= min (GPT
, end1
) - tem
;
3325 if (XINT (end
) > GPT
&& !failure
)
3328 tem
= max (tem
, GPT
);
3329 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3331 nwritten
+= XINT (end
) - tem
;
3337 /* If file was empty, still need to write the annotations */
3338 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3346 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3347 Disk full in NFS may be reported here. */
3348 /* mib says that closing the file will try to write as fast as NFS can do
3349 it, and that means the fsync here is not crucial for autosave files. */
3350 if (!auto_saving
&& fsync (desc
) < 0)
3351 failure
= 1, save_errno
= errno
;
3354 /* Spurious "file has changed on disk" warnings have been
3355 observed on Suns as well.
3356 It seems that `close' can change the modtime, under nfs.
3358 (This has supposedly been fixed in Sunos 4,
3359 but who knows about all the other machines with NFS?) */
3362 /* On VMS and APOLLO, must do the stat after the close
3363 since closing changes the modtime. */
3366 /* Recall that #if defined does not work on VMS. */
3373 /* NFS can report a write failure now. */
3374 if (close (desc
) < 0)
3375 failure
= 1, save_errno
= errno
;
3378 /* If we wrote to a temporary name and had no errors, rename to real name. */
3382 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3390 /* Discard the unwind protect for close_file_unwind. */
3391 specpdl_ptr
= specpdl
+ count1
;
3392 /* Restore the original current buffer. */
3393 visit_file
= unbind_to (count
, visit_file
);
3395 #ifdef CLASH_DETECTION
3397 unlock_file (visit_file
);
3398 #endif /* CLASH_DETECTION */
3400 /* Do this before reporting IO error
3401 to avoid a "file has changed on disk" warning on
3402 next attempt to save. */
3404 current_buffer
->modtime
= st
.st_mtime
;
3407 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3411 current_buffer
->save_modified
= MODIFF
;
3412 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3413 current_buffer
->filename
= visit_file
;
3414 update_mode_lines
++;
3420 message ("Wrote %s", XSTRING (visit_file
)->data
);
3425 Lisp_Object
merge ();
3427 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3428 "Return t if (car A) is numerically less than (car B).")
3432 return Flss (Fcar (a
), Fcar (b
));
3435 /* Build the complete list of annotations appropriate for writing out
3436 the text between START and END, by calling all the functions in
3437 write-region-annotate-functions and merging the lists they return.
3438 If one of these functions switches to a different buffer, we assume
3439 that buffer contains altered text. Therefore, the caller must
3440 make sure to restore the current buffer in all cases,
3441 as save-excursion would do. */
3444 build_annotations (start
, end
)
3445 Lisp_Object start
, end
;
3447 Lisp_Object annotations
;
3449 struct gcpro gcpro1
, gcpro2
;
3452 p
= Vwrite_region_annotate_functions
;
3453 GCPRO2 (annotations
, p
);
3456 struct buffer
*given_buffer
= current_buffer
;
3457 Vwrite_region_annotations_so_far
= annotations
;
3458 res
= call2 (Fcar (p
), start
, end
);
3459 /* If the function makes a different buffer current,
3460 assume that means this buffer contains altered text to be output.
3461 Reset START and END from the buffer bounds
3462 and discard all previous annotations because they should have
3463 been dealt with by this function. */
3464 if (current_buffer
!= given_buffer
)
3470 Flength (res
); /* Check basic validity of return value */
3471 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3478 /* Write to descriptor DESC the LEN characters starting at ADDR,
3479 assuming they start at position POS in the buffer.
3480 Intersperse with them the annotations from *ANNOT
3481 (those which fall within the range of positions POS to POS + LEN),
3482 each at its appropriate position.
3484 Modify *ANNOT by discarding elements as we output them.
3485 The return value is negative in case of system call failure. */
3488 a_write (desc
, addr
, len
, pos
, annot
)
3490 register char *addr
;
3497 int lastpos
= pos
+ len
;
3499 while (NILP (*annot
) || CONSP (*annot
))
3501 tem
= Fcar_safe (Fcar (*annot
));
3502 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3503 nextpos
= XFASTINT (tem
);
3505 return e_write (desc
, addr
, lastpos
- pos
);
3508 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3510 addr
+= nextpos
- pos
;
3513 tem
= Fcdr (Fcar (*annot
));
3516 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3519 *annot
= Fcdr (*annot
);
3524 e_write (desc
, addr
, len
)
3526 register char *addr
;
3529 char buf
[16 * 1024];
3530 register char *p
, *end
;
3532 if (!EQ (current_buffer
->selective_display
, Qt
))
3533 return write (desc
, addr
, len
) - len
;
3537 end
= p
+ sizeof buf
;
3542 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3551 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3557 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3558 Sverify_visited_file_modtime
, 1, 1, 0,
3559 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3560 This means that the file has not been changed since it was visited or saved.")
3566 Lisp_Object handler
;
3568 CHECK_BUFFER (buf
, 0);
3571 if (!STRINGP (b
->filename
)) return Qt
;
3572 if (b
->modtime
== 0) return Qt
;
3574 /* If the file name has special constructs in it,
3575 call the corresponding file handler. */
3576 handler
= Ffind_file_name_handler (b
->filename
,
3577 Qverify_visited_file_modtime
);
3578 if (!NILP (handler
))
3579 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3581 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3583 /* If the file doesn't exist now and didn't exist before,
3584 we say that it isn't modified, provided the error is a tame one. */
3585 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3590 if (st
.st_mtime
== b
->modtime
3591 /* If both are positive, accept them if they are off by one second. */
3592 || (st
.st_mtime
> 0 && b
->modtime
> 0
3593 && (st
.st_mtime
== b
->modtime
+ 1
3594 || st
.st_mtime
== b
->modtime
- 1)))
3599 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3600 Sclear_visited_file_modtime
, 0, 0, 0,
3601 "Clear out records of last mod time of visited file.\n\
3602 Next attempt to save will certainly not complain of a discrepancy.")
3605 current_buffer
->modtime
= 0;
3609 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3610 Svisited_file_modtime
, 0, 0, 0,
3611 "Return the current buffer's recorded visited file modification time.\n\
3612 The value is a list of the form (HIGH . LOW), like the time values\n\
3613 that `file-attributes' returns.")
3616 return long_to_cons (current_buffer
->modtime
);
3619 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3620 Sset_visited_file_modtime
, 0, 1, 0,
3621 "Update buffer's recorded modification time from the visited file's time.\n\
3622 Useful if the buffer was not read from the file normally\n\
3623 or if the file itself has been changed for some known benign reason.\n\
3624 An argument specifies the modification time value to use\n\
3625 \(instead of that of the visited file), in the form of a list\n\
3626 \(HIGH . LOW) or (HIGH LOW).")
3628 Lisp_Object time_list
;
3630 if (!NILP (time_list
))
3631 current_buffer
->modtime
= cons_to_long (time_list
);
3634 register Lisp_Object filename
;
3636 Lisp_Object handler
;
3638 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3640 /* If the file name has special constructs in it,
3641 call the corresponding file handler. */
3642 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3643 if (!NILP (handler
))
3644 /* The handler can find the file name the same way we did. */
3645 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3646 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3647 current_buffer
->modtime
= st
.st_mtime
;
3657 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3658 Fsleep_for (make_number (1), Qnil
);
3659 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3660 Fsleep_for (make_number (1), Qnil
);
3661 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3662 Fsleep_for (make_number (1), Qnil
);
3672 /* Get visited file's mode to become the auto save file's mode. */
3673 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3674 /* But make sure we can overwrite it later! */
3675 auto_save_mode_bits
= st
.st_mode
| 0600;
3677 auto_save_mode_bits
= 0666;
3680 Fwrite_region (Qnil
, Qnil
,
3681 current_buffer
->auto_save_file_name
,
3686 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3689 close (XINT (desc
));
3693 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3694 "Auto-save all buffers that need it.\n\
3695 This is all buffers that have auto-saving enabled\n\
3696 and are changed since last auto-saved.\n\
3697 Auto-saving writes the buffer into a file\n\
3698 so that your editing is not lost if the system crashes.\n\
3699 This file is not the file you visited; that changes only when you save.\n\
3700 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3701 Non-nil first argument means do not print any message if successful.\n\
3702 Non-nil second argument means save only current buffer.")
3703 (no_message
, current_only
)
3704 Lisp_Object no_message
, current_only
;
3706 struct buffer
*old
= current_buffer
, *b
;
3707 Lisp_Object tail
, buf
;
3709 char *omessage
= echo_area_glyphs
;
3710 int omessage_length
= echo_area_glyphs_length
;
3711 extern int minibuf_level
;
3712 int do_handled_files
;
3715 int count
= specpdl_ptr
- specpdl
;
3718 /* Ordinarily don't quit within this function,
3719 but don't make it impossible to quit (in case we get hung in I/O). */
3723 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3724 point to non-strings reached from Vbuffer_alist. */
3730 if (!NILP (Vrun_hooks
))
3731 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3733 if (STRINGP (Vauto_save_list_file_name
))
3736 listdesc
= open (XSTRING (Vauto_save_list_file_name
)->data
,
3737 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3738 S_IREAD
| S_IWRITE
);
3739 #else /* not DOS_NT */
3740 listdesc
= creat (XSTRING (Vauto_save_list_file_name
)->data
, 0666);
3741 #endif /* not DOS_NT */
3746 /* Arrange to close that file whether or not we get an error. */
3748 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3750 /* First, save all files which don't have handlers. If Emacs is
3751 crashing, the handlers may tweak what is causing Emacs to crash
3752 in the first place, and it would be a shame if Emacs failed to
3753 autosave perfectly ordinary files because it couldn't handle some
3755 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3756 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
3757 tail
= XCONS (tail
)->cdr
)
3759 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3762 /* Record all the buffers that have auto save mode
3763 in the special file that lists them. */
3764 if (STRINGP (b
->auto_save_file_name
)
3765 && listdesc
>= 0 && do_handled_files
== 0)
3767 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3768 XSTRING (b
->auto_save_file_name
)->size
);
3769 write (listdesc
, "\n", 1);
3772 if (!NILP (current_only
)
3773 && b
!= current_buffer
)
3776 /* Check for auto save enabled
3777 and file changed since last auto save
3778 and file changed since last real save. */
3779 if (STRINGP (b
->auto_save_file_name
)
3780 && b
->save_modified
< BUF_MODIFF (b
)
3781 && b
->auto_save_modified
< BUF_MODIFF (b
)
3782 /* -1 means we've turned off autosaving for a while--see below. */
3783 && XINT (b
->save_length
) >= 0
3784 && (do_handled_files
3785 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3788 EMACS_TIME before_time
, after_time
;
3790 EMACS_GET_TIME (before_time
);
3792 /* If we had a failure, don't try again for 20 minutes. */
3793 if (b
->auto_save_failure_time
>= 0
3794 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3797 if ((XFASTINT (b
->save_length
) * 10
3798 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3799 /* A short file is likely to change a large fraction;
3800 spare the user annoying messages. */
3801 && XFASTINT (b
->save_length
) > 5000
3802 /* These messages are frequent and annoying for `*mail*'. */
3803 && !EQ (b
->filename
, Qnil
)
3804 && NILP (no_message
))
3806 /* It has shrunk too much; turn off auto-saving here. */
3807 message ("Buffer %s has shrunk a lot; auto save turned off there",
3808 XSTRING (b
->name
)->data
);
3809 /* Turn off auto-saving until there's a real save,
3810 and prevent any more warnings. */
3811 XSETINT (b
->save_length
, -1);
3812 Fsleep_for (make_number (1), Qnil
);
3815 set_buffer_internal (b
);
3816 if (!auto_saved
&& NILP (no_message
))
3817 message1 ("Auto-saving...");
3818 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3820 b
->auto_save_modified
= BUF_MODIFF (b
);
3821 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3822 set_buffer_internal (old
);
3824 EMACS_GET_TIME (after_time
);
3826 /* If auto-save took more than 60 seconds,
3827 assume it was an NFS failure that got a timeout. */
3828 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3829 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3833 /* Prevent another auto save till enough input events come in. */
3834 record_auto_save ();
3836 if (auto_saved
&& NILP (no_message
))
3839 message2 (omessage
, omessage_length
);
3841 message1 ("Auto-saving...done");
3847 unbind_to (count
, Qnil
);
3851 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3852 Sset_buffer_auto_saved
, 0, 0, 0,
3853 "Mark current buffer as auto-saved with its current text.\n\
3854 No auto-save file will be written until the buffer changes again.")
3857 current_buffer
->auto_save_modified
= MODIFF
;
3858 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3859 current_buffer
->auto_save_failure_time
= -1;
3863 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3864 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3865 "Clear any record of a recent auto-save failure in the current buffer.")
3868 current_buffer
->auto_save_failure_time
= -1;
3872 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3874 "Return t if buffer has been auto-saved since last read in or saved.")
3877 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3880 /* Reading and completing file names */
3881 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3883 /* In the string VAL, change each $ to $$ and return the result. */
3886 double_dollars (val
)
3889 register unsigned char *old
, *new;
3893 osize
= XSTRING (val
)->size
;
3894 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3895 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3896 if (*old
++ == '$') count
++;
3899 old
= XSTRING (val
)->data
;
3900 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3901 new = XSTRING (val
)->data
;
3902 for (n
= osize
; n
> 0; n
--)
3915 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3917 "Internal subroutine for read-file-name. Do not call this.")
3918 (string
, dir
, action
)
3919 Lisp_Object string
, dir
, action
;
3920 /* action is nil for complete, t for return list of completions,
3921 lambda for verify final value */
3923 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3925 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3932 /* No need to protect ACTION--we only compare it with t and nil. */
3933 GCPRO4 (string
, realdir
, name
, specdir
);
3935 if (XSTRING (string
)->size
== 0)
3937 if (EQ (action
, Qlambda
))
3945 orig_string
= string
;
3946 string
= Fsubstitute_in_file_name (string
);
3947 changed
= NILP (Fstring_equal (string
, orig_string
));
3948 name
= Ffile_name_nondirectory (string
);
3949 val
= Ffile_name_directory (string
);
3951 realdir
= Fexpand_file_name (val
, realdir
);
3956 specdir
= Ffile_name_directory (string
);
3957 val
= Ffile_name_completion (name
, realdir
);
3962 return double_dollars (string
);
3966 if (!NILP (specdir
))
3967 val
= concat2 (specdir
, val
);
3969 return double_dollars (val
);
3972 #endif /* not VMS */
3976 if (EQ (action
, Qt
))
3977 return Ffile_name_all_completions (name
, realdir
);
3978 /* Only other case actually used is ACTION = lambda */
3980 /* Supposedly this helps commands such as `cd' that read directory names,
3981 but can someone explain how it helps them? -- RMS */
3982 if (XSTRING (name
)->size
== 0)
3985 return Ffile_exists_p (string
);
3988 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3989 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3990 Value is not expanded---you must call `expand-file-name' yourself.\n\
3991 Default name to DEFAULT if user enters a null string.\n\
3992 (If DEFAULT is omitted, the visited file name is used,\n\
3993 except that if INITIAL is specified, that combined with DIR is used.)\n\
3994 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3995 Non-nil and non-t means also require confirmation after completion.\n\
3996 Fifth arg INITIAL specifies text to start with.\n\
3997 DIR defaults to current buffer's directory default.")
3998 (prompt
, dir
, defalt
, mustmatch
, initial
)
3999 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4001 Lisp_Object val
, insdef
, insdef1
, tem
;
4002 struct gcpro gcpro1
, gcpro2
;
4003 register char *homedir
;
4007 dir
= current_buffer
->directory
;
4010 if (! NILP (initial
))
4011 defalt
= Fexpand_file_name (initial
, dir
);
4013 defalt
= current_buffer
->filename
;
4016 /* If dir starts with user's homedir, change that to ~. */
4017 homedir
= (char *) egetenv ("HOME");
4020 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4021 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4023 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4024 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4025 XSTRING (dir
)->data
[0] = '~';
4028 if (insert_default_directory
)
4031 if (!NILP (initial
))
4033 Lisp_Object args
[2], pos
;
4037 insdef
= Fconcat (2, args
);
4038 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4039 insdef1
= Fcons (double_dollars (insdef
), pos
);
4042 insdef1
= double_dollars (insdef
);
4044 else if (!NILP (initial
))
4047 insdef1
= Fcons (double_dollars (insdef
), 0);
4050 insdef
= Qnil
, insdef1
= Qnil
;
4053 count
= specpdl_ptr
- specpdl
;
4054 specbind (intern ("completion-ignore-case"), Qt
);
4057 GCPRO2 (insdef
, defalt
);
4058 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4059 dir
, mustmatch
, insdef1
,
4060 Qfile_name_history
);
4063 unbind_to (count
, Qnil
);
4068 error ("No file name specified");
4069 tem
= Fstring_equal (val
, insdef
);
4070 if (!NILP (tem
) && !NILP (defalt
))
4072 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4077 error ("No default file name");
4079 return Fsubstitute_in_file_name (val
);
4082 #if 0 /* Old version */
4083 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4084 /* Don't confuse make-docfile by having two doc strings for this function.
4085 make-docfile does not pay attention to #if, for good reason! */
4087 (prompt
, dir
, defalt
, mustmatch
, initial
)
4088 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4090 Lisp_Object val
, insdef
, tem
;
4091 struct gcpro gcpro1
, gcpro2
;
4092 register char *homedir
;
4096 dir
= current_buffer
->directory
;
4098 defalt
= current_buffer
->filename
;
4100 /* If dir starts with user's homedir, change that to ~. */
4101 homedir
= (char *) egetenv ("HOME");
4104 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4105 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4107 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4108 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4109 XSTRING (dir
)->data
[0] = '~';
4112 if (!NILP (initial
))
4114 else if (insert_default_directory
)
4117 insdef
= build_string ("");
4120 count
= specpdl_ptr
- specpdl
;
4121 specbind (intern ("completion-ignore-case"), Qt
);
4124 GCPRO2 (insdef
, defalt
);
4125 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4127 insert_default_directory
? insdef
: Qnil
,
4128 Qfile_name_history
);
4131 unbind_to (count
, Qnil
);
4136 error ("No file name specified");
4137 tem
= Fstring_equal (val
, insdef
);
4138 if (!NILP (tem
) && !NILP (defalt
))
4140 return Fsubstitute_in_file_name (val
);
4142 #endif /* Old version */
4146 Qexpand_file_name
= intern ("expand-file-name");
4147 Qdirectory_file_name
= intern ("directory-file-name");
4148 Qfile_name_directory
= intern ("file-name-directory");
4149 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4150 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4151 Qfile_name_as_directory
= intern ("file-name-as-directory");
4152 Qcopy_file
= intern ("copy-file");
4153 Qmake_directory_internal
= intern ("make-directory-internal");
4154 Qdelete_directory
= intern ("delete-directory");
4155 Qdelete_file
= intern ("delete-file");
4156 Qrename_file
= intern ("rename-file");
4157 Qadd_name_to_file
= intern ("add-name-to-file");
4158 Qmake_symbolic_link
= intern ("make-symbolic-link");
4159 Qfile_exists_p
= intern ("file-exists-p");
4160 Qfile_executable_p
= intern ("file-executable-p");
4161 Qfile_readable_p
= intern ("file-readable-p");
4162 Qfile_symlink_p
= intern ("file-symlink-p");
4163 Qfile_writable_p
= intern ("file-writable-p");
4164 Qfile_directory_p
= intern ("file-directory-p");
4165 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4166 Qfile_modes
= intern ("file-modes");
4167 Qset_file_modes
= intern ("set-file-modes");
4168 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4169 Qinsert_file_contents
= intern ("insert-file-contents");
4170 Qwrite_region
= intern ("write-region");
4171 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4172 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4174 staticpro (&Qexpand_file_name
);
4175 staticpro (&Qdirectory_file_name
);
4176 staticpro (&Qfile_name_directory
);
4177 staticpro (&Qfile_name_nondirectory
);
4178 staticpro (&Qunhandled_file_name_directory
);
4179 staticpro (&Qfile_name_as_directory
);
4180 staticpro (&Qcopy_file
);
4181 staticpro (&Qmake_directory_internal
);
4182 staticpro (&Qdelete_directory
);
4183 staticpro (&Qdelete_file
);
4184 staticpro (&Qrename_file
);
4185 staticpro (&Qadd_name_to_file
);
4186 staticpro (&Qmake_symbolic_link
);
4187 staticpro (&Qfile_exists_p
);
4188 staticpro (&Qfile_executable_p
);
4189 staticpro (&Qfile_readable_p
);
4190 staticpro (&Qfile_symlink_p
);
4191 staticpro (&Qfile_writable_p
);
4192 staticpro (&Qfile_directory_p
);
4193 staticpro (&Qfile_accessible_directory_p
);
4194 staticpro (&Qfile_modes
);
4195 staticpro (&Qset_file_modes
);
4196 staticpro (&Qfile_newer_than_file_p
);
4197 staticpro (&Qinsert_file_contents
);
4198 staticpro (&Qwrite_region
);
4199 staticpro (&Qverify_visited_file_modtime
);
4201 Qfile_name_history
= intern ("file-name-history");
4202 Fset (Qfile_name_history
, Qnil
);
4203 staticpro (&Qfile_name_history
);
4205 Qfile_error
= intern ("file-error");
4206 staticpro (&Qfile_error
);
4207 Qfile_already_exists
= intern("file-already-exists");
4208 staticpro (&Qfile_already_exists
);
4211 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4212 staticpro (&Qfind_buffer_file_type
);
4215 Qcar_less_than_car
= intern ("car-less-than-car");
4216 staticpro (&Qcar_less_than_car
);
4218 Fput (Qfile_error
, Qerror_conditions
,
4219 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4220 Fput (Qfile_error
, Qerror_message
,
4221 build_string ("File error"));
4223 Fput (Qfile_already_exists
, Qerror_conditions
,
4224 Fcons (Qfile_already_exists
,
4225 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4226 Fput (Qfile_already_exists
, Qerror_message
,
4227 build_string ("File already exists"));
4229 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4230 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4231 insert_default_directory
= 1;
4233 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4234 "*Non-nil means write new files with record format `stmlf'.\n\
4235 nil means use format `var'. This variable is meaningful only on VMS.");
4236 vms_stmlf_recfm
= 0;
4238 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4239 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4240 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4243 The first argument given to HANDLER is the name of the I/O primitive\n\
4244 to be handled; the remaining arguments are the arguments that were\n\
4245 passed to that primitive. For example, if you do\n\
4246 (file-exists-p FILENAME)\n\
4247 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4248 (funcall HANDLER 'file-exists-p FILENAME)\n\
4249 The function `find-file-name-handler' checks this list for a handler\n\
4250 for its argument.");
4251 Vfile_name_handler_alist
= Qnil
;
4253 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4254 "A list of functions to be called at the end of `insert-file-contents'.\n\
4255 Each is passed one argument, the number of bytes inserted. It should return\n\
4256 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4257 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4258 responsible for calling the after-insert-file-functions if appropriate.");
4259 Vafter_insert_file_functions
= Qnil
;
4261 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4262 "A list of functions to be called at the start of `write-region'.\n\
4263 Each is passed two arguments, START and END as for `write-region'. It should\n\
4264 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4265 inserted at the specified positions of the file being written (1 means to\n\
4266 insert before the first byte written). The POSITIONs must be sorted into\n\
4267 increasing order. If there are several functions in the list, the several\n\
4268 lists are merged destructively.");
4269 Vwrite_region_annotate_functions
= Qnil
;
4271 DEFVAR_LISP ("write-region-annotations-so-far",
4272 &Vwrite_region_annotations_so_far
,
4273 "When an annotation function is called, this holds the previous annotations.\n\
4274 These are the annotations made by other annotation functions\n\
4275 that were already called. See also `write-region-annotate-functions'.");
4276 Vwrite_region_annotations_so_far
= Qnil
;
4278 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4279 "A list of file name handlers that temporarily should not be used.\n\
4280 This applies only to the operation `inhibit-file-name-operation'.");
4281 Vinhibit_file_name_handlers
= Qnil
;
4283 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4284 "The operation for which `inhibit-file-name-handlers' is applicable.");
4285 Vinhibit_file_name_operation
= Qnil
;
4287 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4288 "File name in which we write a list of all auto save file names.");
4289 Vauto_save_list_file_name
= Qnil
;
4291 defsubr (&Sfind_file_name_handler
);
4292 defsubr (&Sfile_name_directory
);
4293 defsubr (&Sfile_name_nondirectory
);
4294 defsubr (&Sunhandled_file_name_directory
);
4295 defsubr (&Sfile_name_as_directory
);
4296 defsubr (&Sdirectory_file_name
);
4297 defsubr (&Smake_temp_name
);
4298 defsubr (&Sexpand_file_name
);
4299 defsubr (&Ssubstitute_in_file_name
);
4300 defsubr (&Scopy_file
);
4301 defsubr (&Smake_directory_internal
);
4302 defsubr (&Sdelete_directory
);
4303 defsubr (&Sdelete_file
);
4304 defsubr (&Srename_file
);
4305 defsubr (&Sadd_name_to_file
);
4307 defsubr (&Smake_symbolic_link
);
4308 #endif /* S_IFLNK */
4310 defsubr (&Sdefine_logical_name
);
4313 defsubr (&Ssysnetunam
);
4314 #endif /* HPUX_NET */
4315 defsubr (&Sfile_name_absolute_p
);
4316 defsubr (&Sfile_exists_p
);
4317 defsubr (&Sfile_executable_p
);
4318 defsubr (&Sfile_readable_p
);
4319 defsubr (&Sfile_writable_p
);
4320 defsubr (&Sfile_symlink_p
);
4321 defsubr (&Sfile_directory_p
);
4322 defsubr (&Sfile_accessible_directory_p
);
4323 defsubr (&Sfile_regular_p
);
4324 defsubr (&Sfile_modes
);
4325 defsubr (&Sset_file_modes
);
4326 defsubr (&Sset_default_file_modes
);
4327 defsubr (&Sdefault_file_modes
);
4328 defsubr (&Sfile_newer_than_file_p
);
4329 defsubr (&Sinsert_file_contents
);
4330 defsubr (&Swrite_region
);
4331 defsubr (&Scar_less_than_car
);
4332 defsubr (&Sverify_visited_file_modtime
);
4333 defsubr (&Sclear_visited_file_modtime
);
4334 defsubr (&Svisited_file_modtime
);
4335 defsubr (&Sset_visited_file_modtime
);
4336 defsubr (&Sdo_auto_save
);
4337 defsubr (&Sset_buffer_auto_saved
);
4338 defsubr (&Sclear_buffer_auto_save_failure
);
4339 defsubr (&Srecent_auto_save_p
);
4341 defsubr (&Sread_file_name_internal
);
4342 defsubr (&Sread_file_name
);
4345 defsubr (&Sunix_sync
);