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 DEFUN ("copy-file", Fcopy_file, 2, 4,
1680 "fCopy file: \nFCopy %s to file: \np\nP", /*
1681 Copy FILENAME to NEWNAME. Both args must be strings.
1682 Signals a `file-already-exists' error if file NEWNAME already exists,
1683 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
1684 A number as third arg means request confirmation if NEWNAME already exists.
1685 This is what happens in interactive use with M-x.
1686 Fourth arg KEEP-TIME non-nil means give the new file the same
1687 last-modified time as the old one. (This works on only some systems.)
1688 A prefix arg makes KEEP-TIME non-nil.
1690 (filename, newname, ok_if_already_exists, keep_time))
1692 /* This function can call Lisp. GC checked 2000-07-28 ben */
1694 char buf[16 * 1024];
1695 struct stat st, out_st;
1696 Lisp_Object handler;
1697 int speccount = specpdl_depth ();
1698 struct gcpro gcpro1, gcpro2;
1699 /* Lisp_Object args[6]; */
1700 int input_file_statable_p;
1702 GCPRO2 (filename, newname);
1703 CHECK_STRING (filename);
1704 CHECK_STRING (newname);
1705 filename = Fexpand_file_name (filename, Qnil);
1706 newname = Fexpand_file_name (newname, Qnil);
1708 /* If the input file name has special constructs in it,
1709 call the corresponding file handler. */
1710 handler = Ffind_file_name_handler (filename, Qcopy_file);
1711 /* Likewise for output file name. */
1713 handler = Ffind_file_name_handler (newname, Qcopy_file);
1714 if (!NILP (handler))
1717 return call5 (handler, Qcopy_file, filename, newname,
1718 ok_if_already_exists, keep_time);
1721 /* When second argument is a directory, copy the file into it.
1722 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
1724 if (!NILP (Ffile_directory_p (newname)))
1726 Lisp_Object args[3];
1727 struct gcpro ngcpro1;
1731 args[1] = Qnil; args[2] = Qnil;
1734 if (!IS_DIRECTORY_SEP (XSTRING_BYTE (newname,
1735 XSTRING_LENGTH (newname) - 1)))
1737 args[i++] = Fchar_to_string (Vdirectory_sep_char);
1738 args[i++] = Ffile_name_nondirectory (filename);
1739 newname = Fconcat (i, args);
1743 if (NILP (ok_if_already_exists)
1744 || INTP (ok_if_already_exists))
1745 barf_or_query_if_file_exists (newname, "copy to it",
1746 INTP (ok_if_already_exists), &out_st);
1747 else if (xemacs_stat ((const char *) XSTRING_DATA (newname), &out_st) < 0)
1750 ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0);
1752 report_file_error ("Opening input file", list1 (filename));
1754 record_unwind_protect (close_file_unwind, make_int (ifd));
1756 /* We can only copy regular files and symbolic links. Other files are not
1758 input_file_statable_p = (fstat (ifd, &st) >= 0);
1760 #ifndef WIN32_NATIVE
1761 if (out_st.st_mode != 0
1762 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
1765 report_file_error ("Input and output files are the same",
1766 list2 (filename, newname));
1770 #if defined (S_ISREG) && defined (S_ISLNK)
1771 if (input_file_statable_p)
1773 if (!(S_ISREG (st.st_mode))
1774 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
1776 && !(S_ISCHR (st.st_mode))
1778 && !(S_ISLNK (st.st_mode)))
1780 #if defined (EISDIR)
1781 /* Get a better looking error message. */
1784 report_file_error ("Non-regular file", list1 (filename));
1787 #endif /* S_ISREG && S_ISLNK */
1789 ofd = open( (char *) XSTRING_DATA (newname),
1790 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
1792 report_file_error ("Opening output file", list1 (newname));
1795 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil);
1797 record_unwind_protect (close_file_unwind, ofd_locative);
1799 while ((n = read_allowing_quit (ifd, buf, sizeof (buf))) > 0)
1801 if (write_allowing_quit (ofd, buf, n) != n)
1802 report_file_error ("I/O error", list1 (newname));
1805 /* Closing the output clobbers the file times on some systems. */
1806 if (close (ofd) < 0)
1807 report_file_error ("I/O error", list1 (newname));
1809 if (input_file_statable_p)
1811 if (!NILP (keep_time))
1813 EMACS_TIME atime, mtime;
1814 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
1815 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
1816 if (set_file_times ((char *) XSTRING_DATA (newname), atime,
1818 report_file_error ("I/O error", list1 (newname));
1820 chmod ((const char *) XSTRING_DATA (newname),
1821 st.st_mode & 07777);
1824 /* We'll close it by hand */
1825 XCAR (ofd_locative) = Qnil;
1828 unbind_to (speccount, Qnil);
1835 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
1836 Create a directory. One argument, a file name string.
1840 /* This function can GC. GC checked 1997.04.06. */
1841 char dir [MAXPATHLEN];
1842 Lisp_Object handler;
1843 struct gcpro gcpro1;
1845 CHECK_STRING (dirname_);
1846 dirname_ = Fexpand_file_name (dirname_, Qnil);
1849 handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal);
1851 if (!NILP (handler))
1852 return (call2 (handler, Qmake_directory_internal, dirname_));
1854 if (XSTRING_LENGTH (dirname_) > (Bytecount) (sizeof (dir) - 1))
1856 return Fsignal (Qfile_error,
1857 list3 (build_translated_string ("Creating directory"),
1858 build_translated_string ("pathname too long"),
1861 strncpy (dir, (char *) XSTRING_DATA (dirname_),
1862 XSTRING_LENGTH (dirname_) + 1);
1864 if (dir [XSTRING_LENGTH (dirname_) - 1] == '/')
1865 dir [XSTRING_LENGTH (dirname_) - 1] = 0;
1867 if (mkdir (dir, 0777) != 0)
1868 report_file_error ("Creating directory", list1 (dirname_));
1873 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
1874 Delete a directory. One argument, a file name or directory name string.
1878 /* This function can GC. GC checked 1997.04.06. */
1879 Lisp_Object handler;
1880 struct gcpro gcpro1;
1882 CHECK_STRING (dirname_);
1885 dirname_ = Fexpand_file_name (dirname_, Qnil);
1886 dirname_ = Fdirectory_file_name (dirname_);
1888 handler = Ffind_file_name_handler (dirname_, Qdelete_directory);
1890 if (!NILP (handler))
1891 return (call2 (handler, Qdelete_directory, dirname_));
1893 if (rmdir ((char *) XSTRING_DATA (dirname_)) != 0)
1894 report_file_error ("Removing directory", list1 (dirname_));
1899 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
1900 Delete the file named FILENAME (a string).
1901 If FILENAME has multiple names, it continues to exist with the other names.
1905 /* This function can GC. GC checked 1997.04.06. */
1906 Lisp_Object handler;
1907 struct gcpro gcpro1;
1909 CHECK_STRING (filename);
1910 filename = Fexpand_file_name (filename, Qnil);
1913 handler = Ffind_file_name_handler (filename, Qdelete_file);
1915 if (!NILP (handler))
1916 return call2 (handler, Qdelete_file, filename);
1918 if (0 > unlink ((char *) XSTRING_DATA (filename)))
1919 report_file_error ("Removing old name", list1 (filename));
1924 internal_delete_file_1 (Lisp_Object ignore, Lisp_Object ignore2)
1929 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1932 internal_delete_file (Lisp_Object filename)
1934 /* This function can GC. GC checked 1997.04.06. */
1935 return NILP (condition_case_1 (Qt, Fdelete_file, filename,
1936 internal_delete_file_1, Qnil));
1939 DEFUN ("rename-file", Frename_file, 2, 3,
1940 "fRename file: \nFRename %s to file: \np", /*
1941 Rename FILENAME as NEWNAME. Both args must be strings.
1942 If file has names other than FILENAME, it continues to have those names.
1943 Signals a `file-already-exists' error if a file NEWNAME already exists
1944 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1945 A number as third arg means request confirmation if NEWNAME already exists.
1946 This is what happens in interactive use with M-x.
1948 (filename, newname, ok_if_already_exists))
1950 /* This function can GC. GC checked 1997.04.06. */
1951 Lisp_Object handler;
1952 struct gcpro gcpro1, gcpro2;
1954 GCPRO2 (filename, newname);
1955 CHECK_STRING (filename);
1956 CHECK_STRING (newname);
1957 filename = Fexpand_file_name (filename, Qnil);
1958 newname = Fexpand_file_name (newname, Qnil);
1960 /* If the file name has special constructs in it,
1961 call the corresponding file handler. */
1962 handler = Ffind_file_name_handler (filename, Qrename_file);
1964 handler = Ffind_file_name_handler (newname, Qrename_file);
1965 if (!NILP (handler))
1968 return call4 (handler, Qrename_file,
1969 filename, newname, ok_if_already_exists);
1972 /* When second argument is a directory, rename the file into it.
1973 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
1975 if (!NILP (Ffile_directory_p (newname)))
1977 Lisp_Object args[3];
1978 struct gcpro ngcpro1;
1982 args[1] = Qnil; args[2] = Qnil;
1985 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
1986 args[i++] = build_string ("/");
1987 args[i++] = Ffile_name_nondirectory (filename);
1988 newname = Fconcat (i, args);
1992 if (NILP (ok_if_already_exists)
1993 || INTP (ok_if_already_exists))
1994 barf_or_query_if_file_exists (newname, "rename to it",
1995 INTP (ok_if_already_exists), 0);
1997 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
1998 WIN32_NATIVE here; I've removed it. --marcpa */
2000 /* We have configure check for rename() and emulate using
2001 link()/unlink() if necessary. */
2002 if (0 > rename ((char *) XSTRING_DATA (filename),
2003 (char *) XSTRING_DATA (newname)))
2007 Fcopy_file (filename, newname,
2008 /* We have already prompted if it was an integer,
2009 so don't have copy-file prompt again. */
2010 (NILP (ok_if_already_exists) ? Qnil : Qt),
2012 Fdelete_file (filename);
2016 report_file_error ("Renaming", list2 (filename, newname));
2023 DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3,
2024 "fAdd name to file: \nFName to add to %s: \np", /*
2025 Give FILENAME additional name NEWNAME. Both args must be strings.
2026 Signals a `file-already-exists' error if a file NEWNAME already exists
2027 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2028 A number as third arg means request confirmation if NEWNAME already exists.
2029 This is what happens in interactive use with M-x.
2031 (filename, newname, ok_if_already_exists))
2033 /* This function can GC. GC checked 1997.04.06. */
2034 Lisp_Object handler;
2035 struct gcpro gcpro1, gcpro2;
2037 GCPRO2 (filename, newname);
2038 CHECK_STRING (filename);
2039 CHECK_STRING (newname);
2040 filename = Fexpand_file_name (filename, Qnil);
2041 newname = Fexpand_file_name (newname, Qnil);
2043 /* If the file name has special constructs in it,
2044 call the corresponding file handler. */
2045 handler = Ffind_file_name_handler (filename, Qadd_name_to_file);
2046 if (!NILP (handler))
2047 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2048 newname, ok_if_already_exists));
2050 /* If the new name has special constructs in it,
2051 call the corresponding file handler. */
2052 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2053 if (!NILP (handler))
2054 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2055 newname, ok_if_already_exists));
2057 if (NILP (ok_if_already_exists)
2058 || INTP (ok_if_already_exists))
2059 barf_or_query_if_file_exists (newname, "make it a new name",
2060 INTP (ok_if_already_exists), 0);
2061 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
2062 on NT here. --marcpa */
2063 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
2064 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
2065 Reverted to previous behavior pending a working fix. (jhar) */
2066 #if defined(WIN32_NATIVE)
2067 /* Windows does not support this operation. */
2068 report_file_error ("Adding new name", Flist (2, &filename));
2069 #else /* not defined(WIN32_NATIVE) */
2071 unlink ((char *) XSTRING_DATA (newname));
2072 if (0 > link ((char *) XSTRING_DATA (filename),
2073 (char *) XSTRING_DATA (newname)))
2075 report_file_error ("Adding new name",
2076 list2 (filename, newname));
2078 #endif /* defined(WIN32_NATIVE) */
2084 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3,
2085 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
2086 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2087 Signals a `file-already-exists' error if a file LINKNAME already exists
2088 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2089 A number as third arg means request confirmation if LINKNAME already exists.
2090 This happens for interactive use with M-x.
2092 (filename, linkname, ok_if_already_exists))
2094 /* This function can GC. GC checked 1997.06.04. */
2095 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2096 Lisp_Object handler;
2097 struct gcpro gcpro1, gcpro2;
2099 GCPRO2 (filename, linkname);
2100 CHECK_STRING (filename);
2101 CHECK_STRING (linkname);
2102 /* If the link target has a ~, we must expand it to get
2103 a truly valid file name. Otherwise, do not expand;
2104 we want to permit links to relative file names. */
2105 if (XSTRING_BYTE (filename, 0) == '~')
2106 filename = Fexpand_file_name (filename, Qnil);
2107 linkname = Fexpand_file_name (linkname, Qnil);
2109 /* If the file name has special constructs in it,
2110 call the corresponding file handler. */
2111 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
2112 if (!NILP (handler))
2113 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname,
2114 ok_if_already_exists));
2116 /* If the new link name has special constructs in it,
2117 call the corresponding file handler. */
2118 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2119 if (!NILP (handler))
2120 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2121 linkname, ok_if_already_exists));
2124 if (NILP (ok_if_already_exists)
2125 || INTP (ok_if_already_exists))
2126 barf_or_query_if_file_exists (linkname, "make it a link",
2127 INTP (ok_if_already_exists), 0);
2129 unlink ((char *) XSTRING_DATA (linkname));
2130 if (0 > symlink ((char *) XSTRING_DATA (filename),
2131 (char *) XSTRING_DATA (linkname)))
2133 report_file_error ("Making symbolic link",
2134 list2 (filename, linkname));
2136 #endif /* S_IFLNK */
2144 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
2145 Open a network connection to PATH using LOGIN as the login string.
2150 const char *path_ext;
2151 const char *login_ext;
2153 CHECK_STRING (path);
2154 CHECK_STRING (login);
2156 /* netunam, being a strange-o system call only used once, is not
2159 LISP_STRING_TO_EXTERNAL (path, path_ext, Qfile_name);
2160 LISP_STRING_TO_EXTERNAL (login, login_ext, Qnative);
2162 netresult = netunam (path_ext, login_ext);
2164 return netresult == -1 ? Qnil : Qt;
2166 #endif /* HPUX_NET */
2168 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
2169 Return t if file FILENAME specifies an absolute path name.
2170 On Unix, this is a name starting with a `/' or a `~'.
2174 /* This function does not GC */
2177 CHECK_STRING (filename);
2178 ptr = XSTRING_DATA (filename);
2179 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
2181 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
2186 /* Return nonzero if file FILENAME exists and can be executed. */
2189 check_executable (char *filename)
2193 if (xemacs_stat (filename, &st) < 0)
2195 return ((st.st_mode & S_IEXEC) != 0);
2196 #else /* not WIN32_NATIVE */
2198 return eaccess (filename, X_OK) >= 0;
2200 /* Access isn't quite right because it uses the real uid
2201 and we really want to test with the effective uid.
2202 But Unix doesn't give us a right way to do it. */
2203 return access (filename, X_OK) >= 0;
2204 #endif /* HAVE_EACCESS */
2205 #endif /* not WIN32_NATIVE */
2208 /* Return nonzero if file FILENAME exists and can be written. */
2211 check_writable (const char *filename)
2214 return (eaccess (filename, W_OK) >= 0);
2216 /* Access isn't quite right because it uses the real uid
2217 and we really want to test with the effective uid.
2218 But Unix doesn't give us a right way to do it.
2219 Opening with O_WRONLY could work for an ordinary file,
2220 but would lose for directories. */
2221 return (access (filename, W_OK) >= 0);
2225 DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
2226 Return t if file FILENAME exists. (This does not mean you can read it.)
2227 See also `file-readable-p' and `file-attributes'.
2231 /* This function can call lisp; GC checked 2000-07-11 ben */
2232 Lisp_Object abspath;
2233 Lisp_Object handler;
2234 struct stat statbuf;
2235 struct gcpro gcpro1;
2237 CHECK_STRING (filename);
2238 abspath = Fexpand_file_name (filename, Qnil);
2240 /* If the file name has special constructs in it,
2241 call the corresponding file handler. */
2243 handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
2245 if (!NILP (handler))
2246 return call2 (handler, Qfile_exists_p, abspath);
2248 return xemacs_stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
2251 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
2252 Return t if FILENAME can be executed by you.
2253 For a directory, this means you can access files in that directory.
2258 /* This function can GC. GC checked 07-11-2000 ben. */
2259 Lisp_Object abspath;
2260 Lisp_Object handler;
2261 struct gcpro gcpro1;
2263 CHECK_STRING (filename);
2264 abspath = Fexpand_file_name (filename, Qnil);
2266 /* If the file name has special constructs in it,
2267 call the corresponding file handler. */
2269 handler = Ffind_file_name_handler (abspath, Qfile_executable_p);
2271 if (!NILP (handler))
2272 return call2 (handler, Qfile_executable_p, abspath);
2274 return check_executable ((char *) XSTRING_DATA (abspath)) ? Qt : Qnil;
2277 DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
2278 Return t if file FILENAME exists and you can read it.
2279 See also `file-exists-p' and `file-attributes'.
2283 /* This function can GC */
2284 Lisp_Object abspath = Qnil;
2285 Lisp_Object handler;
2286 struct gcpro gcpro1;
2289 CHECK_STRING (filename);
2290 abspath = Fexpand_file_name (filename, Qnil);
2292 /* If the file name has special constructs in it,
2293 call the corresponding file handler. */
2294 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
2295 if (!NILP (handler))
2296 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
2298 #if defined(WIN32_NATIVE) || defined(CYGWIN)
2299 /* Under MS-DOS and Windows, open does not work for directories. */
2301 if (access (XSTRING_DATA (abspath), 0) == 0)
2305 #else /* not WIN32_NATIVE */
2307 int desc = interruptible_open ((char *) XSTRING_DATA (abspath), O_RDONLY | OPEN_BINARY, 0);
2314 #endif /* not WIN32_NATIVE */
2317 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2319 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
2320 Return t if file FILENAME can be written or created by you.
2324 /* This function can GC. GC checked 1997.04.10. */
2325 Lisp_Object abspath, dir;
2326 Lisp_Object handler;
2327 struct stat statbuf;
2328 struct gcpro gcpro1;
2330 CHECK_STRING (filename);
2331 abspath = Fexpand_file_name (filename, Qnil);
2333 /* If the file name has special constructs in it,
2334 call the corresponding file handler. */
2336 handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
2338 if (!NILP (handler))
2339 return call2 (handler, Qfile_writable_p, abspath);
2341 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0)
2342 return (check_writable ((char *) XSTRING_DATA (abspath))
2347 dir = Ffile_name_directory (abspath);
2349 return (check_writable (!NILP (dir) ? (char *) XSTRING_DATA (dir)
2354 DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
2355 Return non-nil if file FILENAME is the name of a symbolic link.
2356 The value is the name of the file to which it is linked.
2357 Otherwise returns nil.
2361 /* This function can GC. GC checked 1997.04.10. */
2362 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2369 Lisp_Object handler;
2370 struct gcpro gcpro1;
2372 CHECK_STRING (filename);
2373 filename = Fexpand_file_name (filename, Qnil);
2375 /* If the file name has special constructs in it,
2376 call the corresponding file handler. */
2378 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
2380 if (!NILP (handler))
2381 return call2 (handler, Qfile_symlink_p, filename);
2387 buf = xnew_array_and_zero (char, bufsize);
2388 valsize = readlink ((char *) XSTRING_DATA (filename),
2390 if (valsize < bufsize) break;
2391 /* Buffer was not long enough */
2400 val = make_string ((Bufbyte *) buf, valsize);
2403 #else /* not S_IFLNK */
2405 #endif /* not S_IFLNK */
2408 DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
2409 Return t if file FILENAME is the name of a directory as a file.
2410 A directory name spec may be given instead; then the value is t
2411 if the directory so specified exists and really is a directory.
2415 /* This function can GC. GC checked 1997.04.10. */
2416 Lisp_Object abspath;
2418 Lisp_Object handler;
2419 struct gcpro gcpro1;
2421 GCPRO1 (current_buffer->directory);
2422 abspath = expand_and_dir_to_file (filename,
2423 current_buffer->directory);
2426 /* If the file name has special constructs in it,
2427 call the corresponding file handler. */
2429 handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
2431 if (!NILP (handler))
2432 return call2 (handler, Qfile_directory_p, abspath);
2434 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2436 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2439 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
2440 Return t if file FILENAME is the name of a directory as a file,
2441 and files in that directory can be opened by you. In order to use a
2442 directory as a buffer's current directory, this predicate must return true.
2443 A directory name spec may be given instead; then the value is t
2444 if the directory so specified exists and really is a readable and
2445 searchable directory.
2449 /* This function can GC. GC checked 1997.04.10. */
2450 Lisp_Object handler;
2452 /* If the file name has special constructs in it,
2453 call the corresponding file handler. */
2454 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
2455 if (!NILP (handler))
2456 return call2 (handler, Qfile_accessible_directory_p,
2459 #if !defined(WIN32_NATIVE)
2460 if (NILP (Ffile_directory_p (filename)))
2463 return Ffile_executable_p (filename);
2467 struct gcpro gcpro1;
2468 /* It's an unlikely combination, but yes we really do need to gcpro:
2469 Suppose that file-accessible-directory-p has no handler, but
2470 file-directory-p does have a handler; this handler causes a GC which
2471 relocates the string in `filename'; and finally file-directory-p
2472 returns non-nil. Then we would end up passing a garbaged string
2473 to file-executable-p. */
2475 tem = (NILP (Ffile_directory_p (filename))
2476 || NILP (Ffile_executable_p (filename)));
2478 return tem ? Qnil : Qt;
2480 #endif /* !defined(WIN32_NATIVE) */
2483 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
2484 Return t if file FILENAME is the name of a regular file.
2485 This is the sort of file that holds an ordinary stream of data bytes.
2489 /* This function can GC. GC checked 1997.04.10. */
2490 Lisp_Object abspath;
2492 Lisp_Object handler;
2493 struct gcpro gcpro1;
2495 GCPRO1 (current_buffer->directory);
2496 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
2499 /* If the file name has special constructs in it,
2500 call the corresponding file handler. */
2502 handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
2504 if (!NILP (handler))
2505 return call2 (handler, Qfile_regular_p, abspath);
2507 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2509 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2512 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
2513 Return mode bits of file named FILENAME, as an integer.
2517 /* This function can GC. GC checked 1997.04.10. */
2518 Lisp_Object abspath;
2520 Lisp_Object handler;
2521 struct gcpro gcpro1;
2523 GCPRO1 (current_buffer->directory);
2524 abspath = expand_and_dir_to_file (filename,
2525 current_buffer->directory);
2528 /* If the file name has special constructs in it,
2529 call the corresponding file handler. */
2531 handler = Ffind_file_name_handler (abspath, Qfile_modes);
2533 if (!NILP (handler))
2534 return call2 (handler, Qfile_modes, abspath);
2536 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2538 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
2541 if (check_executable (XSTRING_DATA (abspath)))
2542 st.st_mode |= S_IEXEC;
2543 #endif /* WIN32_NATIVE */
2546 return make_int (st.st_mode & 07777);
2549 DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /*
2550 Set mode bits of file named FILENAME to MODE (an integer).
2551 Only the 12 low bits of MODE are used.
2555 /* This function can GC. GC checked 1997.04.10. */
2556 Lisp_Object abspath;
2557 Lisp_Object handler;
2558 struct gcpro gcpro1;
2560 GCPRO1 (current_buffer->directory);
2561 abspath = Fexpand_file_name (filename, current_buffer->directory);
2566 /* If the file name has special constructs in it,
2567 call the corresponding file handler. */
2569 handler = Ffind_file_name_handler (abspath, Qset_file_modes);
2571 if (!NILP (handler))
2572 return call3 (handler, Qset_file_modes, abspath, mode);
2574 if (chmod ((char *) XSTRING_DATA (abspath), XINT (mode)) < 0)
2575 report_file_error ("Doing chmod", list1 (abspath));
2580 DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
2581 Set the file permission bits for newly created files.
2582 The argument MODE should be an integer; if a bit in MODE is 1,
2583 subsequently created files will not have the permission corresponding
2584 to that bit enabled. Only the low 9 bits are used.
2585 This setting is inherited by subprocesses.
2591 umask ((~ XINT (mode)) & 0777);
2596 DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
2597 Return the default file protection for created files.
2598 The umask value determines which permissions are enabled in newly
2599 created files. If a permission's bit in the umask is 1, subsequently
2600 created files will not have that permission enabled.
2609 return make_int ((~ mode) & 0777);
2612 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /*
2613 Tell Unix to finish all pending disk updates.
2617 #ifndef WIN32_NATIVE
2624 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
2625 Return t if file FILE1 is newer than file FILE2.
2626 If FILE1 does not exist, the answer is nil;
2627 otherwise, if FILE2 does not exist, the answer is t.
2631 /* This function can GC. GC checked 1997.04.10. */
2632 Lisp_Object abspath1, abspath2;
2635 Lisp_Object handler;
2636 struct gcpro gcpro1, gcpro2, gcpro3;
2638 CHECK_STRING (file1);
2639 CHECK_STRING (file2);
2644 GCPRO3 (abspath1, abspath2, current_buffer->directory);
2645 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
2646 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
2648 /* If the file name has special constructs in it,
2649 call the corresponding file handler. */
2650 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p);
2652 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p);
2654 if (!NILP (handler))
2655 return call3 (handler, Qfile_newer_than_file_p, abspath1,
2658 if (xemacs_stat ((char *) XSTRING_DATA (abspath1), &st) < 0)
2661 mtime1 = st.st_mtime;
2663 if (xemacs_stat ((char *) XSTRING_DATA (abspath2), &st) < 0)
2666 return (mtime1 > st.st_mtime) ? Qt : Qnil;
2670 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
2671 /* #define READ_BUF_SIZE (2 << 16) */
2672 #define READ_BUF_SIZE (1 << 15)
2674 DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal,
2676 Insert contents of file FILENAME after point; no coding-system frobbing.
2677 This function is identical to `insert-file-contents' except for the
2678 handling of the CODESYS and USED-CODESYS arguments under
2679 XEmacs/Mule. (When Mule support is not present, both functions are
2680 identical and ignore the CODESYS and USED-CODESYS arguments.)
2682 If support for Mule exists in this Emacs, the file is decoded according
2683 to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil,
2684 it should be a symbol, and the actual coding system that was used for the
2685 decoding is stored into it. It will in general be different from CODESYS
2686 if CODESYS specifies automatic encoding detection or end-of-line detection.
2688 Currently START and END refer to byte positions (as opposed to character
2689 positions), even in Mule. (Fixing this is very difficult.)
2691 (filename, visit, start, end, replace, codesys, used_codesys))
2693 /* This function can call lisp */
2697 Charcount inserted = 0;
2699 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2700 Lisp_Object handler = Qnil, val;
2702 Bufbyte read_buf[READ_BUF_SIZE];
2704 struct buffer *buf = current_buffer;
2706 int not_regular = 0;
2708 if (buf->base_buffer && ! NILP (visit))
2709 error ("Cannot do file visiting in an indirect buffer");
2711 /* No need to call Fbarf_if_buffer_read_only() here.
2712 That's called in begin_multiple_change() or wherever. */
2716 /* #### dmoore - should probably check in various places to see if
2717 curbuf was killed and if so signal an error? */
2719 XSETBUFFER (curbuf, buf);
2721 GCPRO5 (filename, val, visit, handler, curbuf);
2723 mc_count = (NILP (replace)) ?
2724 begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) :
2725 begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf));
2727 speccount = specpdl_depth (); /* begin_multiple_change also adds
2728 an unwind_protect */
2730 filename = Fexpand_file_name (filename, Qnil);
2732 /* If the file name has special constructs in it,
2733 call the corresponding file handler. */
2734 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
2735 if (!NILP (handler))
2737 val = call6 (handler, Qinsert_file_contents, filename,
2738 visit, start, end, replace);
2743 if (!NILP (used_codesys))
2744 CHECK_SYMBOL (used_codesys);
2747 if ( (!NILP (start) || !NILP (end)) && !NILP (visit) )
2748 error ("Attempt to visit less than an entire file");
2752 if (xemacs_stat ((char *) XSTRING_DATA (filename), &st) < 0)
2754 if (fd >= 0) close (fd);
2757 report_file_error ("Opening input file", list1 (filename));
2763 /* Signal an error if we are accessing a non-regular file, with
2764 REPLACE, START or END being non-nil. */
2765 if (!S_ISREG (st.st_mode))
2772 if (!NILP (replace) || !NILP (start) || !NILP (end))
2774 end_multiple_change (buf, mc_count);
2777 (Fsignal (Qfile_error,
2778 list2 (build_translated_string("not a regular file"),
2782 #endif /* S_IFREG */
2794 if ((fd = interruptible_open ((char *) XSTRING_DATA (filename),
2795 O_RDONLY | OPEN_BINARY, 0)) < 0)
2799 /* Replacement should preserve point as it preserves markers. */
2800 if (!NILP (replace))
2801 record_unwind_protect (restore_point_unwind, Fpoint_marker (Qnil, Qnil));
2803 record_unwind_protect (close_file_unwind, make_int (fd));
2805 /* Supposedly happens on VMS. */
2807 error ("File size is negative");
2813 end = make_int (st.st_size);
2814 if (XINT (end) != st.st_size)
2815 error ("Maximum buffer size exceeded");
2819 /* If requested, replace the accessible part of the buffer
2820 with the file contents. Avoid replacing text at the
2821 beginning or end of the buffer that matches the file contents;
2822 that preserves markers pointing to the unchanged parts. */
2823 #if !defined (FILE_CODING)
2824 /* The replace-mode code currently only works when the assumption
2825 'one byte == one char' holds true. This fails Mule because
2826 files may contain multibyte characters. It holds under Windows NT
2827 provided we convert CRLF into LF. */
2828 # define FSFMACS_SPEEDY_INSERT
2829 #endif /* !defined (FILE_CODING) */
2831 #ifndef FSFMACS_SPEEDY_INSERT
2832 if (!NILP (replace))
2834 buffer_delete_range (buf, BUF_BEG (buf), BUF_Z (buf),
2835 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2837 #else /* FSFMACS_SPEEDY_INSERT */
2838 if (!NILP (replace))
2840 char buffer[1 << 14];
2841 Bufpos same_at_start = BUF_BEGV (buf);
2842 Bufpos same_at_end = BUF_ZV (buf);
2845 /* Count how many chars at the start of the file
2846 match the text at the beginning of the buffer. */
2851 nread = read_allowing_quit (fd, buffer, sizeof buffer);
2853 error ("IO error reading %s: %s",
2854 XSTRING_DATA (filename), strerror (errno));
2855 else if (nread == 0)
2858 while (bufpos < nread && same_at_start < BUF_ZV (buf)
2859 && BUF_FETCH_CHAR (buf, same_at_start) == buffer[bufpos])
2860 same_at_start++, bufpos++;
2861 /* If we found a discrepancy, stop the scan.
2862 Otherwise loop around and scan the next bufferful. */
2863 if (bufpos != nread)
2866 /* If the file matches the buffer completely,
2867 there's no need to replace anything. */
2868 if (same_at_start - BUF_BEGV (buf) == st.st_size)
2871 unbind_to (speccount, Qnil);
2872 /* Truncate the buffer to the size of the file. */
2873 buffer_delete_range (buf, same_at_start, same_at_end,
2874 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2877 /* Count how many chars at the end of the file
2878 match the text at the end of the buffer. */
2881 int total_read, nread;
2882 Bufpos bufpos, curpos, trial;
2884 /* At what file position are we now scanning? */
2885 curpos = st.st_size - (BUF_ZV (buf) - same_at_end);
2886 /* If the entire file matches the buffer tail, stop the scan. */
2889 /* How much can we scan in the next step? */
2890 trial = min (curpos, (Bufpos) sizeof (buffer));
2891 if (lseek (fd, curpos - trial, 0) < 0)
2892 report_file_error ("Setting file position", list1 (filename));
2895 while (total_read < trial)
2897 nread = read_allowing_quit (fd, buffer + total_read,
2898 trial - total_read);
2900 report_file_error ("IO error reading file", list1 (filename));
2901 total_read += nread;
2903 /* Scan this bufferful from the end, comparing with
2904 the Emacs buffer. */
2905 bufpos = total_read;
2906 /* Compare with same_at_start to avoid counting some buffer text
2907 as matching both at the file's beginning and at the end. */
2908 while (bufpos > 0 && same_at_end > same_at_start
2909 && BUF_FETCH_CHAR (buf, same_at_end - 1) ==
2911 same_at_end--, bufpos--;
2912 /* If we found a discrepancy, stop the scan.
2913 Otherwise loop around and scan the preceding bufferful. */
2916 /* If display current starts at beginning of line,
2917 keep it that way. */
2918 if (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == buf)
2919 XWINDOW (Fselected_window (Qnil))->start_at_line_beg =
2920 !NILP (Fbolp (make_buffer (buf)));
2923 /* Don't try to reuse the same piece of text twice. */
2924 overlap = same_at_start - BUF_BEGV (buf) -
2925 (same_at_end + st.st_size - BUF_ZV (buf));
2927 same_at_end += overlap;
2929 /* Arrange to read only the nonmatching middle part of the file. */
2930 start = make_int (same_at_start - BUF_BEGV (buf));
2931 end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end));
2933 buffer_delete_range (buf, same_at_start, same_at_end,
2934 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2935 /* Insert from the file at the proper position. */
2936 BUF_SET_PT (buf, same_at_start);
2938 #endif /* FSFMACS_SPEEDY_INSERT */
2942 total = XINT (end) - XINT (start);
2944 /* Make sure point-max won't overflow after this insertion. */
2945 if (total != XINT (make_int (total)))
2946 error ("Maximum buffer size exceeded");
2949 /* For a special file, all we can do is guess. The value of -1
2950 will make the stream functions read as much as possible. */
2953 if (XINT (start) != 0
2954 #ifdef FSFMACS_SPEEDY_INSERT
2955 /* why was this here? asked jwz. The reason is that the replace-mode
2956 connivings above will normally put the file pointer other than
2957 where it should be. */
2959 #endif /* !FSFMACS_SPEEDY_INSERT */
2962 if (lseek (fd, XINT (start), 0) < 0)
2963 report_file_error ("Setting file position", list1 (filename));
2967 Bufpos cur_point = BUF_PT (buf);
2968 struct gcpro ngcpro1;
2969 Lisp_Object stream = make_filedesc_input_stream (fd, 0, total,
2973 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2975 stream = make_decoding_input_stream
2976 (XLSTREAM (stream), Fget_coding_system (codesys));
2977 Lstream_set_character_mode (XLSTREAM (stream));
2978 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2979 #endif /* FILE_CODING */
2981 record_unwind_protect (delete_stream_unwind, stream);
2983 /* No need to limit the amount of stuff we attempt to read. (It would
2984 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
2985 occurs inside of the filedesc stream. */
2989 Charcount cc_inserted;
2992 this_len = Lstream_read (XLSTREAM (stream), read_buf,
3002 cc_inserted = buffer_insert_raw_string_1 (buf, cur_point, read_buf,
3005 ? INSDEL_NO_LOCKING : 0);
3006 inserted += cc_inserted;
3007 cur_point += cc_inserted;
3010 if (!NILP (used_codesys))
3013 XCODING_SYSTEM_NAME (decoding_stream_coding_system (XLSTREAM (stream))));
3015 #endif /* FILE_CODING */
3019 /* Close the file/stream */
3020 unbind_to (speccount, Qnil);
3024 error ("IO error reading %s: %s",
3025 XSTRING_DATA (filename), strerror (saverrno));
3031 end_multiple_change (buf, mc_count);
3035 if (!EQ (buf->undo_list, Qt))
3036 buf->undo_list = Qnil;
3039 buf->modtime = st.st_mtime;
3040 buf->filename = filename;
3041 /* XEmacs addition: */
3042 /* This function used to be in C, ostensibly so that
3043 it could be called here. But that's just silly.
3044 There's no reason C code can't call out to Lisp
3045 code, and it's a lot cleaner this way. */
3046 /* Note: compute-buffer-file-truename is called for
3047 side-effect! Its return value is intentionally
3049 if (!NILP (Ffboundp (Qcompute_buffer_file_truename)))
3050 call1 (Qcompute_buffer_file_truename, make_buffer (buf));
3052 BUF_SAVE_MODIFF (buf) = BUF_MODIFF (buf);
3053 buf->auto_save_modified = BUF_MODIFF (buf);
3054 buf->saved_size = make_int (BUF_SIZE (buf));
3055 #ifdef CLASH_DETECTION
3058 if (!NILP (buf->file_truename))
3059 unlock_file (buf->file_truename);
3060 unlock_file (filename);
3062 #endif /* CLASH_DETECTION */
3064 RETURN_UNGCPRO (Fsignal (Qfile_error,
3065 list2 (build_string ("not a regular file"),
3068 /* If visiting nonexistent file, return nil. */
3069 if (buf->modtime == -1)
3070 report_file_error ("Opening input file",
3074 /* Decode file format */
3077 Lisp_Object insval = call3 (Qformat_decode,
3078 Qnil, make_int (inserted), visit);
3080 inserted = XINT (insval);
3086 struct gcpro ngcpro1;
3089 EXTERNAL_LIST_LOOP (p, Vafter_insert_file_functions)
3091 Lisp_Object insval =
3092 call1 (XCAR (p), make_int (inserted));
3095 CHECK_NATNUM (insval);
3096 inserted = XINT (insval);
3108 return (list2 (filename, make_int (inserted)));
3112 static int a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3113 Lisp_Object *annot);
3114 static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end);
3116 /* If build_annotations switched buffers, switch back to BUF.
3117 Kill the temporary buffer that was selected in the meantime. */
3120 build_annotations_unwind (Lisp_Object buf)
3124 if (XBUFFER (buf) == current_buffer)
3126 tembuf = Fcurrent_buffer ();
3128 Fkill_buffer (tembuf);
3132 DEFUN ("write-region-internal", Fwrite_region_internal, 3, 7,
3133 "r\nFWrite region to file: ", /*
3134 Write current region into specified file; no coding-system frobbing.
3135 This function is identical to `write-region' except for the handling
3136 of the CODESYS argument under XEmacs/Mule. (When Mule support is not
3137 present, both functions are identical and ignore the CODESYS argument.)
3138 If support for Mule exists in this Emacs, the file is encoded according
3139 to the value of CODESYS. If this is nil, no code conversion occurs.
3141 (start, end, filename, append, visit, lockname, codesys))
3143 /* This function can call lisp. GC checked 2000-07-28 ben */
3148 Lisp_Object fn = Qnil;
3149 int speccount = specpdl_depth ();
3150 int visiting_other = STRINGP (visit);
3151 int visiting = (EQ (visit, Qt) || visiting_other);
3152 int quietly = (!visiting && !NILP (visit));
3153 Lisp_Object visit_file = Qnil;
3154 Lisp_Object annotations = Qnil;
3155 struct buffer *given_buffer;
3156 Bufpos start1, end1;
3157 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3158 struct gcpro ngcpro1, ngcpro2;
3161 XSETBUFFER (curbuf, current_buffer);
3163 /* start, end, visit, and append are never modified in this fun
3164 so we don't protect them. */
3165 GCPRO5 (visit_file, filename, codesys, lockname, annotations);
3166 NGCPRO2 (curbuf, fn);
3168 /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
3169 we should signal an error rather than blissfully continuing
3170 along. ARGH, this function is going to lose lose lose. We need
3171 to protect the current_buffer from being destroyed, but the
3172 multiple return points make this a pain in the butt. ]] we do
3173 protect curbuf now. --ben */
3176 codesys = Fget_coding_system (codesys);
3177 #endif /* FILE_CODING */
3179 if (current_buffer->base_buffer && ! NILP (visit))
3180 invalid_operation ("Cannot do file visiting in an indirect buffer",
3183 if (!NILP (start) && !STRINGP (start))
3184 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0);
3187 Lisp_Object handler;
3190 visit_file = Fexpand_file_name (visit, Qnil);
3192 visit_file = filename;
3193 filename = Fexpand_file_name (filename, Qnil);
3195 if (NILP (lockname))
3196 lockname = visit_file;
3198 /* We used to UNGCPRO here. BAD! visit_file is used below after
3199 more Lisp calling. */
3200 /* If the file name has special constructs in it,
3201 call the corresponding file handler. */
3202 handler = Ffind_file_name_handler (filename, Qwrite_region);
3203 /* If FILENAME has no handler, see if VISIT has one. */
3204 if (NILP (handler) && STRINGP (visit))
3205 handler = Ffind_file_name_handler (visit, Qwrite_region);
3207 if (!NILP (handler))
3209 Lisp_Object val = call8 (handler, Qwrite_region, start, end,
3210 filename, append, visit, lockname, codesys);
3213 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3214 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3215 current_buffer->filename = visit_file;
3216 MARK_MODELINE_CHANGED;
3224 #ifdef CLASH_DETECTION
3226 lock_file (lockname);
3227 #endif /* CLASH_DETECTION */
3229 /* Special kludge to simplify auto-saving. */
3232 start1 = BUF_BEG (current_buffer);
3233 end1 = BUF_Z (current_buffer);
3236 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
3238 given_buffer = current_buffer;
3239 annotations = build_annotations (start, end);
3240 if (current_buffer != given_buffer)
3242 start1 = BUF_BEGV (current_buffer);
3243 end1 = BUF_ZV (current_buffer);
3250 desc = open ((char *) XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0);
3254 desc = open ((char *) XSTRING_DATA (fn),
3255 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
3256 auto_saving ? auto_save_mode_bits : CREAT_MODE);
3261 #ifdef CLASH_DETECTION
3263 if (!auto_saving) unlock_file (lockname);
3265 #endif /* CLASH_DETECTION */
3266 report_file_error ("Opening output file", list1 (filename));
3270 Lisp_Object desc_locative = Fcons (make_int (desc), Qnil);
3271 Lisp_Object instream = Qnil, outstream = Qnil;
3272 struct gcpro nngcpro1, nngcpro2;
3273 /* need to gcpro; QUIT could happen out of call to write() */
3274 NNGCPRO2 (instream, outstream);
3276 record_unwind_protect (close_file_unwind, desc_locative);
3280 if (lseek (desc, 0, 2) < 0)
3282 #ifdef CLASH_DETECTION
3283 if (!auto_saving) unlock_file (lockname);
3284 #endif /* CLASH_DETECTION */
3285 report_file_error ("Lseek error",
3292 /* Note: I tried increasing the buffering size, along with
3293 various other tricks, but nothing seemed to make much of
3294 a difference in the time it took to save a large file.
3295 (Actually that's not true. With a local disk, changing
3296 the buffer size doesn't seem to make much difference.
3297 With an NFS-mounted disk, it could make a lot of difference
3298 because you're affecting the number of network requests
3299 that need to be made, and there could be a large latency
3300 for each request. So I've increased the buffer size
3302 outstream = make_filedesc_output_stream (desc, 0, -1, 0);
3303 Lstream_set_buffering (XLSTREAM (outstream),
3304 LSTREAM_BLOCKN_BUFFERED, 65536);
3307 make_encoding_output_stream (XLSTREAM (outstream), codesys);
3308 Lstream_set_buffering (XLSTREAM (outstream),
3309 LSTREAM_BLOCKN_BUFFERED, 65536);
3310 #endif /* FILE_CODING */
3311 if (STRINGP (start))
3313 instream = make_lisp_string_input_stream (start, 0, -1);
3317 instream = make_lisp_buffer_input_stream (current_buffer, start1, end1,
3319 LSTR_IGNORE_ACCESSIBLE);
3320 failure = (0 > (a_write (outstream, instream, start1,
3323 /* Note that this doesn't close the desc since we created the
3324 stream without the LSTR_CLOSING flag, but it does
3325 flush out any buffered data. */
3326 if (Lstream_close (XLSTREAM (outstream)) < 0)
3331 Lstream_close (XLSTREAM (instream));
3334 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3335 Disk full in NFS may be reported here. */
3336 /* mib says that closing the file will try to write as fast as NFS can do
3337 it, and that means the fsync here is not crucial for autosave files. */
3338 if (!auto_saving && fsync (desc) < 0
3339 /* If fsync fails with EINTR, don't treat that as serious. */
3345 #endif /* HAVE_FSYNC */
3347 /* Spurious "file has changed on disk" warnings used to be seen on
3348 systems where close() can change the modtime. This is known to
3349 happen on various NFS file systems, on Windows, and on Linux.
3350 Rather than handling this on a per-system basis, we
3351 unconditionally do the xemacs_stat() after the close(). */
3353 /* NFS can report a write failure now. */
3354 if (close (desc) < 0)
3360 /* Discard the close unwind-protect. Execute the one for
3361 build_annotations (switches back to the original current buffer
3363 XCAR (desc_locative) = Qnil;
3364 unbind_to (speccount, Qnil);
3369 xemacs_stat ((char *) XSTRING_DATA (fn), &st);
3371 #ifdef CLASH_DETECTION
3373 unlock_file (lockname);
3374 #endif /* CLASH_DETECTION */
3376 /* Do this before reporting IO error
3377 to avoid a "file has changed on disk" warning on
3378 next attempt to save. */
3380 current_buffer->modtime = st.st_mtime;
3385 report_file_error ("Writing file", list1 (fn));
3390 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3391 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3392 current_buffer->filename = visit_file;
3393 MARK_MODELINE_CHANGED;
3405 message ("Wrote %s", XSTRING_DATA (visit_file));
3408 Lisp_Object fsp = Qnil;
3409 struct gcpro nngcpro1;
3412 fsp = Ffile_symlink_p (fn);
3414 message ("Wrote %s", XSTRING_DATA (fn));
3416 message ("Wrote %s (symlink to %s)",
3417 XSTRING_DATA (fn), XSTRING_DATA (fsp));
3426 /* #### This is such a load of shit!!!! There is no way we should define
3427 something so stupid as a subr, just sort the fucking list more
3429 DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3430 Return t if (car A) is numerically less than (car B).
3434 Lisp_Object objs[2];
3437 return Flss (2, objs);
3440 /* Heh heh heh, let's define this too, just to aggravate the person who
3441 wrote the above comment. */
3442 DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3443 Return t if (cdr A) is numerically less than (cdr B).
3447 Lisp_Object objs[2];
3450 return Flss (2, objs);
3453 /* Build the complete list of annotations appropriate for writing out
3454 the text between START and END, by calling all the functions in
3455 write-region-annotate-functions and merging the lists they return.
3456 If one of these functions switches to a different buffer, we assume
3457 that buffer contains altered text. Therefore, the caller must
3458 make sure to restore the current buffer in all cases,
3459 as save-excursion would do. */
3462 build_annotations (Lisp_Object start, Lisp_Object end)
3464 /* This function can GC */
3465 Lisp_Object annotations;
3467 struct gcpro gcpro1, gcpro2;
3468 Lisp_Object original_buffer;
3470 XSETBUFFER (original_buffer, current_buffer);
3473 p = Vwrite_region_annotate_functions;
3474 GCPRO2 (annotations, p);
3477 struct buffer *given_buffer = current_buffer;
3478 Vwrite_region_annotations_so_far = annotations;
3479 res = call2 (Fcar (p), start, end);
3480 /* If the function makes a different buffer current,
3481 assume that means this buffer contains altered text to be output.
3482 Reset START and END from the buffer bounds
3483 and discard all previous annotations because they should have
3484 been dealt with by this function. */
3485 if (current_buffer != given_buffer)
3487 start = make_int (BUF_BEGV (current_buffer));
3488 end = make_int (BUF_ZV (current_buffer));
3491 Flength (res); /* Check basic validity of return value */
3492 annotations = merge (annotations, res, Qcar_less_than_car);
3496 /* Now do the same for annotation functions implied by the file-format */
3497 if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
3498 p = Vauto_save_file_format;
3500 p = current_buffer->file_format;
3503 struct buffer *given_buffer = current_buffer;
3504 Vwrite_region_annotations_so_far = annotations;
3505 res = call4 (Qformat_annotate_function, Fcar (p), start, end,
3507 if (current_buffer != given_buffer)
3509 start = make_int (BUF_BEGV (current_buffer));
3510 end = make_int (BUF_ZV (current_buffer));
3514 annotations = merge (annotations, res, Qcar_less_than_car);
3521 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3522 EOF is encountered), assuming they start at position POS in the buffer
3523 of string that STREAM refers to. Intersperse with them the annotations
3524 from *ANNOT that fall into the range of positions we are reading from,
3525 each at its appropriate position.
3527 Modify *ANNOT by discarding elements as we output them.
3528 The return value is negative in case of system call failure. */
3530 /* 4K should probably be fine. We just need to reduce the number of
3531 function calls to reasonable level. The Lstream stuff itself will
3532 batch to 64K to reduce the number of system calls. */
3534 #define A_WRITE_BATCH_SIZE 4096
3537 a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3542 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3543 Lstream *instr = XLSTREAM (instream);
3544 Lstream *outstr = XLSTREAM (outstream);
3546 while (LISTP (*annot))
3548 tem = Fcar_safe (Fcar (*annot));
3550 nextpos = XINT (tem);
3554 /* If there are annotations left and we have Mule, then we
3555 have to do the I/O one emchar at a time so we can
3556 determine when to insert the annotation. */
3560 while (pos != nextpos && (ch = Lstream_get_emchar (instr)) != EOF)
3562 if (Lstream_put_emchar (outstr, ch) < 0)
3570 while (pos != nextpos)
3572 /* Otherwise there is no point to that. Just go in batches. */
3573 int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE);
3575 chunk = Lstream_read (instr, largebuf, chunk);
3578 if (chunk == 0) /* EOF */
3580 if (Lstream_write (outstr, largebuf, chunk) < chunk)
3587 tem = Fcdr (Fcar (*annot));
3590 if (Lstream_write (outstr, XSTRING_DATA (tem),
3591 XSTRING_LENGTH (tem)) < 0)
3594 *annot = Fcdr (*annot);
3605 #include <des_crypt.h>
3607 #define CRYPT_BLOCK_SIZE 8 /* bytes */
3608 #define CRYPT_KEY_SIZE 8 /* bytes */
3610 DEFUN ("encrypt-string", Fencrypt_string, 2, 2, 0, /*
3611 Encrypt STRING using KEY.
3615 char *encrypted_string, *raw_key;
3616 int rounded_size, extra, key_size;
3618 /* !!#### May produce bogus data under Mule. */
3619 CHECK_STRING (string);
3622 extra = XSTRING_LENGTH (string) % CRYPT_BLOCK_SIZE;
3623 rounded_size = XSTRING_LENGTH (string) + extra;
3624 encrypted_string = alloca (rounded_size + 1);
3625 memcpy (encrypted_string, XSTRING_DATA (string), XSTRING_LENGTH (string));
3626 memset (encrypted_string + rounded_size - extra, 0, extra + 1);
3628 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3630 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3631 memcpy (raw_key, XSTRING_DATA (key), key_size);
3632 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3634 ecb_crypt (raw_key, encrypted_string, rounded_size,
3635 DES_ENCRYPT | DES_SW);
3636 return make_string (encrypted_string, rounded_size);
3639 DEFUN ("decrypt-string", Fdecrypt_string, 2, 2, 0, /*
3640 Decrypt STRING using KEY.
3644 char *decrypted_string, *raw_key;
3645 int string_size, key_size;
3647 CHECK_STRING (string);
3650 string_size = XSTRING_LENGTH (string) + 1;
3651 decrypted_string = alloca (string_size);
3652 memcpy (decrypted_string, XSTRING_DATA (string), string_size);
3653 decrypted_string[string_size - 1] = '\0';
3655 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3657 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3658 memcpy (raw_key, XSTRING_DATA (key), key_size);
3659 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3662 ecb_crypt (raw_key, decrypted_string, string_size, D | DES_SW);
3663 return make_string (decrypted_string, string_size - 1);
3668 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
3669 Return t if last mod time of BUFFER's visited file matches what BUFFER records.
3670 This means that the file has not been changed since it was visited or saved.
3674 /* This function can call lisp; GC checked 2000-07-11 ben */
3677 Lisp_Object handler;
3679 CHECK_BUFFER (buffer);
3680 b = XBUFFER (buffer);
3682 if (!STRINGP (b->filename)) return Qt;
3683 if (b->modtime == 0) return Qt;
3685 /* If the file name has special constructs in it,
3686 call the corresponding file handler. */
3687 handler = Ffind_file_name_handler (b->filename,
3688 Qverify_visited_file_modtime);
3689 if (!NILP (handler))
3690 return call2 (handler, Qverify_visited_file_modtime, buffer);
3692 if (xemacs_stat ((char *) XSTRING_DATA (b->filename), &st) < 0)
3694 /* If the file doesn't exist now and didn't exist before,
3695 we say that it isn't modified, provided the error is a tame one. */
3696 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3701 if (st.st_mtime == b->modtime
3702 /* If both are positive, accept them if they are off by one second. */
3703 || (st.st_mtime > 0 && b->modtime > 0
3704 && (st.st_mtime == b->modtime + 1
3705 || st.st_mtime == b->modtime - 1)))
3710 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3711 Clear out records of last mod time of visited file.
3712 Next attempt to save will certainly not complain of a discrepancy.
3716 current_buffer->modtime = 0;
3720 DEFUN ("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3721 Return the current buffer's recorded visited file modification time.
3722 The value is a list of the form (HIGH . LOW), like the time values
3723 that `file-attributes' returns.
3727 return time_to_lisp ((time_t) current_buffer->modtime);
3730 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3731 Update buffer's recorded modification time from the visited file's time.
3732 Useful if the buffer was not read from the file normally
3733 or if the file itself has been changed for some known benign reason.
3734 An argument specifies the modification time value to use
3735 \(instead of that of the visited file), in the form of a list
3736 \(HIGH . LOW) or (HIGH LOW).
3740 /* This function can call lisp */
3741 if (!NILP (time_list))
3744 lisp_to_time (time_list, &the_time);
3745 current_buffer->modtime = (int) the_time;
3749 Lisp_Object filename = Qnil;
3751 Lisp_Object handler;
3752 struct gcpro gcpro1, gcpro2, gcpro3;
3754 GCPRO3 (filename, time_list, current_buffer->filename);
3755 filename = Fexpand_file_name (current_buffer->filename, Qnil);
3757 /* If the file name has special constructs in it,
3758 call the corresponding file handler. */
3759 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
3761 if (!NILP (handler))
3762 /* The handler can find the file name the same way we did. */
3763 return call2 (handler, Qset_visited_file_modtime, Qnil);
3764 else if (xemacs_stat ((char *) XSTRING_DATA (filename), &st) >= 0)
3765 current_buffer->modtime = st.st_mtime;
3772 auto_save_error (Lisp_Object condition_object, Lisp_Object ignored)
3774 /* This function can call lisp */
3777 /* Don't try printing an error message after everything is gone! */
3778 if (preparing_for_armageddon)
3780 clear_echo_area (selected_frame (), Qauto_saving, 1);
3781 Fding (Qt, Qauto_save_error, Qnil);
3782 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3783 Fsleep_for (make_int (1));
3784 message ("Auto-saving...error!for %s", XSTRING_DATA (current_buffer->name));
3785 Fsleep_for (make_int (1));
3786 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3787 Fsleep_for (make_int (1));
3792 auto_save_1 (Lisp_Object ignored)
3794 /* This function can call lisp */
3795 /* #### I think caller is protecting current_buffer? */
3797 Lisp_Object fn = current_buffer->filename;
3798 Lisp_Object a = current_buffer->auto_save_file_name;
3803 /* Get visited file's mode to become the auto save file's mode. */
3805 xemacs_stat ((char *) XSTRING_DATA (fn), &st) >= 0)
3806 /* But make sure we can overwrite it later! */
3807 auto_save_mode_bits = st.st_mode | 0600;
3809 /* default mode for auto-save files of buffers with no file is
3810 readable by owner only. This may annoy some small number of
3811 people, but the alternative removes all privacy from email. */
3812 auto_save_mode_bits = 0600;
3815 /* !!#### need to deal with this 'escape-quoted everywhere */
3816 Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil,
3826 auto_save_expand_name_error (Lisp_Object condition_object, Lisp_Object ignored)
3828 /* #### this function should spew an error message about not being
3829 able to open the .saves file. */
3834 auto_save_expand_name (Lisp_Object name)
3836 struct gcpro gcpro1;
3838 /* note that caller did NOT gc protect name, so we do it. */
3839 /* #### dmoore - this might not be necessary, if condition_case_1
3840 protects it. but I don't think it does. */
3842 RETURN_UNGCPRO (Fexpand_file_name (name, Qnil));
3847 do_auto_save_unwind (Lisp_Object fd)
3854 do_auto_save_unwind_2 (Lisp_Object old_auto_saving)
3856 auto_saving = XINT (old_auto_saving);
3860 /* Fdo_auto_save() checks whether a GC is in progress when it is called,
3861 and if so, tries to avoid touching lisp objects.
3863 The only time that Fdo_auto_save() is called while GC is in progress
3864 is if we're going down, as a result of an abort() or a kill signal.
3865 It's fairly important that we generate autosave files in that case!
3868 DEFUN ("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3869 Auto-save all buffers that need it.
3870 This is all buffers that have auto-saving enabled
3871 and are changed since last auto-saved.
3872 Auto-saving writes the buffer into a file
3873 so that your editing is not lost if the system crashes.
3874 This file is not the file you visited; that changes only when you save.
3875 Normally we run the normal hook `auto-save-hook' before saving.
3877 Non-nil first argument means do not print any message if successful.
3878 Non-nil second argument means save only current buffer.
3880 (no_message, current_only))
3882 /* This function can call lisp */
3884 Lisp_Object tail, buf;
3886 int do_handled_files;
3887 Lisp_Object oquit = Qnil;
3888 Lisp_Object listfile = Qnil;
3891 int speccount = specpdl_depth ();
3892 struct gcpro gcpro1, gcpro2, gcpro3;
3894 XSETBUFFER (old, current_buffer);
3895 GCPRO3 (oquit, listfile, old);
3896 check_quit (); /* make Vquit_flag accurate */
3897 /* Ordinarily don't quit within this function,
3898 but don't make it impossible to quit (in case we get hung in I/O). */
3902 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3903 variables point to non-strings reached from Vbuffer_alist. */
3905 if (minibuf_level != 0 || preparing_for_armageddon)
3908 run_hook (Qauto_save_hook);
3910 if (STRINGP (Vauto_save_list_file_name))
3911 listfile = condition_case_1 (Qt,
3912 auto_save_expand_name,
3913 Vauto_save_list_file_name,
3914 auto_save_expand_name_error, Qnil);
3916 /* Make sure auto_saving is reset. */
3917 record_unwind_protect (do_auto_save_unwind_2, make_int (auto_saving));
3921 /* First, save all files which don't have handlers. If Emacs is
3922 crashing, the handlers may tweak what is causing Emacs to crash
3923 in the first place, and it would be a shame if Emacs failed to
3924 autosave perfectly ordinary files because it couldn't handle some
3926 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
3928 for (tail = Vbuffer_alist;
3932 buf = XCDR (XCAR (tail));
3935 if (!NILP (current_only)
3936 && b != current_buffer)
3939 /* Don't auto-save indirect buffers.
3940 The base buffer takes care of it. */
3944 /* Check for auto save enabled
3945 and file changed since last auto save
3946 and file changed since last real save. */
3947 if (STRINGP (b->auto_save_file_name)
3948 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
3949 && b->auto_save_modified < BUF_MODIFF (b)
3950 /* -1 means we've turned off autosaving for a while--see below. */
3951 && XINT (b->saved_size) >= 0
3952 && (do_handled_files
3953 || NILP (Ffind_file_name_handler (b->auto_save_file_name,
3956 EMACS_TIME before_time, after_time;
3958 EMACS_GET_TIME (before_time);
3959 /* If we had a failure, don't try again for 20 minutes. */
3960 if (!preparing_for_armageddon
3961 && b->auto_save_failure_time >= 0
3962 && (EMACS_SECS (before_time) - b->auto_save_failure_time <
3966 if (!preparing_for_armageddon &&
3967 (XINT (b->saved_size) * 10
3968 > (BUF_Z (b) - BUF_BEG (b)) * 13)
3969 /* A short file is likely to change a large fraction;
3970 spare the user annoying messages. */
3971 && XINT (b->saved_size) > 5000
3972 /* These messages are frequent and annoying for `*mail*'. */
3973 && !NILP (b->filename)
3974 && NILP (no_message)
3975 && disable_auto_save_when_buffer_shrinks)
3977 /* It has shrunk too much; turn off auto-saving here.
3978 Unless we're about to crash, in which case auto-save it
3982 ("Buffer %s has shrunk a lot; auto save turned off there",
3983 XSTRING_DATA (b->name));
3984 /* Turn off auto-saving until there's a real save,
3985 and prevent any more warnings. */
3986 b->saved_size = make_int (-1);
3987 if (!gc_in_progress)
3988 Fsleep_for (make_int (1));
3991 set_buffer_internal (b);
3992 if (!auto_saved && NILP (no_message))
3994 static const unsigned char *msg
3995 = (const unsigned char *) "Auto-saving...";
3996 echo_area_message (selected_frame (), msg, Qnil,
3997 0, strlen ((const char *) msg),
4001 /* Open the auto-save list file, if necessary.
4002 We only do this now so that the file only exists
4003 if we actually auto-saved any files. */
4004 if (!auto_saved && !inhibit_auto_save_session
4005 && !NILP (Vauto_save_list_file_prefix)
4006 && STRINGP (listfile) && listdesc < 0)
4008 listdesc = open ((char *) XSTRING_DATA (listfile),
4009 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4012 /* Arrange to close that file whether or not we get
4015 record_unwind_protect (do_auto_save_unwind,
4016 make_int (listdesc));
4019 /* Record all the buffers that we are auto-saving in
4020 the special file that lists them. For each of
4021 these buffers, record visited name (if any) and
4025 const Extbyte *auto_save_file_name_ext;
4026 Extcount auto_save_file_name_ext_len;
4028 TO_EXTERNAL_FORMAT (LISP_STRING, b->auto_save_file_name,
4029 ALLOCA, (auto_save_file_name_ext,
4030 auto_save_file_name_ext_len),
4032 if (!NILP (b->filename))
4034 const Extbyte *filename_ext;
4035 Extcount filename_ext_len;
4037 TO_EXTERNAL_FORMAT (LISP_STRING, b->filename,
4038 ALLOCA, (filename_ext,
4041 write (listdesc, filename_ext, filename_ext_len);
4043 write (listdesc, "\n", 1);
4044 write (listdesc, auto_save_file_name_ext,
4045 auto_save_file_name_ext_len);
4046 write (listdesc, "\n", 1);
4049 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
4050 based on values in Vbuffer_alist. auto_save_1 may
4051 cause lisp handlers to run. Those handlers may kill
4052 the buffer and then GC. Since the buffer is killed,
4053 it's no longer in Vbuffer_alist so it might get reaped
4054 by the GC. We also need to protect tail. */
4055 /* #### There is probably a lot of other code which has
4056 pointers into buffers which may get blown away by
4059 struct gcpro ngcpro1, ngcpro2;
4060 NGCPRO2 (buf, tail);
4061 condition_case_1 (Qt,
4063 auto_save_error, Qnil);
4066 /* Handler killed our saved current-buffer! Pick any. */
4067 if (!BUFFER_LIVE_P (XBUFFER (old)))
4068 XSETBUFFER (old, current_buffer);
4070 set_buffer_internal (XBUFFER (old));
4073 /* Handler killed their own buffer! */
4074 if (!BUFFER_LIVE_P(b))
4077 b->auto_save_modified = BUF_MODIFF (b);
4078 b->saved_size = make_int (BUF_SIZE (b));
4079 EMACS_GET_TIME (after_time);
4080 /* If auto-save took more than 60 seconds,
4081 assume it was an NFS failure that got a timeout. */
4082 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
4083 b->auto_save_failure_time = EMACS_SECS (after_time);
4088 /* Prevent another auto save till enough input events come in. */
4090 record_auto_save ();
4092 /* If we didn't save anything into the listfile, remove the old
4093 one because nothing needed to be auto-saved. Do this afterwards
4094 rather than before in case we get a crash attempting to autosave
4095 (in that case we'd still want the old one around). */
4096 if (listdesc < 0 && !auto_saved && STRINGP (listfile))
4097 unlink ((char *) XSTRING_DATA (listfile));
4099 /* Show "...done" only if the echo area would otherwise be empty. */
4100 if (auto_saved && NILP (no_message)
4101 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0)))
4103 static const unsigned char *msg
4104 = (const unsigned char *)"Auto-saving...done";
4105 echo_area_message (selected_frame (), msg, Qnil, 0,
4106 strlen ((const char *) msg), Qauto_saving);
4111 RETURN_UNGCPRO (unbind_to (speccount, Qnil));
4114 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
4115 Mark current buffer as auto-saved with its current text.
4116 No auto-save file will be written until the buffer changes again.
4120 current_buffer->auto_save_modified = BUF_MODIFF (current_buffer);
4121 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
4122 current_buffer->auto_save_failure_time = -1;
4126 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
4127 Clear any record of a recent auto-save failure in the current buffer.
4131 current_buffer->auto_save_failure_time = -1;
4135 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
4136 Return t if buffer has been auto-saved since last read in or saved.
4140 return (BUF_SAVE_MODIFF (current_buffer) <
4141 current_buffer->auto_save_modified) ? Qt : Qnil;
4145 /************************************************************************/
4146 /* initialization */
4147 /************************************************************************/
4150 syms_of_fileio (void)
4152 defsymbol (&Qexpand_file_name, "expand-file-name");
4153 defsymbol (&Qfile_truename, "file-truename");
4154 defsymbol (&Qsubstitute_in_file_name, "substitute-in-file-name");
4155 defsymbol (&Qdirectory_file_name, "directory-file-name");
4156 defsymbol (&Qfile_name_directory, "file-name-directory");
4157 defsymbol (&Qfile_name_nondirectory, "file-name-nondirectory");
4158 defsymbol (&Qunhandled_file_name_directory, "unhandled-file-name-directory");
4159 defsymbol (&Qfile_name_as_directory, "file-name-as-directory");
4160 defsymbol (&Qcopy_file, "copy-file");
4161 defsymbol (&Qmake_directory_internal, "make-directory-internal");
4162 defsymbol (&Qdelete_directory, "delete-directory");
4163 defsymbol (&Qdelete_file, "delete-file");
4164 defsymbol (&Qrename_file, "rename-file");
4165 defsymbol (&Qadd_name_to_file, "add-name-to-file");
4166 defsymbol (&Qmake_symbolic_link, "make-symbolic-link");
4167 defsymbol (&Qfile_exists_p, "file-exists-p");
4168 defsymbol (&Qfile_executable_p, "file-executable-p");
4169 defsymbol (&Qfile_readable_p, "file-readable-p");
4170 defsymbol (&Qfile_symlink_p, "file-symlink-p");
4171 defsymbol (&Qfile_writable_p, "file-writable-p");
4172 defsymbol (&Qfile_directory_p, "file-directory-p");
4173 defsymbol (&Qfile_regular_p, "file-regular-p");
4174 defsymbol (&Qfile_accessible_directory_p, "file-accessible-directory-p");
4175 defsymbol (&Qfile_modes, "file-modes");
4176 defsymbol (&Qset_file_modes, "set-file-modes");
4177 defsymbol (&Qfile_newer_than_file_p, "file-newer-than-file-p");
4178 defsymbol (&Qinsert_file_contents, "insert-file-contents");
4179 defsymbol (&Qwrite_region, "write-region");
4180 defsymbol (&Qverify_visited_file_modtime, "verify-visited-file-modtime");
4181 defsymbol (&Qset_visited_file_modtime, "set-visited-file-modtime");
4182 defsymbol (&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */
4184 defsymbol (&Qauto_save_hook, "auto-save-hook");
4185 defsymbol (&Qauto_save_error, "auto-save-error");
4186 defsymbol (&Qauto_saving, "auto-saving");
4188 defsymbol (&Qformat_decode, "format-decode");
4189 defsymbol (&Qformat_annotate_function, "format-annotate-function");
4191 defsymbol (&Qcompute_buffer_file_truename, "compute-buffer-file-truename");
4192 DEFERROR_STANDARD (Qfile_error, Qio_error);
4193 DEFERROR_STANDARD (Qfile_already_exists, Qfile_error);
4195 DEFSUBR (Ffind_file_name_handler);
4197 DEFSUBR (Ffile_name_directory);
4198 DEFSUBR (Ffile_name_nondirectory);
4199 DEFSUBR (Funhandled_file_name_directory);
4200 DEFSUBR (Ffile_name_as_directory);
4201 DEFSUBR (Fdirectory_file_name);
4202 DEFSUBR (Fmake_temp_name);
4203 DEFSUBR (Fexpand_file_name);
4204 DEFSUBR (Ffile_truename);
4205 DEFSUBR (Fsubstitute_in_file_name);
4206 DEFSUBR (Fcopy_file);
4207 DEFSUBR (Fmake_directory_internal);
4208 DEFSUBR (Fdelete_directory);
4209 DEFSUBR (Fdelete_file);
4210 DEFSUBR (Frename_file);
4211 DEFSUBR (Fadd_name_to_file);
4212 DEFSUBR (Fmake_symbolic_link);
4214 DEFSUBR (Fsysnetunam);
4215 #endif /* HPUX_NET */
4216 DEFSUBR (Ffile_name_absolute_p);
4217 DEFSUBR (Ffile_exists_p);
4218 DEFSUBR (Ffile_executable_p);
4219 DEFSUBR (Ffile_readable_p);
4220 DEFSUBR (Ffile_writable_p);
4221 DEFSUBR (Ffile_symlink_p);
4222 DEFSUBR (Ffile_directory_p);
4223 DEFSUBR (Ffile_accessible_directory_p);
4224 DEFSUBR (Ffile_regular_p);
4225 DEFSUBR (Ffile_modes);
4226 DEFSUBR (Fset_file_modes);
4227 DEFSUBR (Fset_default_file_modes);
4228 DEFSUBR (Fdefault_file_modes);
4229 DEFSUBR (Funix_sync);
4230 DEFSUBR (Ffile_newer_than_file_p);
4231 DEFSUBR (Finsert_file_contents_internal);
4232 DEFSUBR (Fwrite_region_internal);
4233 DEFSUBR (Fcar_less_than_car); /* Vomitous! */
4234 DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
4236 DEFSUBR (Fencrypt_string);
4237 DEFSUBR (Fdecrypt_string);
4239 DEFSUBR (Fverify_visited_file_modtime);
4240 DEFSUBR (Fclear_visited_file_modtime);
4241 DEFSUBR (Fvisited_file_modtime);
4242 DEFSUBR (Fset_visited_file_modtime);
4244 DEFSUBR (Fdo_auto_save);
4245 DEFSUBR (Fset_buffer_auto_saved);
4246 DEFSUBR (Fclear_buffer_auto_save_failure);
4247 DEFSUBR (Frecent_auto_save_p);
4251 vars_of_fileio (void)
4253 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /*
4254 *Format in which to write auto-save files.
4255 Should be a list of symbols naming formats that are defined in `format-alist'.
4256 If it is t, which is the default, auto-save files are written in the
4257 same format as a regular save would use.
4259 Vauto_save_file_format = Qt;
4261 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /*
4262 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
4263 If a file name matches REGEXP, then all I/O on that file is done by calling
4266 The first argument given to HANDLER is the name of the I/O primitive
4267 to be handled; the remaining arguments are the arguments that were
4268 passed to that primitive. For example, if you do
4269 (file-exists-p FILENAME)
4270 and FILENAME is handled by HANDLER, then HANDLER is called like this:
4271 (funcall HANDLER 'file-exists-p FILENAME)
4272 The function `find-file-name-handler' checks this list for a handler
4275 Vfile_name_handler_alist = Qnil;
4277 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /*
4278 A list of functions to be called at the end of `insert-file-contents'.
4279 Each is passed one argument, the number of bytes inserted. It should return
4280 the new byte count, and leave point the same. If `insert-file-contents' is
4281 intercepted by a handler from `file-name-handler-alist', that handler is
4282 responsible for calling the after-insert-file-functions if appropriate.
4284 Vafter_insert_file_functions = Qnil;
4286 DEFVAR_LISP ("write-region-annotate-functions",
4287 &Vwrite_region_annotate_functions /*
4288 A list of functions to be called at the start of `write-region'.
4289 Each is passed two arguments, START and END, as for `write-region'.
4290 It should return a list of pairs (POSITION . STRING) of strings to be
4291 effectively inserted at the specified positions of the file being written
4292 \(1 means to insert before the first byte written). The POSITIONs must be
4293 sorted into increasing order. If there are several functions in the list,
4294 the several lists are merged destructively.
4296 Vwrite_region_annotate_functions = Qnil;
4298 DEFVAR_LISP ("write-region-annotations-so-far",
4299 &Vwrite_region_annotations_so_far /*
4300 When an annotation function is called, this holds the previous annotations.
4301 These are the annotations made by other annotation functions
4302 that were already called. See also `write-region-annotate-functions'.
4304 Vwrite_region_annotations_so_far = Qnil;
4306 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
4307 A list of file name handlers that temporarily should not be used.
4308 This applies only to the operation `inhibit-file-name-operation'.
4310 Vinhibit_file_name_handlers = Qnil;
4312 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
4313 The operation for which `inhibit-file-name-handlers' is applicable.
4315 Vinhibit_file_name_operation = Qnil;
4317 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name /*
4318 File name in which we write a list of all auto save file names.
4320 Vauto_save_list_file_name = Qnil;
4322 DEFVAR_LISP ("auto-save-list-file-prefix", &Vauto_save_list_file_prefix /*
4323 Prefix for generating auto-save-list-file-name.
4324 Emacs's pid and the system name will be appended to
4325 this prefix to create a unique file name.
4327 Vauto_save_list_file_prefix = build_string ("~/.saves-");
4329 DEFVAR_BOOL ("inhibit-auto-save-session", &inhibit_auto_save_session /*
4330 When non-nil, inhibit auto save list file creation.
4332 inhibit_auto_save_session = 0;
4334 DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks",
4335 &disable_auto_save_when_buffer_shrinks /*
4336 If non-nil, auto-saving is disabled when a buffer shrinks too much.
4337 This is to prevent you from losing your edits if you accidentally
4338 delete a large chunk of the buffer and don't notice it until too late.
4339 Saving the buffer normally turns auto-save back on.
4341 disable_auto_save_when_buffer_shrinks = 1;
4343 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /*
4344 Directory separator character for built-in functions that return file names.
4345 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
4346 This variable affects the built-in functions only on Windows,
4347 on other platforms, it is initialized so that Lisp code can find out
4348 what the normal separator is.
4351 Vdirectory_sep_char = make_char ('\\');
4353 Vdirectory_sep_char = make_char ('/');
4356 reinit_vars_of_fileio ();
4360 reinit_vars_of_fileio (void)
4362 /* We want temp_name_rand to be initialized to a value likely to be
4363 unique to the process, not to the executable. The danger is that
4364 two different XEmacs processes using the same binary on different
4365 machines creating temp files in the same directory will be
4366 unlucky enough to have the same pid. If we randomize using
4367 process startup time, then in practice they will be unlikely to
4368 collide. We use the microseconds field so that scripts that start
4369 simultaneous XEmacs processes on multiple machines will have less
4370 chance of collision. */
4374 EMACS_GET_TIME (thyme);
4375 temp_name_rand = (unsigned int) (EMACS_SECS (thyme) ^ EMACS_USECS (thyme));