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 */
58 #define IS_DRIVE(x) isalpha (x)
59 /* Need to lower-case the drive letter, or else expanded
60 filenames will sometimes compare inequal, because
61 `expand-file-name' doesn't always down-case the drive letter. */
62 #define DRIVE_LETTER(x) tolower (x)
63 #endif /* WIN32_NATIVE */
65 int lisp_to_time (Lisp_Object, time_t *);
66 Lisp_Object time_to_lisp (time_t);
68 /* Nonzero during writing of auto-save files */
69 static int auto_saving;
71 /* Set by auto_save_1 to mode of original file so Fwrite_region_internal
72 will create a new file with the same mode as the original */
73 static int auto_save_mode_bits;
75 /* Alist of elements (REGEXP . HANDLER) for file names
76 whose I/O is done with a special handler. */
77 Lisp_Object Vfile_name_handler_alist;
79 /* Format for auto-save files */
80 Lisp_Object Vauto_save_file_format;
82 /* Lisp functions for translating file formats */
83 Lisp_Object Qformat_decode, Qformat_annotate_function;
85 /* Functions to be called to process text properties in inserted file. */
86 Lisp_Object Vafter_insert_file_functions;
88 /* Functions to be called to create text property annotations for file. */
89 Lisp_Object Vwrite_region_annotate_functions;
91 /* During build_annotations, each time an annotation function is called,
92 this holds the annotations made by the previous functions. */
93 Lisp_Object Vwrite_region_annotations_so_far;
95 /* File name in which we write a list of all our auto save files. */
96 Lisp_Object Vauto_save_list_file_name;
98 /* Prefix used to construct Vauto_save_list_file_name. */
99 Lisp_Object Vauto_save_list_file_prefix;
101 /* When non-nil, it prevents auto-save list file creation. */
102 int inhibit_auto_save_session;
104 int disable_auto_save_when_buffer_shrinks;
106 Lisp_Object Vdirectory_sep_char;
108 /* These variables describe handlers that have "already" had a chance
109 to handle the current operation.
111 Vinhibit_file_name_handlers is a list of file name handlers.
112 Vinhibit_file_name_operation is the operation being handled.
113 If we try to handle that operation, we ignore those handlers. */
115 static Lisp_Object Vinhibit_file_name_handlers;
116 static Lisp_Object Vinhibit_file_name_operation;
118 Lisp_Object Qfile_error, Qfile_already_exists;
120 Lisp_Object Qauto_save_hook;
121 Lisp_Object Qauto_save_error;
122 Lisp_Object Qauto_saving;
124 Lisp_Object Qcar_less_than_car;
126 Lisp_Object Qcompute_buffer_file_truename;
128 EXFUN (Frunning_temacs_p, 0);
130 /* signal a file error when errno contains a meaningful value. */
133 report_file_error (const char *string, Lisp_Object data)
135 /* #### dmoore - This uses current_buffer, better make sure no one
136 has GC'd the current buffer. File handlers are giving me a headache
137 maybe I'll just always protect current_buffer around all of those
140 signal_error (Qfile_error,
141 Fcons (build_translated_string (string),
142 Fcons (lisp_strerror (errno), data)));
146 maybe_report_file_error (const char *string, Lisp_Object data,
147 Lisp_Object class, Error_behavior errb)
150 if (ERRB_EQ (errb, ERROR_ME_NOT))
153 maybe_signal_error (Qfile_error,
154 Fcons (build_translated_string (string),
155 Fcons (lisp_strerror (errno), data)),
159 /* signal a file error when errno does not contain a meaningful value. */
162 signal_file_error (const char *string, Lisp_Object data)
164 signal_error (Qfile_error,
165 list2 (build_translated_string (string), data));
169 maybe_signal_file_error (const char *string, Lisp_Object data,
170 Lisp_Object class, Error_behavior errb)
173 if (ERRB_EQ (errb, ERROR_ME_NOT))
175 maybe_signal_error (Qfile_error,
176 list2 (build_translated_string (string), data),
181 signal_double_file_error (const char *string1, const char *string2,
184 signal_error (Qfile_error,
185 list3 (build_translated_string (string1),
186 build_translated_string (string2),
191 maybe_signal_double_file_error (const char *string1, const char *string2,
192 Lisp_Object data, Lisp_Object class,
196 if (ERRB_EQ (errb, ERROR_ME_NOT))
198 maybe_signal_error (Qfile_error,
199 list3 (build_translated_string (string1),
200 build_translated_string (string2),
206 signal_double_file_error_2 (const char *string1, const char *string2,
207 Lisp_Object data1, Lisp_Object data2)
209 signal_error (Qfile_error,
210 list4 (build_translated_string (string1),
211 build_translated_string (string2),
216 maybe_signal_double_file_error_2 (const char *string1, const char *string2,
217 Lisp_Object data1, Lisp_Object data2,
218 Lisp_Object class, Error_behavior errb)
221 if (ERRB_EQ (errb, ERROR_ME_NOT))
223 maybe_signal_error (Qfile_error,
224 list4 (build_translated_string (string1),
225 build_translated_string (string2),
231 /* Just like strerror(3), except return a lisp string instead of char *.
232 The string needs to be converted since it may be localized.
233 Perhaps this should use strerror-coding-system instead? */
235 lisp_strerror (int errnum)
237 return build_ext_string (strerror (errnum), Qnative);
241 close_file_unwind (Lisp_Object fd)
245 if (INTP (XCAR (fd)))
246 close (XINT (XCAR (fd)));
248 free_cons (XCONS (fd));
257 delete_stream_unwind (Lisp_Object stream)
259 Lstream_delete (XLSTREAM (stream));
263 /* Restore point, having saved it as a marker. */
266 restore_point_unwind (Lisp_Object point_marker)
268 BUF_SET_PT (current_buffer, marker_position (point_marker));
269 return Fset_marker (point_marker, Qnil, Qnil);
272 /* Versions of read() and write() that allow quitting out of the actual
273 I/O. We don't use immediate_quit (i.e. direct longjmp() out of the
274 signal handler) because that's way too losing.
276 (#### Actually, longjmp()ing out of the signal handler may not be
277 as losing as I thought. See sys_do_signal() in sysdep.c.) */
280 read_allowing_quit (int fildes, void *buf, size_t size)
283 return sys_read_1 (fildes, buf, size, 1);
287 write_allowing_quit (int fildes, const void *buf, size_t size)
290 return sys_write_1 (fildes, buf, size, 1);
294 Lisp_Object Qexpand_file_name;
295 Lisp_Object Qfile_truename;
296 Lisp_Object Qsubstitute_in_file_name;
297 Lisp_Object Qdirectory_file_name;
298 Lisp_Object Qfile_name_directory;
299 Lisp_Object Qfile_name_nondirectory;
300 Lisp_Object Qunhandled_file_name_directory;
301 Lisp_Object Qfile_name_as_directory;
302 Lisp_Object Qcopy_file;
303 Lisp_Object Qmake_directory_internal;
304 Lisp_Object Qdelete_directory;
305 Lisp_Object Qdelete_file;
306 Lisp_Object Qrename_file;
307 Lisp_Object Qadd_name_to_file;
308 Lisp_Object Qmake_symbolic_link;
309 Lisp_Object Qfile_exists_p;
310 Lisp_Object Qfile_executable_p;
311 Lisp_Object Qfile_readable_p;
312 Lisp_Object Qfile_symlink_p;
313 Lisp_Object Qfile_writable_p;
314 Lisp_Object Qfile_directory_p;
315 Lisp_Object Qfile_regular_p;
316 Lisp_Object Qfile_accessible_directory_p;
317 Lisp_Object Qfile_modes;
318 Lisp_Object Qset_file_modes;
319 Lisp_Object Qfile_newer_than_file_p;
320 Lisp_Object Qinsert_file_contents;
321 Lisp_Object Qwrite_region;
322 Lisp_Object Qverify_visited_file_modtime;
323 Lisp_Object Qset_visited_file_modtime;
325 /* If FILENAME is handled specially on account of its syntax,
326 return its handler function. Otherwise, return nil. */
328 DEFUN ("find-file-name-handler", Ffind_file_name_handler, 1, 2, 0, /*
329 Return FILENAME's handler function for OPERATION, if it has one.
330 Otherwise, return nil.
331 A file name is handled if one of the regular expressions in
332 `file-name-handler-alist' matches it.
334 If OPERATION equals `inhibit-file-name-operation', then we ignore
335 any handlers that are members of `inhibit-file-name-handlers',
336 but we still do run any other handlers. This lets handlers
337 use the standard functions without calling themselves recursively.
339 (filename, operation))
341 /* This function does not GC */
342 /* This function can be called during GC */
343 /* This function must not munge the match data. */
344 Lisp_Object chain, inhibited_handlers;
346 CHECK_STRING (filename);
348 if (EQ (operation, Vinhibit_file_name_operation))
349 inhibited_handlers = Vinhibit_file_name_handlers;
351 inhibited_handlers = Qnil;
353 EXTERNAL_LIST_LOOP (chain, Vfile_name_handler_alist)
355 Lisp_Object elt = XCAR (chain);
358 Lisp_Object string = XCAR (elt);
360 && (fast_lisp_string_match (string, filename) >= 0))
362 Lisp_Object handler = XCDR (elt);
363 if (NILP (Fmemq (handler, inhibited_handlers)))
373 call2_check_string (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
375 /* This function can call lisp */
376 Lisp_Object result = call2 (fn, arg0, arg1);
377 CHECK_STRING (result);
382 call2_check_string_or_nil (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
384 /* This function can call lisp */
385 Lisp_Object result = call2 (fn, arg0, arg1);
387 CHECK_STRING (result);
392 call3_check_string (Lisp_Object fn, Lisp_Object arg0,
393 Lisp_Object arg1, Lisp_Object arg2)
395 /* This function can call lisp */
396 Lisp_Object result = call3 (fn, arg0, arg1, arg2);
397 CHECK_STRING (result);
402 DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /*
403 Return the directory component in file name FILENAME.
404 Return nil if FILENAME does not include a directory.
405 Otherwise return a directory spec.
406 Given a Unix syntax file name, returns a string ending in slash.
410 /* This function can GC. GC checked 2000-07-28 ben */
415 CHECK_STRING (filename);
417 /* If the file name has special constructs in it,
418 call the corresponding file handler. */
419 handler = Ffind_file_name_handler (filename, Qfile_name_directory);
421 return call2_check_string_or_nil (handler, Qfile_name_directory, filename);
423 #ifdef FILE_SYSTEM_CASE
424 filename = FILE_SYSTEM_CASE (filename);
426 beg = XSTRING_DATA (filename);
427 p = beg + XSTRING_LENGTH (filename);
429 while (p != beg && !IS_ANY_SEP (p[-1])
431 /* only recognize drive specifier at beginning */
432 && !(p[-1] == ':' && p == beg + 2)
439 /* Expansion of "c:" to drive and default directory. */
440 /* (NT does the right thing.) */
441 if (p == beg + 2 && beg[1] == ':')
443 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
444 Bufbyte *res = (Bufbyte*) alloca (MAXPATHLEN + 1);
445 if (_getdcwd (toupper (*beg) - 'A' + 1, (char *)res, MAXPATHLEN))
447 char *c=((char *) res) + strlen ((char *) res);
448 if (!IS_DIRECTORY_SEP (*c))
450 *c++ = DIRECTORY_SEP;
454 p = beg + strlen ((char *) beg);
457 #endif /* WIN32_NATIVE */
458 return make_string (beg, p - beg);
461 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /*
462 Return file name FILENAME sans its directory.
463 For example, in a Unix-syntax file name,
464 this is everything after the last slash,
465 or the entire name if it contains no slash.
469 /* This function can GC. GC checked 2000-07-28 ben */
470 Bufbyte *beg, *p, *end;
473 CHECK_STRING (filename);
475 /* If the file name has special constructs in it,
476 call the corresponding file handler. */
477 handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
479 return call2_check_string (handler, Qfile_name_nondirectory, filename);
481 beg = XSTRING_DATA (filename);
482 end = p = beg + XSTRING_LENGTH (filename);
484 while (p != beg && !IS_ANY_SEP (p[-1])
486 /* only recognize drive specifier at beginning */
487 && !(p[-1] == ':' && p == beg + 2)
491 return make_string (p, end - p);
494 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /*
495 Return a directly usable directory name somehow associated with FILENAME.
496 A `directly usable' directory name is one that may be used without the
497 intervention of any file handler.
498 If FILENAME is a directly usable file itself, return
499 \(file-name-directory FILENAME).
500 The `call-process' and `start-process' functions use this function to
501 get a current directory to run processes in.
505 /* This function can GC. GC checked 2000-07-28 ben */
508 /* If the file name has special constructs in it,
509 call the corresponding file handler. */
510 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
512 return call2 (handler, Qunhandled_file_name_directory,
515 return Ffile_name_directory (filename);
520 file_name_as_directory (char *out, char *in)
522 /* This function cannot GC */
523 int size = strlen (in);
528 out[1] = DIRECTORY_SEP;
534 /* Append a slash if necessary */
535 if (!IS_ANY_SEP (out[size-1]))
537 out[size] = DIRECTORY_SEP;
538 out[size + 1] = '\0';
544 DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /*
545 Return a string representing file FILENAME interpreted as a directory.
546 This operation exists because a directory is also a file, but its name as
547 a directory is different from its name as a file.
548 The result can be used as the value of `default-directory'
549 or passed as second argument to `expand-file-name'.
550 For a Unix-syntax file name, just appends a slash,
551 except for (file-name-as-directory \"\") => \"./\".
555 /* This function can GC. GC checked 2000-07-28 ben */
559 CHECK_STRING (filename);
561 /* If the file name has special constructs in it,
562 call the corresponding file handler. */
563 handler = Ffind_file_name_handler (filename, Qfile_name_as_directory);
565 return call2_check_string (handler, Qfile_name_as_directory, filename);
567 buf = (char *) alloca (XSTRING_LENGTH (filename) + 10);
568 return build_string (file_name_as_directory
569 (buf, (char *) XSTRING_DATA (filename)));
573 * Convert from directory name to filename.
574 * On UNIX, it's simple: just make sure there isn't a terminating /
576 * Value is nonzero if the string output is different from the input.
580 directory_file_name (const char *src, char *dst)
582 /* This function cannot GC */
583 long slen = strlen (src);
584 /* Process as Unix format: just remove any final slash.
585 But leave "/" unchanged; do not change it to "". */
588 && IS_DIRECTORY_SEP (dst[slen - 1])
590 && !IS_ANY_SEP (dst[slen - 2])
591 #endif /* WIN32_NATIVE */
597 DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
598 Return the file name of the directory named DIRECTORY.
599 This is the name of the file that holds the data for the directory.
600 This operation exists because a directory is also a file, but its name as
601 a directory is different from its name as a file.
602 In Unix-syntax, this function just removes the final slash.
606 /* This function can GC. GC checked 2000-07-28 ben */
610 CHECK_STRING (directory);
612 #if 0 /* #### WTF? */
613 if (NILP (directory))
617 /* If the file name has special constructs in it,
618 call the corresponding file handler. */
619 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
621 return call2_check_string (handler, Qdirectory_file_name, directory);
622 buf = (char *) alloca (XSTRING_LENGTH (directory) + 20);
623 directory_file_name ((char *) XSTRING_DATA (directory), buf);
624 return build_string (buf);
627 /* Fmake_temp_name used to be a simple wrapper around mktemp(), but it
628 proved too broken for our purposes (it supported only 26 or 62
629 unique names under some implementations). For example, this
630 arbitrary limit broke generation of Gnus Incoming* files.
632 This implementation is better than what one usually finds in libc.
635 static unsigned int temp_name_rand;
637 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
638 Generate a temporary file name starting with PREFIX.
639 The Emacs process number forms part of the result, so there is no
640 danger of generating a name being used by another process.
642 In addition, this function makes an attempt to choose a name that
643 does not specify an existing file. To make this work, PREFIX should
644 be an absolute file name.
648 static const char tbl[64] =
650 'A','B','C','D','E','F','G','H',
651 'I','J','K','L','M','N','O','P',
652 'Q','R','S','T','U','V','W','X',
653 'Y','Z','a','b','c','d','e','f',
654 'g','h','i','j','k','l','m','n',
655 'o','p','q','r','s','t','u','v',
656 'w','x','y','z','0','1','2','3',
657 '4','5','6','7','8','9','-','_'
664 CHECK_STRING (prefix);
666 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's
669 1) It might change the prefix, so the resulting string might not
670 begin with PREFIX. This violates the principle of least
673 2) It breaks under many unforeseeable circumstances, such as with
674 the code that uses (make-temp-name "") instead of
675 (make-temp-name "./").
677 3) It might yield unexpected (to stat(2)) results in the presence
678 of EFS and file name handlers. */
680 len = XSTRING_LENGTH (prefix);
681 val = make_uninit_string (len + 6);
682 data = XSTRING_DATA (val);
683 memcpy (data, XSTRING_DATA (prefix), len);
686 /* VAL is created by adding 6 characters to PREFIX. The first three
687 are the PID of this process, in base 64, and the second three are
688 a pseudo-random number seeded from process startup time. This
689 ensures 262144 unique file names per PID per PREFIX per machine. */
692 unsigned int pid = (unsigned int) getpid ();
693 *p++ = tbl[(pid >> 0) & 63];
694 *p++ = tbl[(pid >> 6) & 63];
695 *p++ = tbl[(pid >> 12) & 63];
698 /* Here we try to minimize useless stat'ing when this function is
699 invoked many times successively with the same PREFIX. We achieve
700 this by using a very pseudo-random number generator to generate
701 file names unique to this process, with a very long cycle. */
707 p[0] = tbl[(temp_name_rand >> 0) & 63];
708 p[1] = tbl[(temp_name_rand >> 6) & 63];
709 p[2] = tbl[(temp_name_rand >> 12) & 63];
711 /* Poor man's congruential RN generator. Replace with ++count
713 temp_name_rand += 25229;
714 temp_name_rand %= 225307;
718 if (xemacs_stat ((const char *) data, &ignored) < 0)
720 /* We want to return only if errno is ENOENT. */
724 /* The error here is dubious, but there is little else we
725 can do. The alternatives are to return nil, which is
726 as bad as (and in many cases worse than) throwing the
727 error, or to ignore the error, which will likely result
729 report_file_error ("Cannot create temporary name for prefix",
731 return Qnil; /* not reached */
737 DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /*
738 Convert filename NAME to absolute, and canonicalize it.
739 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
740 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
741 the current buffer's value of `default-directory' is used.
742 File name components that are `.' are removed, and
743 so are file name components followed by `..', along with the `..' itself;
744 note that these simplifications are done without checking the resulting
745 file names in the file system.
746 An initial `~/' expands to your home directory.
747 An initial `~USER/' expands to USER's home directory.
748 See also the function `substitute-in-file-name'.
750 (name, default_directory))
752 /* This function can GC. GC-checked 2000-11-18 */
755 Bufbyte *newdir, *p, *o;
760 int collapse_newdir = 1;
763 #endif /* WIN32_NATIVE */
765 Lisp_Object handler = Qnil;
769 struct gcpro gcpro1, gcpro2, gcpro3;
771 /* both of these get set below */
772 GCPRO3 (name, default_directory, handler);
776 /* If the file name has special constructs in it,
777 call the corresponding file handler. */
778 handler = Ffind_file_name_handler (name, Qexpand_file_name);
780 RETURN_UNGCPRO (call3_check_string (handler, Qexpand_file_name,
781 name, default_directory));
783 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
784 if (NILP (default_directory))
785 default_directory = current_buffer->directory;
786 if (! STRINGP (default_directory))
787 default_directory = build_string ("/");
789 if (!NILP (default_directory))
791 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
793 RETURN_UNGCPRO (call3 (handler, Qexpand_file_name,
794 name, default_directory));
797 o = XSTRING_DATA (default_directory);
799 /* Make sure DEFAULT_DIRECTORY is properly expanded.
800 It would be better to do this down below where we actually use
801 default_directory. Unfortunately, calling Fexpand_file_name recursively
802 could invoke GC, and the strings might be relocated. This would
803 be annoying because we have pointers into strings lying around
804 that would need adjusting, and people would add new pointers to
805 the code and forget to adjust them, resulting in intermittent bugs.
806 Putting this call here avoids all that crud.
808 The EQ test avoids infinite recursion. */
809 if (! NILP (default_directory) && !EQ (default_directory, name)
810 /* Save time in some common cases - as long as default_directory
811 is not relative, it can be canonicalized with name below (if it
812 is needed at all) without requiring it to be expanded now. */
814 /* Detect Windows file names with drive specifiers. */
815 && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2])))
816 /* Detect Windows file names in UNC format. */
817 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
819 #else /* not WIN32_NATIVE */
821 /* Detect Unix absolute file names (/... alone is not absolute on
823 && ! (IS_DIRECTORY_SEP (o[0]))
824 #endif /* not WIN32_NATIVE */
827 default_directory = Fexpand_file_name (default_directory, Qnil);
829 #ifdef FILE_SYSTEM_CASE
830 name = FILE_SYSTEM_CASE (name);
833 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing
834 into name should be safe during all of this, though. */
835 nm = XSTRING_DATA (name);
838 /* We will force directory separators to be either all \ or /, so make
839 a local copy to modify, even if there ends up being no change. */
840 nm = strcpy ((char *)alloca (strlen ((char *)nm) + 1), (char *)nm);
842 /* Find and remove drive specifier if present; this makes nm absolute
843 even if the rest of the name appears to be relative. */
845 Bufbyte *colon = (Bufbyte *) strrchr ((char *)nm, ':');
848 /* Only recognize colon as part of drive specifier if there is a
849 single alphabetic character preceding the colon (and if the
850 character before the drive letter, if present, is a directory
851 separator); this is to support the remote system syntax used by
852 ange-ftp, and the "po:username" syntax for POP mailboxes. */
856 else if (IS_DRIVE (colon[-1])
857 && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2])))
864 while (--colon >= nm)
870 /* If we see "c://somedir", we want to strip the first slash after the
871 colon when stripping the drive letter. Otherwise, this expands to
873 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
875 #endif /* WIN32_NATIVE */
877 /* If nm is absolute, look for /./ or /../ sequences; if none are
878 found, we can probably return right away. We will avoid allocating
879 a new string if name is already fully expanded. */
881 IS_DIRECTORY_SEP (nm[0])
883 && (drive || IS_DIRECTORY_SEP (nm[1]))
887 /* If it turns out that the filename we want to return is just a
888 suffix of FILENAME, we don't need to go through and edit
889 things; we just need to construct a new string using data
890 starting at the middle of FILENAME. If we set lose to a
891 non-zero value, that means we've discovered that we can't do
898 /* Since we know the name is absolute, we can assume that each
899 element starts with a "/". */
901 /* "." and ".." are hairy. */
902 if (IS_DIRECTORY_SEP (p[0])
904 && (IS_DIRECTORY_SEP (p[2])
906 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
914 /* Make sure directories are all separated with / or \ as
915 desired, but avoid allocation of a new string when not
917 CORRECT_DIR_SEPS (nm);
918 if (IS_DIRECTORY_SEP (nm[1]))
920 if (strcmp (nm, XSTRING_DATA (name)) != 0)
921 name = build_string (nm);
923 /* drive must be set, so this is okay */
924 else if (strcmp (nm - 2, XSTRING_DATA (name)) != 0)
926 name = make_string (nm - 2, p - nm + 2);
927 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
928 XSTRING_DATA (name)[1] = ':';
930 RETURN_UNGCPRO (name);
931 #else /* not WIN32_NATIVE */
932 if (nm == XSTRING_DATA (name))
933 RETURN_UNGCPRO (name);
934 RETURN_UNGCPRO (build_string ((char *) nm));
935 #endif /* not WIN32_NATIVE */
939 /* At this point, nm might or might not be an absolute file name. We
940 need to expand ~ or ~user if present, otherwise prefix nm with
941 default_directory if nm is not absolute, and finally collapse /./
942 and /foo/../ sequences.
944 We set newdir to be the appropriate prefix if one is needed:
945 - the relevant user directory if nm starts with ~ or ~user
946 - the specified drive's working dir (DOS/NT only) if nm does not
948 - the value of default_directory.
950 Note that these prefixes are not guaranteed to be absolute (except
951 for the working dir of a drive). Therefore, to ensure we always
952 return an absolute name, if the final prefix is not absolute we
953 append it to the current working directory. */
957 if (nm[0] == '~') /* prefix ~ */
959 if (IS_DIRECTORY_SEP (nm[1])
960 || nm[1] == 0) /* ~ by itself */
962 Extbyte *newdir_external = get_home_directory ();
964 if (newdir_external == NULL)
965 newdir = (Bufbyte *) "";
967 TO_INTERNAL_FORMAT (C_STRING, newdir_external,
968 C_STRING_ALLOCA, (* ((char **) &newdir)),
976 else /* ~user/filename */
978 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++)
980 o = (Bufbyte *) alloca (p - nm + 1);
981 memcpy (o, (char *) nm, p - nm);
984 /* #### While NT is single-user (for the moment) you still
985 can have multiple user profiles users defined, each with
986 its HOME. So maybe possibly we should think about handling
990 if ((user = user_login_name (NULL)) != NULL)
992 /* Does the user login name match the ~name? */
993 if (strcmp (user, (char *) o + 1) == 0)
995 newdir = (Bufbyte *) get_home_directory();
1002 /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM
1003 occurring in it. (It can call select()). */
1004 slow_down_interrupts ();
1005 pw = (struct passwd *) getpwnam ((char *) o + 1);
1006 speed_up_interrupts ();
1009 newdir = (Bufbyte *) pw -> pw_dir;
1015 #endif /* not WIN32_NATIVE */
1017 /* If we don't find a user of that name, leave the name
1018 unchanged; don't move nm forward to p. */
1023 /* On DOS and Windows, nm is absolute if a drive name was specified;
1024 use the drive's current directory as the prefix if needed. */
1025 if (!newdir && drive)
1027 /* Get default directory if needed to make nm absolute. */
1028 if (!IS_DIRECTORY_SEP (nm[0]))
1030 newdir = alloca (MAXPATHLEN + 1);
1031 if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN))
1036 /* Either nm starts with /, or drive isn't mounted. */
1037 newdir = alloca (4);
1038 newdir[0] = DRIVE_LETTER (drive);
1044 #endif /* WIN32_NATIVE */
1046 /* Finally, if no prefix has been specified and nm is not absolute,
1047 then it must be expanded relative to default_directory. */
1050 #ifndef WIN32_NATIVE
1051 /* /... alone is not absolute on DOS and Windows. */
1052 && !IS_DIRECTORY_SEP (nm[0])
1054 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
1058 newdir = XSTRING_DATA (default_directory);
1064 /* First ensure newdir is an absolute name. */
1066 /* Detect Windows file names with drive specifiers. */
1067 ! (IS_DRIVE (newdir[0])
1068 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
1069 /* Detect Windows file names in UNC format. */
1070 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1071 /* Detect drive spec by itself */
1072 && ! (IS_DEVICE_SEP (newdir[1]) && newdir[2] == 0)
1075 /* Effectively, let newdir be (expand-file-name newdir cwd).
1076 Because of the admonition against calling expand-file-name
1077 when we have pointers into lisp strings, we accomplish this
1078 indirectly by prepending newdir to nm if necessary, and using
1079 cwd (or the wd of newdir's drive) as the new newdir. */
1081 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1086 if (!IS_DIRECTORY_SEP (nm[0]))
1088 char * tmp = alloca (strlen (newdir) + strlen (nm) + 2);
1089 file_name_as_directory (tmp, newdir);
1093 newdir = alloca (MAXPATHLEN + 1);
1096 if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN))
1103 /* Strip off drive name from prefix, if present. */
1104 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1110 /* Keep only a prefix from newdir if nm starts with slash
1111 (/ /server/share for UNC, nothing otherwise). */
1112 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
1114 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1116 newdir = strcpy (alloca (strlen (newdir) + 1), newdir);
1118 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1120 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1127 #endif /* WIN32_NATIVE */
1131 /* Get rid of any slash at the end of newdir, unless newdir is
1132 just // (an incomplete UNC name). */
1133 length = strlen ((char *) newdir);
1134 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
1136 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
1140 Bufbyte *temp = (Bufbyte *) alloca (length);
1141 memcpy (temp, newdir, length - 1);
1142 temp[length - 1] = 0;
1150 /* Now concatenate the directory and name to new space in the stack frame */
1151 tlen += strlen ((char *) nm) + 1;
1153 /* Add reserved space for drive name. (The Microsoft x86 compiler
1154 produces incorrect code if the following two lines are combined.) */
1155 target = (Bufbyte *) alloca (tlen + 2);
1157 #else /* not WIN32_NATIVE */
1158 target = (Bufbyte *) alloca (tlen);
1159 #endif /* not WIN32_NATIVE */
1164 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
1165 strcpy ((char *) target, (char *) newdir);
1167 file_name_as_directory ((char *) target, (char *) newdir);
1170 strcat ((char *) target, (char *) nm);
1172 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1174 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1181 if (!IS_DIRECTORY_SEP (*p))
1185 else if (IS_DIRECTORY_SEP (p[0])
1187 && (IS_DIRECTORY_SEP (p[2])
1190 /* If "/." is the entire filename, keep the "/". Otherwise,
1191 just delete the whole "/.". */
1192 if (o == target && p[2] == '\0')
1196 else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
1197 /* `/../' is the "superroot" on certain file systems. */
1199 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
1201 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
1203 /* Keep initial / only if this is the whole name. */
1204 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
1209 /* if drive is set, we're not dealing with an UNC, so
1210 multiple dir-seps are redundant (and reportedly cause trouble
1212 else if (drive && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
1222 /* At last, set drive name, except for network file name. */
1226 target[0] = DRIVE_LETTER (drive);
1231 assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]));
1233 CORRECT_DIR_SEPS (target);
1234 #endif /* WIN32_NATIVE */
1236 RETURN_UNGCPRO (make_string (target, o - target));
1239 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /*
1240 Return the canonical name of FILENAME.
1241 Second arg DEFAULT is directory to start with if FILENAME is relative
1242 (does not start with slash); if DEFAULT is nil or missing,
1243 the current buffer's value of `default-directory' is used.
1244 No component of the resulting pathname will be a symbolic link, as
1245 in the realpath() function.
1247 (filename, default_))
1249 /* This function can GC. GC checked 2000-07-28 ben. */
1250 Lisp_Object expanded_name;
1251 struct gcpro gcpro1;
1253 CHECK_STRING (filename);
1255 expanded_name = Fexpand_file_name (filename, default_);
1257 if (!STRINGP (expanded_name))
1260 GCPRO1 (expanded_name);
1263 Lisp_Object handler =
1264 Ffind_file_name_handler (expanded_name, Qfile_truename);
1266 if (!NILP (handler))
1268 (call2_check_string (handler, Qfile_truename, expanded_name));
1272 char resolved_path[MAXPATHLEN];
1277 TO_EXTERNAL_FORMAT (LISP_STRING, expanded_name,
1278 ALLOCA, (path, elen),
1281 if (elen > MAXPATHLEN)
1284 /* Try doing it all at once. */
1285 /* !! Does realpath() Mule-encapsulate?
1286 Answer: Nope! So we do it above */
1287 if (!xrealpath ((char *) path, resolved_path))
1289 /* Didn't resolve it -- have to do it one component at a time. */
1290 /* "realpath" is a typically useless, stupid un*x piece of crap.
1291 It claims to return a useful value in the "error" case, but since
1292 there is no indication provided of how far along the pathname
1293 the function went before erring, there is no way to use the
1294 partial result returned. What a piece of junk.
1296 The above comment refers to historical versions of
1297 realpath(). The Unix98 specs state:
1299 "On successful completion, realpath() returns a
1300 pointer to the resolved name. Otherwise, realpath()
1301 returns a null pointer and sets errno to indicate the
1302 error, and the contents of the buffer pointed to by
1303 resolved_name are undefined."
1305 Since we depend on undocumented semantics of various system realpath()s,
1306 we just use our own version in realpath.c. */
1312 if (IS_DRIVE (p[0]) && IS_DEVICE_SEP (p[1])
1313 && IS_DIRECTORY_SEP (p[2]))
1314 /* don't test c: on windows */
1316 else if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
1317 /* start after // */
1320 for (pos = p + 1; pos < path + elen; pos++)
1321 if (IS_DIRECTORY_SEP (*pos))
1329 if (xrealpath ((char *) path, resolved_path))
1337 else if (errno == ENOENT || errno == EACCES)
1339 /* Failed on this component. Just tack on the rest of
1340 the string and we are done. */
1341 int rlen = strlen (resolved_path);
1343 /* "On failure, it returns NULL, sets errno to indicate
1344 the error, and places in resolved_path the absolute pathname
1345 of the path component which could not be resolved." */
1349 int plen = elen - (p - path);
1351 if (rlen > 1 && IS_DIRECTORY_SEP (resolved_path[rlen - 1]))
1354 if (plen + rlen + 1 > countof (resolved_path))
1357 resolved_path[rlen] = DIRECTORY_SEP;
1358 memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1);
1368 Lisp_Object resolved_name;
1369 int rlen = strlen (resolved_path);
1370 if (elen > 0 && IS_DIRECTORY_SEP (XSTRING_BYTE (expanded_name, elen - 1))
1371 && !(rlen > 0 && IS_DIRECTORY_SEP (resolved_path[rlen - 1])))
1373 if (rlen + 1 > countof (resolved_path))
1375 resolved_path[rlen++] = DIRECTORY_SEP;
1376 resolved_path[rlen] = '\0';
1378 TO_INTERNAL_FORMAT (DATA, (resolved_path, rlen),
1379 LISP_STRING, resolved_name,
1381 RETURN_UNGCPRO (resolved_name);
1385 errno = ENAMETOOLONG;
1388 report_file_error ("Finding truename", list1 (expanded_name));
1390 RETURN_UNGCPRO (Qnil);
1394 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
1395 Substitute environment variables referred to in FILENAME.
1396 `$FOO' where FOO is an environment variable name means to substitute
1397 the value of that variable. The variable name should be terminated
1398 with a character, not a letter, digit or underscore; otherwise, enclose
1399 the entire variable name in braces.
1400 If `/~' appears, all of FILENAME through that `/' is discarded.
1404 /* This function can GC. GC checked 2000-07-28 ben. */
1407 Bufbyte *s, *p, *o, *x, *endp;
1408 Bufbyte *target = 0;
1410 int substituted = 0;
1412 Lisp_Object handler;
1414 CHECK_STRING (filename);
1416 /* If the file name has special constructs in it,
1417 call the corresponding file handler. */
1418 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
1419 if (!NILP (handler))
1420 return call2_check_string_or_nil (handler, Qsubstitute_in_file_name,
1423 nm = XSTRING_DATA (filename);
1424 endp = nm + XSTRING_LENGTH (filename);
1426 /* If /~ or // appears, discard everything through first slash. */
1428 for (p = nm; p != endp; p++)
1431 #if defined (WIN32_NATIVE) || defined (CYGWIN)
1432 /* // at start of file name is meaningful in WindowsNT systems */
1433 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
1434 #else /* not (WIN32_NATIVE || CYGWIN) */
1435 || IS_DIRECTORY_SEP (p[0])
1436 #endif /* not (WIN32_NATIVE || CYGWIN) */
1439 && (IS_DIRECTORY_SEP (p[-1])))
1445 /* see comment in expand-file-name about drive specifiers */
1446 else if (IS_DRIVE (p[0]) && p[1] == ':'
1447 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1452 #endif /* WIN32_NATIVE */
1455 /* See if any variables are substituted into the string
1456 and find the total length of their values in `total' */
1458 for (p = nm; p != endp;)
1468 /* "$$" means a single "$" */
1477 while (p != endp && *p != '}') p++;
1478 if (*p != '}') goto missingclose;
1484 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1488 /* Copy out the variable name */
1489 target = (Bufbyte *) alloca (s - o + 1);
1490 strncpy ((char *) target, (char *) o, s - o);
1493 strupr (target); /* $home == $HOME etc. */
1494 #endif /* WIN32_NATIVE */
1496 /* Get variable value */
1497 o = (Bufbyte *) egetenv ((char *) target);
1498 if (!o) goto badvar;
1499 total += strlen ((char *) o);
1506 /* If substitution required, recopy the filename and do it */
1507 /* Make space in stack frame for the new copy */
1508 xnm = (Bufbyte *) alloca (XSTRING_LENGTH (filename) + total + 1);
1511 /* Copy the rest of the name through, replacing $ constructs with values */
1528 while (p != endp && *p != '}') p++;
1529 if (*p != '}') goto missingclose;
1535 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1539 /* Copy out the variable name */
1540 target = (Bufbyte *) alloca (s - o + 1);
1541 strncpy ((char *) target, (char *) o, s - o);
1544 strupr (target); /* $home == $HOME etc. */
1545 #endif /* WIN32_NATIVE */
1547 /* Get variable value */
1548 o = (Bufbyte *) egetenv ((char *) target);
1552 strcpy ((char *) x, (char *) o);
1553 x += strlen ((char *) o);
1558 /* If /~ or // appears, discard everything through first slash. */
1560 for (p = xnm; p != x; p++)
1562 #if defined (WIN32_NATIVE)
1563 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
1564 #else /* not WIN32_NATIVE */
1565 || IS_DIRECTORY_SEP (p[0])
1566 #endif /* not WIN32_NATIVE */
1568 /* don't do p[-1] if that would go off the beginning --jwz */
1569 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1]))
1572 else if (IS_DRIVE (p[0]) && p[1] == ':'
1573 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1577 return make_string (xnm, x - xnm);
1580 syntax_error ("Bad format environment-variable substitution", filename);
1582 syntax_error ("Missing \"}\" in environment-variable substitution",
1585 syntax_error_2 ("Substituting nonexistent environment variable",
1586 filename, build_string ((char *) target));
1589 return Qnil; /* suppress compiler warning */
1592 /* A slightly faster and more convenient way to get
1593 (directory-file-name (expand-file-name FOO)). */
1596 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
1598 /* This function can call Lisp. GC checked 2000-07-28 ben */
1599 Lisp_Object abspath;
1600 struct gcpro gcpro1;
1602 abspath = Fexpand_file_name (filename, defdir);
1604 /* Remove final slash, if any (unless path is root).
1605 stat behaves differently depending! */
1606 if (XSTRING_LENGTH (abspath) > 1
1607 && IS_DIRECTORY_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1))
1608 && !IS_DEVICE_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 2)))
1609 /* We cannot take shortcuts; they might be wrong for magic file names. */
1610 abspath = Fdirectory_file_name (abspath);
1615 /* Signal an error if the file ABSNAME already exists.
1616 If INTERACTIVE is nonzero, ask the user whether to proceed,
1617 and bypass the error if the user says to go ahead.
1618 QUERYSTRING is a name for the action that is being considered
1620 *STATPTR is used to store the stat information if the file exists.
1621 If the file does not exist, STATPTR->st_mode is set to 0. */
1624 barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring,
1625 int interactive, struct stat *statptr)
1627 /* This function can call Lisp. GC checked 2000-07-28 ben */
1628 struct stat statbuf;
1630 /* stat is a good way to tell whether the file exists,
1631 regardless of what access permissions it has. */
1632 if (xemacs_stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0)
1639 struct gcpro gcpro1;
1641 prompt = emacs_doprnt_string_c
1642 ((const Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "),
1643 Qnil, -1, XSTRING_DATA (absname),
1644 GETTEXT (querystring));
1647 tem = call1 (Qyes_or_no_p, prompt);
1654 Fsignal (Qfile_already_exists,
1655 list2 (build_translated_string ("File already exists"),
1663 statptr->st_mode = 0;
1668 DEFUN ("copy-file", Fcopy_file, 2, 4,
1669 "fCopy file: \nFCopy %s to file: \np\nP", /*
1670 Copy FILENAME to NEWNAME. Both args must be strings.
1671 Signals a `file-already-exists' error if file NEWNAME already exists,
1672 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
1673 A number as third arg means request confirmation if NEWNAME already exists.
1674 This is what happens in interactive use with M-x.
1675 Fourth arg KEEP-TIME non-nil means give the new file the same
1676 last-modified time as the old one. (This works on only some systems.)
1677 A prefix arg makes KEEP-TIME non-nil.
1679 (filename, newname, ok_if_already_exists, keep_time))
1681 /* This function can call Lisp. GC checked 2000-07-28 ben */
1683 char buf[16 * 1024];
1684 struct stat st, out_st;
1685 Lisp_Object handler;
1686 int speccount = specpdl_depth ();
1687 struct gcpro gcpro1, gcpro2;
1688 /* Lisp_Object args[6]; */
1689 int input_file_statable_p;
1691 GCPRO2 (filename, newname);
1692 CHECK_STRING (filename);
1693 CHECK_STRING (newname);
1694 filename = Fexpand_file_name (filename, Qnil);
1695 newname = Fexpand_file_name (newname, Qnil);
1697 /* If the input file name has special constructs in it,
1698 call the corresponding file handler. */
1699 handler = Ffind_file_name_handler (filename, Qcopy_file);
1700 /* Likewise for output file name. */
1702 handler = Ffind_file_name_handler (newname, Qcopy_file);
1703 if (!NILP (handler))
1706 return call5 (handler, Qcopy_file, filename, newname,
1707 ok_if_already_exists, keep_time);
1710 /* When second argument is a directory, copy the file into it.
1711 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
1713 if (!NILP (Ffile_directory_p (newname)))
1715 Lisp_Object args[3];
1716 struct gcpro ngcpro1;
1720 args[1] = Qnil; args[2] = Qnil;
1723 if (!IS_DIRECTORY_SEP (XSTRING_BYTE (newname,
1724 XSTRING_LENGTH (newname) - 1)))
1726 args[i++] = Fchar_to_string (Vdirectory_sep_char);
1727 args[i++] = Ffile_name_nondirectory (filename);
1728 newname = Fconcat (i, args);
1732 if (NILP (ok_if_already_exists)
1733 || INTP (ok_if_already_exists))
1734 barf_or_query_if_file_exists (newname, "copy to it",
1735 INTP (ok_if_already_exists), &out_st);
1736 else if (xemacs_stat ((const char *) XSTRING_DATA (newname), &out_st) < 0)
1739 ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0);
1741 report_file_error ("Opening input file", list1 (filename));
1743 record_unwind_protect (close_file_unwind, make_int (ifd));
1745 /* We can only copy regular files and symbolic links. Other files are not
1747 input_file_statable_p = (fstat (ifd, &st) >= 0);
1749 #ifndef WIN32_NATIVE
1750 if (out_st.st_mode != 0
1751 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
1754 report_file_error ("Input and output files are the same",
1755 list2 (filename, newname));
1759 #if defined (S_ISREG) && defined (S_ISLNK)
1760 if (input_file_statable_p)
1762 if (!(S_ISREG (st.st_mode))
1763 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
1765 && !(S_ISCHR (st.st_mode))
1767 && !(S_ISLNK (st.st_mode)))
1769 #if defined (EISDIR)
1770 /* Get a better looking error message. */
1773 report_file_error ("Non-regular file", list1 (filename));
1776 #endif /* S_ISREG && S_ISLNK */
1778 ofd = open( (char *) XSTRING_DATA (newname),
1779 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
1781 report_file_error ("Opening output file", list1 (newname));
1784 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil);
1786 record_unwind_protect (close_file_unwind, ofd_locative);
1788 while ((n = read_allowing_quit (ifd, buf, sizeof (buf))) > 0)
1790 if (write_allowing_quit (ofd, buf, n) != n)
1791 report_file_error ("I/O error", list1 (newname));
1794 /* Closing the output clobbers the file times on some systems. */
1795 if (close (ofd) < 0)
1796 report_file_error ("I/O error", list1 (newname));
1798 if (input_file_statable_p)
1800 if (!NILP (keep_time))
1802 EMACS_TIME atime, mtime;
1803 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
1804 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
1805 if (set_file_times (newname, atime, mtime))
1806 report_file_error ("I/O error", list1 (newname));
1808 chmod ((const char *) XSTRING_DATA (newname),
1809 st.st_mode & 07777);
1812 /* We'll close it by hand */
1813 XCAR (ofd_locative) = Qnil;
1816 unbind_to (speccount, Qnil);
1823 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
1824 Create a directory. One argument, a file name string.
1828 /* This function can GC. GC checked 1997.04.06. */
1829 char dir [MAXPATHLEN];
1830 Lisp_Object handler;
1831 struct gcpro gcpro1;
1833 CHECK_STRING (dirname_);
1834 dirname_ = Fexpand_file_name (dirname_, Qnil);
1837 handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal);
1839 if (!NILP (handler))
1840 return (call2 (handler, Qmake_directory_internal, dirname_));
1842 if (XSTRING_LENGTH (dirname_) > (Bytecount) (sizeof (dir) - 1))
1844 return Fsignal (Qfile_error,
1845 list3 (build_translated_string ("Creating directory"),
1846 build_translated_string ("pathname too long"),
1849 strncpy (dir, (char *) XSTRING_DATA (dirname_),
1850 XSTRING_LENGTH (dirname_) + 1);
1852 if (dir [XSTRING_LENGTH (dirname_) - 1] == '/')
1853 dir [XSTRING_LENGTH (dirname_) - 1] = 0;
1855 if (mkdir (dir, 0777) != 0)
1856 report_file_error ("Creating directory", list1 (dirname_));
1861 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
1862 Delete a directory. One argument, a file name or directory name string.
1866 /* This function can GC. GC checked 1997.04.06. */
1867 Lisp_Object handler;
1868 struct gcpro gcpro1;
1870 CHECK_STRING (dirname_);
1873 dirname_ = Fexpand_file_name (dirname_, Qnil);
1874 dirname_ = Fdirectory_file_name (dirname_);
1876 handler = Ffind_file_name_handler (dirname_, Qdelete_directory);
1878 if (!NILP (handler))
1879 return (call2 (handler, Qdelete_directory, dirname_));
1881 if (rmdir ((char *) XSTRING_DATA (dirname_)) != 0)
1882 report_file_error ("Removing directory", list1 (dirname_));
1887 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
1888 Delete the file named FILENAME (a string).
1889 If FILENAME has multiple names, it continues to exist with the other names.
1893 /* This function can GC. GC checked 1997.04.06. */
1894 Lisp_Object handler;
1895 struct gcpro gcpro1;
1897 CHECK_STRING (filename);
1898 filename = Fexpand_file_name (filename, Qnil);
1901 handler = Ffind_file_name_handler (filename, Qdelete_file);
1903 if (!NILP (handler))
1904 return call2 (handler, Qdelete_file, filename);
1906 if (0 > unlink ((char *) XSTRING_DATA (filename)))
1907 report_file_error ("Removing old name", list1 (filename));
1912 internal_delete_file_1 (Lisp_Object ignore, Lisp_Object ignore2)
1917 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1920 internal_delete_file (Lisp_Object filename)
1922 /* This function can GC. GC checked 1997.04.06. */
1923 return NILP (condition_case_1 (Qt, Fdelete_file, filename,
1924 internal_delete_file_1, Qnil));
1927 DEFUN ("rename-file", Frename_file, 2, 3,
1928 "fRename file: \nFRename %s to file: \np", /*
1929 Rename FILENAME as NEWNAME. Both args must be strings.
1930 If file has names other than FILENAME, it continues to have those names.
1931 Signals a `file-already-exists' error if a file NEWNAME already exists
1932 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1933 A number as third arg means request confirmation if NEWNAME already exists.
1934 This is what happens in interactive use with M-x.
1936 (filename, newname, ok_if_already_exists))
1938 /* This function can GC. GC checked 1997.04.06. */
1939 Lisp_Object handler;
1940 struct gcpro gcpro1, gcpro2;
1942 GCPRO2 (filename, newname);
1943 CHECK_STRING (filename);
1944 CHECK_STRING (newname);
1945 filename = Fexpand_file_name (filename, Qnil);
1946 newname = Fexpand_file_name (newname, Qnil);
1948 /* If the file name has special constructs in it,
1949 call the corresponding file handler. */
1950 handler = Ffind_file_name_handler (filename, Qrename_file);
1952 handler = Ffind_file_name_handler (newname, Qrename_file);
1953 if (!NILP (handler))
1956 return call4 (handler, Qrename_file,
1957 filename, newname, ok_if_already_exists);
1960 /* When second argument is a directory, rename the file into it.
1961 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
1963 if (!NILP (Ffile_directory_p (newname)))
1965 Lisp_Object args[3];
1966 struct gcpro ngcpro1;
1970 args[1] = Qnil; args[2] = Qnil;
1973 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
1974 args[i++] = build_string ("/");
1975 args[i++] = Ffile_name_nondirectory (filename);
1976 newname = Fconcat (i, args);
1980 if (NILP (ok_if_already_exists)
1981 || INTP (ok_if_already_exists))
1982 barf_or_query_if_file_exists (newname, "rename to it",
1983 INTP (ok_if_already_exists), 0);
1985 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
1986 WIN32_NATIVE here; I've removed it. --marcpa */
1988 /* We have configure check for rename() and emulate using
1989 link()/unlink() if necessary. */
1990 if (0 > rename ((char *) XSTRING_DATA (filename),
1991 (char *) XSTRING_DATA (newname)))
1995 Fcopy_file (filename, newname,
1996 /* We have already prompted if it was an integer,
1997 so don't have copy-file prompt again. */
1998 (NILP (ok_if_already_exists) ? Qnil : Qt),
2000 Fdelete_file (filename);
2004 report_file_error ("Renaming", list2 (filename, newname));
2011 DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3,
2012 "fAdd name to file: \nFName to add to %s: \np", /*
2013 Give FILENAME additional name NEWNAME. Both args must be strings.
2014 Signals a `file-already-exists' error if a file NEWNAME already exists
2015 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2016 A number as third arg means request confirmation if NEWNAME already exists.
2017 This is what happens in interactive use with M-x.
2019 (filename, newname, ok_if_already_exists))
2021 /* This function can GC. GC checked 1997.04.06. */
2022 Lisp_Object handler;
2023 struct gcpro gcpro1, gcpro2;
2025 GCPRO2 (filename, newname);
2026 CHECK_STRING (filename);
2027 CHECK_STRING (newname);
2028 filename = Fexpand_file_name (filename, Qnil);
2029 newname = Fexpand_file_name (newname, Qnil);
2031 /* If the file name has special constructs in it,
2032 call the corresponding file handler. */
2033 handler = Ffind_file_name_handler (filename, Qadd_name_to_file);
2034 if (!NILP (handler))
2035 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2036 newname, ok_if_already_exists));
2038 /* If the new name has special constructs in it,
2039 call the corresponding file handler. */
2040 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2041 if (!NILP (handler))
2042 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2043 newname, ok_if_already_exists));
2045 if (NILP (ok_if_already_exists)
2046 || INTP (ok_if_already_exists))
2047 barf_or_query_if_file_exists (newname, "make it a new name",
2048 INTP (ok_if_already_exists), 0);
2049 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
2050 on NT here. --marcpa */
2051 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
2052 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
2053 Reverted to previous behavior pending a working fix. (jhar) */
2054 #if defined(WIN32_NATIVE)
2055 /* Windows does not support this operation. */
2056 report_file_error ("Adding new name", Flist (2, &filename));
2057 #else /* not defined(WIN32_NATIVE) */
2059 unlink ((char *) XSTRING_DATA (newname));
2060 if (0 > link ((char *) XSTRING_DATA (filename),
2061 (char *) XSTRING_DATA (newname)))
2063 report_file_error ("Adding new name",
2064 list2 (filename, newname));
2066 #endif /* defined(WIN32_NATIVE) */
2072 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3,
2073 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
2074 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2075 Signals a `file-already-exists' error if a file LINKNAME already exists
2076 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2077 A number as third arg means request confirmation if LINKNAME already exists.
2078 This happens for interactive use with M-x.
2080 (filename, linkname, ok_if_already_exists))
2082 /* This function can GC. GC checked 1997.06.04. */
2083 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2084 Lisp_Object handler;
2085 struct gcpro gcpro1, gcpro2;
2087 GCPRO2 (filename, linkname);
2088 CHECK_STRING (filename);
2089 CHECK_STRING (linkname);
2090 /* If the link target has a ~, we must expand it to get
2091 a truly valid file name. Otherwise, do not expand;
2092 we want to permit links to relative file names. */
2093 if (XSTRING_BYTE (filename, 0) == '~')
2094 filename = Fexpand_file_name (filename, Qnil);
2095 linkname = Fexpand_file_name (linkname, Qnil);
2097 /* If the file name has special constructs in it,
2098 call the corresponding file handler. */
2099 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
2100 if (!NILP (handler))
2101 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname,
2102 ok_if_already_exists));
2104 /* If the new link name has special constructs in it,
2105 call the corresponding file handler. */
2106 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2107 if (!NILP (handler))
2108 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2109 linkname, ok_if_already_exists));
2112 if (NILP (ok_if_already_exists)
2113 || INTP (ok_if_already_exists))
2114 barf_or_query_if_file_exists (linkname, "make it a link",
2115 INTP (ok_if_already_exists), 0);
2117 unlink ((char *) XSTRING_DATA (linkname));
2118 if (0 > symlink ((char *) XSTRING_DATA (filename),
2119 (char *) XSTRING_DATA (linkname)))
2121 report_file_error ("Making symbolic link",
2122 list2 (filename, linkname));
2124 #endif /* S_IFLNK */
2132 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
2133 Open a network connection to PATH using LOGIN as the login string.
2138 const char *path_ext;
2139 const char *login_ext;
2141 CHECK_STRING (path);
2142 CHECK_STRING (login);
2144 /* netunam, being a strange-o system call only used once, is not
2147 LISP_STRING_TO_EXTERNAL (path, path_ext, Qfile_name);
2148 LISP_STRING_TO_EXTERNAL (login, login_ext, Qnative);
2150 netresult = netunam (path_ext, login_ext);
2152 return netresult == -1 ? Qnil : Qt;
2154 #endif /* HPUX_NET */
2156 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
2157 Return t if file FILENAME specifies an absolute path name.
2158 On Unix, this is a name starting with a `/' or a `~'.
2162 /* This function does not GC */
2165 CHECK_STRING (filename);
2166 ptr = XSTRING_DATA (filename);
2167 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
2169 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
2174 /* Return nonzero if file FILENAME exists and can be executed. */
2177 check_executable (char *filename)
2181 if (xemacs_stat (filename, &st) < 0)
2183 return ((st.st_mode & S_IEXEC) != 0);
2184 #else /* not WIN32_NATIVE */
2186 return eaccess (filename, X_OK) >= 0;
2188 /* Access isn't quite right because it uses the real uid
2189 and we really want to test with the effective uid.
2190 But Unix doesn't give us a right way to do it. */
2191 return access (filename, X_OK) >= 0;
2192 #endif /* HAVE_EACCESS */
2193 #endif /* not WIN32_NATIVE */
2196 /* Return nonzero if file FILENAME exists and can be written. */
2199 check_writable (const char *filename)
2202 return (eaccess (filename, W_OK) >= 0);
2204 /* Access isn't quite right because it uses the real uid
2205 and we really want to test with the effective uid.
2206 But Unix doesn't give us a right way to do it.
2207 Opening with O_WRONLY could work for an ordinary file,
2208 but would lose for directories. */
2209 return (access (filename, W_OK) >= 0);
2213 DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
2214 Return t if file FILENAME exists. (This does not mean you can read it.)
2215 See also `file-readable-p' and `file-attributes'.
2219 /* This function can call lisp; GC checked 2000-07-11 ben */
2220 Lisp_Object abspath;
2221 Lisp_Object handler;
2222 struct stat statbuf;
2223 struct gcpro gcpro1;
2225 CHECK_STRING (filename);
2226 abspath = Fexpand_file_name (filename, Qnil);
2228 /* If the file name has special constructs in it,
2229 call the corresponding file handler. */
2231 handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
2233 if (!NILP (handler))
2234 return call2 (handler, Qfile_exists_p, abspath);
2236 return xemacs_stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
2239 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
2240 Return t if FILENAME can be executed by you.
2241 For a directory, this means you can access files in that directory.
2246 /* This function can GC. GC checked 07-11-2000 ben. */
2247 Lisp_Object abspath;
2248 Lisp_Object handler;
2249 struct gcpro gcpro1;
2251 CHECK_STRING (filename);
2252 abspath = Fexpand_file_name (filename, Qnil);
2254 /* If the file name has special constructs in it,
2255 call the corresponding file handler. */
2257 handler = Ffind_file_name_handler (abspath, Qfile_executable_p);
2259 if (!NILP (handler))
2260 return call2 (handler, Qfile_executable_p, abspath);
2262 return check_executable ((char *) XSTRING_DATA (abspath)) ? Qt : Qnil;
2265 DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
2266 Return t if file FILENAME exists and you can read it.
2267 See also `file-exists-p' and `file-attributes'.
2271 /* This function can GC */
2272 Lisp_Object abspath = Qnil;
2273 Lisp_Object handler;
2274 struct gcpro gcpro1;
2277 CHECK_STRING (filename);
2278 abspath = Fexpand_file_name (filename, Qnil);
2280 /* If the file name has special constructs in it,
2281 call the corresponding file handler. */
2282 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
2283 if (!NILP (handler))
2284 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
2286 #if defined(WIN32_NATIVE) || defined(CYGWIN)
2287 /* Under MS-DOS and Windows, open does not work for directories. */
2289 if (access (XSTRING_DATA (abspath), 0) == 0)
2293 #else /* not WIN32_NATIVE */
2295 int desc = interruptible_open ((char *) XSTRING_DATA (abspath), O_RDONLY | OPEN_BINARY, 0);
2302 #endif /* not WIN32_NATIVE */
2305 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2307 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
2308 Return t if file FILENAME can be written or created by you.
2312 /* This function can GC. GC checked 1997.04.10. */
2313 Lisp_Object abspath, dir;
2314 Lisp_Object handler;
2315 struct stat statbuf;
2316 struct gcpro gcpro1;
2318 CHECK_STRING (filename);
2319 abspath = Fexpand_file_name (filename, Qnil);
2321 /* If the file name has special constructs in it,
2322 call the corresponding file handler. */
2324 handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
2326 if (!NILP (handler))
2327 return call2 (handler, Qfile_writable_p, abspath);
2329 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0)
2330 return (check_writable ((char *) XSTRING_DATA (abspath))
2335 dir = Ffile_name_directory (abspath);
2337 return (check_writable (!NILP (dir) ? (char *) XSTRING_DATA (dir)
2342 DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
2343 Return non-nil if file FILENAME is the name of a symbolic link.
2344 The value is the name of the file to which it is linked.
2345 Otherwise returns nil.
2349 /* This function can GC. GC checked 1997.04.10. */
2350 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2357 Lisp_Object handler;
2358 struct gcpro gcpro1;
2360 CHECK_STRING (filename);
2361 filename = Fexpand_file_name (filename, Qnil);
2363 /* If the file name has special constructs in it,
2364 call the corresponding file handler. */
2366 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
2368 if (!NILP (handler))
2369 return call2 (handler, Qfile_symlink_p, filename);
2375 buf = xnew_array_and_zero (char, bufsize);
2376 valsize = readlink ((char *) XSTRING_DATA (filename),
2378 if (valsize < bufsize) break;
2379 /* Buffer was not long enough */
2388 val = make_string ((Bufbyte *) buf, valsize);
2391 #else /* not S_IFLNK */
2393 #endif /* not S_IFLNK */
2396 DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
2397 Return t if file FILENAME is the name of a directory as a file.
2398 A directory name spec may be given instead; then the value is t
2399 if the directory so specified exists and really is a directory.
2403 /* This function can GC. GC checked 1997.04.10. */
2404 Lisp_Object abspath;
2406 Lisp_Object handler;
2407 struct gcpro gcpro1;
2409 GCPRO1 (current_buffer->directory);
2410 abspath = expand_and_dir_to_file (filename,
2411 current_buffer->directory);
2414 /* If the file name has special constructs in it,
2415 call the corresponding file handler. */
2417 handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
2419 if (!NILP (handler))
2420 return call2 (handler, Qfile_directory_p, abspath);
2422 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2424 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2427 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
2428 Return t if file FILENAME is the name of a directory as a file,
2429 and files in that directory can be opened by you. In order to use a
2430 directory as a buffer's current directory, this predicate must return true.
2431 A directory name spec may be given instead; then the value is t
2432 if the directory so specified exists and really is a readable and
2433 searchable directory.
2437 /* This function can GC. GC checked 1997.04.10. */
2438 Lisp_Object handler;
2440 /* If the file name has special constructs in it,
2441 call the corresponding file handler. */
2442 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
2443 if (!NILP (handler))
2444 return call2 (handler, Qfile_accessible_directory_p,
2447 #if !defined(WIN32_NATIVE)
2448 if (NILP (Ffile_directory_p (filename)))
2451 return Ffile_executable_p (filename);
2455 struct gcpro gcpro1;
2456 /* It's an unlikely combination, but yes we really do need to gcpro:
2457 Suppose that file-accessible-directory-p has no handler, but
2458 file-directory-p does have a handler; this handler causes a GC which
2459 relocates the string in `filename'; and finally file-directory-p
2460 returns non-nil. Then we would end up passing a garbaged string
2461 to file-executable-p. */
2463 tem = (NILP (Ffile_directory_p (filename))
2464 || NILP (Ffile_executable_p (filename)));
2466 return tem ? Qnil : Qt;
2468 #endif /* !defined(WIN32_NATIVE) */
2471 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
2472 Return t if file FILENAME is the name of a regular file.
2473 This is the sort of file that holds an ordinary stream of data bytes.
2477 /* This function can GC. GC checked 1997.04.10. */
2478 Lisp_Object abspath;
2480 Lisp_Object handler;
2481 struct gcpro gcpro1;
2483 GCPRO1 (current_buffer->directory);
2484 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
2487 /* If the file name has special constructs in it,
2488 call the corresponding file handler. */
2490 handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
2492 if (!NILP (handler))
2493 return call2 (handler, Qfile_regular_p, abspath);
2495 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2497 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2500 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
2501 Return mode bits of file named FILENAME, as an integer.
2505 /* This function can GC. GC checked 1997.04.10. */
2506 Lisp_Object abspath;
2508 Lisp_Object handler;
2509 struct gcpro gcpro1;
2511 GCPRO1 (current_buffer->directory);
2512 abspath = expand_and_dir_to_file (filename,
2513 current_buffer->directory);
2516 /* If the file name has special constructs in it,
2517 call the corresponding file handler. */
2519 handler = Ffind_file_name_handler (abspath, Qfile_modes);
2521 if (!NILP (handler))
2522 return call2 (handler, Qfile_modes, abspath);
2524 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2526 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
2529 if (check_executable (XSTRING_DATA (abspath)))
2530 st.st_mode |= S_IEXEC;
2531 #endif /* WIN32_NATIVE */
2534 return make_int (st.st_mode & 07777);
2537 DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /*
2538 Set mode bits of file named FILENAME to MODE (an integer).
2539 Only the 12 low bits of MODE are used.
2543 /* This function can GC. GC checked 1997.04.10. */
2544 Lisp_Object abspath;
2545 Lisp_Object handler;
2546 struct gcpro gcpro1;
2548 GCPRO1 (current_buffer->directory);
2549 abspath = Fexpand_file_name (filename, current_buffer->directory);
2554 /* If the file name has special constructs in it,
2555 call the corresponding file handler. */
2557 handler = Ffind_file_name_handler (abspath, Qset_file_modes);
2559 if (!NILP (handler))
2560 return call3 (handler, Qset_file_modes, abspath, mode);
2562 if (chmod ((char *) XSTRING_DATA (abspath), XINT (mode)) < 0)
2563 report_file_error ("Doing chmod", list1 (abspath));
2568 DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
2569 Set the file permission bits for newly created files.
2570 The argument MODE should be an integer; if a bit in MODE is 1,
2571 subsequently created files will not have the permission corresponding
2572 to that bit enabled. Only the low 9 bits are used.
2573 This setting is inherited by subprocesses.
2579 umask ((~ XINT (mode)) & 0777);
2584 DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
2585 Return the default file protection for created files.
2586 The umask value determines which permissions are enabled in newly
2587 created files. If a permission's bit in the umask is 1, subsequently
2588 created files will not have that permission enabled.
2597 return make_int ((~ mode) & 0777);
2600 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /*
2601 Tell Unix to finish all pending disk updates.
2605 #ifndef WIN32_NATIVE
2612 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
2613 Return t if file FILE1 is newer than file FILE2.
2614 If FILE1 does not exist, the answer is nil;
2615 otherwise, if FILE2 does not exist, the answer is t.
2619 /* This function can GC. GC checked 1997.04.10. */
2620 Lisp_Object abspath1, abspath2;
2623 Lisp_Object handler;
2624 struct gcpro gcpro1, gcpro2, gcpro3;
2626 CHECK_STRING (file1);
2627 CHECK_STRING (file2);
2632 GCPRO3 (abspath1, abspath2, current_buffer->directory);
2633 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
2634 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
2636 /* If the file name has special constructs in it,
2637 call the corresponding file handler. */
2638 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p);
2640 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p);
2642 if (!NILP (handler))
2643 return call3 (handler, Qfile_newer_than_file_p, abspath1,
2646 if (xemacs_stat ((char *) XSTRING_DATA (abspath1), &st) < 0)
2649 mtime1 = st.st_mtime;
2651 if (xemacs_stat ((char *) XSTRING_DATA (abspath2), &st) < 0)
2654 return (mtime1 > st.st_mtime) ? Qt : Qnil;
2658 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
2659 /* #define READ_BUF_SIZE (2 << 16) */
2660 #define READ_BUF_SIZE (1 << 15)
2662 DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal,
2664 Insert contents of file FILENAME after point; no coding-system frobbing.
2665 This function is identical to `insert-file-contents' except for the
2666 handling of the CODESYS and USED-CODESYS arguments under
2667 XEmacs/Mule. (When Mule support is not present, both functions are
2668 identical and ignore the CODESYS and USED-CODESYS arguments.)
2670 If support for Mule exists in this Emacs, the file is decoded according
2671 to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil,
2672 it should be a symbol, and the actual coding system that was used for the
2673 decoding is stored into it. It will in general be different from CODESYS
2674 if CODESYS specifies automatic encoding detection or end-of-line detection.
2676 Currently START and END refer to byte positions (as opposed to character
2677 positions), even in Mule. (Fixing this is very difficult.)
2679 (filename, visit, start, end, replace, codesys, used_codesys))
2681 /* This function can call lisp */
2685 Charcount inserted = 0;
2687 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2688 Lisp_Object handler = Qnil, val;
2690 Bufbyte read_buf[READ_BUF_SIZE];
2692 struct buffer *buf = current_buffer;
2694 int not_regular = 0;
2696 if (buf->base_buffer && ! NILP (visit))
2697 error ("Cannot do file visiting in an indirect buffer");
2699 /* No need to call Fbarf_if_buffer_read_only() here.
2700 That's called in begin_multiple_change() or wherever. */
2704 /* #### dmoore - should probably check in various places to see if
2705 curbuf was killed and if so signal an error? */
2707 XSETBUFFER (curbuf, buf);
2709 GCPRO5 (filename, val, visit, handler, curbuf);
2711 mc_count = (NILP (replace)) ?
2712 begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) :
2713 begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf));
2715 speccount = specpdl_depth (); /* begin_multiple_change also adds
2716 an unwind_protect */
2718 filename = Fexpand_file_name (filename, Qnil);
2720 /* If the file name has special constructs in it,
2721 call the corresponding file handler. */
2722 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
2723 if (!NILP (handler))
2725 val = call6 (handler, Qinsert_file_contents, filename,
2726 visit, start, end, replace);
2731 if (!NILP (used_codesys))
2732 CHECK_SYMBOL (used_codesys);
2735 if ( (!NILP (start) || !NILP (end)) && !NILP (visit) )
2736 error ("Attempt to visit less than an entire file");
2740 if (xemacs_stat ((char *) XSTRING_DATA (filename), &st) < 0)
2742 if (fd >= 0) close (fd);
2745 report_file_error ("Opening input file", list1 (filename));
2751 /* Signal an error if we are accessing a non-regular file, with
2752 REPLACE, START or END being non-nil. */
2753 if (!S_ISREG (st.st_mode))
2760 if (!NILP (replace) || !NILP (start) || !NILP (end))
2762 end_multiple_change (buf, mc_count);
2765 (Fsignal (Qfile_error,
2766 list2 (build_translated_string("not a regular file"),
2770 #endif /* S_IFREG */
2782 if ((fd = interruptible_open ((char *) XSTRING_DATA (filename),
2783 O_RDONLY | OPEN_BINARY, 0)) < 0)
2787 /* Replacement should preserve point as it preserves markers. */
2788 if (!NILP (replace))
2789 record_unwind_protect (restore_point_unwind, Fpoint_marker (Qnil, Qnil));
2791 record_unwind_protect (close_file_unwind, make_int (fd));
2793 /* Supposedly happens on VMS. */
2795 error ("File size is negative");
2801 end = make_int (st.st_size);
2802 if (XINT (end) != st.st_size)
2803 error ("Maximum buffer size exceeded");
2807 /* If requested, replace the accessible part of the buffer
2808 with the file contents. Avoid replacing text at the
2809 beginning or end of the buffer that matches the file contents;
2810 that preserves markers pointing to the unchanged parts. */
2811 #if !defined (FILE_CODING)
2812 /* The replace-mode code currently only works when the assumption
2813 'one byte == one char' holds true. This fails Mule because
2814 files may contain multibyte characters. It holds under Windows NT
2815 provided we convert CRLF into LF. */
2816 # define FSFMACS_SPEEDY_INSERT
2817 #endif /* !defined (FILE_CODING) */
2819 #ifndef FSFMACS_SPEEDY_INSERT
2820 if (!NILP (replace))
2822 buffer_delete_range (buf, BUF_BEG (buf), BUF_Z (buf),
2823 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2825 #else /* FSFMACS_SPEEDY_INSERT */
2826 if (!NILP (replace))
2828 char buffer[1 << 14];
2829 Bufpos same_at_start = BUF_BEGV (buf);
2830 Bufpos same_at_end = BUF_ZV (buf);
2833 /* Count how many chars at the start of the file
2834 match the text at the beginning of the buffer. */
2839 nread = read_allowing_quit (fd, buffer, sizeof buffer);
2841 error ("IO error reading %s: %s",
2842 XSTRING_DATA (filename), strerror (errno));
2843 else if (nread == 0)
2846 while (bufpos < nread && same_at_start < BUF_ZV (buf)
2847 && BUF_FETCH_CHAR (buf, same_at_start) == buffer[bufpos])
2848 same_at_start++, bufpos++;
2849 /* If we found a discrepancy, stop the scan.
2850 Otherwise loop around and scan the next bufferful. */
2851 if (bufpos != nread)
2854 /* If the file matches the buffer completely,
2855 there's no need to replace anything. */
2856 if (same_at_start - BUF_BEGV (buf) == st.st_size)
2859 unbind_to (speccount, Qnil);
2860 /* Truncate the buffer to the size of the file. */
2861 buffer_delete_range (buf, same_at_start, same_at_end,
2862 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2865 /* Count how many chars at the end of the file
2866 match the text at the end of the buffer. */
2869 int total_read, nread;
2870 Bufpos bufpos, curpos, trial;
2872 /* At what file position are we now scanning? */
2873 curpos = st.st_size - (BUF_ZV (buf) - same_at_end);
2874 /* If the entire file matches the buffer tail, stop the scan. */
2877 /* How much can we scan in the next step? */
2878 trial = min (curpos, (Bufpos) sizeof (buffer));
2879 if (lseek (fd, curpos - trial, 0) < 0)
2880 report_file_error ("Setting file position", list1 (filename));
2883 while (total_read < trial)
2885 nread = read_allowing_quit (fd, buffer + total_read,
2886 trial - total_read);
2888 report_file_error ("IO error reading file", list1 (filename));
2889 total_read += nread;
2891 /* Scan this bufferful from the end, comparing with
2892 the Emacs buffer. */
2893 bufpos = total_read;
2894 /* Compare with same_at_start to avoid counting some buffer text
2895 as matching both at the file's beginning and at the end. */
2896 while (bufpos > 0 && same_at_end > same_at_start
2897 && BUF_FETCH_CHAR (buf, same_at_end - 1) ==
2899 same_at_end--, bufpos--;
2900 /* If we found a discrepancy, stop the scan.
2901 Otherwise loop around and scan the preceding bufferful. */
2904 /* If display current starts at beginning of line,
2905 keep it that way. */
2906 if (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == buf)
2907 XWINDOW (Fselected_window (Qnil))->start_at_line_beg =
2908 !NILP (Fbolp (make_buffer (buf)));
2911 /* Don't try to reuse the same piece of text twice. */
2912 overlap = same_at_start - BUF_BEGV (buf) -
2913 (same_at_end + st.st_size - BUF_ZV (buf));
2915 same_at_end += overlap;
2917 /* Arrange to read only the nonmatching middle part of the file. */
2918 start = make_int (same_at_start - BUF_BEGV (buf));
2919 end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end));
2921 buffer_delete_range (buf, same_at_start, same_at_end,
2922 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2923 /* Insert from the file at the proper position. */
2924 BUF_SET_PT (buf, same_at_start);
2926 #endif /* FSFMACS_SPEEDY_INSERT */
2930 total = XINT (end) - XINT (start);
2932 /* Make sure point-max won't overflow after this insertion. */
2933 if (total != XINT (make_int (total)))
2934 error ("Maximum buffer size exceeded");
2937 /* For a special file, all we can do is guess. The value of -1
2938 will make the stream functions read as much as possible. */
2941 if (XINT (start) != 0
2942 #ifdef FSFMACS_SPEEDY_INSERT
2943 /* why was this here? asked jwz. The reason is that the replace-mode
2944 connivings above will normally put the file pointer other than
2945 where it should be. */
2947 #endif /* !FSFMACS_SPEEDY_INSERT */
2950 if (lseek (fd, XINT (start), 0) < 0)
2951 report_file_error ("Setting file position", list1 (filename));
2955 Bufpos cur_point = BUF_PT (buf);
2956 struct gcpro ngcpro1;
2957 Lisp_Object stream = make_filedesc_input_stream (fd, 0, total,
2961 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2963 stream = make_decoding_input_stream
2964 (XLSTREAM (stream), Fget_coding_system (codesys));
2965 Lstream_set_character_mode (XLSTREAM (stream));
2966 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2967 #endif /* FILE_CODING */
2969 record_unwind_protect (delete_stream_unwind, stream);
2971 /* No need to limit the amount of stuff we attempt to read. (It would
2972 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
2973 occurs inside of the filedesc stream. */
2976 Lstream_data_count this_len;
2977 Charcount cc_inserted;
2980 this_len = Lstream_read (XLSTREAM (stream), read_buf,
2990 cc_inserted = buffer_insert_raw_string_1 (buf, cur_point, read_buf,
2993 ? INSDEL_NO_LOCKING : 0);
2994 inserted += cc_inserted;
2995 cur_point += cc_inserted;
2998 if (!NILP (used_codesys))
3001 XCODING_SYSTEM_NAME (decoding_stream_coding_system (XLSTREAM (stream))));
3003 #endif /* FILE_CODING */
3007 /* Close the file/stream */
3008 unbind_to (speccount, Qnil);
3012 error ("IO error reading %s: %s",
3013 XSTRING_DATA (filename), strerror (saverrno));
3019 end_multiple_change (buf, mc_count);
3023 if (!EQ (buf->undo_list, Qt))
3024 buf->undo_list = Qnil;
3027 buf->modtime = st.st_mtime;
3028 buf->filename = filename;
3029 /* XEmacs addition: */
3030 /* This function used to be in C, ostensibly so that
3031 it could be called here. But that's just silly.
3032 There's no reason C code can't call out to Lisp
3033 code, and it's a lot cleaner this way. */
3034 /* Note: compute-buffer-file-truename is called for
3035 side-effect! Its return value is intentionally
3037 if (!NILP (Ffboundp (Qcompute_buffer_file_truename)))
3038 call1 (Qcompute_buffer_file_truename, make_buffer (buf));
3040 BUF_SAVE_MODIFF (buf) = BUF_MODIFF (buf);
3041 buf->auto_save_modified = BUF_MODIFF (buf);
3042 buf->saved_size = make_int (BUF_SIZE (buf));
3043 #ifdef CLASH_DETECTION
3046 if (!NILP (buf->file_truename))
3047 unlock_file (buf->file_truename);
3048 unlock_file (filename);
3050 #endif /* CLASH_DETECTION */
3052 RETURN_UNGCPRO (Fsignal (Qfile_error,
3053 list2 (build_string ("not a regular file"),
3056 /* If visiting nonexistent file, return nil. */
3057 if (buf->modtime == -1)
3058 report_file_error ("Opening input file",
3062 /* Decode file format */
3065 Lisp_Object insval = call3 (Qformat_decode,
3066 Qnil, make_int (inserted), visit);
3068 inserted = XINT (insval);
3074 struct gcpro ngcpro1;
3077 EXTERNAL_LIST_LOOP (p, Vafter_insert_file_functions)
3079 Lisp_Object insval =
3080 call1 (XCAR (p), make_int (inserted));
3083 CHECK_NATNUM (insval);
3084 inserted = XINT (insval);
3096 return (list2 (filename, make_int (inserted)));
3100 static int a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3101 Lisp_Object *annot);
3102 static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end);
3104 /* If build_annotations switched buffers, switch back to BUF.
3105 Kill the temporary buffer that was selected in the meantime. */
3108 build_annotations_unwind (Lisp_Object buf)
3112 if (XBUFFER (buf) == current_buffer)
3114 tembuf = Fcurrent_buffer ();
3116 Fkill_buffer (tembuf);
3120 DEFUN ("write-region-internal", Fwrite_region_internal, 3, 7,
3121 "r\nFWrite region to file: ", /*
3122 Write current region into specified file; no coding-system frobbing.
3123 This function is identical to `write-region' except for the handling
3124 of the CODESYS argument under XEmacs/Mule. (When Mule support is not
3125 present, both functions are identical and ignore the CODESYS argument.)
3126 If support for Mule exists in this Emacs, the file is encoded according
3127 to the value of CODESYS. If this is nil, no code conversion occurs.
3129 (start, end, filename, append, visit, lockname, codesys))
3131 /* This function can call lisp. GC checked 2000-07-28 ben */
3136 Lisp_Object fn = Qnil;
3137 int speccount = specpdl_depth ();
3138 int visiting_other = STRINGP (visit);
3139 int visiting = (EQ (visit, Qt) || visiting_other);
3140 int quietly = (!visiting && !NILP (visit));
3141 Lisp_Object visit_file = Qnil;
3142 Lisp_Object annotations = Qnil;
3143 struct buffer *given_buffer;
3144 Bufpos start1, end1;
3145 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3146 struct gcpro ngcpro1, ngcpro2;
3149 XSETBUFFER (curbuf, current_buffer);
3151 /* start, end, visit, and append are never modified in this fun
3152 so we don't protect them. */
3153 GCPRO5 (visit_file, filename, codesys, lockname, annotations);
3154 NGCPRO2 (curbuf, fn);
3156 /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
3157 we should signal an error rather than blissfully continuing
3158 along. ARGH, this function is going to lose lose lose. We need
3159 to protect the current_buffer from being destroyed, but the
3160 multiple return points make this a pain in the butt. ]] we do
3161 protect curbuf now. --ben */
3164 codesys = Fget_coding_system (codesys);
3165 #endif /* FILE_CODING */
3167 if (current_buffer->base_buffer && ! NILP (visit))
3168 invalid_operation ("Cannot do file visiting in an indirect buffer",
3171 if (!NILP (start) && !STRINGP (start))
3172 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0);
3175 Lisp_Object handler;
3178 visit_file = Fexpand_file_name (visit, Qnil);
3180 visit_file = filename;
3181 filename = Fexpand_file_name (filename, Qnil);
3183 if (NILP (lockname))
3184 lockname = visit_file;
3186 /* We used to UNGCPRO here. BAD! visit_file is used below after
3187 more Lisp calling. */
3188 /* If the file name has special constructs in it,
3189 call the corresponding file handler. */
3190 handler = Ffind_file_name_handler (filename, Qwrite_region);
3191 /* If FILENAME has no handler, see if VISIT has one. */
3192 if (NILP (handler) && STRINGP (visit))
3193 handler = Ffind_file_name_handler (visit, Qwrite_region);
3195 if (!NILP (handler))
3197 Lisp_Object val = call8 (handler, Qwrite_region, start, end,
3198 filename, append, visit, lockname, codesys);
3201 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3202 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3203 current_buffer->filename = visit_file;
3204 MARK_MODELINE_CHANGED;
3212 #ifdef CLASH_DETECTION
3214 lock_file (lockname);
3215 #endif /* CLASH_DETECTION */
3217 /* Special kludge to simplify auto-saving. */
3220 start1 = BUF_BEG (current_buffer);
3221 end1 = BUF_Z (current_buffer);
3224 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
3226 given_buffer = current_buffer;
3227 annotations = build_annotations (start, end);
3228 if (current_buffer != given_buffer)
3230 start1 = BUF_BEGV (current_buffer);
3231 end1 = BUF_ZV (current_buffer);
3238 desc = open ((char *) XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0);
3242 desc = open ((char *) XSTRING_DATA (fn),
3243 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
3244 auto_saving ? auto_save_mode_bits : CREAT_MODE);
3249 #ifdef CLASH_DETECTION
3251 if (!auto_saving) unlock_file (lockname);
3253 #endif /* CLASH_DETECTION */
3254 report_file_error ("Opening output file", list1 (filename));
3258 Lisp_Object desc_locative = Fcons (make_int (desc), Qnil);
3259 Lisp_Object instream = Qnil, outstream = Qnil;
3260 struct gcpro nngcpro1, nngcpro2;
3261 /* need to gcpro; QUIT could happen out of call to write() */
3262 NNGCPRO2 (instream, outstream);
3264 record_unwind_protect (close_file_unwind, desc_locative);
3268 if (lseek (desc, 0, 2) < 0)
3270 #ifdef CLASH_DETECTION
3271 if (!auto_saving) unlock_file (lockname);
3272 #endif /* CLASH_DETECTION */
3273 report_file_error ("Lseek error",
3280 /* Note: I tried increasing the buffering size, along with
3281 various other tricks, but nothing seemed to make much of
3282 a difference in the time it took to save a large file.
3283 (Actually that's not true. With a local disk, changing
3284 the buffer size doesn't seem to make much difference.
3285 With an NFS-mounted disk, it could make a lot of difference
3286 because you're affecting the number of network requests
3287 that need to be made, and there could be a large latency
3288 for each request. So I've increased the buffer size
3290 outstream = make_filedesc_output_stream (desc, 0, -1, 0);
3291 Lstream_set_buffering (XLSTREAM (outstream),
3292 LSTREAM_BLOCKN_BUFFERED, 65536);
3295 make_encoding_output_stream (XLSTREAM (outstream), codesys);
3296 Lstream_set_buffering (XLSTREAM (outstream),
3297 LSTREAM_BLOCKN_BUFFERED, 65536);
3298 #endif /* FILE_CODING */
3299 if (STRINGP (start))
3301 instream = make_lisp_string_input_stream (start, 0, -1);
3305 instream = make_lisp_buffer_input_stream (current_buffer, start1, end1,
3307 LSTR_IGNORE_ACCESSIBLE);
3308 failure = (0 > (a_write (outstream, instream, start1,
3311 /* Note that this doesn't close the desc since we created the
3312 stream without the LSTR_CLOSING flag, but it does
3313 flush out any buffered data. */
3314 if (Lstream_close (XLSTREAM (outstream)) < 0)
3319 Lstream_close (XLSTREAM (instream));
3322 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3323 Disk full in NFS may be reported here. */
3324 /* mib says that closing the file will try to write as fast as NFS can do
3325 it, and that means the fsync here is not crucial for autosave files. */
3326 if (!auto_saving && fsync (desc) < 0
3327 /* If fsync fails with EINTR, don't treat that as serious. */
3333 #endif /* HAVE_FSYNC */
3335 /* Spurious "file has changed on disk" warnings used to be seen on
3336 systems where close() can change the modtime. This is known to
3337 happen on various NFS file systems, on Windows, and on Linux.
3338 Rather than handling this on a per-system basis, we
3339 unconditionally do the xemacs_stat() after the close(). */
3341 /* NFS can report a write failure now. */
3342 if (close (desc) < 0)
3348 /* Discard the close unwind-protect. Execute the one for
3349 build_annotations (switches back to the original current buffer
3351 XCAR (desc_locative) = Qnil;
3352 unbind_to (speccount, Qnil);
3357 xemacs_stat ((char *) XSTRING_DATA (fn), &st);
3359 #ifdef CLASH_DETECTION
3361 unlock_file (lockname);
3362 #endif /* CLASH_DETECTION */
3364 /* Do this before reporting IO error
3365 to avoid a "file has changed on disk" warning on
3366 next attempt to save. */
3368 current_buffer->modtime = st.st_mtime;
3373 report_file_error ("Writing file", list1 (fn));
3378 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3379 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3380 current_buffer->filename = visit_file;
3381 MARK_MODELINE_CHANGED;
3393 message ("Wrote %s", XSTRING_DATA (visit_file));
3396 Lisp_Object fsp = Qnil;
3397 struct gcpro nngcpro1;
3400 fsp = Ffile_symlink_p (fn);
3402 message ("Wrote %s", XSTRING_DATA (fn));
3404 message ("Wrote %s (symlink to %s)",
3405 XSTRING_DATA (fn), XSTRING_DATA (fsp));
3414 /* #### This is such a load of shit!!!! There is no way we should define
3415 something so stupid as a subr, just sort the fucking list more
3417 DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3418 Return t if (car A) is numerically less than (car B).
3422 Lisp_Object objs[2];
3425 return Flss (2, objs);
3428 /* Heh heh heh, let's define this too, just to aggravate the person who
3429 wrote the above comment. */
3430 DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3431 Return t if (cdr A) is numerically less than (cdr B).
3435 Lisp_Object objs[2];
3438 return Flss (2, objs);
3441 /* Build the complete list of annotations appropriate for writing out
3442 the text between START and END, by calling all the functions in
3443 write-region-annotate-functions and merging the lists they return.
3444 If one of these functions switches to a different buffer, we assume
3445 that buffer contains altered text. Therefore, the caller must
3446 make sure to restore the current buffer in all cases,
3447 as save-excursion would do. */
3450 build_annotations (Lisp_Object start, Lisp_Object end)
3452 /* This function can GC */
3453 Lisp_Object annotations;
3455 struct gcpro gcpro1, gcpro2;
3456 Lisp_Object original_buffer;
3458 XSETBUFFER (original_buffer, current_buffer);
3461 p = Vwrite_region_annotate_functions;
3462 GCPRO2 (annotations, p);
3465 struct buffer *given_buffer = current_buffer;
3466 Vwrite_region_annotations_so_far = annotations;
3467 res = call2 (Fcar (p), start, end);
3468 /* If the function makes a different buffer current,
3469 assume that means this buffer contains altered text to be output.
3470 Reset START and END from the buffer bounds
3471 and discard all previous annotations because they should have
3472 been dealt with by this function. */
3473 if (current_buffer != given_buffer)
3475 start = make_int (BUF_BEGV (current_buffer));
3476 end = make_int (BUF_ZV (current_buffer));
3479 Flength (res); /* Check basic validity of return value */
3480 annotations = merge (annotations, res, Qcar_less_than_car);
3484 /* Now do the same for annotation functions implied by the file-format */
3485 if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
3486 p = Vauto_save_file_format;
3488 p = current_buffer->file_format;
3491 struct buffer *given_buffer = current_buffer;
3492 Vwrite_region_annotations_so_far = annotations;
3493 res = call4 (Qformat_annotate_function, Fcar (p), start, end,
3495 if (current_buffer != given_buffer)
3497 start = make_int (BUF_BEGV (current_buffer));
3498 end = make_int (BUF_ZV (current_buffer));
3502 annotations = merge (annotations, res, Qcar_less_than_car);
3509 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3510 EOF is encountered), assuming they start at position POS in the buffer
3511 of string that STREAM refers to. Intersperse with them the annotations
3512 from *ANNOT that fall into the range of positions we are reading from,
3513 each at its appropriate position.
3515 Modify *ANNOT by discarding elements as we output them.
3516 The return value is negative in case of system call failure. */
3518 /* 4K should probably be fine. We just need to reduce the number of
3519 function calls to reasonable level. The Lstream stuff itself will
3520 batch to 64K to reduce the number of system calls. */
3522 #define A_WRITE_BATCH_SIZE 4096
3525 a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3530 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3531 Lstream *instr = XLSTREAM (instream);
3532 Lstream *outstr = XLSTREAM (outstream);
3534 while (LISTP (*annot))
3536 tem = Fcar_safe (Fcar (*annot));
3538 nextpos = XINT (tem);
3542 /* If there are annotations left and we have Mule, then we
3543 have to do the I/O one emchar at a time so we can
3544 determine when to insert the annotation. */
3548 while (pos != nextpos && (ch = Lstream_get_emchar (instr)) != EOF)
3550 if (Lstream_put_emchar (outstr, ch) < 0)
3558 while (pos != nextpos)
3560 /* Otherwise there is no point to that. Just go in batches. */
3561 int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE);
3563 chunk = Lstream_read (instr, largebuf, chunk);
3566 if (chunk == 0) /* EOF */
3568 if (Lstream_write (outstr, largebuf, chunk) < chunk)
3575 tem = Fcdr (Fcar (*annot));
3578 if (Lstream_write (outstr, XSTRING_DATA (tem),
3579 XSTRING_LENGTH (tem)) < 0)
3582 *annot = Fcdr (*annot);
3593 #include <des_crypt.h>
3595 #define CRYPT_BLOCK_SIZE 8 /* bytes */
3596 #define CRYPT_KEY_SIZE 8 /* bytes */
3598 DEFUN ("encrypt-string", Fencrypt_string, 2, 2, 0, /*
3599 Encrypt STRING using KEY.
3603 char *encrypted_string, *raw_key;
3604 int rounded_size, extra, key_size;
3606 /* !!#### May produce bogus data under Mule. */
3607 CHECK_STRING (string);
3610 extra = XSTRING_LENGTH (string) % CRYPT_BLOCK_SIZE;
3611 rounded_size = XSTRING_LENGTH (string) + extra;
3612 encrypted_string = alloca (rounded_size + 1);
3613 memcpy (encrypted_string, XSTRING_DATA (string), XSTRING_LENGTH (string));
3614 memset (encrypted_string + rounded_size - extra, 0, extra + 1);
3616 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3618 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3619 memcpy (raw_key, XSTRING_DATA (key), key_size);
3620 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3622 ecb_crypt (raw_key, encrypted_string, rounded_size,
3623 DES_ENCRYPT | DES_SW);
3624 return make_string (encrypted_string, rounded_size);
3627 DEFUN ("decrypt-string", Fdecrypt_string, 2, 2, 0, /*
3628 Decrypt STRING using KEY.
3632 char *decrypted_string, *raw_key;
3633 int string_size, key_size;
3635 CHECK_STRING (string);
3638 string_size = XSTRING_LENGTH (string) + 1;
3639 decrypted_string = alloca (string_size);
3640 memcpy (decrypted_string, XSTRING_DATA (string), string_size);
3641 decrypted_string[string_size - 1] = '\0';
3643 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3645 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3646 memcpy (raw_key, XSTRING_DATA (key), key_size);
3647 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3650 ecb_crypt (raw_key, decrypted_string, string_size, D | DES_SW);
3651 return make_string (decrypted_string, string_size - 1);
3656 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
3657 Return t if last mod time of BUFFER's visited file matches what BUFFER records.
3658 This means that the file has not been changed since it was visited or saved.
3662 /* This function can call lisp; GC checked 2000-07-11 ben */
3665 Lisp_Object handler;
3667 CHECK_BUFFER (buffer);
3668 b = XBUFFER (buffer);
3670 if (!STRINGP (b->filename)) return Qt;
3671 if (b->modtime == 0) return Qt;
3673 /* If the file name has special constructs in it,
3674 call the corresponding file handler. */
3675 handler = Ffind_file_name_handler (b->filename,
3676 Qverify_visited_file_modtime);
3677 if (!NILP (handler))
3678 return call2 (handler, Qverify_visited_file_modtime, buffer);
3680 if (xemacs_stat ((char *) XSTRING_DATA (b->filename), &st) < 0)
3682 /* If the file doesn't exist now and didn't exist before,
3683 we say that it isn't modified, provided the error is a tame one. */
3684 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3689 if (st.st_mtime == b->modtime
3690 /* If both are positive, accept them if they are off by one second. */
3691 || (st.st_mtime > 0 && b->modtime > 0
3692 && (st.st_mtime == b->modtime + 1
3693 || st.st_mtime == b->modtime - 1)))
3698 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3699 Clear out records of last mod time of visited file.
3700 Next attempt to save will certainly not complain of a discrepancy.
3704 current_buffer->modtime = 0;
3708 DEFUN ("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3709 Return the current buffer's recorded visited file modification time.
3710 The value is a list of the form (HIGH . LOW), like the time values
3711 that `file-attributes' returns.
3715 return time_to_lisp ((time_t) current_buffer->modtime);
3718 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3719 Update buffer's recorded modification time from the visited file's time.
3720 Useful if the buffer was not read from the file normally
3721 or if the file itself has been changed for some known benign reason.
3722 An argument specifies the modification time value to use
3723 \(instead of that of the visited file), in the form of a list
3724 \(HIGH . LOW) or (HIGH LOW).
3728 /* This function can call lisp */
3729 if (!NILP (time_list))
3732 lisp_to_time (time_list, &the_time);
3733 current_buffer->modtime = (int) the_time;
3737 Lisp_Object filename = Qnil;
3739 Lisp_Object handler;
3740 struct gcpro gcpro1, gcpro2, gcpro3;
3742 GCPRO3 (filename, time_list, current_buffer->filename);
3743 filename = Fexpand_file_name (current_buffer->filename, Qnil);
3745 /* If the file name has special constructs in it,
3746 call the corresponding file handler. */
3747 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
3749 if (!NILP (handler))
3750 /* The handler can find the file name the same way we did. */
3751 return call2 (handler, Qset_visited_file_modtime, Qnil);
3752 else if (xemacs_stat ((char *) XSTRING_DATA (filename), &st) >= 0)
3753 current_buffer->modtime = st.st_mtime;
3760 auto_save_error (Lisp_Object condition_object, Lisp_Object ignored)
3762 /* This function can call lisp */
3765 /* Don't try printing an error message after everything is gone! */
3766 if (preparing_for_armageddon)
3768 clear_echo_area (selected_frame (), Qauto_saving, 1);
3769 Fding (Qt, Qauto_save_error, Qnil);
3770 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3771 Fsleep_for (make_int (1));
3772 message ("Auto-saving...error!for %s", XSTRING_DATA (current_buffer->name));
3773 Fsleep_for (make_int (1));
3774 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3775 Fsleep_for (make_int (1));
3780 auto_save_1 (Lisp_Object ignored)
3782 /* This function can call lisp */
3783 /* #### I think caller is protecting current_buffer? */
3785 Lisp_Object fn = current_buffer->filename;
3786 Lisp_Object a = current_buffer->auto_save_file_name;
3791 /* Get visited file's mode to become the auto save file's mode. */
3793 xemacs_stat ((char *) XSTRING_DATA (fn), &st) >= 0)
3794 /* But make sure we can overwrite it later! */
3795 auto_save_mode_bits = st.st_mode | 0600;
3797 /* default mode for auto-save files of buffers with no file is
3798 readable by owner only. This may annoy some small number of
3799 people, but the alternative removes all privacy from email. */
3800 auto_save_mode_bits = 0600;
3803 /* !!#### need to deal with this 'escape-quoted everywhere */
3804 Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil,
3814 auto_save_expand_name_error (Lisp_Object condition_object, Lisp_Object ignored)
3816 /* #### this function should spew an error message about not being
3817 able to open the .saves file. */
3822 auto_save_expand_name (Lisp_Object name)
3824 struct gcpro gcpro1;
3826 /* note that caller did NOT gc protect name, so we do it. */
3827 /* #### dmoore - this might not be necessary, if condition_case_1
3828 protects it. but I don't think it does. */
3830 RETURN_UNGCPRO (Fexpand_file_name (name, Qnil));
3835 do_auto_save_unwind (Lisp_Object fd)
3842 do_auto_save_unwind_2 (Lisp_Object old_auto_saving)
3844 auto_saving = XINT (old_auto_saving);
3848 /* Fdo_auto_save() checks whether a GC is in progress when it is called,
3849 and if so, tries to avoid touching lisp objects.
3851 The only time that Fdo_auto_save() is called while GC is in progress
3852 is if we're going down, as a result of an abort() or a kill signal.
3853 It's fairly important that we generate autosave files in that case!
3856 DEFUN ("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3857 Auto-save all buffers that need it.
3858 This is all buffers that have auto-saving enabled
3859 and are changed since last auto-saved.
3860 Auto-saving writes the buffer into a file
3861 so that your editing is not lost if the system crashes.
3862 This file is not the file you visited; that changes only when you save.
3863 Normally we run the normal hook `auto-save-hook' before saving.
3865 Non-nil first argument means do not print any message if successful.
3866 Non-nil second argument means save only current buffer.
3868 (no_message, current_only))
3870 /* This function can call lisp */
3872 Lisp_Object tail, buf;
3874 int do_handled_files;
3875 Lisp_Object oquit = Qnil;
3876 Lisp_Object listfile = Qnil;
3879 int speccount = specpdl_depth ();
3880 struct gcpro gcpro1, gcpro2, gcpro3;
3882 XSETBUFFER (old, current_buffer);
3883 GCPRO3 (oquit, listfile, old);
3884 check_quit (); /* make Vquit_flag accurate */
3885 /* Ordinarily don't quit within this function,
3886 but don't make it impossible to quit (in case we get hung in I/O). */
3890 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3891 variables point to non-strings reached from Vbuffer_alist. */
3893 if (minibuf_level != 0 || preparing_for_armageddon)
3896 run_hook (Qauto_save_hook);
3898 if (STRINGP (Vauto_save_list_file_name))
3899 listfile = condition_case_1 (Qt,
3900 auto_save_expand_name,
3901 Vauto_save_list_file_name,
3902 auto_save_expand_name_error, Qnil);
3904 /* Make sure auto_saving is reset. */
3905 record_unwind_protect (do_auto_save_unwind_2, make_int (auto_saving));
3909 /* First, save all files which don't have handlers. If Emacs is
3910 crashing, the handlers may tweak what is causing Emacs to crash
3911 in the first place, and it would be a shame if Emacs failed to
3912 autosave perfectly ordinary files because it couldn't handle some
3914 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
3916 for (tail = Vbuffer_alist;
3920 buf = XCDR (XCAR (tail));
3923 if (!NILP (current_only)
3924 && b != current_buffer)
3927 /* Don't auto-save indirect buffers.
3928 The base buffer takes care of it. */
3932 /* Check for auto save enabled
3933 and file changed since last auto save
3934 and file changed since last real save. */
3935 if (STRINGP (b->auto_save_file_name)
3936 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
3937 && b->auto_save_modified < BUF_MODIFF (b)
3938 /* -1 means we've turned off autosaving for a while--see below. */
3939 && XINT (b->saved_size) >= 0
3940 && (do_handled_files
3941 || NILP (Ffind_file_name_handler (b->auto_save_file_name,
3944 EMACS_TIME before_time, after_time;
3946 EMACS_GET_TIME (before_time);
3947 /* If we had a failure, don't try again for 20 minutes. */
3948 if (!preparing_for_armageddon
3949 && b->auto_save_failure_time >= 0
3950 && (EMACS_SECS (before_time) - b->auto_save_failure_time <
3954 if (!preparing_for_armageddon &&
3955 (XINT (b->saved_size) * 10
3956 > (BUF_Z (b) - BUF_BEG (b)) * 13)
3957 /* A short file is likely to change a large fraction;
3958 spare the user annoying messages. */
3959 && XINT (b->saved_size) > 5000
3960 /* These messages are frequent and annoying for `*mail*'. */
3961 && !NILP (b->filename)
3962 && NILP (no_message)
3963 && disable_auto_save_when_buffer_shrinks)
3965 /* It has shrunk too much; turn off auto-saving here.
3966 Unless we're about to crash, in which case auto-save it
3970 ("Buffer %s has shrunk a lot; auto save turned off there",
3971 XSTRING_DATA (b->name));
3972 /* Turn off auto-saving until there's a real save,
3973 and prevent any more warnings. */
3974 b->saved_size = make_int (-1);
3975 if (!gc_in_progress)
3976 Fsleep_for (make_int (1));
3979 set_buffer_internal (b);
3980 if (!auto_saved && NILP (no_message))
3982 static const unsigned char *msg
3983 = (const unsigned char *) "Auto-saving...";
3984 echo_area_message (selected_frame (), msg, Qnil,
3985 0, strlen ((const char *) msg),
3989 /* Open the auto-save list file, if necessary.
3990 We only do this now so that the file only exists
3991 if we actually auto-saved any files. */
3992 if (!auto_saved && !inhibit_auto_save_session
3993 && !NILP (Vauto_save_list_file_prefix)
3994 && STRINGP (listfile) && listdesc < 0)
3996 listdesc = open ((char *) XSTRING_DATA (listfile),
3997 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4000 /* Arrange to close that file whether or not we get
4003 record_unwind_protect (do_auto_save_unwind,
4004 make_int (listdesc));
4007 /* Record all the buffers that we are auto-saving in
4008 the special file that lists them. For each of
4009 these buffers, record visited name (if any) and
4013 const Extbyte *auto_save_file_name_ext;
4014 Extcount auto_save_file_name_ext_len;
4016 TO_EXTERNAL_FORMAT (LISP_STRING, b->auto_save_file_name,
4017 ALLOCA, (auto_save_file_name_ext,
4018 auto_save_file_name_ext_len),
4020 if (!NILP (b->filename))
4022 const Extbyte *filename_ext;
4023 Extcount filename_ext_len;
4025 TO_EXTERNAL_FORMAT (LISP_STRING, b->filename,
4026 ALLOCA, (filename_ext,
4029 write (listdesc, filename_ext, filename_ext_len);
4031 write (listdesc, "\n", 1);
4032 write (listdesc, auto_save_file_name_ext,
4033 auto_save_file_name_ext_len);
4034 write (listdesc, "\n", 1);
4037 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
4038 based on values in Vbuffer_alist. auto_save_1 may
4039 cause lisp handlers to run. Those handlers may kill
4040 the buffer and then GC. Since the buffer is killed,
4041 it's no longer in Vbuffer_alist so it might get reaped
4042 by the GC. We also need to protect tail. */
4043 /* #### There is probably a lot of other code which has
4044 pointers into buffers which may get blown away by
4047 struct gcpro ngcpro1, ngcpro2;
4048 NGCPRO2 (buf, tail);
4049 condition_case_1 (Qt,
4051 auto_save_error, Qnil);
4054 /* Handler killed our saved current-buffer! Pick any. */
4055 if (!BUFFER_LIVE_P (XBUFFER (old)))
4056 XSETBUFFER (old, current_buffer);
4058 set_buffer_internal (XBUFFER (old));
4061 /* Handler killed their own buffer! */
4062 if (!BUFFER_LIVE_P(b))
4065 b->auto_save_modified = BUF_MODIFF (b);
4066 b->saved_size = make_int (BUF_SIZE (b));
4067 EMACS_GET_TIME (after_time);
4068 /* If auto-save took more than 60 seconds,
4069 assume it was an NFS failure that got a timeout. */
4070 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
4071 b->auto_save_failure_time = EMACS_SECS (after_time);
4076 /* Prevent another auto save till enough input events come in. */
4078 record_auto_save ();
4080 /* If we didn't save anything into the listfile, remove the old
4081 one because nothing needed to be auto-saved. Do this afterwards
4082 rather than before in case we get a crash attempting to autosave
4083 (in that case we'd still want the old one around). */
4084 if (listdesc < 0 && !auto_saved && STRINGP (listfile))
4085 unlink ((char *) XSTRING_DATA (listfile));
4087 /* Show "...done" only if the echo area would otherwise be empty. */
4088 if (auto_saved && NILP (no_message)
4089 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0)))
4091 static const unsigned char *msg
4092 = (const unsigned char *)"Auto-saving...done";
4093 echo_area_message (selected_frame (), msg, Qnil, 0,
4094 strlen ((const char *) msg), Qauto_saving);
4099 RETURN_UNGCPRO (unbind_to (speccount, Qnil));
4102 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
4103 Mark current buffer as auto-saved with its current text.
4104 No auto-save file will be written until the buffer changes again.
4108 current_buffer->auto_save_modified = BUF_MODIFF (current_buffer);
4109 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
4110 current_buffer->auto_save_failure_time = -1;
4114 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
4115 Clear any record of a recent auto-save failure in the current buffer.
4119 current_buffer->auto_save_failure_time = -1;
4123 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
4124 Return t if buffer has been auto-saved since last read in or saved.
4128 return (BUF_SAVE_MODIFF (current_buffer) <
4129 current_buffer->auto_save_modified) ? Qt : Qnil;
4133 /************************************************************************/
4134 /* initialization */
4135 /************************************************************************/
4138 syms_of_fileio (void)
4140 defsymbol (&Qexpand_file_name, "expand-file-name");
4141 defsymbol (&Qfile_truename, "file-truename");
4142 defsymbol (&Qsubstitute_in_file_name, "substitute-in-file-name");
4143 defsymbol (&Qdirectory_file_name, "directory-file-name");
4144 defsymbol (&Qfile_name_directory, "file-name-directory");
4145 defsymbol (&Qfile_name_nondirectory, "file-name-nondirectory");
4146 defsymbol (&Qunhandled_file_name_directory, "unhandled-file-name-directory");
4147 defsymbol (&Qfile_name_as_directory, "file-name-as-directory");
4148 defsymbol (&Qcopy_file, "copy-file");
4149 defsymbol (&Qmake_directory_internal, "make-directory-internal");
4150 defsymbol (&Qdelete_directory, "delete-directory");
4151 defsymbol (&Qdelete_file, "delete-file");
4152 defsymbol (&Qrename_file, "rename-file");
4153 defsymbol (&Qadd_name_to_file, "add-name-to-file");
4154 defsymbol (&Qmake_symbolic_link, "make-symbolic-link");
4155 defsymbol (&Qfile_exists_p, "file-exists-p");
4156 defsymbol (&Qfile_executable_p, "file-executable-p");
4157 defsymbol (&Qfile_readable_p, "file-readable-p");
4158 defsymbol (&Qfile_symlink_p, "file-symlink-p");
4159 defsymbol (&Qfile_writable_p, "file-writable-p");
4160 defsymbol (&Qfile_directory_p, "file-directory-p");
4161 defsymbol (&Qfile_regular_p, "file-regular-p");
4162 defsymbol (&Qfile_accessible_directory_p, "file-accessible-directory-p");
4163 defsymbol (&Qfile_modes, "file-modes");
4164 defsymbol (&Qset_file_modes, "set-file-modes");
4165 defsymbol (&Qfile_newer_than_file_p, "file-newer-than-file-p");
4166 defsymbol (&Qinsert_file_contents, "insert-file-contents");
4167 defsymbol (&Qwrite_region, "write-region");
4168 defsymbol (&Qverify_visited_file_modtime, "verify-visited-file-modtime");
4169 defsymbol (&Qset_visited_file_modtime, "set-visited-file-modtime");
4170 defsymbol (&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */
4172 defsymbol (&Qauto_save_hook, "auto-save-hook");
4173 defsymbol (&Qauto_save_error, "auto-save-error");
4174 defsymbol (&Qauto_saving, "auto-saving");
4176 defsymbol (&Qformat_decode, "format-decode");
4177 defsymbol (&Qformat_annotate_function, "format-annotate-function");
4179 defsymbol (&Qcompute_buffer_file_truename, "compute-buffer-file-truename");
4180 DEFERROR_STANDARD (Qfile_error, Qio_error);
4181 DEFERROR_STANDARD (Qfile_already_exists, Qfile_error);
4183 DEFSUBR (Ffind_file_name_handler);
4185 DEFSUBR (Ffile_name_directory);
4186 DEFSUBR (Ffile_name_nondirectory);
4187 DEFSUBR (Funhandled_file_name_directory);
4188 DEFSUBR (Ffile_name_as_directory);
4189 DEFSUBR (Fdirectory_file_name);
4190 DEFSUBR (Fmake_temp_name);
4191 DEFSUBR (Fexpand_file_name);
4192 DEFSUBR (Ffile_truename);
4193 DEFSUBR (Fsubstitute_in_file_name);
4194 DEFSUBR (Fcopy_file);
4195 DEFSUBR (Fmake_directory_internal);
4196 DEFSUBR (Fdelete_directory);
4197 DEFSUBR (Fdelete_file);
4198 DEFSUBR (Frename_file);
4199 DEFSUBR (Fadd_name_to_file);
4200 DEFSUBR (Fmake_symbolic_link);
4202 DEFSUBR (Fsysnetunam);
4203 #endif /* HPUX_NET */
4204 DEFSUBR (Ffile_name_absolute_p);
4205 DEFSUBR (Ffile_exists_p);
4206 DEFSUBR (Ffile_executable_p);
4207 DEFSUBR (Ffile_readable_p);
4208 DEFSUBR (Ffile_writable_p);
4209 DEFSUBR (Ffile_symlink_p);
4210 DEFSUBR (Ffile_directory_p);
4211 DEFSUBR (Ffile_accessible_directory_p);
4212 DEFSUBR (Ffile_regular_p);
4213 DEFSUBR (Ffile_modes);
4214 DEFSUBR (Fset_file_modes);
4215 DEFSUBR (Fset_default_file_modes);
4216 DEFSUBR (Fdefault_file_modes);
4217 DEFSUBR (Funix_sync);
4218 DEFSUBR (Ffile_newer_than_file_p);
4219 DEFSUBR (Finsert_file_contents_internal);
4220 DEFSUBR (Fwrite_region_internal);
4221 DEFSUBR (Fcar_less_than_car); /* Vomitous! */
4222 DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
4224 DEFSUBR (Fencrypt_string);
4225 DEFSUBR (Fdecrypt_string);
4227 DEFSUBR (Fverify_visited_file_modtime);
4228 DEFSUBR (Fclear_visited_file_modtime);
4229 DEFSUBR (Fvisited_file_modtime);
4230 DEFSUBR (Fset_visited_file_modtime);
4232 DEFSUBR (Fdo_auto_save);
4233 DEFSUBR (Fset_buffer_auto_saved);
4234 DEFSUBR (Fclear_buffer_auto_save_failure);
4235 DEFSUBR (Frecent_auto_save_p);
4239 vars_of_fileio (void)
4241 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /*
4242 *Format in which to write auto-save files.
4243 Should be a list of symbols naming formats that are defined in `format-alist'.
4244 If it is t, which is the default, auto-save files are written in the
4245 same format as a regular save would use.
4247 Vauto_save_file_format = Qt;
4249 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /*
4250 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
4251 If a file name matches REGEXP, then all I/O on that file is done by calling
4254 The first argument given to HANDLER is the name of the I/O primitive
4255 to be handled; the remaining arguments are the arguments that were
4256 passed to that primitive. For example, if you do
4257 (file-exists-p FILENAME)
4258 and FILENAME is handled by HANDLER, then HANDLER is called like this:
4259 (funcall HANDLER 'file-exists-p FILENAME)
4260 The function `find-file-name-handler' checks this list for a handler
4263 Vfile_name_handler_alist = Qnil;
4265 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /*
4266 A list of functions to be called at the end of `insert-file-contents'.
4267 Each is passed one argument, the number of bytes inserted. It should return
4268 the new byte count, and leave point the same. If `insert-file-contents' is
4269 intercepted by a handler from `file-name-handler-alist', that handler is
4270 responsible for calling the after-insert-file-functions if appropriate.
4272 Vafter_insert_file_functions = Qnil;
4274 DEFVAR_LISP ("write-region-annotate-functions",
4275 &Vwrite_region_annotate_functions /*
4276 A list of functions to be called at the start of `write-region'.
4277 Each is passed two arguments, START and END, as for `write-region'.
4278 It should return a list of pairs (POSITION . STRING) of strings to be
4279 effectively inserted at the specified positions of the file being written
4280 \(1 means to insert before the first byte written). The POSITIONs must be
4281 sorted into increasing order. If there are several functions in the list,
4282 the several lists are merged destructively.
4284 Vwrite_region_annotate_functions = Qnil;
4286 DEFVAR_LISP ("write-region-annotations-so-far",
4287 &Vwrite_region_annotations_so_far /*
4288 When an annotation function is called, this holds the previous annotations.
4289 These are the annotations made by other annotation functions
4290 that were already called. See also `write-region-annotate-functions'.
4292 Vwrite_region_annotations_so_far = Qnil;
4294 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
4295 A list of file name handlers that temporarily should not be used.
4296 This applies only to the operation `inhibit-file-name-operation'.
4298 Vinhibit_file_name_handlers = Qnil;
4300 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
4301 The operation for which `inhibit-file-name-handlers' is applicable.
4303 Vinhibit_file_name_operation = Qnil;
4305 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name /*
4306 File name in which we write a list of all auto save file names.
4308 Vauto_save_list_file_name = Qnil;
4310 DEFVAR_LISP ("auto-save-list-file-prefix", &Vauto_save_list_file_prefix /*
4311 Prefix for generating auto-save-list-file-name.
4312 Emacs's pid and the system name will be appended to
4313 this prefix to create a unique file name.
4315 Vauto_save_list_file_prefix = build_string ("~/.saves-");
4317 DEFVAR_BOOL ("inhibit-auto-save-session", &inhibit_auto_save_session /*
4318 When non-nil, inhibit auto save list file creation.
4320 inhibit_auto_save_session = 0;
4322 DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks",
4323 &disable_auto_save_when_buffer_shrinks /*
4324 If non-nil, auto-saving is disabled when a buffer shrinks too much.
4325 This is to prevent you from losing your edits if you accidentally
4326 delete a large chunk of the buffer and don't notice it until too late.
4327 Saving the buffer normally turns auto-save back on.
4329 disable_auto_save_when_buffer_shrinks = 1;
4331 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /*
4332 Directory separator character for built-in functions that return file names.
4333 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
4334 This variable affects the built-in functions only on Windows,
4335 on other platforms, it is initialized so that Lisp code can find out
4336 what the normal separator is.
4339 Vdirectory_sep_char = make_char ('\\');
4341 Vdirectory_sep_char = make_char ('/');
4344 reinit_vars_of_fileio ();
4348 reinit_vars_of_fileio (void)
4350 /* We want temp_name_rand to be initialized to a value likely to be
4351 unique to the process, not to the executable. The danger is that
4352 two different XEmacs processes using the same binary on different
4353 machines creating temp files in the same directory will be
4354 unlucky enough to have the same pid. If we randomize using
4355 process startup time, then in practice they will be unlikely to
4356 collide. We use the microseconds field so that scripts that start
4357 simultaneous XEmacs processes on multiple machines will have less
4358 chance of collision. */
4362 EMACS_GET_TIME (thyme);
4363 temp_name_rand = (unsigned int) (EMACS_SECS (thyme) ^ EMACS_USECS (thyme));