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> */
33 #include "redisplay.h"
35 #include "window.h" /* minibuf_level */
37 #include "file-coding.h"
40 #ifdef HAVE_LIBGEN_H /* Must come before sysfile.h */
53 #endif /* HPUX_PRE_8_0 */
57 #define IS_DRIVE(x) isalpha (x)
58 /* Need to lower-case the drive letter, or else expanded
59 filenames will sometimes compare inequal, because
60 `expand-file-name' doesn't always down-case the drive letter. */
61 #define DRIVE_LETTER(x) tolower (x)
62 #endif /* WIN32_NATIVE */
64 int lisp_to_time (Lisp_Object, time_t *);
65 Lisp_Object time_to_lisp (time_t);
67 /* Nonzero during writing of auto-save files */
68 static int auto_saving;
70 /* Set by auto_save_1 to mode of original file so Fwrite_region_internal
71 will create a new file with the same mode as the original */
72 static int auto_save_mode_bits;
74 /* Alist of elements (REGEXP . HANDLER) for file names
75 whose I/O is done with a special handler. */
76 Lisp_Object Vfile_name_handler_alist;
78 /* Format for auto-save files */
79 Lisp_Object Vauto_save_file_format;
81 /* Lisp functions for translating file formats */
82 Lisp_Object Qformat_decode, Qformat_annotate_function;
84 /* Functions to be called to process text properties in inserted file. */
85 Lisp_Object Vafter_insert_file_functions;
87 /* Functions to be called to create text property annotations for file. */
88 Lisp_Object Vwrite_region_annotate_functions;
90 /* During build_annotations, each time an annotation function is called,
91 this holds the annotations made by the previous functions. */
92 Lisp_Object Vwrite_region_annotations_so_far;
94 /* File name in which we write a list of all our auto save files. */
95 Lisp_Object Vauto_save_list_file_name;
97 /* Prefix used to construct Vauto_save_list_file_name. */
98 Lisp_Object Vauto_save_list_file_prefix;
100 /* When non-nil, it prevents auto-save list file creation. */
101 int inhibit_auto_save_session;
103 int disable_auto_save_when_buffer_shrinks;
105 Lisp_Object Vdirectory_sep_char;
107 /* These variables describe handlers that have "already" had a chance
108 to handle the current operation.
110 Vinhibit_file_name_handlers is a list of file name handlers.
111 Vinhibit_file_name_operation is the operation being handled.
112 If we try to handle that operation, we ignore those handlers. */
114 static Lisp_Object Vinhibit_file_name_handlers;
115 static Lisp_Object Vinhibit_file_name_operation;
117 Lisp_Object Qfile_error, Qfile_already_exists;
119 Lisp_Object Qauto_save_hook;
120 Lisp_Object Qauto_save_error;
121 Lisp_Object Qauto_saving;
123 Lisp_Object Qcar_less_than_car;
125 Lisp_Object Qcompute_buffer_file_truename;
127 EXFUN (Frunning_temacs_p, 0);
129 /* signal a file error when errno contains a meaningful value. */
132 report_file_error (const char *string, Lisp_Object data)
134 /* #### dmoore - This uses current_buffer, better make sure no one
135 has GC'd the current buffer. File handlers are giving me a headache
136 maybe I'll just always protect current_buffer around all of those
139 signal_error (Qfile_error,
140 Fcons (build_translated_string (string),
141 Fcons (lisp_strerror (errno), data)));
145 maybe_report_file_error (const char *string, Lisp_Object data,
146 Lisp_Object class, Error_behavior errb)
149 if (ERRB_EQ (errb, ERROR_ME_NOT))
152 maybe_signal_error (Qfile_error,
153 Fcons (build_translated_string (string),
154 Fcons (lisp_strerror (errno), data)),
158 /* signal a file error when errno does not contain a meaningful value. */
161 signal_file_error (const char *string, Lisp_Object data)
163 signal_error (Qfile_error,
164 list2 (build_translated_string (string), data));
168 maybe_signal_file_error (const char *string, Lisp_Object data,
169 Lisp_Object class, Error_behavior errb)
172 if (ERRB_EQ (errb, ERROR_ME_NOT))
174 maybe_signal_error (Qfile_error,
175 list2 (build_translated_string (string), data),
180 signal_double_file_error (const char *string1, const char *string2,
183 signal_error (Qfile_error,
184 list3 (build_translated_string (string1),
185 build_translated_string (string2),
190 maybe_signal_double_file_error (const char *string1, const char *string2,
191 Lisp_Object data, Lisp_Object class,
195 if (ERRB_EQ (errb, ERROR_ME_NOT))
197 maybe_signal_error (Qfile_error,
198 list3 (build_translated_string (string1),
199 build_translated_string (string2),
205 signal_double_file_error_2 (const char *string1, const char *string2,
206 Lisp_Object data1, Lisp_Object data2)
208 signal_error (Qfile_error,
209 list4 (build_translated_string (string1),
210 build_translated_string (string2),
215 maybe_signal_double_file_error_2 (const char *string1, const char *string2,
216 Lisp_Object data1, Lisp_Object data2,
217 Lisp_Object class, Error_behavior errb)
220 if (ERRB_EQ (errb, ERROR_ME_NOT))
222 maybe_signal_error (Qfile_error,
223 list4 (build_translated_string (string1),
224 build_translated_string (string2),
230 /* Just like strerror(3), except return a lisp string instead of char *.
231 The string needs to be converted since it may be localized.
232 Perhaps this should use strerror-coding-system instead? */
234 lisp_strerror (int errnum)
236 return build_ext_string (strerror (errnum), Qnative);
240 close_file_unwind (Lisp_Object fd)
244 if (INTP (XCAR (fd)))
245 close (XINT (XCAR (fd)));
247 free_cons (XCONS (fd));
256 delete_stream_unwind (Lisp_Object stream)
258 Lstream_delete (XLSTREAM (stream));
262 /* Restore point, having saved it as a marker. */
265 restore_point_unwind (Lisp_Object point_marker)
267 BUF_SET_PT (current_buffer, marker_position (point_marker));
268 return Fset_marker (point_marker, Qnil, Qnil);
271 /* Versions of read() and write() that allow quitting out of the actual
272 I/O. We don't use immediate_quit (i.e. direct longjmp() out of the
273 signal handler) because that's way too losing.
275 (#### Actually, longjmp()ing out of the signal handler may not be
276 as losing as I thought. See sys_do_signal() in sysdep.c.) */
279 read_allowing_quit (int fildes, void *buf, size_t size)
282 return sys_read_1 (fildes, buf, size, 1);
286 write_allowing_quit (int fildes, const void *buf, size_t size)
289 return sys_write_1 (fildes, buf, size, 1);
293 Lisp_Object Qexpand_file_name;
294 Lisp_Object Qfile_truename;
295 Lisp_Object Qsubstitute_in_file_name;
296 Lisp_Object Qdirectory_file_name;
297 Lisp_Object Qfile_name_directory;
298 Lisp_Object Qfile_name_nondirectory;
299 Lisp_Object Qunhandled_file_name_directory;
300 Lisp_Object Qfile_name_as_directory;
301 Lisp_Object Qcopy_file;
302 Lisp_Object Qmake_directory_internal;
303 Lisp_Object Qdelete_directory;
304 Lisp_Object Qdelete_file;
305 Lisp_Object Qrename_file;
306 Lisp_Object Qadd_name_to_file;
307 Lisp_Object Qmake_symbolic_link;
308 Lisp_Object Qfile_exists_p;
309 Lisp_Object Qfile_executable_p;
310 Lisp_Object Qfile_readable_p;
311 Lisp_Object Qfile_symlink_p;
312 Lisp_Object Qfile_writable_p;
313 Lisp_Object Qfile_directory_p;
314 Lisp_Object Qfile_regular_p;
315 Lisp_Object Qfile_accessible_directory_p;
316 Lisp_Object Qfile_modes;
317 Lisp_Object Qset_file_modes;
318 Lisp_Object Qfile_newer_than_file_p;
319 Lisp_Object Qinsert_file_contents;
320 Lisp_Object Qwrite_region;
321 Lisp_Object Qverify_visited_file_modtime;
322 Lisp_Object Qset_visited_file_modtime;
324 /* If FILENAME is handled specially on account of its syntax,
325 return its handler function. Otherwise, return nil. */
327 DEFUN ("find-file-name-handler", Ffind_file_name_handler, 1, 2, 0, /*
328 Return FILENAME's handler function for OPERATION, if it has one.
329 Otherwise, return nil.
330 A file name is handled if one of the regular expressions in
331 `file-name-handler-alist' matches it.
333 If OPERATION equals `inhibit-file-name-operation', then we ignore
334 any handlers that are members of `inhibit-file-name-handlers',
335 but we still do run any other handlers. This lets handlers
336 use the standard functions without calling themselves recursively.
338 (filename, operation))
340 /* This function does not GC */
341 /* This function can be called during GC */
342 /* This function must not munge the match data. */
343 Lisp_Object chain, inhibited_handlers;
345 CHECK_STRING (filename);
347 if (EQ (operation, Vinhibit_file_name_operation))
348 inhibited_handlers = Vinhibit_file_name_handlers;
350 inhibited_handlers = Qnil;
352 EXTERNAL_LIST_LOOP (chain, Vfile_name_handler_alist)
354 Lisp_Object elt = XCAR (chain);
357 Lisp_Object string = XCAR (elt);
359 && (fast_lisp_string_match (string, filename) >= 0))
361 Lisp_Object handler = XCDR (elt);
362 if (NILP (Fmemq (handler, inhibited_handlers)))
372 call2_check_string (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
374 /* This function can call lisp */
375 Lisp_Object result = call2 (fn, arg0, arg1);
376 CHECK_STRING (result);
381 call2_check_string_or_nil (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
383 /* This function can call lisp */
384 Lisp_Object result = call2 (fn, arg0, arg1);
386 CHECK_STRING (result);
391 call3_check_string (Lisp_Object fn, Lisp_Object arg0,
392 Lisp_Object arg1, Lisp_Object arg2)
394 /* This function can call lisp */
395 Lisp_Object result = call3 (fn, arg0, arg1, arg2);
396 CHECK_STRING (result);
401 DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /*
402 Return the directory component in file name FILENAME.
403 Return nil if FILENAME does not include a directory.
404 Otherwise return a directory spec.
405 Given a Unix syntax file name, returns a string ending in slash.
409 /* This function can GC. GC checked 2000-07-28 ben */
414 CHECK_STRING (filename);
416 /* If the file name has special constructs in it,
417 call the corresponding file handler. */
418 handler = Ffind_file_name_handler (filename, Qfile_name_directory);
420 return call2_check_string_or_nil (handler, Qfile_name_directory, filename);
422 #ifdef FILE_SYSTEM_CASE
423 filename = FILE_SYSTEM_CASE (filename);
425 beg = XSTRING_DATA (filename);
426 p = beg + XSTRING_LENGTH (filename);
428 while (p != beg && !IS_ANY_SEP (p[-1])
430 /* only recognize drive specifier at beginning */
431 && !(p[-1] == ':' && p == beg + 2)
438 /* Expansion of "c:" to drive and default directory. */
439 /* (NT does the right thing.) */
440 if (p == beg + 2 && beg[1] == ':')
442 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
443 Bufbyte *res = (Bufbyte*) alloca (MAXPATHLEN + 1);
444 if (_getdcwd (toupper (*beg) - 'A' + 1, (char *)res, MAXPATHLEN))
446 char *c=((char *) res) + strlen ((char *) res);
447 if (!IS_DIRECTORY_SEP (*c))
449 *c++ = DIRECTORY_SEP;
453 p = beg + strlen ((char *) beg);
456 #endif /* WIN32_NATIVE */
457 return make_string (beg, p - beg);
460 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /*
461 Return file name FILENAME sans its directory.
462 For example, in a Unix-syntax file name,
463 this is everything after the last slash,
464 or the entire name if it contains no slash.
468 /* This function can GC. GC checked 2000-07-28 ben */
469 Bufbyte *beg, *p, *end;
472 CHECK_STRING (filename);
474 /* If the file name has special constructs in it,
475 call the corresponding file handler. */
476 handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
478 return call2_check_string (handler, Qfile_name_nondirectory, filename);
480 beg = XSTRING_DATA (filename);
481 end = p = beg + XSTRING_LENGTH (filename);
483 while (p != beg && !IS_ANY_SEP (p[-1])
485 /* only recognize drive specifier at beginning */
486 && !(p[-1] == ':' && p == beg + 2)
490 return make_string (p, end - p);
493 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /*
494 Return a directly usable directory name somehow associated with FILENAME.
495 A `directly usable' directory name is one that may be used without the
496 intervention of any file handler.
497 If FILENAME is a directly usable file itself, return
498 \(file-name-directory FILENAME).
499 The `call-process' and `start-process' functions use this function to
500 get a current directory to run processes in.
504 /* This function can GC. GC checked 2000-07-28 ben */
507 /* If the file name has special constructs in it,
508 call the corresponding file handler. */
509 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
511 return call2 (handler, Qunhandled_file_name_directory,
514 return Ffile_name_directory (filename);
519 file_name_as_directory (char *out, char *in)
521 /* This function cannot GC */
522 int size = strlen (in);
527 out[1] = DIRECTORY_SEP;
533 /* Append a slash if necessary */
534 if (!IS_ANY_SEP (out[size-1]))
536 out[size] = DIRECTORY_SEP;
537 out[size + 1] = '\0';
543 DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /*
544 Return a string representing file FILENAME interpreted as a directory.
545 This operation exists because a directory is also a file, but its name as
546 a directory is different from its name as a file.
547 The result can be used as the value of `default-directory'
548 or passed as second argument to `expand-file-name'.
549 For a Unix-syntax file name, just appends a slash,
550 except for (file-name-as-directory \"\") => \"./\".
554 /* This function can GC. GC checked 2000-07-28 ben */
558 CHECK_STRING (filename);
560 /* If the file name has special constructs in it,
561 call the corresponding file handler. */
562 handler = Ffind_file_name_handler (filename, Qfile_name_as_directory);
564 return call2_check_string (handler, Qfile_name_as_directory, filename);
566 buf = (char *) alloca (XSTRING_LENGTH (filename) + 10);
567 return build_string (file_name_as_directory
568 (buf, (char *) XSTRING_DATA (filename)));
572 * Convert from directory name to filename.
573 * On UNIX, it's simple: just make sure there isn't a terminating /
575 * Value is nonzero if the string output is different from the input.
579 directory_file_name (const char *src, char *dst)
581 /* This function cannot GC */
582 long slen = strlen (src);
583 /* Process as Unix format: just remove any final slash.
584 But leave "/" unchanged; do not change it to "". */
587 && IS_DIRECTORY_SEP (dst[slen - 1])
589 && !IS_ANY_SEP (dst[slen - 2])
590 #endif /* WIN32_NATIVE */
596 DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
597 Return the file name of the directory named DIRECTORY.
598 This is the name of the file that holds the data for the directory.
599 This operation exists because a directory is also a file, but its name as
600 a directory is different from its name as a file.
601 In Unix-syntax, this function just removes the final slash.
605 /* This function can GC. GC checked 2000-07-28 ben */
609 CHECK_STRING (directory);
611 #if 0 /* #### WTF? */
612 if (NILP (directory))
616 /* If the file name has special constructs in it,
617 call the corresponding file handler. */
618 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
620 return call2_check_string (handler, Qdirectory_file_name, directory);
621 buf = (char *) alloca (XSTRING_LENGTH (directory) + 20);
622 directory_file_name ((char *) XSTRING_DATA (directory), buf);
623 return build_string (buf);
626 /* Fmake_temp_name used to be a simple wrapper around mktemp(), but it
627 proved too broken for our purposes (it supported only 26 or 62
628 unique names under some implementations). For example, this
629 arbitrary limit broke generation of Gnus Incoming* files.
631 This implementation is better than what one usually finds in libc.
634 static unsigned int temp_name_rand;
636 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
637 Generate a temporary file name starting with PREFIX.
638 The Emacs process number forms part of the result, so there is no
639 danger of generating a name being used by another process.
641 In addition, this function makes an attempt to choose a name that
642 does not specify an existing file. To make this work, PREFIX should
643 be an absolute file name.
647 static const char tbl[64] =
649 'A','B','C','D','E','F','G','H',
650 'I','J','K','L','M','N','O','P',
651 'Q','R','S','T','U','V','W','X',
652 'Y','Z','a','b','c','d','e','f',
653 'g','h','i','j','k','l','m','n',
654 'o','p','q','r','s','t','u','v',
655 'w','x','y','z','0','1','2','3',
656 '4','5','6','7','8','9','-','_'
663 CHECK_STRING (prefix);
665 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's
668 1) It might change the prefix, so the resulting string might not
669 begin with PREFIX. This violates the principle of least
672 2) It breaks under many unforeseeable circumstances, such as with
673 the code that uses (make-temp-name "") instead of
674 (make-temp-name "./").
676 3) It might yield unexpected (to stat(2)) results in the presence
677 of EFS and file name handlers. */
679 len = XSTRING_LENGTH (prefix);
680 val = make_uninit_string (len + 6);
681 data = XSTRING_DATA (val);
682 memcpy (data, XSTRING_DATA (prefix), len);
685 /* VAL is created by adding 6 characters to PREFIX. The first three
686 are the PID of this process, in base 64, and the second three are
687 a pseudo-random number seeded from process startup time. This
688 ensures 262144 unique file names per PID per PREFIX per machine. */
691 unsigned int pid = (unsigned int) getpid ();
692 *p++ = tbl[(pid >> 0) & 63];
693 *p++ = tbl[(pid >> 6) & 63];
694 *p++ = tbl[(pid >> 12) & 63];
697 /* Here we try to minimize useless stat'ing when this function is
698 invoked many times successively with the same PREFIX. We achieve
699 this by using a very pseudo-random number generator to generate
700 file names unique to this process, with a very long cycle. */
706 p[0] = tbl[(temp_name_rand >> 0) & 63];
707 p[1] = tbl[(temp_name_rand >> 6) & 63];
708 p[2] = tbl[(temp_name_rand >> 12) & 63];
710 /* Poor man's congruential RN generator. Replace with ++count
712 temp_name_rand += 25229;
713 temp_name_rand %= 225307;
717 if (xemacs_stat ((const char *) data, &ignored) < 0)
719 /* We want to return only if errno is ENOENT. */
723 /* The error here is dubious, but there is little else we
724 can do. The alternatives are to return nil, which is
725 as bad as (and in many cases worse than) throwing the
726 error, or to ignore the error, which will likely result
728 report_file_error ("Cannot create temporary name for prefix",
730 return Qnil; /* not reached */
736 DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /*
737 Convert filename NAME to absolute, and canonicalize it.
738 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
739 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
740 the current buffer's value of `default-directory' is used.
741 File name components that are `.' are removed, and
742 so are file name components followed by `..', along with the `..' itself;
743 note that these simplifications are done without checking the resulting
744 file names in the file system.
745 An initial `~/' expands to your home directory.
746 An initial `~USER/' expands to USER's home directory.
747 See also the function `substitute-in-file-name'.
749 (name, default_directory))
751 /* This function can GC. GC-checked 2000-07-11 ben */
754 Bufbyte *newdir, *p, *o;
759 int collapse_newdir = 1;
762 #endif /* WIN32_NATIVE */
768 struct gcpro gcpro1, gcpro2;
770 /* both of these get set below */
771 GCPRO2 (name, default_directory);
775 /* If the file name has special constructs in it,
776 call the corresponding file handler. */
777 handler = Ffind_file_name_handler (name, Qexpand_file_name);
781 return call3_check_string (handler, Qexpand_file_name, name,
785 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
786 if (NILP (default_directory))
787 default_directory = current_buffer->directory;
788 if (! STRINGP (default_directory))
789 default_directory = build_string ("/");
791 if (!NILP (default_directory))
793 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
797 return call3 (handler, Qexpand_file_name, name, default_directory);
801 o = XSTRING_DATA (default_directory);
803 /* Make sure DEFAULT_DIRECTORY is properly expanded.
804 It would be better to do this down below where we actually use
805 default_directory. Unfortunately, calling Fexpand_file_name recursively
806 could invoke GC, and the strings might be relocated. This would
807 be annoying because we have pointers into strings lying around
808 that would need adjusting, and people would add new pointers to
809 the code and forget to adjust them, resulting in intermittent bugs.
810 Putting this call here avoids all that crud.
812 The EQ test avoids infinite recursion. */
813 if (! NILP (default_directory) && !EQ (default_directory, name)
814 /* Save time in some common cases - as long as default_directory
815 is not relative, it can be canonicalized with name below (if it
816 is needed at all) without requiring it to be expanded now. */
818 /* Detect Windows file names with drive specifiers. */
819 && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2])))
820 /* Detect Windows file names in UNC format. */
821 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
823 #else /* not WIN32_NATIVE */
825 /* Detect Unix absolute file names (/... alone is not absolute on
827 && ! (IS_DIRECTORY_SEP (o[0]))
828 #endif /* not WIN32_NATIVE */
831 default_directory = Fexpand_file_name (default_directory, Qnil);
833 #ifdef FILE_SYSTEM_CASE
834 name = FILE_SYSTEM_CASE (name);
837 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing
838 into name should be safe during all of this, though. */
839 nm = XSTRING_DATA (name);
842 /* We will force directory separators to be either all \ or /, so make
843 a local copy to modify, even if there ends up being no change. */
844 nm = strcpy ((char *)alloca (strlen ((char *)nm) + 1), (char *)nm);
846 /* Find and remove drive specifier if present; this makes nm absolute
847 even if the rest of the name appears to be relative. */
849 Bufbyte *colon = (Bufbyte *) strrchr ((char *)nm, ':');
852 /* Only recognize colon as part of drive specifier if there is a
853 single alphabetic character preceding the colon (and if the
854 character before the drive letter, if present, is a directory
855 separator); this is to support the remote system syntax used by
856 ange-ftp, and the "po:username" syntax for POP mailboxes. */
860 else if (IS_DRIVE (colon[-1])
861 && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2])))
868 while (--colon >= nm)
874 /* If we see "c://somedir", we want to strip the first slash after the
875 colon when stripping the drive letter. Otherwise, this expands to
877 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
879 #endif /* WIN32_NATIVE */
881 /* If nm is absolute, look for /./ or /../ sequences; if none are
882 found, we can probably return right away. We will avoid allocating
883 a new string if name is already fully expanded. */
885 IS_DIRECTORY_SEP (nm[0])
887 && (drive || IS_DIRECTORY_SEP (nm[1]))
891 /* If it turns out that the filename we want to return is just a
892 suffix of FILENAME, we don't need to go through and edit
893 things; we just need to construct a new string using data
894 starting at the middle of FILENAME. If we set lose to a
895 non-zero value, that means we've discovered that we can't do
902 /* Since we know the name is absolute, we can assume that each
903 element starts with a "/". */
905 /* "." and ".." are hairy. */
906 if (IS_DIRECTORY_SEP (p[0])
908 && (IS_DIRECTORY_SEP (p[2])
910 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
918 /* Make sure directories are all separated with / or \ as
919 desired, but avoid allocation of a new string when not
921 CORRECT_DIR_SEPS (nm);
922 if (IS_DIRECTORY_SEP (nm[1]))
924 if (strcmp (nm, XSTRING_DATA (name)) != 0)
925 name = build_string (nm);
927 /* drive must be set, so this is okay */
928 else if (strcmp (nm - 2, XSTRING_DATA (name)) != 0)
930 name = make_string (nm - 2, p - nm + 2);
931 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
932 XSTRING_DATA (name)[1] = ':';
934 RETURN_UNGCPRO (name);
935 #else /* not WIN32_NATIVE */
936 if (nm == XSTRING_DATA (name))
937 RETURN_UNGCPRO (name);
938 RETURN_UNGCPRO (build_string ((char *) nm));
939 #endif /* not WIN32_NATIVE */
943 /* At this point, nm might or might not be an absolute file name. We
944 need to expand ~ or ~user if present, otherwise prefix nm with
945 default_directory if nm is not absolute, and finally collapse /./
946 and /foo/../ sequences.
948 We set newdir to be the appropriate prefix if one is needed:
949 - the relevant user directory if nm starts with ~ or ~user
950 - the specified drive's working dir (DOS/NT only) if nm does not
952 - the value of default_directory.
954 Note that these prefixes are not guaranteed to be absolute (except
955 for the working dir of a drive). Therefore, to ensure we always
956 return an absolute name, if the final prefix is not absolute we
957 append it to the current working directory. */
961 if (nm[0] == '~') /* prefix ~ */
963 if (IS_DIRECTORY_SEP (nm[1])
964 || nm[1] == 0) /* ~ by itself */
966 Extbyte *newdir_external = get_home_directory ();
968 if (newdir_external == NULL)
969 newdir = (Bufbyte *) "";
971 TO_INTERNAL_FORMAT (C_STRING, newdir_external,
972 C_STRING_ALLOCA, (* ((char **) &newdir)),
980 else /* ~user/filename */
982 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++)
984 o = (Bufbyte *) alloca (p - nm + 1);
985 memcpy (o, (char *) nm, p - nm);
988 /* #### marcpa's syncing note: FSF uses getpwnam even on NT,
989 which does not work. The following works only if ~USER
990 names the user who runs this instance of XEmacs. While
991 NT is single-user (for the moment) you still can have
992 multiple user profiles users defined, each with its HOME.
993 Therefore, the following should be reworked to handle
996 /* Now if the file given is "~foo/file" and HOME="c:/", then
997 we want the file to be named "c:/file" ("~foo" becomes
998 "c:/"). The variable o has "~foo", so we can use the
999 length of that string to offset nm. August Hill, 31 Aug
1001 newdir = (Bufbyte *) get_home_directory();
1002 dostounix_filename (newdir);
1003 nm += strlen(o) + 1;
1004 #else /* not WIN32_NATIVE */
1006 if ((user = user_login_name (NULL)) != NULL)
1008 /* Does the user login name match the ~name? */
1009 if (strcmp (user, (char *) o + 1) == 0)
1011 newdir = (Bufbyte *) get_home_directory();
1018 /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM
1019 occurring in it. (It can call select()). */
1020 slow_down_interrupts ();
1021 pw = (struct passwd *) getpwnam ((char *) o + 1);
1022 speed_up_interrupts ();
1025 newdir = (Bufbyte *) pw -> pw_dir;
1031 #endif /* not WIN32_NATIVE */
1033 /* If we don't find a user of that name, leave the name
1034 unchanged; don't move nm forward to p. */
1039 /* On DOS and Windows, nm is absolute if a drive name was specified;
1040 use the drive's current directory as the prefix if needed. */
1041 if (!newdir && drive)
1043 /* Get default directory if needed to make nm absolute. */
1044 if (!IS_DIRECTORY_SEP (nm[0]))
1046 newdir = alloca (MAXPATHLEN + 1);
1047 if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN))
1052 /* Either nm starts with /, or drive isn't mounted. */
1053 newdir = alloca (4);
1054 newdir[0] = DRIVE_LETTER (drive);
1060 #endif /* WIN32_NATIVE */
1062 /* Finally, if no prefix has been specified and nm is not absolute,
1063 then it must be expanded relative to default_directory. */
1066 #ifndef WIN32_NATIVE
1067 /* /... alone is not absolute on DOS and Windows. */
1068 && !IS_DIRECTORY_SEP (nm[0])
1070 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
1074 newdir = XSTRING_DATA (default_directory);
1080 /* First ensure newdir is an absolute name. */
1082 /* Detect Windows file names with drive specifiers. */
1083 ! (IS_DRIVE (newdir[0])
1084 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
1085 /* Detect Windows file names in UNC format. */
1086 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1087 /* Detect drive spec by itself */
1088 && ! (IS_DEVICE_SEP (newdir[1]) && newdir[2] == 0)
1091 /* Effectively, let newdir be (expand-file-name newdir cwd).
1092 Because of the admonition against calling expand-file-name
1093 when we have pointers into lisp strings, we accomplish this
1094 indirectly by prepending newdir to nm if necessary, and using
1095 cwd (or the wd of newdir's drive) as the new newdir. */
1097 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1102 if (!IS_DIRECTORY_SEP (nm[0]))
1104 char * tmp = alloca (strlen (newdir) + strlen (nm) + 2);
1105 file_name_as_directory (tmp, newdir);
1109 newdir = alloca (MAXPATHLEN + 1);
1112 if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN))
1119 /* Strip off drive name from prefix, if present. */
1120 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1126 /* Keep only a prefix from newdir if nm starts with slash
1127 (/ /server/share for UNC, nothing otherwise). */
1128 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
1130 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1132 newdir = strcpy (alloca (strlen (newdir) + 1), newdir);
1134 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1136 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1143 #endif /* WIN32_NATIVE */
1147 /* Get rid of any slash at the end of newdir, unless newdir is
1148 just // (an incomplete UNC name). */
1149 length = strlen ((char *) newdir);
1150 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
1152 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
1156 Bufbyte *temp = (Bufbyte *) alloca (length);
1157 memcpy (temp, newdir, length - 1);
1158 temp[length - 1] = 0;
1166 /* Now concatenate the directory and name to new space in the stack frame */
1167 tlen += strlen ((char *) nm) + 1;
1169 /* Add reserved space for drive name. (The Microsoft x86 compiler
1170 produces incorrect code if the following two lines are combined.) */
1171 target = (Bufbyte *) alloca (tlen + 2);
1173 #else /* not WIN32_NATIVE */
1174 target = (Bufbyte *) alloca (tlen);
1175 #endif /* not WIN32_NATIVE */
1180 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
1181 strcpy ((char *) target, (char *) newdir);
1183 file_name_as_directory ((char *) target, (char *) newdir);
1186 strcat ((char *) target, (char *) nm);
1188 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1190 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1197 if (!IS_DIRECTORY_SEP (*p))
1201 else if (IS_DIRECTORY_SEP (p[0])
1203 && (IS_DIRECTORY_SEP (p[2])
1206 /* If "/." is the entire filename, keep the "/". Otherwise,
1207 just delete the whole "/.". */
1208 if (o == target && p[2] == '\0')
1212 else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
1213 /* `/../' is the "superroot" on certain file systems. */
1215 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
1217 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
1219 /* Keep initial / only if this is the whole name. */
1220 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
1225 /* if drive is set, we're not dealing with an UNC, so
1226 multiple dir-seps are redundant (and reportedly cause trouble
1228 else if (drive && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
1238 /* At last, set drive name, except for network file name. */
1242 target[0] = DRIVE_LETTER (drive);
1247 assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]));
1249 CORRECT_DIR_SEPS (target);
1250 #endif /* WIN32_NATIVE */
1252 RETURN_UNGCPRO (make_string (target, o - target));
1255 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /*
1256 Return the canonical name of FILENAME.
1257 Second arg DEFAULT is directory to start with if FILENAME is relative
1258 (does not start with slash); if DEFAULT is nil or missing,
1259 the current buffer's value of `default-directory' is used.
1260 No component of the resulting pathname will be a symbolic link, as
1261 in the realpath() function.
1263 (filename, default_))
1265 /* This function can GC. GC checked 2000-07-28 ben. */
1266 Lisp_Object expanded_name;
1267 struct gcpro gcpro1;
1269 CHECK_STRING (filename);
1271 expanded_name = Fexpand_file_name (filename, default_);
1273 if (!STRINGP (expanded_name))
1276 GCPRO1 (expanded_name);
1279 Lisp_Object handler =
1280 Ffind_file_name_handler (expanded_name, Qfile_truename);
1282 if (!NILP (handler))
1284 (call2_check_string (handler, Qfile_truename, expanded_name));
1288 char resolved_path[MAXPATHLEN];
1293 TO_EXTERNAL_FORMAT (LISP_STRING, expanded_name,
1294 ALLOCA, (path, elen),
1297 if (elen > MAXPATHLEN)
1300 /* Try doing it all at once. */
1301 /* !! Does realpath() Mule-encapsulate?
1302 Answer: Nope! So we do it above */
1303 if (!xrealpath ((char *) path, resolved_path))
1305 /* Didn't resolve it -- have to do it one component at a time. */
1306 /* "realpath" is a typically useless, stupid un*x piece of crap.
1307 It claims to return a useful value in the "error" case, but since
1308 there is no indication provided of how far along the pathname
1309 the function went before erring, there is no way to use the
1310 partial result returned. What a piece of junk.
1312 The above comment refers to historical versions of
1313 realpath(). The Unix98 specs state:
1315 "On successful completion, realpath() returns a
1316 pointer to the resolved name. Otherwise, realpath()
1317 returns a null pointer and sets errno to indicate the
1318 error, and the contents of the buffer pointed to by
1319 resolved_name are undefined."
1321 Since we depend on undocumented semantics of various system realpath()s,
1322 we just use our own version in realpath.c. */
1325 p = (Extbyte *) memchr (p + 1, '/', elen - (p + 1 - path));
1329 if (xrealpath ((char *) 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." */
1349 int plen = elen - (p - path);
1351 if (rlen > 1 && resolved_path[rlen - 1] == '/')
1354 if (plen + rlen + 1 > countof (resolved_path))
1357 resolved_path[rlen] = '/';
1358 memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1);
1368 Lisp_Object resolved_name;
1369 int rlen = strlen (resolved_path);
1370 if (elen > 0 && XSTRING_BYTE (expanded_name, elen - 1) == '/'
1371 && !(rlen > 0 && resolved_path[rlen - 1] == '/'))
1373 if (rlen + 1 > countof (resolved_path))
1375 resolved_path[rlen++] = '/';
1376 resolved_path[rlen] = '\0';
1378 TO_INTERNAL_FORMAT (DATA, (resolved_path, rlen),
1379 LISP_STRING, resolved_name,
1381 RETURN_UNGCPRO (resolved_name);
1385 errno = ENAMETOOLONG;
1388 report_file_error ("Finding truename", list1 (expanded_name));
1390 RETURN_UNGCPRO (Qnil);
1394 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
1395 Substitute environment variables referred to in FILENAME.
1396 `$FOO' where FOO is an environment variable name means to substitute
1397 the value of that variable. The variable name should be terminated
1398 with a character, not a letter, digit or underscore; otherwise, enclose
1399 the entire variable name in braces.
1400 If `/~' appears, all of FILENAME through that `/' is discarded.
1404 /* This function can GC. GC checked 2000-07-28 ben. */
1407 Bufbyte *s, *p, *o, *x, *endp;
1408 Bufbyte *target = 0;
1410 int substituted = 0;
1412 Lisp_Object handler;
1414 CHECK_STRING (filename);
1416 /* If the file name has special constructs in it,
1417 call the corresponding file handler. */
1418 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
1419 if (!NILP (handler))
1420 return call2_check_string_or_nil (handler, Qsubstitute_in_file_name,
1423 nm = XSTRING_DATA (filename);
1424 endp = nm + XSTRING_LENGTH (filename);
1426 /* If /~ or // appears, discard everything through first slash. */
1428 for (p = nm; p != endp; p++)
1431 #if defined (WIN32_NATIVE) || defined (CYGWIN)
1432 /* // at start of file name is meaningful in WindowsNT systems */
1433 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
1434 #else /* not (WIN32_NATIVE || CYGWIN) */
1435 || IS_DIRECTORY_SEP (p[0])
1436 #endif /* not (WIN32_NATIVE || CYGWIN) */
1439 && (IS_DIRECTORY_SEP (p[-1])))
1445 /* see comment in expand-file-name about drive specifiers */
1446 else if (IS_DRIVE (p[0]) && p[1] == ':'
1447 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1452 #endif /* WIN32_NATIVE */
1455 /* See if any variables are substituted into the string
1456 and find the total length of their values in `total' */
1458 for (p = nm; p != endp;)
1468 /* "$$" means a single "$" */
1477 while (p != endp && *p != '}') p++;
1478 if (*p != '}') goto missingclose;
1484 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1488 /* Copy out the variable name */
1489 target = (Bufbyte *) alloca (s - o + 1);
1490 strncpy ((char *) target, (char *) o, s - o);
1493 strupr (target); /* $home == $HOME etc. */
1494 #endif /* WIN32_NATIVE */
1496 /* Get variable value */
1497 o = (Bufbyte *) egetenv ((char *) target);
1498 if (!o) goto badvar;
1499 total += strlen ((char *) o);
1506 /* If substitution required, recopy the filename and do it */
1507 /* Make space in stack frame for the new copy */
1508 xnm = (Bufbyte *) alloca (XSTRING_LENGTH (filename) + total + 1);
1511 /* Copy the rest of the name through, replacing $ constructs with values */
1528 while (p != endp && *p != '}') p++;
1529 if (*p != '}') goto missingclose;
1535 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1539 /* Copy out the variable name */
1540 target = (Bufbyte *) alloca (s - o + 1);
1541 strncpy ((char *) target, (char *) o, s - o);
1544 strupr (target); /* $home == $HOME etc. */
1545 #endif /* WIN32_NATIVE */
1547 /* Get variable value */
1548 o = (Bufbyte *) egetenv ((char *) target);
1552 strcpy ((char *) x, (char *) o);
1553 x += strlen ((char *) o);
1558 /* If /~ or // appears, discard everything through first slash. */
1560 for (p = xnm; p != x; p++)
1562 #if defined (WIN32_NATIVE)
1563 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
1564 #else /* not WIN32_NATIVE */
1565 || IS_DIRECTORY_SEP (p[0])
1566 #endif /* not WIN32_NATIVE */
1568 /* don't do p[-1] if that would go off the beginning --jwz */
1569 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1]))
1572 else if (IS_DRIVE (p[0]) && p[1] == ':'
1573 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1577 return make_string (xnm, x - xnm);
1580 syntax_error ("Bad format environment-variable substitution", filename);
1582 syntax_error ("Missing \"}\" in environment-variable substitution",
1585 syntax_error_2 ("Substituting nonexistent environment variable",
1586 filename, build_string ((char *) target));
1589 return Qnil; /* suppress compiler warning */
1592 /* A slightly faster and more convenient way to get
1593 (directory-file-name (expand-file-name FOO)). */
1596 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
1598 /* This function can call Lisp. GC checked 2000-07-28 ben */
1599 Lisp_Object abspath;
1600 struct gcpro gcpro1;
1602 abspath = Fexpand_file_name (filename, defdir);
1604 /* Remove final slash, if any (unless path is root).
1605 stat behaves differently depending! */
1606 if (XSTRING_LENGTH (abspath) > 1
1607 && IS_DIRECTORY_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1))
1608 && !IS_DEVICE_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 2)))
1609 /* We cannot take shortcuts; they might be wrong for magic file names. */
1610 abspath = Fdirectory_file_name (abspath);
1615 /* Signal an error if the file ABSNAME already exists.
1616 If INTERACTIVE is nonzero, ask the user whether to proceed,
1617 and bypass the error if the user says to go ahead.
1618 QUERYSTRING is a name for the action that is being considered
1620 *STATPTR is used to store the stat information if the file exists.
1621 If the file does not exist, STATPTR->st_mode is set to 0. */
1624 barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring,
1625 int interactive, struct stat *statptr)
1627 /* This function can call Lisp. GC checked 2000-07-28 ben */
1628 struct stat statbuf;
1630 /* stat is a good way to tell whether the file exists,
1631 regardless of what access permissions it has. */
1632 if (xemacs_stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0)
1639 struct gcpro gcpro1;
1641 prompt = emacs_doprnt_string_c
1642 ((const Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "),
1643 Qnil, -1, XSTRING_DATA (absname),
1644 GETTEXT (querystring));
1647 tem = call1 (Qyes_or_no_p, prompt);
1654 Fsignal (Qfile_already_exists,
1655 list2 (build_translated_string ("File already exists"),
1663 statptr->st_mode = 0;
1668 DEFUN ("copy-file", Fcopy_file, 2, 4,
1669 "fCopy file: \nFCopy %s to file: \np\nP", /*
1670 Copy FILENAME to NEWNAME. Both args must be strings.
1671 Signals a `file-already-exists' error if file NEWNAME already exists,
1672 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
1673 A number as third arg means request confirmation if NEWNAME already exists.
1674 This is what happens in interactive use with M-x.
1675 Fourth arg KEEP-TIME non-nil means give the new file the same
1676 last-modified time as the old one. (This works on only some systems.)
1677 A prefix arg makes KEEP-TIME non-nil.
1679 (filename, newname, ok_if_already_exists, keep_time))
1681 /* This function can call Lisp. GC checked 2000-07-28 ben */
1683 char buf[16 * 1024];
1684 struct stat st, out_st;
1685 Lisp_Object handler;
1686 int speccount = specpdl_depth ();
1687 struct gcpro gcpro1, gcpro2;
1688 /* Lisp_Object args[6]; */
1689 int input_file_statable_p;
1691 GCPRO2 (filename, newname);
1692 CHECK_STRING (filename);
1693 CHECK_STRING (newname);
1694 filename = Fexpand_file_name (filename, Qnil);
1695 newname = Fexpand_file_name (newname, Qnil);
1697 /* If the input file name has special constructs in it,
1698 call the corresponding file handler. */
1699 handler = Ffind_file_name_handler (filename, Qcopy_file);
1700 /* Likewise for output file name. */
1702 handler = Ffind_file_name_handler (newname, Qcopy_file);
1703 if (!NILP (handler))
1706 return call5 (handler, Qcopy_file, filename, newname,
1707 ok_if_already_exists, keep_time);
1710 /* When second argument is a directory, copy the file into it.
1711 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
1713 if (!NILP (Ffile_directory_p (newname)))
1715 Lisp_Object args[3];
1716 struct gcpro ngcpro1;
1720 args[1] = Qnil; args[2] = Qnil;
1723 if (!IS_DIRECTORY_SEP (XSTRING_BYTE (newname,
1724 XSTRING_LENGTH (newname) - 1)))
1726 args[i++] = Fchar_to_string (Vdirectory_sep_char);
1727 args[i++] = Ffile_name_nondirectory (filename);
1728 newname = Fconcat (i, args);
1732 if (NILP (ok_if_already_exists)
1733 || INTP (ok_if_already_exists))
1734 barf_or_query_if_file_exists (newname, "copy to it",
1735 INTP (ok_if_already_exists), &out_st);
1736 else if (xemacs_stat ((const char *) XSTRING_DATA (newname), &out_st) < 0)
1739 ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0);
1741 report_file_error ("Opening input file", list1 (filename));
1743 record_unwind_protect (close_file_unwind, make_int (ifd));
1745 /* We can only copy regular files and symbolic links. Other files are not
1747 input_file_statable_p = (fstat (ifd, &st) >= 0);
1749 #ifndef WIN32_NATIVE
1750 if (out_st.st_mode != 0
1751 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
1754 report_file_error ("Input and output files are the same",
1755 list2 (filename, newname));
1759 #if defined (S_ISREG) && defined (S_ISLNK)
1760 if (input_file_statable_p)
1762 if (!(S_ISREG (st.st_mode))
1763 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
1765 && !(S_ISCHR (st.st_mode))
1767 && !(S_ISLNK (st.st_mode)))
1769 #if defined (EISDIR)
1770 /* Get a better looking error message. */
1773 report_file_error ("Non-regular file", list1 (filename));
1776 #endif /* S_ISREG && S_ISLNK */
1778 ofd = open( (char *) XSTRING_DATA (newname),
1779 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
1781 report_file_error ("Opening output file", list1 (newname));
1784 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil);
1786 record_unwind_protect (close_file_unwind, ofd_locative);
1788 while ((n = read_allowing_quit (ifd, buf, sizeof (buf))) > 0)
1790 if (write_allowing_quit (ofd, buf, n) != n)
1791 report_file_error ("I/O error", list1 (newname));
1794 /* Closing the output clobbers the file times on some systems. */
1795 if (close (ofd) < 0)
1796 report_file_error ("I/O error", list1 (newname));
1798 if (input_file_statable_p)
1800 if (!NILP (keep_time))
1802 EMACS_TIME atime, mtime;
1803 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
1804 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
1805 if (set_file_times ((char *) XSTRING_DATA (newname), atime,
1807 report_file_error ("I/O error", list1 (newname));
1809 chmod ((const char *) XSTRING_DATA (newname),
1810 st.st_mode & 07777);
1813 /* We'll close it by hand */
1814 XCAR (ofd_locative) = Qnil;
1817 unbind_to (speccount, Qnil);
1824 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
1825 Create a directory. One argument, a file name string.
1829 /* This function can GC. GC checked 1997.04.06. */
1830 char dir [MAXPATHLEN];
1831 Lisp_Object handler;
1832 struct gcpro gcpro1;
1834 CHECK_STRING (dirname_);
1835 dirname_ = Fexpand_file_name (dirname_, Qnil);
1838 handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal);
1840 if (!NILP (handler))
1841 return (call2 (handler, Qmake_directory_internal, dirname_));
1843 if (XSTRING_LENGTH (dirname_) > (Bytecount) (sizeof (dir) - 1))
1845 return Fsignal (Qfile_error,
1846 list3 (build_translated_string ("Creating directory"),
1847 build_translated_string ("pathname too long"),
1850 strncpy (dir, (char *) XSTRING_DATA (dirname_),
1851 XSTRING_LENGTH (dirname_) + 1);
1853 if (dir [XSTRING_LENGTH (dirname_) - 1] == '/')
1854 dir [XSTRING_LENGTH (dirname_) - 1] = 0;
1856 if (mkdir (dir, 0777) != 0)
1857 report_file_error ("Creating directory", list1 (dirname_));
1862 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
1863 Delete a directory. One argument, a file name or directory name string.
1867 /* This function can GC. GC checked 1997.04.06. */
1868 Lisp_Object handler;
1869 struct gcpro gcpro1;
1871 CHECK_STRING (dirname_);
1874 dirname_ = Fexpand_file_name (dirname_, Qnil);
1875 dirname_ = Fdirectory_file_name (dirname_);
1877 handler = Ffind_file_name_handler (dirname_, Qdelete_directory);
1879 if (!NILP (handler))
1880 return (call2 (handler, Qdelete_directory, dirname_));
1882 if (rmdir ((char *) XSTRING_DATA (dirname_)) != 0)
1883 report_file_error ("Removing directory", list1 (dirname_));
1888 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
1889 Delete the file named FILENAME (a string).
1890 If FILENAME has multiple names, it continues to exist with the other names.
1894 /* This function can GC. GC checked 1997.04.06. */
1895 Lisp_Object handler;
1896 struct gcpro gcpro1;
1898 CHECK_STRING (filename);
1899 filename = Fexpand_file_name (filename, Qnil);
1902 handler = Ffind_file_name_handler (filename, Qdelete_file);
1904 if (!NILP (handler))
1905 return call2 (handler, Qdelete_file, filename);
1907 if (0 > unlink ((char *) XSTRING_DATA (filename)))
1908 report_file_error ("Removing old name", list1 (filename));
1913 internal_delete_file_1 (Lisp_Object ignore, Lisp_Object ignore2)
1918 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1921 internal_delete_file (Lisp_Object filename)
1923 /* This function can GC. GC checked 1997.04.06. */
1924 return NILP (condition_case_1 (Qt, Fdelete_file, filename,
1925 internal_delete_file_1, Qnil));
1928 DEFUN ("rename-file", Frename_file, 2, 3,
1929 "fRename file: \nFRename %s to file: \np", /*
1930 Rename FILENAME as NEWNAME. Both args must be strings.
1931 If file has names other than FILENAME, it continues to have those names.
1932 Signals a `file-already-exists' error if a file NEWNAME already exists
1933 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1934 A number as third arg means request confirmation if NEWNAME already exists.
1935 This is what happens in interactive use with M-x.
1937 (filename, newname, ok_if_already_exists))
1939 /* This function can GC. GC checked 1997.04.06. */
1940 Lisp_Object handler;
1941 struct gcpro gcpro1, gcpro2;
1943 GCPRO2 (filename, newname);
1944 CHECK_STRING (filename);
1945 CHECK_STRING (newname);
1946 filename = Fexpand_file_name (filename, Qnil);
1947 newname = Fexpand_file_name (newname, Qnil);
1949 /* If the file name has special constructs in it,
1950 call the corresponding file handler. */
1951 handler = Ffind_file_name_handler (filename, Qrename_file);
1953 handler = Ffind_file_name_handler (newname, Qrename_file);
1954 if (!NILP (handler))
1957 return call4 (handler, Qrename_file,
1958 filename, newname, ok_if_already_exists);
1961 /* When second argument is a directory, rename the file into it.
1962 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
1964 if (!NILP (Ffile_directory_p (newname)))
1966 Lisp_Object args[3];
1967 struct gcpro ngcpro1;
1971 args[1] = Qnil; args[2] = Qnil;
1974 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
1975 args[i++] = build_string ("/");
1976 args[i++] = Ffile_name_nondirectory (filename);
1977 newname = Fconcat (i, args);
1981 if (NILP (ok_if_already_exists)
1982 || INTP (ok_if_already_exists))
1983 barf_or_query_if_file_exists (newname, "rename to it",
1984 INTP (ok_if_already_exists), 0);
1986 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
1987 WIN32_NATIVE here; I've removed it. --marcpa */
1989 /* We have configure check for rename() and emulate using
1990 link()/unlink() if necessary. */
1991 if (0 > rename ((char *) XSTRING_DATA (filename),
1992 (char *) XSTRING_DATA (newname)))
1996 Fcopy_file (filename, newname,
1997 /* We have already prompted if it was an integer,
1998 so don't have copy-file prompt again. */
1999 (NILP (ok_if_already_exists) ? Qnil : Qt),
2001 Fdelete_file (filename);
2005 report_file_error ("Renaming", list2 (filename, newname));
2012 DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3,
2013 "fAdd name to file: \nFName to add to %s: \np", /*
2014 Give FILENAME additional name NEWNAME. Both args must be strings.
2015 Signals a `file-already-exists' error if a file NEWNAME already exists
2016 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2017 A number as third arg means request confirmation if NEWNAME already exists.
2018 This is what happens in interactive use with M-x.
2020 (filename, newname, ok_if_already_exists))
2022 /* This function can GC. GC checked 1997.04.06. */
2023 Lisp_Object handler;
2024 struct gcpro gcpro1, gcpro2;
2026 GCPRO2 (filename, newname);
2027 CHECK_STRING (filename);
2028 CHECK_STRING (newname);
2029 filename = Fexpand_file_name (filename, Qnil);
2030 newname = Fexpand_file_name (newname, Qnil);
2032 /* If the file name has special constructs in it,
2033 call the corresponding file handler. */
2034 handler = Ffind_file_name_handler (filename, Qadd_name_to_file);
2035 if (!NILP (handler))
2036 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2037 newname, ok_if_already_exists));
2039 /* If the new name has special constructs in it,
2040 call the corresponding file handler. */
2041 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2042 if (!NILP (handler))
2043 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2044 newname, ok_if_already_exists));
2046 if (NILP (ok_if_already_exists)
2047 || INTP (ok_if_already_exists))
2048 barf_or_query_if_file_exists (newname, "make it a new name",
2049 INTP (ok_if_already_exists), 0);
2050 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
2051 on NT here. --marcpa */
2052 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
2053 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
2054 Reverted to previous behavior pending a working fix. (jhar) */
2055 #if defined(WIN32_NATIVE)
2056 /* Windows does not support this operation. */
2057 report_file_error ("Adding new name", Flist (2, &filename));
2058 #else /* not defined(WIN32_NATIVE) */
2060 unlink ((char *) XSTRING_DATA (newname));
2061 if (0 > link ((char *) XSTRING_DATA (filename),
2062 (char *) XSTRING_DATA (newname)))
2064 report_file_error ("Adding new name",
2065 list2 (filename, newname));
2067 #endif /* defined(WIN32_NATIVE) */
2073 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3,
2074 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
2075 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2076 Signals a `file-already-exists' error if a file LINKNAME already exists
2077 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2078 A number as third arg means request confirmation if LINKNAME already exists.
2079 This happens for interactive use with M-x.
2081 (filename, linkname, ok_if_already_exists))
2083 /* This function can GC. GC checked 1997.06.04. */
2084 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2085 Lisp_Object handler;
2086 struct gcpro gcpro1, gcpro2;
2088 GCPRO2 (filename, linkname);
2089 CHECK_STRING (filename);
2090 CHECK_STRING (linkname);
2091 /* If the link target has a ~, we must expand it to get
2092 a truly valid file name. Otherwise, do not expand;
2093 we want to permit links to relative file names. */
2094 if (XSTRING_BYTE (filename, 0) == '~')
2095 filename = Fexpand_file_name (filename, Qnil);
2096 linkname = Fexpand_file_name (linkname, Qnil);
2098 /* If the file name has special constructs in it,
2099 call the corresponding file handler. */
2100 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
2101 if (!NILP (handler))
2102 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname,
2103 ok_if_already_exists));
2105 /* If the new link name has special constructs in it,
2106 call the corresponding file handler. */
2107 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2108 if (!NILP (handler))
2109 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2110 linkname, ok_if_already_exists));
2113 if (NILP (ok_if_already_exists)
2114 || INTP (ok_if_already_exists))
2115 barf_or_query_if_file_exists (linkname, "make it a link",
2116 INTP (ok_if_already_exists), 0);
2118 unlink ((char *) XSTRING_DATA (linkname));
2119 if (0 > symlink ((char *) XSTRING_DATA (filename),
2120 (char *) XSTRING_DATA (linkname)))
2122 report_file_error ("Making symbolic link",
2123 list2 (filename, linkname));
2125 #endif /* S_IFLNK */
2133 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
2134 Open a network connection to PATH using LOGIN as the login string.
2139 const char *path_ext;
2140 const char *login_ext;
2142 CHECK_STRING (path);
2143 CHECK_STRING (login);
2145 /* netunam, being a strange-o system call only used once, is not
2148 LISP_STRING_TO_EXTERNAL (path, path_ext, Qfile_name);
2149 LISP_STRING_TO_EXTERNAL (login, login_ext, Qnative);
2151 netresult = netunam (path_ext, login_ext);
2153 return netresult == -1 ? Qnil : Qt;
2155 #endif /* HPUX_NET */
2157 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
2158 Return t if file FILENAME specifies an absolute path name.
2159 On Unix, this is a name starting with a `/' or a `~'.
2163 /* This function does not GC */
2166 CHECK_STRING (filename);
2167 ptr = XSTRING_DATA (filename);
2168 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
2170 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
2175 /* Return nonzero if file FILENAME exists and can be executed. */
2178 check_executable (char *filename)
2182 if (xemacs_stat (filename, &st) < 0)
2184 return ((st.st_mode & S_IEXEC) != 0);
2185 #else /* not WIN32_NATIVE */
2187 return eaccess (filename, X_OK) >= 0;
2189 /* Access isn't quite right because it uses the real uid
2190 and we really want to test with the effective uid.
2191 But Unix doesn't give us a right way to do it. */
2192 return access (filename, X_OK) >= 0;
2193 #endif /* HAVE_EACCESS */
2194 #endif /* not WIN32_NATIVE */
2197 /* Return nonzero if file FILENAME exists and can be written. */
2200 check_writable (const char *filename)
2203 return (eaccess (filename, W_OK) >= 0);
2205 /* Access isn't quite right because it uses the real uid
2206 and we really want to test with the effective uid.
2207 But Unix doesn't give us a right way to do it.
2208 Opening with O_WRONLY could work for an ordinary file,
2209 but would lose for directories. */
2210 return (access (filename, W_OK) >= 0);
2214 DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
2215 Return t if file FILENAME exists. (This does not mean you can read it.)
2216 See also `file-readable-p' and `file-attributes'.
2220 /* This function can call lisp; GC checked 2000-07-11 ben */
2221 Lisp_Object abspath;
2222 Lisp_Object handler;
2223 struct stat statbuf;
2224 struct gcpro gcpro1;
2226 CHECK_STRING (filename);
2227 abspath = Fexpand_file_name (filename, Qnil);
2229 /* If the file name has special constructs in it,
2230 call the corresponding file handler. */
2232 handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
2234 if (!NILP (handler))
2235 return call2 (handler, Qfile_exists_p, abspath);
2237 return xemacs_stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
2240 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
2241 Return t if FILENAME can be executed by you.
2242 For a directory, this means you can access files in that directory.
2247 /* This function can GC. GC checked 07-11-2000 ben. */
2248 Lisp_Object abspath;
2249 Lisp_Object handler;
2250 struct gcpro gcpro1;
2252 CHECK_STRING (filename);
2253 abspath = Fexpand_file_name (filename, Qnil);
2255 /* If the file name has special constructs in it,
2256 call the corresponding file handler. */
2258 handler = Ffind_file_name_handler (abspath, Qfile_executable_p);
2260 if (!NILP (handler))
2261 return call2 (handler, Qfile_executable_p, abspath);
2263 return check_executable ((char *) XSTRING_DATA (abspath)) ? Qt : Qnil;
2266 DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
2267 Return t if file FILENAME exists and you can read it.
2268 See also `file-exists-p' and `file-attributes'.
2272 /* This function can GC */
2273 Lisp_Object abspath = Qnil;
2274 Lisp_Object handler;
2275 struct gcpro gcpro1;
2278 CHECK_STRING (filename);
2279 abspath = Fexpand_file_name (filename, Qnil);
2281 /* If the file name has special constructs in it,
2282 call the corresponding file handler. */
2283 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
2284 if (!NILP (handler))
2285 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
2287 #if defined(WIN32_NATIVE) || defined(CYGWIN)
2288 /* Under MS-DOS and Windows, open does not work for directories. */
2290 if (access (XSTRING_DATA (abspath), 0) == 0)
2294 #else /* not WIN32_NATIVE */
2296 int desc = interruptible_open ((char *) XSTRING_DATA (abspath), O_RDONLY | OPEN_BINARY, 0);
2303 #endif /* not WIN32_NATIVE */
2306 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2308 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
2309 Return t if file FILENAME can be written or created by you.
2313 /* This function can GC. GC checked 1997.04.10. */
2314 Lisp_Object abspath, dir;
2315 Lisp_Object handler;
2316 struct stat statbuf;
2317 struct gcpro gcpro1;
2319 CHECK_STRING (filename);
2320 abspath = Fexpand_file_name (filename, Qnil);
2322 /* If the file name has special constructs in it,
2323 call the corresponding file handler. */
2325 handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
2327 if (!NILP (handler))
2328 return call2 (handler, Qfile_writable_p, abspath);
2330 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0)
2331 return (check_writable ((char *) XSTRING_DATA (abspath))
2336 dir = Ffile_name_directory (abspath);
2338 return (check_writable (!NILP (dir) ? (char *) XSTRING_DATA (dir)
2343 DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
2344 Return non-nil if file FILENAME is the name of a symbolic link.
2345 The value is the name of the file to which it is linked.
2346 Otherwise returns nil.
2350 /* This function can GC. GC checked 1997.04.10. */
2351 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2358 Lisp_Object handler;
2359 struct gcpro gcpro1;
2361 CHECK_STRING (filename);
2362 filename = Fexpand_file_name (filename, Qnil);
2364 /* If the file name has special constructs in it,
2365 call the corresponding file handler. */
2367 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
2369 if (!NILP (handler))
2370 return call2 (handler, Qfile_symlink_p, filename);
2376 buf = xnew_array_and_zero (char, bufsize);
2377 valsize = readlink ((char *) XSTRING_DATA (filename),
2379 if (valsize < bufsize) break;
2380 /* Buffer was not long enough */
2389 val = make_string ((Bufbyte *) buf, valsize);
2392 #else /* not S_IFLNK */
2394 #endif /* not S_IFLNK */
2397 DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
2398 Return t if file FILENAME is the name of a directory as a file.
2399 A directory name spec may be given instead; then the value is t
2400 if the directory so specified exists and really is a directory.
2404 /* This function can GC. GC checked 1997.04.10. */
2405 Lisp_Object abspath;
2407 Lisp_Object handler;
2408 struct gcpro gcpro1;
2410 GCPRO1 (current_buffer->directory);
2411 abspath = expand_and_dir_to_file (filename,
2412 current_buffer->directory);
2415 /* If the file name has special constructs in it,
2416 call the corresponding file handler. */
2418 handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
2420 if (!NILP (handler))
2421 return call2 (handler, Qfile_directory_p, abspath);
2423 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2425 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2428 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
2429 Return t if file FILENAME is the name of a directory as a file,
2430 and files in that directory can be opened by you. In order to use a
2431 directory as a buffer's current directory, this predicate must return true.
2432 A directory name spec may be given instead; then the value is t
2433 if the directory so specified exists and really is a readable and
2434 searchable directory.
2438 /* This function can GC. GC checked 1997.04.10. */
2439 Lisp_Object handler;
2441 /* If the file name has special constructs in it,
2442 call the corresponding file handler. */
2443 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
2444 if (!NILP (handler))
2445 return call2 (handler, Qfile_accessible_directory_p,
2448 #if !defined(WIN32_NATIVE)
2449 if (NILP (Ffile_directory_p (filename)))
2452 return Ffile_executable_p (filename);
2456 struct gcpro gcpro1;
2457 /* It's an unlikely combination, but yes we really do need to gcpro:
2458 Suppose that file-accessible-directory-p has no handler, but
2459 file-directory-p does have a handler; this handler causes a GC which
2460 relocates the string in `filename'; and finally file-directory-p
2461 returns non-nil. Then we would end up passing a garbaged string
2462 to file-executable-p. */
2464 tem = (NILP (Ffile_directory_p (filename))
2465 || NILP (Ffile_executable_p (filename)));
2467 return tem ? Qnil : Qt;
2469 #endif /* !defined(WIN32_NATIVE) */
2472 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
2473 Return t if file FILENAME is the name of a regular file.
2474 This is the sort of file that holds an ordinary stream of data bytes.
2478 /* This function can GC. GC checked 1997.04.10. */
2479 Lisp_Object abspath;
2481 Lisp_Object handler;
2482 struct gcpro gcpro1;
2484 GCPRO1 (current_buffer->directory);
2485 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
2488 /* If the file name has special constructs in it,
2489 call the corresponding file handler. */
2491 handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
2493 if (!NILP (handler))
2494 return call2 (handler, Qfile_regular_p, abspath);
2496 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2498 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2501 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
2502 Return mode bits of file named FILENAME, as an integer.
2506 /* This function can GC. GC checked 1997.04.10. */
2507 Lisp_Object abspath;
2509 Lisp_Object handler;
2510 struct gcpro gcpro1;
2512 GCPRO1 (current_buffer->directory);
2513 abspath = expand_and_dir_to_file (filename,
2514 current_buffer->directory);
2517 /* If the file name has special constructs in it,
2518 call the corresponding file handler. */
2520 handler = Ffind_file_name_handler (abspath, Qfile_modes);
2522 if (!NILP (handler))
2523 return call2 (handler, Qfile_modes, abspath);
2525 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2527 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
2530 if (check_executable (XSTRING_DATA (abspath)))
2531 st.st_mode |= S_IEXEC;
2532 #endif /* WIN32_NATIVE */
2535 return make_int (st.st_mode & 07777);
2538 DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /*
2539 Set mode bits of file named FILENAME to MODE (an integer).
2540 Only the 12 low bits of MODE are used.
2544 /* This function can GC. GC checked 1997.04.10. */
2545 Lisp_Object abspath;
2546 Lisp_Object handler;
2547 struct gcpro gcpro1;
2549 GCPRO1 (current_buffer->directory);
2550 abspath = Fexpand_file_name (filename, current_buffer->directory);
2555 /* If the file name has special constructs in it,
2556 call the corresponding file handler. */
2558 handler = Ffind_file_name_handler (abspath, Qset_file_modes);
2560 if (!NILP (handler))
2561 return call3 (handler, Qset_file_modes, abspath, mode);
2563 if (chmod ((char *) XSTRING_DATA (abspath), XINT (mode)) < 0)
2564 report_file_error ("Doing chmod", list1 (abspath));
2569 DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
2570 Set the file permission bits for newly created files.
2571 The argument MODE should be an integer; if a bit in MODE is 1,
2572 subsequently created files will not have the permission corresponding
2573 to that bit enabled. Only the low 9 bits are used.
2574 This setting is inherited by subprocesses.
2580 umask ((~ XINT (mode)) & 0777);
2585 DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
2586 Return the default file protection for created files.
2587 The umask value determines which permissions are enabled in newly
2588 created files. If a permission's bit in the umask is 1, subsequently
2589 created files will not have that permission enabled.
2598 return make_int ((~ mode) & 0777);
2601 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /*
2602 Tell Unix to finish all pending disk updates.
2606 #ifndef WIN32_NATIVE
2613 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
2614 Return t if file FILE1 is newer than file FILE2.
2615 If FILE1 does not exist, the answer is nil;
2616 otherwise, if FILE2 does not exist, the answer is t.
2620 /* This function can GC. GC checked 1997.04.10. */
2621 Lisp_Object abspath1, abspath2;
2624 Lisp_Object handler;
2625 struct gcpro gcpro1, gcpro2, gcpro3;
2627 CHECK_STRING (file1);
2628 CHECK_STRING (file2);
2633 GCPRO3 (abspath1, abspath2, current_buffer->directory);
2634 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
2635 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
2637 /* If the file name has special constructs in it,
2638 call the corresponding file handler. */
2639 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p);
2641 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p);
2643 if (!NILP (handler))
2644 return call3 (handler, Qfile_newer_than_file_p, abspath1,
2647 if (xemacs_stat ((char *) XSTRING_DATA (abspath1), &st) < 0)
2650 mtime1 = st.st_mtime;
2652 if (xemacs_stat ((char *) XSTRING_DATA (abspath2), &st) < 0)
2655 return (mtime1 > st.st_mtime) ? Qt : Qnil;
2659 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
2660 /* #define READ_BUF_SIZE (2 << 16) */
2661 #define READ_BUF_SIZE (1 << 15)
2663 DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal,
2665 Insert contents of file FILENAME after point; no coding-system frobbing.
2666 This function is identical to `insert-file-contents' except for the
2667 handling of the CODESYS and USED-CODESYS arguments under
2668 XEmacs/Mule. (When Mule support is not present, both functions are
2669 identical and ignore the CODESYS and USED-CODESYS arguments.)
2671 If support for Mule exists in this Emacs, the file is decoded according
2672 to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil,
2673 it should be a symbol, and the actual coding system that was used for the
2674 decoding is stored into it. It will in general be different from CODESYS
2675 if CODESYS specifies automatic encoding detection or end-of-line detection.
2677 Currently START and END refer to byte positions (as opposed to character
2678 positions), even in Mule. (Fixing this is very difficult.)
2680 (filename, visit, start, end, replace, codesys, used_codesys))
2682 /* This function can call lisp */
2686 Charcount inserted = 0;
2688 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2689 Lisp_Object handler = Qnil, val;
2691 Bufbyte read_buf[READ_BUF_SIZE];
2693 struct buffer *buf = current_buffer;
2695 int not_regular = 0;
2697 if (buf->base_buffer && ! NILP (visit))
2698 error ("Cannot do file visiting in an indirect buffer");
2700 /* No need to call Fbarf_if_buffer_read_only() here.
2701 That's called in begin_multiple_change() or wherever. */
2705 /* #### dmoore - should probably check in various places to see if
2706 curbuf was killed and if so signal an error? */
2708 XSETBUFFER (curbuf, buf);
2710 GCPRO5 (filename, val, visit, handler, curbuf);
2712 mc_count = (NILP (replace)) ?
2713 begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) :
2714 begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf));
2716 speccount = specpdl_depth (); /* begin_multiple_change also adds
2717 an unwind_protect */
2719 filename = Fexpand_file_name (filename, Qnil);
2721 /* If the file name has special constructs in it,
2722 call the corresponding file handler. */
2723 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
2724 if (!NILP (handler))
2726 val = call6 (handler, Qinsert_file_contents, filename,
2727 visit, start, end, replace);
2732 if (!NILP (used_codesys))
2733 CHECK_SYMBOL (used_codesys);
2736 if ( (!NILP (start) || !NILP (end)) && !NILP (visit) )
2737 error ("Attempt to visit less than an entire file");
2741 if (xemacs_stat ((char *) XSTRING_DATA (filename), &st) < 0)
2743 if (fd >= 0) close (fd);
2746 report_file_error ("Opening input file", list1 (filename));
2752 /* Signal an error if we are accessing a non-regular file, with
2753 REPLACE, START or END being non-nil. */
2754 if (!S_ISREG (st.st_mode))
2761 if (!NILP (replace) || !NILP (start) || !NILP (end))
2763 end_multiple_change (buf, mc_count);
2766 (Fsignal (Qfile_error,
2767 list2 (build_translated_string("not a regular file"),
2771 #endif /* S_IFREG */
2783 if ((fd = interruptible_open ((char *) XSTRING_DATA (filename),
2784 O_RDONLY | OPEN_BINARY, 0)) < 0)
2788 /* Replacement should preserve point as it preserves markers. */
2789 if (!NILP (replace))
2790 record_unwind_protect (restore_point_unwind, Fpoint_marker (Qnil, Qnil));
2792 record_unwind_protect (close_file_unwind, make_int (fd));
2794 /* Supposedly happens on VMS. */
2796 error ("File size is negative");
2802 end = make_int (st.st_size);
2803 if (XINT (end) != st.st_size)
2804 error ("Maximum buffer size exceeded");
2808 /* If requested, replace the accessible part of the buffer
2809 with the file contents. Avoid replacing text at the
2810 beginning or end of the buffer that matches the file contents;
2811 that preserves markers pointing to the unchanged parts. */
2812 #if !defined (FILE_CODING)
2813 /* The replace-mode code currently only works when the assumption
2814 'one byte == one char' holds true. This fails Mule because
2815 files may contain multibyte characters. It holds under Windows NT
2816 provided we convert CRLF into LF. */
2817 # define FSFMACS_SPEEDY_INSERT
2818 #endif /* !defined (FILE_CODING) */
2820 #ifndef FSFMACS_SPEEDY_INSERT
2821 if (!NILP (replace))
2823 buffer_delete_range (buf, BUF_BEG (buf), BUF_Z (buf),
2824 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2826 #else /* FSFMACS_SPEEDY_INSERT */
2827 if (!NILP (replace))
2829 char buffer[1 << 14];
2830 Bufpos same_at_start = BUF_BEGV (buf);
2831 Bufpos same_at_end = BUF_ZV (buf);
2834 /* Count how many chars at the start of the file
2835 match the text at the beginning of the buffer. */
2840 nread = read_allowing_quit (fd, buffer, sizeof buffer);
2842 error ("IO error reading %s: %s",
2843 XSTRING_DATA (filename), strerror (errno));
2844 else if (nread == 0)
2847 while (bufpos < nread && same_at_start < BUF_ZV (buf)
2848 && BUF_FETCH_CHAR (buf, same_at_start) == buffer[bufpos])
2849 same_at_start++, bufpos++;
2850 /* If we found a discrepancy, stop the scan.
2851 Otherwise loop around and scan the next bufferful. */
2852 if (bufpos != nread)
2855 /* If the file matches the buffer completely,
2856 there's no need to replace anything. */
2857 if (same_at_start - BUF_BEGV (buf) == st.st_size)
2860 unbind_to (speccount, Qnil);
2861 /* Truncate the buffer to the size of the file. */
2862 buffer_delete_range (buf, same_at_start, same_at_end,
2863 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2866 /* Count how many chars at the end of the file
2867 match the text at the end of the buffer. */
2870 int total_read, nread;
2871 Bufpos bufpos, curpos, trial;
2873 /* At what file position are we now scanning? */
2874 curpos = st.st_size - (BUF_ZV (buf) - same_at_end);
2875 /* If the entire file matches the buffer tail, stop the scan. */
2878 /* How much can we scan in the next step? */
2879 trial = min (curpos, (Bufpos) sizeof (buffer));
2880 if (lseek (fd, curpos - trial, 0) < 0)
2881 report_file_error ("Setting file position", list1 (filename));
2884 while (total_read < trial)
2886 nread = read_allowing_quit (fd, buffer + total_read,
2887 trial - total_read);
2889 report_file_error ("IO error reading file", list1 (filename));
2890 total_read += nread;
2892 /* Scan this bufferful from the end, comparing with
2893 the Emacs buffer. */
2894 bufpos = total_read;
2895 /* Compare with same_at_start to avoid counting some buffer text
2896 as matching both at the file's beginning and at the end. */
2897 while (bufpos > 0 && same_at_end > same_at_start
2898 && BUF_FETCH_CHAR (buf, same_at_end - 1) ==
2900 same_at_end--, bufpos--;
2901 /* If we found a discrepancy, stop the scan.
2902 Otherwise loop around and scan the preceding bufferful. */
2905 /* If display current starts at beginning of line,
2906 keep it that way. */
2907 if (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == buf)
2908 XWINDOW (Fselected_window (Qnil))->start_at_line_beg =
2909 !NILP (Fbolp (make_buffer (buf)));
2912 /* Don't try to reuse the same piece of text twice. */
2913 overlap = same_at_start - BUF_BEGV (buf) -
2914 (same_at_end + st.st_size - BUF_ZV (buf));
2916 same_at_end += overlap;
2918 /* Arrange to read only the nonmatching middle part of the file. */
2919 start = make_int (same_at_start - BUF_BEGV (buf));
2920 end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end));
2922 buffer_delete_range (buf, same_at_start, same_at_end,
2923 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2924 /* Insert from the file at the proper position. */
2925 BUF_SET_PT (buf, same_at_start);
2927 #endif /* FSFMACS_SPEEDY_INSERT */
2931 total = XINT (end) - XINT (start);
2933 /* Make sure point-max won't overflow after this insertion. */
2934 if (total != XINT (make_int (total)))
2935 error ("Maximum buffer size exceeded");
2938 /* For a special file, all we can do is guess. The value of -1
2939 will make the stream functions read as much as possible. */
2942 if (XINT (start) != 0
2943 #ifdef FSFMACS_SPEEDY_INSERT
2944 /* why was this here? asked jwz. The reason is that the replace-mode
2945 connivings above will normally put the file pointer other than
2946 where it should be. */
2948 #endif /* !FSFMACS_SPEEDY_INSERT */
2951 if (lseek (fd, XINT (start), 0) < 0)
2952 report_file_error ("Setting file position", list1 (filename));
2956 Bufpos cur_point = BUF_PT (buf);
2957 struct gcpro ngcpro1;
2958 Lisp_Object stream = make_filedesc_input_stream (fd, 0, total,
2962 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2964 stream = make_decoding_input_stream
2965 (XLSTREAM (stream), Fget_coding_system (codesys));
2966 Lstream_set_character_mode (XLSTREAM (stream));
2967 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2968 #endif /* FILE_CODING */
2970 record_unwind_protect (delete_stream_unwind, stream);
2972 /* No need to limit the amount of stuff we attempt to read. (It would
2973 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
2974 occurs inside of the filedesc stream. */
2978 Charcount cc_inserted;
2981 this_len = Lstream_read (XLSTREAM (stream), read_buf,
2991 cc_inserted = buffer_insert_raw_string_1 (buf, cur_point, read_buf,
2994 ? INSDEL_NO_LOCKING : 0);
2995 inserted += cc_inserted;
2996 cur_point += cc_inserted;
2999 if (!NILP (used_codesys))
3002 XCODING_SYSTEM_NAME (decoding_stream_coding_system (XLSTREAM (stream))));
3004 #endif /* FILE_CODING */
3008 /* Close the file/stream */
3009 unbind_to (speccount, Qnil);
3013 error ("IO error reading %s: %s",
3014 XSTRING_DATA (filename), strerror (saverrno));
3020 end_multiple_change (buf, mc_count);
3024 if (!EQ (buf->undo_list, Qt))
3025 buf->undo_list = Qnil;
3028 buf->modtime = st.st_mtime;
3029 buf->filename = filename;
3030 /* XEmacs addition: */
3031 /* This function used to be in C, ostensibly so that
3032 it could be called here. But that's just silly.
3033 There's no reason C code can't call out to Lisp
3034 code, and it's a lot cleaner this way. */
3035 /* Note: compute-buffer-file-truename is called for
3036 side-effect! Its return value is intentionally
3038 if (!NILP (Ffboundp (Qcompute_buffer_file_truename)))
3039 call1 (Qcompute_buffer_file_truename, make_buffer (buf));
3041 BUF_SAVE_MODIFF (buf) = BUF_MODIFF (buf);
3042 buf->auto_save_modified = BUF_MODIFF (buf);
3043 buf->saved_size = make_int (BUF_SIZE (buf));
3044 #ifdef CLASH_DETECTION
3047 if (!NILP (buf->file_truename))
3048 unlock_file (buf->file_truename);
3049 unlock_file (filename);
3051 #endif /* CLASH_DETECTION */
3053 RETURN_UNGCPRO (Fsignal (Qfile_error,
3054 list2 (build_string ("not a regular file"),
3057 /* If visiting nonexistent file, return nil. */
3058 if (buf->modtime == -1)
3059 report_file_error ("Opening input file",
3063 /* Decode file format */
3066 Lisp_Object insval = call3 (Qformat_decode,
3067 Qnil, make_int (inserted), visit);
3069 inserted = XINT (insval);
3075 struct gcpro ngcpro1;
3078 EXTERNAL_LIST_LOOP (p, Vafter_insert_file_functions)
3080 Lisp_Object insval =
3081 call1 (XCAR (p), make_int (inserted));
3084 CHECK_NATNUM (insval);
3085 inserted = XINT (insval);
3097 return (list2 (filename, make_int (inserted)));
3101 static int a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3102 Lisp_Object *annot);
3103 static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end);
3105 /* If build_annotations switched buffers, switch back to BUF.
3106 Kill the temporary buffer that was selected in the meantime. */
3109 build_annotations_unwind (Lisp_Object buf)
3113 if (XBUFFER (buf) == current_buffer)
3115 tembuf = Fcurrent_buffer ();
3117 Fkill_buffer (tembuf);
3121 DEFUN ("write-region-internal", Fwrite_region_internal, 3, 7,
3122 "r\nFWrite region to file: ", /*
3123 Write current region into specified file; no coding-system frobbing.
3124 This function is identical to `write-region' except for the handling
3125 of the CODESYS argument under XEmacs/Mule. (When Mule support is not
3126 present, both functions are identical and ignore the CODESYS argument.)
3127 If support for Mule exists in this Emacs, the file is encoded according
3128 to the value of CODESYS. If this is nil, no code conversion occurs.
3130 (start, end, filename, append, visit, lockname, codesys))
3132 /* This function can call lisp. GC checked 2000-07-28 ben */
3137 Lisp_Object fn = Qnil;
3138 int speccount = specpdl_depth ();
3139 int visiting_other = STRINGP (visit);
3140 int visiting = (EQ (visit, Qt) || visiting_other);
3141 int quietly = (!visiting && !NILP (visit));
3142 Lisp_Object visit_file = Qnil;
3143 Lisp_Object annotations = Qnil;
3144 struct buffer *given_buffer;
3145 Bufpos start1, end1;
3146 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3147 struct gcpro ngcpro1, ngcpro2;
3150 XSETBUFFER (curbuf, current_buffer);
3152 /* start, end, visit, and append are never modified in this fun
3153 so we don't protect them. */
3154 GCPRO5 (visit_file, filename, codesys, lockname, annotations);
3155 NGCPRO2 (curbuf, fn);
3157 /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
3158 we should signal an error rather than blissfully continuing
3159 along. ARGH, this function is going to lose lose lose. We need
3160 to protect the current_buffer from being destroyed, but the
3161 multiple return points make this a pain in the butt. ]] we do
3162 protect curbuf now. --ben */
3165 codesys = Fget_coding_system (codesys);
3166 #endif /* FILE_CODING */
3168 if (current_buffer->base_buffer && ! NILP (visit))
3169 invalid_operation ("Cannot do file visiting in an indirect buffer",
3172 if (!NILP (start) && !STRINGP (start))
3173 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0);
3176 Lisp_Object handler;
3179 visit_file = Fexpand_file_name (visit, Qnil);
3181 visit_file = filename;
3182 filename = Fexpand_file_name (filename, Qnil);
3184 if (NILP (lockname))
3185 lockname = visit_file;
3187 /* We used to UNGCPRO here. BAD! visit_file is used below after
3188 more Lisp calling. */
3189 /* If the file name has special constructs in it,
3190 call the corresponding file handler. */
3191 handler = Ffind_file_name_handler (filename, Qwrite_region);
3192 /* If FILENAME has no handler, see if VISIT has one. */
3193 if (NILP (handler) && STRINGP (visit))
3194 handler = Ffind_file_name_handler (visit, Qwrite_region);
3196 if (!NILP (handler))
3198 Lisp_Object val = call8 (handler, Qwrite_region, start, end,
3199 filename, append, visit, lockname, codesys);
3202 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3203 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3204 current_buffer->filename = visit_file;
3205 MARK_MODELINE_CHANGED;
3213 #ifdef CLASH_DETECTION
3215 lock_file (lockname);
3216 #endif /* CLASH_DETECTION */
3218 /* Special kludge to simplify auto-saving. */
3221 start1 = BUF_BEG (current_buffer);
3222 end1 = BUF_Z (current_buffer);
3225 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
3227 given_buffer = current_buffer;
3228 annotations = build_annotations (start, end);
3229 if (current_buffer != given_buffer)
3231 start1 = BUF_BEGV (current_buffer);
3232 end1 = BUF_ZV (current_buffer);
3239 desc = open ((char *) XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0);
3243 desc = open ((char *) XSTRING_DATA (fn),
3244 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
3245 auto_saving ? auto_save_mode_bits : CREAT_MODE);
3250 #ifdef CLASH_DETECTION
3252 if (!auto_saving) unlock_file (lockname);
3254 #endif /* CLASH_DETECTION */
3255 report_file_error ("Opening output file", list1 (filename));
3259 Lisp_Object desc_locative = Fcons (make_int (desc), Qnil);
3260 Lisp_Object instream = Qnil, outstream = Qnil;
3261 struct gcpro nngcpro1, nngcpro2;
3262 /* need to gcpro; QUIT could happen out of call to write() */
3263 NNGCPRO2 (instream, outstream);
3265 record_unwind_protect (close_file_unwind, desc_locative);
3269 if (lseek (desc, 0, 2) < 0)
3271 #ifdef CLASH_DETECTION
3272 if (!auto_saving) unlock_file (lockname);
3273 #endif /* CLASH_DETECTION */
3274 report_file_error ("Lseek error",
3281 /* Note: I tried increasing the buffering size, along with
3282 various other tricks, but nothing seemed to make much of
3283 a difference in the time it took to save a large file.
3284 (Actually that's not true. With a local disk, changing
3285 the buffer size doesn't seem to make much difference.
3286 With an NFS-mounted disk, it could make a lot of difference
3287 because you're affecting the number of network requests
3288 that need to be made, and there could be a large latency
3289 for each request. So I've increased the buffer size
3291 outstream = make_filedesc_output_stream (desc, 0, -1, 0);
3292 Lstream_set_buffering (XLSTREAM (outstream),
3293 LSTREAM_BLOCKN_BUFFERED, 65536);
3296 make_encoding_output_stream (XLSTREAM (outstream), codesys);
3297 Lstream_set_buffering (XLSTREAM (outstream),
3298 LSTREAM_BLOCKN_BUFFERED, 65536);
3299 #endif /* FILE_CODING */
3300 if (STRINGP (start))
3302 instream = make_lisp_string_input_stream (start, 0, -1);
3306 instream = make_lisp_buffer_input_stream (current_buffer, start1, end1,
3308 LSTR_IGNORE_ACCESSIBLE);
3309 failure = (0 > (a_write (outstream, instream, start1,
3312 /* Note that this doesn't close the desc since we created the
3313 stream without the LSTR_CLOSING flag, but it does
3314 flush out any buffered data. */
3315 if (Lstream_close (XLSTREAM (outstream)) < 0)
3320 Lstream_close (XLSTREAM (instream));
3323 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3324 Disk full in NFS may be reported here. */
3325 /* mib says that closing the file will try to write as fast as NFS can do
3326 it, and that means the fsync here is not crucial for autosave files. */
3327 if (!auto_saving && fsync (desc) < 0
3328 /* If fsync fails with EINTR, don't treat that as serious. */
3334 #endif /* HAVE_FSYNC */
3336 /* Spurious "file has changed on disk" warnings used to be seen on
3337 systems where close() can change the modtime. This is known to
3338 happen on various NFS file systems, on Windows, and on Linux.
3339 Rather than handling this on a per-system basis, we
3340 unconditionally do the xemacs_stat() after the close(). */
3342 /* NFS can report a write failure now. */
3343 if (close (desc) < 0)
3349 /* Discard the close unwind-protect. Execute the one for
3350 build_annotations (switches back to the original current buffer
3352 XCAR (desc_locative) = Qnil;
3353 unbind_to (speccount, Qnil);
3358 xemacs_stat ((char *) XSTRING_DATA (fn), &st);
3360 #ifdef CLASH_DETECTION
3362 unlock_file (lockname);
3363 #endif /* CLASH_DETECTION */
3365 /* Do this before reporting IO error
3366 to avoid a "file has changed on disk" warning on
3367 next attempt to save. */
3369 current_buffer->modtime = st.st_mtime;
3374 report_file_error ("Writing file", list1 (fn));
3379 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3380 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3381 current_buffer->filename = visit_file;
3382 MARK_MODELINE_CHANGED;
3394 message ("Wrote %s", XSTRING_DATA (visit_file));
3398 struct gcpro nngcpro1;
3401 fsp = Ffile_symlink_p (fn);
3403 message ("Wrote %s", XSTRING_DATA (fn));
3405 message ("Wrote %s (symlink to %s)",
3406 XSTRING_DATA (fn), XSTRING_DATA (fsp));
3415 /* #### This is such a load of shit!!!! There is no way we should define
3416 something so stupid as a subr, just sort the fucking list more
3418 DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3419 Return t if (car A) is numerically less than (car B).
3423 Lisp_Object objs[2];
3426 return Flss (2, objs);
3429 /* Heh heh heh, let's define this too, just to aggravate the person who
3430 wrote the above comment. */
3431 DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3432 Return t if (cdr A) is numerically less than (cdr B).
3436 Lisp_Object objs[2];
3439 return Flss (2, objs);
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 BUFFER's visited file matches what BUFFER records.
3659 This means that the file has not been changed since it was visited or saved.
3663 /* This function can call lisp; GC checked 2000-07-11 ben */
3666 Lisp_Object handler;
3668 CHECK_BUFFER (buffer);
3669 b = XBUFFER (buffer);
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, buffer);
3681 if (xemacs_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 (xemacs_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 xemacs_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 necessary, 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 (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 (!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 (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 && 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 && !inhibit_auto_save_session
3994 && !NILP (Vauto_save_list_file_prefix)
3995 && STRINGP (listfile) && listdesc < 0)
3997 listdesc = open ((char *) XSTRING_DATA (listfile),
3998 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4001 /* Arrange to close that file whether or not we get
4004 record_unwind_protect (do_auto_save_unwind,
4005 make_int (listdesc));
4008 /* Record all the buffers that we are auto-saving in
4009 the special file that lists them. For each of
4010 these buffers, record visited name (if any) and
4014 const Extbyte *auto_save_file_name_ext;
4015 Extcount auto_save_file_name_ext_len;
4017 TO_EXTERNAL_FORMAT (LISP_STRING, b->auto_save_file_name,
4018 ALLOCA, (auto_save_file_name_ext,
4019 auto_save_file_name_ext_len),
4021 if (!NILP (b->filename))
4023 const Extbyte *filename_ext;
4024 Extcount filename_ext_len;
4026 TO_EXTERNAL_FORMAT (LISP_STRING, b->filename,
4027 ALLOCA, (filename_ext,
4030 write (listdesc, filename_ext, filename_ext_len);
4032 write (listdesc, "\n", 1);
4033 write (listdesc, auto_save_file_name_ext,
4034 auto_save_file_name_ext_len);
4035 write (listdesc, "\n", 1);
4038 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
4039 based on values in Vbuffer_alist. auto_save_1 may
4040 cause lisp handlers to run. Those handlers may kill
4041 the buffer and then GC. Since the buffer is killed,
4042 it's no longer in Vbuffer_alist so it might get reaped
4043 by the GC. We also need to protect tail. */
4044 /* #### There is probably a lot of other code which has
4045 pointers into buffers which may get blown away by
4048 struct gcpro ngcpro1, ngcpro2;
4049 NGCPRO2 (buf, tail);
4050 condition_case_1 (Qt,
4052 auto_save_error, Qnil);
4055 /* Handler killed our saved current-buffer! Pick any. */
4056 if (!BUFFER_LIVE_P (XBUFFER (old)))
4057 XSETBUFFER (old, current_buffer);
4059 set_buffer_internal (XBUFFER (old));
4062 /* Handler killed their own buffer! */
4063 if (!BUFFER_LIVE_P(b))
4066 b->auto_save_modified = BUF_MODIFF (b);
4067 b->saved_size = make_int (BUF_SIZE (b));
4068 EMACS_GET_TIME (after_time);
4069 /* If auto-save took more than 60 seconds,
4070 assume it was an NFS failure that got a timeout. */
4071 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
4072 b->auto_save_failure_time = EMACS_SECS (after_time);
4077 /* Prevent another auto save till enough input events come in. */
4079 record_auto_save ();
4081 /* If we didn't save anything into the listfile, remove the old
4082 one because nothing needed to be auto-saved. Do this afterwards
4083 rather than before in case we get a crash attempting to autosave
4084 (in that case we'd still want the old one around). */
4085 if (listdesc < 0 && !auto_saved && STRINGP (listfile))
4086 unlink ((char *) XSTRING_DATA (listfile));
4088 /* Show "...done" only if the echo area would otherwise be empty. */
4089 if (auto_saved && NILP (no_message)
4090 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0)))
4092 static const unsigned char *msg
4093 = (const unsigned char *)"Auto-saving...done";
4094 echo_area_message (selected_frame (), msg, Qnil, 0,
4095 strlen ((const char *) msg), Qauto_saving);
4100 RETURN_UNGCPRO (unbind_to (speccount, Qnil));
4103 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
4104 Mark current buffer as auto-saved with its current text.
4105 No auto-save file will be written until the buffer changes again.
4109 current_buffer->auto_save_modified = BUF_MODIFF (current_buffer);
4110 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
4111 current_buffer->auto_save_failure_time = -1;
4115 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
4116 Clear any record of a recent auto-save failure in the current buffer.
4120 current_buffer->auto_save_failure_time = -1;
4124 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
4125 Return t if buffer has been auto-saved since last read in or saved.
4129 return (BUF_SAVE_MODIFF (current_buffer) <
4130 current_buffer->auto_save_modified) ? Qt : Qnil;
4134 /************************************************************************/
4135 /* initialization */
4136 /************************************************************************/
4139 syms_of_fileio (void)
4141 defsymbol (&Qexpand_file_name, "expand-file-name");
4142 defsymbol (&Qfile_truename, "file-truename");
4143 defsymbol (&Qsubstitute_in_file_name, "substitute-in-file-name");
4144 defsymbol (&Qdirectory_file_name, "directory-file-name");
4145 defsymbol (&Qfile_name_directory, "file-name-directory");
4146 defsymbol (&Qfile_name_nondirectory, "file-name-nondirectory");
4147 defsymbol (&Qunhandled_file_name_directory, "unhandled-file-name-directory");
4148 defsymbol (&Qfile_name_as_directory, "file-name-as-directory");
4149 defsymbol (&Qcopy_file, "copy-file");
4150 defsymbol (&Qmake_directory_internal, "make-directory-internal");
4151 defsymbol (&Qdelete_directory, "delete-directory");
4152 defsymbol (&Qdelete_file, "delete-file");
4153 defsymbol (&Qrename_file, "rename-file");
4154 defsymbol (&Qadd_name_to_file, "add-name-to-file");
4155 defsymbol (&Qmake_symbolic_link, "make-symbolic-link");
4156 defsymbol (&Qfile_exists_p, "file-exists-p");
4157 defsymbol (&Qfile_executable_p, "file-executable-p");
4158 defsymbol (&Qfile_readable_p, "file-readable-p");
4159 defsymbol (&Qfile_symlink_p, "file-symlink-p");
4160 defsymbol (&Qfile_writable_p, "file-writable-p");
4161 defsymbol (&Qfile_directory_p, "file-directory-p");
4162 defsymbol (&Qfile_regular_p, "file-regular-p");
4163 defsymbol (&Qfile_accessible_directory_p, "file-accessible-directory-p");
4164 defsymbol (&Qfile_modes, "file-modes");
4165 defsymbol (&Qset_file_modes, "set-file-modes");
4166 defsymbol (&Qfile_newer_than_file_p, "file-newer-than-file-p");
4167 defsymbol (&Qinsert_file_contents, "insert-file-contents");
4168 defsymbol (&Qwrite_region, "write-region");
4169 defsymbol (&Qverify_visited_file_modtime, "verify-visited-file-modtime");
4170 defsymbol (&Qset_visited_file_modtime, "set-visited-file-modtime");
4171 defsymbol (&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */
4173 defsymbol (&Qauto_save_hook, "auto-save-hook");
4174 defsymbol (&Qauto_save_error, "auto-save-error");
4175 defsymbol (&Qauto_saving, "auto-saving");
4177 defsymbol (&Qformat_decode, "format-decode");
4178 defsymbol (&Qformat_annotate_function, "format-annotate-function");
4180 defsymbol (&Qcompute_buffer_file_truename, "compute-buffer-file-truename");
4181 DEFERROR_STANDARD (Qfile_error, Qio_error);
4182 DEFERROR_STANDARD (Qfile_already_exists, Qfile_error);
4184 DEFSUBR (Ffind_file_name_handler);
4186 DEFSUBR (Ffile_name_directory);
4187 DEFSUBR (Ffile_name_nondirectory);
4188 DEFSUBR (Funhandled_file_name_directory);
4189 DEFSUBR (Ffile_name_as_directory);
4190 DEFSUBR (Fdirectory_file_name);
4191 DEFSUBR (Fmake_temp_name);
4192 DEFSUBR (Fexpand_file_name);
4193 DEFSUBR (Ffile_truename);
4194 DEFSUBR (Fsubstitute_in_file_name);
4195 DEFSUBR (Fcopy_file);
4196 DEFSUBR (Fmake_directory_internal);
4197 DEFSUBR (Fdelete_directory);
4198 DEFSUBR (Fdelete_file);
4199 DEFSUBR (Frename_file);
4200 DEFSUBR (Fadd_name_to_file);
4201 DEFSUBR (Fmake_symbolic_link);
4203 DEFSUBR (Fsysnetunam);
4204 #endif /* HPUX_NET */
4205 DEFSUBR (Ffile_name_absolute_p);
4206 DEFSUBR (Ffile_exists_p);
4207 DEFSUBR (Ffile_executable_p);
4208 DEFSUBR (Ffile_readable_p);
4209 DEFSUBR (Ffile_writable_p);
4210 DEFSUBR (Ffile_symlink_p);
4211 DEFSUBR (Ffile_directory_p);
4212 DEFSUBR (Ffile_accessible_directory_p);
4213 DEFSUBR (Ffile_regular_p);
4214 DEFSUBR (Ffile_modes);
4215 DEFSUBR (Fset_file_modes);
4216 DEFSUBR (Fset_default_file_modes);
4217 DEFSUBR (Fdefault_file_modes);
4218 DEFSUBR (Funix_sync);
4219 DEFSUBR (Ffile_newer_than_file_p);
4220 DEFSUBR (Finsert_file_contents_internal);
4221 DEFSUBR (Fwrite_region_internal);
4222 DEFSUBR (Fcar_less_than_car); /* Vomitous! */
4223 DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
4225 DEFSUBR (Fencrypt_string);
4226 DEFSUBR (Fdecrypt_string);
4228 DEFSUBR (Fverify_visited_file_modtime);
4229 DEFSUBR (Fclear_visited_file_modtime);
4230 DEFSUBR (Fvisited_file_modtime);
4231 DEFSUBR (Fset_visited_file_modtime);
4233 DEFSUBR (Fdo_auto_save);
4234 DEFSUBR (Fset_buffer_auto_saved);
4235 DEFSUBR (Fclear_buffer_auto_save_failure);
4236 DEFSUBR (Frecent_auto_save_p);
4240 vars_of_fileio (void)
4242 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /*
4243 *Format in which to write auto-save files.
4244 Should be a list of symbols naming formats that are defined in `format-alist'.
4245 If it is t, which is the default, auto-save files are written in the
4246 same format as a regular save would use.
4248 Vauto_save_file_format = Qt;
4250 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /*
4251 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
4252 If a file name matches REGEXP, then all I/O on that file is done by calling
4255 The first argument given to HANDLER is the name of the I/O primitive
4256 to be handled; the remaining arguments are the arguments that were
4257 passed to that primitive. For example, if you do
4258 (file-exists-p FILENAME)
4259 and FILENAME is handled by HANDLER, then HANDLER is called like this:
4260 (funcall HANDLER 'file-exists-p FILENAME)
4261 The function `find-file-name-handler' checks this list for a handler
4264 Vfile_name_handler_alist = Qnil;
4266 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /*
4267 A list of functions to be called at the end of `insert-file-contents'.
4268 Each is passed one argument, the number of bytes inserted. It should return
4269 the new byte count, and leave point the same. If `insert-file-contents' is
4270 intercepted by a handler from `file-name-handler-alist', that handler is
4271 responsible for calling the after-insert-file-functions if appropriate.
4273 Vafter_insert_file_functions = Qnil;
4275 DEFVAR_LISP ("write-region-annotate-functions",
4276 &Vwrite_region_annotate_functions /*
4277 A list of functions to be called at the start of `write-region'.
4278 Each is passed two arguments, START and END, as for `write-region'.
4279 It should return a list of pairs (POSITION . STRING) of strings to be
4280 effectively inserted at the specified positions of the file being written
4281 \(1 means to insert before the first byte written). The POSITIONs must be
4282 sorted into increasing order. If there are several functions in the list,
4283 the several lists are merged destructively.
4285 Vwrite_region_annotate_functions = Qnil;
4287 DEFVAR_LISP ("write-region-annotations-so-far",
4288 &Vwrite_region_annotations_so_far /*
4289 When an annotation function is called, this holds the previous annotations.
4290 These are the annotations made by other annotation functions
4291 that were already called. See also `write-region-annotate-functions'.
4293 Vwrite_region_annotations_so_far = Qnil;
4295 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
4296 A list of file name handlers that temporarily should not be used.
4297 This applies only to the operation `inhibit-file-name-operation'.
4299 Vinhibit_file_name_handlers = Qnil;
4301 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
4302 The operation for which `inhibit-file-name-handlers' is applicable.
4304 Vinhibit_file_name_operation = Qnil;
4306 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name /*
4307 File name in which we write a list of all auto save file names.
4309 Vauto_save_list_file_name = Qnil;
4311 DEFVAR_LISP ("auto-save-list-file-prefix", &Vauto_save_list_file_prefix /*
4312 Prefix for generating auto-save-list-file-name.
4313 Emacs's pid and the system name will be appended to
4314 this prefix to create a unique file name.
4316 Vauto_save_list_file_prefix = build_string ("~/.saves-");
4318 DEFVAR_BOOL ("inhibit-auto-save-session", &inhibit_auto_save_session /*
4319 When non-nil, inhibit auto save list file creation.
4321 inhibit_auto_save_session = 0;
4323 DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks",
4324 &disable_auto_save_when_buffer_shrinks /*
4325 If non-nil, auto-saving is disabled when a buffer shrinks too much.
4326 This is to prevent you from losing your edits if you accidentally
4327 delete a large chunk of the buffer and don't notice it until too late.
4328 Saving the buffer normally turns auto-save back on.
4330 disable_auto_save_when_buffer_shrinks = 1;
4332 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /*
4333 Directory separator character for built-in functions that return file names.
4334 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
4335 This variable affects the built-in functions only on Windows,
4336 on other platforms, it is initialized so that Lisp code can find out
4337 what the normal separator is.
4340 Vdirectory_sep_char = make_char ('\\');
4342 Vdirectory_sep_char = make_char ('/');
4345 reinit_vars_of_fileio ();
4349 reinit_vars_of_fileio (void)
4351 /* We want temp_name_rand to be initialized to a value likely to be
4352 unique to the process, not to the executable. The danger is that
4353 two different XEmacs processes using the same binary on different
4354 machines creating temp files in the same directory will be
4355 unlucky enough to have the same pid. If we randomize using
4356 process startup time, then in practice they will be unlikely to
4357 collide. We use the microseconds field so that scripts that start
4358 simultaneous XEmacs processes on multiple machines will have less
4359 chance of collision. */
4363 EMACS_GET_TIME (thyme);
4364 temp_name_rand = (unsigned int) (EMACS_SECS (thyme) ^ EMACS_USECS (thyme));