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 char *c=((char *) res) + strlen ((char *) res);
458 if (!IS_DIRECTORY_SEP (*c))
460 *c++ = DIRECTORY_SEP;
464 p = beg + strlen ((char *) beg);
467 #endif /* WINDOWSNT */
468 return make_string (beg, p - beg);
471 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /*
472 Return file name NAME sans its directory.
473 For example, in a Unix-syntax file name,
474 this is everything after the last slash,
475 or the entire name if it contains no slash.
479 /* This function can GC. GC checked 1997.04.06. */
480 Bufbyte *beg, *p, *end;
485 /* If the file name has special constructs in it,
486 call the corresponding file handler. */
487 handler = Ffind_file_name_handler (file, Qfile_name_nondirectory);
489 return call2_check_string (handler, Qfile_name_nondirectory, file);
491 beg = XSTRING_DATA (file);
492 end = p = beg + XSTRING_LENGTH (file);
494 while (p != beg && !IS_ANY_SEP (p[-1])
496 /* only recognise drive specifier at beginning */
497 && !(p[-1] == ':' && p == beg + 2)
501 return make_string (p, end - p);
504 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /*
505 Return a directly usable directory name somehow associated with FILENAME.
506 A `directly usable' directory name is one that may be used without the
507 intervention of any file handler.
508 If FILENAME is a directly usable file itself, return
509 \(file-name-directory FILENAME).
510 The `call-process' and `start-process' functions use this function to
511 get a current directory to run processes in.
515 /* This function can GC. GC checked 1997.04.06. */
518 /* If the file name has special constructs in it,
519 call the corresponding file handler. */
520 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
522 return call2 (handler, Qunhandled_file_name_directory,
525 return Ffile_name_directory (filename);
530 file_name_as_directory (char *out, char *in)
532 int size = strlen (in);
537 out[1] = DIRECTORY_SEP;
543 /* Append a slash if necessary */
544 if (!IS_ANY_SEP (out[size-1]))
546 out[size] = DIRECTORY_SEP;
547 out[size + 1] = '\0';
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 */
614 DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
615 Return the file name of the directory named DIR.
616 This is the name of the file that holds the data for the directory DIR.
617 This operation exists because a directory is also a file, but its name as
618 a directory is different from its name as a file.
619 In Unix-syntax, this function just removes the final slash.
623 /* This function can GC. GC checked 1997.04.06. */
627 CHECK_STRING (directory);
629 #if 0 /* #### WTF? */
630 if (NILP (directory))
634 /* If the file name has special constructs in it,
635 call the corresponding file handler. */
636 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
638 return call2_check_string (handler, Qdirectory_file_name, directory);
639 buf = (char *) alloca (XSTRING_LENGTH (directory) + 20);
640 directory_file_name ((char *) XSTRING_DATA (directory), buf);
641 return build_string (buf);
644 /* Fmake_temp_name used to be a simple wrapper around mktemp(), but it
645 proved too broken for our purposes (it supported only 26 or 62
646 unique names under some implementations). For example, this
647 arbitrary limit broke generation of Gnus Incoming* files.
649 This implementation is better than what one usually finds in libc.
652 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
653 Generate temporary file name starting with PREFIX.
654 The Emacs process number forms part of the result, so there is no
655 danger of generating a name being used by another process.
657 In addition, this function makes an attempt to choose a name that
658 does not specify an existing file. To make this work, PREFIX should
659 be an absolute file name.
663 static char tbl[64] = {
664 'A','B','C','D','E','F','G','H',
665 'I','J','K','L','M','N','O','P',
666 'Q','R','S','T','U','V','W','X',
667 'Y','Z','a','b','c','d','e','f',
668 'g','h','i','j','k','l','m','n',
669 'o','p','q','r','s','t','u','v',
670 'w','x','y','z','0','1','2','3',
671 '4','5','6','7','8','9','-','_' };
672 static unsigned count, count_initialized_p;
679 CHECK_STRING (prefix);
681 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's
684 1) It might change the prefix, so the resulting string might not
685 begin with PREFIX. This violates the principle of least
688 2) It breaks under many unforeseeable circumstances, such as with
689 the code that uses (make-temp-name "") instead of
690 (make-temp-name "./").
692 3) It might yield unexpected (to stat(2)) results in the presence
693 of EFS and file name handlers. */
695 len = XSTRING_LENGTH (prefix);
696 val = make_uninit_string (len + 6);
697 data = XSTRING_DATA (val);
698 memcpy (data, XSTRING_DATA (prefix), len);
701 /* VAL is created by adding 6 characters to PREFIX. The first three
702 are the PID of this process, in base 64, and the second three are
703 incremented if the file already exists. This ensures 262144
704 unique file names per PID per PREFIX. */
706 pid = (unsigned)getpid ();
707 *p++ = tbl[pid & 63], pid >>= 6;
708 *p++ = tbl[pid & 63], pid >>= 6;
709 *p++ = tbl[pid & 63], pid >>= 6;
711 /* Here we try to minimize useless stat'ing when this function is
712 invoked many times successively with the same PREFIX. We achieve
713 this by initializing count to a random value, and incrementing it
715 if (!count_initialized_p)
717 count = (unsigned)time (NULL);
718 /* Dumping temacs with a non-zero count_initialized_p wouldn't
720 if (NILP (Frunning_temacs_p ()))
721 count_initialized_p = 1;
727 unsigned num = count;
729 p[0] = tbl[num & 63], num >>= 6;
730 p[1] = tbl[num & 63], num >>= 6;
731 p[2] = tbl[num & 63], num >>= 6;
733 /* Poor man's congruential RN generator. Replace with ++count
740 if (stat ((CONST char *) data, &ignored) < 0)
742 /* We want to return only if errno is ENOENT. */
746 /* The error here is dubious, but there is little else we
747 can do. The alternatives are to return nil, which is
748 as bad as (and in many cases worse than) throwing the
749 error, or to ignore the error, which will likely result
751 report_file_error ("Cannot create temporary name for prefix",
756 RETURN_NOT_REACHED (Qnil);
760 DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /*
761 Convert filename NAME to absolute, and canonicalize it.
762 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
763 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
764 the current buffer's value of default-directory is used.
765 File name components that are `.' are removed, and
766 so are file name components followed by `..', along with the `..' itself;
767 note that these simplifications are done without checking the resulting
768 file names in the file system.
769 An initial `~/' expands to your home directory.
770 An initial `~USER/' expands to USER's home directory.
771 See also the function `substitute-in-file-name'.
773 (name, default_directory))
775 /* This function can GC */
778 Bufbyte *newdir, *p, *o;
783 int collapse_newdir = 1;
786 #endif /* WINDOWSNT */
795 /* If the file name has special constructs in it,
796 call the corresponding file handler. */
797 handler = Ffind_file_name_handler (name, Qexpand_file_name);
799 return call3_check_string (handler, Qexpand_file_name, name,
802 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
803 if (NILP (default_directory))
804 default_directory = current_buffer->directory;
805 if (! STRINGP (default_directory))
806 default_directory = build_string ("/");
808 if (!NILP (default_directory))
810 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
812 return call3 (handler, Qexpand_file_name, name, default_directory);
815 o = XSTRING_DATA (default_directory);
817 /* Make sure DEFAULT_DIRECTORY is properly expanded.
818 It would be better to do this down below where we actually use
819 default_directory. Unfortunately, calling Fexpand_file_name recursively
820 could invoke GC, and the strings might be relocated. This would
821 be annoying because we have pointers into strings lying around
822 that would need adjusting, and people would add new pointers to
823 the code and forget to adjust them, resulting in intermittent bugs.
824 Putting this call here avoids all that crud.
826 The EQ test avoids infinite recursion. */
827 if (! NILP (default_directory) && !EQ (default_directory, name)
828 /* Save time in some common cases - as long as default_directory
829 is not relative, it can be canonicalized with name below (if it
830 is needed at all) without requiring it to be expanded now. */
832 /* Detect MSDOS file names with drive specifiers. */
833 && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2])))
834 /* Detect Windows file names in UNC format. */
835 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
837 #else /* not WINDOWSNT */
839 /* Detect Unix absolute file names (/... alone is not absolute on
841 && ! (IS_DIRECTORY_SEP (o[0]))
842 #endif /* not WINDOWSNT */
848 default_directory = Fexpand_file_name (default_directory, Qnil);
852 #ifdef FILE_SYSTEM_CASE
853 name = FILE_SYSTEM_CASE (name);
856 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing
857 into name should be safe during all of this, though. */
858 nm = XSTRING_DATA (name);
861 /* We will force directory separators to be either all \ or /, so make
862 a local copy to modify, even if there ends up being no change. */
863 nm = strcpy (alloca (strlen (nm) + 1), nm);
865 /* Find and remove drive specifier if present; this makes nm absolute
866 even if the rest of the name appears to be relative. */
868 Bufbyte *colon = strrchr (nm, ':');
871 /* Only recognize colon as part of drive specifier if there is a
872 single alphabetic character preceeding the colon (and if the
873 character before the drive letter, if present, is a directory
874 separator); this is to support the remote system syntax used by
875 ange-ftp, and the "po:username" syntax for POP mailboxes. */
879 else if (IS_DRIVE (colon[-1])
880 && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2])))
887 while (--colon >= nm)
893 /* If we see "c://somedir", we want to strip the first slash after the
894 colon when stripping the drive letter. Otherwise, this expands to
896 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
898 #endif /* WINDOWSNT */
900 /* If nm is absolute, look for /./ or /../ sequences; if none are
901 found, we can probably return right away. We will avoid allocating
902 a new string if name is already fully expanded. */
904 IS_DIRECTORY_SEP (nm[0])
906 && (drive || IS_DIRECTORY_SEP (nm[1]))
910 /* If it turns out that the filename we want to return is just a
911 suffix of FILENAME, we don't need to go through and edit
912 things; we just need to construct a new string using data
913 starting at the middle of FILENAME. If we set lose to a
914 non-zero value, that means we've discovered that we can't do
921 /* Since we know the name is absolute, we can assume that each
922 element starts with a "/". */
924 /* "." and ".." are hairy. */
925 if (IS_DIRECTORY_SEP (p[0])
927 && (IS_DIRECTORY_SEP (p[2])
929 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
937 /* Make sure directories are all separated with / or \ as
938 desired, but avoid allocation of a new string when not
940 CORRECT_DIR_SEPS (nm);
941 if (IS_DIRECTORY_SEP (nm[1]))
943 if (strcmp (nm, XSTRING_DATA (name)) != 0)
944 name = build_string (nm);
946 /* drive must be set, so this is okay */
947 else if (strcmp (nm - 2, XSTRING_DATA (name)) != 0)
949 name = make_string (nm - 2, p - nm + 2);
950 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
951 XSTRING_DATA (name)[1] = ':';
954 #else /* not WINDOWSNT */
955 if (nm == XSTRING_DATA (name))
957 return build_string ((char *) nm);
958 #endif /* not WINDOWSNT */
962 /* At this point, nm might or might not be an absolute file name. We
963 need to expand ~ or ~user if present, otherwise prefix nm with
964 default_directory if nm is not absolute, and finally collapse /./
965 and /foo/../ sequences.
967 We set newdir to be the appropriate prefix if one is needed:
968 - the relevant user directory if nm starts with ~ or ~user
969 - the specified drive's working dir (DOS/NT only) if nm does not
971 - the value of default_directory.
973 Note that these prefixes are not guaranteed to be absolute (except
974 for the working dir of a drive). Therefore, to ensure we always
975 return an absolute name, if the final prefix is not absolute we
976 append it to the current working directory. */
980 if (nm[0] == '~') /* prefix ~ */
982 if (IS_DIRECTORY_SEP (nm[1])
983 || nm[1] == 0) /* ~ by itself */
985 if (!(newdir = (Bufbyte *) get_home_directory()))
986 newdir = (Bufbyte *) "";
992 else /* ~user/filename */
994 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++);
995 o = (Bufbyte *) alloca (p - nm + 1);
996 memcpy (o, (char *) nm, p - nm);
999 /* #### marcpa's syncing note: FSF uses getpwnam even on NT,
1000 which does not work. The following works only if ~USER
1001 names the user who runs this instance of XEmacs. While
1002 NT is single-user (for the moment) you still can have
1003 multiple user profiles users defined, each with its HOME.
1004 Therefore, the following should be reworked to handle
1007 /* Now if the file given is "~foo/file" and HOME="c:/", then
1008 we want the file to be named "c:/file" ("~foo" becomes
1009 "c:/"). The variable o has "~foo", so we can use the
1010 length of that string to offset nm. August Hill, 31 Aug
1012 newdir = (Bufbyte *) get_home_directory();
1013 dostounix_filename (newdir);
1014 nm += strlen(o) + 1;
1015 #else /* not WINDOWSNT */
1017 if ((user = user_login_name (NULL)) != NULL)
1019 /* Does the user login name match the ~name? */
1020 if (strcmp(user,((char *) o + 1)) == 0)
1022 newdir = (Bufbyte *) get_home_directory();
1028 #endif /* __CYGWIN32__ */
1029 /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM
1030 occurring in it. (It can call select()). */
1031 slow_down_interrupts ();
1032 pw = (struct passwd *) getpwnam ((char *) o + 1);
1033 speed_up_interrupts ();
1036 newdir = (Bufbyte *) pw -> pw_dir;
1042 #endif /* not WINDOWSNT */
1044 /* If we don't find a user of that name, leave the name
1045 unchanged; don't move nm forward to p. */
1050 /* On DOS and Windows, nm is absolute if a drive name was specified;
1051 use the drive's current directory as the prefix if needed. */
1052 if (!newdir && drive)
1054 /* Get default directory if needed to make nm absolute. */
1055 if (!IS_DIRECTORY_SEP (nm[0]))
1057 newdir = alloca (MAXPATHLEN + 1);
1058 if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
1063 /* Either nm starts with /, or drive isn't mounted. */
1064 newdir = alloca (4);
1065 newdir[0] = DRIVE_LETTER (drive);
1071 #endif /* WINDOWSNT */
1073 /* Finally, if no prefix has been specified and nm is not absolute,
1074 then it must be expanded relative to default_directory. */
1078 /* /... alone is not absolute on DOS and Windows. */
1079 && !IS_DIRECTORY_SEP (nm[0])
1081 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
1085 newdir = XSTRING_DATA (default_directory);
1091 /* First ensure newdir is an absolute name. */
1093 /* Detect MSDOS file names with drive specifiers. */
1094 ! (IS_DRIVE (newdir[0])
1095 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
1096 /* Detect Windows file names in UNC format. */
1097 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1098 /* Detect drive spec by itself */
1099 && ! (IS_DEVICE_SEP (newdir[1]) && newdir[2] == 0)
1102 /* Effectively, let newdir be (expand-file-name newdir cwd).
1103 Because of the admonition against calling expand-file-name
1104 when we have pointers into lisp strings, we accomplish this
1105 indirectly by prepending newdir to nm if necessary, and using
1106 cwd (or the wd of newdir's drive) as the new newdir. */
1108 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1113 if (!IS_DIRECTORY_SEP (nm[0]))
1115 char * tmp = alloca (strlen (newdir) + strlen (nm) + 2);
1116 file_name_as_directory (tmp, newdir);
1120 newdir = alloca (MAXPATHLEN + 1);
1123 if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
1130 /* Strip off drive name from prefix, if present. */
1131 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1137 /* Keep only a prefix from newdir if nm starts with slash
1138 (/ /server/share for UNC, nothing otherwise). */
1139 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
1141 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1143 newdir = strcpy (alloca (strlen (newdir) + 1), newdir);
1145 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1147 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1154 #endif /* WINDOWSNT */
1158 /* Get rid of any slash at the end of newdir, unless newdir is
1159 just // (an incomplete UNC name). */
1160 length = strlen ((char *) newdir);
1161 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
1163 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
1167 Bufbyte *temp = (Bufbyte *) alloca (length);
1168 memcpy (temp, newdir, length - 1);
1169 temp[length - 1] = 0;
1177 /* Now concatenate the directory and name to new space in the stack frame */
1178 tlen += strlen ((char *) nm) + 1;
1180 /* Add reserved space for drive name. (The Microsoft x86 compiler
1181 produces incorrect code if the following two lines are combined.) */
1182 target = (Bufbyte *) alloca (tlen + 2);
1184 #else /* not WINDOWSNT */
1185 target = (Bufbyte *) alloca (tlen);
1186 #endif /* not WINDOWSNT */
1191 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
1192 strcpy ((char *) target, (char *) newdir);
1194 file_name_as_directory ((char *) target, (char *) newdir);
1197 strcat ((char *) target, (char *) nm);
1199 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1201 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1208 if (!IS_DIRECTORY_SEP (*p))
1212 else if (IS_DIRECTORY_SEP (p[0])
1214 && (IS_DIRECTORY_SEP (p[2])
1217 /* If "/." is the entire filename, keep the "/". Otherwise,
1218 just delete the whole "/.". */
1219 if (o == target && p[2] == '\0')
1223 else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
1224 /* `/../' is the "superroot" on certain file systems. */
1226 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
1228 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
1230 /* Keep initial / only if this is the whole name. */
1231 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
1236 /* if drive is set, we're not dealing with an UNC, so
1237 multiple dir-seps are redundant (and reportedly cause trouble
1239 else if (drive && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
1249 /* At last, set drive name, except for network file name. */
1253 target[0] = DRIVE_LETTER (drive);
1258 if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
1261 CORRECT_DIR_SEPS (target);
1262 #endif /* WINDOWSNT */
1264 return make_string (target, o - target);
1268 /* another older version of expand-file-name; */
1271 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /*
1272 Return the canonical name of the given FILE.
1273 Second arg DEFAULT is directory to start with if FILE is relative
1274 (does not start with slash); if DEFAULT is nil or missing,
1275 the current buffer's value of default-directory is used.
1276 No component of the resulting pathname will be a symbolic link, as
1277 in the realpath() function.
1279 (filename, default_))
1281 /* This function can GC. GC checked 1997.04.06. */
1282 Lisp_Object expanded_name;
1283 Lisp_Object handler;
1284 struct gcpro gcpro1;
1286 CHECK_STRING (filename);
1288 expanded_name = Fexpand_file_name (filename, default_);
1290 if (!STRINGP (expanded_name))
1293 GCPRO1 (expanded_name);
1294 handler = Ffind_file_name_handler (expanded_name, Qfile_truename);
1297 if (!NILP (handler))
1298 return call2_check_string (handler, Qfile_truename, expanded_name);
1301 char resolved_path[MAXPATHLEN];
1302 char path[MAXPATHLEN];
1304 int elen = XSTRING_LENGTH (expanded_name);
1306 if (elen >= countof (path))
1309 memcpy (path, XSTRING_DATA (expanded_name), elen + 1);
1310 /* memset (resolved_path, 0, sizeof (resolved_path)); */
1312 /* Try doing it all at once. */
1313 /* !!#### Does realpath() Mule-encapsulate? */
1314 if (!xrealpath (path, resolved_path))
1316 /* Didn't resolve it -- have to do it one component at a time. */
1317 /* "realpath" is a typically useless, stupid un*x piece of crap.
1318 It claims to return a useful value in the "error" case, but since
1319 there is no indication provided of how far along the pathname
1320 the function went before erring, there is no way to use the
1321 partial result returned. What a piece of junk. */
1324 p = (char *) memchr (p + 1, '/', elen - (p + 1 - path));
1328 /* memset (resolved_path, 0, sizeof (resolved_path)); */
1329 if (xrealpath (path, resolved_path))
1337 else if (errno == ENOENT || errno == EACCES)
1339 /* Failed on this component. Just tack on the rest of
1340 the string and we are done. */
1341 int rlen = strlen (resolved_path);
1343 /* "On failure, it returns NULL, sets errno to indicate
1344 the error, and places in resolved_path the absolute pathname
1345 of the path component which could not be resolved." */
1348 int plen = elen - (p - path);
1350 if (rlen > 1 && resolved_path[rlen - 1] == '/')
1353 if (plen + rlen + 1 > countof (resolved_path))
1356 resolved_path[rlen] = '/';
1357 memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1);
1367 int rlen = strlen (resolved_path);
1368 if (elen > 0 && XSTRING_BYTE (expanded_name, elen - 1) == '/'
1369 && !(rlen > 0 && resolved_path[rlen - 1] == '/'))
1371 if (rlen + 1 > countof (resolved_path))
1373 resolved_path[rlen] = '/';
1374 resolved_path[rlen + 1] = 0;
1377 return make_ext_string ((Bufbyte *) resolved_path, rlen, FORMAT_BINARY);
1381 errno = ENAMETOOLONG;
1384 report_file_error ("Finding truename", list1 (expanded_name));
1386 return Qnil; /* suppress compiler warning */
1390 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
1391 Substitute environment variables referred to in FILENAME.
1392 `$FOO' where FOO is an environment variable name means to substitute
1393 the value of that variable. The variable name should be terminated
1394 with a character not a letter, digit or underscore; otherwise, enclose
1395 the entire variable name in braces.
1396 If `/~' appears, all of FILENAME through that `/' is discarded.
1401 /* This function can GC. GC checked 1997.04.06. */
1404 Bufbyte *s, *p, *o, *x, *endp;
1405 Bufbyte *target = 0;
1407 int substituted = 0;
1409 Lisp_Object handler;
1411 CHECK_STRING (string);
1413 /* If the file name has special constructs in it,
1414 call the corresponding file handler. */
1415 handler = Ffind_file_name_handler (string, Qsubstitute_in_file_name);
1416 if (!NILP (handler))
1417 return call2_check_string_or_nil (handler, Qsubstitute_in_file_name,
1420 nm = XSTRING_DATA (string);
1421 endp = nm + XSTRING_LENGTH (string);
1423 /* If /~ or // appears, discard everything through first slash. */
1425 for (p = nm; p != endp; p++)
1428 #if defined (APOLLO) || defined (WINDOWSNT) || defined (__CYGWIN32__)
1429 /* // at start of file name is meaningful in Apollo and
1430 WindowsNT systems */
1431 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
1432 #else /* not (APOLLO || WINDOWSNT || __CYGWIN32__) */
1433 || IS_DIRECTORY_SEP (p[0])
1434 #endif /* not (APOLLO || WINDOWSNT || __CYGWIN32__) */
1437 && (IS_DIRECTORY_SEP (p[-1])))
1443 /* see comment in expand-file-name about drive specifiers */
1444 else if (IS_DRIVE (p[0]) && p[1] == ':'
1445 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1450 #endif /* WINDOWSNT */
1453 /* See if any variables are substituted into the string
1454 and find the total length of their values in `total' */
1456 for (p = nm; p != endp;)
1466 /* "$$" means a single "$" */
1475 while (p != endp && *p != '}') p++;
1476 if (*p != '}') goto missingclose;
1482 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1486 /* Copy out the variable name */
1487 target = (Bufbyte *) alloca (s - o + 1);
1488 strncpy ((char *) target, (char *) o, s - o);
1491 strupr (target); /* $home == $HOME etc. */
1492 #endif /* WINDOWSNT */
1494 /* Get variable value */
1495 o = (Bufbyte *) egetenv ((char *) target);
1496 if (!o) goto badvar;
1497 total += strlen ((char *) o);
1504 /* If substitution required, recopy the string and do it */
1505 /* Make space in stack frame for the new copy */
1506 xnm = (Bufbyte *) alloca (XSTRING_LENGTH (string) + total + 1);
1509 /* Copy the rest of the name through, replacing $ constructs with values */
1526 while (p != endp && *p != '}') p++;
1527 if (*p != '}') goto missingclose;
1533 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1537 /* Copy out the variable name */
1538 target = (Bufbyte *) alloca (s - o + 1);
1539 strncpy ((char *) target, (char *) o, s - o);
1542 strupr (target); /* $home == $HOME etc. */
1543 #endif /* WINDOWSNT */
1545 /* Get variable value */
1546 o = (Bufbyte *) egetenv ((char *) target);
1550 strcpy ((char *) x, (char *) o);
1551 x += strlen ((char *) o);
1556 /* If /~ or // appears, discard everything through first slash. */
1558 for (p = xnm; p != x; p++)
1560 #if defined (APOLLO) || defined (WINDOWSNT)
1561 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
1562 #else /* not (APOLLO || WINDOWSNT) */
1563 || IS_DIRECTORY_SEP (p[0])
1564 #endif /* APOLLO || WINDOWSNT */
1566 /* don't do p[-1] if that would go off the beginning --jwz */
1567 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1]))
1570 else if (IS_DRIVE (p[0]) && p[1] == ':'
1571 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1575 return make_string (xnm, x - xnm);
1578 error ("Bad format environment-variable substitution");
1580 error ("Missing \"}\" in environment-variable substitution");
1582 error ("Substituting nonexistent environment variable \"%s\"",
1586 return Qnil; /* suppress compiler warning */
1589 /* A slightly faster and more convenient way to get
1590 (directory-file-name (expand-file-name FOO)). */
1593 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
1595 /* This function can call lisp */
1596 Lisp_Object abspath;
1597 struct gcpro gcpro1;
1599 abspath = Fexpand_file_name (filename, defdir);
1601 /* Remove final slash, if any (unless path is root).
1602 stat behaves differently depending! */
1603 if (XSTRING_LENGTH (abspath) > 1
1604 && IS_DIRECTORY_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1))
1605 && !IS_DEVICE_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 2)))
1606 /* We cannot take shortcuts; they might be wrong for magic file names. */
1607 abspath = Fdirectory_file_name (abspath);
1612 /* Signal an error if the file ABSNAME already exists.
1613 If INTERACTIVE is nonzero, ask the user whether to proceed,
1614 and bypass the error if the user says to go ahead.
1615 QUERYSTRING is a name for the action that is being considered
1617 *STATPTR is used to store the stat information if the file exists.
1618 If the file does not exist, STATPTR->st_mode is set to 0. */
1621 barf_or_query_if_file_exists (Lisp_Object absname, CONST char *querystring,
1622 int interactive, struct stat *statptr)
1624 /* This function can GC. GC checked 1997.04.06. */
1625 struct stat statbuf;
1627 /* stat is a good way to tell whether the file exists,
1628 regardless of what access permissions it has. */
1629 if (stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0)
1636 struct gcpro gcpro1;
1638 prompt = emacs_doprnt_string_c
1639 ((CONST Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "),
1640 Qnil, -1, XSTRING_DATA (absname),
1641 GETTEXT (querystring));
1644 tem = call1 (Qyes_or_no_p, prompt);
1651 Fsignal (Qfile_already_exists,
1652 list2 (build_translated_string ("File already exists"),
1660 statptr->st_mode = 0;
1665 DEFUN ("copy-file", Fcopy_file, 2, 4,
1666 "fCopy file: \nFCopy %s to file: \np\nP", /*
1667 Copy FILE to NEWNAME. Both args must be strings.
1668 Signals a `file-already-exists' error if file NEWNAME already exists,
1669 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
1670 A number as third arg means request confirmation if NEWNAME already exists.
1671 This is what happens in interactive use with M-x.
1672 Fourth arg KEEP-TIME non-nil means give the new file the same
1673 last-modified time as the old one. (This works on only some systems.)
1674 A prefix arg makes KEEP-TIME non-nil.
1676 (filename, newname, ok_if_already_exists, keep_time))
1678 /* This function can GC. GC checked 1997.04.06. */
1680 char buf[16 * 1024];
1681 struct stat st, out_st;
1682 Lisp_Object handler;
1683 int speccount = specpdl_depth ();
1684 struct gcpro gcpro1, gcpro2;
1685 /* Lisp_Object args[6]; */
1686 int input_file_statable_p;
1688 GCPRO2 (filename, newname);
1689 CHECK_STRING (filename);
1690 CHECK_STRING (newname);
1691 filename = Fexpand_file_name (filename, Qnil);
1692 newname = Fexpand_file_name (newname, Qnil);
1694 /* If the input file name has special constructs in it,
1695 call the corresponding file handler. */
1696 handler = Ffind_file_name_handler (filename, Qcopy_file);
1697 /* Likewise for output file name. */
1699 handler = Ffind_file_name_handler (newname, Qcopy_file);
1700 if (!NILP (handler))
1703 return call5 (handler, Qcopy_file, filename, newname,
1704 ok_if_already_exists, keep_time);
1707 /* When second argument is a directory, copy the file into it.
1708 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
1710 if (!NILP (Ffile_directory_p (newname)))
1712 Lisp_Object args[3];
1713 struct gcpro ngcpro1;
1717 args[1] = Qnil; args[2] = Qnil;
1720 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
1721 args[i++] = build_string ("/");
1722 args[i++] = Ffile_name_nondirectory (filename);
1723 newname = Fconcat (i, args);
1727 if (NILP (ok_if_already_exists)
1728 || INTP (ok_if_already_exists))
1729 barf_or_query_if_file_exists (newname, "copy to it",
1730 INTP (ok_if_already_exists), &out_st);
1731 else if (stat ((CONST char *) XSTRING_DATA (newname), &out_st) < 0)
1734 ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0);
1736 report_file_error ("Opening input file", list1 (filename));
1738 record_unwind_protect (close_file_unwind, make_int (ifd));
1740 /* We can only copy regular files and symbolic links. Other files are not
1742 input_file_statable_p = (fstat (ifd, &st) >= 0);
1745 if (out_st.st_mode != 0
1746 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
1749 report_file_error ("Input and output files are the same",
1750 list2 (filename, newname));
1754 #if defined (S_ISREG) && defined (S_ISLNK)
1755 if (input_file_statable_p)
1757 if (!(S_ISREG (st.st_mode))
1758 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
1760 && !(S_ISCHR (st.st_mode))
1762 && !(S_ISLNK (st.st_mode)))
1764 #if defined (EISDIR)
1765 /* Get a better looking error message. */
1768 report_file_error ("Non-regular file", list1 (filename));
1771 #endif /* S_ISREG && S_ISLNK */
1773 ofd = open( (char *) XSTRING_DATA (newname),
1774 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
1776 report_file_error ("Opening output file", list1 (newname));
1779 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil);
1781 record_unwind_protect (close_file_unwind, ofd_locative);
1783 while ((n = read_allowing_quit (ifd, buf, sizeof (buf))) > 0)
1785 if (write_allowing_quit (ofd, buf, n) != n)
1786 report_file_error ("I/O error", list1 (newname));
1789 /* Closing the output clobbers the file times on some systems. */
1790 if (close (ofd) < 0)
1791 report_file_error ("I/O error", list1 (newname));
1793 if (input_file_statable_p)
1795 if (!NILP (keep_time))
1797 EMACS_TIME atime, mtime;
1798 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
1799 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
1800 if (set_file_times ((char *) XSTRING_DATA (newname), atime,
1802 report_file_error ("I/O error", list1 (newname));
1804 chmod ((CONST char *) XSTRING_DATA (newname),
1805 st.st_mode & 07777);
1808 /* We'll close it by hand */
1809 XCAR (ofd_locative) = Qnil;
1812 unbind_to (speccount, Qnil);
1819 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
1820 Create a directory. One argument, a file name string.
1824 /* This function can GC. GC checked 1997.04.06. */
1825 char dir [MAXPATHLEN];
1826 Lisp_Object handler;
1827 struct gcpro gcpro1;
1829 CHECK_STRING (dirname_);
1830 dirname_ = Fexpand_file_name (dirname_, Qnil);
1833 handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal);
1835 if (!NILP (handler))
1836 return (call2 (handler, Qmake_directory_internal, dirname_));
1838 if (XSTRING_LENGTH (dirname_) > (Bytecount) (sizeof (dir) - 1))
1840 return Fsignal (Qfile_error,
1841 list3 (build_translated_string ("Creating directory"),
1842 build_translated_string ("pathame too long"),
1845 strncpy (dir, (char *) XSTRING_DATA (dirname_),
1846 XSTRING_LENGTH (dirname_) + 1);
1848 if (dir [XSTRING_LENGTH (dirname_) - 1] == '/')
1849 dir [XSTRING_LENGTH (dirname_) - 1] = 0;
1851 if (mkdir (dir, 0777) != 0)
1852 report_file_error ("Creating directory", list1 (dirname_));
1857 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
1858 Delete a directory. One argument, a file name or directory name string.
1862 /* This function can GC. GC checked 1997.04.06. */
1863 Lisp_Object handler;
1864 struct gcpro gcpro1;
1866 CHECK_STRING (dirname_);
1869 dirname_ = Fexpand_file_name (dirname_, Qnil);
1870 dirname_ = Fdirectory_file_name (dirname_);
1872 handler = Ffind_file_name_handler (dirname_, Qdelete_directory);
1874 if (!NILP (handler))
1875 return (call2 (handler, Qdelete_directory, dirname_));
1877 if (rmdir ((char *) XSTRING_DATA (dirname_)) != 0)
1878 report_file_error ("Removing directory", list1 (dirname_));
1883 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
1884 Delete specified file. One argument, a file name string.
1885 If file has multiple names, it continues to exist with the other names.
1889 /* This function can GC. GC checked 1997.04.06. */
1890 Lisp_Object handler;
1891 struct gcpro gcpro1;
1893 CHECK_STRING (filename);
1894 filename = Fexpand_file_name (filename, Qnil);
1897 handler = Ffind_file_name_handler (filename, Qdelete_file);
1899 if (!NILP (handler))
1900 return call2 (handler, Qdelete_file, filename);
1902 if (0 > unlink ((char *) XSTRING_DATA (filename)))
1903 report_file_error ("Removing old name", list1 (filename));
1908 internal_delete_file_1 (Lisp_Object ignore, Lisp_Object ignore2)
1913 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1916 internal_delete_file (Lisp_Object filename)
1918 /* This function can GC. GC checked 1997.04.06. */
1919 return NILP (condition_case_1 (Qt, Fdelete_file, filename,
1920 internal_delete_file_1, Qnil));
1923 DEFUN ("rename-file", Frename_file, 2, 3,
1924 "fRename file: \nFRename %s to file: \np", /*
1925 Rename FILE as NEWNAME. Both args strings.
1926 If file has names other than FILE, it continues to have those names.
1927 Signals a `file-already-exists' error if a file NEWNAME already exists
1928 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1929 A number as third arg means request confirmation if NEWNAME already exists.
1930 This is what happens in interactive use with M-x.
1932 (filename, newname, ok_if_already_exists))
1934 /* This function can GC. GC checked 1997.04.06. */
1935 Lisp_Object handler;
1936 struct gcpro gcpro1, gcpro2;
1938 GCPRO2 (filename, newname);
1939 CHECK_STRING (filename);
1940 CHECK_STRING (newname);
1941 filename = Fexpand_file_name (filename, Qnil);
1942 newname = Fexpand_file_name (newname, Qnil);
1944 /* If the file name has special constructs in it,
1945 call the corresponding file handler. */
1946 handler = Ffind_file_name_handler (filename, Qrename_file);
1948 handler = Ffind_file_name_handler (newname, Qrename_file);
1949 if (!NILP (handler))
1952 return call4 (handler, Qrename_file,
1953 filename, newname, ok_if_already_exists);
1956 /* When second argument is a directory, rename the file into it.
1957 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
1959 if (!NILP (Ffile_directory_p (newname)))
1961 Lisp_Object args[3];
1962 struct gcpro ngcpro1;
1966 args[1] = Qnil; args[2] = Qnil;
1969 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
1970 args[i++] = build_string ("/");
1971 args[i++] = Ffile_name_nondirectory (filename);
1972 newname = Fconcat (i, args);
1976 if (NILP (ok_if_already_exists)
1977 || INTP (ok_if_already_exists))
1978 barf_or_query_if_file_exists (newname, "rename to it",
1979 INTP (ok_if_already_exists), 0);
1981 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
1982 WINDOWSNT here; I've removed it. --marcpa */
1984 /* FSFmacs only calls rename() here under BSD 4.1, and calls
1985 link() and unlink() otherwise, but that's bogus. Sometimes
1986 rename() succeeds where link()/unlink() fail, and we have
1987 configure check for rename() and emulate using link()/unlink()
1989 if (0 > rename ((char *) XSTRING_DATA (filename),
1990 (char *) XSTRING_DATA (newname)))
1994 Fcopy_file (filename, newname,
1995 /* We have already prompted if it was an integer,
1996 so don't have copy-file prompt again. */
1997 ((NILP (ok_if_already_exists)) ? Qnil : Qt),
1999 Fdelete_file (filename);
2003 report_file_error ("Renaming", list2 (filename, newname));
2010 DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3,
2011 "fAdd name to file: \nFName to add to %s: \np", /*
2012 Give FILE additional name NEWNAME. Both args strings.
2013 Signals a `file-already-exists' error if a file NEWNAME already exists
2014 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2015 A number as third arg means request confirmation if NEWNAME already exists.
2016 This is what happens in interactive use with M-x.
2018 (filename, newname, ok_if_already_exists))
2020 /* This function can GC. GC checked 1997.04.06. */
2021 Lisp_Object handler;
2022 struct gcpro gcpro1, gcpro2;
2024 GCPRO2 (filename, newname);
2025 CHECK_STRING (filename);
2026 CHECK_STRING (newname);
2027 filename = Fexpand_file_name (filename, Qnil);
2028 newname = Fexpand_file_name (newname, Qnil);
2030 /* If the file name has special constructs in it,
2031 call the corresponding file handler. */
2032 handler = Ffind_file_name_handler (filename, Qadd_name_to_file);
2033 if (!NILP (handler))
2034 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2035 newname, ok_if_already_exists));
2037 /* If the new name has special constructs in it,
2038 call the corresponding file handler. */
2039 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2040 if (!NILP (handler))
2041 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2042 newname, ok_if_already_exists));
2044 if (NILP (ok_if_already_exists)
2045 || INTP (ok_if_already_exists))
2046 barf_or_query_if_file_exists (newname, "make it a new name",
2047 INTP (ok_if_already_exists), 0);
2048 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
2049 on NT here. --marcpa */
2050 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
2051 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
2052 Reverted to previous behaviour pending a working fix. (jhar) */
2053 #if defined(WINDOWSNT)
2054 /* Windows does not support this operation. */
2055 report_file_error ("Adding new name", Flist (2, &filename));
2056 #else /* not defined(WINDOWSNT) */
2058 unlink ((char *) XSTRING_DATA (newname));
2059 if (0 > link ((char *) XSTRING_DATA (filename),
2060 (char *) XSTRING_DATA (newname)))
2062 report_file_error ("Adding new name",
2063 list2 (filename, newname));
2065 #endif /* defined(WINDOWSNT) */
2072 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3,
2073 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
2074 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2075 Signals a `file-already-exists' error if a file LINKNAME already exists
2076 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2077 A number as third arg means request confirmation if LINKNAME already exists.
2078 This happens for interactive use with M-x.
2080 (filename, linkname, ok_if_already_exists))
2082 /* This function can GC. GC checked 1997.06.04. */
2083 Lisp_Object handler;
2084 struct gcpro gcpro1, gcpro2;
2086 GCPRO2 (filename, linkname);
2087 CHECK_STRING (filename);
2088 CHECK_STRING (linkname);
2089 /* If the link target has a ~, we must expand it to get
2090 a truly valid file name. Otherwise, do not expand;
2091 we want to permit links to relative file names. */
2092 if (XSTRING_BYTE (filename, 0) == '~')
2093 filename = Fexpand_file_name (filename, Qnil);
2094 linkname = Fexpand_file_name (linkname, Qnil);
2096 /* If the file name has special constructs in it,
2097 call the corresponding file handler. */
2098 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
2099 if (!NILP (handler))
2100 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname,
2101 ok_if_already_exists));
2103 /* If the new link name has special constructs in it,
2104 call the corresponding file handler. */
2105 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2106 if (!NILP (handler))
2107 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2108 linkname, ok_if_already_exists));
2110 if (NILP (ok_if_already_exists)
2111 || INTP (ok_if_already_exists))
2112 barf_or_query_if_file_exists (linkname, "make it a link",
2113 INTP (ok_if_already_exists), 0);
2115 unlink ((char *) XSTRING_DATA (linkname));
2116 if (0 > symlink ((char *) XSTRING_DATA (filename),
2117 (char *) XSTRING_DATA (linkname)))
2119 report_file_error ("Making symbolic link",
2120 list2 (filename, linkname));
2125 #endif /* S_IFLNK */
2129 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
2130 Open a network connection to PATH using LOGIN as the login string.
2136 CHECK_STRING (path);
2137 CHECK_STRING (login);
2139 /* netunam, being a strange-o system call only used once, is not
2145 GET_C_STRING_FILENAME_DATA_ALLOCA (path, path_ext);
2146 GET_C_STRING_EXT_DATA_ALLOCA (login, FORMAT_OS, login_ext);
2148 netresult = netunam (path_ext, login_ext);
2151 if (netresult == -1)
2156 #endif /* HPUX_NET */
2158 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
2159 Return t if file FILENAME specifies an absolute path name.
2160 On Unix, this is a name starting with a `/' or a `~'.
2164 /* This function does not GC */
2167 CHECK_STRING (filename);
2168 ptr = XSTRING_DATA (filename);
2169 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
2171 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
2176 /* Return nonzero if file FILENAME exists and can be executed. */
2179 check_executable (char *filename)
2183 if (stat (filename, &st) < 0)
2185 return ((st.st_mode & S_IEXEC) != 0);
2186 #else /* not WINDOWSNT */
2188 return eaccess (filename, 1) >= 0;
2190 /* Access isn't quite right because it uses the real uid
2191 and we really want to test with the effective uid.
2192 But Unix doesn't give us a right way to do it. */
2193 return access (filename, 1) >= 0;
2194 #endif /* HAVE_EACCESS */
2195 #endif /* not WINDOWSNT */
2198 /* Return nonzero if file FILENAME exists and can be written. */
2201 check_writable (CONST char *filename)
2204 return (eaccess (filename, 2) >= 0);
2206 /* Access isn't quite right because it uses the real uid
2207 and we really want to test with the effective uid.
2208 But Unix doesn't give us a right way to do it.
2209 Opening with O_WRONLY could work for an ordinary file,
2210 but would lose for directories. */
2211 return (access (filename, 2) >= 0);
2215 DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
2216 Return t if file FILENAME exists. (This does not mean you can read it.)
2217 See also `file-readable-p' and `file-attributes'.
2221 /* This function can call lisp */
2222 Lisp_Object abspath;
2223 Lisp_Object handler;
2224 struct stat statbuf;
2225 struct gcpro gcpro1;
2227 CHECK_STRING (filename);
2228 abspath = Fexpand_file_name (filename, Qnil);
2230 /* If the file name has special constructs in it,
2231 call the corresponding file handler. */
2233 handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
2235 if (!NILP (handler))
2236 return call2 (handler, Qfile_exists_p, abspath);
2238 return stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
2241 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
2242 Return t if FILENAME can be executed by you.
2243 For a directory, this means you can access files in that directory.
2248 /* This function can GC. GC checked 1997.04.10. */
2249 Lisp_Object abspath;
2250 Lisp_Object handler;
2251 struct gcpro gcpro1;
2253 CHECK_STRING (filename);
2254 abspath = Fexpand_file_name (filename, Qnil);
2256 /* If the file name has special constructs in it,
2257 call the corresponding file handler. */
2259 handler = Ffind_file_name_handler (abspath, Qfile_executable_p);
2261 if (!NILP (handler))
2262 return call2 (handler, Qfile_executable_p, abspath);
2264 return check_executable ((char *) XSTRING_DATA (abspath)) ? Qt : Qnil;
2267 DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
2268 Return t if file FILENAME exists and you can read it.
2269 See also `file-exists-p' and `file-attributes'.
2273 /* This function can GC */
2274 Lisp_Object abspath = Qnil;
2275 Lisp_Object handler;
2276 struct gcpro gcpro1;
2279 CHECK_STRING (filename);
2280 abspath = Fexpand_file_name (filename, Qnil);
2282 /* If the file name has special constructs in it,
2283 call the corresponding file handler. */
2284 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
2285 if (!NILP (handler))
2286 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
2288 #if defined(WINDOWSNT) || defined(__CYGWIN32__)
2289 /* Under MS-DOS and Windows, open does not work for directories. */
2291 if (access (XSTRING_DATA (abspath), 0) == 0)
2295 #else /* not WINDOWSNT */
2297 int desc = interruptible_open ((char *) XSTRING_DATA (abspath), O_RDONLY | OPEN_BINARY, 0);
2304 #endif /* not WINDOWSNT */
2307 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2309 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
2310 Return t if file FILENAME can be written or created by you.
2314 /* This function can GC. GC checked 1997.04.10. */
2315 Lisp_Object abspath, dir;
2316 Lisp_Object handler;
2317 struct stat statbuf;
2318 struct gcpro gcpro1;
2320 CHECK_STRING (filename);
2321 abspath = Fexpand_file_name (filename, Qnil);
2323 /* If the file name has special constructs in it,
2324 call the corresponding file handler. */
2326 handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
2328 if (!NILP (handler))
2329 return call2 (handler, Qfile_writable_p, abspath);
2331 if (stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0)
2332 return (check_writable ((char *) XSTRING_DATA (abspath))
2337 dir = Ffile_name_directory (abspath);
2339 return (check_writable (!NILP (dir) ? (char *) XSTRING_DATA (dir)
2344 DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
2345 Return non-nil if file FILENAME is the name of a symbolic link.
2346 The value is the name of the file to which it is linked.
2347 Otherwise returns nil.
2351 /* This function can GC. GC checked 1997.04.10. */
2357 Lisp_Object handler;
2358 struct gcpro gcpro1;
2360 CHECK_STRING (filename);
2361 filename = Fexpand_file_name (filename, Qnil);
2363 /* If the file name has special constructs in it,
2364 call the corresponding file handler. */
2366 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
2368 if (!NILP (handler))
2369 return call2 (handler, Qfile_symlink_p, filename);
2374 buf = xnew_array_and_zero (char, bufsize);
2375 valsize = readlink ((char *) XSTRING_DATA (filename),
2377 if (valsize < bufsize) break;
2378 /* Buffer was not long enough */
2387 val = make_string ((Bufbyte *) buf, valsize);
2390 #else /* not S_IFLNK */
2392 #endif /* not S_IFLNK */
2395 DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
2396 Return t if file FILENAME is the name of a directory as a file.
2397 A directory name spec may be given instead; then the value is t
2398 if the directory so specified exists and really is a directory.
2402 /* This function can GC. GC checked 1997.04.10. */
2403 Lisp_Object abspath;
2405 Lisp_Object handler;
2406 struct gcpro gcpro1;
2408 GCPRO1 (current_buffer->directory);
2409 abspath = expand_and_dir_to_file (filename,
2410 current_buffer->directory);
2413 /* If the file name has special constructs in it,
2414 call the corresponding file handler. */
2416 handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
2418 if (!NILP (handler))
2419 return call2 (handler, Qfile_directory_p, abspath);
2421 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2423 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2426 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
2427 Return t if file FILENAME is the name of a directory as a file,
2428 and files in that directory can be opened by you. In order to use a
2429 directory as a buffer's current directory, this predicate must return true.
2430 A directory name spec may be given instead; then the value is t
2431 if the directory so specified exists and really is a readable and
2432 searchable directory.
2436 /* This function can GC. GC checked 1997.04.10. */
2437 Lisp_Object handler;
2439 /* If the file name has special constructs in it,
2440 call the corresponding file handler. */
2441 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
2442 if (!NILP (handler))
2443 return call2 (handler, Qfile_accessible_directory_p,
2446 #if !defined(WINDOWSNT)
2447 if (NILP (Ffile_directory_p (filename)))
2450 return Ffile_executable_p (filename);
2454 struct gcpro gcpro1;
2455 /* It's an unlikely combination, but yes we really do need to gcpro:
2456 Suppose that file-accessible-directory-p has no handler, but
2457 file-directory-p does have a handler; this handler causes a GC which
2458 relocates the string in `filename'; and finally file-directory-p
2459 returns non-nil. Then we would end up passing a garbaged string
2460 to file-executable-p. */
2462 tem = (NILP (Ffile_directory_p (filename))
2463 || NILP (Ffile_executable_p (filename)));
2465 return tem ? Qnil : Qt;
2467 #endif /* !defined(WINDOWSNT) */
2470 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
2471 Return t if file FILENAME is the name of a regular file.
2472 This is the sort of file that holds an ordinary stream of data bytes.
2476 /* This function can GC. GC checked 1997.04.10. */
2477 Lisp_Object abspath;
2479 Lisp_Object handler;
2480 struct gcpro gcpro1;
2482 GCPRO1 (current_buffer->directory);
2483 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
2486 /* If the file name has special constructs in it,
2487 call the corresponding file handler. */
2489 handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
2491 if (!NILP (handler))
2492 return call2 (handler, Qfile_regular_p, abspath);
2494 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2496 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2499 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
2500 Return mode bits of FILE, as an integer.
2504 /* This function can GC. GC checked 1997.04.10. */
2505 Lisp_Object abspath;
2507 Lisp_Object handler;
2508 struct gcpro gcpro1;
2510 GCPRO1 (current_buffer->directory);
2511 abspath = expand_and_dir_to_file (filename,
2512 current_buffer->directory);
2515 /* If the file name has special constructs in it,
2516 call the corresponding file handler. */
2518 handler = Ffind_file_name_handler (abspath, Qfile_modes);
2520 if (!NILP (handler))
2521 return call2 (handler, Qfile_modes, abspath);
2523 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2525 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
2528 if (check_executable (XSTRING (abspath)->_data))
2529 st.st_mode |= S_IEXEC;
2533 return make_int (st.st_mode & 07777);
2536 DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /*
2537 Set mode bits of FILE to MODE (an integer).
2538 Only the 12 low bits of MODE are used.
2542 /* This function can GC. GC checked 1997.04.10. */
2543 Lisp_Object abspath;
2544 Lisp_Object handler;
2545 struct gcpro gcpro1;
2547 GCPRO1 (current_buffer->directory);
2548 abspath = Fexpand_file_name (filename, current_buffer->directory);
2553 /* If the file name has special constructs in it,
2554 call the corresponding file handler. */
2556 handler = Ffind_file_name_handler (abspath, Qset_file_modes);
2558 if (!NILP (handler))
2559 return call3 (handler, Qset_file_modes, abspath, mode);
2561 if (chmod ((char *) XSTRING_DATA (abspath), XINT (mode)) < 0)
2562 report_file_error ("Doing chmod", list1 (abspath));
2567 DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
2568 Set the file permission bits for newly created files.
2569 MASK should be an integer; if a permission's bit in MASK is 1,
2570 subsequently created files will not have that permission enabled.
2571 Only the low 9 bits are used.
2572 This setting is inherited by subprocesses.
2578 umask ((~ XINT (mode)) & 0777);
2583 DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
2584 Return the default file protection for created files.
2585 The umask value determines which permissions are enabled in newly
2586 created files. If a permission's bit in the umask is 1, subsequently
2587 created files will not have that permission enabled.
2596 return make_int ((~ mode) & 0777);
2599 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /*
2600 Tell Unix to finish all pending disk updates.
2611 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
2612 Return t if file FILE1 is newer than file FILE2.
2613 If FILE1 does not exist, the answer is nil;
2614 otherwise, if FILE2 does not exist, the answer is t.
2618 /* This function can GC. GC checked 1997.04.10. */
2619 Lisp_Object abspath1, abspath2;
2622 Lisp_Object handler;
2623 struct gcpro gcpro1, gcpro2, gcpro3;
2625 CHECK_STRING (file1);
2626 CHECK_STRING (file2);
2631 GCPRO3 (abspath1, abspath2, current_buffer->directory);
2632 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
2633 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
2635 /* If the file name has special constructs in it,
2636 call the corresponding file handler. */
2637 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p);
2639 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p);
2641 if (!NILP (handler))
2642 return call3 (handler, Qfile_newer_than_file_p, abspath1,
2645 if (stat ((char *) XSTRING_DATA (abspath1), &st) < 0)
2648 mtime1 = st.st_mtime;
2650 if (stat ((char *) XSTRING_DATA (abspath2), &st) < 0)
2653 return (mtime1 > st.st_mtime) ? Qt : Qnil;
2657 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
2658 /* #define READ_BUF_SIZE (2 << 16) */
2659 #define READ_BUF_SIZE (1 << 15)
2661 DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal,
2663 Insert contents of file FILENAME after point; no coding-system frobbing.
2664 This function is identical to `insert-file-contents' except for the
2665 handling of the CODESYS and USED-CODESYS arguments under
2666 XEmacs/Mule. (When Mule support is not present, both functions are
2667 identical and ignore the CODESYS and USED-CODESYS arguments.)
2669 If support for Mule exists in this Emacs, the file is decoded according
2670 to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil,
2671 it should be a symbol, and the actual coding system that was used for the
2672 decoding is stored into it. It will in general be different from CODESYS
2673 if CODESYS specifies automatic encoding detection or end-of-line detection.
2675 Currently BEG and END refer to byte positions (as opposed to character
2676 positions), even in Mule. (Fixing this is very difficult.)
2678 (filename, visit, beg, end, replace, codesys, used_codesys))
2680 /* This function can call lisp */
2681 /* #### dmoore - this function hasn't been checked for gc recently */
2685 Charcount inserted = 0;
2687 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2688 Lisp_Object handler = Qnil, val;
2690 Bufbyte read_buf[READ_BUF_SIZE];
2692 struct buffer *buf = current_buffer;
2694 int not_regular = 0;
2696 if (buf->base_buffer && ! NILP (visit))
2697 error ("Cannot do file visiting in an indirect buffer");
2699 /* No need to call Fbarf_if_buffer_read_only() here.
2700 That's called in begin_multiple_change() or wherever. */
2704 /* #### dmoore - should probably check in various places to see if
2705 curbuf was killed and if so signal an error? */
2707 XSETBUFFER (curbuf, buf);
2709 GCPRO5 (filename, val, visit, handler, curbuf);
2711 mc_count = (NILP (replace)) ?
2712 begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) :
2713 begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf));
2715 speccount = specpdl_depth (); /* begin_multiple_change also adds
2716 an unwind_protect */
2718 filename = Fexpand_file_name (filename, Qnil);
2720 /* If the file name has special constructs in it,
2721 call the corresponding file handler. */
2722 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
2723 if (!NILP (handler))
2725 val = call6 (handler, Qinsert_file_contents, filename,
2726 visit, beg, end, replace);
2731 if (!NILP (used_codesys))
2732 CHECK_SYMBOL (used_codesys);
2735 if ( (!NILP (beg) || !NILP (end)) && !NILP (visit) )
2736 error ("Attempt to visit less than an entire file");
2742 (stat ((char *) XSTRING_DATA (filename), &st) < 0)
2744 /* Don't even bother with interruptible_open. APOLLO sucks. */
2745 ((fd = open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0)) < 0
2746 || fstat (fd, &st) < 0)
2750 if (fd >= 0) close (fd);
2753 report_file_error ("Opening input file", list1 (filename));
2759 /* Signal an error if we are accessing a non-regular file, with
2760 REPLACE, BEG or END being non-nil. */
2761 if (!S_ISREG (st.st_mode))
2768 if (!NILP (replace) || !NILP (beg) || !NILP (end))
2770 end_multiple_change (buf, mc_count);
2772 return Fsignal (Qfile_error,
2773 list2 (build_translated_string("not a regular file"),
2777 #endif /* S_IFREG */
2789 if ((fd = interruptible_open ((char *) XSTRING_DATA (filename),
2790 O_RDONLY | OPEN_BINARY, 0)) < 0)
2794 /* Replacement should preserve point as it preserves markers. */
2795 if (!NILP (replace))
2796 record_unwind_protect (restore_point_unwind, Fpoint_marker (Qnil, Qnil));
2798 record_unwind_protect (close_file_unwind, make_int (fd));
2800 /* Supposedly happens on VMS. */
2802 error ("File size is negative");
2808 end = make_int (st.st_size);
2809 if (XINT (end) != st.st_size)
2810 error ("Maximum buffer size exceeded");
2814 /* If requested, replace the accessible part of the buffer
2815 with the file contents. Avoid replacing text at the
2816 beginning or end of the buffer that matches the file contents;
2817 that preserves markers pointing to the unchanged parts. */
2818 #if !defined (FILE_CODING)
2819 /* The replace-mode code currently only works when the assumption
2820 'one byte == one char' holds true. This fails Mule because
2821 files may contain multibyte characters. It holds under Windows NT
2822 provided we convert CRLF into LF. */
2823 # define FSFMACS_SPEEDY_INSERT
2824 #endif /* !defined (FILE_CODING) */
2826 #ifndef FSFMACS_SPEEDY_INSERT
2827 if (!NILP (replace))
2829 buffer_delete_range (buf, BUF_BEG (buf), BUF_Z (buf),
2830 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2832 #else /* FSFMACS_SPEEDY_INSERT */
2833 if (!NILP (replace))
2835 char buffer[1 << 14];
2836 Bufpos same_at_start = BUF_BEGV (buf);
2837 Bufpos same_at_end = BUF_ZV (buf);
2840 /* Count how many chars at the start of the file
2841 match the text at the beginning of the buffer. */
2846 nread = read_allowing_quit (fd, buffer, sizeof buffer);
2848 error ("IO error reading %s: %s",
2849 XSTRING_DATA (filename), strerror (errno));
2850 else if (nread == 0)
2853 while (bufpos < nread && same_at_start < BUF_ZV (buf)
2854 && BUF_FETCH_CHAR (buf, same_at_start) == buffer[bufpos])
2855 same_at_start++, bufpos++;
2856 /* If we found a discrepancy, stop the scan.
2857 Otherwise loop around and scan the next bufferful. */
2858 if (bufpos != nread)
2861 /* If the file matches the buffer completely,
2862 there's no need to replace anything. */
2863 if (same_at_start - BUF_BEGV (buf) == st.st_size)
2866 unbind_to (speccount, Qnil);
2867 /* Truncate the buffer to the size of the file. */
2868 buffer_delete_range (buf, same_at_start, same_at_end,
2869 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2872 /* Count how many chars at the end of the file
2873 match the text at the end of the buffer. */
2876 int total_read, nread;
2877 Bufpos bufpos, curpos, trial;
2879 /* At what file position are we now scanning? */
2880 curpos = st.st_size - (BUF_ZV (buf) - same_at_end);
2881 /* If the entire file matches the buffer tail, stop the scan. */
2884 /* How much can we scan in the next step? */
2885 trial = min (curpos, (Bufpos) sizeof (buffer));
2886 if (lseek (fd, curpos - trial, 0) < 0)
2887 report_file_error ("Setting file position", list1 (filename));
2890 while (total_read < trial)
2892 nread = read_allowing_quit (fd, buffer + total_read,
2893 trial - total_read);
2895 report_file_error ("IO error reading file", list1 (filename));
2896 total_read += nread;
2898 /* Scan this bufferful from the end, comparing with
2899 the Emacs buffer. */
2900 bufpos = total_read;
2901 /* Compare with same_at_start to avoid counting some buffer text
2902 as matching both at the file's beginning and at the end. */
2903 while (bufpos > 0 && same_at_end > same_at_start
2904 && BUF_FETCH_CHAR (buf, same_at_end - 1) ==
2906 same_at_end--, bufpos--;
2907 /* If we found a discrepancy, stop the scan.
2908 Otherwise loop around and scan the preceding bufferful. */
2911 /* If display current starts at beginning of line,
2912 keep it that way. */
2913 if (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == buf)
2914 XWINDOW (Fselected_window (Qnil))->start_at_line_beg =
2915 !NILP (Fbolp (make_buffer (buf)));
2918 /* Don't try to reuse the same piece of text twice. */
2919 overlap = same_at_start - BUF_BEGV (buf) -
2920 (same_at_end + st.st_size - BUF_ZV (buf));
2922 same_at_end += overlap;
2924 /* Arrange to read only the nonmatching middle part of the file. */
2925 beg = make_int (same_at_start - BUF_BEGV (buf));
2926 end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end));
2928 buffer_delete_range (buf, same_at_start, same_at_end,
2929 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2930 /* Insert from the file at the proper position. */
2931 BUF_SET_PT (buf, same_at_start);
2933 #endif /* FSFMACS_SPEEDY_INSERT */
2937 total = XINT (end) - XINT (beg);
2939 /* Make sure point-max won't overflow after this insertion. */
2940 if (total != XINT (make_int (total)))
2941 error ("Maximum buffer size exceeded");
2944 /* For a special file, all we can do is guess. The value of -1
2945 will make the stream functions read as much as possible. */
2949 #ifdef FSFMACS_SPEEDY_INSERT
2950 /* why was this here? asked jwz. The reason is that the replace-mode
2951 connivings above will normally put the file pointer other than
2952 where it should be. */
2954 #endif /* !FSFMACS_SPEEDY_INSERT */
2957 if (lseek (fd, XINT (beg), 0) < 0)
2958 report_file_error ("Setting file position", list1 (filename));
2962 Bufpos cur_point = BUF_PT (buf);
2963 struct gcpro ngcpro1;
2964 Lisp_Object stream = make_filedesc_input_stream (fd, 0, total,
2968 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2970 stream = make_decoding_input_stream
2971 (XLSTREAM (stream), Fget_coding_system (codesys));
2972 Lstream_set_character_mode (XLSTREAM (stream));
2973 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2974 #endif /* FILE_CODING */
2976 record_unwind_protect (delete_stream_unwind, stream);
2978 /* No need to limit the amount of stuff we attempt to read. (It would
2979 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
2980 occurs inside of the filedesc stream. */
2984 Charcount cc_inserted;
2987 this_len = Lstream_read (XLSTREAM (stream), read_buf,
2997 cc_inserted = buffer_insert_raw_string_1 (buf, cur_point, read_buf,
3000 ? INSDEL_NO_LOCKING : 0);
3001 inserted += cc_inserted;
3002 cur_point += cc_inserted;
3005 if (!NILP (used_codesys))
3008 XCODING_SYSTEM_NAME (decoding_stream_coding_system (XLSTREAM (stream))));
3010 #endif /* FILE_CODING */
3014 /* Close the file/stream */
3015 unbind_to (speccount, Qnil);
3019 error ("IO error reading %s: %s",
3020 XSTRING_DATA (filename), strerror (saverrno));
3026 end_multiple_change (buf, mc_count);
3030 if (!EQ (buf->undo_list, Qt))
3031 buf->undo_list = Qnil;
3033 stat ((char *) XSTRING_DATA (filename), &st);
3037 buf->modtime = st.st_mtime;
3038 buf->filename = filename;
3039 /* XEmacs addition: */
3040 /* This function used to be in C, ostensibly so that
3041 it could be called here. But that's just silly.
3042 There's no reason C code can't call out to Lisp
3043 code, and it's a lot cleaner this way. */
3044 if (!NILP (Ffboundp (Qcompute_buffer_file_truename)))
3045 call1 (Qcompute_buffer_file_truename, make_buffer (buf));
3047 BUF_SAVE_MODIFF (buf) = BUF_MODIFF (buf);
3048 buf->auto_save_modified = BUF_MODIFF (buf);
3049 buf->saved_size = make_int (BUF_SIZE (buf));
3050 #ifdef CLASH_DETECTION
3053 if (!NILP (buf->file_truename))
3054 unlock_file (buf->file_truename);
3055 unlock_file (filename);
3057 #endif /* CLASH_DETECTION */
3059 RETURN_UNGCPRO (Fsignal (Qfile_error,
3060 list2 (build_string ("not a regular file"),
3063 /* If visiting nonexistent file, return nil. */
3064 if (buf->modtime == -1)
3065 report_file_error ("Opening input file",
3069 /* Decode file format */
3072 Lisp_Object insval = call3 (Qformat_decode,
3073 Qnil, make_int (inserted), visit);
3075 inserted = XINT (insval);
3081 struct gcpro ngcpro1;
3084 EXTERNAL_LIST_LOOP (p, Vafter_insert_file_functions)
3086 Lisp_Object insval =
3087 call1 (XCAR (p), make_int (inserted));
3090 CHECK_NATNUM (insval);
3091 inserted = XINT (insval);
3103 return (list2 (filename, make_int (inserted)));
3107 static int a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3108 Lisp_Object *annot);
3109 static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end);
3111 /* If build_annotations switched buffers, switch back to BUF.
3112 Kill the temporary buffer that was selected in the meantime. */
3115 build_annotations_unwind (Lisp_Object buf)
3119 if (XBUFFER (buf) == current_buffer)
3121 tembuf = Fcurrent_buffer ();
3123 Fkill_buffer (tembuf);
3127 DEFUN ("write-region-internal", Fwrite_region_internal, 3, 7,
3128 "r\nFWrite region to file: ", /*
3129 Write current region into specified file; no coding-system frobbing.
3130 This function is identical to `write-region' except for the handling
3131 of the CODESYS argument under XEmacs/Mule. (When Mule support is not
3132 present, both functions are identical and ignore the CODESYS argument.)
3133 If support for Mule exists in this Emacs, the file is encoded according
3134 to the value of CODESYS. If this is nil, no code conversion occurs.
3136 (start, end, filename, append, visit, lockname, codesys))
3138 /* This function can call lisp */
3144 int speccount = specpdl_depth ();
3145 int visiting_other = STRINGP (visit);
3146 int visiting = (EQ (visit, Qt) || visiting_other);
3147 int quietly = (!visiting && !NILP (visit));
3148 Lisp_Object visit_file = Qnil;
3149 Lisp_Object annotations = Qnil;
3150 struct buffer *given_buffer;
3151 Bufpos start1, end1;
3153 /* #### dmoore - if Fexpand_file_name or handlers kill the buffer,
3154 we should signal an error rather than blissfully continuing
3155 along. ARGH, this function is going to lose lose lose. We need
3156 to protect the current_buffer from being destroyed, but the
3157 multiple return points make this a pain in the butt. */
3160 codesys = Fget_coding_system (codesys);
3161 #endif /* FILE_CODING */
3163 if (current_buffer->base_buffer && ! NILP (visit))
3164 error ("Cannot do file visiting in an indirect buffer");
3166 if (!NILP (start) && !STRINGP (start))
3167 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0);
3170 Lisp_Object handler;
3171 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3173 GCPRO5 (start, filename, visit, visit_file, lockname);
3176 visit_file = Fexpand_file_name (visit, Qnil);
3178 visit_file = filename;
3179 filename = Fexpand_file_name (filename, Qnil);
3183 if (NILP (lockname))
3184 lockname = visit_file;
3186 /* If the file name has special constructs in it,
3187 call the corresponding file handler. */
3188 handler = Ffind_file_name_handler (filename, Qwrite_region);
3189 /* If FILENAME has no handler, see if VISIT has one. */
3190 if (NILP (handler) && STRINGP (visit))
3191 handler = Ffind_file_name_handler (visit, Qwrite_region);
3193 if (!NILP (handler))
3195 Lisp_Object val = call8 (handler, Qwrite_region, start, end,
3196 filename, append, visit, lockname, codesys);
3199 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3200 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3201 current_buffer->filename = visit_file;
3202 MARK_MODELINE_CHANGED;
3208 #ifdef CLASH_DETECTION
3212 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3214 XSETBUFFER (curbuf, current_buffer);
3215 GCPRO5 (start, filename, visit_file, lockname, curbuf);
3216 lock_file (lockname);
3219 #endif /* CLASH_DETECTION */
3221 /* Special kludge to simplify auto-saving. */
3224 start1 = BUF_BEG (current_buffer);
3225 end1 = BUF_Z (current_buffer);
3228 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
3230 given_buffer = current_buffer;
3231 annotations = build_annotations (start, end);
3232 if (current_buffer != given_buffer)
3234 start1 = BUF_BEGV (current_buffer);
3235 end1 = BUF_ZV (current_buffer);
3242 desc = open ((char *) XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0);
3246 desc = open ((char *) XSTRING_DATA (fn),
3247 (O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY),
3248 ((auto_saving) ? auto_save_mode_bits : CREAT_MODE));
3253 #ifdef CLASH_DETECTION
3255 if (!auto_saving) unlock_file (lockname);
3257 #endif /* CLASH_DETECTION */
3258 report_file_error ("Opening output file", list1 (filename));
3262 Lisp_Object desc_locative = Fcons (make_int (desc), Qnil);
3263 Lisp_Object instream = Qnil, outstream = Qnil;
3264 struct gcpro gcpro1, gcpro2;
3265 /* need to gcpro; QUIT could happen out of call to write() */
3266 GCPRO2 (instream, outstream);
3268 record_unwind_protect (close_file_unwind, desc_locative);
3272 if (lseek (desc, 0, 2) < 0)
3274 #ifdef CLASH_DETECTION
3275 if (!auto_saving) unlock_file (lockname);
3276 #endif /* CLASH_DETECTION */
3277 report_file_error ("Lseek error",
3284 /* Note: I tried increasing the buffering size, along with
3285 various other tricks, but nothing seemed to make much of
3286 a difference in the time it took to save a large file.
3287 (Actually that's not true. With a local disk, changing
3288 the buffer size doesn't seem to make much difference.
3289 With an NFS-mounted disk, it could make a lot of difference
3290 because you're affecting the number of network requests
3291 that need to be made, and there could be a large latency
3292 for each request. So I've increased the buffer size
3294 outstream = make_filedesc_output_stream (desc, 0, -1, 0);
3295 Lstream_set_buffering (XLSTREAM (outstream),
3296 LSTREAM_BLOCKN_BUFFERED, 65536);
3299 make_encoding_output_stream (XLSTREAM (outstream), codesys);
3300 Lstream_set_buffering (XLSTREAM (outstream),
3301 LSTREAM_BLOCKN_BUFFERED, 65536);
3302 #endif /* FILE_CODING */
3303 if (STRINGP (start))
3305 instream = make_lisp_string_input_stream (start, 0, -1);
3309 instream = make_lisp_buffer_input_stream (current_buffer, start1, end1,
3311 LSTR_IGNORE_ACCESSIBLE);
3312 failure = (0 > (a_write (outstream, instream, start1,
3315 /* Note that this doesn't close the desc since we created the
3316 stream without the LSTR_CLOSING flag, but it does
3317 flush out any buffered data. */
3318 if (Lstream_close (XLSTREAM (outstream)) < 0)
3323 Lstream_close (XLSTREAM (instream));
3327 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3328 Disk full in NFS may be reported here. */
3329 /* mib says that closing the file will try to write as fast as NFS can do
3330 it, and that means the fsync here is not crucial for autosave files. */
3331 if (!auto_saving && fsync (desc) < 0
3332 /* If fsync fails with EINTR, don't treat that as serious. */
3338 #endif /* HAVE_FSYNC */
3340 /* Spurious "file has changed on disk" warnings have been
3341 observed on Suns as well.
3342 It seems that `close' can change the modtime, under nfs.
3344 (This has supposedly been fixed in Sunos 4,
3345 but who knows about all the other machines with NFS?) */
3346 /* On VMS and APOLLO, must do the stat after the close
3347 since closing changes the modtime. */
3348 /* As it does on Windows too - kkm */
3349 #if !defined (WINDOWSNT) /* !defined (VMS) && !defined (APOLLO) */
3353 /* NFS can report a write failure now. */
3354 if (close (desc) < 0)
3360 /* Discard the close unwind-protect. Execute the one for
3361 build_annotations (switches back to the original current buffer
3363 XCAR (desc_locative) = Qnil;
3364 unbind_to (speccount, Qnil);
3367 #if defined (WINDOWSNT) /* defined (VMS) || defined (APOLLO) */
3368 stat ((char *) XSTRING_DATA (fn), &st);
3371 #ifdef CLASH_DETECTION
3373 unlock_file (lockname);
3374 #endif /* CLASH_DETECTION */
3376 /* Do this before reporting IO error
3377 to avoid a "file has changed on disk" warning on
3378 next attempt to save. */
3380 current_buffer->modtime = st.st_mtime;
3383 error ("IO error writing %s: %s",
3385 strerror (save_errno));
3389 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3390 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3391 current_buffer->filename = visit_file;
3392 MARK_MODELINE_CHANGED;
3402 message ("Wrote %s", XSTRING_DATA (visit_file));
3405 struct gcpro gcpro1;
3409 fsp = Ffile_symlink_p (fn);
3411 message ("Wrote %s", XSTRING_DATA (fn));
3413 message ("Wrote %s (symlink to %s)",
3414 XSTRING_DATA (fn), XSTRING_DATA (fsp));
3421 /* #### This is such a load of shit!!!! There is no way we should define
3422 something so stupid as a subr, just sort the fucking list more
3424 DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3425 Return t if (car A) is numerically less than (car B).
3429 return arithcompare (Fcar (a), Fcar (b), arith_less);
3432 /* Heh heh heh, let's define this too, just to aggravate the person who
3433 wrote the above comment. */
3434 DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3435 Return t if (cdr A) is numerically less than (cdr B).
3439 return arithcompare (Fcdr (a), Fcdr (b), arith_less);
3442 /* Build the complete list of annotations appropriate for writing out
3443 the text between START and END, by calling all the functions in
3444 write-region-annotate-functions and merging the lists they return.
3445 If one of these functions switches to a different buffer, we assume
3446 that buffer contains altered text. Therefore, the caller must
3447 make sure to restore the current buffer in all cases,
3448 as save-excursion would do. */
3451 build_annotations (Lisp_Object start, Lisp_Object end)
3453 /* This function can GC */
3454 Lisp_Object annotations;
3456 struct gcpro gcpro1, gcpro2;
3457 Lisp_Object original_buffer;
3459 XSETBUFFER (original_buffer, current_buffer);
3462 p = Vwrite_region_annotate_functions;
3463 GCPRO2 (annotations, p);
3466 struct buffer *given_buffer = current_buffer;
3467 Vwrite_region_annotations_so_far = annotations;
3468 res = call2 (Fcar (p), start, end);
3469 /* If the function makes a different buffer current,
3470 assume that means this buffer contains altered text to be output.
3471 Reset START and END from the buffer bounds
3472 and discard all previous annotations because they should have
3473 been dealt with by this function. */
3474 if (current_buffer != given_buffer)
3476 start = make_int (BUF_BEGV (current_buffer));
3477 end = make_int (BUF_ZV (current_buffer));
3480 Flength (res); /* Check basic validity of return value */
3481 annotations = merge (annotations, res, Qcar_less_than_car);
3485 /* Now do the same for annotation functions implied by the file-format */
3486 if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
3487 p = Vauto_save_file_format;
3489 p = current_buffer->file_format;
3492 struct buffer *given_buffer = current_buffer;
3493 Vwrite_region_annotations_so_far = annotations;
3494 res = call4 (Qformat_annotate_function, Fcar (p), start, end,
3496 if (current_buffer != given_buffer)
3498 start = make_int (BUF_BEGV (current_buffer));
3499 end = make_int (BUF_ZV (current_buffer));
3503 annotations = merge (annotations, res, Qcar_less_than_car);
3510 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3511 EOF is encountered), assuming they start at position POS in the buffer
3512 of string that STREAM refers to. Intersperse with them the annotations
3513 from *ANNOT that fall into the range of positions we are reading from,
3514 each at its appropriate position.
3516 Modify *ANNOT by discarding elements as we output them.
3517 The return value is negative in case of system call failure. */
3519 /* 4K should probably be fine. We just need to reduce the number of
3520 function calls to reasonable level. The Lstream stuff itself will
3521 batch to 64K to reduce the number of system calls. */
3523 #define A_WRITE_BATCH_SIZE 4096
3526 a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3531 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3532 Lstream *instr = XLSTREAM (instream);
3533 Lstream *outstr = XLSTREAM (outstream);
3535 while (LISTP (*annot))
3537 tem = Fcar_safe (Fcar (*annot));
3539 nextpos = XINT (tem);
3543 /* If there are annotations left and we have Mule, then we
3544 have to do the I/O one emchar at a time so we can
3545 determine when to insert the annotation. */
3549 while (pos != nextpos && (ch = Lstream_get_emchar (instr)) != EOF)
3551 if (Lstream_put_emchar (outstr, ch) < 0)
3559 while (pos != nextpos)
3561 /* Otherwise there is no point to that. Just go in batches. */
3562 int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE);
3564 chunk = Lstream_read (instr, largebuf, chunk);
3567 if (chunk == 0) /* EOF */
3569 if (Lstream_write (outstr, largebuf, chunk) < chunk)
3576 tem = Fcdr (Fcar (*annot));
3579 if (Lstream_write (outstr, XSTRING_DATA (tem),
3580 XSTRING_LENGTH (tem)) < 0)
3583 *annot = Fcdr (*annot);
3594 #include <des_crypt.h>
3596 #define CRYPT_BLOCK_SIZE 8 /* bytes */
3597 #define CRYPT_KEY_SIZE 8 /* bytes */
3599 DEFUN ("encrypt-string", Fencrypt_string, 2, 2, 0, /*
3600 Encrypt STRING using KEY.
3604 char *encrypted_string, *raw_key;
3605 int rounded_size, extra, key_size;
3607 /* !!#### May produce bogus data under Mule. */
3608 CHECK_STRING (string);
3611 extra = XSTRING_LENGTH (string) % CRYPT_BLOCK_SIZE;
3612 rounded_size = XSTRING_LENGTH (string) + extra;
3613 encrypted_string = alloca (rounded_size + 1);
3614 memcpy (encrypted_string, XSTRING_DATA (string), XSTRING_LENGTH (string));
3615 memset (encrypted_string + rounded_size - extra, 0, extra + 1);
3617 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3619 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3620 memcpy (raw_key, XSTRING_DATA (key), key_size);
3621 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3623 ecb_crypt (raw_key, encrypted_string, rounded_size,
3624 DES_ENCRYPT | DES_SW);
3625 return make_string (encrypted_string, rounded_size);
3628 DEFUN ("decrypt-string", Fdecrypt_string, 2, 2, 0, /*
3629 Decrypt STRING using KEY.
3633 char *decrypted_string, *raw_key;
3634 int string_size, key_size;
3636 CHECK_STRING (string);
3639 string_size = XSTRING_LENGTH (string) + 1;
3640 decrypted_string = alloca (string_size);
3641 memcpy (decrypted_string, XSTRING_DATA (string), string_size);
3642 decrypted_string[string_size - 1] = '\0';
3644 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3646 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3647 memcpy (raw_key, XSTRING_DATA (key), key_size);
3648 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3651 ecb_crypt (raw_key, decrypted_string, string_size, D | DES_SW);
3652 return make_string (decrypted_string, string_size - 1);
3657 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
3658 Return t if last mod time of BUF's visited file matches what BUF records.
3659 This means that the file has not been changed since it was visited or saved.
3663 /* This function can call lisp */
3666 Lisp_Object handler;
3671 if (!STRINGP (b->filename)) return Qt;
3672 if (b->modtime == 0) return Qt;
3674 /* If the file name has special constructs in it,
3675 call the corresponding file handler. */
3676 handler = Ffind_file_name_handler (b->filename,
3677 Qverify_visited_file_modtime);
3678 if (!NILP (handler))
3679 return call2 (handler, Qverify_visited_file_modtime, buf);
3681 if (stat ((char *) XSTRING_DATA (b->filename), &st) < 0)
3683 /* If the file doesn't exist now and didn't exist before,
3684 we say that it isn't modified, provided the error is a tame one. */
3685 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3690 if (st.st_mtime == b->modtime
3691 /* If both are positive, accept them if they are off by one second. */
3692 || (st.st_mtime > 0 && b->modtime > 0
3693 && (st.st_mtime == b->modtime + 1
3694 || st.st_mtime == b->modtime - 1)))
3699 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3700 Clear out records of last mod time of visited file.
3701 Next attempt to save will certainly not complain of a discrepancy.
3705 current_buffer->modtime = 0;
3709 DEFUN ("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3710 Return the current buffer's recorded visited file modification time.
3711 The value is a list of the form (HIGH . LOW), like the time values
3712 that `file-attributes' returns.
3716 return time_to_lisp ((time_t) current_buffer->modtime);
3719 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3720 Update buffer's recorded modification time from the visited file's time.
3721 Useful if the buffer was not read from the file normally
3722 or if the file itself has been changed for some known benign reason.
3723 An argument specifies the modification time value to use
3724 \(instead of that of the visited file), in the form of a list
3725 \(HIGH . LOW) or (HIGH LOW).
3729 /* This function can call lisp */
3730 if (!NILP (time_list))
3733 lisp_to_time (time_list, &the_time);
3734 current_buffer->modtime = (int) the_time;
3738 Lisp_Object filename;
3740 Lisp_Object handler;
3741 struct gcpro gcpro1, gcpro2, gcpro3;
3743 GCPRO3 (filename, time_list, current_buffer->filename);
3744 filename = Fexpand_file_name (current_buffer->filename, Qnil);
3746 /* If the file name has special constructs in it,
3747 call the corresponding file handler. */
3748 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
3750 if (!NILP (handler))
3751 /* The handler can find the file name the same way we did. */
3752 return call2 (handler, Qset_visited_file_modtime, Qnil);
3753 else if (stat ((char *) XSTRING_DATA (filename), &st) >= 0)
3754 current_buffer->modtime = st.st_mtime;
3761 auto_save_error (Lisp_Object condition_object, Lisp_Object ignored)
3763 /* This function can call lisp */
3766 /* Don't try printing an error message after everything is gone! */
3767 if (preparing_for_armageddon)
3769 clear_echo_area (selected_frame (), Qauto_saving, 1);
3770 Fding (Qt, Qauto_save_error, Qnil);
3771 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3772 Fsleep_for (make_int (1));
3773 message ("Auto-saving...error!for %s", XSTRING_DATA (current_buffer->name));
3774 Fsleep_for (make_int (1));
3775 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3776 Fsleep_for (make_int (1));
3781 auto_save_1 (Lisp_Object ignored)
3783 /* This function can call lisp */
3784 /* #### I think caller is protecting current_buffer? */
3786 Lisp_Object fn = current_buffer->filename;
3787 Lisp_Object a = current_buffer->auto_save_file_name;
3792 /* Get visited file's mode to become the auto save file's mode. */
3794 stat ((char *) XSTRING_DATA (fn), &st) >= 0)
3795 /* But make sure we can overwrite it later! */
3796 auto_save_mode_bits = st.st_mode | 0600;
3798 /* default mode for auto-save files of buffers with no file is
3799 readable by owner only. This may annoy some small number of
3800 people, but the alternative removes all privacy from email. */
3801 auto_save_mode_bits = 0600;
3804 /* !!#### need to deal with this 'escape-quoted everywhere */
3805 Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil,
3815 auto_save_expand_name_error (Lisp_Object condition_object, Lisp_Object ignored)
3817 /* #### this function should spew an error message about not being
3818 able to open the .saves file. */
3823 auto_save_expand_name (Lisp_Object name)
3825 struct gcpro gcpro1;
3827 /* note that caller did NOT gc protect name, so we do it. */
3828 /* #### dmoore - this might not be neccessary, if condition_case_1
3829 protects it. but I don't think it does. */
3831 RETURN_UNGCPRO (Fexpand_file_name (name, Qnil));
3836 do_auto_save_unwind (Lisp_Object fd)
3843 do_auto_save_unwind_2 (Lisp_Object old_auto_saving)
3845 auto_saving = XINT (old_auto_saving);
3849 /* Fdo_auto_save() checks whether a GC is in progress when it is called,
3850 and if so, tries to avoid touching lisp objects.
3852 The only time that Fdo_auto_save() is called while GC is in progress
3853 is if we're going down, as a result of an abort() or a kill signal.
3854 It's fairly important that we generate autosave files in that case!
3857 DEFUN ("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3858 Auto-save all buffers that need it.
3859 This is all buffers that have auto-saving enabled
3860 and are changed since last auto-saved.
3861 Auto-saving writes the buffer into a file
3862 so that your editing is not lost if the system crashes.
3863 This file is not the file you visited; that changes only when you save.
3864 Normally we run the normal hook `auto-save-hook' before saving.
3866 Non-nil first argument means do not print any message if successful.
3867 Non-nil second argument means save only current buffer.
3869 (no_message, current_only))
3871 /* This function can call lisp */
3873 Lisp_Object tail, buf;
3875 int do_handled_files;
3876 Lisp_Object oquit = Qnil;
3877 Lisp_Object listfile = Qnil;
3880 int speccount = specpdl_depth ();
3881 struct gcpro gcpro1, gcpro2, gcpro3;
3883 XSETBUFFER (old, current_buffer);
3884 GCPRO3 (oquit, listfile, old);
3885 check_quit (); /* make Vquit_flag accurate */
3886 /* Ordinarily don't quit within this function,
3887 but don't make it impossible to quit (in case we get hung in I/O). */
3891 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3892 variables point to non-strings reached from Vbuffer_alist. */
3894 if (minibuf_level != 0 || preparing_for_armageddon)
3897 run_hook (Qauto_save_hook);
3899 if (GC_STRINGP (Vauto_save_list_file_name))
3900 listfile = condition_case_1 (Qt,
3901 auto_save_expand_name,
3902 Vauto_save_list_file_name,
3903 auto_save_expand_name_error, Qnil);
3905 /* Make sure auto_saving is reset. */
3906 record_unwind_protect (do_auto_save_unwind_2, make_int (auto_saving));
3910 /* First, save all files which don't have handlers. If Emacs is
3911 crashing, the handlers may tweak what is causing Emacs to crash
3912 in the first place, and it would be a shame if Emacs failed to
3913 autosave perfectly ordinary files because it couldn't handle some
3915 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
3917 for (tail = Vbuffer_alist;
3921 buf = XCDR (XCAR (tail));
3924 if (!GC_NILP (current_only)
3925 && b != current_buffer)
3928 /* Don't auto-save indirect buffers.
3929 The base buffer takes care of it. */
3933 /* Check for auto save enabled
3934 and file changed since last auto save
3935 and file changed since last real save. */
3936 if (GC_STRINGP (b->auto_save_file_name)
3937 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
3938 && b->auto_save_modified < BUF_MODIFF (b)
3939 /* -1 means we've turned off autosaving for a while--see below. */
3940 && XINT (b->saved_size) >= 0
3941 && (do_handled_files
3942 || NILP (Ffind_file_name_handler (b->auto_save_file_name,
3945 EMACS_TIME before_time, after_time;
3947 EMACS_GET_TIME (before_time);
3948 /* If we had a failure, don't try again for 20 minutes. */
3949 if (!preparing_for_armageddon
3950 && b->auto_save_failure_time >= 0
3951 && (EMACS_SECS (before_time) - b->auto_save_failure_time <
3955 if (!preparing_for_armageddon &&
3956 (XINT (b->saved_size) * 10
3957 > (BUF_Z (b) - BUF_BEG (b)) * 13)
3958 /* A short file is likely to change a large fraction;
3959 spare the user annoying messages. */
3960 && XINT (b->saved_size) > 5000
3961 /* These messages are frequent and annoying for `*mail*'. */
3962 && !NILP (b->filename)
3963 && NILP (no_message)
3964 && disable_auto_save_when_buffer_shrinks)
3966 /* It has shrunk too much; turn off auto-saving here.
3967 Unless we're about to crash, in which case auto-save it
3971 ("Buffer %s has shrunk a lot; auto save turned off there",
3972 XSTRING_DATA (b->name));
3973 /* Turn off auto-saving until there's a real save,
3974 and prevent any more warnings. */
3975 b->saved_size = make_int (-1);
3976 if (!gc_in_progress)
3977 Fsleep_for (make_int (1));
3980 set_buffer_internal (b);
3981 if (!auto_saved && GC_NILP (no_message))
3983 static CONST unsigned char *msg
3984 = (CONST unsigned char *) "Auto-saving...";
3985 echo_area_message (selected_frame (), msg, Qnil,
3986 0, strlen ((CONST char *) msg),
3990 /* Open the auto-save list file, if necessary.
3991 We only do this now so that the file only exists
3992 if we actually auto-saved any files. */
3993 if (!auto_saved && GC_STRINGP (listfile) && listdesc < 0)
3995 listdesc = open ((char *) XSTRING_DATA (listfile),
3996 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
3999 /* Arrange to close that file whether or not we get
4002 record_unwind_protect (do_auto_save_unwind,
4003 make_int (listdesc));
4006 /* Record all the buffers that we are auto-saving in
4007 the special file that lists them. For each of
4008 these buffers, record visited name (if any) and
4012 CONST Extbyte *auto_save_file_name_ext;
4013 Extcount auto_save_file_name_ext_len;
4015 GET_STRING_FILENAME_DATA_ALLOCA
4016 (b->auto_save_file_name,
4017 auto_save_file_name_ext,
4018 auto_save_file_name_ext_len);
4019 if (!NILP (b->filename))
4021 CONST Extbyte *filename_ext;
4022 Extcount filename_ext_len;
4024 GET_STRING_FILENAME_DATA_ALLOCA (b->filename,
4027 write (listdesc, filename_ext, filename_ext_len);
4029 write (listdesc, "\n", 1);
4030 write (listdesc, auto_save_file_name_ext,
4031 auto_save_file_name_ext_len);
4032 write (listdesc, "\n", 1);
4035 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
4036 based on values in Vbuffer_alist. auto_save_1 may
4037 cause lisp handlers to run. Those handlers may kill
4038 the buffer and then GC. Since the buffer is killed,
4039 it's no longer in Vbuffer_alist so it might get reaped
4040 by the GC. We also need to protect tail. */
4041 /* #### There is probably a lot of other code which has
4042 pointers into buffers which may get blown away by
4045 struct gcpro ngcpro1, ngcpro2;
4046 NGCPRO2 (buf, tail);
4047 condition_case_1 (Qt,
4049 auto_save_error, Qnil);
4052 /* Handler killed our saved current-buffer! Pick any. */
4053 if (!BUFFER_LIVE_P (XBUFFER (old)))
4054 XSETBUFFER (old, current_buffer);
4056 set_buffer_internal (XBUFFER (old));
4059 /* Handler killed their own buffer! */
4060 if (!BUFFER_LIVE_P(b))
4063 b->auto_save_modified = BUF_MODIFF (b);
4064 b->saved_size = make_int (BUF_SIZE (b));
4065 EMACS_GET_TIME (after_time);
4066 /* If auto-save took more than 60 seconds,
4067 assume it was an NFS failure that got a timeout. */
4068 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
4069 b->auto_save_failure_time = EMACS_SECS (after_time);
4074 /* Prevent another auto save till enough input events come in. */
4076 record_auto_save ();
4078 /* If we didn't save anything into the listfile, remove the old
4079 one because nothing needed to be auto-saved. Do this afterwards
4080 rather than before in case we get a crash attempting to autosave
4081 (in that case we'd still want the old one around). */
4082 if (listdesc < 0 && !auto_saved && GC_STRINGP (listfile))
4083 unlink ((char *) XSTRING_DATA (listfile));
4085 /* Show "...done" only if the echo area would otherwise be empty. */
4086 if (auto_saved && NILP (no_message)
4087 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0)))
4089 static CONST unsigned char *msg
4090 = (CONST unsigned char *)"Auto-saving...done";
4091 echo_area_message (selected_frame (), msg, Qnil, 0,
4092 strlen ((CONST char *) msg), Qauto_saving);
4097 RETURN_UNGCPRO (unbind_to (speccount, Qnil));
4100 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
4101 Mark current buffer as auto-saved with its current text.
4102 No auto-save file will be written until the buffer changes again.
4106 current_buffer->auto_save_modified = BUF_MODIFF (current_buffer);
4107 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
4108 current_buffer->auto_save_failure_time = -1;
4112 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
4113 Clear any record of a recent auto-save failure in the current buffer.
4117 current_buffer->auto_save_failure_time = -1;
4121 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
4122 Return t if buffer has been auto-saved since last read in or saved.
4126 return (BUF_SAVE_MODIFF (current_buffer) <
4127 current_buffer->auto_save_modified) ? Qt : Qnil;
4131 /************************************************************************/
4132 /* initialization */
4133 /************************************************************************/
4136 syms_of_fileio (void)
4138 defsymbol (&Qexpand_file_name, "expand-file-name");
4139 defsymbol (&Qfile_truename, "file-truename");
4140 defsymbol (&Qsubstitute_in_file_name, "substitute-in-file-name");
4141 defsymbol (&Qdirectory_file_name, "directory-file-name");
4142 defsymbol (&Qfile_name_directory, "file-name-directory");
4143 defsymbol (&Qfile_name_nondirectory, "file-name-nondirectory");
4144 defsymbol (&Qunhandled_file_name_directory, "unhandled-file-name-directory");
4145 defsymbol (&Qfile_name_as_directory, "file-name-as-directory");
4146 defsymbol (&Qcopy_file, "copy-file");
4147 defsymbol (&Qmake_directory_internal, "make-directory-internal");
4148 defsymbol (&Qdelete_directory, "delete-directory");
4149 defsymbol (&Qdelete_file, "delete-file");
4150 defsymbol (&Qrename_file, "rename-file");
4151 defsymbol (&Qadd_name_to_file, "add-name-to-file");
4152 defsymbol (&Qmake_symbolic_link, "make-symbolic-link");
4153 defsymbol (&Qfile_exists_p, "file-exists-p");
4154 defsymbol (&Qfile_executable_p, "file-executable-p");
4155 defsymbol (&Qfile_readable_p, "file-readable-p");
4156 defsymbol (&Qfile_symlink_p, "file-symlink-p");
4157 defsymbol (&Qfile_writable_p, "file-writable-p");
4158 defsymbol (&Qfile_directory_p, "file-directory-p");
4159 defsymbol (&Qfile_regular_p, "file-regular-p");
4160 defsymbol (&Qfile_accessible_directory_p, "file-accessible-directory-p");
4161 defsymbol (&Qfile_modes, "file-modes");
4162 defsymbol (&Qset_file_modes, "set-file-modes");
4163 defsymbol (&Qfile_newer_than_file_p, "file-newer-than-file-p");
4164 defsymbol (&Qinsert_file_contents, "insert-file-contents");
4165 defsymbol (&Qwrite_region, "write-region");
4166 defsymbol (&Qverify_visited_file_modtime, "verify-visited-file-modtime");
4167 defsymbol (&Qset_visited_file_modtime, "set-visited-file-modtime");
4168 defsymbol (&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */
4170 defsymbol (&Qfile_name_handler_alist, "file-name-handler-alist");
4171 defsymbol (&Qauto_save_hook, "auto-save-hook");
4172 defsymbol (&Qauto_save_error, "auto-save-error");
4173 defsymbol (&Qauto_saving, "auto-saving");
4175 defsymbol (&Qformat_decode, "format-decode");
4176 defsymbol (&Qformat_annotate_function, "format-annotate-function");
4178 defsymbol (&Qcompute_buffer_file_truename, "compute-buffer-file-truename");
4179 deferror (&Qfile_error, "file-error", "File error", Qio_error);
4180 deferror (&Qfile_already_exists, "file-already-exists",
4181 "File already exists", Qfile_error);
4183 DEFSUBR (Ffind_file_name_handler);
4185 DEFSUBR (Ffile_name_directory);
4186 DEFSUBR (Ffile_name_nondirectory);
4187 DEFSUBR (Funhandled_file_name_directory);
4188 DEFSUBR (Ffile_name_as_directory);
4189 DEFSUBR (Fdirectory_file_name);
4190 DEFSUBR (Fmake_temp_name);
4191 DEFSUBR (Fexpand_file_name);
4192 DEFSUBR (Ffile_truename);
4193 DEFSUBR (Fsubstitute_in_file_name);
4194 DEFSUBR (Fcopy_file);
4195 DEFSUBR (Fmake_directory_internal);
4196 DEFSUBR (Fdelete_directory);
4197 DEFSUBR (Fdelete_file);
4198 DEFSUBR (Frename_file);
4199 DEFSUBR (Fadd_name_to_file);
4201 DEFSUBR (Fmake_symbolic_link);
4202 #endif /* S_IFLNK */
4204 DEFSUBR (Fsysnetunam);
4205 #endif /* HPUX_NET */
4206 DEFSUBR (Ffile_name_absolute_p);
4207 DEFSUBR (Ffile_exists_p);
4208 DEFSUBR (Ffile_executable_p);
4209 DEFSUBR (Ffile_readable_p);
4210 DEFSUBR (Ffile_writable_p);
4211 DEFSUBR (Ffile_symlink_p);
4212 DEFSUBR (Ffile_directory_p);
4213 DEFSUBR (Ffile_accessible_directory_p);
4214 DEFSUBR (Ffile_regular_p);
4215 DEFSUBR (Ffile_modes);
4216 DEFSUBR (Fset_file_modes);
4217 DEFSUBR (Fset_default_file_modes);
4218 DEFSUBR (Fdefault_file_modes);
4219 DEFSUBR (Funix_sync);
4220 DEFSUBR (Ffile_newer_than_file_p);
4221 DEFSUBR (Finsert_file_contents_internal);
4222 DEFSUBR (Fwrite_region_internal);
4223 DEFSUBR (Fcar_less_than_car); /* Vomitous! */
4224 DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
4226 DEFSUBR (Fencrypt_string);
4227 DEFSUBR (Fdecrypt_string);
4229 DEFSUBR (Fverify_visited_file_modtime);
4230 DEFSUBR (Fclear_visited_file_modtime);
4231 DEFSUBR (Fvisited_file_modtime);
4232 DEFSUBR (Fset_visited_file_modtime);
4234 DEFSUBR (Fdo_auto_save);
4235 DEFSUBR (Fset_buffer_auto_saved);
4236 DEFSUBR (Fclear_buffer_auto_save_failure);
4237 DEFSUBR (Frecent_auto_save_p);
4241 vars_of_fileio (void)
4243 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /*
4244 *Format in which to write auto-save files.
4245 Should be a list of symbols naming formats that are defined in `format-alist'.
4246 If it is t, which is the default, auto-save files are written in the
4247 same format as a regular save would use.
4249 Vauto_save_file_format = Qt;
4251 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /*
4252 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
4253 If a file name matches REGEXP, then all I/O on that file is done by calling
4256 The first argument given to HANDLER is the name of the I/O primitive
4257 to be handled; the remaining arguments are the arguments that were
4258 passed to that primitive. For example, if you do
4259 (file-exists-p FILENAME)
4260 and FILENAME is handled by HANDLER, then HANDLER is called like this:
4261 (funcall HANDLER 'file-exists-p FILENAME)
4262 The function `find-file-name-handler' checks this list for a handler
4265 Vfile_name_handler_alist = Qnil;
4267 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /*
4268 A list of functions to be called at the end of `insert-file-contents'.
4269 Each is passed one argument, the number of bytes inserted. It should return
4270 the new byte count, and leave point the same. If `insert-file-contents' is
4271 intercepted by a handler from `file-name-handler-alist', that handler is
4272 responsible for calling the after-insert-file-functions if appropriate.
4274 Vafter_insert_file_functions = Qnil;
4276 DEFVAR_LISP ("write-region-annotate-functions",
4277 &Vwrite_region_annotate_functions /*
4278 A list of functions to be called at the start of `write-region'.
4279 Each is passed two arguments, START and END, as for `write-region'.
4280 It should return a list of pairs (POSITION . STRING) of strings to be
4281 effectively inserted at the specified positions of the file being written
4282 \(1 means to insert before the first byte written). The POSITIONs must be
4283 sorted into increasing order. If there are several functions in the list,
4284 the several lists are merged destructively.
4286 Vwrite_region_annotate_functions = Qnil;
4288 DEFVAR_LISP ("write-region-annotations-so-far",
4289 &Vwrite_region_annotations_so_far /*
4290 When an annotation function is called, this holds the previous annotations.
4291 These are the annotations made by other annotation functions
4292 that were already called. See also `write-region-annotate-functions'.
4294 Vwrite_region_annotations_so_far = Qnil;
4296 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
4297 A list of file name handlers that temporarily should not be used.
4298 This applies only to the operation `inhibit-file-name-operation'.
4300 Vinhibit_file_name_handlers = Qnil;
4302 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
4303 The operation for which `inhibit-file-name-handlers' is applicable.
4305 Vinhibit_file_name_operation = Qnil;
4307 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name /*
4308 File name in which we write a list of all auto save file names.
4310 Vauto_save_list_file_name = Qnil;
4312 DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks",
4313 &disable_auto_save_when_buffer_shrinks /*
4314 If non-nil, auto-saving is disabled when a buffer shrinks too much.
4315 This is to prevent you from losing your edits if you accidentally
4316 delete a large chunk of the buffer and don't notice it until too late.
4317 Saving the buffer normally turns auto-save back on.
4319 disable_auto_save_when_buffer_shrinks = 1;
4321 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /*
4322 Directory separator character for built-in functions that return file names.
4323 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
4324 This variable affects the built-in functions only on Windows,
4325 on other platforms, it is initialized so that Lisp code can find out
4326 what the normal separator is.
4328 Vdirectory_sep_char = make_char ('/');