2 Copyright (C) 1985-1988, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1996 Ben Wing.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: Mule 2.0, FSF 19.30. */
23 /* More syncing: FSF Emacs 19.34.6 by Marc Paquette <marcpa@cam.org> */
34 #include "redisplay.h"
36 #include "window.h" /* minibuf_level */
38 #include "file-coding.h"
41 #ifdef HAVE_LIBGEN_H /* Must come before sysfile.h */
54 #endif /* HPUX_PRE_8_0 */
63 #endif /* not WINDOWSNT */
66 #define CORRECT_DIR_SEPS(s) \
67 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
68 else unixtodos_filename (s); \
70 #define IS_DRIVE(x) isalpha (x)
71 /* Need to lower-case the drive letter, or else expanded
72 filenames will sometimes compare inequal, because
73 `expand-file-name' doesn't always down-case the drive letter. */
74 #define DRIVE_LETTER(x) tolower (x)
75 #endif /* WINDOWSNT */
77 int lisp_to_time (Lisp_Object, time_t *);
78 Lisp_Object time_to_lisp (time_t);
80 /* Nonzero during writing of auto-save files */
81 static int auto_saving;
83 /* Set by auto_save_1 to mode of original file so Fwrite_region_internal
84 will create a new file with the same mode as the original */
85 static int auto_save_mode_bits;
87 /* Alist of elements (REGEXP . HANDLER) for file names
88 whose I/O is done with a special handler. */
89 Lisp_Object Vfile_name_handler_alist;
91 /* Format for auto-save files */
92 Lisp_Object Vauto_save_file_format;
94 /* Lisp functions for translating file formats */
95 Lisp_Object Qformat_decode, Qformat_annotate_function;
97 /* Functions to be called to process text properties in inserted file. */
98 Lisp_Object Vafter_insert_file_functions;
100 /* Functions to be called to create text property annotations for file. */
101 Lisp_Object Vwrite_region_annotate_functions;
103 /* During build_annotations, each time an annotation function is called,
104 this holds the annotations made by the previous functions. */
105 Lisp_Object Vwrite_region_annotations_so_far;
107 /* File name in which we write a list of all our auto save files. */
108 Lisp_Object Vauto_save_list_file_name;
110 int disable_auto_save_when_buffer_shrinks;
112 Lisp_Object Vdirectory_sep_char;
114 /* These variables describe handlers that have "already" had a chance
115 to handle the current operation.
117 Vinhibit_file_name_handlers is a list of file name handlers.
118 Vinhibit_file_name_operation is the operation being handled.
119 If we try to handle that operation, we ignore those handlers. */
121 static Lisp_Object Vinhibit_file_name_handlers;
122 static Lisp_Object Vinhibit_file_name_operation;
124 Lisp_Object Qfile_error, Qfile_already_exists;
126 Lisp_Object Qauto_save_hook;
127 Lisp_Object Qauto_save_error;
128 Lisp_Object Qauto_saving;
130 Lisp_Object Qcar_less_than_car;
132 Lisp_Object Qcompute_buffer_file_truename;
134 EXFUN (Frunning_temacs_p, 0);
136 /* signal a file error when errno contains a meaningful value. */
139 report_file_error (CONST char *string, Lisp_Object data)
141 /* #### dmoore - This uses current_buffer, better make sure no one
142 has GC'd the current buffer. File handlers are giving me a headache
143 maybe I'll just always protect current_buffer around all of those
146 signal_error (Qfile_error,
147 Fcons (build_translated_string (string),
148 Fcons (lisp_strerror (errno), data)));
152 maybe_report_file_error (CONST char *string, Lisp_Object data,
153 Lisp_Object class, Error_behavior errb)
156 if (ERRB_EQ (errb, ERROR_ME_NOT))
159 maybe_signal_error (Qfile_error,
160 Fcons (build_translated_string (string),
161 Fcons (lisp_strerror (errno), data)),
165 /* signal a file error when errno does not contain a meaningful value. */
168 signal_file_error (CONST char *string, Lisp_Object data)
170 signal_error (Qfile_error,
171 list2 (build_translated_string (string), data));
175 maybe_signal_file_error (CONST char *string, Lisp_Object data,
176 Lisp_Object class, Error_behavior errb)
179 if (ERRB_EQ (errb, ERROR_ME_NOT))
181 maybe_signal_error (Qfile_error,
182 list2 (build_translated_string (string), data),
187 signal_double_file_error (CONST char *string1, CONST char *string2,
190 signal_error (Qfile_error,
191 list3 (build_translated_string (string1),
192 build_translated_string (string2),
197 maybe_signal_double_file_error (CONST char *string1, CONST char *string2,
198 Lisp_Object data, Lisp_Object class,
202 if (ERRB_EQ (errb, ERROR_ME_NOT))
204 maybe_signal_error (Qfile_error,
205 list3 (build_translated_string (string1),
206 build_translated_string (string2),
212 signal_double_file_error_2 (CONST char *string1, CONST char *string2,
213 Lisp_Object data1, Lisp_Object data2)
215 signal_error (Qfile_error,
216 list4 (build_translated_string (string1),
217 build_translated_string (string2),
222 maybe_signal_double_file_error_2 (CONST char *string1, CONST char *string2,
223 Lisp_Object data1, Lisp_Object data2,
224 Lisp_Object class, Error_behavior errb)
227 if (ERRB_EQ (errb, ERROR_ME_NOT))
229 maybe_signal_error (Qfile_error,
230 list4 (build_translated_string (string1),
231 build_translated_string (string2),
237 /* Just like strerror(3), except return a lisp string instead of char *.
238 The string needs to be converted since it may be localized.
239 Perhaps this should use strerror-coding-system instead? */
241 lisp_strerror (int errnum)
243 return build_ext_string (strerror (errnum), FORMAT_NATIVE);
247 close_file_unwind (Lisp_Object fd)
251 if (INTP (XCAR (fd)))
252 close (XINT (XCAR (fd)));
254 free_cons (XCONS (fd));
263 delete_stream_unwind (Lisp_Object stream)
265 Lstream_delete (XLSTREAM (stream));
269 /* Restore point, having saved it as a marker. */
272 restore_point_unwind (Lisp_Object point_marker)
274 BUF_SET_PT (current_buffer, marker_position (point_marker));
275 return Fset_marker (point_marker, Qnil, Qnil);
278 /* Versions of read() and write() that allow quitting out of the actual
279 I/O. We don't use immediate_quit (i.e. direct longjmp() out of the
280 signal handler) because that's way too losing.
282 (#### Actually, longjmp()ing out of the signal handler may not be
283 as losing as I thought. See sys_do_signal() in sysdep.c.)
285 Solaris include files declare the return value as ssize_t.
288 read_allowing_quit (int fildes, void *buf, size_t size)
291 return sys_read_1 (fildes, buf, size, 1);
295 write_allowing_quit (int fildes, CONST void *buf, size_t size)
298 return sys_write_1 (fildes, buf, size, 1);
302 Lisp_Object Qexpand_file_name;
303 Lisp_Object Qfile_truename;
304 Lisp_Object Qsubstitute_in_file_name;
305 Lisp_Object Qdirectory_file_name;
306 Lisp_Object Qfile_name_directory;
307 Lisp_Object Qfile_name_nondirectory;
308 Lisp_Object Qunhandled_file_name_directory;
309 Lisp_Object Qfile_name_as_directory;
310 Lisp_Object Qcopy_file;
311 Lisp_Object Qmake_directory_internal;
312 Lisp_Object Qdelete_directory;
313 Lisp_Object Qdelete_file;
314 Lisp_Object Qrename_file;
315 Lisp_Object Qadd_name_to_file;
316 Lisp_Object Qmake_symbolic_link;
317 Lisp_Object Qfile_exists_p;
318 Lisp_Object Qfile_executable_p;
319 Lisp_Object Qfile_readable_p;
320 Lisp_Object Qfile_symlink_p;
321 Lisp_Object Qfile_writable_p;
322 Lisp_Object Qfile_directory_p;
323 Lisp_Object Qfile_regular_p;
324 Lisp_Object Qfile_accessible_directory_p;
325 Lisp_Object Qfile_modes;
326 Lisp_Object Qset_file_modes;
327 Lisp_Object Qfile_newer_than_file_p;
328 Lisp_Object Qinsert_file_contents;
329 Lisp_Object Qwrite_region;
330 Lisp_Object Qverify_visited_file_modtime;
331 Lisp_Object Qset_visited_file_modtime;
333 /* If FILENAME is handled specially on account of its syntax,
334 return its handler function. Otherwise, return nil. */
336 DEFUN ("find-file-name-handler", Ffind_file_name_handler, 1, 2, 0, /*
337 Return FILENAME's handler function for OPERATION, if it has one.
338 Otherwise, return nil.
339 A file name is handled if one of the regular expressions in
340 `file-name-handler-alist' matches it.
342 If OPERATION equals `inhibit-file-name-operation', then we ignore
343 any handlers that are members of `inhibit-file-name-handlers',
344 but we still do run any other handlers. This lets handlers
345 use the standard functions without calling themselves recursively.
347 (filename, operation))
349 /* This function does not GC */
350 /* This function can be called during GC */
351 /* This function must not munge the match data. */
352 Lisp_Object chain, inhibited_handlers;
354 CHECK_STRING (filename);
356 if (EQ (operation, Vinhibit_file_name_operation))
357 inhibited_handlers = Vinhibit_file_name_handlers;
359 inhibited_handlers = Qnil;
361 EXTERNAL_LIST_LOOP (chain, Vfile_name_handler_alist)
363 Lisp_Object elt = XCAR (chain);
366 Lisp_Object string = XCAR (elt);
368 && (fast_lisp_string_match (string, filename) >= 0))
370 Lisp_Object handler = XCDR (elt);
371 if (NILP (Fmemq (handler, inhibited_handlers)))
381 call2_check_string (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
383 /* This function can call lisp */
384 Lisp_Object result = call2 (fn, arg0, arg1);
385 CHECK_STRING (result);
390 call2_check_string_or_nil (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
392 /* This function can call lisp */
393 Lisp_Object result = call2 (fn, arg0, arg1);
395 CHECK_STRING (result);
400 call3_check_string (Lisp_Object fn, Lisp_Object arg0,
401 Lisp_Object arg1, Lisp_Object arg2)
403 /* This function can call lisp */
404 Lisp_Object result = call3 (fn, arg0, arg1, arg2);
405 CHECK_STRING (result);
410 DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /*
411 Return the directory component in file name NAME.
412 Return nil if NAME does not include a directory.
413 Otherwise return a directory spec.
414 Given a Unix syntax file name, returns a string ending in slash.
418 /* This function can GC. GC checked 1997.04.06. */
425 /* If the file name has special constructs in it,
426 call the corresponding file handler. */
427 handler = Ffind_file_name_handler (file, Qfile_name_directory);
429 return call2_check_string_or_nil (handler, Qfile_name_directory, file);
431 #ifdef FILE_SYSTEM_CASE
432 file = FILE_SYSTEM_CASE (file);
434 beg = XSTRING_DATA (file);
435 p = beg + XSTRING_LENGTH (file);
437 while (p != beg && !IS_ANY_SEP (p[-1])
439 /* only recognize drive specifier at beginning */
440 && !(p[-1] == ':' && p == beg + 2)
447 /* Expansion of "c:" to drive and default directory. */
448 /* (NT does the right thing.) */
449 if (p == beg + 2 && beg[1] == ':')
451 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
452 Bufbyte *res = alloca (MAXPATHLEN + 1);
453 if (getdefdir (toupper (*beg) - 'A' + 1, res))
455 char *c=((char *) res) + strlen ((char *) res);
456 if (!IS_DIRECTORY_SEP (*c))
458 *c++ = DIRECTORY_SEP;
462 p = beg + strlen ((char *) beg);
465 #endif /* WINDOWSNT */
466 return make_string (beg, p - beg);
469 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /*
470 Return file name NAME sans its directory.
471 For example, in a Unix-syntax file name,
472 this is everything after the last slash,
473 or the entire name if it contains no slash.
477 /* This function can GC. GC checked 1997.04.06. */
478 Bufbyte *beg, *p, *end;
483 /* If the file name has special constructs in it,
484 call the corresponding file handler. */
485 handler = Ffind_file_name_handler (file, Qfile_name_nondirectory);
487 return call2_check_string (handler, Qfile_name_nondirectory, file);
489 beg = XSTRING_DATA (file);
490 end = p = beg + XSTRING_LENGTH (file);
492 while (p != beg && !IS_ANY_SEP (p[-1])
494 /* only recognize drive specifier at beginning */
495 && !(p[-1] == ':' && p == beg + 2)
499 return make_string (p, end - p);
502 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /*
503 Return a directly usable directory name somehow associated with FILENAME.
504 A `directly usable' directory name is one that may be used without the
505 intervention of any file handler.
506 If FILENAME is a directly usable file itself, return
507 \(file-name-directory FILENAME).
508 The `call-process' and `start-process' functions use this function to
509 get a current directory to run processes in.
513 /* This function can GC. GC checked 1997.04.06. */
516 /* If the file name has special constructs in it,
517 call the corresponding file handler. */
518 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
520 return call2 (handler, Qunhandled_file_name_directory,
523 return Ffile_name_directory (filename);
528 file_name_as_directory (char *out, char *in)
530 int size = strlen (in);
535 out[1] = DIRECTORY_SEP;
541 /* Append a slash if necessary */
542 if (!IS_ANY_SEP (out[size-1]))
544 out[size] = DIRECTORY_SEP;
545 out[size + 1] = '\0';
551 DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /*
552 Return a string representing file FILENAME interpreted as a directory.
553 This operation exists because a directory is also a file, but its name as
554 a directory is different from its name as a file.
555 The result can be used as the value of `default-directory'
556 or passed as second argument to `expand-file-name'.
557 For a Unix-syntax file name, just appends a slash,
558 except for (file-name-as-directory \"\") => \"./\".
562 /* This function can GC. GC checked 1997.04.06. */
568 /* If the file name has special constructs in it,
569 call the corresponding file handler. */
570 handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
572 return call2_check_string (handler, Qfile_name_as_directory, file);
574 buf = (char *) alloca (XSTRING_LENGTH (file) + 10);
575 return build_string (file_name_as_directory
576 (buf, (char *) XSTRING_DATA (file)));
580 * Convert from directory name to filename.
581 * On UNIX, it's simple: just make sure there isn't a terminating /
583 * Value is nonzero if the string output is different from the input.
587 directory_file_name (CONST char *src, char *dst)
592 /* Process as Unix format: just remove any final slash.
593 But leave "/" unchanged; do not change it to "". */
596 /* Handle // as root for apollo's. */
597 if ((slen > 2 && dst[slen - 1] == '/')
598 || (slen > 1 && dst[0] != '/' && dst[slen - 1] == '/'))
602 && IS_DIRECTORY_SEP (dst[slen - 1])
604 && !IS_ANY_SEP (dst[slen - 2])
605 #endif /* WINDOWSNT */
612 DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
613 Return the file name of the directory named DIR.
614 This is the name of the file that holds the data for the directory DIR.
615 This operation exists because a directory is also a file, but its name as
616 a directory is different from its name as a file.
617 In Unix-syntax, this function just removes the final slash.
621 /* This function can GC. GC checked 1997.04.06. */
625 CHECK_STRING (directory);
627 #if 0 /* #### WTF? */
628 if (NILP (directory))
632 /* If the file name has special constructs in it,
633 call the corresponding file handler. */
634 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
636 return call2_check_string (handler, Qdirectory_file_name, directory);
637 buf = (char *) alloca (XSTRING_LENGTH (directory) + 20);
638 directory_file_name ((char *) XSTRING_DATA (directory), buf);
639 return build_string (buf);
642 /* Fmake_temp_name used to be a simple wrapper around mktemp(), but it
643 proved too broken for our purposes (it supported only 26 or 62
644 unique names under some implementations). For example, this
645 arbitrary limit broke generation of Gnus Incoming* files.
647 This implementation is better than what one usually finds in libc.
650 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
651 Generate temporary file name starting with PREFIX.
652 The Emacs process number forms part of the result, so there is no
653 danger of generating a name being used by another process.
655 In addition, this function makes an attempt to choose a name that
656 does not specify an existing file. To make this work, PREFIX should
657 be an absolute file name.
661 static char tbl[64] = {
662 'A','B','C','D','E','F','G','H',
663 'I','J','K','L','M','N','O','P',
664 'Q','R','S','T','U','V','W','X',
665 'Y','Z','a','b','c','d','e','f',
666 'g','h','i','j','k','l','m','n',
667 'o','p','q','r','s','t','u','v',
668 'w','x','y','z','0','1','2','3',
669 '4','5','6','7','8','9','-','_' };
670 static unsigned count, count_initialized_p;
677 CHECK_STRING (prefix);
679 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's
682 1) It might change the prefix, so the resulting string might not
683 begin with PREFIX. This violates the principle of least
686 2) It breaks under many unforeseeable circumstances, such as with
687 the code that uses (make-temp-name "") instead of
688 (make-temp-name "./").
690 3) It might yield unexpected (to stat(2)) results in the presence
691 of EFS and file name handlers. */
693 len = XSTRING_LENGTH (prefix);
694 val = make_uninit_string (len + 6);
695 data = XSTRING_DATA (val);
696 memcpy (data, XSTRING_DATA (prefix), len);
699 /* VAL is created by adding 6 characters to PREFIX. The first three
700 are the PID of this process, in base 64, and the second three are
701 incremented if the file already exists. This ensures 262144
702 unique file names per PID per PREFIX. */
704 pid = (unsigned)getpid ();
705 *p++ = tbl[pid & 63], pid >>= 6;
706 *p++ = tbl[pid & 63], pid >>= 6;
707 *p++ = tbl[pid & 63], pid >>= 6;
709 /* Here we try to minimize useless stat'ing when this function is
710 invoked many times successively with the same PREFIX. We achieve
711 this by initializing count to a random value, and incrementing it
713 if (!count_initialized_p)
715 count = (unsigned)time (NULL);
716 /* Dumping temacs with a non-zero count_initialized_p wouldn't
718 if (NILP (Frunning_temacs_p ()))
719 count_initialized_p = 1;
725 unsigned num = count;
727 p[0] = tbl[num & 63], num >>= 6;
728 p[1] = tbl[num & 63], num >>= 6;
729 p[2] = tbl[num & 63], num >>= 6;
731 /* Poor man's congruential RN generator. Replace with ++count
738 if (stat ((CONST char *) data, &ignored) < 0)
740 /* We want to return only if errno is ENOENT. */
744 /* The error here is dubious, but there is little else we
745 can do. The alternatives are to return nil, which is
746 as bad as (and in many cases worse than) throwing the
747 error, or to ignore the error, which will likely result
749 report_file_error ("Cannot create temporary name for prefix",
751 return Qnil; /* not reached */
757 DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /*
758 Convert filename NAME to absolute, and canonicalize it.
759 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
760 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
761 the current buffer's value of default-directory is used.
762 File name components that are `.' are removed, and
763 so are file name components followed by `..', along with the `..' itself;
764 note that these simplifications are done without checking the resulting
765 file names in the file system.
766 An initial `~/' expands to your home directory.
767 An initial `~USER/' expands to USER's home directory.
768 See also the function `substitute-in-file-name'.
770 (name, default_directory))
772 /* This function can GC */
775 Bufbyte *newdir, *p, *o;
780 int collapse_newdir = 1;
783 #endif /* WINDOWSNT */
792 /* If the file name has special constructs in it,
793 call the corresponding file handler. */
794 handler = Ffind_file_name_handler (name, Qexpand_file_name);
796 return call3_check_string (handler, Qexpand_file_name, name,
799 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
800 if (NILP (default_directory))
801 default_directory = current_buffer->directory;
802 if (! STRINGP (default_directory))
803 default_directory = build_string ("/");
805 if (!NILP (default_directory))
807 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
809 return call3 (handler, Qexpand_file_name, name, default_directory);
812 o = XSTRING_DATA (default_directory);
814 /* Make sure DEFAULT_DIRECTORY is properly expanded.
815 It would be better to do this down below where we actually use
816 default_directory. Unfortunately, calling Fexpand_file_name recursively
817 could invoke GC, and the strings might be relocated. This would
818 be annoying because we have pointers into strings lying around
819 that would need adjusting, and people would add new pointers to
820 the code and forget to adjust them, resulting in intermittent bugs.
821 Putting this call here avoids all that crud.
823 The EQ test avoids infinite recursion. */
824 if (! NILP (default_directory) && !EQ (default_directory, name)
825 /* Save time in some common cases - as long as default_directory
826 is not relative, it can be canonicalized with name below (if it
827 is needed at all) without requiring it to be expanded now. */
829 /* Detect MSDOS file names with drive specifiers. */
830 && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2])))
831 /* Detect Windows file names in UNC format. */
832 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
834 #else /* not WINDOWSNT */
836 /* Detect Unix absolute file names (/... alone is not absolute on
838 && ! (IS_DIRECTORY_SEP (o[0]))
839 #endif /* not WINDOWSNT */
845 default_directory = Fexpand_file_name (default_directory, Qnil);
849 #ifdef FILE_SYSTEM_CASE
850 name = FILE_SYSTEM_CASE (name);
853 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing
854 into name should be safe during all of this, though. */
855 nm = XSTRING_DATA (name);
858 /* We will force directory separators to be either all \ or /, so make
859 a local copy to modify, even if there ends up being no change. */
860 nm = strcpy (alloca (strlen (nm) + 1), nm);
862 /* Find and remove drive specifier if present; this makes nm absolute
863 even if the rest of the name appears to be relative. */
865 Bufbyte *colon = strrchr (nm, ':');
868 /* Only recognize colon as part of drive specifier if there is a
869 single alphabetic character preceding the colon (and if the
870 character before the drive letter, if present, is a directory
871 separator); this is to support the remote system syntax used by
872 ange-ftp, and the "po:username" syntax for POP mailboxes. */
876 else if (IS_DRIVE (colon[-1])
877 && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2])))
884 while (--colon >= nm)
890 /* If we see "c://somedir", we want to strip the first slash after the
891 colon when stripping the drive letter. Otherwise, this expands to
893 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
895 #endif /* WINDOWSNT */
897 /* If nm is absolute, look for /./ or /../ sequences; if none are
898 found, we can probably return right away. We will avoid allocating
899 a new string if name is already fully expanded. */
901 IS_DIRECTORY_SEP (nm[0])
903 && (drive || IS_DIRECTORY_SEP (nm[1]))
907 /* If it turns out that the filename we want to return is just a
908 suffix of FILENAME, we don't need to go through and edit
909 things; we just need to construct a new string using data
910 starting at the middle of FILENAME. If we set lose to a
911 non-zero value, that means we've discovered that we can't do
918 /* Since we know the name is absolute, we can assume that each
919 element starts with a "/". */
921 /* "." and ".." are hairy. */
922 if (IS_DIRECTORY_SEP (p[0])
924 && (IS_DIRECTORY_SEP (p[2])
926 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
934 /* Make sure directories are all separated with / or \ as
935 desired, but avoid allocation of a new string when not
937 CORRECT_DIR_SEPS (nm);
938 if (IS_DIRECTORY_SEP (nm[1]))
940 if (strcmp (nm, XSTRING_DATA (name)) != 0)
941 name = build_string (nm);
943 /* drive must be set, so this is okay */
944 else if (strcmp (nm - 2, XSTRING_DATA (name)) != 0)
946 name = make_string (nm - 2, p - nm + 2);
947 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
948 XSTRING_DATA (name)[1] = ':';
951 #else /* not WINDOWSNT */
952 if (nm == XSTRING_DATA (name))
954 return build_string ((char *) nm);
955 #endif /* not WINDOWSNT */
959 /* At this point, nm might or might not be an absolute file name. We
960 need to expand ~ or ~user if present, otherwise prefix nm with
961 default_directory if nm is not absolute, and finally collapse /./
962 and /foo/../ sequences.
964 We set newdir to be the appropriate prefix if one is needed:
965 - the relevant user directory if nm starts with ~ or ~user
966 - the specified drive's working dir (DOS/NT only) if nm does not
968 - the value of default_directory.
970 Note that these prefixes are not guaranteed to be absolute (except
971 for the working dir of a drive). Therefore, to ensure we always
972 return an absolute name, if the final prefix is not absolute we
973 append it to the current working directory. */
977 if (nm[0] == '~') /* prefix ~ */
979 if (IS_DIRECTORY_SEP (nm[1])
980 || nm[1] == 0) /* ~ by itself */
982 char * newdir_external = get_home_directory ();
984 if (newdir_external == NULL)
985 newdir = (Bufbyte *) "";
987 GET_C_CHARPTR_INT_FILENAME_DATA_ALLOCA (newdir_external, newdir);
994 else /* ~user/filename */
996 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++)
998 o = (Bufbyte *) alloca (p - nm + 1);
999 memcpy (o, (char *) nm, p - nm);
1002 /* #### marcpa's syncing note: FSF uses getpwnam even on NT,
1003 which does not work. The following works only if ~USER
1004 names the user who runs this instance of XEmacs. While
1005 NT is single-user (for the moment) you still can have
1006 multiple user profiles users defined, each with its HOME.
1007 Therefore, the following should be reworked to handle
1010 /* Now if the file given is "~foo/file" and HOME="c:/", then
1011 we want the file to be named "c:/file" ("~foo" becomes
1012 "c:/"). The variable o has "~foo", so we can use the
1013 length of that string to offset nm. August Hill, 31 Aug
1015 newdir = (Bufbyte *) get_home_directory();
1016 dostounix_filename (newdir);
1017 nm += strlen(o) + 1;
1018 #else /* not WINDOWSNT */
1020 if ((user = user_login_name (NULL)) != NULL)
1022 /* Does the user login name match the ~name? */
1023 if (strcmp(user,((char *) o + 1)) == 0)
1025 newdir = (Bufbyte *) get_home_directory();
1031 #endif /* __CYGWIN32__ */
1032 /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM
1033 occurring in it. (It can call select()). */
1034 slow_down_interrupts ();
1035 pw = (struct passwd *) getpwnam ((char *) o + 1);
1036 speed_up_interrupts ();
1039 newdir = (Bufbyte *) pw -> pw_dir;
1045 #endif /* not WINDOWSNT */
1047 /* If we don't find a user of that name, leave the name
1048 unchanged; don't move nm forward to p. */
1053 /* On DOS and Windows, nm is absolute if a drive name was specified;
1054 use the drive's current directory as the prefix if needed. */
1055 if (!newdir && drive)
1057 /* Get default directory if needed to make nm absolute. */
1058 if (!IS_DIRECTORY_SEP (nm[0]))
1060 newdir = alloca (MAXPATHLEN + 1);
1061 if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
1066 /* Either nm starts with /, or drive isn't mounted. */
1067 newdir = alloca (4);
1068 newdir[0] = DRIVE_LETTER (drive);
1074 #endif /* WINDOWSNT */
1076 /* Finally, if no prefix has been specified and nm is not absolute,
1077 then it must be expanded relative to default_directory. */
1081 /* /... alone is not absolute on DOS and Windows. */
1082 && !IS_DIRECTORY_SEP (nm[0])
1084 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
1088 newdir = XSTRING_DATA (default_directory);
1094 /* First ensure newdir is an absolute name. */
1096 /* Detect MSDOS file names with drive specifiers. */
1097 ! (IS_DRIVE (newdir[0])
1098 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
1099 /* Detect Windows file names in UNC format. */
1100 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1101 /* Detect drive spec by itself */
1102 && ! (IS_DEVICE_SEP (newdir[1]) && newdir[2] == 0)
1105 /* Effectively, let newdir be (expand-file-name newdir cwd).
1106 Because of the admonition against calling expand-file-name
1107 when we have pointers into lisp strings, we accomplish this
1108 indirectly by prepending newdir to nm if necessary, and using
1109 cwd (or the wd of newdir's drive) as the new newdir. */
1111 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1116 if (!IS_DIRECTORY_SEP (nm[0]))
1118 char * tmp = alloca (strlen (newdir) + strlen (nm) + 2);
1119 file_name_as_directory (tmp, newdir);
1123 newdir = alloca (MAXPATHLEN + 1);
1126 if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
1133 /* Strip off drive name from prefix, if present. */
1134 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1140 /* Keep only a prefix from newdir if nm starts with slash
1141 (/ /server/share for UNC, nothing otherwise). */
1142 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
1144 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1146 newdir = strcpy (alloca (strlen (newdir) + 1), newdir);
1148 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1150 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1157 #endif /* WINDOWSNT */
1161 /* Get rid of any slash at the end of newdir, unless newdir is
1162 just // (an incomplete UNC name). */
1163 length = strlen ((char *) newdir);
1164 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
1166 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
1170 Bufbyte *temp = (Bufbyte *) alloca (length);
1171 memcpy (temp, newdir, length - 1);
1172 temp[length - 1] = 0;
1180 /* Now concatenate the directory and name to new space in the stack frame */
1181 tlen += strlen ((char *) nm) + 1;
1183 /* Add reserved space for drive name. (The Microsoft x86 compiler
1184 produces incorrect code if the following two lines are combined.) */
1185 target = (Bufbyte *) alloca (tlen + 2);
1187 #else /* not WINDOWSNT */
1188 target = (Bufbyte *) alloca (tlen);
1189 #endif /* not WINDOWSNT */
1194 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
1195 strcpy ((char *) target, (char *) newdir);
1197 file_name_as_directory ((char *) target, (char *) newdir);
1200 strcat ((char *) target, (char *) nm);
1202 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1204 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1211 if (!IS_DIRECTORY_SEP (*p))
1215 else if (IS_DIRECTORY_SEP (p[0])
1217 && (IS_DIRECTORY_SEP (p[2])
1220 /* If "/." is the entire filename, keep the "/". Otherwise,
1221 just delete the whole "/.". */
1222 if (o == target && p[2] == '\0')
1226 else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
1227 /* `/../' is the "superroot" on certain file systems. */
1229 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
1231 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
1233 /* Keep initial / only if this is the whole name. */
1234 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
1239 /* if drive is set, we're not dealing with an UNC, so
1240 multiple dir-seps are redundant (and reportedly cause trouble
1242 else if (drive && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
1252 /* At last, set drive name, except for network file name. */
1256 target[0] = DRIVE_LETTER (drive);
1261 assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]));
1263 CORRECT_DIR_SEPS (target);
1264 #endif /* WINDOWSNT */
1266 return make_string (target, o - target);
1270 /* another older version of expand-file-name; */
1273 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /*
1274 Return the canonical name of the given FILE.
1275 Second arg DEFAULT is directory to start with if FILE is relative
1276 (does not start with slash); if DEFAULT is nil or missing,
1277 the current buffer's value of default-directory is used.
1278 No component of the resulting pathname will be a symbolic link, as
1279 in the realpath() function.
1281 (filename, default_))
1283 /* This function can GC. GC checked 1997.04.06. */
1284 Lisp_Object expanded_name;
1285 Lisp_Object handler;
1286 struct gcpro gcpro1;
1288 CHECK_STRING (filename);
1290 expanded_name = Fexpand_file_name (filename, default_);
1292 if (!STRINGP (expanded_name))
1295 GCPRO1 (expanded_name);
1296 handler = Ffind_file_name_handler (expanded_name, Qfile_truename);
1299 if (!NILP (handler))
1300 return call2_check_string (handler, Qfile_truename, expanded_name);
1303 char resolved_path[MAXPATHLEN];
1306 Extcount elen = XSTRING_LENGTH (expanded_name);
1308 GET_STRING_FILENAME_DATA_ALLOCA (expanded_name,path,elen);
1310 if (elen > MAXPATHLEN)
1313 /* Try doing it all at once. */
1314 /* !! Does realpath() Mule-encapsulate?
1315 Answer: Nope! So we do it above */
1316 if (!xrealpath ((char *) path, resolved_path))
1318 /* Didn't resolve it -- have to do it one component at a time. */
1319 /* "realpath" is a typically useless, stupid un*x piece of crap.
1320 It claims to return a useful value in the "error" case, but since
1321 there is no indication provided of how far along the pathname
1322 the function went before erring, there is no way to use the
1323 partial result returned. What a piece of junk. */
1326 p = (Extbyte *) memchr (p + 1, '/', elen - (p + 1 - path));
1330 /* memset (resolved_path, 0, sizeof (resolved_path)); */
1331 if (xrealpath ((char *) path, resolved_path))
1339 else if (errno == ENOENT || errno == EACCES)
1341 /* Failed on this component. Just tack on the rest of
1342 the string and we are done. */
1343 int rlen = strlen (resolved_path);
1345 /* "On failure, it returns NULL, sets errno to indicate
1346 the error, and places in resolved_path the absolute pathname
1347 of the path component which could not be resolved." */
1350 int plen = elen - (p - path);
1352 if (rlen > 1 && resolved_path[rlen - 1] == '/')
1355 if (plen + rlen + 1 > countof (resolved_path))
1358 resolved_path[rlen] = '/';
1359 memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1);
1369 int rlen = strlen (resolved_path);
1370 if (elen > 0 && XSTRING_BYTE (expanded_name, elen - 1) == '/'
1371 && !(rlen > 0 && resolved_path[rlen - 1] == '/'))
1373 if (rlen + 1 > countof (resolved_path))
1375 resolved_path[rlen] = '/';
1376 resolved_path[rlen + 1] = 0;
1379 return make_ext_string ((Bufbyte *) resolved_path, rlen, FORMAT_BINARY);
1383 errno = ENAMETOOLONG;
1386 report_file_error ("Finding truename", list1 (expanded_name));
1388 return Qnil; /* suppress compiler warning */
1392 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
1393 Substitute environment variables referred to in FILENAME.
1394 `$FOO' where FOO is an environment variable name means to substitute
1395 the value of that variable. The variable name should be terminated
1396 with a character not a letter, digit or underscore; otherwise, enclose
1397 the entire variable name in braces.
1398 If `/~' appears, all of FILENAME through that `/' is discarded.
1403 /* This function can GC. GC checked 1997.04.06. */
1406 Bufbyte *s, *p, *o, *x, *endp;
1407 Bufbyte *target = 0;
1409 int substituted = 0;
1411 Lisp_Object handler;
1413 CHECK_STRING (string);
1415 /* If the file name has special constructs in it,
1416 call the corresponding file handler. */
1417 handler = Ffind_file_name_handler (string, Qsubstitute_in_file_name);
1418 if (!NILP (handler))
1419 return call2_check_string_or_nil (handler, Qsubstitute_in_file_name,
1422 nm = XSTRING_DATA (string);
1423 endp = nm + XSTRING_LENGTH (string);
1425 /* If /~ or // appears, discard everything through first slash. */
1427 for (p = nm; p != endp; p++)
1430 #if defined (APOLLO) || defined (WINDOWSNT) || defined (__CYGWIN32__)
1431 /* // at start of file name is meaningful in Apollo and
1432 WindowsNT systems */
1433 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
1434 #else /* not (APOLLO || WINDOWSNT || __CYGWIN32__) */
1435 || IS_DIRECTORY_SEP (p[0])
1436 #endif /* not (APOLLO || WINDOWSNT || __CYGWIN32__) */
1439 && (IS_DIRECTORY_SEP (p[-1])))
1445 /* see comment in expand-file-name about drive specifiers */
1446 else if (IS_DRIVE (p[0]) && p[1] == ':'
1447 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1452 #endif /* WINDOWSNT */
1455 /* See if any variables are substituted into the string
1456 and find the total length of their values in `total' */
1458 for (p = nm; p != endp;)
1468 /* "$$" means a single "$" */
1477 while (p != endp && *p != '}') p++;
1478 if (*p != '}') goto missingclose;
1484 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1488 /* Copy out the variable name */
1489 target = (Bufbyte *) alloca (s - o + 1);
1490 strncpy ((char *) target, (char *) o, s - o);
1493 strupr (target); /* $home == $HOME etc. */
1494 #endif /* WINDOWSNT */
1496 /* Get variable value */
1497 o = (Bufbyte *) egetenv ((char *) target);
1498 if (!o) goto badvar;
1499 total += strlen ((char *) o);
1506 /* If substitution required, recopy the string and do it */
1507 /* Make space in stack frame for the new copy */
1508 xnm = (Bufbyte *) alloca (XSTRING_LENGTH (string) + total + 1);
1511 /* Copy the rest of the name through, replacing $ constructs with values */
1528 while (p != endp && *p != '}') p++;
1529 if (*p != '}') goto missingclose;
1535 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1539 /* Copy out the variable name */
1540 target = (Bufbyte *) alloca (s - o + 1);
1541 strncpy ((char *) target, (char *) o, s - o);
1544 strupr (target); /* $home == $HOME etc. */
1545 #endif /* WINDOWSNT */
1547 /* Get variable value */
1548 o = (Bufbyte *) egetenv ((char *) target);
1552 strcpy ((char *) x, (char *) o);
1553 x += strlen ((char *) o);
1558 /* If /~ or // appears, discard everything through first slash. */
1560 for (p = xnm; p != x; p++)
1562 #if defined (APOLLO) || defined (WINDOWSNT)
1563 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
1564 #else /* not (APOLLO || WINDOWSNT) */
1565 || IS_DIRECTORY_SEP (p[0])
1566 #endif /* APOLLO || WINDOWSNT */
1568 /* don't do p[-1] if that would go off the beginning --jwz */
1569 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1]))
1572 else if (IS_DRIVE (p[0]) && p[1] == ':'
1573 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1577 return make_string (xnm, x - xnm);
1580 error ("Bad format environment-variable substitution");
1582 error ("Missing \"}\" in environment-variable substitution");
1584 error ("Substituting nonexistent environment variable \"%s\"",
1588 return Qnil; /* suppress compiler warning */
1591 /* A slightly faster and more convenient way to get
1592 (directory-file-name (expand-file-name FOO)). */
1595 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
1597 /* This function can call lisp */
1598 Lisp_Object abspath;
1599 struct gcpro gcpro1;
1601 abspath = Fexpand_file_name (filename, defdir);
1603 /* Remove final slash, if any (unless path is root).
1604 stat behaves differently depending! */
1605 if (XSTRING_LENGTH (abspath) > 1
1606 && IS_DIRECTORY_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1))
1607 && !IS_DEVICE_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 2)))
1608 /* We cannot take shortcuts; they might be wrong for magic file names. */
1609 abspath = Fdirectory_file_name (abspath);
1614 /* Signal an error if the file ABSNAME already exists.
1615 If INTERACTIVE is nonzero, ask the user whether to proceed,
1616 and bypass the error if the user says to go ahead.
1617 QUERYSTRING is a name for the action that is being considered
1619 *STATPTR is used to store the stat information if the file exists.
1620 If the file does not exist, STATPTR->st_mode is set to 0. */
1623 barf_or_query_if_file_exists (Lisp_Object absname, CONST char *querystring,
1624 int interactive, struct stat *statptr)
1626 /* This function can GC. GC checked 1997.04.06. */
1627 struct stat statbuf;
1629 /* stat is a good way to tell whether the file exists,
1630 regardless of what access permissions it has. */
1631 if (stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0)
1638 struct gcpro gcpro1;
1640 prompt = emacs_doprnt_string_c
1641 ((CONST Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "),
1642 Qnil, -1, XSTRING_DATA (absname),
1643 GETTEXT (querystring));
1646 tem = call1 (Qyes_or_no_p, prompt);
1653 Fsignal (Qfile_already_exists,
1654 list2 (build_translated_string ("File already exists"),
1662 statptr->st_mode = 0;
1667 DEFUN ("copy-file", Fcopy_file, 2, 4,
1668 "fCopy file: \nFCopy %s to file: \np\nP", /*
1669 Copy FILE to NEWNAME. Both args must be strings.
1670 Signals a `file-already-exists' error if file NEWNAME already exists,
1671 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
1672 A number as third arg means request confirmation if NEWNAME already exists.
1673 This is what happens in interactive use with M-x.
1674 Fourth arg KEEP-TIME non-nil means give the new file the same
1675 last-modified time as the old one. (This works on only some systems.)
1676 A prefix arg makes KEEP-TIME non-nil.
1678 (filename, newname, ok_if_already_exists, keep_time))
1680 /* This function can GC. GC checked 1997.04.06. */
1682 char buf[16 * 1024];
1683 struct stat st, out_st;
1684 Lisp_Object handler;
1685 int speccount = specpdl_depth ();
1686 struct gcpro gcpro1, gcpro2;
1687 /* Lisp_Object args[6]; */
1688 int input_file_statable_p;
1690 GCPRO2 (filename, newname);
1691 CHECK_STRING (filename);
1692 CHECK_STRING (newname);
1693 filename = Fexpand_file_name (filename, Qnil);
1694 newname = Fexpand_file_name (newname, Qnil);
1696 /* If the input file name has special constructs in it,
1697 call the corresponding file handler. */
1698 handler = Ffind_file_name_handler (filename, Qcopy_file);
1699 /* Likewise for output file name. */
1701 handler = Ffind_file_name_handler (newname, Qcopy_file);
1702 if (!NILP (handler))
1705 return call5 (handler, Qcopy_file, filename, newname,
1706 ok_if_already_exists, keep_time);
1709 /* When second argument is a directory, copy the file into it.
1710 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
1712 if (!NILP (Ffile_directory_p (newname)))
1714 Lisp_Object args[3];
1715 struct gcpro ngcpro1;
1719 args[1] = Qnil; args[2] = Qnil;
1722 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
1723 args[i++] = build_string ("/");
1724 args[i++] = Ffile_name_nondirectory (filename);
1725 newname = Fconcat (i, args);
1729 if (NILP (ok_if_already_exists)
1730 || INTP (ok_if_already_exists))
1731 barf_or_query_if_file_exists (newname, "copy to it",
1732 INTP (ok_if_already_exists), &out_st);
1733 else if (stat ((CONST char *) XSTRING_DATA (newname), &out_st) < 0)
1736 ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0);
1738 report_file_error ("Opening input file", list1 (filename));
1740 record_unwind_protect (close_file_unwind, make_int (ifd));
1742 /* We can only copy regular files and symbolic links. Other files are not
1744 input_file_statable_p = (fstat (ifd, &st) >= 0);
1747 if (out_st.st_mode != 0
1748 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
1751 report_file_error ("Input and output files are the same",
1752 list2 (filename, newname));
1756 #if defined (S_ISREG) && defined (S_ISLNK)
1757 if (input_file_statable_p)
1759 if (!(S_ISREG (st.st_mode))
1760 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
1762 && !(S_ISCHR (st.st_mode))
1764 && !(S_ISLNK (st.st_mode)))
1766 #if defined (EISDIR)
1767 /* Get a better looking error message. */
1770 report_file_error ("Non-regular file", list1 (filename));
1773 #endif /* S_ISREG && S_ISLNK */
1775 ofd = open( (char *) XSTRING_DATA (newname),
1776 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
1778 report_file_error ("Opening output file", list1 (newname));
1781 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil);
1783 record_unwind_protect (close_file_unwind, ofd_locative);
1785 while ((n = read_allowing_quit (ifd, buf, sizeof (buf))) > 0)
1787 if (write_allowing_quit (ofd, buf, n) != n)
1788 report_file_error ("I/O error", list1 (newname));
1791 /* Closing the output clobbers the file times on some systems. */
1792 if (close (ofd) < 0)
1793 report_file_error ("I/O error", list1 (newname));
1795 if (input_file_statable_p)
1797 if (!NILP (keep_time))
1799 EMACS_TIME atime, mtime;
1800 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
1801 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
1802 if (set_file_times ((char *) XSTRING_DATA (newname), atime,
1804 report_file_error ("I/O error", list1 (newname));
1806 chmod ((CONST char *) XSTRING_DATA (newname),
1807 st.st_mode & 07777);
1810 /* We'll close it by hand */
1811 XCAR (ofd_locative) = Qnil;
1814 unbind_to (speccount, Qnil);
1821 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
1822 Create a directory. One argument, a file name string.
1826 /* This function can GC. GC checked 1997.04.06. */
1827 char dir [MAXPATHLEN];
1828 Lisp_Object handler;
1829 struct gcpro gcpro1;
1831 CHECK_STRING (dirname_);
1832 dirname_ = Fexpand_file_name (dirname_, Qnil);
1835 handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal);
1837 if (!NILP (handler))
1838 return (call2 (handler, Qmake_directory_internal, dirname_));
1840 if (XSTRING_LENGTH (dirname_) > (Bytecount) (sizeof (dir) - 1))
1842 return Fsignal (Qfile_error,
1843 list3 (build_translated_string ("Creating directory"),
1844 build_translated_string ("pathame too long"),
1847 strncpy (dir, (char *) XSTRING_DATA (dirname_),
1848 XSTRING_LENGTH (dirname_) + 1);
1850 if (dir [XSTRING_LENGTH (dirname_) - 1] == '/')
1851 dir [XSTRING_LENGTH (dirname_) - 1] = 0;
1853 if (mkdir (dir, 0777) != 0)
1854 report_file_error ("Creating directory", list1 (dirname_));
1859 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
1860 Delete a directory. One argument, a file name or directory name string.
1864 /* This function can GC. GC checked 1997.04.06. */
1865 Lisp_Object handler;
1866 struct gcpro gcpro1;
1868 CHECK_STRING (dirname_);
1871 dirname_ = Fexpand_file_name (dirname_, Qnil);
1872 dirname_ = Fdirectory_file_name (dirname_);
1874 handler = Ffind_file_name_handler (dirname_, Qdelete_directory);
1876 if (!NILP (handler))
1877 return (call2 (handler, Qdelete_directory, dirname_));
1879 if (rmdir ((char *) XSTRING_DATA (dirname_)) != 0)
1880 report_file_error ("Removing directory", list1 (dirname_));
1885 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
1886 Delete specified file. One argument, a file name string.
1887 If file has multiple names, it continues to exist with the other names.
1891 /* This function can GC. GC checked 1997.04.06. */
1892 Lisp_Object handler;
1893 struct gcpro gcpro1;
1895 CHECK_STRING (filename);
1896 filename = Fexpand_file_name (filename, Qnil);
1899 handler = Ffind_file_name_handler (filename, Qdelete_file);
1901 if (!NILP (handler))
1902 return call2 (handler, Qdelete_file, filename);
1904 if (0 > unlink ((char *) XSTRING_DATA (filename)))
1905 report_file_error ("Removing old name", list1 (filename));
1910 internal_delete_file_1 (Lisp_Object ignore, Lisp_Object ignore2)
1915 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1918 internal_delete_file (Lisp_Object filename)
1920 /* This function can GC. GC checked 1997.04.06. */
1921 return NILP (condition_case_1 (Qt, Fdelete_file, filename,
1922 internal_delete_file_1, Qnil));
1925 DEFUN ("rename-file", Frename_file, 2, 3,
1926 "fRename file: \nFRename %s to file: \np", /*
1927 Rename FILE as NEWNAME. Both args strings.
1928 If file has names other than FILE, it continues to have those names.
1929 Signals a `file-already-exists' error if a file NEWNAME already exists
1930 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1931 A number as third arg means request confirmation if NEWNAME already exists.
1932 This is what happens in interactive use with M-x.
1934 (filename, newname, ok_if_already_exists))
1936 /* This function can GC. GC checked 1997.04.06. */
1937 Lisp_Object handler;
1938 struct gcpro gcpro1, gcpro2;
1940 GCPRO2 (filename, newname);
1941 CHECK_STRING (filename);
1942 CHECK_STRING (newname);
1943 filename = Fexpand_file_name (filename, Qnil);
1944 newname = Fexpand_file_name (newname, Qnil);
1946 /* If the file name has special constructs in it,
1947 call the corresponding file handler. */
1948 handler = Ffind_file_name_handler (filename, Qrename_file);
1950 handler = Ffind_file_name_handler (newname, Qrename_file);
1951 if (!NILP (handler))
1954 return call4 (handler, Qrename_file,
1955 filename, newname, ok_if_already_exists);
1958 /* When second argument is a directory, rename the file into it.
1959 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
1961 if (!NILP (Ffile_directory_p (newname)))
1963 Lisp_Object args[3];
1964 struct gcpro ngcpro1;
1968 args[1] = Qnil; args[2] = Qnil;
1971 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
1972 args[i++] = build_string ("/");
1973 args[i++] = Ffile_name_nondirectory (filename);
1974 newname = Fconcat (i, args);
1978 if (NILP (ok_if_already_exists)
1979 || INTP (ok_if_already_exists))
1980 barf_or_query_if_file_exists (newname, "rename to it",
1981 INTP (ok_if_already_exists), 0);
1983 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
1984 WINDOWSNT here; I've removed it. --marcpa */
1986 /* FSFmacs only calls rename() here under BSD 4.1, and calls
1987 link() and unlink() otherwise, but that's bogus. Sometimes
1988 rename() succeeds where link()/unlink() fail, and we have
1989 configure check for rename() and emulate using link()/unlink()
1991 if (0 > rename ((char *) XSTRING_DATA (filename),
1992 (char *) XSTRING_DATA (newname)))
1996 Fcopy_file (filename, newname,
1997 /* We have already prompted if it was an integer,
1998 so don't have copy-file prompt again. */
1999 (NILP (ok_if_already_exists) ? Qnil : Qt),
2001 Fdelete_file (filename);
2005 report_file_error ("Renaming", list2 (filename, newname));
2012 DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3,
2013 "fAdd name to file: \nFName to add to %s: \np", /*
2014 Give FILE additional name NEWNAME. Both args strings.
2015 Signals a `file-already-exists' error if a file NEWNAME already exists
2016 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2017 A number as third arg means request confirmation if NEWNAME already exists.
2018 This is what happens in interactive use with M-x.
2020 (filename, newname, ok_if_already_exists))
2022 /* This function can GC. GC checked 1997.04.06. */
2023 Lisp_Object handler;
2024 struct gcpro gcpro1, gcpro2;
2026 GCPRO2 (filename, newname);
2027 CHECK_STRING (filename);
2028 CHECK_STRING (newname);
2029 filename = Fexpand_file_name (filename, Qnil);
2030 newname = Fexpand_file_name (newname, Qnil);
2032 /* If the file name has special constructs in it,
2033 call the corresponding file handler. */
2034 handler = Ffind_file_name_handler (filename, Qadd_name_to_file);
2035 if (!NILP (handler))
2036 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2037 newname, ok_if_already_exists));
2039 /* If the new name has special constructs in it,
2040 call the corresponding file handler. */
2041 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2042 if (!NILP (handler))
2043 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2044 newname, ok_if_already_exists));
2046 if (NILP (ok_if_already_exists)
2047 || INTP (ok_if_already_exists))
2048 barf_or_query_if_file_exists (newname, "make it a new name",
2049 INTP (ok_if_already_exists), 0);
2050 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
2051 on NT here. --marcpa */
2052 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
2053 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
2054 Reverted to previous behavior pending a working fix. (jhar) */
2055 #if defined(WINDOWSNT)
2056 /* Windows does not support this operation. */
2057 report_file_error ("Adding new name", Flist (2, &filename));
2058 #else /* not defined(WINDOWSNT) */
2060 unlink ((char *) XSTRING_DATA (newname));
2061 if (0 > link ((char *) XSTRING_DATA (filename),
2062 (char *) XSTRING_DATA (newname)))
2064 report_file_error ("Adding new name",
2065 list2 (filename, newname));
2067 #endif /* defined(WINDOWSNT) */
2074 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3,
2075 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
2076 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2077 Signals a `file-already-exists' error if a file LINKNAME already exists
2078 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2079 A number as third arg means request confirmation if LINKNAME already exists.
2080 This happens for interactive use with M-x.
2082 (filename, linkname, ok_if_already_exists))
2084 /* This function can GC. GC checked 1997.06.04. */
2085 Lisp_Object handler;
2086 struct gcpro gcpro1, gcpro2;
2088 GCPRO2 (filename, linkname);
2089 CHECK_STRING (filename);
2090 CHECK_STRING (linkname);
2091 /* If the link target has a ~, we must expand it to get
2092 a truly valid file name. Otherwise, do not expand;
2093 we want to permit links to relative file names. */
2094 if (XSTRING_BYTE (filename, 0) == '~')
2095 filename = Fexpand_file_name (filename, Qnil);
2096 linkname = Fexpand_file_name (linkname, Qnil);
2098 /* If the file name has special constructs in it,
2099 call the corresponding file handler. */
2100 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
2101 if (!NILP (handler))
2102 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname,
2103 ok_if_already_exists));
2105 /* If the new link name has special constructs in it,
2106 call the corresponding file handler. */
2107 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2108 if (!NILP (handler))
2109 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2110 linkname, ok_if_already_exists));
2112 if (NILP (ok_if_already_exists)
2113 || INTP (ok_if_already_exists))
2114 barf_or_query_if_file_exists (linkname, "make it a link",
2115 INTP (ok_if_already_exists), 0);
2117 unlink ((char *) XSTRING_DATA (linkname));
2118 if (0 > symlink ((char *) XSTRING_DATA (filename),
2119 (char *) XSTRING_DATA (linkname)))
2121 report_file_error ("Making symbolic link",
2122 list2 (filename, linkname));
2127 #endif /* S_IFLNK */
2131 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
2132 Open a network connection to PATH using LOGIN as the login string.
2138 CHECK_STRING (path);
2139 CHECK_STRING (login);
2141 /* netunam, being a strange-o system call only used once, is not
2147 GET_C_STRING_FILENAME_DATA_ALLOCA (path, path_ext);
2148 GET_C_STRING_EXT_DATA_ALLOCA (login, FORMAT_OS, login_ext);
2150 netresult = netunam (path_ext, login_ext);
2153 if (netresult == -1)
2158 #endif /* HPUX_NET */
2160 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
2161 Return t if file FILENAME specifies an absolute path name.
2162 On Unix, this is a name starting with a `/' or a `~'.
2166 /* This function does not GC */
2169 CHECK_STRING (filename);
2170 ptr = XSTRING_DATA (filename);
2171 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
2173 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
2178 /* Return nonzero if file FILENAME exists and can be executed. */
2181 check_executable (char *filename)
2185 if (stat (filename, &st) < 0)
2187 return ((st.st_mode & S_IEXEC) != 0);
2188 #else /* not WINDOWSNT */
2190 return eaccess (filename, 1) >= 0;
2192 /* Access isn't quite right because it uses the real uid
2193 and we really want to test with the effective uid.
2194 But Unix doesn't give us a right way to do it. */
2195 return access (filename, 1) >= 0;
2196 #endif /* HAVE_EACCESS */
2197 #endif /* not WINDOWSNT */
2200 /* Return nonzero if file FILENAME exists and can be written. */
2203 check_writable (CONST char *filename)
2206 return (eaccess (filename, 2) >= 0);
2208 /* Access isn't quite right because it uses the real uid
2209 and we really want to test with the effective uid.
2210 But Unix doesn't give us a right way to do it.
2211 Opening with O_WRONLY could work for an ordinary file,
2212 but would lose for directories. */
2213 return (access (filename, 2) >= 0);
2217 DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
2218 Return t if file FILENAME exists. (This does not mean you can read it.)
2219 See also `file-readable-p' and `file-attributes'.
2223 /* This function can call lisp */
2224 Lisp_Object abspath;
2225 Lisp_Object handler;
2226 struct stat statbuf;
2227 struct gcpro gcpro1;
2229 CHECK_STRING (filename);
2230 abspath = Fexpand_file_name (filename, Qnil);
2232 /* If the file name has special constructs in it,
2233 call the corresponding file handler. */
2235 handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
2237 if (!NILP (handler))
2238 return call2 (handler, Qfile_exists_p, abspath);
2240 return stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
2243 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
2244 Return t if FILENAME can be executed by you.
2245 For a directory, this means you can access files in that directory.
2250 /* This function can GC. GC checked 1997.04.10. */
2251 Lisp_Object abspath;
2252 Lisp_Object handler;
2253 struct gcpro gcpro1;
2255 CHECK_STRING (filename);
2256 abspath = Fexpand_file_name (filename, Qnil);
2258 /* If the file name has special constructs in it,
2259 call the corresponding file handler. */
2261 handler = Ffind_file_name_handler (abspath, Qfile_executable_p);
2263 if (!NILP (handler))
2264 return call2 (handler, Qfile_executable_p, abspath);
2266 return check_executable ((char *) XSTRING_DATA (abspath)) ? Qt : Qnil;
2269 DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
2270 Return t if file FILENAME exists and you can read it.
2271 See also `file-exists-p' and `file-attributes'.
2275 /* This function can GC */
2276 Lisp_Object abspath = Qnil;
2277 Lisp_Object handler;
2278 struct gcpro gcpro1;
2281 CHECK_STRING (filename);
2282 abspath = Fexpand_file_name (filename, Qnil);
2284 /* If the file name has special constructs in it,
2285 call the corresponding file handler. */
2286 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
2287 if (!NILP (handler))
2288 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
2290 #if defined(WINDOWSNT) || defined(__CYGWIN32__)
2291 /* Under MS-DOS and Windows, open does not work for directories. */
2293 if (access (XSTRING_DATA (abspath), 0) == 0)
2297 #else /* not WINDOWSNT */
2299 int desc = interruptible_open ((char *) XSTRING_DATA (abspath), O_RDONLY | OPEN_BINARY, 0);
2306 #endif /* not WINDOWSNT */
2309 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2311 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
2312 Return t if file FILENAME can be written or created by you.
2316 /* This function can GC. GC checked 1997.04.10. */
2317 Lisp_Object abspath, dir;
2318 Lisp_Object handler;
2319 struct stat statbuf;
2320 struct gcpro gcpro1;
2322 CHECK_STRING (filename);
2323 abspath = Fexpand_file_name (filename, Qnil);
2325 /* If the file name has special constructs in it,
2326 call the corresponding file handler. */
2328 handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
2330 if (!NILP (handler))
2331 return call2 (handler, Qfile_writable_p, abspath);
2333 if (stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0)
2334 return (check_writable ((char *) XSTRING_DATA (abspath))
2339 dir = Ffile_name_directory (abspath);
2341 return (check_writable (!NILP (dir) ? (char *) XSTRING_DATA (dir)
2346 DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
2347 Return non-nil if file FILENAME is the name of a symbolic link.
2348 The value is the name of the file to which it is linked.
2349 Otherwise returns nil.
2353 /* This function can GC. GC checked 1997.04.10. */
2359 Lisp_Object handler;
2360 struct gcpro gcpro1;
2362 CHECK_STRING (filename);
2363 filename = Fexpand_file_name (filename, Qnil);
2365 /* If the file name has special constructs in it,
2366 call the corresponding file handler. */
2368 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
2370 if (!NILP (handler))
2371 return call2 (handler, Qfile_symlink_p, filename);
2376 buf = xnew_array_and_zero (char, bufsize);
2377 valsize = readlink ((char *) XSTRING_DATA (filename),
2379 if (valsize < bufsize) break;
2380 /* Buffer was not long enough */
2389 val = make_string ((Bufbyte *) buf, valsize);
2392 #else /* not S_IFLNK */
2394 #endif /* not S_IFLNK */
2397 DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
2398 Return t if file FILENAME is the name of a directory as a file.
2399 A directory name spec may be given instead; then the value is t
2400 if the directory so specified exists and really is a directory.
2404 /* This function can GC. GC checked 1997.04.10. */
2405 Lisp_Object abspath;
2407 Lisp_Object handler;
2408 struct gcpro gcpro1;
2410 GCPRO1 (current_buffer->directory);
2411 abspath = expand_and_dir_to_file (filename,
2412 current_buffer->directory);
2415 /* If the file name has special constructs in it,
2416 call the corresponding file handler. */
2418 handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
2420 if (!NILP (handler))
2421 return call2 (handler, Qfile_directory_p, abspath);
2423 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2425 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2428 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
2429 Return t if file FILENAME is the name of a directory as a file,
2430 and files in that directory can be opened by you. In order to use a
2431 directory as a buffer's current directory, this predicate must return true.
2432 A directory name spec may be given instead; then the value is t
2433 if the directory so specified exists and really is a readable and
2434 searchable directory.
2438 /* This function can GC. GC checked 1997.04.10. */
2439 Lisp_Object handler;
2441 /* If the file name has special constructs in it,
2442 call the corresponding file handler. */
2443 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
2444 if (!NILP (handler))
2445 return call2 (handler, Qfile_accessible_directory_p,
2448 #if !defined(WINDOWSNT)
2449 if (NILP (Ffile_directory_p (filename)))
2452 return Ffile_executable_p (filename);
2456 struct gcpro gcpro1;
2457 /* It's an unlikely combination, but yes we really do need to gcpro:
2458 Suppose that file-accessible-directory-p has no handler, but
2459 file-directory-p does have a handler; this handler causes a GC which
2460 relocates the string in `filename'; and finally file-directory-p
2461 returns non-nil. Then we would end up passing a garbaged string
2462 to file-executable-p. */
2464 tem = (NILP (Ffile_directory_p (filename))
2465 || NILP (Ffile_executable_p (filename)));
2467 return tem ? Qnil : Qt;
2469 #endif /* !defined(WINDOWSNT) */
2472 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
2473 Return t if file FILENAME is the name of a regular file.
2474 This is the sort of file that holds an ordinary stream of data bytes.
2478 /* This function can GC. GC checked 1997.04.10. */
2479 Lisp_Object abspath;
2481 Lisp_Object handler;
2482 struct gcpro gcpro1;
2484 GCPRO1 (current_buffer->directory);
2485 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
2488 /* If the file name has special constructs in it,
2489 call the corresponding file handler. */
2491 handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
2493 if (!NILP (handler))
2494 return call2 (handler, Qfile_regular_p, abspath);
2496 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2498 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2501 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
2502 Return mode bits of FILE, as an integer.
2506 /* This function can GC. GC checked 1997.04.10. */
2507 Lisp_Object abspath;
2509 Lisp_Object handler;
2510 struct gcpro gcpro1;
2512 GCPRO1 (current_buffer->directory);
2513 abspath = expand_and_dir_to_file (filename,
2514 current_buffer->directory);
2517 /* If the file name has special constructs in it,
2518 call the corresponding file handler. */
2520 handler = Ffind_file_name_handler (abspath, Qfile_modes);
2522 if (!NILP (handler))
2523 return call2 (handler, Qfile_modes, abspath);
2525 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2527 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
2530 if (check_executable (XSTRING_DATA (abspath)))
2531 st.st_mode |= S_IEXEC;
2535 return make_int (st.st_mode & 07777);
2538 DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /*
2539 Set mode bits of FILE to MODE (an integer).
2540 Only the 12 low bits of MODE are used.
2544 /* This function can GC. GC checked 1997.04.10. */
2545 Lisp_Object abspath;
2546 Lisp_Object handler;
2547 struct gcpro gcpro1;
2549 GCPRO1 (current_buffer->directory);
2550 abspath = Fexpand_file_name (filename, current_buffer->directory);
2555 /* If the file name has special constructs in it,
2556 call the corresponding file handler. */
2558 handler = Ffind_file_name_handler (abspath, Qset_file_modes);
2560 if (!NILP (handler))
2561 return call3 (handler, Qset_file_modes, abspath, mode);
2563 if (chmod ((char *) XSTRING_DATA (abspath), XINT (mode)) < 0)
2564 report_file_error ("Doing chmod", list1 (abspath));
2569 DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
2570 Set the file permission bits for newly created files.
2571 MASK should be an integer; if a permission's bit in MASK is 1,
2572 subsequently created files will not have that permission enabled.
2573 Only the low 9 bits are used.
2574 This setting is inherited by subprocesses.
2580 umask ((~ XINT (mode)) & 0777);
2585 DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
2586 Return the default file protection for created files.
2587 The umask value determines which permissions are enabled in newly
2588 created files. If a permission's bit in the umask is 1, subsequently
2589 created files will not have that permission enabled.
2598 return make_int ((~ mode) & 0777);
2601 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /*
2602 Tell Unix to finish all pending disk updates.
2613 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
2614 Return t if file FILE1 is newer than file FILE2.
2615 If FILE1 does not exist, the answer is nil;
2616 otherwise, if FILE2 does not exist, the answer is t.
2620 /* This function can GC. GC checked 1997.04.10. */
2621 Lisp_Object abspath1, abspath2;
2624 Lisp_Object handler;
2625 struct gcpro gcpro1, gcpro2, gcpro3;
2627 CHECK_STRING (file1);
2628 CHECK_STRING (file2);
2633 GCPRO3 (abspath1, abspath2, current_buffer->directory);
2634 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
2635 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
2637 /* If the file name has special constructs in it,
2638 call the corresponding file handler. */
2639 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p);
2641 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p);
2643 if (!NILP (handler))
2644 return call3 (handler, Qfile_newer_than_file_p, abspath1,
2647 if (stat ((char *) XSTRING_DATA (abspath1), &st) < 0)
2650 mtime1 = st.st_mtime;
2652 if (stat ((char *) XSTRING_DATA (abspath2), &st) < 0)
2655 return (mtime1 > st.st_mtime) ? Qt : Qnil;
2659 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
2660 /* #define READ_BUF_SIZE (2 << 16) */
2661 #define READ_BUF_SIZE (1 << 15)
2663 DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal,
2665 Insert contents of file FILENAME after point; no coding-system frobbing.
2666 This function is identical to `insert-file-contents' except for the
2667 handling of the CODESYS and USED-CODESYS arguments under
2668 XEmacs/Mule. (When Mule support is not present, both functions are
2669 identical and ignore the CODESYS and USED-CODESYS arguments.)
2671 If support for Mule exists in this Emacs, the file is decoded according
2672 to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil,
2673 it should be a symbol, and the actual coding system that was used for the
2674 decoding is stored into it. It will in general be different from CODESYS
2675 if CODESYS specifies automatic encoding detection or end-of-line detection.
2677 Currently BEG and END refer to byte positions (as opposed to character
2678 positions), even in Mule. (Fixing this is very difficult.)
2680 (filename, visit, beg, end, replace, codesys, used_codesys))
2682 /* This function can call lisp */
2683 /* #### dmoore - this function hasn't been checked for gc recently */
2687 Charcount inserted = 0;
2689 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2690 Lisp_Object handler = Qnil, val;
2692 Bufbyte read_buf[READ_BUF_SIZE];
2694 struct buffer *buf = current_buffer;
2696 int not_regular = 0;
2698 if (buf->base_buffer && ! NILP (visit))
2699 error ("Cannot do file visiting in an indirect buffer");
2701 /* No need to call Fbarf_if_buffer_read_only() here.
2702 That's called in begin_multiple_change() or wherever. */
2706 /* #### dmoore - should probably check in various places to see if
2707 curbuf was killed and if so signal an error? */
2709 XSETBUFFER (curbuf, buf);
2711 GCPRO5 (filename, val, visit, handler, curbuf);
2713 mc_count = (NILP (replace)) ?
2714 begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) :
2715 begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf));
2717 speccount = specpdl_depth (); /* begin_multiple_change also adds
2718 an unwind_protect */
2720 filename = Fexpand_file_name (filename, Qnil);
2722 /* If the file name has special constructs in it,
2723 call the corresponding file handler. */
2724 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
2725 if (!NILP (handler))
2727 val = call6 (handler, Qinsert_file_contents, filename,
2728 visit, beg, end, replace);
2733 if (!NILP (used_codesys))
2734 CHECK_SYMBOL (used_codesys);
2737 if ( (!NILP (beg) || !NILP (end)) && !NILP (visit) )
2738 error ("Attempt to visit less than an entire file");
2744 (stat ((char *) XSTRING_DATA (filename), &st) < 0)
2746 /* Don't even bother with interruptible_open. APOLLO sucks. */
2747 ((fd = open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0)) < 0
2748 || fstat (fd, &st) < 0)
2752 if (fd >= 0) close (fd);
2755 report_file_error ("Opening input file", list1 (filename));
2761 /* Signal an error if we are accessing a non-regular file, with
2762 REPLACE, BEG or END being non-nil. */
2763 if (!S_ISREG (st.st_mode))
2770 if (!NILP (replace) || !NILP (beg) || !NILP (end))
2772 end_multiple_change (buf, mc_count);
2774 return Fsignal (Qfile_error,
2775 list2 (build_translated_string("not a regular file"),
2779 #endif /* S_IFREG */
2791 if ((fd = interruptible_open ((char *) XSTRING_DATA (filename),
2792 O_RDONLY | OPEN_BINARY, 0)) < 0)
2796 /* Replacement should preserve point as it preserves markers. */
2797 if (!NILP (replace))
2798 record_unwind_protect (restore_point_unwind, Fpoint_marker (Qnil, Qnil));
2800 record_unwind_protect (close_file_unwind, make_int (fd));
2802 /* Supposedly happens on VMS. */
2804 error ("File size is negative");
2810 end = make_int (st.st_size);
2811 if (XINT (end) != st.st_size)
2812 error ("Maximum buffer size exceeded");
2816 /* If requested, replace the accessible part of the buffer
2817 with the file contents. Avoid replacing text at the
2818 beginning or end of the buffer that matches the file contents;
2819 that preserves markers pointing to the unchanged parts. */
2820 #if !defined (FILE_CODING)
2821 /* The replace-mode code currently only works when the assumption
2822 'one byte == one char' holds true. This fails Mule because
2823 files may contain multibyte characters. It holds under Windows NT
2824 provided we convert CRLF into LF. */
2825 # define FSFMACS_SPEEDY_INSERT
2826 #endif /* !defined (FILE_CODING) */
2828 #ifndef FSFMACS_SPEEDY_INSERT
2829 if (!NILP (replace))
2831 buffer_delete_range (buf, BUF_BEG (buf), BUF_Z (buf),
2832 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2834 #else /* FSFMACS_SPEEDY_INSERT */
2835 if (!NILP (replace))
2837 char buffer[1 << 14];
2838 Bufpos same_at_start = BUF_BEGV (buf);
2839 Bufpos same_at_end = BUF_ZV (buf);
2842 /* Count how many chars at the start of the file
2843 match the text at the beginning of the buffer. */
2848 nread = read_allowing_quit (fd, buffer, sizeof buffer);
2850 error ("IO error reading %s: %s",
2851 XSTRING_DATA (filename), strerror (errno));
2852 else if (nread == 0)
2855 while (bufpos < nread && same_at_start < BUF_ZV (buf)
2856 && BUF_FETCH_CHAR (buf, same_at_start) == buffer[bufpos])
2857 same_at_start++, bufpos++;
2858 /* If we found a discrepancy, stop the scan.
2859 Otherwise loop around and scan the next bufferful. */
2860 if (bufpos != nread)
2863 /* If the file matches the buffer completely,
2864 there's no need to replace anything. */
2865 if (same_at_start - BUF_BEGV (buf) == st.st_size)
2868 unbind_to (speccount, Qnil);
2869 /* Truncate the buffer to the size of the file. */
2870 buffer_delete_range (buf, same_at_start, same_at_end,
2871 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2874 /* Count how many chars at the end of the file
2875 match the text at the end of the buffer. */
2878 int total_read, nread;
2879 Bufpos bufpos, curpos, trial;
2881 /* At what file position are we now scanning? */
2882 curpos = st.st_size - (BUF_ZV (buf) - same_at_end);
2883 /* If the entire file matches the buffer tail, stop the scan. */
2886 /* How much can we scan in the next step? */
2887 trial = min (curpos, (Bufpos) sizeof (buffer));
2888 if (lseek (fd, curpos - trial, 0) < 0)
2889 report_file_error ("Setting file position", list1 (filename));
2892 while (total_read < trial)
2894 nread = read_allowing_quit (fd, buffer + total_read,
2895 trial - total_read);
2897 report_file_error ("IO error reading file", list1 (filename));
2898 total_read += nread;
2900 /* Scan this bufferful from the end, comparing with
2901 the Emacs buffer. */
2902 bufpos = total_read;
2903 /* Compare with same_at_start to avoid counting some buffer text
2904 as matching both at the file's beginning and at the end. */
2905 while (bufpos > 0 && same_at_end > same_at_start
2906 && BUF_FETCH_CHAR (buf, same_at_end - 1) ==
2908 same_at_end--, bufpos--;
2909 /* If we found a discrepancy, stop the scan.
2910 Otherwise loop around and scan the preceding bufferful. */
2913 /* If display current starts at beginning of line,
2914 keep it that way. */
2915 if (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == buf)
2916 XWINDOW (Fselected_window (Qnil))->start_at_line_beg =
2917 !NILP (Fbolp (make_buffer (buf)));
2920 /* Don't try to reuse the same piece of text twice. */
2921 overlap = same_at_start - BUF_BEGV (buf) -
2922 (same_at_end + st.st_size - BUF_ZV (buf));
2924 same_at_end += overlap;
2926 /* Arrange to read only the nonmatching middle part of the file. */
2927 beg = make_int (same_at_start - BUF_BEGV (buf));
2928 end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end));
2930 buffer_delete_range (buf, same_at_start, same_at_end,
2931 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2932 /* Insert from the file at the proper position. */
2933 BUF_SET_PT (buf, same_at_start);
2935 #endif /* FSFMACS_SPEEDY_INSERT */
2939 total = XINT (end) - XINT (beg);
2941 /* Make sure point-max won't overflow after this insertion. */
2942 if (total != XINT (make_int (total)))
2943 error ("Maximum buffer size exceeded");
2946 /* For a special file, all we can do is guess. The value of -1
2947 will make the stream functions read as much as possible. */
2951 #ifdef FSFMACS_SPEEDY_INSERT
2952 /* why was this here? asked jwz. The reason is that the replace-mode
2953 connivings above will normally put the file pointer other than
2954 where it should be. */
2956 #endif /* !FSFMACS_SPEEDY_INSERT */
2959 if (lseek (fd, XINT (beg), 0) < 0)
2960 report_file_error ("Setting file position", list1 (filename));
2964 Bufpos cur_point = BUF_PT (buf);
2965 struct gcpro ngcpro1;
2966 Lisp_Object stream = make_filedesc_input_stream (fd, 0, total,
2970 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2972 stream = make_decoding_input_stream
2973 (XLSTREAM (stream), Fget_coding_system (codesys));
2974 Lstream_set_character_mode (XLSTREAM (stream));
2975 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2976 #endif /* FILE_CODING */
2978 record_unwind_protect (delete_stream_unwind, stream);
2980 /* No need to limit the amount of stuff we attempt to read. (It would
2981 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
2982 occurs inside of the filedesc stream. */
2986 Charcount cc_inserted;
2989 this_len = Lstream_read (XLSTREAM (stream), read_buf,
2999 cc_inserted = buffer_insert_raw_string_1 (buf, cur_point, read_buf,
3002 ? INSDEL_NO_LOCKING : 0);
3003 inserted += cc_inserted;
3004 cur_point += cc_inserted;
3007 if (!NILP (used_codesys))
3010 XCODING_SYSTEM_NAME (decoding_stream_coding_system (XLSTREAM (stream))));
3012 #endif /* FILE_CODING */
3016 /* Close the file/stream */
3017 unbind_to (speccount, Qnil);
3021 error ("IO error reading %s: %s",
3022 XSTRING_DATA (filename), strerror (saverrno));
3028 end_multiple_change (buf, mc_count);
3032 if (!EQ (buf->undo_list, Qt))
3033 buf->undo_list = Qnil;
3035 stat ((char *) XSTRING_DATA (filename), &st);
3039 buf->modtime = st.st_mtime;
3040 buf->filename = filename;
3041 /* XEmacs addition: */
3042 /* This function used to be in C, ostensibly so that
3043 it could be called here. But that's just silly.
3044 There's no reason C code can't call out to Lisp
3045 code, and it's a lot cleaner this way. */
3046 if (!NILP (Ffboundp (Qcompute_buffer_file_truename)))
3047 call1 (Qcompute_buffer_file_truename, make_buffer (buf));
3049 BUF_SAVE_MODIFF (buf) = BUF_MODIFF (buf);
3050 buf->auto_save_modified = BUF_MODIFF (buf);
3051 buf->saved_size = make_int (BUF_SIZE (buf));
3052 #ifdef CLASH_DETECTION
3055 if (!NILP (buf->file_truename))
3056 unlock_file (buf->file_truename);
3057 unlock_file (filename);
3059 #endif /* CLASH_DETECTION */
3061 RETURN_UNGCPRO (Fsignal (Qfile_error,
3062 list2 (build_string ("not a regular file"),
3065 /* If visiting nonexistent file, return nil. */
3066 if (buf->modtime == -1)
3067 report_file_error ("Opening input file",
3071 /* Decode file format */
3074 Lisp_Object insval = call3 (Qformat_decode,
3075 Qnil, make_int (inserted), visit);
3077 inserted = XINT (insval);
3083 struct gcpro ngcpro1;
3086 EXTERNAL_LIST_LOOP (p, Vafter_insert_file_functions)
3088 Lisp_Object insval =
3089 call1 (XCAR (p), make_int (inserted));
3092 CHECK_NATNUM (insval);
3093 inserted = XINT (insval);
3105 return (list2 (filename, make_int (inserted)));
3109 static int a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3110 Lisp_Object *annot);
3111 static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end);
3113 /* If build_annotations switched buffers, switch back to BUF.
3114 Kill the temporary buffer that was selected in the meantime. */
3117 build_annotations_unwind (Lisp_Object buf)
3121 if (XBUFFER (buf) == current_buffer)
3123 tembuf = Fcurrent_buffer ();
3125 Fkill_buffer (tembuf);
3129 DEFUN ("write-region-internal", Fwrite_region_internal, 3, 7,
3130 "r\nFWrite region to file: ", /*
3131 Write current region into specified file; no coding-system frobbing.
3132 This function is identical to `write-region' except for the handling
3133 of the CODESYS argument under XEmacs/Mule. (When Mule support is not
3134 present, both functions are identical and ignore the CODESYS argument.)
3135 If support for Mule exists in this Emacs, the file is encoded according
3136 to the value of CODESYS. If this is nil, no code conversion occurs.
3138 (start, end, filename, append, visit, lockname, codesys))
3140 /* This function can call lisp */
3146 int speccount = specpdl_depth ();
3147 int visiting_other = STRINGP (visit);
3148 int visiting = (EQ (visit, Qt) || visiting_other);
3149 int quietly = (!visiting && !NILP (visit));
3150 Lisp_Object visit_file = Qnil;
3151 Lisp_Object annotations = Qnil;
3152 struct buffer *given_buffer;
3153 Bufpos start1, end1;
3155 /* #### dmoore - if Fexpand_file_name or handlers kill the buffer,
3156 we should signal an error rather than blissfully continuing
3157 along. ARGH, this function is going to lose lose lose. We need
3158 to protect the current_buffer from being destroyed, but the
3159 multiple return points make this a pain in the butt. */
3162 codesys = Fget_coding_system (codesys);
3163 #endif /* FILE_CODING */
3165 if (current_buffer->base_buffer && ! NILP (visit))
3166 error ("Cannot do file visiting in an indirect buffer");
3168 if (!NILP (start) && !STRINGP (start))
3169 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0);
3172 Lisp_Object handler;
3173 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3175 GCPRO5 (start, filename, visit, visit_file, lockname);
3178 visit_file = Fexpand_file_name (visit, Qnil);
3180 visit_file = filename;
3181 filename = Fexpand_file_name (filename, Qnil);
3185 if (NILP (lockname))
3186 lockname = visit_file;
3188 /* If the file name has special constructs in it,
3189 call the corresponding file handler. */
3190 handler = Ffind_file_name_handler (filename, Qwrite_region);
3191 /* If FILENAME has no handler, see if VISIT has one. */
3192 if (NILP (handler) && STRINGP (visit))
3193 handler = Ffind_file_name_handler (visit, Qwrite_region);
3195 if (!NILP (handler))
3197 Lisp_Object val = call8 (handler, Qwrite_region, start, end,
3198 filename, append, visit, lockname, codesys);
3201 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3202 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3203 current_buffer->filename = visit_file;
3204 MARK_MODELINE_CHANGED;
3210 #ifdef CLASH_DETECTION
3214 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3216 XSETBUFFER (curbuf, current_buffer);
3217 GCPRO5 (start, filename, visit_file, lockname, curbuf);
3218 lock_file (lockname);
3221 #endif /* CLASH_DETECTION */
3223 /* Special kludge to simplify auto-saving. */
3226 start1 = BUF_BEG (current_buffer);
3227 end1 = BUF_Z (current_buffer);
3230 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
3232 given_buffer = current_buffer;
3233 annotations = build_annotations (start, end);
3234 if (current_buffer != given_buffer)
3236 start1 = BUF_BEGV (current_buffer);
3237 end1 = BUF_ZV (current_buffer);
3244 desc = open ((char *) XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0);
3248 desc = open ((char *) XSTRING_DATA (fn),
3249 (O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY),
3250 ((auto_saving) ? auto_save_mode_bits : CREAT_MODE));
3255 #ifdef CLASH_DETECTION
3257 if (!auto_saving) unlock_file (lockname);
3259 #endif /* CLASH_DETECTION */
3260 report_file_error ("Opening output file", list1 (filename));
3264 Lisp_Object desc_locative = Fcons (make_int (desc), Qnil);
3265 Lisp_Object instream = Qnil, outstream = Qnil;
3266 struct gcpro gcpro1, gcpro2;
3267 /* need to gcpro; QUIT could happen out of call to write() */
3268 GCPRO2 (instream, outstream);
3270 record_unwind_protect (close_file_unwind, desc_locative);
3274 if (lseek (desc, 0, 2) < 0)
3276 #ifdef CLASH_DETECTION
3277 if (!auto_saving) unlock_file (lockname);
3278 #endif /* CLASH_DETECTION */
3279 report_file_error ("Lseek error",
3286 /* Note: I tried increasing the buffering size, along with
3287 various other tricks, but nothing seemed to make much of
3288 a difference in the time it took to save a large file.
3289 (Actually that's not true. With a local disk, changing
3290 the buffer size doesn't seem to make much difference.
3291 With an NFS-mounted disk, it could make a lot of difference
3292 because you're affecting the number of network requests
3293 that need to be made, and there could be a large latency
3294 for each request. So I've increased the buffer size
3296 outstream = make_filedesc_output_stream (desc, 0, -1, 0);
3297 Lstream_set_buffering (XLSTREAM (outstream),
3298 LSTREAM_BLOCKN_BUFFERED, 65536);
3301 make_encoding_output_stream (XLSTREAM (outstream), codesys);
3302 Lstream_set_buffering (XLSTREAM (outstream),
3303 LSTREAM_BLOCKN_BUFFERED, 65536);
3304 #endif /* FILE_CODING */
3305 if (STRINGP (start))
3307 instream = make_lisp_string_input_stream (start, 0, -1);
3311 instream = make_lisp_buffer_input_stream (current_buffer, start1, end1,
3313 LSTR_IGNORE_ACCESSIBLE);
3314 failure = (0 > (a_write (outstream, instream, start1,
3317 /* Note that this doesn't close the desc since we created the
3318 stream without the LSTR_CLOSING flag, but it does
3319 flush out any buffered data. */
3320 if (Lstream_close (XLSTREAM (outstream)) < 0)
3325 Lstream_close (XLSTREAM (instream));
3329 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3330 Disk full in NFS may be reported here. */
3331 /* mib says that closing the file will try to write as fast as NFS can do
3332 it, and that means the fsync here is not crucial for autosave files. */
3333 if (!auto_saving && fsync (desc) < 0
3334 /* If fsync fails with EINTR, don't treat that as serious. */
3340 #endif /* HAVE_FSYNC */
3342 /* Spurious "file has changed on disk" warnings have been
3343 observed on Suns as well.
3344 It seems that `close' can change the modtime, under nfs.
3346 (This has supposedly been fixed in Sunos 4,
3347 but who knows about all the other machines with NFS?) */
3348 /* On VMS and APOLLO, must do the stat after the close
3349 since closing changes the modtime. */
3350 /* As it does on Windows too - kkm */
3351 /* The spurious warnings appear on Linux too. Rather than handling
3352 this on a per-system basis, unconditionally do the stat after the close - cgw */
3354 #if 0 /* !defined (WINDOWSNT) */ /* !defined (VMS) && !defined (APOLLO) */
3358 /* NFS can report a write failure now. */
3359 if (close (desc) < 0)
3365 /* Discard the close unwind-protect. Execute the one for
3366 build_annotations (switches back to the original current buffer
3368 XCAR (desc_locative) = Qnil;
3369 unbind_to (speccount, Qnil);
3372 /* # if defined (WINDOWSNT) */ /* defined (VMS) || defined (APOLLO) */
3373 stat ((char *) XSTRING_DATA (fn), &st);
3376 #ifdef CLASH_DETECTION
3378 unlock_file (lockname);
3379 #endif /* CLASH_DETECTION */
3381 /* Do this before reporting IO error
3382 to avoid a "file has changed on disk" warning on
3383 next attempt to save. */
3385 current_buffer->modtime = st.st_mtime;
3388 error ("IO error writing %s: %s",
3390 strerror (save_errno));
3394 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3395 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3396 current_buffer->filename = visit_file;
3397 MARK_MODELINE_CHANGED;
3407 message ("Wrote %s", XSTRING_DATA (visit_file));
3410 struct gcpro gcpro1;
3414 fsp = Ffile_symlink_p (fn);
3416 message ("Wrote %s", XSTRING_DATA (fn));
3418 message ("Wrote %s (symlink to %s)",
3419 XSTRING_DATA (fn), XSTRING_DATA (fsp));
3426 /* #### This is such a load of shit!!!! There is no way we should define
3427 something so stupid as a subr, just sort the fucking list more
3429 DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3430 Return t if (car A) is numerically less than (car B).
3434 Lisp_Object objs[2];
3437 return Flss (2, objs);
3440 /* Heh heh heh, let's define this too, just to aggravate the person who
3441 wrote the above comment. */
3442 DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3443 Return t if (cdr A) is numerically less than (cdr B).
3447 Lisp_Object objs[2];
3450 return Flss (2, objs);
3453 /* Build the complete list of annotations appropriate for writing out
3454 the text between START and END, by calling all the functions in
3455 write-region-annotate-functions and merging the lists they return.
3456 If one of these functions switches to a different buffer, we assume
3457 that buffer contains altered text. Therefore, the caller must
3458 make sure to restore the current buffer in all cases,
3459 as save-excursion would do. */
3462 build_annotations (Lisp_Object start, Lisp_Object end)
3464 /* This function can GC */
3465 Lisp_Object annotations;
3467 struct gcpro gcpro1, gcpro2;
3468 Lisp_Object original_buffer;
3470 XSETBUFFER (original_buffer, current_buffer);
3473 p = Vwrite_region_annotate_functions;
3474 GCPRO2 (annotations, p);
3477 struct buffer *given_buffer = current_buffer;
3478 Vwrite_region_annotations_so_far = annotations;
3479 res = call2 (Fcar (p), start, end);
3480 /* If the function makes a different buffer current,
3481 assume that means this buffer contains altered text to be output.
3482 Reset START and END from the buffer bounds
3483 and discard all previous annotations because they should have
3484 been dealt with by this function. */
3485 if (current_buffer != given_buffer)
3487 start = make_int (BUF_BEGV (current_buffer));
3488 end = make_int (BUF_ZV (current_buffer));
3491 Flength (res); /* Check basic validity of return value */
3492 annotations = merge (annotations, res, Qcar_less_than_car);
3496 /* Now do the same for annotation functions implied by the file-format */
3497 if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
3498 p = Vauto_save_file_format;
3500 p = current_buffer->file_format;
3503 struct buffer *given_buffer = current_buffer;
3504 Vwrite_region_annotations_so_far = annotations;
3505 res = call4 (Qformat_annotate_function, Fcar (p), start, end,
3507 if (current_buffer != given_buffer)
3509 start = make_int (BUF_BEGV (current_buffer));
3510 end = make_int (BUF_ZV (current_buffer));
3514 annotations = merge (annotations, res, Qcar_less_than_car);
3521 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3522 EOF is encountered), assuming they start at position POS in the buffer
3523 of string that STREAM refers to. Intersperse with them the annotations
3524 from *ANNOT that fall into the range of positions we are reading from,
3525 each at its appropriate position.
3527 Modify *ANNOT by discarding elements as we output them.
3528 The return value is negative in case of system call failure. */
3530 /* 4K should probably be fine. We just need to reduce the number of
3531 function calls to reasonable level. The Lstream stuff itself will
3532 batch to 64K to reduce the number of system calls. */
3534 #define A_WRITE_BATCH_SIZE 4096
3537 a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3542 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3543 Lstream *instr = XLSTREAM (instream);
3544 Lstream *outstr = XLSTREAM (outstream);
3546 while (LISTP (*annot))
3548 tem = Fcar_safe (Fcar (*annot));
3550 nextpos = XINT (tem);
3554 /* If there are annotations left and we have Mule, then we
3555 have to do the I/O one emchar at a time so we can
3556 determine when to insert the annotation. */
3560 while (pos != nextpos && (ch = Lstream_get_emchar (instr)) != EOF)
3562 if (Lstream_put_emchar (outstr, ch) < 0)
3570 while (pos != nextpos)
3572 /* Otherwise there is no point to that. Just go in batches. */
3573 int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE);
3575 chunk = Lstream_read (instr, largebuf, chunk);
3578 if (chunk == 0) /* EOF */
3580 if (Lstream_write (outstr, largebuf, chunk) < chunk)
3587 tem = Fcdr (Fcar (*annot));
3590 if (Lstream_write (outstr, XSTRING_DATA (tem),
3591 XSTRING_LENGTH (tem)) < 0)
3594 *annot = Fcdr (*annot);
3605 #include <des_crypt.h>
3607 #define CRYPT_BLOCK_SIZE 8 /* bytes */
3608 #define CRYPT_KEY_SIZE 8 /* bytes */
3610 DEFUN ("encrypt-string", Fencrypt_string, 2, 2, 0, /*
3611 Encrypt STRING using KEY.
3615 char *encrypted_string, *raw_key;
3616 int rounded_size, extra, key_size;
3618 /* !!#### May produce bogus data under Mule. */
3619 CHECK_STRING (string);
3622 extra = XSTRING_LENGTH (string) % CRYPT_BLOCK_SIZE;
3623 rounded_size = XSTRING_LENGTH (string) + extra;
3624 encrypted_string = alloca (rounded_size + 1);
3625 memcpy (encrypted_string, XSTRING_DATA (string), XSTRING_LENGTH (string));
3626 memset (encrypted_string + rounded_size - extra, 0, extra + 1);
3628 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3630 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3631 memcpy (raw_key, XSTRING_DATA (key), key_size);
3632 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3634 ecb_crypt (raw_key, encrypted_string, rounded_size,
3635 DES_ENCRYPT | DES_SW);
3636 return make_string (encrypted_string, rounded_size);
3639 DEFUN ("decrypt-string", Fdecrypt_string, 2, 2, 0, /*
3640 Decrypt STRING using KEY.
3644 char *decrypted_string, *raw_key;
3645 int string_size, key_size;
3647 CHECK_STRING (string);
3650 string_size = XSTRING_LENGTH (string) + 1;
3651 decrypted_string = alloca (string_size);
3652 memcpy (decrypted_string, XSTRING_DATA (string), string_size);
3653 decrypted_string[string_size - 1] = '\0';
3655 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3657 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3658 memcpy (raw_key, XSTRING_DATA (key), key_size);
3659 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3662 ecb_crypt (raw_key, decrypted_string, string_size, D | DES_SW);
3663 return make_string (decrypted_string, string_size - 1);
3668 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
3669 Return t if last mod time of BUF's visited file matches what BUF records.
3670 This means that the file has not been changed since it was visited or saved.
3674 /* This function can call lisp */
3677 Lisp_Object handler;
3682 if (!STRINGP (b->filename)) return Qt;
3683 if (b->modtime == 0) return Qt;
3685 /* If the file name has special constructs in it,
3686 call the corresponding file handler. */
3687 handler = Ffind_file_name_handler (b->filename,
3688 Qverify_visited_file_modtime);
3689 if (!NILP (handler))
3690 return call2 (handler, Qverify_visited_file_modtime, buf);
3692 if (stat ((char *) XSTRING_DATA (b->filename), &st) < 0)
3694 /* If the file doesn't exist now and didn't exist before,
3695 we say that it isn't modified, provided the error is a tame one. */
3696 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3701 if (st.st_mtime == b->modtime
3702 /* If both are positive, accept them if they are off by one second. */
3703 || (st.st_mtime > 0 && b->modtime > 0
3704 && (st.st_mtime == b->modtime + 1
3705 || st.st_mtime == b->modtime - 1)))
3710 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3711 Clear out records of last mod time of visited file.
3712 Next attempt to save will certainly not complain of a discrepancy.
3716 current_buffer->modtime = 0;
3720 DEFUN ("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3721 Return the current buffer's recorded visited file modification time.
3722 The value is a list of the form (HIGH . LOW), like the time values
3723 that `file-attributes' returns.
3727 return time_to_lisp ((time_t) current_buffer->modtime);
3730 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3731 Update buffer's recorded modification time from the visited file's time.
3732 Useful if the buffer was not read from the file normally
3733 or if the file itself has been changed for some known benign reason.
3734 An argument specifies the modification time value to use
3735 \(instead of that of the visited file), in the form of a list
3736 \(HIGH . LOW) or (HIGH LOW).
3740 /* This function can call lisp */
3741 if (!NILP (time_list))
3744 lisp_to_time (time_list, &the_time);
3745 current_buffer->modtime = (int) the_time;
3749 Lisp_Object filename;
3751 Lisp_Object handler;
3752 struct gcpro gcpro1, gcpro2, gcpro3;
3754 GCPRO3 (filename, time_list, current_buffer->filename);
3755 filename = Fexpand_file_name (current_buffer->filename, Qnil);
3757 /* If the file name has special constructs in it,
3758 call the corresponding file handler. */
3759 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
3761 if (!NILP (handler))
3762 /* The handler can find the file name the same way we did. */
3763 return call2 (handler, Qset_visited_file_modtime, Qnil);
3764 else if (stat ((char *) XSTRING_DATA (filename), &st) >= 0)
3765 current_buffer->modtime = st.st_mtime;
3772 auto_save_error (Lisp_Object condition_object, Lisp_Object ignored)
3774 /* This function can call lisp */
3777 /* Don't try printing an error message after everything is gone! */
3778 if (preparing_for_armageddon)
3780 clear_echo_area (selected_frame (), Qauto_saving, 1);
3781 Fding (Qt, Qauto_save_error, Qnil);
3782 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3783 Fsleep_for (make_int (1));
3784 message ("Auto-saving...error!for %s", XSTRING_DATA (current_buffer->name));
3785 Fsleep_for (make_int (1));
3786 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3787 Fsleep_for (make_int (1));
3792 auto_save_1 (Lisp_Object ignored)
3794 /* This function can call lisp */
3795 /* #### I think caller is protecting current_buffer? */
3797 Lisp_Object fn = current_buffer->filename;
3798 Lisp_Object a = current_buffer->auto_save_file_name;
3803 /* Get visited file's mode to become the auto save file's mode. */
3805 stat ((char *) XSTRING_DATA (fn), &st) >= 0)
3806 /* But make sure we can overwrite it later! */
3807 auto_save_mode_bits = st.st_mode | 0600;
3809 /* default mode for auto-save files of buffers with no file is
3810 readable by owner only. This may annoy some small number of
3811 people, but the alternative removes all privacy from email. */
3812 auto_save_mode_bits = 0600;
3815 /* !!#### need to deal with this 'escape-quoted everywhere */
3816 Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil,
3826 auto_save_expand_name_error (Lisp_Object condition_object, Lisp_Object ignored)
3828 /* #### this function should spew an error message about not being
3829 able to open the .saves file. */
3834 auto_save_expand_name (Lisp_Object name)
3836 struct gcpro gcpro1;
3838 /* note that caller did NOT gc protect name, so we do it. */
3839 /* #### dmoore - this might not be necessary, if condition_case_1
3840 protects it. but I don't think it does. */
3842 RETURN_UNGCPRO (Fexpand_file_name (name, Qnil));
3847 do_auto_save_unwind (Lisp_Object fd)
3854 do_auto_save_unwind_2 (Lisp_Object old_auto_saving)
3856 auto_saving = XINT (old_auto_saving);
3860 /* Fdo_auto_save() checks whether a GC is in progress when it is called,
3861 and if so, tries to avoid touching lisp objects.
3863 The only time that Fdo_auto_save() is called while GC is in progress
3864 is if we're going down, as a result of an abort() or a kill signal.
3865 It's fairly important that we generate autosave files in that case!
3868 DEFUN ("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3869 Auto-save all buffers that need it.
3870 This is all buffers that have auto-saving enabled
3871 and are changed since last auto-saved.
3872 Auto-saving writes the buffer into a file
3873 so that your editing is not lost if the system crashes.
3874 This file is not the file you visited; that changes only when you save.
3875 Normally we run the normal hook `auto-save-hook' before saving.
3877 Non-nil first argument means do not print any message if successful.
3878 Non-nil second argument means save only current buffer.
3880 (no_message, current_only))
3882 /* This function can call lisp */
3884 Lisp_Object tail, buf;
3886 int do_handled_files;
3887 Lisp_Object oquit = Qnil;
3888 Lisp_Object listfile = Qnil;
3891 int speccount = specpdl_depth ();
3892 struct gcpro gcpro1, gcpro2, gcpro3;
3894 XSETBUFFER (old, current_buffer);
3895 GCPRO3 (oquit, listfile, old);
3896 check_quit (); /* make Vquit_flag accurate */
3897 /* Ordinarily don't quit within this function,
3898 but don't make it impossible to quit (in case we get hung in I/O). */
3902 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3903 variables point to non-strings reached from Vbuffer_alist. */
3905 if (minibuf_level != 0 || preparing_for_armageddon)
3908 run_hook (Qauto_save_hook);
3910 if (STRINGP (Vauto_save_list_file_name))
3911 listfile = condition_case_1 (Qt,
3912 auto_save_expand_name,
3913 Vauto_save_list_file_name,
3914 auto_save_expand_name_error, Qnil);
3916 /* Make sure auto_saving is reset. */
3917 record_unwind_protect (do_auto_save_unwind_2, make_int (auto_saving));
3921 /* First, save all files which don't have handlers. If Emacs is
3922 crashing, the handlers may tweak what is causing Emacs to crash
3923 in the first place, and it would be a shame if Emacs failed to
3924 autosave perfectly ordinary files because it couldn't handle some
3926 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
3928 for (tail = Vbuffer_alist;
3932 buf = XCDR (XCAR (tail));
3935 if (!NILP (current_only)
3936 && b != current_buffer)
3939 /* Don't auto-save indirect buffers.
3940 The base buffer takes care of it. */
3944 /* Check for auto save enabled
3945 and file changed since last auto save
3946 and file changed since last real save. */
3947 if (STRINGP (b->auto_save_file_name)
3948 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
3949 && b->auto_save_modified < BUF_MODIFF (b)
3950 /* -1 means we've turned off autosaving for a while--see below. */
3951 && XINT (b->saved_size) >= 0
3952 && (do_handled_files
3953 || NILP (Ffind_file_name_handler (b->auto_save_file_name,
3956 EMACS_TIME before_time, after_time;
3958 EMACS_GET_TIME (before_time);
3959 /* If we had a failure, don't try again for 20 minutes. */
3960 if (!preparing_for_armageddon
3961 && b->auto_save_failure_time >= 0
3962 && (EMACS_SECS (before_time) - b->auto_save_failure_time <
3966 if (!preparing_for_armageddon &&
3967 (XINT (b->saved_size) * 10
3968 > (BUF_Z (b) - BUF_BEG (b)) * 13)
3969 /* A short file is likely to change a large fraction;
3970 spare the user annoying messages. */
3971 && XINT (b->saved_size) > 5000
3972 /* These messages are frequent and annoying for `*mail*'. */
3973 && !NILP (b->filename)
3974 && NILP (no_message)
3975 && disable_auto_save_when_buffer_shrinks)
3977 /* It has shrunk too much; turn off auto-saving here.
3978 Unless we're about to crash, in which case auto-save it
3982 ("Buffer %s has shrunk a lot; auto save turned off there",
3983 XSTRING_DATA (b->name));
3984 /* Turn off auto-saving until there's a real save,
3985 and prevent any more warnings. */
3986 b->saved_size = make_int (-1);
3987 if (!gc_in_progress)
3988 Fsleep_for (make_int (1));
3991 set_buffer_internal (b);
3992 if (!auto_saved && NILP (no_message))
3994 static CONST unsigned char *msg
3995 = (CONST unsigned char *) "Auto-saving...";
3996 echo_area_message (selected_frame (), msg, Qnil,
3997 0, strlen ((CONST char *) msg),
4001 /* Open the auto-save list file, if necessary.
4002 We only do this now so that the file only exists
4003 if we actually auto-saved any files. */
4004 if (!auto_saved && STRINGP (listfile) && listdesc < 0)
4006 listdesc = open ((char *) XSTRING_DATA (listfile),
4007 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4010 /* Arrange to close that file whether or not we get
4013 record_unwind_protect (do_auto_save_unwind,
4014 make_int (listdesc));
4017 /* Record all the buffers that we are auto-saving in
4018 the special file that lists them. For each of
4019 these buffers, record visited name (if any) and
4023 CONST Extbyte *auto_save_file_name_ext;
4024 Extcount auto_save_file_name_ext_len;
4026 GET_STRING_FILENAME_DATA_ALLOCA
4027 (b->auto_save_file_name,
4028 auto_save_file_name_ext,
4029 auto_save_file_name_ext_len);
4030 if (!NILP (b->filename))
4032 CONST Extbyte *filename_ext;
4033 Extcount filename_ext_len;
4035 GET_STRING_FILENAME_DATA_ALLOCA (b->filename,
4038 write (listdesc, filename_ext, filename_ext_len);
4040 write (listdesc, "\n", 1);
4041 write (listdesc, auto_save_file_name_ext,
4042 auto_save_file_name_ext_len);
4043 write (listdesc, "\n", 1);
4046 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
4047 based on values in Vbuffer_alist. auto_save_1 may
4048 cause lisp handlers to run. Those handlers may kill
4049 the buffer and then GC. Since the buffer is killed,
4050 it's no longer in Vbuffer_alist so it might get reaped
4051 by the GC. We also need to protect tail. */
4052 /* #### There is probably a lot of other code which has
4053 pointers into buffers which may get blown away by
4056 struct gcpro ngcpro1, ngcpro2;
4057 NGCPRO2 (buf, tail);
4058 condition_case_1 (Qt,
4060 auto_save_error, Qnil);
4063 /* Handler killed our saved current-buffer! Pick any. */
4064 if (!BUFFER_LIVE_P (XBUFFER (old)))
4065 XSETBUFFER (old, current_buffer);
4067 set_buffer_internal (XBUFFER (old));
4070 /* Handler killed their own buffer! */
4071 if (!BUFFER_LIVE_P(b))
4074 b->auto_save_modified = BUF_MODIFF (b);
4075 b->saved_size = make_int (BUF_SIZE (b));
4076 EMACS_GET_TIME (after_time);
4077 /* If auto-save took more than 60 seconds,
4078 assume it was an NFS failure that got a timeout. */
4079 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
4080 b->auto_save_failure_time = EMACS_SECS (after_time);
4085 /* Prevent another auto save till enough input events come in. */
4087 record_auto_save ();
4089 /* If we didn't save anything into the listfile, remove the old
4090 one because nothing needed to be auto-saved. Do this afterwards
4091 rather than before in case we get a crash attempting to autosave
4092 (in that case we'd still want the old one around). */
4093 if (listdesc < 0 && !auto_saved && STRINGP (listfile))
4094 unlink ((char *) XSTRING_DATA (listfile));
4096 /* Show "...done" only if the echo area would otherwise be empty. */
4097 if (auto_saved && NILP (no_message)
4098 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0)))
4100 static CONST unsigned char *msg
4101 = (CONST unsigned char *)"Auto-saving...done";
4102 echo_area_message (selected_frame (), msg, Qnil, 0,
4103 strlen ((CONST char *) msg), Qauto_saving);
4108 RETURN_UNGCPRO (unbind_to (speccount, Qnil));
4111 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
4112 Mark current buffer as auto-saved with its current text.
4113 No auto-save file will be written until the buffer changes again.
4117 current_buffer->auto_save_modified = BUF_MODIFF (current_buffer);
4118 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
4119 current_buffer->auto_save_failure_time = -1;
4123 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
4124 Clear any record of a recent auto-save failure in the current buffer.
4128 current_buffer->auto_save_failure_time = -1;
4132 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
4133 Return t if buffer has been auto-saved since last read in or saved.
4137 return (BUF_SAVE_MODIFF (current_buffer) <
4138 current_buffer->auto_save_modified) ? Qt : Qnil;
4142 /************************************************************************/
4143 /* initialization */
4144 /************************************************************************/
4147 syms_of_fileio (void)
4149 defsymbol (&Qexpand_file_name, "expand-file-name");
4150 defsymbol (&Qfile_truename, "file-truename");
4151 defsymbol (&Qsubstitute_in_file_name, "substitute-in-file-name");
4152 defsymbol (&Qdirectory_file_name, "directory-file-name");
4153 defsymbol (&Qfile_name_directory, "file-name-directory");
4154 defsymbol (&Qfile_name_nondirectory, "file-name-nondirectory");
4155 defsymbol (&Qunhandled_file_name_directory, "unhandled-file-name-directory");
4156 defsymbol (&Qfile_name_as_directory, "file-name-as-directory");
4157 defsymbol (&Qcopy_file, "copy-file");
4158 defsymbol (&Qmake_directory_internal, "make-directory-internal");
4159 defsymbol (&Qdelete_directory, "delete-directory");
4160 defsymbol (&Qdelete_file, "delete-file");
4161 defsymbol (&Qrename_file, "rename-file");
4162 defsymbol (&Qadd_name_to_file, "add-name-to-file");
4163 defsymbol (&Qmake_symbolic_link, "make-symbolic-link");
4164 defsymbol (&Qfile_exists_p, "file-exists-p");
4165 defsymbol (&Qfile_executable_p, "file-executable-p");
4166 defsymbol (&Qfile_readable_p, "file-readable-p");
4167 defsymbol (&Qfile_symlink_p, "file-symlink-p");
4168 defsymbol (&Qfile_writable_p, "file-writable-p");
4169 defsymbol (&Qfile_directory_p, "file-directory-p");
4170 defsymbol (&Qfile_regular_p, "file-regular-p");
4171 defsymbol (&Qfile_accessible_directory_p, "file-accessible-directory-p");
4172 defsymbol (&Qfile_modes, "file-modes");
4173 defsymbol (&Qset_file_modes, "set-file-modes");
4174 defsymbol (&Qfile_newer_than_file_p, "file-newer-than-file-p");
4175 defsymbol (&Qinsert_file_contents, "insert-file-contents");
4176 defsymbol (&Qwrite_region, "write-region");
4177 defsymbol (&Qverify_visited_file_modtime, "verify-visited-file-modtime");
4178 defsymbol (&Qset_visited_file_modtime, "set-visited-file-modtime");
4179 defsymbol (&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */
4181 defsymbol (&Qauto_save_hook, "auto-save-hook");
4182 defsymbol (&Qauto_save_error, "auto-save-error");
4183 defsymbol (&Qauto_saving, "auto-saving");
4185 defsymbol (&Qformat_decode, "format-decode");
4186 defsymbol (&Qformat_annotate_function, "format-annotate-function");
4188 defsymbol (&Qcompute_buffer_file_truename, "compute-buffer-file-truename");
4189 deferror (&Qfile_error, "file-error", "File error", Qio_error);
4190 deferror (&Qfile_already_exists, "file-already-exists",
4191 "File already exists", Qfile_error);
4193 DEFSUBR (Ffind_file_name_handler);
4195 DEFSUBR (Ffile_name_directory);
4196 DEFSUBR (Ffile_name_nondirectory);
4197 DEFSUBR (Funhandled_file_name_directory);
4198 DEFSUBR (Ffile_name_as_directory);
4199 DEFSUBR (Fdirectory_file_name);
4200 DEFSUBR (Fmake_temp_name);
4201 DEFSUBR (Fexpand_file_name);
4202 DEFSUBR (Ffile_truename);
4203 DEFSUBR (Fsubstitute_in_file_name);
4204 DEFSUBR (Fcopy_file);
4205 DEFSUBR (Fmake_directory_internal);
4206 DEFSUBR (Fdelete_directory);
4207 DEFSUBR (Fdelete_file);
4208 DEFSUBR (Frename_file);
4209 DEFSUBR (Fadd_name_to_file);
4211 DEFSUBR (Fmake_symbolic_link);
4212 #endif /* S_IFLNK */
4214 DEFSUBR (Fsysnetunam);
4215 #endif /* HPUX_NET */
4216 DEFSUBR (Ffile_name_absolute_p);
4217 DEFSUBR (Ffile_exists_p);
4218 DEFSUBR (Ffile_executable_p);
4219 DEFSUBR (Ffile_readable_p);
4220 DEFSUBR (Ffile_writable_p);
4221 DEFSUBR (Ffile_symlink_p);
4222 DEFSUBR (Ffile_directory_p);
4223 DEFSUBR (Ffile_accessible_directory_p);
4224 DEFSUBR (Ffile_regular_p);
4225 DEFSUBR (Ffile_modes);
4226 DEFSUBR (Fset_file_modes);
4227 DEFSUBR (Fset_default_file_modes);
4228 DEFSUBR (Fdefault_file_modes);
4229 DEFSUBR (Funix_sync);
4230 DEFSUBR (Ffile_newer_than_file_p);
4231 DEFSUBR (Finsert_file_contents_internal);
4232 DEFSUBR (Fwrite_region_internal);
4233 DEFSUBR (Fcar_less_than_car); /* Vomitous! */
4234 DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
4236 DEFSUBR (Fencrypt_string);
4237 DEFSUBR (Fdecrypt_string);
4239 DEFSUBR (Fverify_visited_file_modtime);
4240 DEFSUBR (Fclear_visited_file_modtime);
4241 DEFSUBR (Fvisited_file_modtime);
4242 DEFSUBR (Fset_visited_file_modtime);
4244 DEFSUBR (Fdo_auto_save);
4245 DEFSUBR (Fset_buffer_auto_saved);
4246 DEFSUBR (Fclear_buffer_auto_save_failure);
4247 DEFSUBR (Frecent_auto_save_p);
4251 vars_of_fileio (void)
4253 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /*
4254 *Format in which to write auto-save files.
4255 Should be a list of symbols naming formats that are defined in `format-alist'.
4256 If it is t, which is the default, auto-save files are written in the
4257 same format as a regular save would use.
4259 Vauto_save_file_format = Qt;
4261 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /*
4262 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
4263 If a file name matches REGEXP, then all I/O on that file is done by calling
4266 The first argument given to HANDLER is the name of the I/O primitive
4267 to be handled; the remaining arguments are the arguments that were
4268 passed to that primitive. For example, if you do
4269 (file-exists-p FILENAME)
4270 and FILENAME is handled by HANDLER, then HANDLER is called like this:
4271 (funcall HANDLER 'file-exists-p FILENAME)
4272 The function `find-file-name-handler' checks this list for a handler
4275 Vfile_name_handler_alist = Qnil;
4277 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /*
4278 A list of functions to be called at the end of `insert-file-contents'.
4279 Each is passed one argument, the number of bytes inserted. It should return
4280 the new byte count, and leave point the same. If `insert-file-contents' is
4281 intercepted by a handler from `file-name-handler-alist', that handler is
4282 responsible for calling the after-insert-file-functions if appropriate.
4284 Vafter_insert_file_functions = Qnil;
4286 DEFVAR_LISP ("write-region-annotate-functions",
4287 &Vwrite_region_annotate_functions /*
4288 A list of functions to be called at the start of `write-region'.
4289 Each is passed two arguments, START and END, as for `write-region'.
4290 It should return a list of pairs (POSITION . STRING) of strings to be
4291 effectively inserted at the specified positions of the file being written
4292 \(1 means to insert before the first byte written). The POSITIONs must be
4293 sorted into increasing order. If there are several functions in the list,
4294 the several lists are merged destructively.
4296 Vwrite_region_annotate_functions = Qnil;
4298 DEFVAR_LISP ("write-region-annotations-so-far",
4299 &Vwrite_region_annotations_so_far /*
4300 When an annotation function is called, this holds the previous annotations.
4301 These are the annotations made by other annotation functions
4302 that were already called. See also `write-region-annotate-functions'.
4304 Vwrite_region_annotations_so_far = Qnil;
4306 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
4307 A list of file name handlers that temporarily should not be used.
4308 This applies only to the operation `inhibit-file-name-operation'.
4310 Vinhibit_file_name_handlers = Qnil;
4312 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
4313 The operation for which `inhibit-file-name-handlers' is applicable.
4315 Vinhibit_file_name_operation = Qnil;
4317 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name /*
4318 File name in which we write a list of all auto save file names.
4320 Vauto_save_list_file_name = Qnil;
4322 DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks",
4323 &disable_auto_save_when_buffer_shrinks /*
4324 If non-nil, auto-saving is disabled when a buffer shrinks too much.
4325 This is to prevent you from losing your edits if you accidentally
4326 delete a large chunk of the buffer and don't notice it until too late.
4327 Saving the buffer normally turns auto-save back on.
4329 disable_auto_save_when_buffer_shrinks = 1;
4331 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /*
4332 Directory separator character for built-in functions that return file names.
4333 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
4334 This variable affects the built-in functions only on Windows,
4335 on other platforms, it is initialized so that Lisp code can find out
4336 what the normal separator is.
4338 Vdirectory_sep_char = make_char ('/');