2 Copyright (C) 1985-1988, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1996 Ben Wing.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: Mule 2.0, FSF 19.30. */
23 /* More syncing: FSF Emacs 19.34.6 by Marc Paquette <marcpa@cam.org> */
33 #include "redisplay.h"
35 #include "window.h" /* minibuf_level */
37 #include "file-coding.h"
40 #ifdef HAVE_LIBGEN_H /* Must come before sysfile.h */
53 #endif /* HPUX_PRE_8_0 */
57 #define IS_DRIVE(x) isalpha (x)
58 /* Need to lower-case the drive letter, or else expanded
59 filenames will sometimes compare inequal, because
60 `expand-file-name' doesn't always down-case the drive letter. */
61 #define DRIVE_LETTER(x) tolower (x)
62 #endif /* WIN32_NATIVE */
64 int lisp_to_time (Lisp_Object, time_t *);
65 Lisp_Object time_to_lisp (time_t);
67 /* Nonzero during writing of auto-save files */
68 static int auto_saving;
70 /* Set by auto_save_1 to mode of original file so Fwrite_region_internal
71 will create a new file with the same mode as the original */
72 static int auto_save_mode_bits;
74 /* Alist of elements (REGEXP . HANDLER) for file names
75 whose I/O is done with a special handler. */
76 Lisp_Object Vfile_name_handler_alist;
78 /* Format for auto-save files */
79 Lisp_Object Vauto_save_file_format;
81 /* Lisp functions for translating file formats */
82 Lisp_Object Qformat_decode, Qformat_annotate_function;
84 /* Functions to be called to process text properties in inserted file. */
85 Lisp_Object Vafter_insert_file_functions;
87 /* Functions to be called to create text property annotations for file. */
88 Lisp_Object Vwrite_region_annotate_functions;
90 /* During build_annotations, each time an annotation function is called,
91 this holds the annotations made by the previous functions. */
92 Lisp_Object Vwrite_region_annotations_so_far;
94 /* File name in which we write a list of all our auto save files. */
95 Lisp_Object Vauto_save_list_file_name;
97 int disable_auto_save_when_buffer_shrinks;
99 Lisp_Object Vdirectory_sep_char;
101 /* These variables describe handlers that have "already" had a chance
102 to handle the current operation.
104 Vinhibit_file_name_handlers is a list of file name handlers.
105 Vinhibit_file_name_operation is the operation being handled.
106 If we try to handle that operation, we ignore those handlers. */
108 static Lisp_Object Vinhibit_file_name_handlers;
109 static Lisp_Object Vinhibit_file_name_operation;
111 Lisp_Object Qfile_error, Qfile_already_exists;
113 Lisp_Object Qauto_save_hook;
114 Lisp_Object Qauto_save_error;
115 Lisp_Object Qauto_saving;
117 Lisp_Object Qcar_less_than_car;
119 Lisp_Object Qcompute_buffer_file_truename;
121 EXFUN (Frunning_temacs_p, 0);
123 /* signal a file error when errno contains a meaningful value. */
126 report_file_error (const char *string, Lisp_Object data)
128 /* #### dmoore - This uses current_buffer, better make sure no one
129 has GC'd the current buffer. File handlers are giving me a headache
130 maybe I'll just always protect current_buffer around all of those
133 signal_error (Qfile_error,
134 Fcons (build_translated_string (string),
135 Fcons (lisp_strerror (errno), data)));
139 maybe_report_file_error (const char *string, Lisp_Object data,
140 Lisp_Object class, Error_behavior errb)
143 if (ERRB_EQ (errb, ERROR_ME_NOT))
146 maybe_signal_error (Qfile_error,
147 Fcons (build_translated_string (string),
148 Fcons (lisp_strerror (errno), data)),
152 /* signal a file error when errno does not contain a meaningful value. */
155 signal_file_error (const char *string, Lisp_Object data)
157 signal_error (Qfile_error,
158 list2 (build_translated_string (string), data));
162 maybe_signal_file_error (const char *string, Lisp_Object data,
163 Lisp_Object class, Error_behavior errb)
166 if (ERRB_EQ (errb, ERROR_ME_NOT))
168 maybe_signal_error (Qfile_error,
169 list2 (build_translated_string (string), data),
174 signal_double_file_error (const char *string1, const char *string2,
177 signal_error (Qfile_error,
178 list3 (build_translated_string (string1),
179 build_translated_string (string2),
184 maybe_signal_double_file_error (const char *string1, const char *string2,
185 Lisp_Object data, Lisp_Object class,
189 if (ERRB_EQ (errb, ERROR_ME_NOT))
191 maybe_signal_error (Qfile_error,
192 list3 (build_translated_string (string1),
193 build_translated_string (string2),
199 signal_double_file_error_2 (const char *string1, const char *string2,
200 Lisp_Object data1, Lisp_Object data2)
202 signal_error (Qfile_error,
203 list4 (build_translated_string (string1),
204 build_translated_string (string2),
209 maybe_signal_double_file_error_2 (const char *string1, const char *string2,
210 Lisp_Object data1, Lisp_Object data2,
211 Lisp_Object class, Error_behavior errb)
214 if (ERRB_EQ (errb, ERROR_ME_NOT))
216 maybe_signal_error (Qfile_error,
217 list4 (build_translated_string (string1),
218 build_translated_string (string2),
224 /* Just like strerror(3), except return a lisp string instead of char *.
225 The string needs to be converted since it may be localized.
226 Perhaps this should use strerror-coding-system instead? */
228 lisp_strerror (int errnum)
230 return build_ext_string (strerror (errnum), Qnative);
234 close_file_unwind (Lisp_Object fd)
238 if (INTP (XCAR (fd)))
239 close (XINT (XCAR (fd)));
241 free_cons (XCONS (fd));
250 delete_stream_unwind (Lisp_Object stream)
252 Lstream_delete (XLSTREAM (stream));
256 /* Restore point, having saved it as a marker. */
259 restore_point_unwind (Lisp_Object point_marker)
261 BUF_SET_PT (current_buffer, marker_position (point_marker));
262 return Fset_marker (point_marker, Qnil, Qnil);
265 /* Versions of read() and write() that allow quitting out of the actual
266 I/O. We don't use immediate_quit (i.e. direct longjmp() out of the
267 signal handler) because that's way too losing.
269 (#### Actually, longjmp()ing out of the signal handler may not be
270 as losing as I thought. See sys_do_signal() in sysdep.c.) */
273 read_allowing_quit (int fildes, void *buf, size_t size)
276 return sys_read_1 (fildes, buf, size, 1);
280 write_allowing_quit (int fildes, const void *buf, size_t size)
283 return sys_write_1 (fildes, buf, size, 1);
287 Lisp_Object Qexpand_file_name;
288 Lisp_Object Qfile_truename;
289 Lisp_Object Qsubstitute_in_file_name;
290 Lisp_Object Qdirectory_file_name;
291 Lisp_Object Qfile_name_directory;
292 Lisp_Object Qfile_name_nondirectory;
293 Lisp_Object Qunhandled_file_name_directory;
294 Lisp_Object Qfile_name_as_directory;
295 Lisp_Object Qcopy_file;
296 Lisp_Object Qmake_directory_internal;
297 Lisp_Object Qdelete_directory;
298 Lisp_Object Qdelete_file;
299 Lisp_Object Qrename_file;
300 Lisp_Object Qadd_name_to_file;
301 Lisp_Object Qmake_symbolic_link;
302 Lisp_Object Qfile_exists_p;
303 Lisp_Object Qfile_executable_p;
304 Lisp_Object Qfile_readable_p;
305 Lisp_Object Qfile_symlink_p;
306 Lisp_Object Qfile_writable_p;
307 Lisp_Object Qfile_directory_p;
308 Lisp_Object Qfile_regular_p;
309 Lisp_Object Qfile_accessible_directory_p;
310 Lisp_Object Qfile_modes;
311 Lisp_Object Qset_file_modes;
312 Lisp_Object Qfile_newer_than_file_p;
313 Lisp_Object Qinsert_file_contents;
314 Lisp_Object Qwrite_region;
315 Lisp_Object Qverify_visited_file_modtime;
316 Lisp_Object Qset_visited_file_modtime;
318 /* If FILENAME is handled specially on account of its syntax,
319 return its handler function. Otherwise, return nil. */
321 DEFUN ("find-file-name-handler", Ffind_file_name_handler, 1, 2, 0, /*
322 Return FILENAME's handler function for OPERATION, if it has one.
323 Otherwise, return nil.
324 A file name is handled if one of the regular expressions in
325 `file-name-handler-alist' matches it.
327 If OPERATION equals `inhibit-file-name-operation', then we ignore
328 any handlers that are members of `inhibit-file-name-handlers',
329 but we still do run any other handlers. This lets handlers
330 use the standard functions without calling themselves recursively.
332 (filename, operation))
334 /* This function does not GC */
335 /* This function can be called during GC */
336 /* This function must not munge the match data. */
337 Lisp_Object chain, inhibited_handlers;
339 CHECK_STRING (filename);
341 if (EQ (operation, Vinhibit_file_name_operation))
342 inhibited_handlers = Vinhibit_file_name_handlers;
344 inhibited_handlers = Qnil;
346 EXTERNAL_LIST_LOOP (chain, Vfile_name_handler_alist)
348 Lisp_Object elt = XCAR (chain);
351 Lisp_Object string = XCAR (elt);
353 && (fast_lisp_string_match (string, filename) >= 0))
355 Lisp_Object handler = XCDR (elt);
356 if (NILP (Fmemq (handler, inhibited_handlers)))
366 call2_check_string (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
368 /* This function can call lisp */
369 Lisp_Object result = call2 (fn, arg0, arg1);
370 CHECK_STRING (result);
375 call2_check_string_or_nil (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
377 /* This function can call lisp */
378 Lisp_Object result = call2 (fn, arg0, arg1);
380 CHECK_STRING (result);
385 call3_check_string (Lisp_Object fn, Lisp_Object arg0,
386 Lisp_Object arg1, Lisp_Object arg2)
388 /* This function can call lisp */
389 Lisp_Object result = call3 (fn, arg0, arg1, arg2);
390 CHECK_STRING (result);
395 DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /*
396 Return the directory component in file name NAME.
397 Return nil if NAME does not include a directory.
398 Otherwise return a directory spec.
399 Given a Unix syntax file name, returns a string ending in slash.
403 /* This function can GC. GC checked 2000-07-28 ben */
410 /* If the file name has special constructs in it,
411 call the corresponding file handler. */
412 handler = Ffind_file_name_handler (file, Qfile_name_directory);
414 return call2_check_string_or_nil (handler, Qfile_name_directory, file);
416 #ifdef FILE_SYSTEM_CASE
417 file = FILE_SYSTEM_CASE (file);
419 beg = XSTRING_DATA (file);
420 p = beg + XSTRING_LENGTH (file);
422 while (p != beg && !IS_ANY_SEP (p[-1])
424 /* only recognize drive specifier at beginning */
425 && !(p[-1] == ':' && p == beg + 2)
432 /* Expansion of "c:" to drive and default directory. */
433 /* (NT does the right thing.) */
434 if (p == beg + 2 && beg[1] == ':')
436 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
437 Bufbyte *res = (Bufbyte*) alloca (MAXPATHLEN + 1);
438 if (_getdcwd (toupper (*beg) - 'A' + 1, (char *)res, MAXPATHLEN))
440 char *c=((char *) res) + strlen ((char *) res);
441 if (!IS_DIRECTORY_SEP (*c))
443 *c++ = DIRECTORY_SEP;
447 p = beg + strlen ((char *) beg);
450 #endif /* WIN32_NATIVE */
451 return make_string (beg, p - beg);
454 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /*
455 Return file name NAME sans its directory.
456 For example, in a Unix-syntax file name,
457 this is everything after the last slash,
458 or the entire name if it contains no slash.
462 /* This function can GC. GC checked 2000-07-28 ben */
463 Bufbyte *beg, *p, *end;
468 /* If the file name has special constructs in it,
469 call the corresponding file handler. */
470 handler = Ffind_file_name_handler (file, Qfile_name_nondirectory);
472 return call2_check_string (handler, Qfile_name_nondirectory, file);
474 beg = XSTRING_DATA (file);
475 end = p = beg + XSTRING_LENGTH (file);
477 while (p != beg && !IS_ANY_SEP (p[-1])
479 /* only recognize drive specifier at beginning */
480 && !(p[-1] == ':' && p == beg + 2)
484 return make_string (p, end - p);
487 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /*
488 Return a directly usable directory name somehow associated with FILENAME.
489 A `directly usable' directory name is one that may be used without the
490 intervention of any file handler.
491 If FILENAME is a directly usable file itself, return
492 \(file-name-directory FILENAME).
493 The `call-process' and `start-process' functions use this function to
494 get a current directory to run processes in.
498 /* This function can GC. GC checked 2000-07-28 ben */
501 /* If the file name has special constructs in it,
502 call the corresponding file handler. */
503 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
505 return call2 (handler, Qunhandled_file_name_directory,
508 return Ffile_name_directory (filename);
513 file_name_as_directory (char *out, char *in)
515 /* This function cannot GC */
516 int size = strlen (in);
521 out[1] = DIRECTORY_SEP;
527 /* Append a slash if necessary */
528 if (!IS_ANY_SEP (out[size-1]))
530 out[size] = DIRECTORY_SEP;
531 out[size + 1] = '\0';
537 DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /*
538 Return a string representing file FILENAME interpreted as a directory.
539 This operation exists because a directory is also a file, but its name as
540 a directory is different from its name as a file.
541 The result can be used as the value of `default-directory'
542 or passed as second argument to `expand-file-name'.
543 For a Unix-syntax file name, just appends a slash,
544 except for (file-name-as-directory \"\") => \"./\".
548 /* This function can GC. GC checked 2000-07-28 ben */
554 /* If the file name has special constructs in it,
555 call the corresponding file handler. */
556 handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
558 return call2_check_string (handler, Qfile_name_as_directory, file);
560 buf = (char *) alloca (XSTRING_LENGTH (file) + 10);
561 return build_string (file_name_as_directory
562 (buf, (char *) XSTRING_DATA (file)));
566 * Convert from directory name to filename.
567 * On UNIX, it's simple: just make sure there isn't a terminating /
569 * Value is nonzero if the string output is different from the input.
573 directory_file_name (const char *src, char *dst)
575 /* This function cannot GC */
576 long slen = strlen (src);
577 /* Process as Unix format: just remove any final slash.
578 But leave "/" unchanged; do not change it to "". */
581 && IS_DIRECTORY_SEP (dst[slen - 1])
583 && !IS_ANY_SEP (dst[slen - 2])
584 #endif /* WIN32_NATIVE */
590 DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
591 Return the file name of the directory named DIR.
592 This is the name of the file that holds the data for the directory DIR.
593 This operation exists because a directory is also a file, but its name as
594 a directory is different from its name as a file.
595 In Unix-syntax, this function just removes the final slash.
599 /* This function can GC. GC checked 2000-07-28 ben */
603 CHECK_STRING (directory);
605 #if 0 /* #### WTF? */
606 if (NILP (directory))
610 /* If the file name has special constructs in it,
611 call the corresponding file handler. */
612 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
614 return call2_check_string (handler, Qdirectory_file_name, directory);
615 buf = (char *) alloca (XSTRING_LENGTH (directory) + 20);
616 directory_file_name ((char *) XSTRING_DATA (directory), buf);
617 return build_string (buf);
620 /* Fmake_temp_name used to be a simple wrapper around mktemp(), but it
621 proved too broken for our purposes (it supported only 26 or 62
622 unique names under some implementations). For example, this
623 arbitrary limit broke generation of Gnus Incoming* files.
625 This implementation is better than what one usually finds in libc.
628 static unsigned int temp_name_rand;
630 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
631 Generate a temporary file name starting with PREFIX.
632 The Emacs process number forms part of the result, so there is no
633 danger of generating a name being used by another process.
635 In addition, this function makes an attempt to choose a name that
636 does not specify an existing file. To make this work, PREFIX should
637 be an absolute file name.
641 static const char tbl[64] =
643 'A','B','C','D','E','F','G','H',
644 'I','J','K','L','M','N','O','P',
645 'Q','R','S','T','U','V','W','X',
646 'Y','Z','a','b','c','d','e','f',
647 'g','h','i','j','k','l','m','n',
648 'o','p','q','r','s','t','u','v',
649 'w','x','y','z','0','1','2','3',
650 '4','5','6','7','8','9','-','_'
657 CHECK_STRING (prefix);
659 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's
662 1) It might change the prefix, so the resulting string might not
663 begin with PREFIX. This violates the principle of least
666 2) It breaks under many unforeseeable circumstances, such as with
667 the code that uses (make-temp-name "") instead of
668 (make-temp-name "./").
670 3) It might yield unexpected (to stat(2)) results in the presence
671 of EFS and file name handlers. */
673 len = XSTRING_LENGTH (prefix);
674 val = make_uninit_string (len + 6);
675 data = XSTRING_DATA (val);
676 memcpy (data, XSTRING_DATA (prefix), len);
679 /* VAL is created by adding 6 characters to PREFIX. The first three
680 are the PID of this process, in base 64, and the second three are
681 a pseudo-random number seeded from process startup time. This
682 ensures 262144 unique file names per PID per PREFIX per machine. */
685 unsigned int pid = (unsigned int) getpid ();
686 *p++ = tbl[(pid >> 0) & 63];
687 *p++ = tbl[(pid >> 6) & 63];
688 *p++ = tbl[(pid >> 12) & 63];
691 /* Here we try to minimize useless stat'ing when this function is
692 invoked many times successively with the same PREFIX. We achieve
693 this by using a very pseudo-random number generator to generate
694 file names unique to this process, with a very long cycle. */
700 p[0] = tbl[(temp_name_rand >> 0) & 63];
701 p[1] = tbl[(temp_name_rand >> 6) & 63];
702 p[2] = tbl[(temp_name_rand >> 12) & 63];
704 /* Poor man's congruential RN generator. Replace with ++count
706 temp_name_rand += 25229;
707 temp_name_rand %= 225307;
711 if (xemacs_stat ((const char *) data, &ignored) < 0)
713 /* We want to return only if errno is ENOENT. */
717 /* The error here is dubious, but there is little else we
718 can do. The alternatives are to return nil, which is
719 as bad as (and in many cases worse than) throwing the
720 error, or to ignore the error, which will likely result
722 report_file_error ("Cannot create temporary name for prefix",
724 return Qnil; /* not reached */
730 DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /*
731 Convert filename NAME to absolute, and canonicalize it.
732 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
733 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
734 the current buffer's value of default-directory is used.
735 File name components that are `.' are removed, and
736 so are file name components followed by `..', along with the `..' itself;
737 note that these simplifications are done without checking the resulting
738 file names in the file system.
739 An initial `~/' expands to your home directory.
740 An initial `~USER/' expands to USER's home directory.
741 See also the function `substitute-in-file-name'.
743 (name, default_directory))
745 /* This function can GC. GC-checked 2000-07-11 ben */
748 Bufbyte *newdir, *p, *o;
753 int collapse_newdir = 1;
756 #endif /* WIN32_NATIVE */
762 struct gcpro gcpro1, gcpro2;
764 /* both of these get set below */
765 GCPRO2 (name, default_directory);
769 /* If the file name has special constructs in it,
770 call the corresponding file handler. */
771 handler = Ffind_file_name_handler (name, Qexpand_file_name);
775 return call3_check_string (handler, Qexpand_file_name, name,
779 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
780 if (NILP (default_directory))
781 default_directory = current_buffer->directory;
782 if (! STRINGP (default_directory))
783 default_directory = build_string ("/");
785 if (!NILP (default_directory))
787 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
791 return call3 (handler, Qexpand_file_name, name, default_directory);
795 o = XSTRING_DATA (default_directory);
797 /* Make sure DEFAULT_DIRECTORY is properly expanded.
798 It would be better to do this down below where we actually use
799 default_directory. Unfortunately, calling Fexpand_file_name recursively
800 could invoke GC, and the strings might be relocated. This would
801 be annoying because we have pointers into strings lying around
802 that would need adjusting, and people would add new pointers to
803 the code and forget to adjust them, resulting in intermittent bugs.
804 Putting this call here avoids all that crud.
806 The EQ test avoids infinite recursion. */
807 if (! NILP (default_directory) && !EQ (default_directory, name)
808 /* Save time in some common cases - as long as default_directory
809 is not relative, it can be canonicalized with name below (if it
810 is needed at all) without requiring it to be expanded now. */
812 /* Detect Windows file names with drive specifiers. */
813 && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2])))
814 /* Detect Windows file names in UNC format. */
815 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
817 #else /* not WIN32_NATIVE */
819 /* Detect Unix absolute file names (/... alone is not absolute on
821 && ! (IS_DIRECTORY_SEP (o[0]))
822 #endif /* not WIN32_NATIVE */
825 default_directory = Fexpand_file_name (default_directory, Qnil);
827 #ifdef FILE_SYSTEM_CASE
828 name = FILE_SYSTEM_CASE (name);
831 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing
832 into name should be safe during all of this, though. */
833 nm = XSTRING_DATA (name);
836 /* We will force directory separators to be either all \ or /, so make
837 a local copy to modify, even if there ends up being no change. */
838 nm = strcpy ((char *)alloca (strlen ((char *)nm) + 1), (char *)nm);
840 /* Find and remove drive specifier if present; this makes nm absolute
841 even if the rest of the name appears to be relative. */
843 Bufbyte *colon = (Bufbyte *) strrchr ((char *)nm, ':');
846 /* Only recognize colon as part of drive specifier if there is a
847 single alphabetic character preceding the colon (and if the
848 character before the drive letter, if present, is a directory
849 separator); this is to support the remote system syntax used by
850 ange-ftp, and the "po:username" syntax for POP mailboxes. */
854 else if (IS_DRIVE (colon[-1])
855 && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2])))
862 while (--colon >= nm)
868 /* If we see "c://somedir", we want to strip the first slash after the
869 colon when stripping the drive letter. Otherwise, this expands to
871 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
873 #endif /* WIN32_NATIVE */
875 /* If nm is absolute, look for /./ or /../ sequences; if none are
876 found, we can probably return right away. We will avoid allocating
877 a new string if name is already fully expanded. */
879 IS_DIRECTORY_SEP (nm[0])
881 && (drive || IS_DIRECTORY_SEP (nm[1]))
885 /* If it turns out that the filename we want to return is just a
886 suffix of FILENAME, we don't need to go through and edit
887 things; we just need to construct a new string using data
888 starting at the middle of FILENAME. If we set lose to a
889 non-zero value, that means we've discovered that we can't do
896 /* Since we know the name is absolute, we can assume that each
897 element starts with a "/". */
899 /* "." and ".." are hairy. */
900 if (IS_DIRECTORY_SEP (p[0])
902 && (IS_DIRECTORY_SEP (p[2])
904 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
912 /* Make sure directories are all separated with / or \ as
913 desired, but avoid allocation of a new string when not
915 CORRECT_DIR_SEPS (nm);
916 if (IS_DIRECTORY_SEP (nm[1]))
918 if (strcmp (nm, XSTRING_DATA (name)) != 0)
919 name = build_string (nm);
921 /* drive must be set, so this is okay */
922 else if (strcmp (nm - 2, XSTRING_DATA (name)) != 0)
924 name = make_string (nm - 2, p - nm + 2);
925 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
926 XSTRING_DATA (name)[1] = ':';
928 RETURN_UNGCPRO (name);
929 #else /* not WIN32_NATIVE */
930 if (nm == XSTRING_DATA (name))
931 RETURN_UNGCPRO (name);
932 RETURN_UNGCPRO (build_string ((char *) nm));
933 #endif /* not WIN32_NATIVE */
937 /* At this point, nm might or might not be an absolute file name. We
938 need to expand ~ or ~user if present, otherwise prefix nm with
939 default_directory if nm is not absolute, and finally collapse /./
940 and /foo/../ sequences.
942 We set newdir to be the appropriate prefix if one is needed:
943 - the relevant user directory if nm starts with ~ or ~user
944 - the specified drive's working dir (DOS/NT only) if nm does not
946 - the value of default_directory.
948 Note that these prefixes are not guaranteed to be absolute (except
949 for the working dir of a drive). Therefore, to ensure we always
950 return an absolute name, if the final prefix is not absolute we
951 append it to the current working directory. */
955 if (nm[0] == '~') /* prefix ~ */
957 if (IS_DIRECTORY_SEP (nm[1])
958 || nm[1] == 0) /* ~ by itself */
960 Extbyte *newdir_external = get_home_directory ();
962 if (newdir_external == NULL)
963 newdir = (Bufbyte *) "";
965 TO_INTERNAL_FORMAT (C_STRING, newdir_external,
966 C_STRING_ALLOCA, (* ((char **) &newdir)),
974 else /* ~user/filename */
976 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++)
978 o = (Bufbyte *) alloca (p - nm + 1);
979 memcpy (o, (char *) nm, p - nm);
982 /* #### marcpa's syncing note: FSF uses getpwnam even on NT,
983 which does not work. The following works only if ~USER
984 names the user who runs this instance of XEmacs. While
985 NT is single-user (for the moment) you still can have
986 multiple user profiles users defined, each with its HOME.
987 Therefore, the following should be reworked to handle
990 /* Now if the file given is "~foo/file" and HOME="c:/", then
991 we want the file to be named "c:/file" ("~foo" becomes
992 "c:/"). The variable o has "~foo", so we can use the
993 length of that string to offset nm. August Hill, 31 Aug
995 newdir = (Bufbyte *) get_home_directory();
996 dostounix_filename (newdir);
998 #else /* not WIN32_NATIVE */
1000 if ((user = user_login_name (NULL)) != NULL)
1002 /* Does the user login name match the ~name? */
1003 if (strcmp (user, (char *) o + 1) == 0)
1005 newdir = (Bufbyte *) get_home_directory();
1012 /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM
1013 occurring in it. (It can call select()). */
1014 slow_down_interrupts ();
1015 pw = (struct passwd *) getpwnam ((char *) o + 1);
1016 speed_up_interrupts ();
1019 newdir = (Bufbyte *) pw -> pw_dir;
1025 #endif /* not WIN32_NATIVE */
1027 /* If we don't find a user of that name, leave the name
1028 unchanged; don't move nm forward to p. */
1033 /* On DOS and Windows, nm is absolute if a drive name was specified;
1034 use the drive's current directory as the prefix if needed. */
1035 if (!newdir && drive)
1037 /* Get default directory if needed to make nm absolute. */
1038 if (!IS_DIRECTORY_SEP (nm[0]))
1040 newdir = alloca (MAXPATHLEN + 1);
1041 if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN))
1046 /* Either nm starts with /, or drive isn't mounted. */
1047 newdir = alloca (4);
1048 newdir[0] = DRIVE_LETTER (drive);
1054 #endif /* WIN32_NATIVE */
1056 /* Finally, if no prefix has been specified and nm is not absolute,
1057 then it must be expanded relative to default_directory. */
1060 #ifndef WIN32_NATIVE
1061 /* /... alone is not absolute on DOS and Windows. */
1062 && !IS_DIRECTORY_SEP (nm[0])
1064 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
1068 newdir = XSTRING_DATA (default_directory);
1074 /* First ensure newdir is an absolute name. */
1076 /* Detect Windows file names with drive specifiers. */
1077 ! (IS_DRIVE (newdir[0])
1078 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
1079 /* Detect Windows file names in UNC format. */
1080 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1081 /* Detect drive spec by itself */
1082 && ! (IS_DEVICE_SEP (newdir[1]) && newdir[2] == 0)
1085 /* Effectively, let newdir be (expand-file-name newdir cwd).
1086 Because of the admonition against calling expand-file-name
1087 when we have pointers into lisp strings, we accomplish this
1088 indirectly by prepending newdir to nm if necessary, and using
1089 cwd (or the wd of newdir's drive) as the new newdir. */
1091 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1096 if (!IS_DIRECTORY_SEP (nm[0]))
1098 char * tmp = alloca (strlen (newdir) + strlen (nm) + 2);
1099 file_name_as_directory (tmp, newdir);
1103 newdir = alloca (MAXPATHLEN + 1);
1106 if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN))
1113 /* Strip off drive name from prefix, if present. */
1114 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1120 /* Keep only a prefix from newdir if nm starts with slash
1121 (/ /server/share for UNC, nothing otherwise). */
1122 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
1124 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1126 newdir = strcpy (alloca (strlen (newdir) + 1), newdir);
1128 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1130 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1137 #endif /* WIN32_NATIVE */
1141 /* Get rid of any slash at the end of newdir, unless newdir is
1142 just // (an incomplete UNC name). */
1143 length = strlen ((char *) newdir);
1144 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
1146 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
1150 Bufbyte *temp = (Bufbyte *) alloca (length);
1151 memcpy (temp, newdir, length - 1);
1152 temp[length - 1] = 0;
1160 /* Now concatenate the directory and name to new space in the stack frame */
1161 tlen += strlen ((char *) nm) + 1;
1163 /* Add reserved space for drive name. (The Microsoft x86 compiler
1164 produces incorrect code if the following two lines are combined.) */
1165 target = (Bufbyte *) alloca (tlen + 2);
1167 #else /* not WIN32_NATIVE */
1168 target = (Bufbyte *) alloca (tlen);
1169 #endif /* not WIN32_NATIVE */
1174 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
1175 strcpy ((char *) target, (char *) newdir);
1177 file_name_as_directory ((char *) target, (char *) newdir);
1180 strcat ((char *) target, (char *) nm);
1182 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1184 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1191 if (!IS_DIRECTORY_SEP (*p))
1195 else if (IS_DIRECTORY_SEP (p[0])
1197 && (IS_DIRECTORY_SEP (p[2])
1200 /* If "/." is the entire filename, keep the "/". Otherwise,
1201 just delete the whole "/.". */
1202 if (o == target && p[2] == '\0')
1206 else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
1207 /* `/../' is the "superroot" on certain file systems. */
1209 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
1211 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
1213 /* Keep initial / only if this is the whole name. */
1214 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
1219 /* if drive is set, we're not dealing with an UNC, so
1220 multiple dir-seps are redundant (and reportedly cause trouble
1222 else if (drive && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
1232 /* At last, set drive name, except for network file name. */
1236 target[0] = DRIVE_LETTER (drive);
1241 assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]));
1243 CORRECT_DIR_SEPS (target);
1244 #endif /* WIN32_NATIVE */
1246 RETURN_UNGCPRO (make_string (target, o - target));
1249 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /*
1250 Return the canonical name of the given FILE.
1251 Second arg DEFAULT is directory to start with if FILE is relative
1252 (does not start with slash); if DEFAULT is nil or missing,
1253 the current buffer's value of default-directory is used.
1254 No component of the resulting pathname will be a symbolic link, as
1255 in the realpath() function.
1257 (filename, default_))
1259 /* This function can GC. GC checked 2000-07-28 ben. */
1260 Lisp_Object expanded_name;
1261 struct gcpro gcpro1;
1263 CHECK_STRING (filename);
1265 expanded_name = Fexpand_file_name (filename, default_);
1267 if (!STRINGP (expanded_name))
1270 GCPRO1 (expanded_name);
1273 Lisp_Object handler =
1274 Ffind_file_name_handler (expanded_name, Qfile_truename);
1276 if (!NILP (handler))
1278 (call2_check_string (handler, Qfile_truename, expanded_name));
1282 char resolved_path[MAXPATHLEN];
1287 TO_EXTERNAL_FORMAT (LISP_STRING, expanded_name,
1288 ALLOCA, (path, elen),
1291 if (elen > MAXPATHLEN)
1294 /* Try doing it all at once. */
1295 /* !! Does realpath() Mule-encapsulate?
1296 Answer: Nope! So we do it above */
1297 if (!xrealpath ((char *) path, resolved_path))
1299 /* Didn't resolve it -- have to do it one component at a time. */
1300 /* "realpath" is a typically useless, stupid un*x piece of crap.
1301 It claims to return a useful value in the "error" case, but since
1302 there is no indication provided of how far along the pathname
1303 the function went before erring, there is no way to use the
1304 partial result returned. What a piece of junk.
1306 The above comment refers to historical versions of
1307 realpath(). The Unix98 specs state:
1309 "On successful completion, realpath() returns a
1310 pointer to the resolved name. Otherwise, realpath()
1311 returns a null pointer and sets errno to indicate the
1312 error, and the contents of the buffer pointed to by
1313 resolved_name are undefined."
1315 Since we depend on undocumented semantics of various system realpath()s,
1316 we just use our own version in realpath.c. */
1319 p = (Extbyte *) memchr (p + 1, '/', elen - (p + 1 - path));
1323 if (xrealpath ((char *) path, resolved_path))
1331 else if (errno == ENOENT || errno == EACCES)
1333 /* Failed on this component. Just tack on the rest of
1334 the string and we are done. */
1335 int rlen = strlen (resolved_path);
1337 /* "On failure, it returns NULL, sets errno to indicate
1338 the error, and places in resolved_path the absolute pathname
1339 of the path component which could not be resolved." */
1343 int plen = elen - (p - path);
1345 if (rlen > 1 && resolved_path[rlen - 1] == '/')
1348 if (plen + rlen + 1 > countof (resolved_path))
1351 resolved_path[rlen] = '/';
1352 memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1);
1362 Lisp_Object resolved_name;
1363 int rlen = strlen (resolved_path);
1364 if (elen > 0 && XSTRING_BYTE (expanded_name, elen - 1) == '/'
1365 && !(rlen > 0 && resolved_path[rlen - 1] == '/'))
1367 if (rlen + 1 > countof (resolved_path))
1369 resolved_path[rlen++] = '/';
1370 resolved_path[rlen] = '\0';
1372 TO_INTERNAL_FORMAT (DATA, (resolved_path, rlen),
1373 LISP_STRING, resolved_name,
1375 RETURN_UNGCPRO (resolved_name);
1379 errno = ENAMETOOLONG;
1382 report_file_error ("Finding truename", list1 (expanded_name));
1384 RETURN_UNGCPRO (Qnil);
1388 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
1389 Substitute environment variables referred to in FILENAME.
1390 `$FOO' where FOO is an environment variable name means to substitute
1391 the value of that variable. The variable name should be terminated
1392 with a character not a letter, digit or underscore; otherwise, enclose
1393 the entire variable name in braces.
1394 If `/~' appears, all of FILENAME through that `/' is discarded.
1399 /* This function can GC. GC checked 2000-07-28 ben. */
1402 Bufbyte *s, *p, *o, *x, *endp;
1403 Bufbyte *target = 0;
1405 int substituted = 0;
1407 Lisp_Object handler;
1409 CHECK_STRING (string);
1411 /* If the file name has special constructs in it,
1412 call the corresponding file handler. */
1413 handler = Ffind_file_name_handler (string, Qsubstitute_in_file_name);
1414 if (!NILP (handler))
1415 return call2_check_string_or_nil (handler, Qsubstitute_in_file_name,
1418 nm = XSTRING_DATA (string);
1419 endp = nm + XSTRING_LENGTH (string);
1421 /* If /~ or // appears, discard everything through first slash. */
1423 for (p = nm; p != endp; p++)
1426 #if defined (WIN32_NATIVE) || defined (CYGWIN)
1427 /* // at start of file name is meaningful in WindowsNT systems */
1428 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
1429 #else /* not (WIN32_NATIVE || CYGWIN) */
1430 || IS_DIRECTORY_SEP (p[0])
1431 #endif /* not (WIN32_NATIVE || CYGWIN) */
1434 && (IS_DIRECTORY_SEP (p[-1])))
1440 /* see comment in expand-file-name about drive specifiers */
1441 else if (IS_DRIVE (p[0]) && p[1] == ':'
1442 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1447 #endif /* WIN32_NATIVE */
1450 /* See if any variables are substituted into the string
1451 and find the total length of their values in `total' */
1453 for (p = nm; p != endp;)
1463 /* "$$" means a single "$" */
1472 while (p != endp && *p != '}') p++;
1473 if (*p != '}') goto missingclose;
1479 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1483 /* Copy out the variable name */
1484 target = (Bufbyte *) alloca (s - o + 1);
1485 strncpy ((char *) target, (char *) o, s - o);
1488 strupr (target); /* $home == $HOME etc. */
1489 #endif /* WIN32_NATIVE */
1491 /* Get variable value */
1492 o = (Bufbyte *) egetenv ((char *) target);
1493 if (!o) goto badvar;
1494 total += strlen ((char *) o);
1501 /* If substitution required, recopy the string and do it */
1502 /* Make space in stack frame for the new copy */
1503 xnm = (Bufbyte *) alloca (XSTRING_LENGTH (string) + total + 1);
1506 /* Copy the rest of the name through, replacing $ constructs with values */
1523 while (p != endp && *p != '}') p++;
1524 if (*p != '}') goto missingclose;
1530 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1534 /* Copy out the variable name */
1535 target = (Bufbyte *) alloca (s - o + 1);
1536 strncpy ((char *) target, (char *) o, s - o);
1539 strupr (target); /* $home == $HOME etc. */
1540 #endif /* WIN32_NATIVE */
1542 /* Get variable value */
1543 o = (Bufbyte *) egetenv ((char *) target);
1547 strcpy ((char *) x, (char *) o);
1548 x += strlen ((char *) o);
1553 /* If /~ or // appears, discard everything through first slash. */
1555 for (p = xnm; p != x; p++)
1557 #if defined (WIN32_NATIVE)
1558 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
1559 #else /* not WIN32_NATIVE */
1560 || IS_DIRECTORY_SEP (p[0])
1561 #endif /* not WIN32_NATIVE */
1563 /* don't do p[-1] if that would go off the beginning --jwz */
1564 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1]))
1567 else if (IS_DRIVE (p[0]) && p[1] == ':'
1568 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1572 return make_string (xnm, x - xnm);
1575 syntax_error ("Bad format environment-variable substitution", string);
1577 syntax_error ("Missing \"}\" in environment-variable substitution",
1580 syntax_error_2 ("Substituting nonexistent environment variable",
1581 string, build_string (target));
1584 return Qnil; /* suppress compiler warning */
1587 /* A slightly faster and more convenient way to get
1588 (directory-file-name (expand-file-name FOO)). */
1591 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
1593 /* This function can call Lisp. GC checked 2000-07-28 ben */
1594 Lisp_Object abspath;
1595 struct gcpro gcpro1;
1597 abspath = Fexpand_file_name (filename, defdir);
1599 /* Remove final slash, if any (unless path is root).
1600 stat behaves differently depending! */
1601 if (XSTRING_LENGTH (abspath) > 1
1602 && IS_DIRECTORY_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1))
1603 && !IS_DEVICE_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 2)))
1604 /* We cannot take shortcuts; they might be wrong for magic file names. */
1605 abspath = Fdirectory_file_name (abspath);
1610 /* Signal an error if the file ABSNAME already exists.
1611 If INTERACTIVE is nonzero, ask the user whether to proceed,
1612 and bypass the error if the user says to go ahead.
1613 QUERYSTRING is a name for the action that is being considered
1615 *STATPTR is used to store the stat information if the file exists.
1616 If the file does not exist, STATPTR->st_mode is set to 0. */
1619 barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring,
1620 int interactive, struct stat *statptr)
1622 /* This function can call Lisp. GC checked 2000-07-28 ben */
1623 struct stat statbuf;
1625 /* stat is a good way to tell whether the file exists,
1626 regardless of what access permissions it has. */
1627 if (xemacs_stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0)
1634 struct gcpro gcpro1;
1636 prompt = emacs_doprnt_string_c
1637 ((const Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "),
1638 Qnil, -1, XSTRING_DATA (absname),
1639 GETTEXT (querystring));
1642 tem = call1 (Qyes_or_no_p, prompt);
1649 Fsignal (Qfile_already_exists,
1650 list2 (build_translated_string ("File already exists"),
1658 statptr->st_mode = 0;
1663 DEFUN ("copy-file", Fcopy_file, 2, 4,
1664 "fCopy file: \nFCopy %s to file: \np\nP", /*
1665 Copy FILE to NEWNAME. Both args must be strings.
1666 Signals a `file-already-exists' error if file NEWNAME already exists,
1667 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
1668 A number as third arg means request confirmation if NEWNAME already exists.
1669 This is what happens in interactive use with M-x.
1670 Fourth arg KEEP-TIME non-nil means give the new file the same
1671 last-modified time as the old one. (This works on only some systems.)
1672 A prefix arg makes KEEP-TIME non-nil.
1674 (filename, newname, ok_if_already_exists, keep_time))
1676 /* This function can call Lisp. GC checked 2000-07-28 ben */
1678 char buf[16 * 1024];
1679 struct stat st, out_st;
1680 Lisp_Object handler;
1681 int speccount = specpdl_depth ();
1682 struct gcpro gcpro1, gcpro2;
1683 /* Lisp_Object args[6]; */
1684 int input_file_statable_p;
1686 GCPRO2 (filename, newname);
1687 CHECK_STRING (filename);
1688 CHECK_STRING (newname);
1689 filename = Fexpand_file_name (filename, Qnil);
1690 newname = Fexpand_file_name (newname, Qnil);
1692 /* If the input file name has special constructs in it,
1693 call the corresponding file handler. */
1694 handler = Ffind_file_name_handler (filename, Qcopy_file);
1695 /* Likewise for output file name. */
1697 handler = Ffind_file_name_handler (newname, Qcopy_file);
1698 if (!NILP (handler))
1701 return call5 (handler, Qcopy_file, filename, newname,
1702 ok_if_already_exists, keep_time);
1705 /* When second argument is a directory, copy the file into it.
1706 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
1708 if (!NILP (Ffile_directory_p (newname)))
1710 Lisp_Object args[3];
1711 struct gcpro ngcpro1;
1715 args[1] = Qnil; args[2] = Qnil;
1718 if (!IS_DIRECTORY_SEP (XSTRING_BYTE (newname,
1719 XSTRING_LENGTH (newname) - 1)))
1721 args[i++] = Fchar_to_string (Vdirectory_sep_char);
1722 args[i++] = Ffile_name_nondirectory (filename);
1723 newname = Fconcat (i, args);
1727 if (NILP (ok_if_already_exists)
1728 || INTP (ok_if_already_exists))
1729 barf_or_query_if_file_exists (newname, "copy to it",
1730 INTP (ok_if_already_exists), &out_st);
1731 else if (xemacs_stat ((const char *) XSTRING_DATA (newname), &out_st) < 0)
1734 ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0);
1736 report_file_error ("Opening input file", list1 (filename));
1738 record_unwind_protect (close_file_unwind, make_int (ifd));
1740 /* We can only copy regular files and symbolic links. Other files are not
1742 input_file_statable_p = (fstat (ifd, &st) >= 0);
1744 #ifndef WIN32_NATIVE
1745 if (out_st.st_mode != 0
1746 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
1749 report_file_error ("Input and output files are the same",
1750 list2 (filename, newname));
1754 #if defined (S_ISREG) && defined (S_ISLNK)
1755 if (input_file_statable_p)
1757 if (!(S_ISREG (st.st_mode))
1758 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
1760 && !(S_ISCHR (st.st_mode))
1762 && !(S_ISLNK (st.st_mode)))
1764 #if defined (EISDIR)
1765 /* Get a better looking error message. */
1768 report_file_error ("Non-regular file", list1 (filename));
1771 #endif /* S_ISREG && S_ISLNK */
1773 ofd = open( (char *) XSTRING_DATA (newname),
1774 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
1776 report_file_error ("Opening output file", list1 (newname));
1779 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil);
1781 record_unwind_protect (close_file_unwind, ofd_locative);
1783 while ((n = read_allowing_quit (ifd, buf, sizeof (buf))) > 0)
1785 if (write_allowing_quit (ofd, buf, n) != n)
1786 report_file_error ("I/O error", list1 (newname));
1789 /* Closing the output clobbers the file times on some systems. */
1790 if (close (ofd) < 0)
1791 report_file_error ("I/O error", list1 (newname));
1793 if (input_file_statable_p)
1795 if (!NILP (keep_time))
1797 EMACS_TIME atime, mtime;
1798 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
1799 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
1800 if (set_file_times ((char *) XSTRING_DATA (newname), atime,
1802 report_file_error ("I/O error", list1 (newname));
1804 chmod ((const char *) XSTRING_DATA (newname),
1805 st.st_mode & 07777);
1808 /* We'll close it by hand */
1809 XCAR (ofd_locative) = Qnil;
1812 unbind_to (speccount, Qnil);
1819 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
1820 Create a directory. One argument, a file name string.
1824 /* This function can GC. GC checked 1997.04.06. */
1825 char dir [MAXPATHLEN];
1826 Lisp_Object handler;
1827 struct gcpro gcpro1;
1829 CHECK_STRING (dirname_);
1830 dirname_ = Fexpand_file_name (dirname_, Qnil);
1833 handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal);
1835 if (!NILP (handler))
1836 return (call2 (handler, Qmake_directory_internal, dirname_));
1838 if (XSTRING_LENGTH (dirname_) > (Bytecount) (sizeof (dir) - 1))
1840 return Fsignal (Qfile_error,
1841 list3 (build_translated_string ("Creating directory"),
1842 build_translated_string ("pathname too long"),
1845 strncpy (dir, (char *) XSTRING_DATA (dirname_),
1846 XSTRING_LENGTH (dirname_) + 1);
1848 if (dir [XSTRING_LENGTH (dirname_) - 1] == '/')
1849 dir [XSTRING_LENGTH (dirname_) - 1] = 0;
1851 if (mkdir (dir, 0777) != 0)
1852 report_file_error ("Creating directory", list1 (dirname_));
1857 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
1858 Delete a directory. One argument, a file name or directory name string.
1862 /* This function can GC. GC checked 1997.04.06. */
1863 Lisp_Object handler;
1864 struct gcpro gcpro1;
1866 CHECK_STRING (dirname_);
1869 dirname_ = Fexpand_file_name (dirname_, Qnil);
1870 dirname_ = Fdirectory_file_name (dirname_);
1872 handler = Ffind_file_name_handler (dirname_, Qdelete_directory);
1874 if (!NILP (handler))
1875 return (call2 (handler, Qdelete_directory, dirname_));
1877 if (rmdir ((char *) XSTRING_DATA (dirname_)) != 0)
1878 report_file_error ("Removing directory", list1 (dirname_));
1883 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
1884 Delete the file named FILENAME (a string).
1885 If FILENAME has multiple names, it continues to exist with the other names.
1889 /* This function can GC. GC checked 1997.04.06. */
1890 Lisp_Object handler;
1891 struct gcpro gcpro1;
1893 CHECK_STRING (filename);
1894 filename = Fexpand_file_name (filename, Qnil);
1897 handler = Ffind_file_name_handler (filename, Qdelete_file);
1899 if (!NILP (handler))
1900 return call2 (handler, Qdelete_file, filename);
1902 if (0 > unlink ((char *) XSTRING_DATA (filename)))
1903 report_file_error ("Removing old name", list1 (filename));
1908 internal_delete_file_1 (Lisp_Object ignore, Lisp_Object ignore2)
1913 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1916 internal_delete_file (Lisp_Object filename)
1918 /* This function can GC. GC checked 1997.04.06. */
1919 return NILP (condition_case_1 (Qt, Fdelete_file, filename,
1920 internal_delete_file_1, Qnil));
1923 DEFUN ("rename-file", Frename_file, 2, 3,
1924 "fRename file: \nFRename %s to file: \np", /*
1925 Rename FILE as NEWNAME. Both args strings.
1926 If file has names other than FILE, it continues to have those names.
1927 Signals a `file-already-exists' error if a file NEWNAME already exists
1928 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1929 A number as third arg means request confirmation if NEWNAME already exists.
1930 This is what happens in interactive use with M-x.
1932 (filename, newname, ok_if_already_exists))
1934 /* This function can GC. GC checked 1997.04.06. */
1935 Lisp_Object handler;
1936 struct gcpro gcpro1, gcpro2;
1938 GCPRO2 (filename, newname);
1939 CHECK_STRING (filename);
1940 CHECK_STRING (newname);
1941 filename = Fexpand_file_name (filename, Qnil);
1942 newname = Fexpand_file_name (newname, Qnil);
1944 /* If the file name has special constructs in it,
1945 call the corresponding file handler. */
1946 handler = Ffind_file_name_handler (filename, Qrename_file);
1948 handler = Ffind_file_name_handler (newname, Qrename_file);
1949 if (!NILP (handler))
1952 return call4 (handler, Qrename_file,
1953 filename, newname, ok_if_already_exists);
1956 /* When second argument is a directory, rename the file into it.
1957 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
1959 if (!NILP (Ffile_directory_p (newname)))
1961 Lisp_Object args[3];
1962 struct gcpro ngcpro1;
1966 args[1] = Qnil; args[2] = Qnil;
1969 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
1970 args[i++] = build_string ("/");
1971 args[i++] = Ffile_name_nondirectory (filename);
1972 newname = Fconcat (i, args);
1976 if (NILP (ok_if_already_exists)
1977 || INTP (ok_if_already_exists))
1978 barf_or_query_if_file_exists (newname, "rename to it",
1979 INTP (ok_if_already_exists), 0);
1981 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
1982 WIN32_NATIVE here; I've removed it. --marcpa */
1984 /* We have configure check for rename() and emulate using
1985 link()/unlink() if necessary. */
1986 if (0 > rename ((char *) XSTRING_DATA (filename),
1987 (char *) XSTRING_DATA (newname)))
1991 Fcopy_file (filename, newname,
1992 /* We have already prompted if it was an integer,
1993 so don't have copy-file prompt again. */
1994 (NILP (ok_if_already_exists) ? Qnil : Qt),
1996 Fdelete_file (filename);
2000 report_file_error ("Renaming", list2 (filename, newname));
2007 DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3,
2008 "fAdd name to file: \nFName to add to %s: \np", /*
2009 Give FILE additional name NEWNAME. Both args strings.
2010 Signals a `file-already-exists' error if a file NEWNAME already exists
2011 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2012 A number as third arg means request confirmation if NEWNAME already exists.
2013 This is what happens in interactive use with M-x.
2015 (filename, newname, ok_if_already_exists))
2017 /* This function can GC. GC checked 1997.04.06. */
2018 Lisp_Object handler;
2019 struct gcpro gcpro1, gcpro2;
2021 GCPRO2 (filename, newname);
2022 CHECK_STRING (filename);
2023 CHECK_STRING (newname);
2024 filename = Fexpand_file_name (filename, Qnil);
2025 newname = Fexpand_file_name (newname, Qnil);
2027 /* If the file name has special constructs in it,
2028 call the corresponding file handler. */
2029 handler = Ffind_file_name_handler (filename, Qadd_name_to_file);
2030 if (!NILP (handler))
2031 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2032 newname, ok_if_already_exists));
2034 /* If the new name has special constructs in it,
2035 call the corresponding file handler. */
2036 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2037 if (!NILP (handler))
2038 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2039 newname, ok_if_already_exists));
2041 if (NILP (ok_if_already_exists)
2042 || INTP (ok_if_already_exists))
2043 barf_or_query_if_file_exists (newname, "make it a new name",
2044 INTP (ok_if_already_exists), 0);
2045 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
2046 on NT here. --marcpa */
2047 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
2048 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
2049 Reverted to previous behavior pending a working fix. (jhar) */
2050 #if defined(WIN32_NATIVE)
2051 /* Windows does not support this operation. */
2052 report_file_error ("Adding new name", Flist (2, &filename));
2053 #else /* not defined(WIN32_NATIVE) */
2055 unlink ((char *) XSTRING_DATA (newname));
2056 if (0 > link ((char *) XSTRING_DATA (filename),
2057 (char *) XSTRING_DATA (newname)))
2059 report_file_error ("Adding new name",
2060 list2 (filename, newname));
2062 #endif /* defined(WIN32_NATIVE) */
2068 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3,
2069 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
2070 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2071 Signals a `file-already-exists' error if a file LINKNAME already exists
2072 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2073 A number as third arg means request confirmation if LINKNAME already exists.
2074 This happens for interactive use with M-x.
2076 (filename, linkname, ok_if_already_exists))
2078 /* This function can GC. GC checked 1997.06.04. */
2079 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2080 Lisp_Object handler;
2081 struct gcpro gcpro1, gcpro2;
2083 GCPRO2 (filename, linkname);
2084 CHECK_STRING (filename);
2085 CHECK_STRING (linkname);
2086 /* If the link target has a ~, we must expand it to get
2087 a truly valid file name. Otherwise, do not expand;
2088 we want to permit links to relative file names. */
2089 if (XSTRING_BYTE (filename, 0) == '~')
2090 filename = Fexpand_file_name (filename, Qnil);
2091 linkname = Fexpand_file_name (linkname, Qnil);
2093 /* If the file name has special constructs in it,
2094 call the corresponding file handler. */
2095 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
2096 if (!NILP (handler))
2097 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname,
2098 ok_if_already_exists));
2100 /* If the new link name has special constructs in it,
2101 call the corresponding file handler. */
2102 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2103 if (!NILP (handler))
2104 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2105 linkname, ok_if_already_exists));
2108 if (NILP (ok_if_already_exists)
2109 || INTP (ok_if_already_exists))
2110 barf_or_query_if_file_exists (linkname, "make it a link",
2111 INTP (ok_if_already_exists), 0);
2113 unlink ((char *) XSTRING_DATA (linkname));
2114 if (0 > symlink ((char *) XSTRING_DATA (filename),
2115 (char *) XSTRING_DATA (linkname)))
2117 report_file_error ("Making symbolic link",
2118 list2 (filename, linkname));
2120 #endif /* S_IFLNK */
2128 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
2129 Open a network connection to PATH using LOGIN as the login string.
2134 const char *path_ext;
2135 const char *login_ext;
2137 CHECK_STRING (path);
2138 CHECK_STRING (login);
2140 /* netunam, being a strange-o system call only used once, is not
2143 LISP_STRING_TO_EXTERNAL (path, path_ext, Qfile_name);
2144 LISP_STRING_TO_EXTERNAL (login, login_ext, Qnative);
2146 netresult = netunam (path_ext, login_ext);
2148 return netresult == -1 ? Qnil : Qt;
2150 #endif /* HPUX_NET */
2152 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
2153 Return t if file FILENAME specifies an absolute path name.
2154 On Unix, this is a name starting with a `/' or a `~'.
2158 /* This function does not GC */
2161 CHECK_STRING (filename);
2162 ptr = XSTRING_DATA (filename);
2163 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
2165 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
2170 /* Return nonzero if file FILENAME exists and can be executed. */
2173 check_executable (char *filename)
2177 if (xemacs_stat (filename, &st) < 0)
2179 return ((st.st_mode & S_IEXEC) != 0);
2180 #else /* not WIN32_NATIVE */
2182 return eaccess (filename, X_OK) >= 0;
2184 /* Access isn't quite right because it uses the real uid
2185 and we really want to test with the effective uid.
2186 But Unix doesn't give us a right way to do it. */
2187 return access (filename, X_OK) >= 0;
2188 #endif /* HAVE_EACCESS */
2189 #endif /* not WIN32_NATIVE */
2192 /* Return nonzero if file FILENAME exists and can be written. */
2195 check_writable (const char *filename)
2198 return (eaccess (filename, W_OK) >= 0);
2200 /* Access isn't quite right because it uses the real uid
2201 and we really want to test with the effective uid.
2202 But Unix doesn't give us a right way to do it.
2203 Opening with O_WRONLY could work for an ordinary file,
2204 but would lose for directories. */
2205 return (access (filename, W_OK) >= 0);
2209 DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
2210 Return t if file FILENAME exists. (This does not mean you can read it.)
2211 See also `file-readable-p' and `file-attributes'.
2215 /* This function can call lisp; GC checked 2000-07-11 ben */
2216 Lisp_Object abspath;
2217 Lisp_Object handler;
2218 struct stat statbuf;
2219 struct gcpro gcpro1;
2221 CHECK_STRING (filename);
2222 abspath = Fexpand_file_name (filename, Qnil);
2224 /* If the file name has special constructs in it,
2225 call the corresponding file handler. */
2227 handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
2229 if (!NILP (handler))
2230 return call2 (handler, Qfile_exists_p, abspath);
2232 return xemacs_stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
2235 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
2236 Return t if FILENAME can be executed by you.
2237 For a directory, this means you can access files in that directory.
2242 /* This function can GC. GC checked 07-11-2000 ben. */
2243 Lisp_Object abspath;
2244 Lisp_Object handler;
2245 struct gcpro gcpro1;
2247 CHECK_STRING (filename);
2248 abspath = Fexpand_file_name (filename, Qnil);
2250 /* If the file name has special constructs in it,
2251 call the corresponding file handler. */
2253 handler = Ffind_file_name_handler (abspath, Qfile_executable_p);
2255 if (!NILP (handler))
2256 return call2 (handler, Qfile_executable_p, abspath);
2258 return check_executable ((char *) XSTRING_DATA (abspath)) ? Qt : Qnil;
2261 DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
2262 Return t if file FILENAME exists and you can read it.
2263 See also `file-exists-p' and `file-attributes'.
2267 /* This function can GC */
2268 Lisp_Object abspath = Qnil;
2269 Lisp_Object handler;
2270 struct gcpro gcpro1;
2273 CHECK_STRING (filename);
2274 abspath = Fexpand_file_name (filename, Qnil);
2276 /* If the file name has special constructs in it,
2277 call the corresponding file handler. */
2278 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
2279 if (!NILP (handler))
2280 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
2282 #if defined(WIN32_NATIVE) || defined(CYGWIN)
2283 /* Under MS-DOS and Windows, open does not work for directories. */
2285 if (access (XSTRING_DATA (abspath), 0) == 0)
2289 #else /* not WIN32_NATIVE */
2291 int desc = interruptible_open ((char *) XSTRING_DATA (abspath), O_RDONLY | OPEN_BINARY, 0);
2298 #endif /* not WIN32_NATIVE */
2301 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2303 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
2304 Return t if file FILENAME can be written or created by you.
2308 /* This function can GC. GC checked 1997.04.10. */
2309 Lisp_Object abspath, dir;
2310 Lisp_Object handler;
2311 struct stat statbuf;
2312 struct gcpro gcpro1;
2314 CHECK_STRING (filename);
2315 abspath = Fexpand_file_name (filename, Qnil);
2317 /* If the file name has special constructs in it,
2318 call the corresponding file handler. */
2320 handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
2322 if (!NILP (handler))
2323 return call2 (handler, Qfile_writable_p, abspath);
2325 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0)
2326 return (check_writable ((char *) XSTRING_DATA (abspath))
2331 dir = Ffile_name_directory (abspath);
2333 return (check_writable (!NILP (dir) ? (char *) XSTRING_DATA (dir)
2338 DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
2339 Return non-nil if file FILENAME is the name of a symbolic link.
2340 The value is the name of the file to which it is linked.
2341 Otherwise returns nil.
2345 /* This function can GC. GC checked 1997.04.10. */
2346 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2353 Lisp_Object handler;
2354 struct gcpro gcpro1;
2356 CHECK_STRING (filename);
2357 filename = Fexpand_file_name (filename, Qnil);
2359 /* If the file name has special constructs in it,
2360 call the corresponding file handler. */
2362 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
2364 if (!NILP (handler))
2365 return call2 (handler, Qfile_symlink_p, filename);
2371 buf = xnew_array_and_zero (char, bufsize);
2372 valsize = readlink ((char *) XSTRING_DATA (filename),
2374 if (valsize < bufsize) break;
2375 /* Buffer was not long enough */
2384 val = make_string ((Bufbyte *) buf, valsize);
2387 #else /* not S_IFLNK */
2389 #endif /* not S_IFLNK */
2392 DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
2393 Return t if file FILENAME is the name of a directory as a file.
2394 A directory name spec may be given instead; then the value is t
2395 if the directory so specified exists and really is a directory.
2399 /* This function can GC. GC checked 1997.04.10. */
2400 Lisp_Object abspath;
2402 Lisp_Object handler;
2403 struct gcpro gcpro1;
2405 GCPRO1 (current_buffer->directory);
2406 abspath = expand_and_dir_to_file (filename,
2407 current_buffer->directory);
2410 /* If the file name has special constructs in it,
2411 call the corresponding file handler. */
2413 handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
2415 if (!NILP (handler))
2416 return call2 (handler, Qfile_directory_p, abspath);
2418 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2420 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2423 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
2424 Return t if file FILENAME is the name of a directory as a file,
2425 and files in that directory can be opened by you. In order to use a
2426 directory as a buffer's current directory, this predicate must return true.
2427 A directory name spec may be given instead; then the value is t
2428 if the directory so specified exists and really is a readable and
2429 searchable directory.
2433 /* This function can GC. GC checked 1997.04.10. */
2434 Lisp_Object handler;
2436 /* If the file name has special constructs in it,
2437 call the corresponding file handler. */
2438 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
2439 if (!NILP (handler))
2440 return call2 (handler, Qfile_accessible_directory_p,
2443 #if !defined(WIN32_NATIVE)
2444 if (NILP (Ffile_directory_p (filename)))
2447 return Ffile_executable_p (filename);
2451 struct gcpro gcpro1;
2452 /* It's an unlikely combination, but yes we really do need to gcpro:
2453 Suppose that file-accessible-directory-p has no handler, but
2454 file-directory-p does have a handler; this handler causes a GC which
2455 relocates the string in `filename'; and finally file-directory-p
2456 returns non-nil. Then we would end up passing a garbaged string
2457 to file-executable-p. */
2459 tem = (NILP (Ffile_directory_p (filename))
2460 || NILP (Ffile_executable_p (filename)));
2462 return tem ? Qnil : Qt;
2464 #endif /* !defined(WIN32_NATIVE) */
2467 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
2468 Return t if file FILENAME is the name of a regular file.
2469 This is the sort of file that holds an ordinary stream of data bytes.
2473 /* This function can GC. GC checked 1997.04.10. */
2474 Lisp_Object abspath;
2476 Lisp_Object handler;
2477 struct gcpro gcpro1;
2479 GCPRO1 (current_buffer->directory);
2480 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
2483 /* If the file name has special constructs in it,
2484 call the corresponding file handler. */
2486 handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
2488 if (!NILP (handler))
2489 return call2 (handler, Qfile_regular_p, abspath);
2491 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2493 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2496 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
2497 Return mode bits of FILE, as an integer.
2501 /* This function can GC. GC checked 1997.04.10. */
2502 Lisp_Object abspath;
2504 Lisp_Object handler;
2505 struct gcpro gcpro1;
2507 GCPRO1 (current_buffer->directory);
2508 abspath = expand_and_dir_to_file (filename,
2509 current_buffer->directory);
2512 /* If the file name has special constructs in it,
2513 call the corresponding file handler. */
2515 handler = Ffind_file_name_handler (abspath, Qfile_modes);
2517 if (!NILP (handler))
2518 return call2 (handler, Qfile_modes, abspath);
2520 if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2522 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
2525 if (check_executable (XSTRING_DATA (abspath)))
2526 st.st_mode |= S_IEXEC;
2527 #endif /* WIN32_NATIVE */
2530 return make_int (st.st_mode & 07777);
2533 DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /*
2534 Set mode bits of FILE to MODE (an integer).
2535 Only the 12 low bits of MODE are used.
2539 /* This function can GC. GC checked 1997.04.10. */
2540 Lisp_Object abspath;
2541 Lisp_Object handler;
2542 struct gcpro gcpro1;
2544 GCPRO1 (current_buffer->directory);
2545 abspath = Fexpand_file_name (filename, current_buffer->directory);
2550 /* If the file name has special constructs in it,
2551 call the corresponding file handler. */
2553 handler = Ffind_file_name_handler (abspath, Qset_file_modes);
2555 if (!NILP (handler))
2556 return call3 (handler, Qset_file_modes, abspath, mode);
2558 if (chmod ((char *) XSTRING_DATA (abspath), XINT (mode)) < 0)
2559 report_file_error ("Doing chmod", list1 (abspath));
2564 DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
2565 Set the file permission bits for newly created files.
2566 MASK should be an integer; if a permission's bit in MASK is 1,
2567 subsequently created files will not have that permission enabled.
2568 Only the low 9 bits are used.
2569 This setting is inherited by subprocesses.
2575 umask ((~ XINT (mode)) & 0777);
2580 DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
2581 Return the default file protection for created files.
2582 The umask value determines which permissions are enabled in newly
2583 created files. If a permission's bit in the umask is 1, subsequently
2584 created files will not have that permission enabled.
2593 return make_int ((~ mode) & 0777);
2596 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /*
2597 Tell Unix to finish all pending disk updates.
2601 #ifndef WIN32_NATIVE
2608 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
2609 Return t if file FILE1 is newer than file FILE2.
2610 If FILE1 does not exist, the answer is nil;
2611 otherwise, if FILE2 does not exist, the answer is t.
2615 /* This function can GC. GC checked 1997.04.10. */
2616 Lisp_Object abspath1, abspath2;
2619 Lisp_Object handler;
2620 struct gcpro gcpro1, gcpro2, gcpro3;
2622 CHECK_STRING (file1);
2623 CHECK_STRING (file2);
2628 GCPRO3 (abspath1, abspath2, current_buffer->directory);
2629 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
2630 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
2632 /* If the file name has special constructs in it,
2633 call the corresponding file handler. */
2634 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p);
2636 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p);
2638 if (!NILP (handler))
2639 return call3 (handler, Qfile_newer_than_file_p, abspath1,
2642 if (xemacs_stat ((char *) XSTRING_DATA (abspath1), &st) < 0)
2645 mtime1 = st.st_mtime;
2647 if (xemacs_stat ((char *) XSTRING_DATA (abspath2), &st) < 0)
2650 return (mtime1 > st.st_mtime) ? Qt : Qnil;
2654 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
2655 /* #define READ_BUF_SIZE (2 << 16) */
2656 #define READ_BUF_SIZE (1 << 15)
2658 DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal,
2660 Insert contents of file FILENAME after point; no coding-system frobbing.
2661 This function is identical to `insert-file-contents' except for the
2662 handling of the CODESYS and USED-CODESYS arguments under
2663 XEmacs/Mule. (When Mule support is not present, both functions are
2664 identical and ignore the CODESYS and USED-CODESYS arguments.)
2666 If support for Mule exists in this Emacs, the file is decoded according
2667 to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil,
2668 it should be a symbol, and the actual coding system that was used for the
2669 decoding is stored into it. It will in general be different from CODESYS
2670 if CODESYS specifies automatic encoding detection or end-of-line detection.
2672 Currently BEG and END refer to byte positions (as opposed to character
2673 positions), even in Mule. (Fixing this is very difficult.)
2675 (filename, visit, beg, end, replace, codesys, used_codesys))
2677 /* This function can call lisp */
2678 /* #### dmoore - this function hasn't been checked for gc recently */
2682 Charcount inserted = 0;
2684 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2685 Lisp_Object handler = Qnil, val;
2687 Bufbyte read_buf[READ_BUF_SIZE];
2689 struct buffer *buf = current_buffer;
2691 int not_regular = 0;
2693 if (buf->base_buffer && ! NILP (visit))
2694 error ("Cannot do file visiting in an indirect buffer");
2696 /* No need to call Fbarf_if_buffer_read_only() here.
2697 That's called in begin_multiple_change() or wherever. */
2701 /* #### dmoore - should probably check in various places to see if
2702 curbuf was killed and if so signal an error? */
2704 XSETBUFFER (curbuf, buf);
2706 GCPRO5 (filename, val, visit, handler, curbuf);
2708 mc_count = (NILP (replace)) ?
2709 begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) :
2710 begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf));
2712 speccount = specpdl_depth (); /* begin_multiple_change also adds
2713 an unwind_protect */
2715 filename = Fexpand_file_name (filename, Qnil);
2717 /* If the file name has special constructs in it,
2718 call the corresponding file handler. */
2719 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
2720 if (!NILP (handler))
2722 val = call6 (handler, Qinsert_file_contents, filename,
2723 visit, beg, end, replace);
2728 if (!NILP (used_codesys))
2729 CHECK_SYMBOL (used_codesys);
2732 if ( (!NILP (beg) || !NILP (end)) && !NILP (visit) )
2733 error ("Attempt to visit less than an entire file");
2737 if (xemacs_stat ((char *) XSTRING_DATA (filename), &st) < 0)
2739 if (fd >= 0) close (fd);
2742 report_file_error ("Opening input file", list1 (filename));
2748 /* Signal an error if we are accessing a non-regular file, with
2749 REPLACE, BEG or END being non-nil. */
2750 if (!S_ISREG (st.st_mode))
2757 if (!NILP (replace) || !NILP (beg) || !NILP (end))
2759 end_multiple_change (buf, mc_count);
2761 return Fsignal (Qfile_error,
2762 list2 (build_translated_string("not a regular file"),
2766 #endif /* S_IFREG */
2778 if ((fd = interruptible_open ((char *) XSTRING_DATA (filename),
2779 O_RDONLY | OPEN_BINARY, 0)) < 0)
2783 /* Replacement should preserve point as it preserves markers. */
2784 if (!NILP (replace))
2785 record_unwind_protect (restore_point_unwind, Fpoint_marker (Qnil, Qnil));
2787 record_unwind_protect (close_file_unwind, make_int (fd));
2789 /* Supposedly happens on VMS. */
2791 error ("File size is negative");
2797 end = make_int (st.st_size);
2798 if (XINT (end) != st.st_size)
2799 error ("Maximum buffer size exceeded");
2803 /* If requested, replace the accessible part of the buffer
2804 with the file contents. Avoid replacing text at the
2805 beginning or end of the buffer that matches the file contents;
2806 that preserves markers pointing to the unchanged parts. */
2807 #if !defined (FILE_CODING)
2808 /* The replace-mode code currently only works when the assumption
2809 'one byte == one char' holds true. This fails Mule because
2810 files may contain multibyte characters. It holds under Windows NT
2811 provided we convert CRLF into LF. */
2812 # define FSFMACS_SPEEDY_INSERT
2813 #endif /* !defined (FILE_CODING) */
2815 #ifndef FSFMACS_SPEEDY_INSERT
2816 if (!NILP (replace))
2818 buffer_delete_range (buf, BUF_BEG (buf), BUF_Z (buf),
2819 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2821 #else /* FSFMACS_SPEEDY_INSERT */
2822 if (!NILP (replace))
2824 char buffer[1 << 14];
2825 Bufpos same_at_start = BUF_BEGV (buf);
2826 Bufpos same_at_end = BUF_ZV (buf);
2829 /* Count how many chars at the start of the file
2830 match the text at the beginning of the buffer. */
2835 nread = read_allowing_quit (fd, buffer, sizeof buffer);
2837 error ("IO error reading %s: %s",
2838 XSTRING_DATA (filename), strerror (errno));
2839 else if (nread == 0)
2842 while (bufpos < nread && same_at_start < BUF_ZV (buf)
2843 && BUF_FETCH_CHAR (buf, same_at_start) == buffer[bufpos])
2844 same_at_start++, bufpos++;
2845 /* If we found a discrepancy, stop the scan.
2846 Otherwise loop around and scan the next bufferful. */
2847 if (bufpos != nread)
2850 /* If the file matches the buffer completely,
2851 there's no need to replace anything. */
2852 if (same_at_start - BUF_BEGV (buf) == st.st_size)
2855 unbind_to (speccount, Qnil);
2856 /* Truncate the buffer to the size of the file. */
2857 buffer_delete_range (buf, same_at_start, same_at_end,
2858 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2861 /* Count how many chars at the end of the file
2862 match the text at the end of the buffer. */
2865 int total_read, nread;
2866 Bufpos bufpos, curpos, trial;
2868 /* At what file position are we now scanning? */
2869 curpos = st.st_size - (BUF_ZV (buf) - same_at_end);
2870 /* If the entire file matches the buffer tail, stop the scan. */
2873 /* How much can we scan in the next step? */
2874 trial = min (curpos, (Bufpos) sizeof (buffer));
2875 if (lseek (fd, curpos - trial, 0) < 0)
2876 report_file_error ("Setting file position", list1 (filename));
2879 while (total_read < trial)
2881 nread = read_allowing_quit (fd, buffer + total_read,
2882 trial - total_read);
2884 report_file_error ("IO error reading file", list1 (filename));
2885 total_read += nread;
2887 /* Scan this bufferful from the end, comparing with
2888 the Emacs buffer. */
2889 bufpos = total_read;
2890 /* Compare with same_at_start to avoid counting some buffer text
2891 as matching both at the file's beginning and at the end. */
2892 while (bufpos > 0 && same_at_end > same_at_start
2893 && BUF_FETCH_CHAR (buf, same_at_end - 1) ==
2895 same_at_end--, bufpos--;
2896 /* If we found a discrepancy, stop the scan.
2897 Otherwise loop around and scan the preceding bufferful. */
2900 /* If display current starts at beginning of line,
2901 keep it that way. */
2902 if (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == buf)
2903 XWINDOW (Fselected_window (Qnil))->start_at_line_beg =
2904 !NILP (Fbolp (make_buffer (buf)));
2907 /* Don't try to reuse the same piece of text twice. */
2908 overlap = same_at_start - BUF_BEGV (buf) -
2909 (same_at_end + st.st_size - BUF_ZV (buf));
2911 same_at_end += overlap;
2913 /* Arrange to read only the nonmatching middle part of the file. */
2914 beg = make_int (same_at_start - BUF_BEGV (buf));
2915 end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end));
2917 buffer_delete_range (buf, same_at_start, same_at_end,
2918 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2919 /* Insert from the file at the proper position. */
2920 BUF_SET_PT (buf, same_at_start);
2922 #endif /* FSFMACS_SPEEDY_INSERT */
2926 total = XINT (end) - XINT (beg);
2928 /* Make sure point-max won't overflow after this insertion. */
2929 if (total != XINT (make_int (total)))
2930 error ("Maximum buffer size exceeded");
2933 /* For a special file, all we can do is guess. The value of -1
2934 will make the stream functions read as much as possible. */
2938 #ifdef FSFMACS_SPEEDY_INSERT
2939 /* why was this here? asked jwz. The reason is that the replace-mode
2940 connivings above will normally put the file pointer other than
2941 where it should be. */
2943 #endif /* !FSFMACS_SPEEDY_INSERT */
2946 if (lseek (fd, XINT (beg), 0) < 0)
2947 report_file_error ("Setting file position", list1 (filename));
2951 Bufpos cur_point = BUF_PT (buf);
2952 struct gcpro ngcpro1;
2953 Lisp_Object stream = make_filedesc_input_stream (fd, 0, total,
2957 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2959 stream = make_decoding_input_stream
2960 (XLSTREAM (stream), Fget_coding_system (codesys));
2961 Lstream_set_character_mode (XLSTREAM (stream));
2962 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2963 #endif /* FILE_CODING */
2965 record_unwind_protect (delete_stream_unwind, stream);
2967 /* No need to limit the amount of stuff we attempt to read. (It would
2968 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
2969 occurs inside of the filedesc stream. */
2973 Charcount cc_inserted;
2976 this_len = Lstream_read (XLSTREAM (stream), read_buf,
2986 cc_inserted = buffer_insert_raw_string_1 (buf, cur_point, read_buf,
2989 ? INSDEL_NO_LOCKING : 0);
2990 inserted += cc_inserted;
2991 cur_point += cc_inserted;
2994 if (!NILP (used_codesys))
2997 XCODING_SYSTEM_NAME (decoding_stream_coding_system (XLSTREAM (stream))));
2999 #endif /* FILE_CODING */
3003 /* Close the file/stream */
3004 unbind_to (speccount, Qnil);
3008 error ("IO error reading %s: %s",
3009 XSTRING_DATA (filename), strerror (saverrno));
3015 end_multiple_change (buf, mc_count);
3019 if (!EQ (buf->undo_list, Qt))
3020 buf->undo_list = Qnil;
3023 buf->modtime = st.st_mtime;
3024 buf->filename = filename;
3025 /* XEmacs addition: */
3026 /* This function used to be in C, ostensibly so that
3027 it could be called here. But that's just silly.
3028 There's no reason C code can't call out to Lisp
3029 code, and it's a lot cleaner this way. */
3030 if (!NILP (Ffboundp (Qcompute_buffer_file_truename)))
3031 call1 (Qcompute_buffer_file_truename, make_buffer (buf));
3033 BUF_SAVE_MODIFF (buf) = BUF_MODIFF (buf);
3034 buf->auto_save_modified = BUF_MODIFF (buf);
3035 buf->saved_size = make_int (BUF_SIZE (buf));
3036 #ifdef CLASH_DETECTION
3039 if (!NILP (buf->file_truename))
3040 unlock_file (buf->file_truename);
3041 unlock_file (filename);
3043 #endif /* CLASH_DETECTION */
3045 RETURN_UNGCPRO (Fsignal (Qfile_error,
3046 list2 (build_string ("not a regular file"),
3049 /* If visiting nonexistent file, return nil. */
3050 if (buf->modtime == -1)
3051 report_file_error ("Opening input file",
3055 /* Decode file format */
3058 Lisp_Object insval = call3 (Qformat_decode,
3059 Qnil, make_int (inserted), visit);
3061 inserted = XINT (insval);
3067 struct gcpro ngcpro1;
3070 EXTERNAL_LIST_LOOP (p, Vafter_insert_file_functions)
3072 Lisp_Object insval =
3073 call1 (XCAR (p), make_int (inserted));
3076 CHECK_NATNUM (insval);
3077 inserted = XINT (insval);
3089 return (list2 (filename, make_int (inserted)));
3093 static int a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3094 Lisp_Object *annot);
3095 static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end);
3097 /* If build_annotations switched buffers, switch back to BUF.
3098 Kill the temporary buffer that was selected in the meantime. */
3101 build_annotations_unwind (Lisp_Object buf)
3105 if (XBUFFER (buf) == current_buffer)
3107 tembuf = Fcurrent_buffer ();
3109 Fkill_buffer (tembuf);
3113 DEFUN ("write-region-internal", Fwrite_region_internal, 3, 7,
3114 "r\nFWrite region to file: ", /*
3115 Write current region into specified file; no coding-system frobbing.
3116 This function is identical to `write-region' except for the handling
3117 of the CODESYS argument under XEmacs/Mule. (When Mule support is not
3118 present, both functions are identical and ignore the CODESYS argument.)
3119 If support for Mule exists in this Emacs, the file is encoded according
3120 to the value of CODESYS. If this is nil, no code conversion occurs.
3122 (start, end, filename, append, visit, lockname, codesys))
3124 /* This function can call lisp. GC checked 2000-07-28 ben */
3129 Lisp_Object fn = Qnil;
3130 int speccount = specpdl_depth ();
3131 int visiting_other = STRINGP (visit);
3132 int visiting = (EQ (visit, Qt) || visiting_other);
3133 int quietly = (!visiting && !NILP (visit));
3134 Lisp_Object visit_file = Qnil;
3135 Lisp_Object annotations = Qnil;
3136 struct buffer *given_buffer;
3137 Bufpos start1, end1;
3138 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3139 struct gcpro ngcpro1, ngcpro2;
3142 XSETBUFFER (curbuf, current_buffer);
3144 /* start, end, visit, and append are never modified in this fun
3145 so we don't protect them. */
3146 GCPRO5 (visit_file, filename, codesys, lockname, annotations);
3147 NGCPRO2 (curbuf, fn);
3149 /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
3150 we should signal an error rather than blissfully continuing
3151 along. ARGH, this function is going to lose lose lose. We need
3152 to protect the current_buffer from being destroyed, but the
3153 multiple return points make this a pain in the butt. ]] we do
3154 protect curbuf now. --ben */
3157 codesys = Fget_coding_system (codesys);
3158 #endif /* FILE_CODING */
3160 if (current_buffer->base_buffer && ! NILP (visit))
3161 invalid_operation ("Cannot do file visiting in an indirect buffer",
3164 if (!NILP (start) && !STRINGP (start))
3165 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0);
3168 Lisp_Object handler;
3171 visit_file = Fexpand_file_name (visit, Qnil);
3173 visit_file = filename;
3174 filename = Fexpand_file_name (filename, Qnil);
3176 if (NILP (lockname))
3177 lockname = visit_file;
3179 /* We used to UNGCPRO here. BAD! visit_file is used below after
3180 more Lisp calling. */
3181 /* If the file name has special constructs in it,
3182 call the corresponding file handler. */
3183 handler = Ffind_file_name_handler (filename, Qwrite_region);
3184 /* If FILENAME has no handler, see if VISIT has one. */
3185 if (NILP (handler) && STRINGP (visit))
3186 handler = Ffind_file_name_handler (visit, Qwrite_region);
3188 if (!NILP (handler))
3190 Lisp_Object val = call8 (handler, Qwrite_region, start, end,
3191 filename, append, visit, lockname, codesys);
3194 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3195 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3196 current_buffer->filename = visit_file;
3197 MARK_MODELINE_CHANGED;
3205 #ifdef CLASH_DETECTION
3207 lock_file (lockname);
3208 #endif /* CLASH_DETECTION */
3210 /* Special kludge to simplify auto-saving. */
3213 start1 = BUF_BEG (current_buffer);
3214 end1 = BUF_Z (current_buffer);
3217 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
3219 given_buffer = current_buffer;
3220 annotations = build_annotations (start, end);
3221 if (current_buffer != given_buffer)
3223 start1 = BUF_BEGV (current_buffer);
3224 end1 = BUF_ZV (current_buffer);
3231 desc = open ((char *) XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0);
3235 desc = open ((char *) XSTRING_DATA (fn),
3236 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
3237 auto_saving ? auto_save_mode_bits : CREAT_MODE);
3242 #ifdef CLASH_DETECTION
3244 if (!auto_saving) unlock_file (lockname);
3246 #endif /* CLASH_DETECTION */
3247 report_file_error ("Opening output file", list1 (filename));
3251 Lisp_Object desc_locative = Fcons (make_int (desc), Qnil);
3252 Lisp_Object instream = Qnil, outstream = Qnil;
3253 struct gcpro nngcpro1, nngcpro2;
3254 /* need to gcpro; QUIT could happen out of call to write() */
3255 NNGCPRO2 (instream, outstream);
3257 record_unwind_protect (close_file_unwind, desc_locative);
3261 if (lseek (desc, 0, 2) < 0)
3263 #ifdef CLASH_DETECTION
3264 if (!auto_saving) unlock_file (lockname);
3265 #endif /* CLASH_DETECTION */
3266 report_file_error ("Lseek error",
3273 /* Note: I tried increasing the buffering size, along with
3274 various other tricks, but nothing seemed to make much of
3275 a difference in the time it took to save a large file.
3276 (Actually that's not true. With a local disk, changing
3277 the buffer size doesn't seem to make much difference.
3278 With an NFS-mounted disk, it could make a lot of difference
3279 because you're affecting the number of network requests
3280 that need to be made, and there could be a large latency
3281 for each request. So I've increased the buffer size
3283 outstream = make_filedesc_output_stream (desc, 0, -1, 0);
3284 Lstream_set_buffering (XLSTREAM (outstream),
3285 LSTREAM_BLOCKN_BUFFERED, 65536);
3288 make_encoding_output_stream (XLSTREAM (outstream), codesys);
3289 Lstream_set_buffering (XLSTREAM (outstream),
3290 LSTREAM_BLOCKN_BUFFERED, 65536);
3291 #endif /* FILE_CODING */
3292 if (STRINGP (start))
3294 instream = make_lisp_string_input_stream (start, 0, -1);
3298 instream = make_lisp_buffer_input_stream (current_buffer, start1, end1,
3300 LSTR_IGNORE_ACCESSIBLE);
3301 failure = (0 > (a_write (outstream, instream, start1,
3304 /* Note that this doesn't close the desc since we created the
3305 stream without the LSTR_CLOSING flag, but it does
3306 flush out any buffered data. */
3307 if (Lstream_close (XLSTREAM (outstream)) < 0)
3312 Lstream_close (XLSTREAM (instream));
3315 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3316 Disk full in NFS may be reported here. */
3317 /* mib says that closing the file will try to write as fast as NFS can do
3318 it, and that means the fsync here is not crucial for autosave files. */
3319 if (!auto_saving && fsync (desc) < 0
3320 /* If fsync fails with EINTR, don't treat that as serious. */
3326 #endif /* HAVE_FSYNC */
3328 /* Spurious "file has changed on disk" warnings used to be seen on
3329 systems where close() can change the modtime. This is known to
3330 happen on various NFS file systems, on Windows, and on Linux.
3331 Rather than handling this on a per-system basis, we
3332 unconditionally do the xemacs_stat() after the close(). */
3334 /* NFS can report a write failure now. */
3335 if (close (desc) < 0)
3341 /* Discard the close unwind-protect. Execute the one for
3342 build_annotations (switches back to the original current buffer
3344 XCAR (desc_locative) = Qnil;
3345 unbind_to (speccount, Qnil);
3350 xemacs_stat ((char *) XSTRING_DATA (fn), &st);
3352 #ifdef CLASH_DETECTION
3354 unlock_file (lockname);
3355 #endif /* CLASH_DETECTION */
3357 /* Do this before reporting IO error
3358 to avoid a "file has changed on disk" warning on
3359 next attempt to save. */
3361 current_buffer->modtime = st.st_mtime;
3366 report_file_error ("Writing file", list1 (fn));
3371 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3372 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3373 current_buffer->filename = visit_file;
3374 MARK_MODELINE_CHANGED;
3386 message ("Wrote %s", XSTRING_DATA (visit_file));
3390 struct gcpro nngcpro1;
3393 fsp = Ffile_symlink_p (fn);
3395 message ("Wrote %s", XSTRING_DATA (fn));
3397 message ("Wrote %s (symlink to %s)",
3398 XSTRING_DATA (fn), XSTRING_DATA (fsp));
3407 /* #### This is such a load of shit!!!! There is no way we should define
3408 something so stupid as a subr, just sort the fucking list more
3410 DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3411 Return t if (car A) is numerically less than (car B).
3415 Lisp_Object objs[2];
3418 return Flss (2, objs);
3421 /* Heh heh heh, let's define this too, just to aggravate the person who
3422 wrote the above comment. */
3423 DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3424 Return t if (cdr A) is numerically less than (cdr B).
3428 Lisp_Object objs[2];
3431 return Flss (2, objs);
3434 /* Build the complete list of annotations appropriate for writing out
3435 the text between START and END, by calling all the functions in
3436 write-region-annotate-functions and merging the lists they return.
3437 If one of these functions switches to a different buffer, we assume
3438 that buffer contains altered text. Therefore, the caller must
3439 make sure to restore the current buffer in all cases,
3440 as save-excursion would do. */
3443 build_annotations (Lisp_Object start, Lisp_Object end)
3445 /* This function can GC */
3446 Lisp_Object annotations;
3448 struct gcpro gcpro1, gcpro2;
3449 Lisp_Object original_buffer;
3451 XSETBUFFER (original_buffer, current_buffer);
3454 p = Vwrite_region_annotate_functions;
3455 GCPRO2 (annotations, p);
3458 struct buffer *given_buffer = current_buffer;
3459 Vwrite_region_annotations_so_far = annotations;
3460 res = call2 (Fcar (p), start, end);
3461 /* If the function makes a different buffer current,
3462 assume that means this buffer contains altered text to be output.
3463 Reset START and END from the buffer bounds
3464 and discard all previous annotations because they should have
3465 been dealt with by this function. */
3466 if (current_buffer != given_buffer)
3468 start = make_int (BUF_BEGV (current_buffer));
3469 end = make_int (BUF_ZV (current_buffer));
3472 Flength (res); /* Check basic validity of return value */
3473 annotations = merge (annotations, res, Qcar_less_than_car);
3477 /* Now do the same for annotation functions implied by the file-format */
3478 if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
3479 p = Vauto_save_file_format;
3481 p = current_buffer->file_format;
3484 struct buffer *given_buffer = current_buffer;
3485 Vwrite_region_annotations_so_far = annotations;
3486 res = call4 (Qformat_annotate_function, Fcar (p), start, end,
3488 if (current_buffer != given_buffer)
3490 start = make_int (BUF_BEGV (current_buffer));
3491 end = make_int (BUF_ZV (current_buffer));
3495 annotations = merge (annotations, res, Qcar_less_than_car);
3502 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3503 EOF is encountered), assuming they start at position POS in the buffer
3504 of string that STREAM refers to. Intersperse with them the annotations
3505 from *ANNOT that fall into the range of positions we are reading from,
3506 each at its appropriate position.
3508 Modify *ANNOT by discarding elements as we output them.
3509 The return value is negative in case of system call failure. */
3511 /* 4K should probably be fine. We just need to reduce the number of
3512 function calls to reasonable level. The Lstream stuff itself will
3513 batch to 64K to reduce the number of system calls. */
3515 #define A_WRITE_BATCH_SIZE 4096
3518 a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3523 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3524 Lstream *instr = XLSTREAM (instream);
3525 Lstream *outstr = XLSTREAM (outstream);
3527 while (LISTP (*annot))
3529 tem = Fcar_safe (Fcar (*annot));
3531 nextpos = XINT (tem);
3535 /* If there are annotations left and we have Mule, then we
3536 have to do the I/O one emchar at a time so we can
3537 determine when to insert the annotation. */
3541 while (pos != nextpos && (ch = Lstream_get_emchar (instr)) != EOF)
3543 if (Lstream_put_emchar (outstr, ch) < 0)
3551 while (pos != nextpos)
3553 /* Otherwise there is no point to that. Just go in batches. */
3554 int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE);
3556 chunk = Lstream_read (instr, largebuf, chunk);
3559 if (chunk == 0) /* EOF */
3561 if (Lstream_write (outstr, largebuf, chunk) < chunk)
3568 tem = Fcdr (Fcar (*annot));
3571 if (Lstream_write (outstr, XSTRING_DATA (tem),
3572 XSTRING_LENGTH (tem)) < 0)
3575 *annot = Fcdr (*annot);
3586 #include <des_crypt.h>
3588 #define CRYPT_BLOCK_SIZE 8 /* bytes */
3589 #define CRYPT_KEY_SIZE 8 /* bytes */
3591 DEFUN ("encrypt-string", Fencrypt_string, 2, 2, 0, /*
3592 Encrypt STRING using KEY.
3596 char *encrypted_string, *raw_key;
3597 int rounded_size, extra, key_size;
3599 /* !!#### May produce bogus data under Mule. */
3600 CHECK_STRING (string);
3603 extra = XSTRING_LENGTH (string) % CRYPT_BLOCK_SIZE;
3604 rounded_size = XSTRING_LENGTH (string) + extra;
3605 encrypted_string = alloca (rounded_size + 1);
3606 memcpy (encrypted_string, XSTRING_DATA (string), XSTRING_LENGTH (string));
3607 memset (encrypted_string + rounded_size - extra, 0, extra + 1);
3609 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3611 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3612 memcpy (raw_key, XSTRING_DATA (key), key_size);
3613 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3615 ecb_crypt (raw_key, encrypted_string, rounded_size,
3616 DES_ENCRYPT | DES_SW);
3617 return make_string (encrypted_string, rounded_size);
3620 DEFUN ("decrypt-string", Fdecrypt_string, 2, 2, 0, /*
3621 Decrypt STRING using KEY.
3625 char *decrypted_string, *raw_key;
3626 int string_size, key_size;
3628 CHECK_STRING (string);
3631 string_size = XSTRING_LENGTH (string) + 1;
3632 decrypted_string = alloca (string_size);
3633 memcpy (decrypted_string, XSTRING_DATA (string), string_size);
3634 decrypted_string[string_size - 1] = '\0';
3636 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3638 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3639 memcpy (raw_key, XSTRING_DATA (key), key_size);
3640 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3643 ecb_crypt (raw_key, decrypted_string, string_size, D | DES_SW);
3644 return make_string (decrypted_string, string_size - 1);
3649 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
3650 Return t if last mod time of BUF's visited file matches what BUF records.
3651 This means that the file has not been changed since it was visited or saved.
3655 /* This function can call lisp; GC checked 2000-07-11 ben */
3658 Lisp_Object handler;
3663 if (!STRINGP (b->filename)) return Qt;
3664 if (b->modtime == 0) return Qt;
3666 /* If the file name has special constructs in it,
3667 call the corresponding file handler. */
3668 handler = Ffind_file_name_handler (b->filename,
3669 Qverify_visited_file_modtime);
3670 if (!NILP (handler))
3671 return call2 (handler, Qverify_visited_file_modtime, buf);
3673 if (xemacs_stat ((char *) XSTRING_DATA (b->filename), &st) < 0)
3675 /* If the file doesn't exist now and didn't exist before,
3676 we say that it isn't modified, provided the error is a tame one. */
3677 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3682 if (st.st_mtime == b->modtime
3683 /* If both are positive, accept them if they are off by one second. */
3684 || (st.st_mtime > 0 && b->modtime > 0
3685 && (st.st_mtime == b->modtime + 1
3686 || st.st_mtime == b->modtime - 1)))
3691 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3692 Clear out records of last mod time of visited file.
3693 Next attempt to save will certainly not complain of a discrepancy.
3697 current_buffer->modtime = 0;
3701 DEFUN ("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3702 Return the current buffer's recorded visited file modification time.
3703 The value is a list of the form (HIGH . LOW), like the time values
3704 that `file-attributes' returns.
3708 return time_to_lisp ((time_t) current_buffer->modtime);
3711 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3712 Update buffer's recorded modification time from the visited file's time.
3713 Useful if the buffer was not read from the file normally
3714 or if the file itself has been changed for some known benign reason.
3715 An argument specifies the modification time value to use
3716 \(instead of that of the visited file), in the form of a list
3717 \(HIGH . LOW) or (HIGH LOW).
3721 /* This function can call lisp */
3722 if (!NILP (time_list))
3725 lisp_to_time (time_list, &the_time);
3726 current_buffer->modtime = (int) the_time;
3730 Lisp_Object filename;
3732 Lisp_Object handler;
3733 struct gcpro gcpro1, gcpro2, gcpro3;
3735 GCPRO3 (filename, time_list, current_buffer->filename);
3736 filename = Fexpand_file_name (current_buffer->filename, Qnil);
3738 /* If the file name has special constructs in it,
3739 call the corresponding file handler. */
3740 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
3742 if (!NILP (handler))
3743 /* The handler can find the file name the same way we did. */
3744 return call2 (handler, Qset_visited_file_modtime, Qnil);
3745 else if (xemacs_stat ((char *) XSTRING_DATA (filename), &st) >= 0)
3746 current_buffer->modtime = st.st_mtime;
3753 auto_save_error (Lisp_Object condition_object, Lisp_Object ignored)
3755 /* This function can call lisp */
3758 /* Don't try printing an error message after everything is gone! */
3759 if (preparing_for_armageddon)
3761 clear_echo_area (selected_frame (), Qauto_saving, 1);
3762 Fding (Qt, Qauto_save_error, Qnil);
3763 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3764 Fsleep_for (make_int (1));
3765 message ("Auto-saving...error!for %s", XSTRING_DATA (current_buffer->name));
3766 Fsleep_for (make_int (1));
3767 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3768 Fsleep_for (make_int (1));
3773 auto_save_1 (Lisp_Object ignored)
3775 /* This function can call lisp */
3776 /* #### I think caller is protecting current_buffer? */
3778 Lisp_Object fn = current_buffer->filename;
3779 Lisp_Object a = current_buffer->auto_save_file_name;
3784 /* Get visited file's mode to become the auto save file's mode. */
3786 xemacs_stat ((char *) XSTRING_DATA (fn), &st) >= 0)
3787 /* But make sure we can overwrite it later! */
3788 auto_save_mode_bits = st.st_mode | 0600;
3790 /* default mode for auto-save files of buffers with no file is
3791 readable by owner only. This may annoy some small number of
3792 people, but the alternative removes all privacy from email. */
3793 auto_save_mode_bits = 0600;
3796 /* !!#### need to deal with this 'escape-quoted everywhere */
3797 Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil,
3807 auto_save_expand_name_error (Lisp_Object condition_object, Lisp_Object ignored)
3809 /* #### this function should spew an error message about not being
3810 able to open the .saves file. */
3815 auto_save_expand_name (Lisp_Object name)
3817 struct gcpro gcpro1;
3819 /* note that caller did NOT gc protect name, so we do it. */
3820 /* #### dmoore - this might not be necessary, if condition_case_1
3821 protects it. but I don't think it does. */
3823 RETURN_UNGCPRO (Fexpand_file_name (name, Qnil));
3828 do_auto_save_unwind (Lisp_Object fd)
3835 do_auto_save_unwind_2 (Lisp_Object old_auto_saving)
3837 auto_saving = XINT (old_auto_saving);
3841 /* Fdo_auto_save() checks whether a GC is in progress when it is called,
3842 and if so, tries to avoid touching lisp objects.
3844 The only time that Fdo_auto_save() is called while GC is in progress
3845 is if we're going down, as a result of an abort() or a kill signal.
3846 It's fairly important that we generate autosave files in that case!
3849 DEFUN ("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3850 Auto-save all buffers that need it.
3851 This is all buffers that have auto-saving enabled
3852 and are changed since last auto-saved.
3853 Auto-saving writes the buffer into a file
3854 so that your editing is not lost if the system crashes.
3855 This file is not the file you visited; that changes only when you save.
3856 Normally we run the normal hook `auto-save-hook' before saving.
3858 Non-nil first argument means do not print any message if successful.
3859 Non-nil second argument means save only current buffer.
3861 (no_message, current_only))
3863 /* This function can call lisp */
3865 Lisp_Object tail, buf;
3867 int do_handled_files;
3868 Lisp_Object oquit = Qnil;
3869 Lisp_Object listfile = Qnil;
3872 int speccount = specpdl_depth ();
3873 struct gcpro gcpro1, gcpro2, gcpro3;
3875 XSETBUFFER (old, current_buffer);
3876 GCPRO3 (oquit, listfile, old);
3877 check_quit (); /* make Vquit_flag accurate */
3878 /* Ordinarily don't quit within this function,
3879 but don't make it impossible to quit (in case we get hung in I/O). */
3883 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3884 variables point to non-strings reached from Vbuffer_alist. */
3886 if (minibuf_level != 0 || preparing_for_armageddon)
3889 run_hook (Qauto_save_hook);
3891 if (STRINGP (Vauto_save_list_file_name))
3892 listfile = condition_case_1 (Qt,
3893 auto_save_expand_name,
3894 Vauto_save_list_file_name,
3895 auto_save_expand_name_error, Qnil);
3897 /* Make sure auto_saving is reset. */
3898 record_unwind_protect (do_auto_save_unwind_2, make_int (auto_saving));
3902 /* First, save all files which don't have handlers. If Emacs is
3903 crashing, the handlers may tweak what is causing Emacs to crash
3904 in the first place, and it would be a shame if Emacs failed to
3905 autosave perfectly ordinary files because it couldn't handle some
3907 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
3909 for (tail = Vbuffer_alist;
3913 buf = XCDR (XCAR (tail));
3916 if (!NILP (current_only)
3917 && b != current_buffer)
3920 /* Don't auto-save indirect buffers.
3921 The base buffer takes care of it. */
3925 /* Check for auto save enabled
3926 and file changed since last auto save
3927 and file changed since last real save. */
3928 if (STRINGP (b->auto_save_file_name)
3929 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
3930 && b->auto_save_modified < BUF_MODIFF (b)
3931 /* -1 means we've turned off autosaving for a while--see below. */
3932 && XINT (b->saved_size) >= 0
3933 && (do_handled_files
3934 || NILP (Ffind_file_name_handler (b->auto_save_file_name,
3937 EMACS_TIME before_time, after_time;
3939 EMACS_GET_TIME (before_time);
3940 /* If we had a failure, don't try again for 20 minutes. */
3941 if (!preparing_for_armageddon
3942 && b->auto_save_failure_time >= 0
3943 && (EMACS_SECS (before_time) - b->auto_save_failure_time <
3947 if (!preparing_for_armageddon &&
3948 (XINT (b->saved_size) * 10
3949 > (BUF_Z (b) - BUF_BEG (b)) * 13)
3950 /* A short file is likely to change a large fraction;
3951 spare the user annoying messages. */
3952 && XINT (b->saved_size) > 5000
3953 /* These messages are frequent and annoying for `*mail*'. */
3954 && !NILP (b->filename)
3955 && NILP (no_message)
3956 && disable_auto_save_when_buffer_shrinks)
3958 /* It has shrunk too much; turn off auto-saving here.
3959 Unless we're about to crash, in which case auto-save it
3963 ("Buffer %s has shrunk a lot; auto save turned off there",
3964 XSTRING_DATA (b->name));
3965 /* Turn off auto-saving until there's a real save,
3966 and prevent any more warnings. */
3967 b->saved_size = make_int (-1);
3968 if (!gc_in_progress)
3969 Fsleep_for (make_int (1));
3972 set_buffer_internal (b);
3973 if (!auto_saved && NILP (no_message))
3975 static const unsigned char *msg
3976 = (const unsigned char *) "Auto-saving...";
3977 echo_area_message (selected_frame (), msg, Qnil,
3978 0, strlen ((const char *) msg),
3982 /* Open the auto-save list file, if necessary.
3983 We only do this now so that the file only exists
3984 if we actually auto-saved any files. */
3985 if (!auto_saved && STRINGP (listfile) && listdesc < 0)
3987 listdesc = open ((char *) XSTRING_DATA (listfile),
3988 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
3991 /* Arrange to close that file whether or not we get
3994 record_unwind_protect (do_auto_save_unwind,
3995 make_int (listdesc));
3998 /* Record all the buffers that we are auto-saving in
3999 the special file that lists them. For each of
4000 these buffers, record visited name (if any) and
4004 const Extbyte *auto_save_file_name_ext;
4005 Extcount auto_save_file_name_ext_len;
4007 TO_EXTERNAL_FORMAT (LISP_STRING, b->auto_save_file_name,
4008 ALLOCA, (auto_save_file_name_ext,
4009 auto_save_file_name_ext_len),
4011 if (!NILP (b->filename))
4013 const Extbyte *filename_ext;
4014 Extcount filename_ext_len;
4016 TO_EXTERNAL_FORMAT (LISP_STRING, b->filename,
4017 ALLOCA, (filename_ext,
4020 write (listdesc, filename_ext, filename_ext_len);
4022 write (listdesc, "\n", 1);
4023 write (listdesc, auto_save_file_name_ext,
4024 auto_save_file_name_ext_len);
4025 write (listdesc, "\n", 1);
4028 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
4029 based on values in Vbuffer_alist. auto_save_1 may
4030 cause lisp handlers to run. Those handlers may kill
4031 the buffer and then GC. Since the buffer is killed,
4032 it's no longer in Vbuffer_alist so it might get reaped
4033 by the GC. We also need to protect tail. */
4034 /* #### There is probably a lot of other code which has
4035 pointers into buffers which may get blown away by
4038 struct gcpro ngcpro1, ngcpro2;
4039 NGCPRO2 (buf, tail);
4040 condition_case_1 (Qt,
4042 auto_save_error, Qnil);
4045 /* Handler killed our saved current-buffer! Pick any. */
4046 if (!BUFFER_LIVE_P (XBUFFER (old)))
4047 XSETBUFFER (old, current_buffer);
4049 set_buffer_internal (XBUFFER (old));
4052 /* Handler killed their own buffer! */
4053 if (!BUFFER_LIVE_P(b))
4056 b->auto_save_modified = BUF_MODIFF (b);
4057 b->saved_size = make_int (BUF_SIZE (b));
4058 EMACS_GET_TIME (after_time);
4059 /* If auto-save took more than 60 seconds,
4060 assume it was an NFS failure that got a timeout. */
4061 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
4062 b->auto_save_failure_time = EMACS_SECS (after_time);
4067 /* Prevent another auto save till enough input events come in. */
4069 record_auto_save ();
4071 /* If we didn't save anything into the listfile, remove the old
4072 one because nothing needed to be auto-saved. Do this afterwards
4073 rather than before in case we get a crash attempting to autosave
4074 (in that case we'd still want the old one around). */
4075 if (listdesc < 0 && !auto_saved && STRINGP (listfile))
4076 unlink ((char *) XSTRING_DATA (listfile));
4078 /* Show "...done" only if the echo area would otherwise be empty. */
4079 if (auto_saved && NILP (no_message)
4080 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0)))
4082 static const unsigned char *msg
4083 = (const unsigned char *)"Auto-saving...done";
4084 echo_area_message (selected_frame (), msg, Qnil, 0,
4085 strlen ((const char *) msg), Qauto_saving);
4090 RETURN_UNGCPRO (unbind_to (speccount, Qnil));
4093 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
4094 Mark current buffer as auto-saved with its current text.
4095 No auto-save file will be written until the buffer changes again.
4099 current_buffer->auto_save_modified = BUF_MODIFF (current_buffer);
4100 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
4101 current_buffer->auto_save_failure_time = -1;
4105 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
4106 Clear any record of a recent auto-save failure in the current buffer.
4110 current_buffer->auto_save_failure_time = -1;
4114 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
4115 Return t if buffer has been auto-saved since last read in or saved.
4119 return (BUF_SAVE_MODIFF (current_buffer) <
4120 current_buffer->auto_save_modified) ? Qt : Qnil;
4124 /************************************************************************/
4125 /* initialization */
4126 /************************************************************************/
4129 syms_of_fileio (void)
4131 defsymbol (&Qexpand_file_name, "expand-file-name");
4132 defsymbol (&Qfile_truename, "file-truename");
4133 defsymbol (&Qsubstitute_in_file_name, "substitute-in-file-name");
4134 defsymbol (&Qdirectory_file_name, "directory-file-name");
4135 defsymbol (&Qfile_name_directory, "file-name-directory");
4136 defsymbol (&Qfile_name_nondirectory, "file-name-nondirectory");
4137 defsymbol (&Qunhandled_file_name_directory, "unhandled-file-name-directory");
4138 defsymbol (&Qfile_name_as_directory, "file-name-as-directory");
4139 defsymbol (&Qcopy_file, "copy-file");
4140 defsymbol (&Qmake_directory_internal, "make-directory-internal");
4141 defsymbol (&Qdelete_directory, "delete-directory");
4142 defsymbol (&Qdelete_file, "delete-file");
4143 defsymbol (&Qrename_file, "rename-file");
4144 defsymbol (&Qadd_name_to_file, "add-name-to-file");
4145 defsymbol (&Qmake_symbolic_link, "make-symbolic-link");
4146 defsymbol (&Qfile_exists_p, "file-exists-p");
4147 defsymbol (&Qfile_executable_p, "file-executable-p");
4148 defsymbol (&Qfile_readable_p, "file-readable-p");
4149 defsymbol (&Qfile_symlink_p, "file-symlink-p");
4150 defsymbol (&Qfile_writable_p, "file-writable-p");
4151 defsymbol (&Qfile_directory_p, "file-directory-p");
4152 defsymbol (&Qfile_regular_p, "file-regular-p");
4153 defsymbol (&Qfile_accessible_directory_p, "file-accessible-directory-p");
4154 defsymbol (&Qfile_modes, "file-modes");
4155 defsymbol (&Qset_file_modes, "set-file-modes");
4156 defsymbol (&Qfile_newer_than_file_p, "file-newer-than-file-p");
4157 defsymbol (&Qinsert_file_contents, "insert-file-contents");
4158 defsymbol (&Qwrite_region, "write-region");
4159 defsymbol (&Qverify_visited_file_modtime, "verify-visited-file-modtime");
4160 defsymbol (&Qset_visited_file_modtime, "set-visited-file-modtime");
4161 defsymbol (&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */
4163 defsymbol (&Qauto_save_hook, "auto-save-hook");
4164 defsymbol (&Qauto_save_error, "auto-save-error");
4165 defsymbol (&Qauto_saving, "auto-saving");
4167 defsymbol (&Qformat_decode, "format-decode");
4168 defsymbol (&Qformat_annotate_function, "format-annotate-function");
4170 defsymbol (&Qcompute_buffer_file_truename, "compute-buffer-file-truename");
4171 DEFERROR_STANDARD (Qfile_error, Qio_error);
4172 DEFERROR_STANDARD (Qfile_already_exists, Qfile_error);
4174 DEFSUBR (Ffind_file_name_handler);
4176 DEFSUBR (Ffile_name_directory);
4177 DEFSUBR (Ffile_name_nondirectory);
4178 DEFSUBR (Funhandled_file_name_directory);
4179 DEFSUBR (Ffile_name_as_directory);
4180 DEFSUBR (Fdirectory_file_name);
4181 DEFSUBR (Fmake_temp_name);
4182 DEFSUBR (Fexpand_file_name);
4183 DEFSUBR (Ffile_truename);
4184 DEFSUBR (Fsubstitute_in_file_name);
4185 DEFSUBR (Fcopy_file);
4186 DEFSUBR (Fmake_directory_internal);
4187 DEFSUBR (Fdelete_directory);
4188 DEFSUBR (Fdelete_file);
4189 DEFSUBR (Frename_file);
4190 DEFSUBR (Fadd_name_to_file);
4191 DEFSUBR (Fmake_symbolic_link);
4193 DEFSUBR (Fsysnetunam);
4194 #endif /* HPUX_NET */
4195 DEFSUBR (Ffile_name_absolute_p);
4196 DEFSUBR (Ffile_exists_p);
4197 DEFSUBR (Ffile_executable_p);
4198 DEFSUBR (Ffile_readable_p);
4199 DEFSUBR (Ffile_writable_p);
4200 DEFSUBR (Ffile_symlink_p);
4201 DEFSUBR (Ffile_directory_p);
4202 DEFSUBR (Ffile_accessible_directory_p);
4203 DEFSUBR (Ffile_regular_p);
4204 DEFSUBR (Ffile_modes);
4205 DEFSUBR (Fset_file_modes);
4206 DEFSUBR (Fset_default_file_modes);
4207 DEFSUBR (Fdefault_file_modes);
4208 DEFSUBR (Funix_sync);
4209 DEFSUBR (Ffile_newer_than_file_p);
4210 DEFSUBR (Finsert_file_contents_internal);
4211 DEFSUBR (Fwrite_region_internal);
4212 DEFSUBR (Fcar_less_than_car); /* Vomitous! */
4213 DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
4215 DEFSUBR (Fencrypt_string);
4216 DEFSUBR (Fdecrypt_string);
4218 DEFSUBR (Fverify_visited_file_modtime);
4219 DEFSUBR (Fclear_visited_file_modtime);
4220 DEFSUBR (Fvisited_file_modtime);
4221 DEFSUBR (Fset_visited_file_modtime);
4223 DEFSUBR (Fdo_auto_save);
4224 DEFSUBR (Fset_buffer_auto_saved);
4225 DEFSUBR (Fclear_buffer_auto_save_failure);
4226 DEFSUBR (Frecent_auto_save_p);
4230 vars_of_fileio (void)
4232 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /*
4233 *Format in which to write auto-save files.
4234 Should be a list of symbols naming formats that are defined in `format-alist'.
4235 If it is t, which is the default, auto-save files are written in the
4236 same format as a regular save would use.
4238 Vauto_save_file_format = Qt;
4240 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /*
4241 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
4242 If a file name matches REGEXP, then all I/O on that file is done by calling
4245 The first argument given to HANDLER is the name of the I/O primitive
4246 to be handled; the remaining arguments are the arguments that were
4247 passed to that primitive. For example, if you do
4248 (file-exists-p FILENAME)
4249 and FILENAME is handled by HANDLER, then HANDLER is called like this:
4250 (funcall HANDLER 'file-exists-p FILENAME)
4251 The function `find-file-name-handler' checks this list for a handler
4254 Vfile_name_handler_alist = Qnil;
4256 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /*
4257 A list of functions to be called at the end of `insert-file-contents'.
4258 Each is passed one argument, the number of bytes inserted. It should return
4259 the new byte count, and leave point the same. If `insert-file-contents' is
4260 intercepted by a handler from `file-name-handler-alist', that handler is
4261 responsible for calling the after-insert-file-functions if appropriate.
4263 Vafter_insert_file_functions = Qnil;
4265 DEFVAR_LISP ("write-region-annotate-functions",
4266 &Vwrite_region_annotate_functions /*
4267 A list of functions to be called at the start of `write-region'.
4268 Each is passed two arguments, START and END, as for `write-region'.
4269 It should return a list of pairs (POSITION . STRING) of strings to be
4270 effectively inserted at the specified positions of the file being written
4271 \(1 means to insert before the first byte written). The POSITIONs must be
4272 sorted into increasing order. If there are several functions in the list,
4273 the several lists are merged destructively.
4275 Vwrite_region_annotate_functions = Qnil;
4277 DEFVAR_LISP ("write-region-annotations-so-far",
4278 &Vwrite_region_annotations_so_far /*
4279 When an annotation function is called, this holds the previous annotations.
4280 These are the annotations made by other annotation functions
4281 that were already called. See also `write-region-annotate-functions'.
4283 Vwrite_region_annotations_so_far = Qnil;
4285 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
4286 A list of file name handlers that temporarily should not be used.
4287 This applies only to the operation `inhibit-file-name-operation'.
4289 Vinhibit_file_name_handlers = Qnil;
4291 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
4292 The operation for which `inhibit-file-name-handlers' is applicable.
4294 Vinhibit_file_name_operation = Qnil;
4296 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name /*
4297 File name in which we write a list of all auto save file names.
4299 Vauto_save_list_file_name = Qnil;
4301 DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks",
4302 &disable_auto_save_when_buffer_shrinks /*
4303 If non-nil, auto-saving is disabled when a buffer shrinks too much.
4304 This is to prevent you from losing your edits if you accidentally
4305 delete a large chunk of the buffer and don't notice it until too late.
4306 Saving the buffer normally turns auto-save back on.
4308 disable_auto_save_when_buffer_shrinks = 1;
4310 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /*
4311 Directory separator character for built-in functions that return file names.
4312 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
4313 This variable affects the built-in functions only on Windows,
4314 on other platforms, it is initialized so that Lisp code can find out
4315 what the normal separator is.
4318 Vdirectory_sep_char = make_char ('\\');
4320 Vdirectory_sep_char = make_char ('/');
4323 reinit_vars_of_fileio ();
4327 reinit_vars_of_fileio (void)
4329 /* We want temp_name_rand to be initialized to a value likely to be
4330 unique to the process, not to the executable. The danger is that
4331 two different XEmacs processes using the same binary on different
4332 machines creating temp files in the same directory will be
4333 unlucky enough to have the same pid. If we randomize using
4334 process startup time, then in practice they will be unlikely to
4335 collide. We use the microseconds field so that scripts that start
4336 simultaneous XEmacs processes on multiple machines will have less
4337 chance of collision. */
4341 EMACS_GET_TIME (thyme);
4342 temp_name_rand = (unsigned int) (EMACS_SECS (thyme) ^ EMACS_USECS (thyme));