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 Qfile_name_handler_alist;
114 Lisp_Object Vdirectory_sep_char;
116 /* These variables describe handlers that have "already" had a chance
117 to handle the current operation.
119 Vinhibit_file_name_handlers is a list of file name handlers.
120 Vinhibit_file_name_operation is the operation being handled.
121 If we try to handle that operation, we ignore those handlers. */
123 static Lisp_Object Vinhibit_file_name_handlers;
124 static Lisp_Object Vinhibit_file_name_operation;
126 Lisp_Object Qfile_error, Qfile_already_exists;
128 Lisp_Object Qauto_save_hook;
129 Lisp_Object Qauto_save_error;
130 Lisp_Object Qauto_saving;
132 Lisp_Object Qcar_less_than_car;
134 Lisp_Object Qcompute_buffer_file_truename;
136 EXFUN (Frunning_temacs_p, 0);
138 /* signal a file error when errno contains a meaningful value. */
141 report_file_error (CONST char *string, Lisp_Object data)
143 /* #### dmoore - This uses current_buffer, better make sure no one
144 has GC'd the current buffer. File handlers are giving me a headache
145 maybe I'll just always protect current_buffer around all of those
148 signal_error (Qfile_error,
149 Fcons (build_translated_string (string),
150 Fcons (lisp_strerror (errno), data)));
154 maybe_report_file_error (CONST char *string, Lisp_Object data,
155 Lisp_Object class, Error_behavior errb)
158 if (ERRB_EQ (errb, ERROR_ME_NOT))
161 maybe_signal_error (Qfile_error,
162 Fcons (build_translated_string (string),
163 Fcons (lisp_strerror (errno), data)),
167 /* signal a file error when errno does not contain a meaningful value. */
170 signal_file_error (CONST char *string, Lisp_Object data)
172 signal_error (Qfile_error,
173 list2 (build_translated_string (string), data));
177 maybe_signal_file_error (CONST char *string, Lisp_Object data,
178 Lisp_Object class, Error_behavior errb)
181 if (ERRB_EQ (errb, ERROR_ME_NOT))
183 maybe_signal_error (Qfile_error,
184 list2 (build_translated_string (string), data),
189 signal_double_file_error (CONST char *string1, CONST char *string2,
192 signal_error (Qfile_error,
193 list3 (build_translated_string (string1),
194 build_translated_string (string2),
199 maybe_signal_double_file_error (CONST char *string1, CONST char *string2,
200 Lisp_Object data, Lisp_Object class,
204 if (ERRB_EQ (errb, ERROR_ME_NOT))
206 maybe_signal_error (Qfile_error,
207 list3 (build_translated_string (string1),
208 build_translated_string (string2),
214 signal_double_file_error_2 (CONST char *string1, CONST char *string2,
215 Lisp_Object data1, Lisp_Object data2)
217 signal_error (Qfile_error,
218 list4 (build_translated_string (string1),
219 build_translated_string (string2),
224 maybe_signal_double_file_error_2 (CONST char *string1, CONST char *string2,
225 Lisp_Object data1, Lisp_Object data2,
226 Lisp_Object class, Error_behavior errb)
229 if (ERRB_EQ (errb, ERROR_ME_NOT))
231 maybe_signal_error (Qfile_error,
232 list4 (build_translated_string (string1),
233 build_translated_string (string2),
239 /* Just like strerror(3), except return a lisp string instead of char *.
240 The string needs to be converted since it may be localized.
241 Perhaps this should use strerror-coding-system instead? */
243 lisp_strerror (int errnum)
245 return build_ext_string (strerror (errnum), FORMAT_NATIVE);
249 close_file_unwind (Lisp_Object fd)
253 if (INTP (XCAR (fd)))
254 close (XINT (XCAR (fd)));
256 free_cons (XCONS (fd));
265 delete_stream_unwind (Lisp_Object stream)
267 Lstream_delete (XLSTREAM (stream));
271 /* Restore point, having saved it as a marker. */
274 restore_point_unwind (Lisp_Object point_marker)
276 BUF_SET_PT (current_buffer, marker_position (point_marker));
277 return Fset_marker (point_marker, Qnil, Qnil);
280 /* Versions of read() and write() that allow quitting out of the actual
281 I/O. We don't use immediate_quit (i.e. direct longjmp() out of the
282 signal handler) because that's way too losing.
284 (#### Actually, longjmp()ing out of the signal handler may not be
285 as losing as I thought. See sys_do_signal() in sysdep.c.)
287 Solaris include files declare the return value as ssize_t.
290 read_allowing_quit (int fildes, void *buf, size_t size)
293 return sys_read_1 (fildes, buf, size, 1);
297 write_allowing_quit (int fildes, CONST void *buf, size_t size)
300 return sys_write_1 (fildes, buf, size, 1);
304 Lisp_Object Qexpand_file_name;
305 Lisp_Object Qfile_truename;
306 Lisp_Object Qsubstitute_in_file_name;
307 Lisp_Object Qdirectory_file_name;
308 Lisp_Object Qfile_name_directory;
309 Lisp_Object Qfile_name_nondirectory;
310 Lisp_Object Qunhandled_file_name_directory;
311 Lisp_Object Qfile_name_as_directory;
312 Lisp_Object Qcopy_file;
313 Lisp_Object Qmake_directory_internal;
314 Lisp_Object Qdelete_directory;
315 Lisp_Object Qdelete_file;
316 Lisp_Object Qrename_file;
317 Lisp_Object Qadd_name_to_file;
318 Lisp_Object Qmake_symbolic_link;
319 Lisp_Object Qfile_exists_p;
320 Lisp_Object Qfile_executable_p;
321 Lisp_Object Qfile_readable_p;
322 Lisp_Object Qfile_symlink_p;
323 Lisp_Object Qfile_writable_p;
324 Lisp_Object Qfile_directory_p;
325 Lisp_Object Qfile_regular_p;
326 Lisp_Object Qfile_accessible_directory_p;
327 Lisp_Object Qfile_modes;
328 Lisp_Object Qset_file_modes;
329 Lisp_Object Qfile_newer_than_file_p;
330 Lisp_Object Qinsert_file_contents;
331 Lisp_Object Qwrite_region;
332 Lisp_Object Qverify_visited_file_modtime;
333 Lisp_Object Qset_visited_file_modtime;
335 /* If FILENAME is handled specially on account of its syntax,
336 return its handler function. Otherwise, return nil. */
338 DEFUN ("find-file-name-handler", Ffind_file_name_handler, 1, 2, 0, /*
339 Return FILENAME's handler function for OPERATION, if it has one.
340 Otherwise, return nil.
341 A file name is handled if one of the regular expressions in
342 `file-name-handler-alist' matches it.
344 If OPERATION equals `inhibit-file-name-operation', then we ignore
345 any handlers that are members of `inhibit-file-name-handlers',
346 but we still do run any other handlers. This lets handlers
347 use the standard functions without calling themselves recursively.
349 (filename, operation))
351 /* This function does not GC */
352 /* This function can be called during GC */
353 /* This function must not munge the match data. */
354 Lisp_Object chain, inhibited_handlers;
356 CHECK_STRING (filename);
358 if (EQ (operation, Vinhibit_file_name_operation))
359 inhibited_handlers = Vinhibit_file_name_handlers;
361 inhibited_handlers = Qnil;
363 EXTERNAL_LIST_LOOP (chain, Vfile_name_handler_alist)
365 Lisp_Object elt = XCAR (chain);
368 Lisp_Object string = XCAR (elt);
370 && (fast_lisp_string_match (string, filename) >= 0))
372 Lisp_Object handler = XCDR (elt);
373 if (NILP (Fmemq (handler, inhibited_handlers)))
383 call2_check_string (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
385 /* This function can call lisp */
386 Lisp_Object result = call2 (fn, arg0, arg1);
387 CHECK_STRING (result);
392 call2_check_string_or_nil (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
394 /* This function can call lisp */
395 Lisp_Object result = call2 (fn, arg0, arg1);
397 CHECK_STRING (result);
402 call3_check_string (Lisp_Object fn, Lisp_Object arg0,
403 Lisp_Object arg1, Lisp_Object arg2)
405 /* This function can call lisp */
406 Lisp_Object result = call3 (fn, arg0, arg1, arg2);
407 CHECK_STRING (result);
412 DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /*
413 Return the directory component in file name NAME.
414 Return nil if NAME does not include a directory.
415 Otherwise return a directory spec.
416 Given a Unix syntax file name, returns a string ending in slash.
420 /* This function can GC. GC checked 1997.04.06. */
427 /* If the file name has special constructs in it,
428 call the corresponding file handler. */
429 handler = Ffind_file_name_handler (file, Qfile_name_directory);
431 return call2_check_string_or_nil (handler, Qfile_name_directory, file);
433 #ifdef FILE_SYSTEM_CASE
434 file = FILE_SYSTEM_CASE (file);
436 beg = XSTRING_DATA (file);
437 p = beg + XSTRING_LENGTH (file);
439 while (p != beg && !IS_ANY_SEP (p[-1])
441 /* only recognise drive specifier at beginning */
442 && !(p[-1] == ':' && p == beg + 2)
449 /* Expansion of "c:" to drive and default directory. */
450 /* (NT does the right thing.) */
451 if (p == beg + 2 && beg[1] == ':')
453 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
454 Bufbyte *res = alloca (MAXPATHLEN + 1);
455 if (getdefdir (toupper (*beg) - 'A' + 1, res))
457 if (!IS_DIRECTORY_SEP (res[strlen ((char *) res) - 1]))
458 strcat ((char *) res, "/");
460 p = beg + strlen ((char *) beg);
463 CORRECT_DIR_SEPS (beg);
464 #endif /* WINDOWSNT */
465 return make_string (beg, p - beg);
468 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /*
469 Return file name NAME sans its directory.
470 For example, in a Unix-syntax file name,
471 this is everything after the last slash,
472 or the entire name if it contains no slash.
476 /* This function can GC. GC checked 1997.04.06. */
477 Bufbyte *beg, *p, *end;
482 /* If the file name has special constructs in it,
483 call the corresponding file handler. */
484 handler = Ffind_file_name_handler (file, Qfile_name_nondirectory);
486 return call2_check_string (handler, Qfile_name_nondirectory, file);
488 beg = XSTRING_DATA (file);
489 end = p = beg + XSTRING_LENGTH (file);
491 while (p != beg && !IS_ANY_SEP (p[-1])
493 /* only recognise drive specifier at beginning */
494 && !(p[-1] == ':' && p == beg + 2)
498 return make_string (p, end - p);
501 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /*
502 Return a directly usable directory name somehow associated with FILENAME.
503 A `directly usable' directory name is one that may be used without the
504 intervention of any file handler.
505 If FILENAME is a directly usable file itself, return
506 \(file-name-directory FILENAME).
507 The `call-process' and `start-process' functions use this function to
508 get a current directory to run processes in.
512 /* This function can GC. GC checked 1997.04.06. */
515 /* If the file name has special constructs in it,
516 call the corresponding file handler. */
517 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
519 return call2 (handler, Qunhandled_file_name_directory,
522 return Ffile_name_directory (filename);
527 file_name_as_directory (char *out, char *in)
529 int size = strlen (in);
534 out[1] = DIRECTORY_SEP;
540 /* Append a slash if necessary */
541 if (!IS_ANY_SEP (out[size-1]))
543 out[size] = DIRECTORY_SEP;
544 out[size + 1] = '\0';
548 CORRECT_DIR_SEPS (out);
553 DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /*
554 Return a string representing file FILENAME interpreted as a directory.
555 This operation exists because a directory is also a file, but its name as
556 a directory is different from its name as a file.
557 The result can be used as the value of `default-directory'
558 or passed as second argument to `expand-file-name'.
559 For a Unix-syntax file name, just appends a slash,
560 except for (file-name-as-directory \"\") => \"./\".
564 /* This function can GC. GC checked 1997.04.06. */
570 /* If the file name has special constructs in it,
571 call the corresponding file handler. */
572 handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
574 return call2_check_string (handler, Qfile_name_as_directory, file);
576 buf = (char *) alloca (XSTRING_LENGTH (file) + 10);
577 return build_string (file_name_as_directory
578 (buf, (char *) XSTRING_DATA (file)));
582 * Convert from directory name to filename.
583 * On UNIX, it's simple: just make sure there isn't a terminating /
585 * Value is nonzero if the string output is different from the input.
589 directory_file_name (CONST char *src, char *dst)
594 /* Process as Unix format: just remove any final slash.
595 But leave "/" unchanged; do not change it to "". */
598 /* Handle // as root for apollo's. */
599 if ((slen > 2 && dst[slen - 1] == '/')
600 || (slen > 1 && dst[0] != '/' && dst[slen - 1] == '/'))
604 && IS_DIRECTORY_SEP (dst[slen - 1])
606 && !IS_ANY_SEP (dst[slen - 2])
607 #endif /* WINDOWSNT */
612 CORRECT_DIR_SEPS (dst);
613 #endif /* WINDOWSNT */
617 DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
618 Return the file name of the directory named DIR.
619 This is the name of the file that holds the data for the directory DIR.
620 This operation exists because a directory is also a file, but its name as
621 a directory is different from its name as a file.
622 In Unix-syntax, this function just removes the final slash.
626 /* This function can GC. GC checked 1997.04.06. */
630 CHECK_STRING (directory);
632 #if 0 /* #### WTF? */
633 if (NILP (directory))
637 /* If the file name has special constructs in it,
638 call the corresponding file handler. */
639 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
641 return call2_check_string (handler, Qdirectory_file_name, directory);
642 buf = (char *) alloca (XSTRING_LENGTH (directory) + 20);
643 directory_file_name ((char *) XSTRING_DATA (directory), buf);
644 return build_string (buf);
647 /* Fmake_temp_name used to be a simple wrapper around mktemp(), but it
648 proved too broken for our purposes (it supported only 26 or 62
649 unique names under some implementations). For example, this
650 arbitrary limit broke generation of Gnus Incoming* files.
652 This implementation is better than what one usually finds in libc.
655 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
656 Generate temporary file name starting with PREFIX.
657 The Emacs process number forms part of the result, so there is no
658 danger of generating a name being used by another process.
660 In addition, this function makes an attempt to choose a name that
661 does not specify an existing file. To make this work, PREFIX should
662 be an absolute file name.
666 static char tbl[64] = {
667 'A','B','C','D','E','F','G','H',
668 'I','J','K','L','M','N','O','P',
669 'Q','R','S','T','U','V','W','X',
670 'Y','Z','a','b','c','d','e','f',
671 'g','h','i','j','k','l','m','n',
672 'o','p','q','r','s','t','u','v',
673 'w','x','y','z','0','1','2','3',
674 '4','5','6','7','8','9','-','_' };
675 static unsigned count, count_initialized_p;
682 CHECK_STRING (prefix);
684 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's
687 1) It might change the prefix, so the resulting string might not
688 begin with PREFIX. This violates the principle of least
691 2) It breaks under many unforeseeable circumstances, such as with
692 the code that uses (make-temp-name "") instead of
693 (make-temp-name "./").
695 3) It might yield unexpected (to stat(2)) results in the presence
696 of EFS and file name handlers. */
698 len = XSTRING_LENGTH (prefix);
699 val = make_uninit_string (len + 6);
700 data = XSTRING_DATA (val);
701 memcpy (data, XSTRING_DATA (prefix), len);
704 /* VAL is created by adding 6 characters to PREFIX. The first three
705 are the PID of this process, in base 64, and the second three are
706 incremented if the file already exists. This ensures 262144
707 unique file names per PID per PREFIX. */
709 pid = (unsigned)getpid ();
710 *p++ = tbl[pid & 63], pid >>= 6;
711 *p++ = tbl[pid & 63], pid >>= 6;
712 *p++ = tbl[pid & 63], pid >>= 6;
714 /* Here we try to minimize useless stat'ing when this function is
715 invoked many times successively with the same PREFIX. We achieve
716 this by initializing count to a random value, and incrementing it
718 if (!count_initialized_p)
720 count = (unsigned)time (NULL);
721 /* Dumping temacs with a non-zero count_initialized_p wouldn't
723 if (NILP (Frunning_temacs_p ()))
724 count_initialized_p = 1;
730 unsigned num = count;
732 p[0] = tbl[num & 63], num >>= 6;
733 p[1] = tbl[num & 63], num >>= 6;
734 p[2] = tbl[num & 63], num >>= 6;
736 /* Poor man's congruential RN generator. Replace with ++count
743 if (stat ((CONST char *) data, &ignored) < 0)
745 /* We want to return only if errno is ENOENT. */
749 /* The error here is dubious, but there is little else we
750 can do. The alternatives are to return nil, which is
751 as bad as (and in many cases worse than) throwing the
752 error, or to ignore the error, which will likely result
754 report_file_error ("Cannot create temporary name for prefix",
759 RETURN_NOT_REACHED (Qnil);
763 DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /*
764 Convert filename NAME to absolute, and canonicalize it.
765 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
766 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
767 the current buffer's value of default-directory is used.
768 File name components that are `.' are removed, and
769 so are file name components followed by `..', along with the `..' itself;
770 note that these simplifications are done without checking the resulting
771 file names in the file system.
772 An initial `~/' expands to your home directory.
773 An initial `~USER/' expands to USER's home directory.
774 See also the function `substitute-in-file-name'.
776 (name, default_directory))
778 /* This function can GC */
781 Bufbyte *newdir, *p, *o;
786 int collapse_newdir = 1;
789 #endif /* WINDOWSNT */
798 /* If the file name has special constructs in it,
799 call the corresponding file handler. */
800 handler = Ffind_file_name_handler (name, Qexpand_file_name);
802 return call3_check_string (handler, Qexpand_file_name, name,
805 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
806 if (NILP (default_directory))
807 default_directory = current_buffer->directory;
808 if (! STRINGP (default_directory))
809 default_directory = build_string ("/");
811 if (!NILP (default_directory))
813 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
815 return call3 (handler, Qexpand_file_name, name, default_directory);
818 o = XSTRING_DATA (default_directory);
820 /* Make sure DEFAULT_DIRECTORY is properly expanded.
821 It would be better to do this down below where we actually use
822 default_directory. Unfortunately, calling Fexpand_file_name recursively
823 could invoke GC, and the strings might be relocated. This would
824 be annoying because we have pointers into strings lying around
825 that would need adjusting, and people would add new pointers to
826 the code and forget to adjust them, resulting in intermittent bugs.
827 Putting this call here avoids all that crud.
829 The EQ test avoids infinite recursion. */
830 if (! NILP (default_directory) && !EQ (default_directory, name)
831 /* Save time in some common cases - as long as default_directory
832 is not relative, it can be canonicalized with name below (if it
833 is needed at all) without requiring it to be expanded now. */
835 /* Detect MSDOS file names with drive specifiers. */
836 && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2])))
837 /* Detect Windows file names in UNC format. */
838 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
840 #else /* not WINDOWSNT */
842 /* Detect Unix absolute file names (/... alone is not absolute on
844 && ! (IS_DIRECTORY_SEP (o[0]))
845 #endif /* not WINDOWSNT */
851 default_directory = Fexpand_file_name (default_directory, Qnil);
855 #ifdef FILE_SYSTEM_CASE
856 name = FILE_SYSTEM_CASE (name);
859 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing
860 into name should be safe during all of this, though. */
861 nm = XSTRING_DATA (name);
864 /* We will force directory separators to be either all \ or /, so make
865 a local copy to modify, even if there ends up being no change. */
866 nm = strcpy (alloca (strlen (nm) + 1), nm);
868 /* Find and remove drive specifier if present; this makes nm absolute
869 even if the rest of the name appears to be relative. */
871 Bufbyte *colon = strrchr (nm, ':');
874 /* Only recognize colon as part of drive specifier if there is a
875 single alphabetic character preceeding the colon (and if the
876 character before the drive letter, if present, is a directory
877 separator); this is to support the remote system syntax used by
878 ange-ftp, and the "po:username" syntax for POP mailboxes. */
882 else if (IS_DRIVE (colon[-1])
883 && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2])))
890 while (--colon >= nm)
896 /* If we see "c://somedir", we want to strip the first slash after the
897 colon when stripping the drive letter. Otherwise, this expands to
899 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
901 #endif /* WINDOWSNT */
903 /* If nm is absolute, look for /./ or /../ sequences; if none are
904 found, we can probably return right away. We will avoid allocating
905 a new string if name is already fully expanded. */
907 IS_DIRECTORY_SEP (nm[0])
909 && (drive || IS_DIRECTORY_SEP (nm[1]))
913 /* If it turns out that the filename we want to return is just a
914 suffix of FILENAME, we don't need to go through and edit
915 things; we just need to construct a new string using data
916 starting at the middle of FILENAME. If we set lose to a
917 non-zero value, that means we've discovered that we can't do
924 /* Since we know the name is absolute, we can assume that each
925 element starts with a "/". */
927 /* "." and ".." are hairy. */
928 if (IS_DIRECTORY_SEP (p[0])
930 && (IS_DIRECTORY_SEP (p[2])
932 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
940 /* Make sure directories are all separated with / or \ as
941 desired, but avoid allocation of a new string when not
943 CORRECT_DIR_SEPS (nm);
944 if (IS_DIRECTORY_SEP (nm[1]))
946 if (strcmp (nm, XSTRING_DATA (name)) != 0)
947 name = build_string (nm);
949 /* drive must be set, so this is okay */
950 else if (strcmp (nm - 2, XSTRING_DATA (name)) != 0)
952 name = make_string (nm - 2, p - nm + 2);
953 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
954 XSTRING_DATA (name)[1] = ':';
957 #else /* not WINDOWSNT */
958 if (nm == XSTRING_DATA (name))
960 return build_string ((char *) nm);
961 #endif /* not WINDOWSNT */
965 /* At this point, nm might or might not be an absolute file name. We
966 need to expand ~ or ~user if present, otherwise prefix nm with
967 default_directory if nm is not absolute, and finally collapse /./
968 and /foo/../ sequences.
970 We set newdir to be the appropriate prefix if one is needed:
971 - the relevant user directory if nm starts with ~ or ~user
972 - the specified drive's working dir (DOS/NT only) if nm does not
974 - the value of default_directory.
976 Note that these prefixes are not guaranteed to be absolute (except
977 for the working dir of a drive). Therefore, to ensure we always
978 return an absolute name, if the final prefix is not absolute we
979 append it to the current working directory. */
983 if (nm[0] == '~') /* prefix ~ */
985 if (IS_DIRECTORY_SEP (nm[1])
986 || nm[1] == 0) /* ~ by itself */
988 if (!(newdir = (Bufbyte *) get_home_directory()))
989 newdir = (Bufbyte *) "";
995 else /* ~user/filename */
997 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 if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
1264 CORRECT_DIR_SEPS (target);
1265 #endif /* WINDOWSNT */
1267 return make_string (target, o - target);
1271 /* another older version of expand-file-name; */
1274 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /*
1275 Return the canonical name of the given FILE.
1276 Second arg DEFAULT is directory to start with if FILE is relative
1277 (does not start with slash); if DEFAULT is nil or missing,
1278 the current buffer's value of default-directory is used.
1279 No component of the resulting pathname will be a symbolic link, as
1280 in the realpath() function.
1282 (filename, default_))
1284 /* This function can GC. GC checked 1997.04.06. */
1285 Lisp_Object expanded_name;
1286 Lisp_Object handler;
1287 struct gcpro gcpro1;
1289 CHECK_STRING (filename);
1291 expanded_name = Fexpand_file_name (filename, default_);
1293 if (!STRINGP (expanded_name))
1296 GCPRO1 (expanded_name);
1297 handler = Ffind_file_name_handler (expanded_name, Qfile_truename);
1300 if (!NILP (handler))
1301 return call2_check_string (handler, Qfile_truename, expanded_name);
1304 char resolved_path[MAXPATHLEN];
1305 char path[MAXPATHLEN];
1307 int elen = XSTRING_LENGTH (expanded_name);
1309 if (elen >= countof (path))
1312 memcpy (path, XSTRING_DATA (expanded_name), elen + 1);
1313 /* memset (resolved_path, 0, sizeof (resolved_path)); */
1315 /* Try doing it all at once. */
1316 /* !!#### Does realpath() Mule-encapsulate? */
1317 if (!xrealpath (path, resolved_path))
1319 /* Didn't resolve it -- have to do it one component at a time. */
1320 /* "realpath" is a typically useless, stupid un*x piece of crap.
1321 It claims to return a useful value in the "error" case, but since
1322 there is no indication provided of how far along the pathname
1323 the function went before erring, there is no way to use the
1324 partial result returned. What a piece of junk. */
1327 p = (char *) memchr (p + 1, '/', elen - (p + 1 - path));
1331 /* memset (resolved_path, 0, sizeof (resolved_path)); */
1332 if (xrealpath (path, resolved_path))
1340 else if (errno == ENOENT || errno == EACCES)
1342 /* Failed on this component. Just tack on the rest of
1343 the string and we are done. */
1344 int rlen = strlen (resolved_path);
1346 /* "On failure, it returns NULL, sets errno to indicate
1347 the error, and places in resolved_path the absolute pathname
1348 of the path component which could not be resolved." */
1351 int plen = elen - (p - path);
1353 if (rlen > 1 && resolved_path[rlen - 1] == '/')
1356 if (plen + rlen + 1 > countof (resolved_path))
1359 resolved_path[rlen] = '/';
1360 memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1);
1370 int rlen = strlen (resolved_path);
1371 if (elen > 0 && XSTRING_BYTE (expanded_name, elen - 1) == '/'
1372 && !(rlen > 0 && resolved_path[rlen - 1] == '/'))
1374 if (rlen + 1 > countof (resolved_path))
1376 resolved_path[rlen] = '/';
1377 resolved_path[rlen + 1] = 0;
1380 return make_ext_string ((Bufbyte *) resolved_path, rlen, FORMAT_BINARY);
1384 errno = ENAMETOOLONG;
1387 report_file_error ("Finding truename", list1 (expanded_name));
1389 return Qnil; /* suppress compiler warning */
1393 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
1394 Substitute environment variables referred to in FILENAME.
1395 `$FOO' where FOO is an environment variable name means to substitute
1396 the value of that variable. The variable name should be terminated
1397 with a character not a letter, digit or underscore; otherwise, enclose
1398 the entire variable name in braces.
1399 If `/~' appears, all of FILENAME through that `/' is discarded.
1404 /* This function can GC. GC checked 1997.04.06. */
1407 Bufbyte *s, *p, *o, *x, *endp;
1408 Bufbyte *target = 0;
1410 int substituted = 0;
1412 Lisp_Object handler;
1414 CHECK_STRING (string);
1416 /* If the file name has special constructs in it,
1417 call the corresponding file handler. */
1418 handler = Ffind_file_name_handler (string, Qsubstitute_in_file_name);
1419 if (!NILP (handler))
1420 return call2_check_string_or_nil (handler, Qsubstitute_in_file_name,
1423 nm = XSTRING_DATA (string);
1424 endp = nm + XSTRING_LENGTH (string);
1426 /* If /~ or // appears, discard everything through first slash. */
1428 for (p = nm; p != endp; p++)
1431 #if defined (APOLLO) || defined (WINDOWSNT) || defined (__CYGWIN32__)
1432 /* // at start of file name is meaningful in Apollo and
1433 WindowsNT systems */
1434 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
1435 #else /* not (APOLLO || WINDOWSNT || __CYGWIN32__) */
1436 || IS_DIRECTORY_SEP (p[0])
1437 #endif /* not (APOLLO || WINDOWSNT || __CYGWIN32__) */
1440 && (IS_DIRECTORY_SEP (p[-1])))
1446 /* see comment in expand-file-name about drive specifiers */
1447 else if (IS_DRIVE (p[0]) && p[1] == ':'
1448 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1453 #endif /* WINDOWSNT */
1456 /* See if any variables are substituted into the string
1457 and find the total length of their values in `total' */
1459 for (p = nm; p != endp;)
1469 /* "$$" means a single "$" */
1478 while (p != endp && *p != '}') p++;
1479 if (*p != '}') goto missingclose;
1485 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1489 /* Copy out the variable name */
1490 target = (Bufbyte *) alloca (s - o + 1);
1491 strncpy ((char *) target, (char *) o, s - o);
1494 strupr (target); /* $home == $HOME etc. */
1495 #endif /* WINDOWSNT */
1497 /* Get variable value */
1498 o = (Bufbyte *) egetenv ((char *) target);
1499 if (!o) goto badvar;
1500 total += strlen ((char *) o);
1507 /* If substitution required, recopy the string and do it */
1508 /* Make space in stack frame for the new copy */
1509 xnm = (Bufbyte *) alloca (XSTRING_LENGTH (string) + total + 1);
1512 /* Copy the rest of the name through, replacing $ constructs with values */
1529 while (p != endp && *p != '}') p++;
1530 if (*p != '}') goto missingclose;
1536 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1540 /* Copy out the variable name */
1541 target = (Bufbyte *) alloca (s - o + 1);
1542 strncpy ((char *) target, (char *) o, s - o);
1545 strupr (target); /* $home == $HOME etc. */
1546 #endif /* WINDOWSNT */
1548 /* Get variable value */
1549 o = (Bufbyte *) egetenv ((char *) target);
1553 strcpy ((char *) x, (char *) o);
1554 x += strlen ((char *) o);
1559 /* If /~ or // appears, discard everything through first slash. */
1561 for (p = xnm; p != x; p++)
1563 #if defined (APOLLO) || defined (WINDOWSNT)
1564 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
1565 #else /* not (APOLLO || WINDOWSNT) */
1566 || IS_DIRECTORY_SEP (p[0])
1567 #endif /* APOLLO || WINDOWSNT */
1569 /* don't do p[-1] if that would go off the beginning --jwz */
1570 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1]))
1573 else if (IS_DRIVE (p[0]) && p[1] == ':'
1574 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1578 return make_string (xnm, x - xnm);
1581 error ("Bad format environment-variable substitution");
1583 error ("Missing \"}\" in environment-variable substitution");
1585 error ("Substituting nonexistent environment variable \"%s\"",
1589 return Qnil; /* suppress compiler warning */
1592 /* A slightly faster and more convenient way to get
1593 (directory-file-name (expand-file-name FOO)). */
1596 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
1598 /* This function can call lisp */
1599 Lisp_Object abspath;
1600 struct gcpro gcpro1;
1602 abspath = Fexpand_file_name (filename, defdir);
1604 /* Remove final slash, if any (unless path is root).
1605 stat behaves differently depending! */
1606 if (XSTRING_LENGTH (abspath) > 1
1607 && IS_DIRECTORY_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1))
1608 && !IS_DEVICE_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 2)))
1609 /* We cannot take shortcuts; they might be wrong for magic file names. */
1610 abspath = Fdirectory_file_name (abspath);
1615 /* Signal an error if the file ABSNAME already exists.
1616 If INTERACTIVE is nonzero, ask the user whether to proceed,
1617 and bypass the error if the user says to go ahead.
1618 QUERYSTRING is a name for the action that is being considered
1620 *STATPTR is used to store the stat information if the file exists.
1621 If the file does not exist, STATPTR->st_mode is set to 0. */
1624 barf_or_query_if_file_exists (Lisp_Object absname, CONST char *querystring,
1625 int interactive, struct stat *statptr)
1627 /* This function can GC. GC checked 1997.04.06. */
1628 struct stat statbuf;
1630 /* stat is a good way to tell whether the file exists,
1631 regardless of what access permissions it has. */
1632 if (stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0)
1639 struct gcpro gcpro1;
1641 prompt = emacs_doprnt_string_c
1642 ((CONST Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "),
1643 Qnil, -1, XSTRING_DATA (absname),
1644 GETTEXT (querystring));
1647 tem = call1 (Qyes_or_no_p, prompt);
1654 Fsignal (Qfile_already_exists,
1655 list2 (build_translated_string ("File already exists"),
1663 statptr->st_mode = 0;
1668 DEFUN ("copy-file", Fcopy_file, 2, 4,
1669 "fCopy file: \nFCopy %s to file: \np\nP", /*
1670 Copy FILE to NEWNAME. Both args must be strings.
1671 Signals a `file-already-exists' error if file NEWNAME already exists,
1672 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
1673 A number as third arg means request confirmation if NEWNAME already exists.
1674 This is what happens in interactive use with M-x.
1675 Fourth arg KEEP-TIME non-nil means give the new file the same
1676 last-modified time as the old one. (This works on only some systems.)
1677 A prefix arg makes KEEP-TIME non-nil.
1679 (filename, newname, ok_if_already_exists, keep_time))
1681 /* This function can GC. GC checked 1997.04.06. */
1683 char buf[16 * 1024];
1684 struct stat st, out_st;
1685 Lisp_Object handler;
1686 int speccount = specpdl_depth ();
1687 struct gcpro gcpro1, gcpro2;
1688 /* Lisp_Object args[6]; */
1689 int input_file_statable_p;
1691 GCPRO2 (filename, newname);
1692 CHECK_STRING (filename);
1693 CHECK_STRING (newname);
1694 filename = Fexpand_file_name (filename, Qnil);
1695 newname = Fexpand_file_name (newname, Qnil);
1697 /* If the input file name has special constructs in it,
1698 call the corresponding file handler. */
1699 handler = Ffind_file_name_handler (filename, Qcopy_file);
1700 /* Likewise for output file name. */
1702 handler = Ffind_file_name_handler (newname, Qcopy_file);
1703 if (!NILP (handler))
1706 return call5 (handler, Qcopy_file, filename, newname,
1707 ok_if_already_exists, keep_time);
1710 /* When second argument is a directory, copy the file into it.
1711 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
1713 if (!NILP (Ffile_directory_p (newname)))
1715 Lisp_Object args[3];
1716 struct gcpro ngcpro1;
1720 args[1] = Qnil; args[2] = Qnil;
1723 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
1724 args[i++] = build_string ("/");
1725 args[i++] = Ffile_name_nondirectory (filename);
1726 newname = Fconcat (i, args);
1730 if (NILP (ok_if_already_exists)
1731 || INTP (ok_if_already_exists))
1732 barf_or_query_if_file_exists (newname, "copy to it",
1733 INTP (ok_if_already_exists), &out_st);
1734 else if (stat ((CONST char *) XSTRING_DATA (newname), &out_st) < 0)
1737 ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0);
1739 report_file_error ("Opening input file", list1 (filename));
1741 record_unwind_protect (close_file_unwind, make_int (ifd));
1743 /* We can only copy regular files and symbolic links. Other files are not
1745 input_file_statable_p = (fstat (ifd, &st) >= 0);
1748 if (out_st.st_mode != 0
1749 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
1752 report_file_error ("Input and output files are the same",
1753 list2 (filename, newname));
1757 #if defined (S_ISREG) && defined (S_ISLNK)
1758 if (input_file_statable_p)
1760 if (!(S_ISREG (st.st_mode))
1761 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
1763 && !(S_ISCHR (st.st_mode))
1765 && !(S_ISLNK (st.st_mode)))
1767 #if defined (EISDIR)
1768 /* Get a better looking error message. */
1771 report_file_error ("Non-regular file", list1 (filename));
1774 #endif /* S_ISREG && S_ISLNK */
1776 ofd = open( (char *) XSTRING_DATA (newname),
1777 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
1779 report_file_error ("Opening output file", list1 (newname));
1782 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil);
1784 record_unwind_protect (close_file_unwind, ofd_locative);
1786 while ((n = read_allowing_quit (ifd, buf, sizeof (buf))) > 0)
1788 if (write_allowing_quit (ofd, buf, n) != n)
1789 report_file_error ("I/O error", list1 (newname));
1792 /* Closing the output clobbers the file times on some systems. */
1793 if (close (ofd) < 0)
1794 report_file_error ("I/O error", list1 (newname));
1796 if (input_file_statable_p)
1798 if (!NILP (keep_time))
1800 EMACS_TIME atime, mtime;
1801 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
1802 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
1803 if (set_file_times ((char *) XSTRING_DATA (newname), atime,
1805 report_file_error ("I/O error", list1 (newname));
1807 chmod ((CONST char *) XSTRING_DATA (newname),
1808 st.st_mode & 07777);
1811 /* We'll close it by hand */
1812 XCAR (ofd_locative) = Qnil;
1815 unbind_to (speccount, Qnil);
1822 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
1823 Create a directory. One argument, a file name string.
1827 /* This function can GC. GC checked 1997.04.06. */
1828 char dir [MAXPATHLEN];
1829 Lisp_Object handler;
1830 struct gcpro gcpro1;
1832 CHECK_STRING (dirname_);
1833 dirname_ = Fexpand_file_name (dirname_, Qnil);
1836 handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal);
1838 if (!NILP (handler))
1839 return (call2 (handler, Qmake_directory_internal, dirname_));
1841 if (XSTRING_LENGTH (dirname_) > (Bytecount) (sizeof (dir) - 1))
1843 return Fsignal (Qfile_error,
1844 list3 (build_translated_string ("Creating directory"),
1845 build_translated_string ("pathame too long"),
1848 strncpy (dir, (char *) XSTRING_DATA (dirname_),
1849 XSTRING_LENGTH (dirname_) + 1);
1851 if (dir [XSTRING_LENGTH (dirname_) - 1] == '/')
1852 dir [XSTRING_LENGTH (dirname_) - 1] = 0;
1854 if (mkdir (dir, 0777) != 0)
1855 report_file_error ("Creating directory", list1 (dirname_));
1860 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
1861 Delete a directory. One argument, a file name or directory name string.
1865 /* This function can GC. GC checked 1997.04.06. */
1866 Lisp_Object handler;
1867 struct gcpro gcpro1;
1869 CHECK_STRING (dirname_);
1872 dirname_ = Fexpand_file_name (dirname_, Qnil);
1873 dirname_ = Fdirectory_file_name (dirname_);
1875 handler = Ffind_file_name_handler (dirname_, Qdelete_directory);
1877 if (!NILP (handler))
1878 return (call2 (handler, Qdelete_directory, dirname_));
1880 if (rmdir ((char *) XSTRING_DATA (dirname_)) != 0)
1881 report_file_error ("Removing directory", list1 (dirname_));
1886 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
1887 Delete specified file. One argument, a file name string.
1888 If file has multiple names, it continues to exist with the other names.
1892 /* This function can GC. GC checked 1997.04.06. */
1893 Lisp_Object handler;
1894 struct gcpro gcpro1;
1896 CHECK_STRING (filename);
1897 filename = Fexpand_file_name (filename, Qnil);
1900 handler = Ffind_file_name_handler (filename, Qdelete_file);
1902 if (!NILP (handler))
1903 return call2 (handler, Qdelete_file, filename);
1905 if (0 > unlink ((char *) XSTRING_DATA (filename)))
1906 report_file_error ("Removing old name", list1 (filename));
1911 internal_delete_file_1 (Lisp_Object ignore, Lisp_Object ignore2)
1916 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1919 internal_delete_file (Lisp_Object filename)
1921 /* This function can GC. GC checked 1997.04.06. */
1922 return NILP (condition_case_1 (Qt, Fdelete_file, filename,
1923 internal_delete_file_1, Qnil));
1926 DEFUN ("rename-file", Frename_file, 2, 3,
1927 "fRename file: \nFRename %s to file: \np", /*
1928 Rename FILE as NEWNAME. Both args strings.
1929 If file has names other than FILE, it continues to have those names.
1930 Signals a `file-already-exists' error if a file NEWNAME already exists
1931 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1932 A number as third arg means request confirmation if NEWNAME already exists.
1933 This is what happens in interactive use with M-x.
1935 (filename, newname, ok_if_already_exists))
1937 /* This function can GC. GC checked 1997.04.06. */
1938 Lisp_Object handler;
1939 struct gcpro gcpro1, gcpro2;
1941 GCPRO2 (filename, newname);
1942 CHECK_STRING (filename);
1943 CHECK_STRING (newname);
1944 filename = Fexpand_file_name (filename, Qnil);
1945 newname = Fexpand_file_name (newname, Qnil);
1947 /* If the file name has special constructs in it,
1948 call the corresponding file handler. */
1949 handler = Ffind_file_name_handler (filename, Qrename_file);
1951 handler = Ffind_file_name_handler (newname, Qrename_file);
1952 if (!NILP (handler))
1955 return call4 (handler, Qrename_file,
1956 filename, newname, ok_if_already_exists);
1959 /* When second argument is a directory, rename the file into it.
1960 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
1962 if (!NILP (Ffile_directory_p (newname)))
1964 Lisp_Object args[3];
1965 struct gcpro ngcpro1;
1969 args[1] = Qnil; args[2] = Qnil;
1972 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
1973 args[i++] = build_string ("/");
1974 args[i++] = Ffile_name_nondirectory (filename);
1975 newname = Fconcat (i, args);
1979 if (NILP (ok_if_already_exists)
1980 || INTP (ok_if_already_exists))
1981 barf_or_query_if_file_exists (newname, "rename to it",
1982 INTP (ok_if_already_exists), 0);
1984 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
1985 WINDOWSNT here; I've removed it. --marcpa */
1987 /* FSFmacs only calls rename() here under BSD 4.1, and calls
1988 link() and unlink() otherwise, but that's bogus. Sometimes
1989 rename() succeeds where link()/unlink() fail, and we have
1990 configure check for rename() and emulate using link()/unlink()
1992 if (0 > rename ((char *) XSTRING_DATA (filename),
1993 (char *) XSTRING_DATA (newname)))
1997 Fcopy_file (filename, newname,
1998 /* We have already prompted if it was an integer,
1999 so don't have copy-file prompt again. */
2000 ((NILP (ok_if_already_exists)) ? Qnil : Qt),
2002 Fdelete_file (filename);
2006 report_file_error ("Renaming", list2 (filename, newname));
2013 DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3,
2014 "fAdd name to file: \nFName to add to %s: \np", /*
2015 Give FILE additional name NEWNAME. Both args strings.
2016 Signals a `file-already-exists' error if a file NEWNAME already exists
2017 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2018 A number as third arg means request confirmation if NEWNAME already exists.
2019 This is what happens in interactive use with M-x.
2021 (filename, newname, ok_if_already_exists))
2023 /* This function can GC. GC checked 1997.04.06. */
2024 Lisp_Object handler;
2025 struct gcpro gcpro1, gcpro2;
2027 GCPRO2 (filename, newname);
2028 CHECK_STRING (filename);
2029 CHECK_STRING (newname);
2030 filename = Fexpand_file_name (filename, Qnil);
2031 newname = Fexpand_file_name (newname, Qnil);
2033 /* If the file name has special constructs in it,
2034 call the corresponding file handler. */
2035 handler = Ffind_file_name_handler (filename, Qadd_name_to_file);
2036 if (!NILP (handler))
2037 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2038 newname, ok_if_already_exists));
2040 /* If the new name has special constructs in it,
2041 call the corresponding file handler. */
2042 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2043 if (!NILP (handler))
2044 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2045 newname, ok_if_already_exists));
2047 if (NILP (ok_if_already_exists)
2048 || INTP (ok_if_already_exists))
2049 barf_or_query_if_file_exists (newname, "make it a new name",
2050 INTP (ok_if_already_exists), 0);
2051 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
2052 on NT here. --marcpa */
2053 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
2054 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
2055 Reverted to previous behaviour pending a working fix. (jhar) */
2056 #if defined(WINDOWSNT)
2057 /* Windows does not support this operation. */
2058 report_file_error ("Adding new name", Flist (2, &filename));
2059 #else /* not defined(WINDOWSNT) */
2061 unlink ((char *) XSTRING_DATA (newname));
2062 if (0 > link ((char *) XSTRING_DATA (filename),
2063 (char *) XSTRING_DATA (newname)))
2065 report_file_error ("Adding new name",
2066 list2 (filename, newname));
2068 #endif /* defined(WINDOWSNT) */
2075 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3,
2076 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
2077 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2078 Signals a `file-already-exists' error if a file LINKNAME already exists
2079 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2080 A number as third arg means request confirmation if LINKNAME already exists.
2081 This happens for interactive use with M-x.
2083 (filename, linkname, ok_if_already_exists))
2085 /* This function can GC. GC checked 1997.06.04. */
2086 Lisp_Object handler;
2087 struct gcpro gcpro1, gcpro2;
2089 GCPRO2 (filename, linkname);
2090 CHECK_STRING (filename);
2091 CHECK_STRING (linkname);
2092 /* If the link target has a ~, we must expand it to get
2093 a truly valid file name. Otherwise, do not expand;
2094 we want to permit links to relative file names. */
2095 if (XSTRING_BYTE (filename, 0) == '~')
2096 filename = Fexpand_file_name (filename, Qnil);
2097 linkname = Fexpand_file_name (linkname, Qnil);
2099 /* If the file name has special constructs in it,
2100 call the corresponding file handler. */
2101 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
2102 if (!NILP (handler))
2103 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname,
2104 ok_if_already_exists));
2106 /* If the new link name has special constructs in it,
2107 call the corresponding file handler. */
2108 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2109 if (!NILP (handler))
2110 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2111 linkname, ok_if_already_exists));
2113 if (NILP (ok_if_already_exists)
2114 || INTP (ok_if_already_exists))
2115 barf_or_query_if_file_exists (linkname, "make it a link",
2116 INTP (ok_if_already_exists), 0);
2118 unlink ((char *) XSTRING_DATA (linkname));
2119 if (0 > symlink ((char *) XSTRING_DATA (filename),
2120 (char *) XSTRING_DATA (linkname)))
2122 report_file_error ("Making symbolic link",
2123 list2 (filename, linkname));
2128 #endif /* S_IFLNK */
2132 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
2133 Open a network connection to PATH using LOGIN as the login string.
2139 CHECK_STRING (path);
2140 CHECK_STRING (login);
2142 /* netunam, being a strange-o system call only used once, is not
2148 GET_C_STRING_FILENAME_DATA_ALLOCA (path, path_ext);
2149 GET_C_STRING_EXT_DATA_ALLOCA (login, FORMAT_OS, login_ext);
2151 netresult = netunam (path_ext, login_ext);
2154 if (netresult == -1)
2159 #endif /* HPUX_NET */
2161 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
2162 Return t if file FILENAME specifies an absolute path name.
2163 On Unix, this is a name starting with a `/' or a `~'.
2167 /* This function does not GC */
2170 CHECK_STRING (filename);
2171 ptr = XSTRING_DATA (filename);
2172 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
2174 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
2179 /* Return nonzero if file FILENAME exists and can be executed. */
2182 check_executable (char *filename)
2186 if (stat (filename, &st) < 0)
2188 return ((st.st_mode & S_IEXEC) != 0);
2189 #else /* not WINDOWSNT */
2191 return eaccess (filename, 1) >= 0;
2193 /* Access isn't quite right because it uses the real uid
2194 and we really want to test with the effective uid.
2195 But Unix doesn't give us a right way to do it. */
2196 return access (filename, 1) >= 0;
2197 #endif /* HAVE_EACCESS */
2198 #endif /* not WINDOWSNT */
2201 /* Return nonzero if file FILENAME exists and can be written. */
2204 check_writable (CONST char *filename)
2207 return (eaccess (filename, 2) >= 0);
2209 /* Access isn't quite right because it uses the real uid
2210 and we really want to test with the effective uid.
2211 But Unix doesn't give us a right way to do it.
2212 Opening with O_WRONLY could work for an ordinary file,
2213 but would lose for directories. */
2214 return (access (filename, 2) >= 0);
2218 DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
2219 Return t if file FILENAME exists. (This does not mean you can read it.)
2220 See also `file-readable-p' and `file-attributes'.
2224 /* This function can call lisp */
2225 Lisp_Object abspath;
2226 Lisp_Object handler;
2227 struct stat statbuf;
2228 struct gcpro gcpro1;
2230 CHECK_STRING (filename);
2231 abspath = Fexpand_file_name (filename, Qnil);
2233 /* If the file name has special constructs in it,
2234 call the corresponding file handler. */
2236 handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
2238 if (!NILP (handler))
2239 return call2 (handler, Qfile_exists_p, abspath);
2241 return stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
2244 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
2245 Return t if FILENAME can be executed by you.
2246 For a directory, this means you can access files in that directory.
2251 /* This function can GC. GC checked 1997.04.10. */
2252 Lisp_Object abspath;
2253 Lisp_Object handler;
2254 struct gcpro gcpro1;
2256 CHECK_STRING (filename);
2257 abspath = Fexpand_file_name (filename, Qnil);
2259 /* If the file name has special constructs in it,
2260 call the corresponding file handler. */
2262 handler = Ffind_file_name_handler (abspath, Qfile_executable_p);
2264 if (!NILP (handler))
2265 return call2 (handler, Qfile_executable_p, abspath);
2267 return check_executable ((char *) XSTRING_DATA (abspath)) ? Qt : Qnil;
2270 DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
2271 Return t if file FILENAME exists and you can read it.
2272 See also `file-exists-p' and `file-attributes'.
2276 /* This function can GC */
2277 Lisp_Object abspath = Qnil;
2278 Lisp_Object handler;
2279 struct gcpro gcpro1;
2282 CHECK_STRING (filename);
2283 abspath = Fexpand_file_name (filename, Qnil);
2285 /* If the file name has special constructs in it,
2286 call the corresponding file handler. */
2287 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
2288 if (!NILP (handler))
2289 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
2292 /* Under MS-DOS and Windows, open does not work for directories. */
2294 if (access (XSTRING_DATA (abspath), 0) == 0)
2298 #else /* not WINDOWSNT */
2300 int desc = interruptible_open ((char *) XSTRING_DATA (abspath), O_RDONLY | OPEN_BINARY, 0);
2307 #endif /* not WINDOWSNT */
2310 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2312 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
2313 Return t if file FILENAME can be written or created by you.
2317 /* This function can GC. GC checked 1997.04.10. */
2318 Lisp_Object abspath, dir;
2319 Lisp_Object handler;
2320 struct stat statbuf;
2321 struct gcpro gcpro1;
2323 CHECK_STRING (filename);
2324 abspath = Fexpand_file_name (filename, Qnil);
2326 /* If the file name has special constructs in it,
2327 call the corresponding file handler. */
2329 handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
2331 if (!NILP (handler))
2332 return call2 (handler, Qfile_writable_p, abspath);
2334 if (stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0)
2335 return (check_writable ((char *) XSTRING_DATA (abspath))
2340 dir = Ffile_name_directory (abspath);
2342 return (check_writable (!NILP (dir) ? (char *) XSTRING_DATA (dir)
2347 DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
2348 Return non-nil if file FILENAME is the name of a symbolic link.
2349 The value is the name of the file to which it is linked.
2350 Otherwise returns nil.
2354 /* This function can GC. GC checked 1997.04.10. */
2360 Lisp_Object handler;
2361 struct gcpro gcpro1;
2363 CHECK_STRING (filename);
2364 filename = Fexpand_file_name (filename, Qnil);
2366 /* If the file name has special constructs in it,
2367 call the corresponding file handler. */
2369 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
2371 if (!NILP (handler))
2372 return call2 (handler, Qfile_symlink_p, filename);
2377 buf = xnew_array_and_zero (char, bufsize);
2378 valsize = readlink ((char *) XSTRING_DATA (filename),
2380 if (valsize < bufsize) break;
2381 /* Buffer was not long enough */
2390 val = make_string ((Bufbyte *) buf, valsize);
2393 #else /* not S_IFLNK */
2395 #endif /* not S_IFLNK */
2398 DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
2399 Return t if file FILENAME is the name of a directory as a file.
2400 A directory name spec may be given instead; then the value is t
2401 if the directory so specified exists and really is a directory.
2405 /* This function can GC. GC checked 1997.04.10. */
2406 Lisp_Object abspath;
2408 Lisp_Object handler;
2409 struct gcpro gcpro1;
2411 GCPRO1 (current_buffer->directory);
2412 abspath = expand_and_dir_to_file (filename,
2413 current_buffer->directory);
2416 /* If the file name has special constructs in it,
2417 call the corresponding file handler. */
2419 handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
2421 if (!NILP (handler))
2422 return call2 (handler, Qfile_directory_p, abspath);
2424 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2426 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2429 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
2430 Return t if file FILENAME is the name of a directory as a file,
2431 and files in that directory can be opened by you. In order to use a
2432 directory as a buffer's current directory, this predicate must return true.
2433 A directory name spec may be given instead; then the value is t
2434 if the directory so specified exists and really is a readable and
2435 searchable directory.
2439 /* This function can GC. GC checked 1997.04.10. */
2440 Lisp_Object handler;
2442 /* If the file name has special constructs in it,
2443 call the corresponding file handler. */
2444 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
2445 if (!NILP (handler))
2446 return call2 (handler, Qfile_accessible_directory_p,
2449 #if !defined(WINDOWSNT)
2450 if (NILP (Ffile_directory_p (filename)))
2453 return Ffile_executable_p (filename);
2457 struct gcpro gcpro1;
2458 /* It's an unlikely combination, but yes we really do need to gcpro:
2459 Suppose that file-accessible-directory-p has no handler, but
2460 file-directory-p does have a handler; this handler causes a GC which
2461 relocates the string in `filename'; and finally file-directory-p
2462 returns non-nil. Then we would end up passing a garbaged string
2463 to file-executable-p. */
2465 tem = (NILP (Ffile_directory_p (filename))
2466 || NILP (Ffile_executable_p (filename)));
2468 return tem ? Qnil : Qt;
2470 #endif /* !defined(WINDOWSNT) */
2473 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
2474 Return t if file FILENAME is the name of a regular file.
2475 This is the sort of file that holds an ordinary stream of data bytes.
2479 /* This function can GC. GC checked 1997.04.10. */
2480 Lisp_Object abspath;
2482 Lisp_Object handler;
2483 struct gcpro gcpro1;
2485 GCPRO1 (current_buffer->directory);
2486 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
2489 /* If the file name has special constructs in it,
2490 call the corresponding file handler. */
2492 handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
2494 if (!NILP (handler))
2495 return call2 (handler, Qfile_regular_p, abspath);
2497 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2499 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2502 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
2503 Return mode bits of FILE, as an integer.
2507 /* This function can GC. GC checked 1997.04.10. */
2508 Lisp_Object abspath;
2510 Lisp_Object handler;
2511 struct gcpro gcpro1;
2513 GCPRO1 (current_buffer->directory);
2514 abspath = expand_and_dir_to_file (filename,
2515 current_buffer->directory);
2518 /* If the file name has special constructs in it,
2519 call the corresponding file handler. */
2521 handler = Ffind_file_name_handler (abspath, Qfile_modes);
2523 if (!NILP (handler))
2524 return call2 (handler, Qfile_modes, abspath);
2526 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2528 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
2531 if (check_executable (XSTRING (abspath)->_data))
2532 st.st_mode |= S_IEXEC;
2536 return make_int (st.st_mode & 07777);
2539 DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /*
2540 Set mode bits of FILE to MODE (an integer).
2541 Only the 12 low bits of MODE are used.
2545 /* This function can GC. GC checked 1997.04.10. */
2546 Lisp_Object abspath;
2547 Lisp_Object handler;
2548 struct gcpro gcpro1;
2550 GCPRO1 (current_buffer->directory);
2551 abspath = Fexpand_file_name (filename, current_buffer->directory);
2556 /* If the file name has special constructs in it,
2557 call the corresponding file handler. */
2559 handler = Ffind_file_name_handler (abspath, Qset_file_modes);
2561 if (!NILP (handler))
2562 return call3 (handler, Qset_file_modes, abspath, mode);
2564 if (chmod ((char *) XSTRING_DATA (abspath), XINT (mode)) < 0)
2565 report_file_error ("Doing chmod", list1 (abspath));
2570 DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
2571 Set the file permission bits for newly created files.
2572 MASK should be an integer; if a permission's bit in MASK is 1,
2573 subsequently created files will not have that permission enabled.
2574 Only the low 9 bits are used.
2575 This setting is inherited by subprocesses.
2581 umask ((~ XINT (mode)) & 0777);
2586 DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
2587 Return the default file protection for created files.
2588 The umask value determines which permissions are enabled in newly
2589 created files. If a permission's bit in the umask is 1, subsequently
2590 created files will not have that permission enabled.
2599 return make_int ((~ mode) & 0777);
2602 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /*
2603 Tell Unix to finish all pending disk updates.
2614 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
2615 Return t if file FILE1 is newer than file FILE2.
2616 If FILE1 does not exist, the answer is nil;
2617 otherwise, if FILE2 does not exist, the answer is t.
2621 /* This function can GC. GC checked 1997.04.10. */
2622 Lisp_Object abspath1, abspath2;
2625 Lisp_Object handler;
2626 struct gcpro gcpro1, gcpro2, gcpro3;
2628 CHECK_STRING (file1);
2629 CHECK_STRING (file2);
2634 GCPRO3 (abspath1, abspath2, current_buffer->directory);
2635 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
2636 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
2638 /* If the file name has special constructs in it,
2639 call the corresponding file handler. */
2640 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p);
2642 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p);
2644 if (!NILP (handler))
2645 return call3 (handler, Qfile_newer_than_file_p, abspath1,
2648 if (stat ((char *) XSTRING_DATA (abspath1), &st) < 0)
2651 mtime1 = st.st_mtime;
2653 if (stat ((char *) XSTRING_DATA (abspath2), &st) < 0)
2656 return (mtime1 > st.st_mtime) ? Qt : Qnil;
2660 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
2661 /* #define READ_BUF_SIZE (2 << 16) */
2662 #define READ_BUF_SIZE (1 << 15)
2664 DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal,
2666 Insert contents of file FILENAME after point; no coding-system frobbing.
2667 This function is identical to `insert-file-contents' except for the
2668 handling of the CODESYS and USED-CODESYS arguments under
2669 XEmacs/Mule. (When Mule support is not present, both functions are
2670 identical and ignore the CODESYS and USED-CODESYS arguments.)
2672 If support for Mule exists in this Emacs, the file is decoded according
2673 to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil,
2674 it should be a symbol, and the actual coding system that was used for the
2675 decoding is stored into it. It will in general be different from CODESYS
2676 if CODESYS specifies automatic encoding detection or end-of-line detection.
2678 Currently BEG and END refer to byte positions (as opposed to character
2679 positions), even in Mule. (Fixing this is very difficult.)
2681 (filename, visit, beg, end, replace, codesys, used_codesys))
2683 /* This function can call lisp */
2684 /* #### dmoore - this function hasn't been checked for gc recently */
2688 Charcount inserted = 0;
2690 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2691 Lisp_Object handler = Qnil, val;
2693 Bufbyte read_buf[READ_BUF_SIZE];
2695 struct buffer *buf = current_buffer;
2697 int not_regular = 0;
2699 if (buf->base_buffer && ! NILP (visit))
2700 error ("Cannot do file visiting in an indirect buffer");
2702 /* No need to call Fbarf_if_buffer_read_only() here.
2703 That's called in begin_multiple_change() or wherever. */
2707 /* #### dmoore - should probably check in various places to see if
2708 curbuf was killed and if so signal an error? */
2710 XSETBUFFER (curbuf, buf);
2712 GCPRO5 (filename, val, visit, handler, curbuf);
2714 mc_count = (NILP (replace)) ?
2715 begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) :
2716 begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf));
2718 speccount = specpdl_depth (); /* begin_multiple_change also adds
2719 an unwind_protect */
2721 filename = Fexpand_file_name (filename, Qnil);
2723 /* If the file name has special constructs in it,
2724 call the corresponding file handler. */
2725 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
2726 if (!NILP (handler))
2728 val = call6 (handler, Qinsert_file_contents, filename,
2729 visit, beg, end, replace);
2734 if (!NILP (used_codesys))
2735 CHECK_SYMBOL (used_codesys);
2738 if ( (!NILP (beg) || !NILP (end)) && !NILP (visit) )
2739 error ("Attempt to visit less than an entire file");
2745 (stat ((char *) XSTRING_DATA (filename), &st) < 0)
2747 /* Don't even bother with interruptible_open. APOLLO sucks. */
2748 ((fd = open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0)) < 0
2749 || fstat (fd, &st) < 0)
2753 if (fd >= 0) close (fd);
2756 report_file_error ("Opening input file", list1 (filename));
2762 /* Signal an error if we are accessing a non-regular file, with
2763 REPLACE, BEG or END being non-nil. */
2764 if (!S_ISREG (st.st_mode))
2771 if (!NILP (replace) || !NILP (beg) || !NILP (end))
2773 end_multiple_change (buf, mc_count);
2775 return Fsignal (Qfile_error,
2776 list2 (build_translated_string("not a regular file"),
2780 #endif /* S_IFREG */
2792 if ((fd = interruptible_open ((char *) XSTRING_DATA (filename),
2793 O_RDONLY | OPEN_BINARY, 0)) < 0)
2797 /* Replacement should preserve point as it preserves markers. */
2798 if (!NILP (replace))
2799 record_unwind_protect (restore_point_unwind, Fpoint_marker (Qnil, Qnil));
2801 record_unwind_protect (close_file_unwind, make_int (fd));
2803 /* Supposedly happens on VMS. */
2805 error ("File size is negative");
2811 end = make_int (st.st_size);
2812 if (XINT (end) != st.st_size)
2813 error ("Maximum buffer size exceeded");
2817 /* If requested, replace the accessible part of the buffer
2818 with the file contents. Avoid replacing text at the
2819 beginning or end of the buffer that matches the file contents;
2820 that preserves markers pointing to the unchanged parts. */
2821 #if !defined (FILE_CODING)
2822 /* The replace-mode code currently only works when the assumption
2823 'one byte == one char' holds true. This fails Mule because
2824 files may contain multibyte characters. It holds under Windows NT
2825 provided we convert CRLF into LF. */
2826 # define FSFMACS_SPEEDY_INSERT
2827 #endif /* !defined (FILE_CODING) */
2829 #ifndef FSFMACS_SPEEDY_INSERT
2830 if (!NILP (replace))
2832 buffer_delete_range (buf, BUF_BEG (buf), BUF_Z (buf),
2833 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2835 #else /* FSFMACS_SPEEDY_INSERT */
2836 if (!NILP (replace))
2838 char buffer[1 << 14];
2839 Bufpos same_at_start = BUF_BEGV (buf);
2840 Bufpos same_at_end = BUF_ZV (buf);
2843 /* Count how many chars at the start of the file
2844 match the text at the beginning of the buffer. */
2849 nread = read_allowing_quit (fd, buffer, sizeof buffer);
2851 error ("IO error reading %s: %s",
2852 XSTRING_DATA (filename), strerror (errno));
2853 else if (nread == 0)
2856 while (bufpos < nread && same_at_start < BUF_ZV (buf)
2857 && BUF_FETCH_CHAR (buf, same_at_start) == buffer[bufpos])
2858 same_at_start++, bufpos++;
2859 /* If we found a discrepancy, stop the scan.
2860 Otherwise loop around and scan the next bufferful. */
2861 if (bufpos != nread)
2864 /* If the file matches the buffer completely,
2865 there's no need to replace anything. */
2866 if (same_at_start - BUF_BEGV (buf) == st.st_size)
2869 unbind_to (speccount, Qnil);
2870 /* Truncate the buffer to the size of the file. */
2871 buffer_delete_range (buf, same_at_start, same_at_end,
2872 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2875 /* Count how many chars at the end of the file
2876 match the text at the end of the buffer. */
2879 int total_read, nread;
2880 Bufpos bufpos, curpos, trial;
2882 /* At what file position are we now scanning? */
2883 curpos = st.st_size - (BUF_ZV (buf) - same_at_end);
2884 /* If the entire file matches the buffer tail, stop the scan. */
2887 /* How much can we scan in the next step? */
2888 trial = min (curpos, (Bufpos) sizeof (buffer));
2889 if (lseek (fd, curpos - trial, 0) < 0)
2890 report_file_error ("Setting file position", list1 (filename));
2893 while (total_read < trial)
2895 nread = read_allowing_quit (fd, buffer + total_read,
2896 trial - total_read);
2898 report_file_error ("IO error reading file", list1 (filename));
2899 total_read += nread;
2901 /* Scan this bufferful from the end, comparing with
2902 the Emacs buffer. */
2903 bufpos = total_read;
2904 /* Compare with same_at_start to avoid counting some buffer text
2905 as matching both at the file's beginning and at the end. */
2906 while (bufpos > 0 && same_at_end > same_at_start
2907 && BUF_FETCH_CHAR (buf, same_at_end - 1) ==
2909 same_at_end--, bufpos--;
2910 /* If we found a discrepancy, stop the scan.
2911 Otherwise loop around and scan the preceding bufferful. */
2914 /* If display current starts at beginning of line,
2915 keep it that way. */
2916 if (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == buf)
2917 XWINDOW (Fselected_window (Qnil))->start_at_line_beg =
2918 !NILP (Fbolp (make_buffer (buf)));
2921 /* Don't try to reuse the same piece of text twice. */
2922 overlap = same_at_start - BUF_BEGV (buf) -
2923 (same_at_end + st.st_size - BUF_ZV (buf));
2925 same_at_end += overlap;
2927 /* Arrange to read only the nonmatching middle part of the file. */
2928 beg = make_int (same_at_start - BUF_BEGV (buf));
2929 end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end));
2931 buffer_delete_range (buf, same_at_start, same_at_end,
2932 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2933 /* Insert from the file at the proper position. */
2934 BUF_SET_PT (buf, same_at_start);
2936 #endif /* FSFMACS_SPEEDY_INSERT */
2940 total = XINT (end) - XINT (beg);
2942 /* Make sure point-max won't overflow after this insertion. */
2943 if (total != XINT (make_int (total)))
2944 error ("Maximum buffer size exceeded");
2947 /* For a special file, all we can do is guess. The value of -1
2948 will make the stream functions read as much as possible. */
2952 #ifdef FSFMACS_SPEEDY_INSERT
2953 /* why was this here? asked jwz. The reason is that the replace-mode
2954 connivings above will normally put the file pointer other than
2955 where it should be. */
2957 #endif /* !FSFMACS_SPEEDY_INSERT */
2960 if (lseek (fd, XINT (beg), 0) < 0)
2961 report_file_error ("Setting file position", list1 (filename));
2965 Bufpos cur_point = BUF_PT (buf);
2966 struct gcpro ngcpro1;
2967 Lisp_Object stream = make_filedesc_input_stream (fd, 0, total,
2971 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2973 stream = make_decoding_input_stream
2974 (XLSTREAM (stream), Fget_coding_system (codesys));
2975 Lstream_set_character_mode (XLSTREAM (stream));
2976 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2977 #endif /* FILE_CODING */
2979 record_unwind_protect (delete_stream_unwind, stream);
2981 /* No need to limit the amount of stuff we attempt to read. (It would
2982 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
2983 occurs inside of the filedesc stream. */
2987 Charcount cc_inserted;
2990 this_len = Lstream_read (XLSTREAM (stream), read_buf,
3000 cc_inserted = buffer_insert_raw_string_1 (buf, cur_point, read_buf,
3003 ? INSDEL_NO_LOCKING : 0);
3004 inserted += cc_inserted;
3005 cur_point += cc_inserted;
3008 if (!NILP (used_codesys))
3011 XCODING_SYSTEM_NAME (decoding_stream_coding_system (XLSTREAM (stream))));
3013 #endif /* FILE_CODING */
3017 /* Close the file/stream */
3018 unbind_to (speccount, Qnil);
3022 error ("IO error reading %s: %s",
3023 XSTRING_DATA (filename), strerror (saverrno));
3029 end_multiple_change (buf, mc_count);
3033 if (!EQ (buf->undo_list, Qt))
3034 buf->undo_list = Qnil;
3036 stat ((char *) XSTRING_DATA (filename), &st);
3040 buf->modtime = st.st_mtime;
3041 buf->filename = filename;
3042 /* XEmacs addition: */
3043 /* This function used to be in C, ostensibly so that
3044 it could be called here. But that's just silly.
3045 There's no reason C code can't call out to Lisp
3046 code, and it's a lot cleaner this way. */
3047 if (!NILP (Ffboundp (Qcompute_buffer_file_truename)))
3048 call1 (Qcompute_buffer_file_truename, make_buffer (buf));
3050 BUF_SAVE_MODIFF (buf) = BUF_MODIFF (buf);
3051 buf->auto_save_modified = BUF_MODIFF (buf);
3052 buf->saved_size = make_int (BUF_SIZE (buf));
3053 #ifdef CLASH_DETECTION
3056 if (!NILP (buf->file_truename))
3057 unlock_file (buf->file_truename);
3058 unlock_file (filename);
3060 #endif /* CLASH_DETECTION */
3062 RETURN_UNGCPRO (Fsignal (Qfile_error,
3063 list2 (build_string ("not a regular file"),
3066 /* If visiting nonexistent file, return nil. */
3067 if (buf->modtime == -1)
3068 report_file_error ("Opening input file",
3072 /* Decode file format */
3075 Lisp_Object insval = call3 (Qformat_decode,
3076 Qnil, make_int (inserted), visit);
3078 inserted = XINT (insval);
3084 struct gcpro ngcpro1;
3087 EXTERNAL_LIST_LOOP (p, Vafter_insert_file_functions)
3089 Lisp_Object insval =
3090 call1 (XCAR (p), make_int (inserted));
3093 CHECK_NATNUM (insval);
3094 inserted = XINT (insval);
3106 return (list2 (filename, make_int (inserted)));
3110 static int a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3111 Lisp_Object *annot);
3112 static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end);
3114 /* If build_annotations switched buffers, switch back to BUF.
3115 Kill the temporary buffer that was selected in the meantime. */
3118 build_annotations_unwind (Lisp_Object buf)
3122 if (XBUFFER (buf) == current_buffer)
3124 tembuf = Fcurrent_buffer ();
3126 Fkill_buffer (tembuf);
3130 DEFUN ("write-region-internal", Fwrite_region_internal, 3, 7,
3131 "r\nFWrite region to file: ", /*
3132 Write current region into specified file; no coding-system frobbing.
3133 This function is identical to `write-region' except for the handling
3134 of the CODESYS argument under XEmacs/Mule. (When Mule support is not
3135 present, both functions are identical and ignore the CODESYS argument.)
3136 If support for Mule exists in this Emacs, the file is encoded according
3137 to the value of CODESYS. If this is nil, no code conversion occurs.
3139 (start, end, filename, append, visit, lockname, codesys))
3141 /* This function can call lisp */
3147 int speccount = specpdl_depth ();
3148 int visiting_other = STRINGP (visit);
3149 int visiting = (EQ (visit, Qt) || visiting_other);
3150 int quietly = (!visiting && !NILP (visit));
3151 Lisp_Object visit_file = Qnil;
3152 Lisp_Object annotations = Qnil;
3153 struct buffer *given_buffer;
3154 Bufpos start1, end1;
3156 /* #### dmoore - if Fexpand_file_name or handlers kill the buffer,
3157 we should signal an error rather than blissfully continuing
3158 along. ARGH, this function is going to lose lose lose. We need
3159 to protect the current_buffer from being destroyed, but the
3160 multiple return points make this a pain in the butt. */
3163 codesys = Fget_coding_system (codesys);
3164 #endif /* FILE_CODING */
3166 if (current_buffer->base_buffer && ! NILP (visit))
3167 error ("Cannot do file visiting in an indirect buffer");
3169 if (!NILP (start) && !STRINGP (start))
3170 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0);
3173 Lisp_Object handler;
3174 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3176 GCPRO5 (start, filename, visit, visit_file, lockname);
3179 visit_file = Fexpand_file_name (visit, Qnil);
3181 visit_file = filename;
3182 filename = Fexpand_file_name (filename, Qnil);
3186 if (NILP (lockname))
3187 lockname = visit_file;
3189 /* If the file name has special constructs in it,
3190 call the corresponding file handler. */
3191 handler = Ffind_file_name_handler (filename, Qwrite_region);
3192 /* If FILENAME has no handler, see if VISIT has one. */
3193 if (NILP (handler) && STRINGP (visit))
3194 handler = Ffind_file_name_handler (visit, Qwrite_region);
3196 if (!NILP (handler))
3198 Lisp_Object val = call8 (handler, Qwrite_region, start, end,
3199 filename, append, visit, lockname, codesys);
3202 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3203 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3204 current_buffer->filename = visit_file;
3205 MARK_MODELINE_CHANGED;
3211 #ifdef CLASH_DETECTION
3215 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3217 XSETBUFFER (curbuf, current_buffer);
3218 GCPRO5 (start, filename, visit_file, lockname, curbuf);
3219 lock_file (lockname);
3222 #endif /* CLASH_DETECTION */
3224 /* Special kludge to simplify auto-saving. */
3227 start1 = BUF_BEG (current_buffer);
3228 end1 = BUF_Z (current_buffer);
3231 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
3233 given_buffer = current_buffer;
3234 annotations = build_annotations (start, end);
3235 if (current_buffer != given_buffer)
3237 start1 = BUF_BEGV (current_buffer);
3238 end1 = BUF_ZV (current_buffer);
3245 desc = open ((char *) XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0);
3249 desc = open ((char *) XSTRING_DATA (fn),
3250 (O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY),
3251 ((auto_saving) ? auto_save_mode_bits : CREAT_MODE));
3256 #ifdef CLASH_DETECTION
3258 if (!auto_saving) unlock_file (lockname);
3260 #endif /* CLASH_DETECTION */
3261 report_file_error ("Opening output file", list1 (filename));
3265 Lisp_Object desc_locative = Fcons (make_int (desc), Qnil);
3266 Lisp_Object instream = Qnil, outstream = Qnil;
3267 struct gcpro gcpro1, gcpro2;
3268 /* need to gcpro; QUIT could happen out of call to write() */
3269 GCPRO2 (instream, outstream);
3271 record_unwind_protect (close_file_unwind, desc_locative);
3275 if (lseek (desc, 0, 2) < 0)
3277 #ifdef CLASH_DETECTION
3278 if (!auto_saving) unlock_file (lockname);
3279 #endif /* CLASH_DETECTION */
3280 report_file_error ("Lseek error",
3287 /* Note: I tried increasing the buffering size, along with
3288 various other tricks, but nothing seemed to make much of
3289 a difference in the time it took to save a large file.
3290 (Actually that's not true. With a local disk, changing
3291 the buffer size doesn't seem to make much difference.
3292 With an NFS-mounted disk, it could make a lot of difference
3293 because you're affecting the number of network requests
3294 that need to be made, and there could be a large latency
3295 for each request. So I've increased the buffer size
3297 outstream = make_filedesc_output_stream (desc, 0, -1, 0);
3298 Lstream_set_buffering (XLSTREAM (outstream),
3299 LSTREAM_BLOCKN_BUFFERED, 65536);
3302 make_encoding_output_stream (XLSTREAM (outstream), codesys);
3303 Lstream_set_buffering (XLSTREAM (outstream),
3304 LSTREAM_BLOCKN_BUFFERED, 65536);
3305 #endif /* FILE_CODING */
3306 if (STRINGP (start))
3308 instream = make_lisp_string_input_stream (start, 0, -1);
3312 instream = make_lisp_buffer_input_stream (current_buffer, start1, end1,
3314 LSTR_IGNORE_ACCESSIBLE);
3315 failure = (0 > (a_write (outstream, instream, start1,
3318 /* Note that this doesn't close the desc since we created the
3319 stream without the LSTR_CLOSING flag, but it does
3320 flush out any buffered data. */
3321 if (Lstream_close (XLSTREAM (outstream)) < 0)
3326 Lstream_close (XLSTREAM (instream));
3330 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3331 Disk full in NFS may be reported here. */
3332 /* mib says that closing the file will try to write as fast as NFS can do
3333 it, and that means the fsync here is not crucial for autosave files. */
3334 if (!auto_saving && fsync (desc) < 0
3335 /* If fsync fails with EINTR, don't treat that as serious. */
3341 #endif /* HAVE_FSYNC */
3343 /* Spurious "file has changed on disk" warnings have been
3344 observed on Suns as well.
3345 It seems that `close' can change the modtime, under nfs.
3347 (This has supposedly been fixed in Sunos 4,
3348 but who knows about all the other machines with NFS?) */
3349 /* On VMS and APOLLO, must do the stat after the close
3350 since closing changes the modtime. */
3351 /* As it does on Windows too - kkm */
3352 #if !defined (WINDOWSNT) /* !defined (VMS) && !defined (APOLLO) */
3356 /* NFS can report a write failure now. */
3357 if (close (desc) < 0)
3363 /* Discard the close unwind-protect. Execute the one for
3364 build_annotations (switches back to the original current buffer
3366 XCAR (desc_locative) = Qnil;
3367 unbind_to (speccount, Qnil);
3370 #if defined (WINDOWSNT) /* defined (VMS) || defined (APOLLO) */
3371 stat ((char *) XSTRING_DATA (fn), &st);
3374 #ifdef CLASH_DETECTION
3376 unlock_file (lockname);
3377 #endif /* CLASH_DETECTION */
3379 /* Do this before reporting IO error
3380 to avoid a "file has changed on disk" warning on
3381 next attempt to save. */
3383 current_buffer->modtime = st.st_mtime;
3386 error ("IO error writing %s: %s",
3388 strerror (save_errno));
3392 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3393 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3394 current_buffer->filename = visit_file;
3395 MARK_MODELINE_CHANGED;
3405 message ("Wrote %s", XSTRING_DATA (visit_file));
3408 struct gcpro gcpro1;
3412 fsp = Ffile_symlink_p (fn);
3414 message ("Wrote %s", XSTRING_DATA (fn));
3416 message ("Wrote %s (symlink to %s)",
3417 XSTRING_DATA (fn), XSTRING_DATA (fsp));
3424 /* #### This is such a load of shit!!!! There is no way we should define
3425 something so stupid as a subr, just sort the fucking list more
3427 DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3428 Return t if (car A) is numerically less than (car B).
3432 return arithcompare (Fcar (a), Fcar (b), arith_less);
3435 /* Heh heh heh, let's define this too, just to aggravate the person who
3436 wrote the above comment. */
3437 DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3438 Return t if (cdr A) is numerically less than (cdr B).
3442 return arithcompare (Fcdr (a), Fcdr (b), arith_less);
3445 /* Build the complete list of annotations appropriate for writing out
3446 the text between START and END, by calling all the functions in
3447 write-region-annotate-functions and merging the lists they return.
3448 If one of these functions switches to a different buffer, we assume
3449 that buffer contains altered text. Therefore, the caller must
3450 make sure to restore the current buffer in all cases,
3451 as save-excursion would do. */
3454 build_annotations (Lisp_Object start, Lisp_Object end)
3456 /* This function can GC */
3457 Lisp_Object annotations;
3459 struct gcpro gcpro1, gcpro2;
3460 Lisp_Object original_buffer;
3462 XSETBUFFER (original_buffer, current_buffer);
3465 p = Vwrite_region_annotate_functions;
3466 GCPRO2 (annotations, p);
3469 struct buffer *given_buffer = current_buffer;
3470 Vwrite_region_annotations_so_far = annotations;
3471 res = call2 (Fcar (p), start, end);
3472 /* If the function makes a different buffer current,
3473 assume that means this buffer contains altered text to be output.
3474 Reset START and END from the buffer bounds
3475 and discard all previous annotations because they should have
3476 been dealt with by this function. */
3477 if (current_buffer != given_buffer)
3479 start = make_int (BUF_BEGV (current_buffer));
3480 end = make_int (BUF_ZV (current_buffer));
3483 Flength (res); /* Check basic validity of return value */
3484 annotations = merge (annotations, res, Qcar_less_than_car);
3488 /* Now do the same for annotation functions implied by the file-format */
3489 if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
3490 p = Vauto_save_file_format;
3492 p = current_buffer->file_format;
3495 struct buffer *given_buffer = current_buffer;
3496 Vwrite_region_annotations_so_far = annotations;
3497 res = call4 (Qformat_annotate_function, Fcar (p), start, end,
3499 if (current_buffer != given_buffer)
3501 start = make_int (BUF_BEGV (current_buffer));
3502 end = make_int (BUF_ZV (current_buffer));
3506 annotations = merge (annotations, res, Qcar_less_than_car);
3513 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3514 EOF is encountered), assuming they start at position POS in the buffer
3515 of string that STREAM refers to. Intersperse with them the annotations
3516 from *ANNOT that fall into the range of positions we are reading from,
3517 each at its appropriate position.
3519 Modify *ANNOT by discarding elements as we output them.
3520 The return value is negative in case of system call failure. */
3522 /* 4K should probably be fine. We just need to reduce the number of
3523 function calls to reasonable level. The Lstream stuff itself will
3524 batch to 64K to reduce the number of system calls. */
3526 #define A_WRITE_BATCH_SIZE 4096
3529 a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3534 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3535 Lstream *instr = XLSTREAM (instream);
3536 Lstream *outstr = XLSTREAM (outstream);
3538 while (LISTP (*annot))
3540 tem = Fcar_safe (Fcar (*annot));
3542 nextpos = XINT (tem);
3546 /* If there are annotations left and we have Mule, then we
3547 have to do the I/O one emchar at a time so we can
3548 determine when to insert the annotation. */
3552 while (pos != nextpos && (ch = Lstream_get_emchar (instr)) != EOF)
3554 if (Lstream_put_emchar (outstr, ch) < 0)
3562 while (pos != nextpos)
3564 /* Otherwise there is no point to that. Just go in batches. */
3565 int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE);
3567 chunk = Lstream_read (instr, largebuf, chunk);
3570 if (chunk == 0) /* EOF */
3572 if (Lstream_write (outstr, largebuf, chunk) < chunk)
3579 tem = Fcdr (Fcar (*annot));
3582 if (Lstream_write (outstr, XSTRING_DATA (tem),
3583 XSTRING_LENGTH (tem)) < 0)
3586 *annot = Fcdr (*annot);
3597 #include <des_crypt.h>
3599 #define CRYPT_BLOCK_SIZE 8 /* bytes */
3600 #define CRYPT_KEY_SIZE 8 /* bytes */
3602 DEFUN ("encrypt-string", Fencrypt_string, 2, 2, 0, /*
3603 Encrypt STRING using KEY.
3607 char *encrypted_string, *raw_key;
3608 int rounded_size, extra, key_size;
3610 /* !!#### May produce bogus data under Mule. */
3611 CHECK_STRING (string);
3614 extra = XSTRING_LENGTH (string) % CRYPT_BLOCK_SIZE;
3615 rounded_size = XSTRING_LENGTH (string) + extra;
3616 encrypted_string = alloca (rounded_size + 1);
3617 memcpy (encrypted_string, XSTRING_DATA (string), XSTRING_LENGTH (string));
3618 memset (encrypted_string + rounded_size - extra, 0, extra + 1);
3620 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3622 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3623 memcpy (raw_key, XSTRING_DATA (key), key_size);
3624 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3626 ecb_crypt (raw_key, encrypted_string, rounded_size,
3627 DES_ENCRYPT | DES_SW);
3628 return make_string (encrypted_string, rounded_size);
3631 DEFUN ("decrypt-string", Fdecrypt_string, 2, 2, 0, /*
3632 Decrypt STRING using KEY.
3636 char *decrypted_string, *raw_key;
3637 int string_size, key_size;
3639 CHECK_STRING (string);
3642 string_size = XSTRING_LENGTH (string) + 1;
3643 decrypted_string = alloca (string_size);
3644 memcpy (decrypted_string, XSTRING_DATA (string), string_size);
3645 decrypted_string[string_size - 1] = '\0';
3647 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3649 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3650 memcpy (raw_key, XSTRING_DATA (key), key_size);
3651 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3654 ecb_crypt (raw_key, decrypted_string, string_size, D | DES_SW);
3655 return make_string (decrypted_string, string_size - 1);
3660 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
3661 Return t if last mod time of BUF's visited file matches what BUF records.
3662 This means that the file has not been changed since it was visited or saved.
3666 /* This function can call lisp */
3669 Lisp_Object handler;
3674 if (!STRINGP (b->filename)) return Qt;
3675 if (b->modtime == 0) return Qt;
3677 /* If the file name has special constructs in it,
3678 call the corresponding file handler. */
3679 handler = Ffind_file_name_handler (b->filename,
3680 Qverify_visited_file_modtime);
3681 if (!NILP (handler))
3682 return call2 (handler, Qverify_visited_file_modtime, buf);
3684 if (stat ((char *) XSTRING_DATA (b->filename), &st) < 0)
3686 /* If the file doesn't exist now and didn't exist before,
3687 we say that it isn't modified, provided the error is a tame one. */
3688 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3693 if (st.st_mtime == b->modtime
3694 /* If both are positive, accept them if they are off by one second. */
3695 || (st.st_mtime > 0 && b->modtime > 0
3696 && (st.st_mtime == b->modtime + 1
3697 || st.st_mtime == b->modtime - 1)))
3702 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3703 Clear out records of last mod time of visited file.
3704 Next attempt to save will certainly not complain of a discrepancy.
3708 current_buffer->modtime = 0;
3712 DEFUN ("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3713 Return the current buffer's recorded visited file modification time.
3714 The value is a list of the form (HIGH . LOW), like the time values
3715 that `file-attributes' returns.
3719 return time_to_lisp ((time_t) current_buffer->modtime);
3722 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3723 Update buffer's recorded modification time from the visited file's time.
3724 Useful if the buffer was not read from the file normally
3725 or if the file itself has been changed for some known benign reason.
3726 An argument specifies the modification time value to use
3727 \(instead of that of the visited file), in the form of a list
3728 \(HIGH . LOW) or (HIGH LOW).
3732 /* This function can call lisp */
3733 if (!NILP (time_list))
3736 lisp_to_time (time_list, &the_time);
3737 current_buffer->modtime = (int) the_time;
3741 Lisp_Object filename;
3743 Lisp_Object handler;
3744 struct gcpro gcpro1, gcpro2, gcpro3;
3746 GCPRO3 (filename, time_list, current_buffer->filename);
3747 filename = Fexpand_file_name (current_buffer->filename, Qnil);
3749 /* If the file name has special constructs in it,
3750 call the corresponding file handler. */
3751 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
3753 if (!NILP (handler))
3754 /* The handler can find the file name the same way we did. */
3755 return call2 (handler, Qset_visited_file_modtime, Qnil);
3756 else if (stat ((char *) XSTRING_DATA (filename), &st) >= 0)
3757 current_buffer->modtime = st.st_mtime;
3764 auto_save_error (Lisp_Object condition_object, Lisp_Object ignored)
3766 /* This function can call lisp */
3769 /* Don't try printing an error message after everything is gone! */
3770 if (preparing_for_armageddon)
3772 clear_echo_area (selected_frame (), Qauto_saving, 1);
3773 Fding (Qt, Qauto_save_error, Qnil);
3774 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3775 Fsleep_for (make_int (1));
3776 message ("Auto-saving...error!for %s", XSTRING_DATA (current_buffer->name));
3777 Fsleep_for (make_int (1));
3778 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3779 Fsleep_for (make_int (1));
3784 auto_save_1 (Lisp_Object ignored)
3786 /* This function can call lisp */
3787 /* #### I think caller is protecting current_buffer? */
3789 Lisp_Object fn = current_buffer->filename;
3790 Lisp_Object a = current_buffer->auto_save_file_name;
3795 /* Get visited file's mode to become the auto save file's mode. */
3797 stat ((char *) XSTRING_DATA (fn), &st) >= 0)
3798 /* But make sure we can overwrite it later! */
3799 auto_save_mode_bits = st.st_mode | 0600;
3801 /* default mode for auto-save files of buffers with no file is
3802 readable by owner only. This may annoy some small number of
3803 people, but the alternative removes all privacy from email. */
3804 auto_save_mode_bits = 0600;
3807 /* !!#### need to deal with this 'escape-quoted everywhere */
3808 Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil,
3818 auto_save_expand_name_error (Lisp_Object condition_object, Lisp_Object ignored)
3820 /* #### this function should spew an error message about not being
3821 able to open the .saves file. */
3826 auto_save_expand_name (Lisp_Object name)
3828 struct gcpro gcpro1;
3830 /* note that caller did NOT gc protect name, so we do it. */
3831 /* #### dmoore - this might not be neccessary, if condition_case_1
3832 protects it. but I don't think it does. */
3834 RETURN_UNGCPRO (Fexpand_file_name (name, Qnil));
3839 do_auto_save_unwind (Lisp_Object fd)
3846 do_auto_save_unwind_2 (Lisp_Object old_auto_saving)
3848 auto_saving = XINT (old_auto_saving);
3852 /* Fdo_auto_save() checks whether a GC is in progress when it is called,
3853 and if so, tries to avoid touching lisp objects.
3855 The only time that Fdo_auto_save() is called while GC is in progress
3856 is if we're going down, as a result of an abort() or a kill signal.
3857 It's fairly important that we generate autosave files in that case!
3860 DEFUN ("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3861 Auto-save all buffers that need it.
3862 This is all buffers that have auto-saving enabled
3863 and are changed since last auto-saved.
3864 Auto-saving writes the buffer into a file
3865 so that your editing is not lost if the system crashes.
3866 This file is not the file you visited; that changes only when you save.
3867 Normally we run the normal hook `auto-save-hook' before saving.
3869 Non-nil first argument means do not print any message if successful.
3870 Non-nil second argument means save only current buffer.
3872 (no_message, current_only))
3874 /* This function can call lisp */
3876 Lisp_Object tail, buf;
3878 int do_handled_files;
3879 Lisp_Object oquit = Qnil;
3880 Lisp_Object listfile = Qnil;
3883 int speccount = specpdl_depth ();
3884 struct gcpro gcpro1, gcpro2, gcpro3;
3886 XSETBUFFER (old, current_buffer);
3887 GCPRO3 (oquit, listfile, old);
3888 check_quit (); /* make Vquit_flag accurate */
3889 /* Ordinarily don't quit within this function,
3890 but don't make it impossible to quit (in case we get hung in I/O). */
3894 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3895 variables point to non-strings reached from Vbuffer_alist. */
3897 if (minibuf_level != 0 || preparing_for_armageddon)
3900 run_hook (Qauto_save_hook);
3902 if (GC_STRINGP (Vauto_save_list_file_name))
3903 listfile = condition_case_1 (Qt,
3904 auto_save_expand_name,
3905 Vauto_save_list_file_name,
3906 auto_save_expand_name_error, Qnil);
3908 /* Make sure auto_saving is reset. */
3909 record_unwind_protect (do_auto_save_unwind_2, make_int (auto_saving));
3913 /* First, save all files which don't have handlers. If Emacs is
3914 crashing, the handlers may tweak what is causing Emacs to crash
3915 in the first place, and it would be a shame if Emacs failed to
3916 autosave perfectly ordinary files because it couldn't handle some
3918 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
3920 for (tail = Vbuffer_alist;
3924 buf = XCDR (XCAR (tail));
3927 if (!GC_NILP (current_only)
3928 && b != current_buffer)
3931 /* Don't auto-save indirect buffers.
3932 The base buffer takes care of it. */
3936 /* Check for auto save enabled
3937 and file changed since last auto save
3938 and file changed since last real save. */
3939 if (GC_STRINGP (b->auto_save_file_name)
3940 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
3941 && b->auto_save_modified < BUF_MODIFF (b)
3942 /* -1 means we've turned off autosaving for a while--see below. */
3943 && XINT (b->saved_size) >= 0
3944 && (do_handled_files
3945 || NILP (Ffind_file_name_handler (b->auto_save_file_name,
3948 EMACS_TIME before_time, after_time;
3950 EMACS_GET_TIME (before_time);
3951 /* If we had a failure, don't try again for 20 minutes. */
3952 if (!preparing_for_armageddon
3953 && b->auto_save_failure_time >= 0
3954 && (EMACS_SECS (before_time) - b->auto_save_failure_time <
3958 if (!preparing_for_armageddon &&
3959 (XINT (b->saved_size) * 10
3960 > (BUF_Z (b) - BUF_BEG (b)) * 13)
3961 /* A short file is likely to change a large fraction;
3962 spare the user annoying messages. */
3963 && XINT (b->saved_size) > 5000
3964 /* These messages are frequent and annoying for `*mail*'. */
3965 && !NILP (b->filename)
3966 && NILP (no_message)
3967 && disable_auto_save_when_buffer_shrinks)
3969 /* It has shrunk too much; turn off auto-saving here.
3970 Unless we're about to crash, in which case auto-save it
3974 ("Buffer %s has shrunk a lot; auto save turned off there",
3975 XSTRING_DATA (b->name));
3976 /* Turn off auto-saving until there's a real save,
3977 and prevent any more warnings. */
3978 b->saved_size = make_int (-1);
3979 if (!gc_in_progress)
3980 Fsleep_for (make_int (1));
3983 set_buffer_internal (b);
3984 if (!auto_saved && GC_NILP (no_message))
3986 static CONST unsigned char *msg
3987 = (CONST unsigned char *) "Auto-saving...";
3988 echo_area_message (selected_frame (), msg, Qnil,
3989 0, strlen ((CONST char *) msg),
3993 /* Open the auto-save list file, if necessary.
3994 We only do this now so that the file only exists
3995 if we actually auto-saved any files. */
3996 if (!auto_saved && GC_STRINGP (listfile) && listdesc < 0)
3998 listdesc = open ((char *) XSTRING_DATA (listfile),
3999 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4002 /* Arrange to close that file whether or not we get
4005 record_unwind_protect (do_auto_save_unwind,
4006 make_int (listdesc));
4009 /* Record all the buffers that we are auto-saving in
4010 the special file that lists them. For each of
4011 these buffers, record visited name (if any) and
4015 CONST Extbyte *auto_save_file_name_ext;
4016 Extcount auto_save_file_name_ext_len;
4018 GET_STRING_FILENAME_DATA_ALLOCA
4019 (b->auto_save_file_name,
4020 auto_save_file_name_ext,
4021 auto_save_file_name_ext_len);
4022 if (!NILP (b->filename))
4024 CONST Extbyte *filename_ext;
4025 Extcount filename_ext_len;
4027 GET_STRING_FILENAME_DATA_ALLOCA (b->filename,
4030 write (listdesc, filename_ext, filename_ext_len);
4032 write (listdesc, "\n", 1);
4033 write (listdesc, auto_save_file_name_ext,
4034 auto_save_file_name_ext_len);
4035 write (listdesc, "\n", 1);
4038 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
4039 based on values in Vbuffer_alist. auto_save_1 may
4040 cause lisp handlers to run. Those handlers may kill
4041 the buffer and then GC. Since the buffer is killed,
4042 it's no longer in Vbuffer_alist so it might get reaped
4043 by the GC. We also need to protect tail. */
4044 /* #### There is probably a lot of other code which has
4045 pointers into buffers which may get blown away by
4048 struct gcpro ngcpro1, ngcpro2;
4049 NGCPRO2 (buf, tail);
4050 condition_case_1 (Qt,
4052 auto_save_error, Qnil);
4055 /* Handler killed our saved current-buffer! Pick any. */
4056 if (!BUFFER_LIVE_P (XBUFFER (old)))
4057 XSETBUFFER (old, current_buffer);
4059 set_buffer_internal (XBUFFER (old));
4062 /* Handler killed their own buffer! */
4063 if (!BUFFER_LIVE_P(b))
4066 b->auto_save_modified = BUF_MODIFF (b);
4067 b->saved_size = make_int (BUF_SIZE (b));
4068 EMACS_GET_TIME (after_time);
4069 /* If auto-save took more than 60 seconds,
4070 assume it was an NFS failure that got a timeout. */
4071 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
4072 b->auto_save_failure_time = EMACS_SECS (after_time);
4077 /* Prevent another auto save till enough input events come in. */
4079 record_auto_save ();
4081 /* If we didn't save anything into the listfile, remove the old
4082 one because nothing needed to be auto-saved. Do this afterwards
4083 rather than before in case we get a crash attempting to autosave
4084 (in that case we'd still want the old one around). */
4085 if (listdesc < 0 && !auto_saved && GC_STRINGP (listfile))
4086 unlink ((char *) XSTRING_DATA (listfile));
4088 /* Show "...done" only if the echo area would otherwise be empty. */
4089 if (auto_saved && NILP (no_message)
4090 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0)))
4092 static CONST unsigned char *msg
4093 = (CONST unsigned char *)"Auto-saving...done";
4094 echo_area_message (selected_frame (), msg, Qnil, 0,
4095 strlen ((CONST char *) msg), Qauto_saving);
4100 RETURN_UNGCPRO (unbind_to (speccount, Qnil));
4103 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
4104 Mark current buffer as auto-saved with its current text.
4105 No auto-save file will be written until the buffer changes again.
4109 current_buffer->auto_save_modified = BUF_MODIFF (current_buffer);
4110 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
4111 current_buffer->auto_save_failure_time = -1;
4115 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
4116 Clear any record of a recent auto-save failure in the current buffer.
4120 current_buffer->auto_save_failure_time = -1;
4124 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
4125 Return t if buffer has been auto-saved since last read in or saved.
4129 return (BUF_SAVE_MODIFF (current_buffer) <
4130 current_buffer->auto_save_modified) ? Qt : Qnil;
4134 /************************************************************************/
4135 /* initialization */
4136 /************************************************************************/
4139 syms_of_fileio (void)
4141 defsymbol (&Qexpand_file_name, "expand-file-name");
4142 defsymbol (&Qfile_truename, "file-truename");
4143 defsymbol (&Qsubstitute_in_file_name, "substitute-in-file-name");
4144 defsymbol (&Qdirectory_file_name, "directory-file-name");
4145 defsymbol (&Qfile_name_directory, "file-name-directory");
4146 defsymbol (&Qfile_name_nondirectory, "file-name-nondirectory");
4147 defsymbol (&Qunhandled_file_name_directory, "unhandled-file-name-directory");
4148 defsymbol (&Qfile_name_as_directory, "file-name-as-directory");
4149 defsymbol (&Qcopy_file, "copy-file");
4150 defsymbol (&Qmake_directory_internal, "make-directory-internal");
4151 defsymbol (&Qdelete_directory, "delete-directory");
4152 defsymbol (&Qdelete_file, "delete-file");
4153 defsymbol (&Qrename_file, "rename-file");
4154 defsymbol (&Qadd_name_to_file, "add-name-to-file");
4155 defsymbol (&Qmake_symbolic_link, "make-symbolic-link");
4156 defsymbol (&Qfile_exists_p, "file-exists-p");
4157 defsymbol (&Qfile_executable_p, "file-executable-p");
4158 defsymbol (&Qfile_readable_p, "file-readable-p");
4159 defsymbol (&Qfile_symlink_p, "file-symlink-p");
4160 defsymbol (&Qfile_writable_p, "file-writable-p");
4161 defsymbol (&Qfile_directory_p, "file-directory-p");
4162 defsymbol (&Qfile_regular_p, "file-regular-p");
4163 defsymbol (&Qfile_accessible_directory_p, "file-accessible-directory-p");
4164 defsymbol (&Qfile_modes, "file-modes");
4165 defsymbol (&Qset_file_modes, "set-file-modes");
4166 defsymbol (&Qfile_newer_than_file_p, "file-newer-than-file-p");
4167 defsymbol (&Qinsert_file_contents, "insert-file-contents");
4168 defsymbol (&Qwrite_region, "write-region");
4169 defsymbol (&Qverify_visited_file_modtime, "verify-visited-file-modtime");
4170 defsymbol (&Qset_visited_file_modtime, "set-visited-file-modtime");
4171 defsymbol (&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */
4173 defsymbol (&Qfile_name_handler_alist, "file-name-handler-alist");
4174 defsymbol (&Qauto_save_hook, "auto-save-hook");
4175 defsymbol (&Qauto_save_error, "auto-save-error");
4176 defsymbol (&Qauto_saving, "auto-saving");
4178 defsymbol (&Qformat_decode, "format-decode");
4179 defsymbol (&Qformat_annotate_function, "format-annotate-function");
4181 defsymbol (&Qcompute_buffer_file_truename, "compute-buffer-file-truename");
4182 deferror (&Qfile_error, "file-error", "File error", Qio_error);
4183 deferror (&Qfile_already_exists, "file-already-exists",
4184 "File already exists", Qfile_error);
4186 DEFSUBR (Ffind_file_name_handler);
4188 DEFSUBR (Ffile_name_directory);
4189 DEFSUBR (Ffile_name_nondirectory);
4190 DEFSUBR (Funhandled_file_name_directory);
4191 DEFSUBR (Ffile_name_as_directory);
4192 DEFSUBR (Fdirectory_file_name);
4193 DEFSUBR (Fmake_temp_name);
4194 DEFSUBR (Fexpand_file_name);
4195 DEFSUBR (Ffile_truename);
4196 DEFSUBR (Fsubstitute_in_file_name);
4197 DEFSUBR (Fcopy_file);
4198 DEFSUBR (Fmake_directory_internal);
4199 DEFSUBR (Fdelete_directory);
4200 DEFSUBR (Fdelete_file);
4201 DEFSUBR (Frename_file);
4202 DEFSUBR (Fadd_name_to_file);
4204 DEFSUBR (Fmake_symbolic_link);
4205 #endif /* S_IFLNK */
4207 DEFSUBR (Fsysnetunam);
4208 #endif /* HPUX_NET */
4209 DEFSUBR (Ffile_name_absolute_p);
4210 DEFSUBR (Ffile_exists_p);
4211 DEFSUBR (Ffile_executable_p);
4212 DEFSUBR (Ffile_readable_p);
4213 DEFSUBR (Ffile_writable_p);
4214 DEFSUBR (Ffile_symlink_p);
4215 DEFSUBR (Ffile_directory_p);
4216 DEFSUBR (Ffile_accessible_directory_p);
4217 DEFSUBR (Ffile_regular_p);
4218 DEFSUBR (Ffile_modes);
4219 DEFSUBR (Fset_file_modes);
4220 DEFSUBR (Fset_default_file_modes);
4221 DEFSUBR (Fdefault_file_modes);
4222 DEFSUBR (Funix_sync);
4223 DEFSUBR (Ffile_newer_than_file_p);
4224 DEFSUBR (Finsert_file_contents_internal);
4225 DEFSUBR (Fwrite_region_internal);
4226 DEFSUBR (Fcar_less_than_car); /* Vomitous! */
4227 DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
4229 DEFSUBR (Fencrypt_string);
4230 DEFSUBR (Fdecrypt_string);
4232 DEFSUBR (Fverify_visited_file_modtime);
4233 DEFSUBR (Fclear_visited_file_modtime);
4234 DEFSUBR (Fvisited_file_modtime);
4235 DEFSUBR (Fset_visited_file_modtime);
4237 DEFSUBR (Fdo_auto_save);
4238 DEFSUBR (Fset_buffer_auto_saved);
4239 DEFSUBR (Fclear_buffer_auto_save_failure);
4240 DEFSUBR (Frecent_auto_save_p);
4244 vars_of_fileio (void)
4246 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /*
4247 *Format in which to write auto-save files.
4248 Should be a list of symbols naming formats that are defined in `format-alist'.
4249 If it is t, which is the default, auto-save files are written in the
4250 same format as a regular save would use.
4252 Vauto_save_file_format = Qt;
4254 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /*
4255 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
4256 If a file name matches REGEXP, then all I/O on that file is done by calling
4259 The first argument given to HANDLER is the name of the I/O primitive
4260 to be handled; the remaining arguments are the arguments that were
4261 passed to that primitive. For example, if you do
4262 (file-exists-p FILENAME)
4263 and FILENAME is handled by HANDLER, then HANDLER is called like this:
4264 (funcall HANDLER 'file-exists-p FILENAME)
4265 The function `find-file-name-handler' checks this list for a handler
4268 Vfile_name_handler_alist = Qnil;
4270 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /*
4271 A list of functions to be called at the end of `insert-file-contents'.
4272 Each is passed one argument, the number of bytes inserted. It should return
4273 the new byte count, and leave point the same. If `insert-file-contents' is
4274 intercepted by a handler from `file-name-handler-alist', that handler is
4275 responsible for calling the after-insert-file-functions if appropriate.
4277 Vafter_insert_file_functions = Qnil;
4279 DEFVAR_LISP ("write-region-annotate-functions",
4280 &Vwrite_region_annotate_functions /*
4281 A list of functions to be called at the start of `write-region'.
4282 Each is passed two arguments, START and END, as for `write-region'.
4283 It should return a list of pairs (POSITION . STRING) of strings to be
4284 effectively inserted at the specified positions of the file being written
4285 \(1 means to insert before the first byte written). The POSITIONs must be
4286 sorted into increasing order. If there are several functions in the list,
4287 the several lists are merged destructively.
4289 Vwrite_region_annotate_functions = Qnil;
4291 DEFVAR_LISP ("write-region-annotations-so-far",
4292 &Vwrite_region_annotations_so_far /*
4293 When an annotation function is called, this holds the previous annotations.
4294 These are the annotations made by other annotation functions
4295 that were already called. See also `write-region-annotate-functions'.
4297 Vwrite_region_annotations_so_far = Qnil;
4299 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
4300 A list of file name handlers that temporarily should not be used.
4301 This applies only to the operation `inhibit-file-name-operation'.
4303 Vinhibit_file_name_handlers = Qnil;
4305 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
4306 The operation for which `inhibit-file-name-handlers' is applicable.
4308 Vinhibit_file_name_operation = Qnil;
4310 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name /*
4311 File name in which we write a list of all auto save file names.
4313 Vauto_save_list_file_name = Qnil;
4315 DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks",
4316 &disable_auto_save_when_buffer_shrinks /*
4317 If non-nil, auto-saving is disabled when a buffer shrinks too much.
4318 This is to prevent you from losing your edits if you accidentally
4319 delete a large chunk of the buffer and don't notice it until too late.
4320 Saving the buffer normally turns auto-save back on.
4322 disable_auto_save_when_buffer_shrinks = 1;
4324 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /*
4325 Directory separator character for built-in functions that return file names.
4326 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
4327 This variable affects the built-in functions only on Windows,
4328 on other platforms, it is initialized so that Lisp code can find out
4329 what the normal separator is.
4331 Vdirectory_sep_char = make_char ('/');