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-11-18 */
754 Bufbyte *newdir, *p, *o;
759 int collapse_newdir = 1;
762 #endif /* WIN32_NATIVE */
764 Lisp_Object handler = Qnil;
768 struct gcpro gcpro1, gcpro2, gcpro3;
770 /* both of these get set below */
771 GCPRO3 (name, default_directory, handler);
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);
779 RETURN_UNGCPRO (call3_check_string (handler, Qexpand_file_name,
780 name, default_directory));
782 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
783 if (NILP (default_directory))
784 default_directory = current_buffer->directory;
785 if (! STRINGP (default_directory))
786 default_directory = build_string ("/");
788 if (!NILP (default_directory))
790 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
792 RETURN_UNGCPRO (call3 (handler, Qexpand_file_name,
793 name, default_directory));
796 o = XSTRING_DATA (default_directory);
798 /* Make sure DEFAULT_DIRECTORY is properly expanded.
799 It would be better to do this down below where we actually use
800 default_directory. Unfortunately, calling Fexpand_file_name recursively
801 could invoke GC, and the strings might be relocated. This would
802 be annoying because we have pointers into strings lying around
803 that would need adjusting, and people would add new pointers to
804 the code and forget to adjust them, resulting in intermittent bugs.
805 Putting this call here avoids all that crud.
807 The EQ test avoids infinite recursion. */
808 if (! NILP (default_directory) && !EQ (default_directory, name)
809 /* Save time in some common cases - as long as default_directory
810 is not relative, it can be canonicalized with name below (if it
811 is needed at all) without requiring it to be expanded now. */
813 /* Detect Windows file names with drive specifiers. */
814 && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2])))
815 /* Detect Windows file names in UNC format. */
816 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
818 #else /* not WIN32_NATIVE */
820 /* Detect Unix absolute file names (/... alone is not absolute on
822 && ! (IS_DIRECTORY_SEP (o[0]))
823 #endif /* not WIN32_NATIVE */
826 default_directory = Fexpand_file_name (default_directory, Qnil);
828 #ifdef FILE_SYSTEM_CASE
829 name = FILE_SYSTEM_CASE (name);
832 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing
833 into name should be safe during all of this, though. */
834 nm = XSTRING_DATA (name);
837 /* We will force directory separators to be either all \ or /, so make
838 a local copy to modify, even if there ends up being no change. */
839 nm = strcpy ((char *)alloca (strlen ((char *)nm) + 1), (char *)nm);
841 /* Find and remove drive specifier if present; this makes nm absolute
842 even if the rest of the name appears to be relative. */
844 Bufbyte *colon = (Bufbyte *) strrchr ((char *)nm, ':');
847 /* Only recognize colon as part of drive specifier if there is a
848 single alphabetic character preceding the colon (and if the
849 character before the drive letter, if present, is a directory
850 separator); this is to support the remote system syntax used by
851 ange-ftp, and the "po:username" syntax for POP mailboxes. */
855 else if (IS_DRIVE (colon[-1])
856 && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2])))
863 while (--colon >= nm)
869 /* If we see "c://somedir", we want to strip the first slash after the
870 colon when stripping the drive letter. Otherwise, this expands to
872 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
874 #endif /* WIN32_NATIVE */
876 /* If nm is absolute, look for /./ or /../ sequences; if none are
877 found, we can probably return right away. We will avoid allocating
878 a new string if name is already fully expanded. */
880 IS_DIRECTORY_SEP (nm[0])
882 && (drive || IS_DIRECTORY_SEP (nm[1]))
886 /* If it turns out that the filename we want to return is just a
887 suffix of FILENAME, we don't need to go through and edit
888 things; we just need to construct a new string using data
889 starting at the middle of FILENAME. If we set lose to a
890 non-zero value, that means we've discovered that we can't do
897 /* Since we know the name is absolute, we can assume that each
898 element starts with a "/". */
900 /* "." and ".." are hairy. */
901 if (IS_DIRECTORY_SEP (p[0])
903 && (IS_DIRECTORY_SEP (p[2])
905 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
913 /* Make sure directories are all separated with / or \ as
914 desired, but avoid allocation of a new string when not
916 CORRECT_DIR_SEPS (nm);
917 if (IS_DIRECTORY_SEP (nm[1]))
919 if (strcmp (nm, XSTRING_DATA (name)) != 0)
920 name = build_string (nm);
922 /* drive must be set, so this is okay */
923 else if (strcmp (nm - 2, XSTRING_DATA (name)) != 0)
925 name = make_string (nm - 2, p - nm + 2);
926 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
927 XSTRING_DATA (name)[1] = ':';
929 RETURN_UNGCPRO (name);
930 #else /* not WIN32_NATIVE */
931 if (nm == XSTRING_DATA (name))
932 RETURN_UNGCPRO (name);
933 RETURN_UNGCPRO (build_string ((char *) nm));
934 #endif /* not WIN32_NATIVE */
938 /* At this point, nm might or might not be an absolute file name. We
939 need to expand ~ or ~user if present, otherwise prefix nm with
940 default_directory if nm is not absolute, and finally collapse /./
941 and /foo/../ sequences.
943 We set newdir to be the appropriate prefix if one is needed:
944 - the relevant user directory if nm starts with ~ or ~user
945 - the specified drive's working dir (DOS/NT only) if nm does not
947 - the value of default_directory.
949 Note that these prefixes are not guaranteed to be absolute (except
950 for the working dir of a drive). Therefore, to ensure we always
951 return an absolute name, if the final prefix is not absolute we
952 append it to the current working directory. */
956 if (nm[0] == '~') /* prefix ~ */
958 if (IS_DIRECTORY_SEP (nm[1])
959 || nm[1] == 0) /* ~ by itself */
961 Extbyte *newdir_external = get_home_directory ();
963 if (newdir_external == NULL)
964 newdir = (Bufbyte *) "";
966 TO_INTERNAL_FORMAT (C_STRING, newdir_external,
967 C_STRING_ALLOCA, (* ((char **) &newdir)),
975 else /* ~user/filename */
977 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++)
979 o = (Bufbyte *) alloca (p - nm + 1);
980 memcpy (o, (char *) nm, p - nm);
983 /* #### marcpa's syncing note: FSF uses getpwnam even on NT,
984 which does not work. The following works only if ~USER
985 names the user who runs this instance of XEmacs. While
986 NT is single-user (for the moment) you still can have
987 multiple user profiles users defined, each with its HOME.
988 Therefore, the following should be reworked to handle
991 /* Now if the file given is "~foo/file" and HOME="c:/", then
992 we want the file to be named "c:/file" ("~foo" becomes
993 "c:/"). The variable o has "~foo", so we can use the
994 length of that string to offset nm. August Hill, 31 Aug
996 newdir = (Bufbyte *) get_home_directory();
997 dostounix_filename (newdir);
999 #else /* not WIN32_NATIVE */
1001 if ((user = user_login_name (NULL)) != NULL)
1003 /* Does the user login name match the ~name? */
1004 if (strcmp (user, (char *) o + 1) == 0)
1006 newdir = (Bufbyte *) get_home_directory();
1013 /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM
1014 occurring in it. (It can call select()). */
1015 slow_down_interrupts ();
1016 pw = (struct passwd *) getpwnam ((char *) o + 1);
1017 speed_up_interrupts ();
1020 newdir = (Bufbyte *) pw -> pw_dir;
1026 #endif /* not WIN32_NATIVE */
1028 /* If we don't find a user of that name, leave the name
1029 unchanged; don't move nm forward to p. */
1034 /* On DOS and Windows, nm is absolute if a drive name was specified;
1035 use the drive's current directory as the prefix if needed. */
1036 if (!newdir && drive)
1038 /* Get default directory if needed to make nm absolute. */
1039 if (!IS_DIRECTORY_SEP (nm[0]))
1041 newdir = alloca (MAXPATHLEN + 1);
1042 if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN))
1047 /* Either nm starts with /, or drive isn't mounted. */
1048 newdir = alloca (4);
1049 newdir[0] = DRIVE_LETTER (drive);
1055 #endif /* WIN32_NATIVE */
1057 /* Finally, if no prefix has been specified and nm is not absolute,
1058 then it must be expanded relative to default_directory. */
1061 #ifndef WIN32_NATIVE
1062 /* /... alone is not absolute on DOS and Windows. */
1063 && !IS_DIRECTORY_SEP (nm[0])
1065 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
1069 newdir = XSTRING_DATA (default_directory);
1075 /* First ensure newdir is an absolute name. */
1077 /* Detect Windows file names with drive specifiers. */
1078 ! (IS_DRIVE (newdir[0])
1079 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
1080 /* Detect Windows file names in UNC format. */
1081 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1082 /* Detect drive spec by itself */
1083 && ! (IS_DEVICE_SEP (newdir[1]) && newdir[2] == 0)
1086 /* Effectively, let newdir be (expand-file-name newdir cwd).
1087 Because of the admonition against calling expand-file-name
1088 when we have pointers into lisp strings, we accomplish this
1089 indirectly by prepending newdir to nm if necessary, and using
1090 cwd (or the wd of newdir's drive) as the new newdir. */
1092 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1097 if (!IS_DIRECTORY_SEP (nm[0]))
1099 char * tmp = alloca (strlen (newdir) + strlen (nm) + 2);
1100 file_name_as_directory (tmp, newdir);
1104 newdir = alloca (MAXPATHLEN + 1);
1107 if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN))
1114 /* Strip off drive name from prefix, if present. */
1115 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1121 /* Keep only a prefix from newdir if nm starts with slash
1122 (/ /server/share for UNC, nothing otherwise). */
1123 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
1125 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1127 newdir = strcpy (alloca (strlen (newdir) + 1), newdir);
1129 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1131 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1138 #endif /* WIN32_NATIVE */
1142 /* Get rid of any slash at the end of newdir, unless newdir is
1143 just // (an incomplete UNC name). */
1144 length = strlen ((char *) newdir);
1145 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
1147 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
1151 Bufbyte *temp = (Bufbyte *) alloca (length);
1152 memcpy (temp, newdir, length - 1);
1153 temp[length - 1] = 0;
1161 /* Now concatenate the directory and name to new space in the stack frame */
1162 tlen += strlen ((char *) nm) + 1;
1164 /* Add reserved space for drive name. (The Microsoft x86 compiler
1165 produces incorrect code if the following two lines are combined.) */
1166 target = (Bufbyte *) alloca (tlen + 2);
1168 #else /* not WIN32_NATIVE */
1169 target = (Bufbyte *) alloca (tlen);
1170 #endif /* not WIN32_NATIVE */
1175 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
1176 strcpy ((char *) target, (char *) newdir);
1178 file_name_as_directory ((char *) target, (char *) newdir);
1181 strcat ((char *) target, (char *) nm);
1183 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1185 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1192 if (!IS_DIRECTORY_SEP (*p))
1196 else if (IS_DIRECTORY_SEP (p[0])
1198 && (IS_DIRECTORY_SEP (p[2])
1201 /* If "/." is the entire filename, keep the "/". Otherwise,
1202 just delete the whole "/.". */
1203 if (o == target && p[2] == '\0')
1207 else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
1208 /* `/../' is the "superroot" on certain file systems. */
1210 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
1212 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
1214 /* Keep initial / only if this is the whole name. */
1215 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
1220 /* if drive is set, we're not dealing with an UNC, so
1221 multiple dir-seps are redundant (and reportedly cause trouble
1223 else if (drive && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
1233 /* At last, set drive name, except for network file name. */
1237 target[0] = DRIVE_LETTER (drive);
1242 assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]));
1244 CORRECT_DIR_SEPS (target);
1245 #endif /* WIN32_NATIVE */
1247 RETURN_UNGCPRO (make_string (target, o - target));
1250 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /*
1251 Return the canonical name of FILENAME.
1252 Second arg DEFAULT is directory to start with if FILENAME is relative
1253 (does not start with slash); if DEFAULT is nil or missing,
1254 the current buffer's value of `default-directory' is used.
1255 No component of the resulting pathname will be a symbolic link, as
1256 in the realpath() function.
1258 (filename, default_))
1260 /* This function can GC. GC checked 2000-07-28 ben. */
1261 Lisp_Object expanded_name;
1262 struct gcpro gcpro1;
1264 CHECK_STRING (filename);
1266 expanded_name = Fexpand_file_name (filename, default_);
1268 if (!STRINGP (expanded_name))
1271 GCPRO1 (expanded_name);
1274 Lisp_Object handler =
1275 Ffind_file_name_handler (expanded_name, Qfile_truename);
1277 if (!NILP (handler))
1279 (call2_check_string (handler, Qfile_truename, expanded_name));
1283 char resolved_path[MAXPATHLEN];
1288 TO_EXTERNAL_FORMAT (LISP_STRING, expanded_name,
1289 ALLOCA, (path, elen),
1292 if (elen > MAXPATHLEN)
1295 /* Try doing it all at once. */
1296 /* !! Does realpath() Mule-encapsulate?
1297 Answer: Nope! So we do it above */
1298 if (!xrealpath ((char *) path, resolved_path))
1300 /* Didn't resolve it -- have to do it one component at a time. */
1301 /* "realpath" is a typically useless, stupid un*x piece of crap.
1302 It claims to return a useful value in the "error" case, but since
1303 there is no indication provided of how far along the pathname
1304 the function went before erring, there is no way to use the
1305 partial result returned. What a piece of junk.
1307 The above comment refers to historical versions of
1308 realpath(). The Unix98 specs state:
1310 "On successful completion, realpath() returns a
1311 pointer to the resolved name. Otherwise, realpath()
1312 returns a null pointer and sets errno to indicate the
1313 error, and the contents of the buffer pointed to by
1314 resolved_name are undefined."
1316 Since we depend on undocumented semantics of various system realpath()s,
1317 we just use our own version in realpath.c. */
1323 if (IS_DRIVE (p[0]) && IS_DEVICE_SEP (p[1])
1324 && IS_DIRECTORY_SEP (p[2]))
1325 /* don't test c: on windows */
1327 else if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
1328 /* start after // */
1331 for (pos = p + 1; pos < path + elen; pos++)
1332 if (IS_DIRECTORY_SEP (*pos))
1340 if (xrealpath ((char *) path, resolved_path))
1348 else if (errno == ENOENT || errno == EACCES)
1350 /* Failed on this component. Just tack on the rest of
1351 the string and we are done. */
1352 int rlen = strlen (resolved_path);
1354 /* "On failure, it returns NULL, sets errno to indicate
1355 the error, and places in resolved_path the absolute pathname
1356 of the path component which could not be resolved." */
1360 int plen = elen - (p - path);
1362 if (rlen > 1 && IS_DIRECTORY_SEP (resolved_path[rlen - 1]))
1365 if (plen + rlen + 1 > countof (resolved_path))
1368 resolved_path[rlen] = DIRECTORY_SEP;
1369 memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1);
1379 Lisp_Object resolved_name;
1380 int rlen = strlen (resolved_path);
1381 if (elen > 0 && IS_DIRECTORY_SEP (XSTRING_BYTE (expanded_name, elen - 1))
1382 && !(rlen > 0 && IS_DIRECTORY_SEP (resolved_path[rlen - 1])))
1384 if (rlen + 1 > countof (resolved_path))
1386 resolved_path[rlen++] = DIRECTORY_SEP;
1387 resolved_path[rlen] = '\0';
1389 TO_INTERNAL_FORMAT (DATA, (resolved_path, rlen),
1390 LISP_STRING, resolved_name,
1392 RETURN_UNGCPRO (resolved_name);
1396 errno = ENAMETOOLONG;
1399 report_file_error ("Finding truename", list1 (expanded_name));
1401 RETURN_UNGCPRO (Qnil);
1405 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
1406 Substitute environment variables referred to in FILENAME.
1407 `$FOO' where FOO is an environment variable name means to substitute
1408 the value of that variable. The variable name should be terminated
1409 with a character, not a letter, digit or underscore; otherwise, enclose
1410 the entire variable name in braces.
1411 If `/~' appears, all of FILENAME through that `/' is discarded.
1415 /* This function can GC. GC checked 2000-07-28 ben. */
1418 Bufbyte *s, *p, *o, *x, *endp;
1419 Bufbyte *target = 0;
1421 int substituted = 0;
1423 Lisp_Object handler;
1425 CHECK_STRING (filename);
1427 /* If the file name has special constructs in it,
1428 call the corresponding file handler. */
1429 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
1430 if (!NILP (handler))
1431 return call2_check_string_or_nil (handler, Qsubstitute_in_file_name,
1434 nm = XSTRING_DATA (filename);
1435 endp = nm + XSTRING_LENGTH (filename);
1437 /* If /~ or // appears, discard everything through first slash. */
1439 for (p = nm; p != endp; p++)
1442 #if defined (WIN32_NATIVE) || defined (CYGWIN)
1443 /* // at start of file name is meaningful in WindowsNT systems */
1444 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
1445 #else /* not (WIN32_NATIVE || CYGWIN) */
1446 || IS_DIRECTORY_SEP (p[0])
1447 #endif /* not (WIN32_NATIVE || CYGWIN) */
1450 && (IS_DIRECTORY_SEP (p[-1])))
1456 /* see comment in expand-file-name about drive specifiers */
1457 else if (IS_DRIVE (p[0]) && p[1] == ':'
1458 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1463 #endif /* WIN32_NATIVE */
1466 /* See if any variables are substituted into the string
1467 and find the total length of their values in `total' */
1469 for (p = nm; p != endp;)
1479 /* "$$" means a single "$" */
1488 while (p != endp && *p != '}') p++;
1489 if (*p != '}') goto missingclose;
1495 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1499 /* Copy out the variable name */
1500 target = (Bufbyte *) alloca (s - o + 1);
1501 strncpy ((char *) target, (char *) o, s - o);
1504 strupr (target); /* $home == $HOME etc. */
1505 #endif /* WIN32_NATIVE */
1507 /* Get variable value */
1508 o = (Bufbyte *) egetenv ((char *) target);
1509 if (!o) goto badvar;
1510 total += strlen ((char *) o);
1517 /* If substitution required, recopy the filename and do it */
1518 /* Make space in stack frame for the new copy */
1519 xnm = (Bufbyte *) alloca (XSTRING_LENGTH (filename) + total + 1);
1522 /* Copy the rest of the name through, replacing $ constructs with values */
1539 while (p != endp && *p != '}') p++;
1540 if (*p != '}') goto missingclose;
1546 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1550 /* Copy out the variable name */
1551 target = (Bufbyte *) alloca (s - o + 1);
1552 strncpy ((char *) target, (char *) o, s - o);
1555 strupr (target); /* $home == $HOME etc. */
1556 #endif /* WIN32_NATIVE */
1558 /* Get variable value */
1559 o = (Bufbyte *) egetenv ((char *) target);
1563 strcpy ((char *) x, (char *) o);
1564 x += strlen ((char *) o);
1569 /* If /~ or // appears, discard everything through first slash. */
1571 for (p = xnm; p != x; p++)
1573 #if defined (WIN32_NATIVE)
1574 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
1575 #else /* not WIN32_NATIVE */
1576 || IS_DIRECTORY_SEP (p[0])
1577 #endif /* not WIN32_NATIVE */
1579 /* don't do p[-1] if that would go off the beginning --jwz */
1580 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1]))
1583 else if (IS_DRIVE (p[0]) && p[1] == ':'
1584 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1588 return make_string (xnm, x - xnm);
1591 syntax_error ("Bad format environment-variable substitution", filename);
1593 syntax_error ("Missing \"}\" in environment-variable substitution",
1596 syntax_error_2 ("Substituting nonexistent environment variable",
1597 filename, build_string ((char *) target));
1600 return Qnil; /* suppress compiler warning */
1603 /* A slightly faster and more convenient way to get
1604 (directory-file-name (expand-file-name FOO)). */
1607 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
1609 /* This function can call Lisp. GC checked 2000-07-28 ben */
1610 Lisp_Object abspath;
1611 struct gcpro gcpro1;
1613 abspath = Fexpand_file_name (filename, defdir);
1615 /* Remove final slash, if any (unless path is root).
1616 stat behaves differently depending! */
1617 if (XSTRING_LENGTH (abspath) > 1
1618 && IS_DIRECTORY_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1))
1619 && !IS_DEVICE_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 2)))
1620 /* We cannot take shortcuts; they might be wrong for magic file names. */
1621 abspath = Fdirectory_file_name (abspath);
1626 /* Signal an error if the file ABSNAME already exists.
1627 If INTERACTIVE is nonzero, ask the user whether to proceed,
1628 and bypass the error if the user says to go ahead.
1629 QUERYSTRING is a name for the action that is being considered
1631 *STATPTR is used to store the stat information if the file exists.
1632 If the file does not exist, STATPTR->st_mode is set to 0. */
1635 barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring,
1636 int interactive, struct stat *statptr)
1638 /* This function can call Lisp. GC checked 2000-07-28 ben */
1639 struct stat statbuf;
1641 /* stat is a good way to tell whether the file exists,
1642 regardless of what access permissions it has. */
1643 if (xemacs_stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0)
1650 struct gcpro gcpro1;
1652 prompt = emacs_doprnt_string_c
1653 ((const Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "),
1654 Qnil, -1, XSTRING_DATA (absname),
1655 GETTEXT (querystring));
1658 tem = call1 (Qyes_or_no_p, prompt);
1665 Fsignal (Qfile_already_exists,
1666 list2 (build_translated_string ("File already exists"),
1674 statptr->st_mode = 0;
1679 /* A slightly higher-level interface than `set_file_times' */
1681 lisp_string_set_file_times (Lisp_Object filename,
1682 EMACS_TIME atime, EMACS_TIME mtime)
1685 LISP_STRING_TO_EXTERNAL (filename, ext_filename, Qfile_name);
1686 return set_file_times (ext_filename, atime, mtime);
1689 DEFUN ("copy-file", Fcopy_file, 2, 4,
1690 "fCopy file: \nFCopy %s to file: \np\nP", /*
1691 Copy FILENAME to NEWNAME. Both args must be strings.
1692 Signals a `file-already-exists' error if file NEWNAME already exists,
1693 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
1694 A number as third arg means request confirmation if NEWNAME already exists.
1695 This is what happens in interactive use with M-x.
1696 Fourth arg KEEP-TIME non-nil means give the new file the same
1697 last-modified time as the old one. (This works on only some systems.)
1698 A prefix arg makes KEEP-TIME non-nil.
1700 (filename, newname, ok_if_already_exists, keep_time))
1702 /* This function can call Lisp. GC checked 2000-07-28 ben */
1704 char buf[16 * 1024];
1705 struct stat st, out_st;
1706 Lisp_Object handler;
1707 int speccount = specpdl_depth ();
1708 struct gcpro gcpro1, gcpro2;
1709 /* Lisp_Object args[6]; */
1710 int input_file_statable_p;
1712 GCPRO2 (filename, newname);
1713 CHECK_STRING (filename);
1714 CHECK_STRING (newname);
1715 filename = Fexpand_file_name (filename, Qnil);
1716 newname = Fexpand_file_name (newname, Qnil);
1718 /* If the input file name has special constructs in it,
1719 call the corresponding file handler. */
1720 handler = Ffind_file_name_handler (filename, Qcopy_file);
1721 /* Likewise for output file name. */
1723 handler = Ffind_file_name_handler (newname, Qcopy_file);
1724 if (!NILP (handler))
1727 return call5 (handler, Qcopy_file, filename, newname,
1728 ok_if_already_exists, keep_time);
1731 /* When second argument is a directory, copy the file into it.
1732 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
1734 if (!NILP (Ffile_directory_p (newname)))
1736 Lisp_Object args[3];
1737 struct gcpro ngcpro1;
1741 args[1] = Qnil; args[2] = Qnil;
1744 if (!IS_DIRECTORY_SEP (XSTRING_BYTE (newname,
1745 XSTRING_LENGTH (newname) - 1)))
1747 args[i++] = Fchar_to_string (Vdirectory_sep_char);
1748 args[i++] = Ffile_name_nondirectory (filename);
1749 newname = Fconcat (i, args);
1753 if (NILP (ok_if_already_exists)
1754 || INTP (ok_if_already_exists))
1755 barf_or_query_if_file_exists (newname, "copy to it",
1756 INTP (ok_if_already_exists), &out_st);
1757 else if (xemacs_stat ((const char *) XSTRING_DATA (newname), &out_st) < 0)
1760 ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0);
1762 report_file_error ("Opening input file", list1 (filename));
1764 record_unwind_protect (close_file_unwind, make_int (ifd));
1766 /* We can only copy regular files and symbolic links. Other files are not
1768 input_file_statable_p = (fstat (ifd, &st) >= 0);
1770 #ifndef WIN32_NATIVE
1771 if (out_st.st_mode != 0
1772 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
1775 report_file_error ("Input and output files are the same",
1776 list2 (filename, newname));
1780 #if defined (S_ISREG) && defined (S_ISLNK)
1781 if (input_file_statable_p)
1783 if (!(S_ISREG (st.st_mode))
1784 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
1786 && !(S_ISCHR (st.st_mode))
1788 && !(S_ISLNK (st.st_mode)))
1790 #if defined (EISDIR)
1791 /* Get a better looking error message. */
1794 report_file_error ("Non-regular file", list1 (filename));
1797 #endif /* S_ISREG && S_ISLNK */
1799 ofd = open( (char *) XSTRING_DATA (newname),
1800 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
1802 report_file_error ("Opening output file", list1 (newname));
1805 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil);
1807 record_unwind_protect (close_file_unwind, ofd_locative);
1809 while ((n = read_allowing_quit (ifd, buf, sizeof (buf))) > 0)
1811 if (write_allowing_quit (ofd, buf, n) != n)
1812 report_file_error ("I/O error", list1 (newname));
1815 /* Closing the output clobbers the file times on some systems. */
1816 if (close (ofd) < 0)
1817 report_file_error ("I/O error", list1 (newname));
1819 if (input_file_statable_p)
1821 if (!NILP (keep_time))
1823 EMACS_TIME atime, mtime;
1824 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
1825 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
1826 if (lisp_string_set_file_times (newname, atime, mtime))
1827 report_file_error ("I/O error", list1 (newname));
1829 chmod ((const char *) XSTRING_DATA (newname),
1830 st.st_mode & 07777);
1833 /* We'll close it by hand */
1834 XCAR (ofd_locative) = Qnil;
1837 unbind_to (speccount, Qnil);
1844 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
1845 Create a directory. One argument, a file name string.
1849 /* This function can GC. GC checked 1997.04.06. */
1850 char dir [MAXPATHLEN];
1851 Lisp_Object handler;
1852 struct gcpro gcpro1;
1854 CHECK_STRING (dirname_);
1855 dirname_ = Fexpand_file_name (dirname_, Qnil);
1858 handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal);
1860 if (!NILP (handler))
1861 return (call2 (handler, Qmake_directory_internal, dirname_));
1863 if (XSTRING_LENGTH (dirname_) > (Bytecount) (sizeof (dir) - 1))
1865 return Fsignal (Qfile_error,
1866 list3 (build_translated_string ("Creating directory"),
1867 build_translated_string ("pathname too long"),
1870 strncpy (dir, (char *) XSTRING_DATA (dirname_),
1871 XSTRING_LENGTH (dirname_) + 1);
1873 if (dir [XSTRING_LENGTH (dirname_) - 1] == '/')
1874 dir [XSTRING_LENGTH (dirname_) - 1] = 0;
1876 if (mkdir (dir, 0777) != 0)
1877 report_file_error ("Creating directory", list1 (dirname_));
1882 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
1883 Delete a directory. One argument, a file name or directory name string.
1887 /* This function can GC. GC checked 1997.04.06. */
1888 Lisp_Object handler;
1889 struct gcpro gcpro1;
1891 CHECK_STRING (dirname_);
1894 dirname_ = Fexpand_file_name (dirname_, Qnil);
1895 dirname_ = Fdirectory_file_name (dirname_);
1897 handler = Ffind_file_name_handler (dirname_, Qdelete_directory);
1899 if (!NILP (handler))
1900 return (call2 (handler, Qdelete_directory, dirname_));
1902 if (rmdir ((char *) XSTRING_DATA (dirname_)) != 0)
1903 report_file_error ("Removing directory", list1 (dirname_));
1908 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
1909 Delete the file named FILENAME (a string).
1910 If FILENAME has multiple names, it continues to exist with the other names.
1914 /* This function can GC. GC checked 1997.04.06. */
1915 Lisp_Object handler;
1916 struct gcpro gcpro1;
1918 CHECK_STRING (filename);
1919 filename = Fexpand_file_name (filename, Qnil);
1922 handler = Ffind_file_name_handler (filename, Qdelete_file);
1924 if (!NILP (handler))
1925 return call2 (handler, Qdelete_file, filename);
1927 if (0 > unlink ((char *) XSTRING_DATA (filename)))
1928 report_file_error ("Removing old name", list1 (filename));
1933 internal_delete_file_1 (Lisp_Object ignore, Lisp_Object ignore2)
1938 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1941 internal_delete_file (Lisp_Object filename)
1943 /* This function can GC. GC checked 1997.04.06. */
1944 return NILP (condition_case_1 (Qt, Fdelete_file, filename,
1945 internal_delete_file_1, Qnil));
1948 DEFUN ("rename-file", Frename_file, 2, 3,
1949 "fRename file: \nFRename %s to file: \np", /*
1950 Rename FILENAME as NEWNAME. Both args must be strings.
1951 If file has names other than FILENAME, it continues to have those names.
1952 Signals a `file-already-exists' error if a file NEWNAME already exists
1953 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1954 A number as third arg means request confirmation if NEWNAME already exists.
1955 This is what happens in interactive use with M-x.
1957 (filename, newname, ok_if_already_exists))
1959 /* This function can GC. GC checked 1997.04.06. */
1960 Lisp_Object handler;
1961 struct gcpro gcpro1, gcpro2;
1963 GCPRO2 (filename, newname);
1964 CHECK_STRING (filename);
1965 CHECK_STRING (newname);
1966 filename = Fexpand_file_name (filename, Qnil);
1967 newname = Fexpand_file_name (newname, Qnil);
1969 /* If the file name has special constructs in it,
1970 call the corresponding file handler. */
1971 handler = Ffind_file_name_handler (filename, Qrename_file);
1973 handler = Ffind_file_name_handler (newname, Qrename_file);
1974 if (!NILP (handler))
1977 return call4 (handler, Qrename_file,
1978 filename, newname, ok_if_already_exists);
1981 /* When second argument is a directory, rename the file into it.
1982 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
1984 if (!NILP (Ffile_directory_p (newname)))
1986 Lisp_Object args[3];
1987 struct gcpro ngcpro1;
1991 args[1] = Qnil; args[2] = Qnil;
1994 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
1995 args[i++] = build_string ("/");
1996 args[i++] = Ffile_name_nondirectory (filename);
1997 newname = Fconcat (i, args);
2001 if (NILP (ok_if_already_exists)
2002 || INTP (ok_if_already_exists))
2003 barf_or_query_if_file_exists (newname, "rename to it",
2004 INTP (ok_if_already_exists), 0);
2006 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
2007 WIN32_NATIVE here; I've removed it. --marcpa */
2009 /* We have configure check for rename() and emulate using
2010 link()/unlink() if necessary. */
2011 if (0 > rename ((char *) XSTRING_DATA (filename),
2012 (char *) XSTRING_DATA (newname)))
2016 Fcopy_file (filename, newname,
2017 /* We have already prompted if it was an integer,
2018 so don't have copy-file prompt again. */
2019 (NILP (ok_if_already_exists) ? Qnil : Qt),
2021 Fdelete_file (filename);
2025 report_file_error ("Renaming", list2 (filename, newname));
2032 DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3,
2033 "fAdd name to file: \nFName to add to %s: \np", /*
2034 Give FILENAME additional name NEWNAME. Both args must be strings.
2035 Signals a `file-already-exists' error if a file NEWNAME already exists
2036 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2037 A number as third arg means request confirmation if NEWNAME already exists.
2038 This is what happens in interactive use with M-x.
2040 (filename, newname, ok_if_already_exists))
2042 /* This function can GC. GC checked 1997.04.06. */
2043 Lisp_Object handler;
2044 struct gcpro gcpro1, gcpro2;
2046 GCPRO2 (filename, newname);
2047 CHECK_STRING (filename);
2048 CHECK_STRING (newname);
2049 filename = Fexpand_file_name (filename, Qnil);
2050 newname = Fexpand_file_name (newname, Qnil);
2052 /* If the file name has special constructs in it,
2053 call the corresponding file handler. */
2054 handler = Ffind_file_name_handler (filename, Qadd_name_to_file);
2055 if (!NILP (handler))
2056 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2057 newname, ok_if_already_exists));
2059 /* If the new name has special constructs in it,
2060 call the corresponding file handler. */
2061 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2062 if (!NILP (handler))
2063 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2064 newname, ok_if_already_exists));
2066 if (NILP (ok_if_already_exists)
2067 || INTP (ok_if_already_exists))
2068 barf_or_query_if_file_exists (newname, "make it a new name",
2069 INTP (ok_if_already_exists), 0);
2070 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
2071 on NT here. --marcpa */
2072 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
2073 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
2074 Reverted to previous behavior pending a working fix. (jhar) */
2075 #if defined(WIN32_NATIVE)
2076 /* Windows does not support this operation. */
2077 report_file_error ("Adding new name", Flist (2, &filename));
2078 #else /* not defined(WIN32_NATIVE) */
2080 unlink ((char *) XSTRING_DATA (newname));
2081 if (0 > link ((char *) XSTRING_DATA (filename),
2082 (char *) XSTRING_DATA (newname)))
2084 report_file_error ("Adding new name",
2085 list2 (filename, newname));
2087 #endif /* defined(WIN32_NATIVE) */
2093 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3,
2094 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
2095 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2096 Signals a `file-already-exists' error if a file LINKNAME already exists
2097 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2098 A number as third arg means request confirmation if LINKNAME already exists.
2099 This happens for interactive use with M-x.
2101 (filename, linkname, ok_if_already_exists))
2103 /* This function can GC. GC checked 1997.06.04. */
2104 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2105 Lisp_Object handler;
2106 struct gcpro gcpro1, gcpro2;
2108 GCPRO2 (filename, linkname);
2109 CHECK_STRING (filename);
2110 CHECK_STRING (linkname);
2111 /* If the link target has a ~, we must expand it to get
2112 a truly valid file name. Otherwise, do not expand;
2113 we want to permit links to relative file names. */
2114 if (XSTRING_BYTE (filename, 0) == '~')
2115 filename = Fexpand_file_name (filename, Qnil);
2116 linkname = Fexpand_file_name (linkname, Qnil);
2118 /* If the file name has special constructs in it,
2119 call the corresponding file handler. */
2120 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
2121 if (!NILP (handler))
2122 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname,
2123 ok_if_already_exists));
2125 /* If the new link name has special constructs in it,
2126 call the corresponding file handler. */
2127 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2128 if (!NILP (handler))
2129 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2130 linkname, ok_if_already_exists));
2133 if (NILP (ok_if_already_exists)
2134 || INTP (ok_if_already_exists))
2135 barf_or_query_if_file_exists (linkname, "make it a link",
2136 INTP (ok_if_already_exists), 0);
2138 unlink ((char *) XSTRING_DATA (linkname));
2139 if (0 > symlink ((char *) XSTRING_DATA (filename),
2140 (char *) XSTRING_DATA (linkname)))
2142 report_file_error ("Making symbolic link",
2143 list2 (filename, linkname));
2145 #endif /* S_IFLNK */
2153 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
2154 Open a network connection to PATH using LOGIN as the login string.
2159 const char *path_ext;
2160 const char *login_ext;
2162 CHECK_STRING (path);
2163 CHECK_STRING (login);
2165 /* netunam, being a strange-o system call only used once, is not
2168 LISP_STRING_TO_EXTERNAL (path, path_ext, Qfile_name);
2169 LISP_STRING_TO_EXTERNAL (login, login_ext, Qnative);
2171 netresult = netunam (path_ext, login_ext);
2173 return netresult == -1 ? Qnil : Qt;
2175 #endif /* HPUX_NET */
2177 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
2178 Return t if file FILENAME specifies an absolute path name.
2179 On Unix, this is a name starting with a `/' or a `~'.
2183 /* This function does not GC */
2186 CHECK_STRING (filename);
2187 ptr = XSTRING_DATA (filename);
2188 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
2190 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
2195 /* Return nonzero if file FILENAME exists and can be executed. */
2198 check_executable (char *filename)
2202 if (xemacs_stat (filename, &st) < 0)
2204 return ((st.st_mode & S_IEXEC) != 0);
2205 #else /* not WIN32_NATIVE */
2207 return eaccess (filename, X_OK) >= 0;
2209 /* Access isn't quite right because it uses the real uid
2210 and we really want to test with the effective uid.
2211 But Unix doesn't give us a right way to do it. */
2212 return access (filename, X_OK) >= 0;
2213 #endif /* HAVE_EACCESS */
2214 #endif /* not WIN32_NATIVE */
2217 /* Return nonzero if file FILENAME exists and can be written. */
2220 check_writable (const char *filename)
2223 return (eaccess (filename, W_OK) >= 0);
2225 /* Access isn't quite right because it uses the real uid
2226 and we really want to test with the effective uid.
2227 But Unix doesn't give us a right way to do it.
2228 Opening with O_WRONLY could work for an ordinary file,
2229 but would lose for directories. */
2230 return (access (filename, W_OK) >= 0);
2234 DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
2235 Return t if file FILENAME exists. (This does not mean you can read it.)
2236 See also `file-readable-p' and `file-attributes'.
2240 /* This function can call lisp; GC checked 2000-07-11 ben */
2241 Lisp_Object abspath;
2242 Lisp_Object handler;
2243 struct stat statbuf;
2244 struct gcpro gcpro1;
2246 CHECK_STRING (filename);
2247 abspath = Fexpand_file_name (filename, Qnil);
2249 /* If the file name has special constructs in it,
2250 call the corresponding file handler. */
2252 handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
2254 if (!NILP (handler))
2255 return call2 (handler, Qfile_exists_p, abspath);
2257 return xemacs_stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
2260 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
2261 Return t if FILENAME can be executed by you.
2262 For a directory, this means you can access files in that directory.
2267 /* This function can GC. GC checked 07-11-2000 ben. */
2268 Lisp_Object abspath;
2269 Lisp_Object handler;
2270 struct gcpro gcpro1;
2272 CHECK_STRING (filename);
2273 abspath = Fexpand_file_name (filename, Qnil);
2275 /* If the file name has special constructs in it,
2276 call the corresponding file handler. */
2278 handler = Ffind_file_name_handler (abspath, Qfile_executable_p);
2280 if (!NILP (handler))
2281 return call2 (handler, Qfile_executable_p, abspath);
2283 return check_executable ((char *) XSTRING_DATA (abspath)) ? Qt : Qnil;
2286 DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
2287 Return t if file FILENAME exists and you can read it.
2288 See also `file-exists-p' and `file-attributes'.
2292 /* This function can GC */
2293 Lisp_Object abspath = Qnil;
2294 Lisp_Object handler;
2295 struct gcpro gcpro1;
2298 CHECK_STRING (filename);
2299 abspath = Fexpand_file_name (filename, Qnil);
2301 /* If the file name has special constructs in it,
2302 call the corresponding file handler. */
2303 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
2304 if (!NILP (handler))
2305 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
2307 #if defined(WIN32_NATIVE) || defined(CYGWIN)
2308 /* Under MS-DOS and Windows, open does not work for directories. */
2310 if (access (XSTRING_DATA (abspath), 0) == 0)
2314 #else /* not WIN32_NATIVE */
2316 int desc = interruptible_open ((char *) XSTRING_DATA (abspath), O_RDONLY | OPEN_BINARY, 0);
2323 #endif /* not WIN32_NATIVE */
2326 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2328 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
2329 Return t if file FILENAME can be written or created by you.
2333 /* This function can GC. GC checked 1997.04.10. */
2334 Lisp_Object abspath, dir;
2335 Lisp_Object handler;
2336 struct stat statbuf;
2337 struct gcpro gcpro1;
2339 CHECK_STRING (filename);
2340 abspath = Fexpand_file_name (filename, Qnil);
2342 /* If the file name has special constructs in it,
2343 call the corresponding file handler. */
2345 handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
2347 if (!NILP (handler))
2348 return call2 (handler, Qfile_writable_p, abspath);
2350 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0)
2351 return (check_writable ((char *) XSTRING_DATA (abspath))
2356 dir = Ffile_name_directory (abspath);
2358 return (check_writable (!NILP (dir) ? (char *) XSTRING_DATA (dir)
2363 DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
2364 Return non-nil if file FILENAME is the name of a symbolic link.
2365 The value is the name of the file to which it is linked.
2366 Otherwise returns nil.
2370 /* This function can GC. GC checked 1997.04.10. */
2371 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2378 Lisp_Object handler;
2379 struct gcpro gcpro1;
2381 CHECK_STRING (filename);
2382 filename = Fexpand_file_name (filename, Qnil);
2384 /* If the file name has special constructs in it,
2385 call the corresponding file handler. */
2387 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
2389 if (!NILP (handler))
2390 return call2 (handler, Qfile_symlink_p, filename);
2396 buf = xnew_array_and_zero (char, bufsize);
2397 valsize = readlink ((char *) XSTRING_DATA (filename),
2399 if (valsize < bufsize) break;
2400 /* Buffer was not long enough */
2409 val = make_string ((Bufbyte *) buf, valsize);
2412 #else /* not S_IFLNK */
2414 #endif /* not S_IFLNK */
2417 DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
2418 Return t if file FILENAME is the name of a directory as a file.
2419 A directory name spec may be given instead; then the value is t
2420 if the directory so specified exists and really is a directory.
2424 /* This function can GC. GC checked 1997.04.10. */
2425 Lisp_Object abspath;
2427 Lisp_Object handler;
2428 struct gcpro gcpro1;
2430 GCPRO1 (current_buffer->directory);
2431 abspath = expand_and_dir_to_file (filename,
2432 current_buffer->directory);
2435 /* If the file name has special constructs in it,
2436 call the corresponding file handler. */
2438 handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
2440 if (!NILP (handler))
2441 return call2 (handler, Qfile_directory_p, abspath);
2443 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2445 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2448 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
2449 Return t if file FILENAME is the name of a directory as a file,
2450 and files in that directory can be opened by you. In order to use a
2451 directory as a buffer's current directory, this predicate must return true.
2452 A directory name spec may be given instead; then the value is t
2453 if the directory so specified exists and really is a readable and
2454 searchable directory.
2458 /* This function can GC. GC checked 1997.04.10. */
2459 Lisp_Object handler;
2461 /* If the file name has special constructs in it,
2462 call the corresponding file handler. */
2463 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
2464 if (!NILP (handler))
2465 return call2 (handler, Qfile_accessible_directory_p,
2468 #if !defined(WIN32_NATIVE)
2469 if (NILP (Ffile_directory_p (filename)))
2472 return Ffile_executable_p (filename);
2476 struct gcpro gcpro1;
2477 /* It's an unlikely combination, but yes we really do need to gcpro:
2478 Suppose that file-accessible-directory-p has no handler, but
2479 file-directory-p does have a handler; this handler causes a GC which
2480 relocates the string in `filename'; and finally file-directory-p
2481 returns non-nil. Then we would end up passing a garbaged string
2482 to file-executable-p. */
2484 tem = (NILP (Ffile_directory_p (filename))
2485 || NILP (Ffile_executable_p (filename)));
2487 return tem ? Qnil : Qt;
2489 #endif /* !defined(WIN32_NATIVE) */
2492 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
2493 Return t if file FILENAME is the name of a regular file.
2494 This is the sort of file that holds an ordinary stream of data bytes.
2498 /* This function can GC. GC checked 1997.04.10. */
2499 Lisp_Object abspath;
2501 Lisp_Object handler;
2502 struct gcpro gcpro1;
2504 GCPRO1 (current_buffer->directory);
2505 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
2508 /* If the file name has special constructs in it,
2509 call the corresponding file handler. */
2511 handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
2513 if (!NILP (handler))
2514 return call2 (handler, Qfile_regular_p, abspath);
2516 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2518 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2521 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
2522 Return mode bits of file named FILENAME, as an integer.
2526 /* This function can GC. GC checked 1997.04.10. */
2527 Lisp_Object abspath;
2529 Lisp_Object handler;
2530 struct gcpro gcpro1;
2532 GCPRO1 (current_buffer->directory);
2533 abspath = expand_and_dir_to_file (filename,
2534 current_buffer->directory);
2537 /* If the file name has special constructs in it,
2538 call the corresponding file handler. */
2540 handler = Ffind_file_name_handler (abspath, Qfile_modes);
2542 if (!NILP (handler))
2543 return call2 (handler, Qfile_modes, abspath);
2545 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2547 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
2550 if (check_executable (XSTRING_DATA (abspath)))
2551 st.st_mode |= S_IEXEC;
2552 #endif /* WIN32_NATIVE */
2555 return make_int (st.st_mode & 07777);
2558 DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /*
2559 Set mode bits of file named FILENAME to MODE (an integer).
2560 Only the 12 low bits of MODE are used.
2564 /* This function can GC. GC checked 1997.04.10. */
2565 Lisp_Object abspath;
2566 Lisp_Object handler;
2567 struct gcpro gcpro1;
2569 GCPRO1 (current_buffer->directory);
2570 abspath = Fexpand_file_name (filename, current_buffer->directory);
2575 /* If the file name has special constructs in it,
2576 call the corresponding file handler. */
2578 handler = Ffind_file_name_handler (abspath, Qset_file_modes);
2580 if (!NILP (handler))
2581 return call3 (handler, Qset_file_modes, abspath, mode);
2583 if (chmod ((char *) XSTRING_DATA (abspath), XINT (mode)) < 0)
2584 report_file_error ("Doing chmod", list1 (abspath));
2589 DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
2590 Set the file permission bits for newly created files.
2591 The argument MODE should be an integer; if a bit in MODE is 1,
2592 subsequently created files will not have the permission corresponding
2593 to that bit enabled. Only the low 9 bits are used.
2594 This setting is inherited by subprocesses.
2600 umask ((~ XINT (mode)) & 0777);
2605 DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
2606 Return the default file protection for created files.
2607 The umask value determines which permissions are enabled in newly
2608 created files. If a permission's bit in the umask is 1, subsequently
2609 created files will not have that permission enabled.
2618 return make_int ((~ mode) & 0777);
2621 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /*
2622 Tell Unix to finish all pending disk updates.
2626 #ifndef WIN32_NATIVE
2633 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
2634 Return t if file FILE1 is newer than file FILE2.
2635 If FILE1 does not exist, the answer is nil;
2636 otherwise, if FILE2 does not exist, the answer is t.
2640 /* This function can GC. GC checked 1997.04.10. */
2641 Lisp_Object abspath1, abspath2;
2644 Lisp_Object handler;
2645 struct gcpro gcpro1, gcpro2, gcpro3;
2647 CHECK_STRING (file1);
2648 CHECK_STRING (file2);
2653 GCPRO3 (abspath1, abspath2, current_buffer->directory);
2654 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
2655 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
2657 /* If the file name has special constructs in it,
2658 call the corresponding file handler. */
2659 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p);
2661 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p);
2663 if (!NILP (handler))
2664 return call3 (handler, Qfile_newer_than_file_p, abspath1,
2667 if (xemacs_stat ((char *) XSTRING_DATA (abspath1), &st) < 0)
2670 mtime1 = st.st_mtime;
2672 if (xemacs_stat ((char *) XSTRING_DATA (abspath2), &st) < 0)
2675 return (mtime1 > st.st_mtime) ? Qt : Qnil;
2679 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
2680 /* #define READ_BUF_SIZE (2 << 16) */
2681 #define READ_BUF_SIZE (1 << 15)
2683 DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal,
2685 Insert contents of file FILENAME after point; no coding-system frobbing.
2686 This function is identical to `insert-file-contents' except for the
2687 handling of the CODESYS and USED-CODESYS arguments under
2688 XEmacs/Mule. (When Mule support is not present, both functions are
2689 identical and ignore the CODESYS and USED-CODESYS arguments.)
2691 If support for Mule exists in this Emacs, the file is decoded according
2692 to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil,
2693 it should be a symbol, and the actual coding system that was used for the
2694 decoding is stored into it. It will in general be different from CODESYS
2695 if CODESYS specifies automatic encoding detection or end-of-line detection.
2697 Currently START and END refer to byte positions (as opposed to character
2698 positions), even in Mule. (Fixing this is very difficult.)
2700 (filename, visit, start, end, replace, codesys, used_codesys))
2702 /* This function can call lisp */
2706 Charcount inserted = 0;
2708 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2709 Lisp_Object handler = Qnil, val;
2711 Bufbyte read_buf[READ_BUF_SIZE];
2713 struct buffer *buf = current_buffer;
2715 int not_regular = 0;
2717 if (buf->base_buffer && ! NILP (visit))
2718 error ("Cannot do file visiting in an indirect buffer");
2720 /* No need to call Fbarf_if_buffer_read_only() here.
2721 That's called in begin_multiple_change() or wherever. */
2725 /* #### dmoore - should probably check in various places to see if
2726 curbuf was killed and if so signal an error? */
2728 XSETBUFFER (curbuf, buf);
2730 GCPRO5 (filename, val, visit, handler, curbuf);
2732 mc_count = (NILP (replace)) ?
2733 begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) :
2734 begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf));
2736 speccount = specpdl_depth (); /* begin_multiple_change also adds
2737 an unwind_protect */
2739 filename = Fexpand_file_name (filename, Qnil);
2741 /* If the file name has special constructs in it,
2742 call the corresponding file handler. */
2743 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
2744 if (!NILP (handler))
2746 val = call6 (handler, Qinsert_file_contents, filename,
2747 visit, start, end, replace);
2752 if (!NILP (used_codesys))
2753 CHECK_SYMBOL (used_codesys);
2756 if ( (!NILP (start) || !NILP (end)) && !NILP (visit) )
2757 error ("Attempt to visit less than an entire file");
2761 if (xemacs_stat ((char *) XSTRING_DATA (filename), &st) < 0)
2763 if (fd >= 0) close (fd);
2766 report_file_error ("Opening input file", list1 (filename));
2772 /* Signal an error if we are accessing a non-regular file, with
2773 REPLACE, START or END being non-nil. */
2774 if (!S_ISREG (st.st_mode))
2781 if (!NILP (replace) || !NILP (start) || !NILP (end))
2783 end_multiple_change (buf, mc_count);
2786 (Fsignal (Qfile_error,
2787 list2 (build_translated_string("not a regular file"),
2791 #endif /* S_IFREG */
2803 if ((fd = interruptible_open ((char *) XSTRING_DATA (filename),
2804 O_RDONLY | OPEN_BINARY, 0)) < 0)
2808 /* Replacement should preserve point as it preserves markers. */
2809 if (!NILP (replace))
2810 record_unwind_protect (restore_point_unwind, Fpoint_marker (Qnil, Qnil));
2812 record_unwind_protect (close_file_unwind, make_int (fd));
2814 /* Supposedly happens on VMS. */
2816 error ("File size is negative");
2822 end = make_int (st.st_size);
2823 if (XINT (end) != st.st_size)
2824 error ("Maximum buffer size exceeded");
2828 /* If requested, replace the accessible part of the buffer
2829 with the file contents. Avoid replacing text at the
2830 beginning or end of the buffer that matches the file contents;
2831 that preserves markers pointing to the unchanged parts. */
2832 #if !defined (FILE_CODING)
2833 /* The replace-mode code currently only works when the assumption
2834 'one byte == one char' holds true. This fails Mule because
2835 files may contain multibyte characters. It holds under Windows NT
2836 provided we convert CRLF into LF. */
2837 # define FSFMACS_SPEEDY_INSERT
2838 #endif /* !defined (FILE_CODING) */
2840 #ifndef FSFMACS_SPEEDY_INSERT
2841 if (!NILP (replace))
2843 buffer_delete_range (buf, BUF_BEG (buf), BUF_Z (buf),
2844 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2846 #else /* FSFMACS_SPEEDY_INSERT */
2847 if (!NILP (replace))
2849 char buffer[1 << 14];
2850 Bufpos same_at_start = BUF_BEGV (buf);
2851 Bufpos same_at_end = BUF_ZV (buf);
2854 /* Count how many chars at the start of the file
2855 match the text at the beginning of the buffer. */
2860 nread = read_allowing_quit (fd, buffer, sizeof buffer);
2862 error ("IO error reading %s: %s",
2863 XSTRING_DATA (filename), strerror (errno));
2864 else if (nread == 0)
2867 while (bufpos < nread && same_at_start < BUF_ZV (buf)
2868 && BUF_FETCH_CHAR (buf, same_at_start) == buffer[bufpos])
2869 same_at_start++, bufpos++;
2870 /* If we found a discrepancy, stop the scan.
2871 Otherwise loop around and scan the next bufferful. */
2872 if (bufpos != nread)
2875 /* If the file matches the buffer completely,
2876 there's no need to replace anything. */
2877 if (same_at_start - BUF_BEGV (buf) == st.st_size)
2880 unbind_to (speccount, Qnil);
2881 /* Truncate the buffer to the size of the file. */
2882 buffer_delete_range (buf, same_at_start, same_at_end,
2883 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2886 /* Count how many chars at the end of the file
2887 match the text at the end of the buffer. */
2890 int total_read, nread;
2891 Bufpos bufpos, curpos, trial;
2893 /* At what file position are we now scanning? */
2894 curpos = st.st_size - (BUF_ZV (buf) - same_at_end);
2895 /* If the entire file matches the buffer tail, stop the scan. */
2898 /* How much can we scan in the next step? */
2899 trial = min (curpos, (Bufpos) sizeof (buffer));
2900 if (lseek (fd, curpos - trial, 0) < 0)
2901 report_file_error ("Setting file position", list1 (filename));
2904 while (total_read < trial)
2906 nread = read_allowing_quit (fd, buffer + total_read,
2907 trial - total_read);
2909 report_file_error ("IO error reading file", list1 (filename));
2910 total_read += nread;
2912 /* Scan this bufferful from the end, comparing with
2913 the Emacs buffer. */
2914 bufpos = total_read;
2915 /* Compare with same_at_start to avoid counting some buffer text
2916 as matching both at the file's beginning and at the end. */
2917 while (bufpos > 0 && same_at_end > same_at_start
2918 && BUF_FETCH_CHAR (buf, same_at_end - 1) ==
2920 same_at_end--, bufpos--;
2921 /* If we found a discrepancy, stop the scan.
2922 Otherwise loop around and scan the preceding bufferful. */
2925 /* If display current starts at beginning of line,
2926 keep it that way. */
2927 if (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == buf)
2928 XWINDOW (Fselected_window (Qnil))->start_at_line_beg =
2929 !NILP (Fbolp (make_buffer (buf)));
2932 /* Don't try to reuse the same piece of text twice. */
2933 overlap = same_at_start - BUF_BEGV (buf) -
2934 (same_at_end + st.st_size - BUF_ZV (buf));
2936 same_at_end += overlap;
2938 /* Arrange to read only the nonmatching middle part of the file. */
2939 start = make_int (same_at_start - BUF_BEGV (buf));
2940 end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end));
2942 buffer_delete_range (buf, same_at_start, same_at_end,
2943 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2944 /* Insert from the file at the proper position. */
2945 BUF_SET_PT (buf, same_at_start);
2947 #endif /* FSFMACS_SPEEDY_INSERT */
2951 total = XINT (end) - XINT (start);
2953 /* Make sure point-max won't overflow after this insertion. */
2954 if (total != XINT (make_int (total)))
2955 error ("Maximum buffer size exceeded");
2958 /* For a special file, all we can do is guess. The value of -1
2959 will make the stream functions read as much as possible. */
2962 if (XINT (start) != 0
2963 #ifdef FSFMACS_SPEEDY_INSERT
2964 /* why was this here? asked jwz. The reason is that the replace-mode
2965 connivings above will normally put the file pointer other than
2966 where it should be. */
2968 #endif /* !FSFMACS_SPEEDY_INSERT */
2971 if (lseek (fd, XINT (start), 0) < 0)
2972 report_file_error ("Setting file position", list1 (filename));
2976 Bufpos cur_point = BUF_PT (buf);
2977 struct gcpro ngcpro1;
2978 Lisp_Object stream = make_filedesc_input_stream (fd, 0, total,
2982 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2984 stream = make_decoding_input_stream
2985 (XLSTREAM (stream), Fget_coding_system (codesys));
2986 Lstream_set_character_mode (XLSTREAM (stream));
2987 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2988 #endif /* FILE_CODING */
2990 record_unwind_protect (delete_stream_unwind, stream);
2992 /* No need to limit the amount of stuff we attempt to read. (It would
2993 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
2994 occurs inside of the filedesc stream. */
2998 Charcount cc_inserted;
3001 this_len = Lstream_read (XLSTREAM (stream), read_buf,
3011 cc_inserted = buffer_insert_raw_string_1 (buf, cur_point, read_buf,
3014 ? INSDEL_NO_LOCKING : 0);
3015 inserted += cc_inserted;
3016 cur_point += cc_inserted;
3019 if (!NILP (used_codesys))
3022 XCODING_SYSTEM_NAME (decoding_stream_coding_system (XLSTREAM (stream))));
3024 #endif /* FILE_CODING */
3028 /* Close the file/stream */
3029 unbind_to (speccount, Qnil);
3033 error ("IO error reading %s: %s",
3034 XSTRING_DATA (filename), strerror (saverrno));
3040 end_multiple_change (buf, mc_count);
3044 if (!EQ (buf->undo_list, Qt))
3045 buf->undo_list = Qnil;
3048 buf->modtime = st.st_mtime;
3049 buf->filename = filename;
3050 /* XEmacs addition: */
3051 /* This function used to be in C, ostensibly so that
3052 it could be called here. But that's just silly.
3053 There's no reason C code can't call out to Lisp
3054 code, and it's a lot cleaner this way. */
3055 /* Note: compute-buffer-file-truename is called for
3056 side-effect! Its return value is intentionally
3058 if (!NILP (Ffboundp (Qcompute_buffer_file_truename)))
3059 call1 (Qcompute_buffer_file_truename, make_buffer (buf));
3061 BUF_SAVE_MODIFF (buf) = BUF_MODIFF (buf);
3062 buf->auto_save_modified = BUF_MODIFF (buf);
3063 buf->saved_size = make_int (BUF_SIZE (buf));
3064 #ifdef CLASH_DETECTION
3067 if (!NILP (buf->file_truename))
3068 unlock_file (buf->file_truename);
3069 unlock_file (filename);
3071 #endif /* CLASH_DETECTION */
3073 RETURN_UNGCPRO (Fsignal (Qfile_error,
3074 list2 (build_string ("not a regular file"),
3077 /* If visiting nonexistent file, return nil. */
3078 if (buf->modtime == -1)
3079 report_file_error ("Opening input file",
3083 /* Decode file format */
3086 Lisp_Object insval = call3 (Qformat_decode,
3087 Qnil, make_int (inserted), visit);
3089 inserted = XINT (insval);
3095 struct gcpro ngcpro1;
3098 EXTERNAL_LIST_LOOP (p, Vafter_insert_file_functions)
3100 Lisp_Object insval =
3101 call1 (XCAR (p), make_int (inserted));
3104 CHECK_NATNUM (insval);
3105 inserted = XINT (insval);
3117 return (list2 (filename, make_int (inserted)));
3121 static int a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3122 Lisp_Object *annot);
3123 static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end);
3125 /* If build_annotations switched buffers, switch back to BUF.
3126 Kill the temporary buffer that was selected in the meantime. */
3129 build_annotations_unwind (Lisp_Object buf)
3133 if (XBUFFER (buf) == current_buffer)
3135 tembuf = Fcurrent_buffer ();
3137 Fkill_buffer (tembuf);
3141 DEFUN ("write-region-internal", Fwrite_region_internal, 3, 7,
3142 "r\nFWrite region to file: ", /*
3143 Write current region into specified file; no coding-system frobbing.
3144 This function is identical to `write-region' except for the handling
3145 of the CODESYS argument under XEmacs/Mule. (When Mule support is not
3146 present, both functions are identical and ignore the CODESYS argument.)
3147 If support for Mule exists in this Emacs, the file is encoded according
3148 to the value of CODESYS. If this is nil, no code conversion occurs.
3150 (start, end, filename, append, visit, lockname, codesys))
3152 /* This function can call lisp. GC checked 2000-07-28 ben */
3157 Lisp_Object fn = Qnil;
3158 int speccount = specpdl_depth ();
3159 int visiting_other = STRINGP (visit);
3160 int visiting = (EQ (visit, Qt) || visiting_other);
3161 int quietly = (!visiting && !NILP (visit));
3162 Lisp_Object visit_file = Qnil;
3163 Lisp_Object annotations = Qnil;
3164 struct buffer *given_buffer;
3165 Bufpos start1, end1;
3166 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3167 struct gcpro ngcpro1, ngcpro2;
3170 XSETBUFFER (curbuf, current_buffer);
3172 /* start, end, visit, and append are never modified in this fun
3173 so we don't protect them. */
3174 GCPRO5 (visit_file, filename, codesys, lockname, annotations);
3175 NGCPRO2 (curbuf, fn);
3177 /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
3178 we should signal an error rather than blissfully continuing
3179 along. ARGH, this function is going to lose lose lose. We need
3180 to protect the current_buffer from being destroyed, but the
3181 multiple return points make this a pain in the butt. ]] we do
3182 protect curbuf now. --ben */
3185 codesys = Fget_coding_system (codesys);
3186 #endif /* FILE_CODING */
3188 if (current_buffer->base_buffer && ! NILP (visit))
3189 invalid_operation ("Cannot do file visiting in an indirect buffer",
3192 if (!NILP (start) && !STRINGP (start))
3193 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0);
3196 Lisp_Object handler;
3199 visit_file = Fexpand_file_name (visit, Qnil);
3201 visit_file = filename;
3202 filename = Fexpand_file_name (filename, Qnil);
3204 if (NILP (lockname))
3205 lockname = visit_file;
3207 /* We used to UNGCPRO here. BAD! visit_file is used below after
3208 more Lisp calling. */
3209 /* If the file name has special constructs in it,
3210 call the corresponding file handler. */
3211 handler = Ffind_file_name_handler (filename, Qwrite_region);
3212 /* If FILENAME has no handler, see if VISIT has one. */
3213 if (NILP (handler) && STRINGP (visit))
3214 handler = Ffind_file_name_handler (visit, Qwrite_region);
3216 if (!NILP (handler))
3218 Lisp_Object val = call8 (handler, Qwrite_region, start, end,
3219 filename, append, visit, lockname, codesys);
3222 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3223 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3224 current_buffer->filename = visit_file;
3225 MARK_MODELINE_CHANGED;
3233 #ifdef CLASH_DETECTION
3235 lock_file (lockname);
3236 #endif /* CLASH_DETECTION */
3238 /* Special kludge to simplify auto-saving. */
3241 start1 = BUF_BEG (current_buffer);
3242 end1 = BUF_Z (current_buffer);
3245 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
3247 given_buffer = current_buffer;
3248 annotations = build_annotations (start, end);
3249 if (current_buffer != given_buffer)
3251 start1 = BUF_BEGV (current_buffer);
3252 end1 = BUF_ZV (current_buffer);
3259 desc = open ((char *) XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0);
3263 desc = open ((char *) XSTRING_DATA (fn),
3264 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
3265 auto_saving ? auto_save_mode_bits : CREAT_MODE);
3270 #ifdef CLASH_DETECTION
3272 if (!auto_saving) unlock_file (lockname);
3274 #endif /* CLASH_DETECTION */
3275 report_file_error ("Opening output file", list1 (filename));
3279 Lisp_Object desc_locative = Fcons (make_int (desc), Qnil);
3280 Lisp_Object instream = Qnil, outstream = Qnil;
3281 struct gcpro nngcpro1, nngcpro2;
3282 /* need to gcpro; QUIT could happen out of call to write() */
3283 NNGCPRO2 (instream, outstream);
3285 record_unwind_protect (close_file_unwind, desc_locative);
3289 if (lseek (desc, 0, 2) < 0)
3291 #ifdef CLASH_DETECTION
3292 if (!auto_saving) unlock_file (lockname);
3293 #endif /* CLASH_DETECTION */
3294 report_file_error ("Lseek error",
3301 /* Note: I tried increasing the buffering size, along with
3302 various other tricks, but nothing seemed to make much of
3303 a difference in the time it took to save a large file.
3304 (Actually that's not true. With a local disk, changing
3305 the buffer size doesn't seem to make much difference.
3306 With an NFS-mounted disk, it could make a lot of difference
3307 because you're affecting the number of network requests
3308 that need to be made, and there could be a large latency
3309 for each request. So I've increased the buffer size
3311 outstream = make_filedesc_output_stream (desc, 0, -1, 0);
3312 Lstream_set_buffering (XLSTREAM (outstream),
3313 LSTREAM_BLOCKN_BUFFERED, 65536);
3316 make_encoding_output_stream (XLSTREAM (outstream), codesys);
3317 Lstream_set_buffering (XLSTREAM (outstream),
3318 LSTREAM_BLOCKN_BUFFERED, 65536);
3319 #endif /* FILE_CODING */
3320 if (STRINGP (start))
3322 instream = make_lisp_string_input_stream (start, 0, -1);
3326 instream = make_lisp_buffer_input_stream (current_buffer, start1, end1,
3328 LSTR_IGNORE_ACCESSIBLE);
3329 failure = (0 > (a_write (outstream, instream, start1,
3332 /* Note that this doesn't close the desc since we created the
3333 stream without the LSTR_CLOSING flag, but it does
3334 flush out any buffered data. */
3335 if (Lstream_close (XLSTREAM (outstream)) < 0)
3340 Lstream_close (XLSTREAM (instream));
3343 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3344 Disk full in NFS may be reported here. */
3345 /* mib says that closing the file will try to write as fast as NFS can do
3346 it, and that means the fsync here is not crucial for autosave files. */
3347 if (!auto_saving && fsync (desc) < 0
3348 /* If fsync fails with EINTR, don't treat that as serious. */
3354 #endif /* HAVE_FSYNC */
3356 /* Spurious "file has changed on disk" warnings used to be seen on
3357 systems where close() can change the modtime. This is known to
3358 happen on various NFS file systems, on Windows, and on Linux.
3359 Rather than handling this on a per-system basis, we
3360 unconditionally do the xemacs_stat() after the close(). */
3362 /* NFS can report a write failure now. */
3363 if (close (desc) < 0)
3369 /* Discard the close unwind-protect. Execute the one for
3370 build_annotations (switches back to the original current buffer
3372 XCAR (desc_locative) = Qnil;
3373 unbind_to (speccount, Qnil);
3378 xemacs_stat ((char *) XSTRING_DATA (fn), &st);
3380 #ifdef CLASH_DETECTION
3382 unlock_file (lockname);
3383 #endif /* CLASH_DETECTION */
3385 /* Do this before reporting IO error
3386 to avoid a "file has changed on disk" warning on
3387 next attempt to save. */
3389 current_buffer->modtime = st.st_mtime;
3394 report_file_error ("Writing file", list1 (fn));
3399 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3400 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3401 current_buffer->filename = visit_file;
3402 MARK_MODELINE_CHANGED;
3414 message ("Wrote %s", XSTRING_DATA (visit_file));
3417 Lisp_Object fsp = Qnil;
3418 struct gcpro nngcpro1;
3421 fsp = Ffile_symlink_p (fn);
3423 message ("Wrote %s", XSTRING_DATA (fn));
3425 message ("Wrote %s (symlink to %s)",
3426 XSTRING_DATA (fn), XSTRING_DATA (fsp));
3435 /* #### This is such a load of shit!!!! There is no way we should define
3436 something so stupid as a subr, just sort the fucking list more
3438 DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3439 Return t if (car A) is numerically less than (car B).
3443 Lisp_Object objs[2];
3446 return Flss (2, objs);
3449 /* Heh heh heh, let's define this too, just to aggravate the person who
3450 wrote the above comment. */
3451 DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3452 Return t if (cdr A) is numerically less than (cdr B).
3456 Lisp_Object objs[2];
3459 return Flss (2, objs);
3462 /* Build the complete list of annotations appropriate for writing out
3463 the text between START and END, by calling all the functions in
3464 write-region-annotate-functions and merging the lists they return.
3465 If one of these functions switches to a different buffer, we assume
3466 that buffer contains altered text. Therefore, the caller must
3467 make sure to restore the current buffer in all cases,
3468 as save-excursion would do. */
3471 build_annotations (Lisp_Object start, Lisp_Object end)
3473 /* This function can GC */
3474 Lisp_Object annotations;
3476 struct gcpro gcpro1, gcpro2;
3477 Lisp_Object original_buffer;
3479 XSETBUFFER (original_buffer, current_buffer);
3482 p = Vwrite_region_annotate_functions;
3483 GCPRO2 (annotations, p);
3486 struct buffer *given_buffer = current_buffer;
3487 Vwrite_region_annotations_so_far = annotations;
3488 res = call2 (Fcar (p), start, end);
3489 /* If the function makes a different buffer current,
3490 assume that means this buffer contains altered text to be output.
3491 Reset START and END from the buffer bounds
3492 and discard all previous annotations because they should have
3493 been dealt with by this function. */
3494 if (current_buffer != given_buffer)
3496 start = make_int (BUF_BEGV (current_buffer));
3497 end = make_int (BUF_ZV (current_buffer));
3500 Flength (res); /* Check basic validity of return value */
3501 annotations = merge (annotations, res, Qcar_less_than_car);
3505 /* Now do the same for annotation functions implied by the file-format */
3506 if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
3507 p = Vauto_save_file_format;
3509 p = current_buffer->file_format;
3512 struct buffer *given_buffer = current_buffer;
3513 Vwrite_region_annotations_so_far = annotations;
3514 res = call4 (Qformat_annotate_function, Fcar (p), start, end,
3516 if (current_buffer != given_buffer)
3518 start = make_int (BUF_BEGV (current_buffer));
3519 end = make_int (BUF_ZV (current_buffer));
3523 annotations = merge (annotations, res, Qcar_less_than_car);
3530 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3531 EOF is encountered), assuming they start at position POS in the buffer
3532 of string that STREAM refers to. Intersperse with them the annotations
3533 from *ANNOT that fall into the range of positions we are reading from,
3534 each at its appropriate position.
3536 Modify *ANNOT by discarding elements as we output them.
3537 The return value is negative in case of system call failure. */
3539 /* 4K should probably be fine. We just need to reduce the number of
3540 function calls to reasonable level. The Lstream stuff itself will
3541 batch to 64K to reduce the number of system calls. */
3543 #define A_WRITE_BATCH_SIZE 4096
3546 a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3551 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3552 Lstream *instr = XLSTREAM (instream);
3553 Lstream *outstr = XLSTREAM (outstream);
3555 while (LISTP (*annot))
3557 tem = Fcar_safe (Fcar (*annot));
3559 nextpos = XINT (tem);
3563 /* If there are annotations left and we have Mule, then we
3564 have to do the I/O one emchar at a time so we can
3565 determine when to insert the annotation. */
3569 while (pos != nextpos && (ch = Lstream_get_emchar (instr)) != EOF)
3571 if (Lstream_put_emchar (outstr, ch) < 0)
3579 while (pos != nextpos)
3581 /* Otherwise there is no point to that. Just go in batches. */
3582 int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE);
3584 chunk = Lstream_read (instr, largebuf, chunk);
3587 if (chunk == 0) /* EOF */
3589 if (Lstream_write (outstr, largebuf, chunk) < chunk)
3596 tem = Fcdr (Fcar (*annot));
3599 if (Lstream_write (outstr, XSTRING_DATA (tem),
3600 XSTRING_LENGTH (tem)) < 0)
3603 *annot = Fcdr (*annot);
3614 #include <des_crypt.h>
3616 #define CRYPT_BLOCK_SIZE 8 /* bytes */
3617 #define CRYPT_KEY_SIZE 8 /* bytes */
3619 DEFUN ("encrypt-string", Fencrypt_string, 2, 2, 0, /*
3620 Encrypt STRING using KEY.
3624 char *encrypted_string, *raw_key;
3625 int rounded_size, extra, key_size;
3627 /* !!#### May produce bogus data under Mule. */
3628 CHECK_STRING (string);
3631 extra = XSTRING_LENGTH (string) % CRYPT_BLOCK_SIZE;
3632 rounded_size = XSTRING_LENGTH (string) + extra;
3633 encrypted_string = alloca (rounded_size + 1);
3634 memcpy (encrypted_string, XSTRING_DATA (string), XSTRING_LENGTH (string));
3635 memset (encrypted_string + rounded_size - extra, 0, extra + 1);
3637 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3639 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3640 memcpy (raw_key, XSTRING_DATA (key), key_size);
3641 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3643 ecb_crypt (raw_key, encrypted_string, rounded_size,
3644 DES_ENCRYPT | DES_SW);
3645 return make_string (encrypted_string, rounded_size);
3648 DEFUN ("decrypt-string", Fdecrypt_string, 2, 2, 0, /*
3649 Decrypt STRING using KEY.
3653 char *decrypted_string, *raw_key;
3654 int string_size, key_size;
3656 CHECK_STRING (string);
3659 string_size = XSTRING_LENGTH (string) + 1;
3660 decrypted_string = alloca (string_size);
3661 memcpy (decrypted_string, XSTRING_DATA (string), string_size);
3662 decrypted_string[string_size - 1] = '\0';
3664 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3666 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3667 memcpy (raw_key, XSTRING_DATA (key), key_size);
3668 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3671 ecb_crypt (raw_key, decrypted_string, string_size, D | DES_SW);
3672 return make_string (decrypted_string, string_size - 1);
3677 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
3678 Return t if last mod time of BUFFER's visited file matches what BUFFER records.
3679 This means that the file has not been changed since it was visited or saved.
3683 /* This function can call lisp; GC checked 2000-07-11 ben */
3686 Lisp_Object handler;
3688 CHECK_BUFFER (buffer);
3689 b = XBUFFER (buffer);
3691 if (!STRINGP (b->filename)) return Qt;
3692 if (b->modtime == 0) return Qt;
3694 /* If the file name has special constructs in it,
3695 call the corresponding file handler. */
3696 handler = Ffind_file_name_handler (b->filename,
3697 Qverify_visited_file_modtime);
3698 if (!NILP (handler))
3699 return call2 (handler, Qverify_visited_file_modtime, buffer);
3701 if (xemacs_stat ((char *) XSTRING_DATA (b->filename), &st) < 0)
3703 /* If the file doesn't exist now and didn't exist before,
3704 we say that it isn't modified, provided the error is a tame one. */
3705 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3710 if (st.st_mtime == b->modtime
3711 /* If both are positive, accept them if they are off by one second. */
3712 || (st.st_mtime > 0 && b->modtime > 0
3713 && (st.st_mtime == b->modtime + 1
3714 || st.st_mtime == b->modtime - 1)))
3719 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3720 Clear out records of last mod time of visited file.
3721 Next attempt to save will certainly not complain of a discrepancy.
3725 current_buffer->modtime = 0;
3729 DEFUN ("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3730 Return the current buffer's recorded visited file modification time.
3731 The value is a list of the form (HIGH . LOW), like the time values
3732 that `file-attributes' returns.
3736 return time_to_lisp ((time_t) current_buffer->modtime);
3739 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3740 Update buffer's recorded modification time from the visited file's time.
3741 Useful if the buffer was not read from the file normally
3742 or if the file itself has been changed for some known benign reason.
3743 An argument specifies the modification time value to use
3744 \(instead of that of the visited file), in the form of a list
3745 \(HIGH . LOW) or (HIGH LOW).
3749 /* This function can call lisp */
3750 if (!NILP (time_list))
3753 lisp_to_time (time_list, &the_time);
3754 current_buffer->modtime = (int) the_time;
3758 Lisp_Object filename = Qnil;
3760 Lisp_Object handler;
3761 struct gcpro gcpro1, gcpro2, gcpro3;
3763 GCPRO3 (filename, time_list, current_buffer->filename);
3764 filename = Fexpand_file_name (current_buffer->filename, Qnil);
3766 /* If the file name has special constructs in it,
3767 call the corresponding file handler. */
3768 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
3770 if (!NILP (handler))
3771 /* The handler can find the file name the same way we did. */
3772 return call2 (handler, Qset_visited_file_modtime, Qnil);
3773 else if (xemacs_stat ((char *) XSTRING_DATA (filename), &st) >= 0)
3774 current_buffer->modtime = st.st_mtime;
3781 auto_save_error (Lisp_Object condition_object, Lisp_Object ignored)
3783 /* This function can call lisp */
3786 /* Don't try printing an error message after everything is gone! */
3787 if (preparing_for_armageddon)
3789 clear_echo_area (selected_frame (), Qauto_saving, 1);
3790 Fding (Qt, Qauto_save_error, Qnil);
3791 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3792 Fsleep_for (make_int (1));
3793 message ("Auto-saving...error!for %s", XSTRING_DATA (current_buffer->name));
3794 Fsleep_for (make_int (1));
3795 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3796 Fsleep_for (make_int (1));
3801 auto_save_1 (Lisp_Object ignored)
3803 /* This function can call lisp */
3804 /* #### I think caller is protecting current_buffer? */
3806 Lisp_Object fn = current_buffer->filename;
3807 Lisp_Object a = current_buffer->auto_save_file_name;
3812 /* Get visited file's mode to become the auto save file's mode. */
3814 xemacs_stat ((char *) XSTRING_DATA (fn), &st) >= 0)
3815 /* But make sure we can overwrite it later! */
3816 auto_save_mode_bits = st.st_mode | 0600;
3818 /* default mode for auto-save files of buffers with no file is
3819 readable by owner only. This may annoy some small number of
3820 people, but the alternative removes all privacy from email. */
3821 auto_save_mode_bits = 0600;
3824 /* !!#### need to deal with this 'escape-quoted everywhere */
3825 Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil,
3835 auto_save_expand_name_error (Lisp_Object condition_object, Lisp_Object ignored)
3837 /* #### this function should spew an error message about not being
3838 able to open the .saves file. */
3843 auto_save_expand_name (Lisp_Object name)
3845 struct gcpro gcpro1;
3847 /* note that caller did NOT gc protect name, so we do it. */
3848 /* #### dmoore - this might not be necessary, if condition_case_1
3849 protects it. but I don't think it does. */
3851 RETURN_UNGCPRO (Fexpand_file_name (name, Qnil));
3856 do_auto_save_unwind (Lisp_Object fd)
3863 do_auto_save_unwind_2 (Lisp_Object old_auto_saving)
3865 auto_saving = XINT (old_auto_saving);
3869 /* Fdo_auto_save() checks whether a GC is in progress when it is called,
3870 and if so, tries to avoid touching lisp objects.
3872 The only time that Fdo_auto_save() is called while GC is in progress
3873 is if we're going down, as a result of an abort() or a kill signal.
3874 It's fairly important that we generate autosave files in that case!
3877 DEFUN ("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3878 Auto-save all buffers that need it.
3879 This is all buffers that have auto-saving enabled
3880 and are changed since last auto-saved.
3881 Auto-saving writes the buffer into a file
3882 so that your editing is not lost if the system crashes.
3883 This file is not the file you visited; that changes only when you save.
3884 Normally we run the normal hook `auto-save-hook' before saving.
3886 Non-nil first argument means do not print any message if successful.
3887 Non-nil second argument means save only current buffer.
3889 (no_message, current_only))
3891 /* This function can call lisp */
3893 Lisp_Object tail, buf;
3895 int do_handled_files;
3896 Lisp_Object oquit = Qnil;
3897 Lisp_Object listfile = Qnil;
3900 int speccount = specpdl_depth ();
3901 struct gcpro gcpro1, gcpro2, gcpro3;
3903 XSETBUFFER (old, current_buffer);
3904 GCPRO3 (oquit, listfile, old);
3905 check_quit (); /* make Vquit_flag accurate */
3906 /* Ordinarily don't quit within this function,
3907 but don't make it impossible to quit (in case we get hung in I/O). */
3911 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3912 variables point to non-strings reached from Vbuffer_alist. */
3914 if (minibuf_level != 0 || preparing_for_armageddon)
3917 run_hook (Qauto_save_hook);
3919 if (STRINGP (Vauto_save_list_file_name))
3920 listfile = condition_case_1 (Qt,
3921 auto_save_expand_name,
3922 Vauto_save_list_file_name,
3923 auto_save_expand_name_error, Qnil);
3925 /* Make sure auto_saving is reset. */
3926 record_unwind_protect (do_auto_save_unwind_2, make_int (auto_saving));
3930 /* First, save all files which don't have handlers. If Emacs is
3931 crashing, the handlers may tweak what is causing Emacs to crash
3932 in the first place, and it would be a shame if Emacs failed to
3933 autosave perfectly ordinary files because it couldn't handle some
3935 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
3937 for (tail = Vbuffer_alist;
3941 buf = XCDR (XCAR (tail));
3944 if (!NILP (current_only)
3945 && b != current_buffer)
3948 /* Don't auto-save indirect buffers.
3949 The base buffer takes care of it. */
3953 /* Check for auto save enabled
3954 and file changed since last auto save
3955 and file changed since last real save. */
3956 if (STRINGP (b->auto_save_file_name)
3957 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
3958 && b->auto_save_modified < BUF_MODIFF (b)
3959 /* -1 means we've turned off autosaving for a while--see below. */
3960 && XINT (b->saved_size) >= 0
3961 && (do_handled_files
3962 || NILP (Ffind_file_name_handler (b->auto_save_file_name,
3965 EMACS_TIME before_time, after_time;
3967 EMACS_GET_TIME (before_time);
3968 /* If we had a failure, don't try again for 20 minutes. */
3969 if (!preparing_for_armageddon
3970 && b->auto_save_failure_time >= 0
3971 && (EMACS_SECS (before_time) - b->auto_save_failure_time <
3975 if (!preparing_for_armageddon &&
3976 (XINT (b->saved_size) * 10
3977 > (BUF_Z (b) - BUF_BEG (b)) * 13)
3978 /* A short file is likely to change a large fraction;
3979 spare the user annoying messages. */
3980 && XINT (b->saved_size) > 5000
3981 /* These messages are frequent and annoying for `*mail*'. */
3982 && !NILP (b->filename)
3983 && NILP (no_message)
3984 && disable_auto_save_when_buffer_shrinks)
3986 /* It has shrunk too much; turn off auto-saving here.
3987 Unless we're about to crash, in which case auto-save it
3991 ("Buffer %s has shrunk a lot; auto save turned off there",
3992 XSTRING_DATA (b->name));
3993 /* Turn off auto-saving until there's a real save,
3994 and prevent any more warnings. */
3995 b->saved_size = make_int (-1);
3996 if (!gc_in_progress)
3997 Fsleep_for (make_int (1));
4000 set_buffer_internal (b);
4001 if (!auto_saved && NILP (no_message))
4003 static const unsigned char *msg
4004 = (const unsigned char *) "Auto-saving...";
4005 echo_area_message (selected_frame (), msg, Qnil,
4006 0, strlen ((const char *) msg),
4010 /* Open the auto-save list file, if necessary.
4011 We only do this now so that the file only exists
4012 if we actually auto-saved any files. */
4013 if (!auto_saved && !inhibit_auto_save_session
4014 && !NILP (Vauto_save_list_file_prefix)
4015 && STRINGP (listfile) && listdesc < 0)
4017 listdesc = open ((char *) XSTRING_DATA (listfile),
4018 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4021 /* Arrange to close that file whether or not we get
4024 record_unwind_protect (do_auto_save_unwind,
4025 make_int (listdesc));
4028 /* Record all the buffers that we are auto-saving in
4029 the special file that lists them. For each of
4030 these buffers, record visited name (if any) and
4034 const Extbyte *auto_save_file_name_ext;
4035 Extcount auto_save_file_name_ext_len;
4037 TO_EXTERNAL_FORMAT (LISP_STRING, b->auto_save_file_name,
4038 ALLOCA, (auto_save_file_name_ext,
4039 auto_save_file_name_ext_len),
4041 if (!NILP (b->filename))
4043 const Extbyte *filename_ext;
4044 Extcount filename_ext_len;
4046 TO_EXTERNAL_FORMAT (LISP_STRING, b->filename,
4047 ALLOCA, (filename_ext,
4050 write (listdesc, filename_ext, filename_ext_len);
4052 write (listdesc, "\n", 1);
4053 write (listdesc, auto_save_file_name_ext,
4054 auto_save_file_name_ext_len);
4055 write (listdesc, "\n", 1);
4058 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
4059 based on values in Vbuffer_alist. auto_save_1 may
4060 cause lisp handlers to run. Those handlers may kill
4061 the buffer and then GC. Since the buffer is killed,
4062 it's no longer in Vbuffer_alist so it might get reaped
4063 by the GC. We also need to protect tail. */
4064 /* #### There is probably a lot of other code which has
4065 pointers into buffers which may get blown away by
4068 struct gcpro ngcpro1, ngcpro2;
4069 NGCPRO2 (buf, tail);
4070 condition_case_1 (Qt,
4072 auto_save_error, Qnil);
4075 /* Handler killed our saved current-buffer! Pick any. */
4076 if (!BUFFER_LIVE_P (XBUFFER (old)))
4077 XSETBUFFER (old, current_buffer);
4079 set_buffer_internal (XBUFFER (old));
4082 /* Handler killed their own buffer! */
4083 if (!BUFFER_LIVE_P(b))
4086 b->auto_save_modified = BUF_MODIFF (b);
4087 b->saved_size = make_int (BUF_SIZE (b));
4088 EMACS_GET_TIME (after_time);
4089 /* If auto-save took more than 60 seconds,
4090 assume it was an NFS failure that got a timeout. */
4091 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
4092 b->auto_save_failure_time = EMACS_SECS (after_time);
4097 /* Prevent another auto save till enough input events come in. */
4099 record_auto_save ();
4101 /* If we didn't save anything into the listfile, remove the old
4102 one because nothing needed to be auto-saved. Do this afterwards
4103 rather than before in case we get a crash attempting to autosave
4104 (in that case we'd still want the old one around). */
4105 if (listdesc < 0 && !auto_saved && STRINGP (listfile))
4106 unlink ((char *) XSTRING_DATA (listfile));
4108 /* Show "...done" only if the echo area would otherwise be empty. */
4109 if (auto_saved && NILP (no_message)
4110 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0)))
4112 static const unsigned char *msg
4113 = (const unsigned char *)"Auto-saving...done";
4114 echo_area_message (selected_frame (), msg, Qnil, 0,
4115 strlen ((const char *) msg), Qauto_saving);
4120 RETURN_UNGCPRO (unbind_to (speccount, Qnil));
4123 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
4124 Mark current buffer as auto-saved with its current text.
4125 No auto-save file will be written until the buffer changes again.
4129 current_buffer->auto_save_modified = BUF_MODIFF (current_buffer);
4130 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
4131 current_buffer->auto_save_failure_time = -1;
4135 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
4136 Clear any record of a recent auto-save failure in the current buffer.
4140 current_buffer->auto_save_failure_time = -1;
4144 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
4145 Return t if buffer has been auto-saved since last read in or saved.
4149 return (BUF_SAVE_MODIFF (current_buffer) <
4150 current_buffer->auto_save_modified) ? Qt : Qnil;
4154 /************************************************************************/
4155 /* initialization */
4156 /************************************************************************/
4159 syms_of_fileio (void)
4161 defsymbol (&Qexpand_file_name, "expand-file-name");
4162 defsymbol (&Qfile_truename, "file-truename");
4163 defsymbol (&Qsubstitute_in_file_name, "substitute-in-file-name");
4164 defsymbol (&Qdirectory_file_name, "directory-file-name");
4165 defsymbol (&Qfile_name_directory, "file-name-directory");
4166 defsymbol (&Qfile_name_nondirectory, "file-name-nondirectory");
4167 defsymbol (&Qunhandled_file_name_directory, "unhandled-file-name-directory");
4168 defsymbol (&Qfile_name_as_directory, "file-name-as-directory");
4169 defsymbol (&Qcopy_file, "copy-file");
4170 defsymbol (&Qmake_directory_internal, "make-directory-internal");
4171 defsymbol (&Qdelete_directory, "delete-directory");
4172 defsymbol (&Qdelete_file, "delete-file");
4173 defsymbol (&Qrename_file, "rename-file");
4174 defsymbol (&Qadd_name_to_file, "add-name-to-file");
4175 defsymbol (&Qmake_symbolic_link, "make-symbolic-link");
4176 defsymbol (&Qfile_exists_p, "file-exists-p");
4177 defsymbol (&Qfile_executable_p, "file-executable-p");
4178 defsymbol (&Qfile_readable_p, "file-readable-p");
4179 defsymbol (&Qfile_symlink_p, "file-symlink-p");
4180 defsymbol (&Qfile_writable_p, "file-writable-p");
4181 defsymbol (&Qfile_directory_p, "file-directory-p");
4182 defsymbol (&Qfile_regular_p, "file-regular-p");
4183 defsymbol (&Qfile_accessible_directory_p, "file-accessible-directory-p");
4184 defsymbol (&Qfile_modes, "file-modes");
4185 defsymbol (&Qset_file_modes, "set-file-modes");
4186 defsymbol (&Qfile_newer_than_file_p, "file-newer-than-file-p");
4187 defsymbol (&Qinsert_file_contents, "insert-file-contents");
4188 defsymbol (&Qwrite_region, "write-region");
4189 defsymbol (&Qverify_visited_file_modtime, "verify-visited-file-modtime");
4190 defsymbol (&Qset_visited_file_modtime, "set-visited-file-modtime");
4191 defsymbol (&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */
4193 defsymbol (&Qauto_save_hook, "auto-save-hook");
4194 defsymbol (&Qauto_save_error, "auto-save-error");
4195 defsymbol (&Qauto_saving, "auto-saving");
4197 defsymbol (&Qformat_decode, "format-decode");
4198 defsymbol (&Qformat_annotate_function, "format-annotate-function");
4200 defsymbol (&Qcompute_buffer_file_truename, "compute-buffer-file-truename");
4201 DEFERROR_STANDARD (Qfile_error, Qio_error);
4202 DEFERROR_STANDARD (Qfile_already_exists, Qfile_error);
4204 DEFSUBR (Ffind_file_name_handler);
4206 DEFSUBR (Ffile_name_directory);
4207 DEFSUBR (Ffile_name_nondirectory);
4208 DEFSUBR (Funhandled_file_name_directory);
4209 DEFSUBR (Ffile_name_as_directory);
4210 DEFSUBR (Fdirectory_file_name);
4211 DEFSUBR (Fmake_temp_name);
4212 DEFSUBR (Fexpand_file_name);
4213 DEFSUBR (Ffile_truename);
4214 DEFSUBR (Fsubstitute_in_file_name);
4215 DEFSUBR (Fcopy_file);
4216 DEFSUBR (Fmake_directory_internal);
4217 DEFSUBR (Fdelete_directory);
4218 DEFSUBR (Fdelete_file);
4219 DEFSUBR (Frename_file);
4220 DEFSUBR (Fadd_name_to_file);
4221 DEFSUBR (Fmake_symbolic_link);
4223 DEFSUBR (Fsysnetunam);
4224 #endif /* HPUX_NET */
4225 DEFSUBR (Ffile_name_absolute_p);
4226 DEFSUBR (Ffile_exists_p);
4227 DEFSUBR (Ffile_executable_p);
4228 DEFSUBR (Ffile_readable_p);
4229 DEFSUBR (Ffile_writable_p);
4230 DEFSUBR (Ffile_symlink_p);
4231 DEFSUBR (Ffile_directory_p);
4232 DEFSUBR (Ffile_accessible_directory_p);
4233 DEFSUBR (Ffile_regular_p);
4234 DEFSUBR (Ffile_modes);
4235 DEFSUBR (Fset_file_modes);
4236 DEFSUBR (Fset_default_file_modes);
4237 DEFSUBR (Fdefault_file_modes);
4238 DEFSUBR (Funix_sync);
4239 DEFSUBR (Ffile_newer_than_file_p);
4240 DEFSUBR (Finsert_file_contents_internal);
4241 DEFSUBR (Fwrite_region_internal);
4242 DEFSUBR (Fcar_less_than_car); /* Vomitous! */
4243 DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
4245 DEFSUBR (Fencrypt_string);
4246 DEFSUBR (Fdecrypt_string);
4248 DEFSUBR (Fverify_visited_file_modtime);
4249 DEFSUBR (Fclear_visited_file_modtime);
4250 DEFSUBR (Fvisited_file_modtime);
4251 DEFSUBR (Fset_visited_file_modtime);
4253 DEFSUBR (Fdo_auto_save);
4254 DEFSUBR (Fset_buffer_auto_saved);
4255 DEFSUBR (Fclear_buffer_auto_save_failure);
4256 DEFSUBR (Frecent_auto_save_p);
4260 vars_of_fileio (void)
4262 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /*
4263 *Format in which to write auto-save files.
4264 Should be a list of symbols naming formats that are defined in `format-alist'.
4265 If it is t, which is the default, auto-save files are written in the
4266 same format as a regular save would use.
4268 Vauto_save_file_format = Qt;
4270 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /*
4271 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
4272 If a file name matches REGEXP, then all I/O on that file is done by calling
4275 The first argument given to HANDLER is the name of the I/O primitive
4276 to be handled; the remaining arguments are the arguments that were
4277 passed to that primitive. For example, if you do
4278 (file-exists-p FILENAME)
4279 and FILENAME is handled by HANDLER, then HANDLER is called like this:
4280 (funcall HANDLER 'file-exists-p FILENAME)
4281 The function `find-file-name-handler' checks this list for a handler
4284 Vfile_name_handler_alist = Qnil;
4286 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /*
4287 A list of functions to be called at the end of `insert-file-contents'.
4288 Each is passed one argument, the number of bytes inserted. It should return
4289 the new byte count, and leave point the same. If `insert-file-contents' is
4290 intercepted by a handler from `file-name-handler-alist', that handler is
4291 responsible for calling the after-insert-file-functions if appropriate.
4293 Vafter_insert_file_functions = Qnil;
4295 DEFVAR_LISP ("write-region-annotate-functions",
4296 &Vwrite_region_annotate_functions /*
4297 A list of functions to be called at the start of `write-region'.
4298 Each is passed two arguments, START and END, as for `write-region'.
4299 It should return a list of pairs (POSITION . STRING) of strings to be
4300 effectively inserted at the specified positions of the file being written
4301 \(1 means to insert before the first byte written). The POSITIONs must be
4302 sorted into increasing order. If there are several functions in the list,
4303 the several lists are merged destructively.
4305 Vwrite_region_annotate_functions = Qnil;
4307 DEFVAR_LISP ("write-region-annotations-so-far",
4308 &Vwrite_region_annotations_so_far /*
4309 When an annotation function is called, this holds the previous annotations.
4310 These are the annotations made by other annotation functions
4311 that were already called. See also `write-region-annotate-functions'.
4313 Vwrite_region_annotations_so_far = Qnil;
4315 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
4316 A list of file name handlers that temporarily should not be used.
4317 This applies only to the operation `inhibit-file-name-operation'.
4319 Vinhibit_file_name_handlers = Qnil;
4321 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
4322 The operation for which `inhibit-file-name-handlers' is applicable.
4324 Vinhibit_file_name_operation = Qnil;
4326 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name /*
4327 File name in which we write a list of all auto save file names.
4329 Vauto_save_list_file_name = Qnil;
4331 DEFVAR_LISP ("auto-save-list-file-prefix", &Vauto_save_list_file_prefix /*
4332 Prefix for generating auto-save-list-file-name.
4333 Emacs's pid and the system name will be appended to
4334 this prefix to create a unique file name.
4336 Vauto_save_list_file_prefix = build_string ("~/.saves-");
4338 DEFVAR_BOOL ("inhibit-auto-save-session", &inhibit_auto_save_session /*
4339 When non-nil, inhibit auto save list file creation.
4341 inhibit_auto_save_session = 0;
4343 DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks",
4344 &disable_auto_save_when_buffer_shrinks /*
4345 If non-nil, auto-saving is disabled when a buffer shrinks too much.
4346 This is to prevent you from losing your edits if you accidentally
4347 delete a large chunk of the buffer and don't notice it until too late.
4348 Saving the buffer normally turns auto-save back on.
4350 disable_auto_save_when_buffer_shrinks = 1;
4352 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /*
4353 Directory separator character for built-in functions that return file names.
4354 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
4355 This variable affects the built-in functions only on Windows,
4356 on other platforms, it is initialized so that Lisp code can find out
4357 what the normal separator is.
4360 Vdirectory_sep_char = make_char ('\\');
4362 Vdirectory_sep_char = make_char ('/');
4365 reinit_vars_of_fileio ();
4369 reinit_vars_of_fileio (void)
4371 /* We want temp_name_rand to be initialized to a value likely to be
4372 unique to the process, not to the executable. The danger is that
4373 two different XEmacs processes using the same binary on different
4374 machines creating temp files in the same directory will be
4375 unlucky enough to have the same pid. If we randomize using
4376 process startup time, then in practice they will be unlikely to
4377 collide. We use the microseconds field so that scripts that start
4378 simultaneous XEmacs processes on multiple machines will have less
4379 chance of collision. */
4383 EMACS_GET_TIME (thyme);
4384 temp_name_rand = (unsigned int) (EMACS_SECS (thyme) ^ EMACS_USECS (thyme));