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 1997.04.06. */
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 1997.04.06. */
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 1997.04.06. */
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 int size = strlen (in);
520 out[1] = DIRECTORY_SEP;
526 /* Append a slash if necessary */
527 if (!IS_ANY_SEP (out[size-1]))
529 out[size] = DIRECTORY_SEP;
530 out[size + 1] = '\0';
536 DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /*
537 Return a string representing file FILENAME interpreted as a directory.
538 This operation exists because a directory is also a file, but its name as
539 a directory is different from its name as a file.
540 The result can be used as the value of `default-directory'
541 or passed as second argument to `expand-file-name'.
542 For a Unix-syntax file name, just appends a slash,
543 except for (file-name-as-directory \"\") => \"./\".
547 /* This function can GC. GC checked 1997.04.06. */
553 /* If the file name has special constructs in it,
554 call the corresponding file handler. */
555 handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
557 return call2_check_string (handler, Qfile_name_as_directory, file);
559 buf = (char *) alloca (XSTRING_LENGTH (file) + 10);
560 return build_string (file_name_as_directory
561 (buf, (char *) XSTRING_DATA (file)));
565 * Convert from directory name to filename.
566 * On UNIX, it's simple: just make sure there isn't a terminating /
568 * Value is nonzero if the string output is different from the input.
572 directory_file_name (const char *src, char *dst)
574 long slen = strlen (src);
575 /* Process as Unix format: just remove any final slash.
576 But leave "/" unchanged; do not change it to "". */
579 && IS_DIRECTORY_SEP (dst[slen - 1])
581 && !IS_ANY_SEP (dst[slen - 2])
582 #endif /* WIN32_NATIVE */
588 DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
589 Return the file name of the directory named DIR.
590 This is the name of the file that holds the data for the directory DIR.
591 This operation exists because a directory is also a file, but its name as
592 a directory is different from its name as a file.
593 In Unix-syntax, this function just removes the final slash.
597 /* This function can GC. GC checked 1997.04.06. */
601 CHECK_STRING (directory);
603 #if 0 /* #### WTF? */
604 if (NILP (directory))
608 /* If the file name has special constructs in it,
609 call the corresponding file handler. */
610 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
612 return call2_check_string (handler, Qdirectory_file_name, directory);
613 buf = (char *) alloca (XSTRING_LENGTH (directory) + 20);
614 directory_file_name ((char *) XSTRING_DATA (directory), buf);
615 return build_string (buf);
618 /* Fmake_temp_name used to be a simple wrapper around mktemp(), but it
619 proved too broken for our purposes (it supported only 26 or 62
620 unique names under some implementations). For example, this
621 arbitrary limit broke generation of Gnus Incoming* files.
623 This implementation is better than what one usually finds in libc.
626 static unsigned int temp_name_rand;
628 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
629 Generate a temporary file name starting with PREFIX.
630 The Emacs process number forms part of the result, so there is no
631 danger of generating a name being used by another process.
633 In addition, this function makes an attempt to choose a name that
634 does not specify an existing file. To make this work, PREFIX should
635 be an absolute file name.
639 static const char tbl[64] =
641 'A','B','C','D','E','F','G','H',
642 'I','J','K','L','M','N','O','P',
643 'Q','R','S','T','U','V','W','X',
644 'Y','Z','a','b','c','d','e','f',
645 'g','h','i','j','k','l','m','n',
646 'o','p','q','r','s','t','u','v',
647 'w','x','y','z','0','1','2','3',
648 '4','5','6','7','8','9','-','_'
655 CHECK_STRING (prefix);
657 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's
660 1) It might change the prefix, so the resulting string might not
661 begin with PREFIX. This violates the principle of least
664 2) It breaks under many unforeseeable circumstances, such as with
665 the code that uses (make-temp-name "") instead of
666 (make-temp-name "./").
668 3) It might yield unexpected (to stat(2)) results in the presence
669 of EFS and file name handlers. */
671 len = XSTRING_LENGTH (prefix);
672 val = make_uninit_string (len + 6);
673 data = XSTRING_DATA (val);
674 memcpy (data, XSTRING_DATA (prefix), len);
677 /* VAL is created by adding 6 characters to PREFIX. The first three
678 are the PID of this process, in base 64, and the second three are
679 a pseudo-random number seeded from process startup time. This
680 ensures 262144 unique file names per PID per PREFIX per machine. */
683 unsigned int pid = (unsigned int) getpid ();
684 *p++ = tbl[(pid >> 0) & 63];
685 *p++ = tbl[(pid >> 6) & 63];
686 *p++ = tbl[(pid >> 12) & 63];
689 /* Here we try to minimize useless stat'ing when this function is
690 invoked many times successively with the same PREFIX. We achieve
691 this by using a very pseudo-random number generator to generate
692 file names unique to this process, with a very long cycle. */
698 p[0] = tbl[(temp_name_rand >> 0) & 63];
699 p[1] = tbl[(temp_name_rand >> 6) & 63];
700 p[2] = tbl[(temp_name_rand >> 12) & 63];
702 /* Poor man's congruential RN generator. Replace with ++count
704 temp_name_rand += 25229;
705 temp_name_rand %= 225307;
709 if (stat ((const char *) data, &ignored) < 0)
711 /* We want to return only if errno is ENOENT. */
715 /* The error here is dubious, but there is little else we
716 can do. The alternatives are to return nil, which is
717 as bad as (and in many cases worse than) throwing the
718 error, or to ignore the error, which will likely result
720 report_file_error ("Cannot create temporary name for prefix",
722 return Qnil; /* not reached */
728 DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /*
729 Convert filename NAME to absolute, and canonicalize it.
730 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
731 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
732 the current buffer's value of default-directory is used.
733 File name components that are `.' are removed, and
734 so are file name components followed by `..', along with the `..' itself;
735 note that these simplifications are done without checking the resulting
736 file names in the file system.
737 An initial `~/' expands to your home directory.
738 An initial `~USER/' expands to USER's home directory.
739 See also the function `substitute-in-file-name'.
741 (name, default_directory))
743 /* This function can GC */
746 Bufbyte *newdir, *p, *o;
751 int collapse_newdir = 1;
754 #endif /* WIN32_NATIVE */
763 /* If the file name has special constructs in it,
764 call the corresponding file handler. */
765 handler = Ffind_file_name_handler (name, Qexpand_file_name);
767 return call3_check_string (handler, Qexpand_file_name, name,
770 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
771 if (NILP (default_directory))
772 default_directory = current_buffer->directory;
773 if (! STRINGP (default_directory))
774 default_directory = build_string ("/");
776 if (!NILP (default_directory))
778 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
780 return call3 (handler, Qexpand_file_name, name, default_directory);
783 o = XSTRING_DATA (default_directory);
785 /* Make sure DEFAULT_DIRECTORY is properly expanded.
786 It would be better to do this down below where we actually use
787 default_directory. Unfortunately, calling Fexpand_file_name recursively
788 could invoke GC, and the strings might be relocated. This would
789 be annoying because we have pointers into strings lying around
790 that would need adjusting, and people would add new pointers to
791 the code and forget to adjust them, resulting in intermittent bugs.
792 Putting this call here avoids all that crud.
794 The EQ test avoids infinite recursion. */
795 if (! NILP (default_directory) && !EQ (default_directory, name)
796 /* Save time in some common cases - as long as default_directory
797 is not relative, it can be canonicalized with name below (if it
798 is needed at all) without requiring it to be expanded now. */
800 /* Detect Windows file names with drive specifiers. */
801 && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2])))
802 /* Detect Windows file names in UNC format. */
803 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
805 #else /* not WIN32_NATIVE */
807 /* Detect Unix absolute file names (/... alone is not absolute on
809 && ! (IS_DIRECTORY_SEP (o[0]))
810 #endif /* not WIN32_NATIVE */
816 default_directory = Fexpand_file_name (default_directory, Qnil);
820 #ifdef FILE_SYSTEM_CASE
821 name = FILE_SYSTEM_CASE (name);
824 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing
825 into name should be safe during all of this, though. */
826 nm = XSTRING_DATA (name);
829 /* We will force directory separators to be either all \ or /, so make
830 a local copy to modify, even if there ends up being no change. */
831 nm = strcpy ((char *)alloca (strlen ((char *)nm) + 1), (char *)nm);
833 /* Find and remove drive specifier if present; this makes nm absolute
834 even if the rest of the name appears to be relative. */
836 Bufbyte *colon = (Bufbyte *) strrchr ((char *)nm, ':');
839 /* Only recognize colon as part of drive specifier if there is a
840 single alphabetic character preceding the colon (and if the
841 character before the drive letter, if present, is a directory
842 separator); this is to support the remote system syntax used by
843 ange-ftp, and the "po:username" syntax for POP mailboxes. */
847 else if (IS_DRIVE (colon[-1])
848 && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2])))
855 while (--colon >= nm)
861 /* If we see "c://somedir", we want to strip the first slash after the
862 colon when stripping the drive letter. Otherwise, this expands to
864 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
866 #endif /* WIN32_NATIVE */
868 /* If nm is absolute, look for /./ or /../ sequences; if none are
869 found, we can probably return right away. We will avoid allocating
870 a new string if name is already fully expanded. */
872 IS_DIRECTORY_SEP (nm[0])
874 && (drive || IS_DIRECTORY_SEP (nm[1]))
878 /* If it turns out that the filename we want to return is just a
879 suffix of FILENAME, we don't need to go through and edit
880 things; we just need to construct a new string using data
881 starting at the middle of FILENAME. If we set lose to a
882 non-zero value, that means we've discovered that we can't do
889 /* Since we know the name is absolute, we can assume that each
890 element starts with a "/". */
892 /* "." and ".." are hairy. */
893 if (IS_DIRECTORY_SEP (p[0])
895 && (IS_DIRECTORY_SEP (p[2])
897 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
905 /* Make sure directories are all separated with / or \ as
906 desired, but avoid allocation of a new string when not
908 CORRECT_DIR_SEPS (nm);
909 if (IS_DIRECTORY_SEP (nm[1]))
911 if (strcmp (nm, XSTRING_DATA (name)) != 0)
912 name = build_string (nm);
914 /* drive must be set, so this is okay */
915 else if (strcmp (nm - 2, XSTRING_DATA (name)) != 0)
917 name = make_string (nm - 2, p - nm + 2);
918 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
919 XSTRING_DATA (name)[1] = ':';
922 #else /* not WIN32_NATIVE */
923 if (nm == XSTRING_DATA (name))
925 return build_string ((char *) nm);
926 #endif /* not WIN32_NATIVE */
930 /* At this point, nm might or might not be an absolute file name. We
931 need to expand ~ or ~user if present, otherwise prefix nm with
932 default_directory if nm is not absolute, and finally collapse /./
933 and /foo/../ sequences.
935 We set newdir to be the appropriate prefix if one is needed:
936 - the relevant user directory if nm starts with ~ or ~user
937 - the specified drive's working dir (DOS/NT only) if nm does not
939 - the value of default_directory.
941 Note that these prefixes are not guaranteed to be absolute (except
942 for the working dir of a drive). Therefore, to ensure we always
943 return an absolute name, if the final prefix is not absolute we
944 append it to the current working directory. */
948 if (nm[0] == '~') /* prefix ~ */
950 if (IS_DIRECTORY_SEP (nm[1])
951 || nm[1] == 0) /* ~ by itself */
953 Extbyte *newdir_external = get_home_directory ();
955 if (newdir_external == NULL)
956 newdir = (Bufbyte *) "";
958 TO_INTERNAL_FORMAT (C_STRING, newdir_external,
959 C_STRING_ALLOCA, (* ((char **) &newdir)),
967 else /* ~user/filename */
969 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++)
971 o = (Bufbyte *) alloca (p - nm + 1);
972 memcpy (o, (char *) nm, p - nm);
975 /* #### marcpa's syncing note: FSF uses getpwnam even on NT,
976 which does not work. The following works only if ~USER
977 names the user who runs this instance of XEmacs. While
978 NT is single-user (for the moment) you still can have
979 multiple user profiles users defined, each with its HOME.
980 Therefore, the following should be reworked to handle
983 /* Now if the file given is "~foo/file" and HOME="c:/", then
984 we want the file to be named "c:/file" ("~foo" becomes
985 "c:/"). The variable o has "~foo", so we can use the
986 length of that string to offset nm. August Hill, 31 Aug
988 newdir = (Bufbyte *) get_home_directory();
989 dostounix_filename (newdir);
991 #else /* not WIN32_NATIVE */
993 if ((user = user_login_name (NULL)) != NULL)
995 /* Does the user login name match the ~name? */
996 if (strcmp (user, (char *) o + 1) == 0)
998 newdir = (Bufbyte *) get_home_directory();
1005 /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM
1006 occurring in it. (It can call select()). */
1007 slow_down_interrupts ();
1008 pw = (struct passwd *) getpwnam ((char *) o + 1);
1009 speed_up_interrupts ();
1012 newdir = (Bufbyte *) pw -> pw_dir;
1018 #endif /* not WIN32_NATIVE */
1020 /* If we don't find a user of that name, leave the name
1021 unchanged; don't move nm forward to p. */
1026 /* On DOS and Windows, nm is absolute if a drive name was specified;
1027 use the drive's current directory as the prefix if needed. */
1028 if (!newdir && drive)
1030 /* Get default directory if needed to make nm absolute. */
1031 if (!IS_DIRECTORY_SEP (nm[0]))
1033 newdir = alloca (MAXPATHLEN + 1);
1034 if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN))
1039 /* Either nm starts with /, or drive isn't mounted. */
1040 newdir = alloca (4);
1041 newdir[0] = DRIVE_LETTER (drive);
1047 #endif /* WIN32_NATIVE */
1049 /* Finally, if no prefix has been specified and nm is not absolute,
1050 then it must be expanded relative to default_directory. */
1053 #ifndef WIN32_NATIVE
1054 /* /... alone is not absolute on DOS and Windows. */
1055 && !IS_DIRECTORY_SEP (nm[0])
1057 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
1061 newdir = XSTRING_DATA (default_directory);
1067 /* First ensure newdir is an absolute name. */
1069 /* Detect Windows file names with drive specifiers. */
1070 ! (IS_DRIVE (newdir[0])
1071 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
1072 /* Detect Windows file names in UNC format. */
1073 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1074 /* Detect drive spec by itself */
1075 && ! (IS_DEVICE_SEP (newdir[1]) && newdir[2] == 0)
1078 /* Effectively, let newdir be (expand-file-name newdir cwd).
1079 Because of the admonition against calling expand-file-name
1080 when we have pointers into lisp strings, we accomplish this
1081 indirectly by prepending newdir to nm if necessary, and using
1082 cwd (or the wd of newdir's drive) as the new newdir. */
1084 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1089 if (!IS_DIRECTORY_SEP (nm[0]))
1091 char * tmp = alloca (strlen (newdir) + strlen (nm) + 2);
1092 file_name_as_directory (tmp, newdir);
1096 newdir = alloca (MAXPATHLEN + 1);
1099 if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN))
1106 /* Strip off drive name from prefix, if present. */
1107 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1113 /* Keep only a prefix from newdir if nm starts with slash
1114 (/ /server/share for UNC, nothing otherwise). */
1115 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
1117 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1119 newdir = strcpy (alloca (strlen (newdir) + 1), newdir);
1121 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1123 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1130 #endif /* WIN32_NATIVE */
1134 /* Get rid of any slash at the end of newdir, unless newdir is
1135 just // (an incomplete UNC name). */
1136 length = strlen ((char *) newdir);
1137 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
1139 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
1143 Bufbyte *temp = (Bufbyte *) alloca (length);
1144 memcpy (temp, newdir, length - 1);
1145 temp[length - 1] = 0;
1153 /* Now concatenate the directory and name to new space in the stack frame */
1154 tlen += strlen ((char *) nm) + 1;
1156 /* Add reserved space for drive name. (The Microsoft x86 compiler
1157 produces incorrect code if the following two lines are combined.) */
1158 target = (Bufbyte *) alloca (tlen + 2);
1160 #else /* not WIN32_NATIVE */
1161 target = (Bufbyte *) alloca (tlen);
1162 #endif /* not WIN32_NATIVE */
1167 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
1168 strcpy ((char *) target, (char *) newdir);
1170 file_name_as_directory ((char *) target, (char *) newdir);
1173 strcat ((char *) target, (char *) nm);
1175 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1177 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1184 if (!IS_DIRECTORY_SEP (*p))
1188 else if (IS_DIRECTORY_SEP (p[0])
1190 && (IS_DIRECTORY_SEP (p[2])
1193 /* If "/." is the entire filename, keep the "/". Otherwise,
1194 just delete the whole "/.". */
1195 if (o == target && p[2] == '\0')
1199 else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
1200 /* `/../' is the "superroot" on certain file systems. */
1202 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
1204 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
1206 /* Keep initial / only if this is the whole name. */
1207 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
1212 /* if drive is set, we're not dealing with an UNC, so
1213 multiple dir-seps are redundant (and reportedly cause trouble
1215 else if (drive && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
1225 /* At last, set drive name, except for network file name. */
1229 target[0] = DRIVE_LETTER (drive);
1234 assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]));
1236 CORRECT_DIR_SEPS (target);
1237 #endif /* WIN32_NATIVE */
1239 return make_string (target, o - target);
1242 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /*
1243 Return the canonical name of the given FILE.
1244 Second arg DEFAULT is directory to start with if FILE is relative
1245 (does not start with slash); if DEFAULT is nil or missing,
1246 the current buffer's value of default-directory is used.
1247 No component of the resulting pathname will be a symbolic link, as
1248 in the realpath() function.
1250 (filename, default_))
1252 /* This function can GC. */
1253 Lisp_Object expanded_name;
1254 struct gcpro gcpro1;
1256 CHECK_STRING (filename);
1258 expanded_name = Fexpand_file_name (filename, default_);
1260 GCPRO1 (expanded_name);
1262 if (!STRINGP (expanded_name))
1266 Lisp_Object handler =
1267 Ffind_file_name_handler (expanded_name, Qfile_truename);
1269 if (!NILP (handler))
1271 (call2_check_string (handler, Qfile_truename, expanded_name));
1275 char resolved_path[MAXPATHLEN];
1280 TO_EXTERNAL_FORMAT (LISP_STRING, expanded_name,
1281 ALLOCA, (path, elen),
1284 if (elen > MAXPATHLEN)
1287 /* Try doing it all at once. */
1288 /* !! Does realpath() Mule-encapsulate?
1289 Answer: Nope! So we do it above */
1290 if (!xrealpath ((char *) path, resolved_path))
1292 /* Didn't resolve it -- have to do it one component at a time. */
1293 /* "realpath" is a typically useless, stupid un*x piece of crap.
1294 It claims to return a useful value in the "error" case, but since
1295 there is no indication provided of how far along the pathname
1296 the function went before erring, there is no way to use the
1297 partial result returned. What a piece of junk.
1299 The above comment refers to historical versions of
1300 realpath(). The Unix98 specs state:
1302 "On successful completion, realpath() returns a
1303 pointer to the resolved name. Otherwise, realpath()
1304 returns a null pointer and sets errno to indicate the
1305 error, and the contents of the buffer pointed to by
1306 resolved_name are undefined."
1308 Since we depend on undocumented semantics of various system realpath()s,
1309 we just use our own version in realpath.c. */
1312 p = (Extbyte *) memchr (p + 1, '/', elen - (p + 1 - path));
1316 if (xrealpath ((char *) path, resolved_path))
1324 else if (errno == ENOENT || errno == EACCES)
1326 /* Failed on this component. Just tack on the rest of
1327 the string and we are done. */
1328 int rlen = strlen (resolved_path);
1330 /* "On failure, it returns NULL, sets errno to indicate
1331 the error, and places in resolved_path the absolute pathname
1332 of the path component which could not be resolved." */
1336 int plen = elen - (p - path);
1338 if (rlen > 1 && resolved_path[rlen - 1] == '/')
1341 if (plen + rlen + 1 > countof (resolved_path))
1344 resolved_path[rlen] = '/';
1345 memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1);
1355 Lisp_Object resolved_name;
1356 int rlen = strlen (resolved_path);
1357 if (elen > 0 && XSTRING_BYTE (expanded_name, elen - 1) == '/'
1358 && !(rlen > 0 && resolved_path[rlen - 1] == '/'))
1360 if (rlen + 1 > countof (resolved_path))
1362 resolved_path[rlen++] = '/';
1363 resolved_path[rlen] = '\0';
1365 TO_INTERNAL_FORMAT (DATA, (resolved_path, rlen),
1366 LISP_STRING, resolved_name,
1368 RETURN_UNGCPRO (resolved_name);
1372 errno = ENAMETOOLONG;
1375 report_file_error ("Finding truename", list1 (expanded_name));
1377 RETURN_UNGCPRO (Qnil);
1381 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
1382 Substitute environment variables referred to in FILENAME.
1383 `$FOO' where FOO is an environment variable name means to substitute
1384 the value of that variable. The variable name should be terminated
1385 with a character not a letter, digit or underscore; otherwise, enclose
1386 the entire variable name in braces.
1387 If `/~' appears, all of FILENAME through that `/' is discarded.
1392 /* This function can GC. GC checked 1997.04.06. */
1395 Bufbyte *s, *p, *o, *x, *endp;
1396 Bufbyte *target = 0;
1398 int substituted = 0;
1400 Lisp_Object handler;
1402 CHECK_STRING (string);
1404 /* If the file name has special constructs in it,
1405 call the corresponding file handler. */
1406 handler = Ffind_file_name_handler (string, Qsubstitute_in_file_name);
1407 if (!NILP (handler))
1408 return call2_check_string_or_nil (handler, Qsubstitute_in_file_name,
1411 nm = XSTRING_DATA (string);
1412 endp = nm + XSTRING_LENGTH (string);
1414 /* If /~ or // appears, discard everything through first slash. */
1416 for (p = nm; p != endp; p++)
1419 #if defined (WIN32_NATIVE) || defined (CYGWIN)
1420 /* // at start of file name is meaningful in WindowsNT systems */
1421 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
1422 #else /* not (WIN32_NATIVE || CYGWIN) */
1423 || IS_DIRECTORY_SEP (p[0])
1424 #endif /* not (WIN32_NATIVE || CYGWIN) */
1427 && (IS_DIRECTORY_SEP (p[-1])))
1433 /* see comment in expand-file-name about drive specifiers */
1434 else if (IS_DRIVE (p[0]) && p[1] == ':'
1435 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1440 #endif /* WIN32_NATIVE */
1443 /* See if any variables are substituted into the string
1444 and find the total length of their values in `total' */
1446 for (p = nm; p != endp;)
1456 /* "$$" means a single "$" */
1465 while (p != endp && *p != '}') p++;
1466 if (*p != '}') goto missingclose;
1472 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1476 /* Copy out the variable name */
1477 target = (Bufbyte *) alloca (s - o + 1);
1478 strncpy ((char *) target, (char *) o, s - o);
1481 strupr (target); /* $home == $HOME etc. */
1482 #endif /* WIN32_NATIVE */
1484 /* Get variable value */
1485 o = (Bufbyte *) egetenv ((char *) target);
1486 if (!o) goto badvar;
1487 total += strlen ((char *) o);
1494 /* If substitution required, recopy the string and do it */
1495 /* Make space in stack frame for the new copy */
1496 xnm = (Bufbyte *) alloca (XSTRING_LENGTH (string) + total + 1);
1499 /* Copy the rest of the name through, replacing $ constructs with values */
1516 while (p != endp && *p != '}') p++;
1517 if (*p != '}') goto missingclose;
1523 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1527 /* Copy out the variable name */
1528 target = (Bufbyte *) alloca (s - o + 1);
1529 strncpy ((char *) target, (char *) o, s - o);
1532 strupr (target); /* $home == $HOME etc. */
1533 #endif /* WIN32_NATIVE */
1535 /* Get variable value */
1536 o = (Bufbyte *) egetenv ((char *) target);
1540 strcpy ((char *) x, (char *) o);
1541 x += strlen ((char *) o);
1546 /* If /~ or // appears, discard everything through first slash. */
1548 for (p = xnm; p != x; p++)
1550 #if defined (WIN32_NATIVE)
1551 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
1552 #else /* not WIN32_NATIVE */
1553 || IS_DIRECTORY_SEP (p[0])
1554 #endif /* not WIN32_NATIVE */
1556 /* don't do p[-1] if that would go off the beginning --jwz */
1557 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1]))
1560 else if (IS_DRIVE (p[0]) && p[1] == ':'
1561 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1565 return make_string (xnm, x - xnm);
1568 error ("Bad format environment-variable substitution");
1570 error ("Missing \"}\" in environment-variable substitution");
1572 error ("Substituting nonexistent environment variable \"%s\"",
1576 return Qnil; /* suppress compiler warning */
1579 /* A slightly faster and more convenient way to get
1580 (directory-file-name (expand-file-name FOO)). */
1583 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
1585 /* This function can call lisp */
1586 Lisp_Object abspath;
1587 struct gcpro gcpro1;
1589 abspath = Fexpand_file_name (filename, defdir);
1591 /* Remove final slash, if any (unless path is root).
1592 stat behaves differently depending! */
1593 if (XSTRING_LENGTH (abspath) > 1
1594 && IS_DIRECTORY_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1))
1595 && !IS_DEVICE_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 2)))
1596 /* We cannot take shortcuts; they might be wrong for magic file names. */
1597 abspath = Fdirectory_file_name (abspath);
1602 /* Signal an error if the file ABSNAME already exists.
1603 If INTERACTIVE is nonzero, ask the user whether to proceed,
1604 and bypass the error if the user says to go ahead.
1605 QUERYSTRING is a name for the action that is being considered
1607 *STATPTR is used to store the stat information if the file exists.
1608 If the file does not exist, STATPTR->st_mode is set to 0. */
1611 barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring,
1612 int interactive, struct stat *statptr)
1614 /* This function can GC. GC checked 1997.04.06. */
1615 struct stat statbuf;
1617 /* stat is a good way to tell whether the file exists,
1618 regardless of what access permissions it has. */
1619 if (stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0)
1626 struct gcpro gcpro1;
1628 prompt = emacs_doprnt_string_c
1629 ((const Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "),
1630 Qnil, -1, XSTRING_DATA (absname),
1631 GETTEXT (querystring));
1634 tem = call1 (Qyes_or_no_p, prompt);
1641 Fsignal (Qfile_already_exists,
1642 list2 (build_translated_string ("File already exists"),
1650 statptr->st_mode = 0;
1655 DEFUN ("copy-file", Fcopy_file, 2, 4,
1656 "fCopy file: \nFCopy %s to file: \np\nP", /*
1657 Copy FILE to NEWNAME. Both args must be strings.
1658 Signals a `file-already-exists' error if file NEWNAME already exists,
1659 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
1660 A number as third arg means request confirmation if NEWNAME already exists.
1661 This is what happens in interactive use with M-x.
1662 Fourth arg KEEP-TIME non-nil means give the new file the same
1663 last-modified time as the old one. (This works on only some systems.)
1664 A prefix arg makes KEEP-TIME non-nil.
1666 (filename, newname, ok_if_already_exists, keep_time))
1668 /* This function can GC. GC checked 1997.04.06. */
1670 char buf[16 * 1024];
1671 struct stat st, out_st;
1672 Lisp_Object handler;
1673 int speccount = specpdl_depth ();
1674 struct gcpro gcpro1, gcpro2;
1675 /* Lisp_Object args[6]; */
1676 int input_file_statable_p;
1678 GCPRO2 (filename, newname);
1679 CHECK_STRING (filename);
1680 CHECK_STRING (newname);
1681 filename = Fexpand_file_name (filename, Qnil);
1682 newname = Fexpand_file_name (newname, Qnil);
1684 /* If the input file name has special constructs in it,
1685 call the corresponding file handler. */
1686 handler = Ffind_file_name_handler (filename, Qcopy_file);
1687 /* Likewise for output file name. */
1689 handler = Ffind_file_name_handler (newname, Qcopy_file);
1690 if (!NILP (handler))
1693 return call5 (handler, Qcopy_file, filename, newname,
1694 ok_if_already_exists, keep_time);
1697 /* When second argument is a directory, copy the file into it.
1698 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
1700 if (!NILP (Ffile_directory_p (newname)))
1702 Lisp_Object args[3];
1703 struct gcpro ngcpro1;
1707 args[1] = Qnil; args[2] = Qnil;
1710 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
1711 args[i++] = build_string ("/");
1712 args[i++] = Ffile_name_nondirectory (filename);
1713 newname = Fconcat (i, args);
1717 if (NILP (ok_if_already_exists)
1718 || INTP (ok_if_already_exists))
1719 barf_or_query_if_file_exists (newname, "copy to it",
1720 INTP (ok_if_already_exists), &out_st);
1721 else if (stat ((const char *) XSTRING_DATA (newname), &out_st) < 0)
1724 ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0);
1726 report_file_error ("Opening input file", list1 (filename));
1728 record_unwind_protect (close_file_unwind, make_int (ifd));
1730 /* We can only copy regular files and symbolic links. Other files are not
1732 input_file_statable_p = (fstat (ifd, &st) >= 0);
1734 #ifndef WIN32_NATIVE
1735 if (out_st.st_mode != 0
1736 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
1739 report_file_error ("Input and output files are the same",
1740 list2 (filename, newname));
1744 #if defined (S_ISREG) && defined (S_ISLNK)
1745 if (input_file_statable_p)
1747 if (!(S_ISREG (st.st_mode))
1748 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
1750 && !(S_ISCHR (st.st_mode))
1752 && !(S_ISLNK (st.st_mode)))
1754 #if defined (EISDIR)
1755 /* Get a better looking error message. */
1758 report_file_error ("Non-regular file", list1 (filename));
1761 #endif /* S_ISREG && S_ISLNK */
1763 ofd = open( (char *) XSTRING_DATA (newname),
1764 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
1766 report_file_error ("Opening output file", list1 (newname));
1769 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil);
1771 record_unwind_protect (close_file_unwind, ofd_locative);
1773 while ((n = read_allowing_quit (ifd, buf, sizeof (buf))) > 0)
1775 if (write_allowing_quit (ofd, buf, n) != n)
1776 report_file_error ("I/O error", list1 (newname));
1779 /* Closing the output clobbers the file times on some systems. */
1780 if (close (ofd) < 0)
1781 report_file_error ("I/O error", list1 (newname));
1783 if (input_file_statable_p)
1785 if (!NILP (keep_time))
1787 EMACS_TIME atime, mtime;
1788 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
1789 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
1790 if (set_file_times ((char *) XSTRING_DATA (newname), atime,
1792 report_file_error ("I/O error", list1 (newname));
1794 chmod ((const char *) XSTRING_DATA (newname),
1795 st.st_mode & 07777);
1798 /* We'll close it by hand */
1799 XCAR (ofd_locative) = Qnil;
1802 unbind_to (speccount, Qnil);
1809 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
1810 Create a directory. One argument, a file name string.
1814 /* This function can GC. GC checked 1997.04.06. */
1815 char dir [MAXPATHLEN];
1816 Lisp_Object handler;
1817 struct gcpro gcpro1;
1819 CHECK_STRING (dirname_);
1820 dirname_ = Fexpand_file_name (dirname_, Qnil);
1823 handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal);
1825 if (!NILP (handler))
1826 return (call2 (handler, Qmake_directory_internal, dirname_));
1828 if (XSTRING_LENGTH (dirname_) > (Bytecount) (sizeof (dir) - 1))
1830 return Fsignal (Qfile_error,
1831 list3 (build_translated_string ("Creating directory"),
1832 build_translated_string ("pathname too long"),
1835 strncpy (dir, (char *) XSTRING_DATA (dirname_),
1836 XSTRING_LENGTH (dirname_) + 1);
1838 if (dir [XSTRING_LENGTH (dirname_) - 1] == '/')
1839 dir [XSTRING_LENGTH (dirname_) - 1] = 0;
1841 if (mkdir (dir, 0777) != 0)
1842 report_file_error ("Creating directory", list1 (dirname_));
1847 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
1848 Delete a directory. One argument, a file name or directory name string.
1852 /* This function can GC. GC checked 1997.04.06. */
1853 Lisp_Object handler;
1854 struct gcpro gcpro1;
1856 CHECK_STRING (dirname_);
1859 dirname_ = Fexpand_file_name (dirname_, Qnil);
1860 dirname_ = Fdirectory_file_name (dirname_);
1862 handler = Ffind_file_name_handler (dirname_, Qdelete_directory);
1864 if (!NILP (handler))
1865 return (call2 (handler, Qdelete_directory, dirname_));
1867 if (rmdir ((char *) XSTRING_DATA (dirname_)) != 0)
1868 report_file_error ("Removing directory", list1 (dirname_));
1873 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
1874 Delete the file named FILENAME (a string).
1875 If FILENAME has multiple names, it continues to exist with the other names.
1879 /* This function can GC. GC checked 1997.04.06. */
1880 Lisp_Object handler;
1881 struct gcpro gcpro1;
1883 CHECK_STRING (filename);
1884 filename = Fexpand_file_name (filename, Qnil);
1887 handler = Ffind_file_name_handler (filename, Qdelete_file);
1889 if (!NILP (handler))
1890 return call2 (handler, Qdelete_file, filename);
1892 if (0 > unlink ((char *) XSTRING_DATA (filename)))
1893 report_file_error ("Removing old name", list1 (filename));
1898 internal_delete_file_1 (Lisp_Object ignore, Lisp_Object ignore2)
1903 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1906 internal_delete_file (Lisp_Object filename)
1908 /* This function can GC. GC checked 1997.04.06. */
1909 return NILP (condition_case_1 (Qt, Fdelete_file, filename,
1910 internal_delete_file_1, Qnil));
1913 DEFUN ("rename-file", Frename_file, 2, 3,
1914 "fRename file: \nFRename %s to file: \np", /*
1915 Rename FILE as NEWNAME. Both args strings.
1916 If file has names other than FILE, it continues to have those names.
1917 Signals a `file-already-exists' error if a file NEWNAME already exists
1918 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1919 A number as third arg means request confirmation if NEWNAME already exists.
1920 This is what happens in interactive use with M-x.
1922 (filename, newname, ok_if_already_exists))
1924 /* This function can GC. GC checked 1997.04.06. */
1925 Lisp_Object handler;
1926 struct gcpro gcpro1, gcpro2;
1928 GCPRO2 (filename, newname);
1929 CHECK_STRING (filename);
1930 CHECK_STRING (newname);
1931 filename = Fexpand_file_name (filename, Qnil);
1932 newname = Fexpand_file_name (newname, Qnil);
1934 /* If the file name has special constructs in it,
1935 call the corresponding file handler. */
1936 handler = Ffind_file_name_handler (filename, Qrename_file);
1938 handler = Ffind_file_name_handler (newname, Qrename_file);
1939 if (!NILP (handler))
1942 return call4 (handler, Qrename_file,
1943 filename, newname, ok_if_already_exists);
1946 /* When second argument is a directory, rename the file into it.
1947 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
1949 if (!NILP (Ffile_directory_p (newname)))
1951 Lisp_Object args[3];
1952 struct gcpro ngcpro1;
1956 args[1] = Qnil; args[2] = Qnil;
1959 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
1960 args[i++] = build_string ("/");
1961 args[i++] = Ffile_name_nondirectory (filename);
1962 newname = Fconcat (i, args);
1966 if (NILP (ok_if_already_exists)
1967 || INTP (ok_if_already_exists))
1968 barf_or_query_if_file_exists (newname, "rename to it",
1969 INTP (ok_if_already_exists), 0);
1971 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
1972 WIN32_NATIVE here; I've removed it. --marcpa */
1974 /* We have configure check for rename() and emulate using
1975 link()/unlink() if necessary. */
1976 if (0 > rename ((char *) XSTRING_DATA (filename),
1977 (char *) XSTRING_DATA (newname)))
1981 Fcopy_file (filename, newname,
1982 /* We have already prompted if it was an integer,
1983 so don't have copy-file prompt again. */
1984 (NILP (ok_if_already_exists) ? Qnil : Qt),
1986 Fdelete_file (filename);
1990 report_file_error ("Renaming", list2 (filename, newname));
1997 DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3,
1998 "fAdd name to file: \nFName to add to %s: \np", /*
1999 Give FILE additional name NEWNAME. Both args strings.
2000 Signals a `file-already-exists' error if a file NEWNAME already exists
2001 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2002 A number as third arg means request confirmation if NEWNAME already exists.
2003 This is what happens in interactive use with M-x.
2005 (filename, newname, ok_if_already_exists))
2007 /* This function can GC. GC checked 1997.04.06. */
2008 Lisp_Object handler;
2009 struct gcpro gcpro1, gcpro2;
2011 GCPRO2 (filename, newname);
2012 CHECK_STRING (filename);
2013 CHECK_STRING (newname);
2014 filename = Fexpand_file_name (filename, Qnil);
2015 newname = Fexpand_file_name (newname, Qnil);
2017 /* If the file name has special constructs in it,
2018 call the corresponding file handler. */
2019 handler = Ffind_file_name_handler (filename, Qadd_name_to_file);
2020 if (!NILP (handler))
2021 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2022 newname, ok_if_already_exists));
2024 /* If the new name has special constructs in it,
2025 call the corresponding file handler. */
2026 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2027 if (!NILP (handler))
2028 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2029 newname, ok_if_already_exists));
2031 if (NILP (ok_if_already_exists)
2032 || INTP (ok_if_already_exists))
2033 barf_or_query_if_file_exists (newname, "make it a new name",
2034 INTP (ok_if_already_exists), 0);
2035 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
2036 on NT here. --marcpa */
2037 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
2038 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
2039 Reverted to previous behavior pending a working fix. (jhar) */
2040 #if defined(WIN32_NATIVE)
2041 /* Windows does not support this operation. */
2042 report_file_error ("Adding new name", Flist (2, &filename));
2043 #else /* not defined(WIN32_NATIVE) */
2045 unlink ((char *) XSTRING_DATA (newname));
2046 if (0 > link ((char *) XSTRING_DATA (filename),
2047 (char *) XSTRING_DATA (newname)))
2049 report_file_error ("Adding new name",
2050 list2 (filename, newname));
2052 #endif /* defined(WIN32_NATIVE) */
2058 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3,
2059 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
2060 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2061 Signals a `file-already-exists' error if a file LINKNAME already exists
2062 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2063 A number as third arg means request confirmation if LINKNAME already exists.
2064 This happens for interactive use with M-x.
2066 (filename, linkname, ok_if_already_exists))
2068 /* This function can GC. GC checked 1997.06.04. */
2069 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2070 Lisp_Object handler;
2071 struct gcpro gcpro1, gcpro2;
2073 GCPRO2 (filename, linkname);
2074 CHECK_STRING (filename);
2075 CHECK_STRING (linkname);
2076 /* If the link target has a ~, we must expand it to get
2077 a truly valid file name. Otherwise, do not expand;
2078 we want to permit links to relative file names. */
2079 if (XSTRING_BYTE (filename, 0) == '~')
2080 filename = Fexpand_file_name (filename, Qnil);
2081 linkname = Fexpand_file_name (linkname, Qnil);
2083 /* If the file name has special constructs in it,
2084 call the corresponding file handler. */
2085 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
2086 if (!NILP (handler))
2087 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname,
2088 ok_if_already_exists));
2090 /* If the new link name has special constructs in it,
2091 call the corresponding file handler. */
2092 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2093 if (!NILP (handler))
2094 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2095 linkname, ok_if_already_exists));
2098 if (NILP (ok_if_already_exists)
2099 || INTP (ok_if_already_exists))
2100 barf_or_query_if_file_exists (linkname, "make it a link",
2101 INTP (ok_if_already_exists), 0);
2103 unlink ((char *) XSTRING_DATA (linkname));
2104 if (0 > symlink ((char *) XSTRING_DATA (filename),
2105 (char *) XSTRING_DATA (linkname)))
2107 report_file_error ("Making symbolic link",
2108 list2 (filename, linkname));
2110 #endif /* S_IFLNK */
2118 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
2119 Open a network connection to PATH using LOGIN as the login string.
2124 const char *path_ext;
2125 const char *login_ext;
2127 CHECK_STRING (path);
2128 CHECK_STRING (login);
2130 /* netunam, being a strange-o system call only used once, is not
2133 TO_EXTERNAL_FORMAT (LISP_STRING, path, C_STRING_ALLOCA, path_ext, Qfile_name);
2134 TO_EXTERNAL_FORMAT (LISP_STRING, login, C_STRING_ALLOCA, login_ext, Qnative);
2136 netresult = netunam (path_ext, login_ext);
2138 return netresult == -1 ? Qnil : Qt;
2140 #endif /* HPUX_NET */
2142 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
2143 Return t if file FILENAME specifies an absolute path name.
2144 On Unix, this is a name starting with a `/' or a `~'.
2148 /* This function does not GC */
2151 CHECK_STRING (filename);
2152 ptr = XSTRING_DATA (filename);
2153 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
2155 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
2160 /* Return nonzero if file FILENAME exists and can be executed. */
2163 check_executable (char *filename)
2167 if (stat (filename, &st) < 0)
2169 return ((st.st_mode & S_IEXEC) != 0);
2170 #else /* not WIN32_NATIVE */
2172 return eaccess (filename, 1) >= 0;
2174 /* Access isn't quite right because it uses the real uid
2175 and we really want to test with the effective uid.
2176 But Unix doesn't give us a right way to do it. */
2177 return access (filename, 1) >= 0;
2178 #endif /* HAVE_EACCESS */
2179 #endif /* not WIN32_NATIVE */
2182 /* Return nonzero if file FILENAME exists and can be written. */
2185 check_writable (const char *filename)
2188 return (eaccess (filename, 2) >= 0);
2190 /* Access isn't quite right because it uses the real uid
2191 and we really want to test with the effective uid.
2192 But Unix doesn't give us a right way to do it.
2193 Opening with O_WRONLY could work for an ordinary file,
2194 but would lose for directories. */
2195 return (access (filename, 2) >= 0);
2199 DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
2200 Return t if file FILENAME exists. (This does not mean you can read it.)
2201 See also `file-readable-p' and `file-attributes'.
2205 /* This function can call lisp */
2206 Lisp_Object abspath;
2207 Lisp_Object handler;
2208 struct stat statbuf;
2209 struct gcpro gcpro1;
2211 CHECK_STRING (filename);
2212 abspath = Fexpand_file_name (filename, Qnil);
2214 /* If the file name has special constructs in it,
2215 call the corresponding file handler. */
2217 handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
2219 if (!NILP (handler))
2220 return call2 (handler, Qfile_exists_p, abspath);
2222 return stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
2225 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
2226 Return t if FILENAME can be executed by you.
2227 For a directory, this means you can access files in that directory.
2232 /* This function can GC. GC checked 1997.04.10. */
2233 Lisp_Object abspath;
2234 Lisp_Object handler;
2235 struct gcpro gcpro1;
2237 CHECK_STRING (filename);
2238 abspath = Fexpand_file_name (filename, Qnil);
2240 /* If the file name has special constructs in it,
2241 call the corresponding file handler. */
2243 handler = Ffind_file_name_handler (abspath, Qfile_executable_p);
2245 if (!NILP (handler))
2246 return call2 (handler, Qfile_executable_p, abspath);
2248 return check_executable ((char *) XSTRING_DATA (abspath)) ? Qt : Qnil;
2251 DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
2252 Return t if file FILENAME exists and you can read it.
2253 See also `file-exists-p' and `file-attributes'.
2257 /* This function can GC */
2258 Lisp_Object abspath = Qnil;
2259 Lisp_Object handler;
2260 struct gcpro gcpro1;
2263 CHECK_STRING (filename);
2264 abspath = Fexpand_file_name (filename, Qnil);
2266 /* If the file name has special constructs in it,
2267 call the corresponding file handler. */
2268 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
2269 if (!NILP (handler))
2270 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
2272 #if defined(WIN32_NATIVE) || defined(CYGWIN)
2273 /* Under MS-DOS and Windows, open does not work for directories. */
2275 if (access (XSTRING_DATA (abspath), 0) == 0)
2279 #else /* not WIN32_NATIVE */
2281 int desc = interruptible_open ((char *) XSTRING_DATA (abspath), O_RDONLY | OPEN_BINARY, 0);
2288 #endif /* not WIN32_NATIVE */
2291 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2293 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
2294 Return t if file FILENAME can be written or created by you.
2298 /* This function can GC. GC checked 1997.04.10. */
2299 Lisp_Object abspath, dir;
2300 Lisp_Object handler;
2301 struct stat statbuf;
2302 struct gcpro gcpro1;
2304 CHECK_STRING (filename);
2305 abspath = Fexpand_file_name (filename, Qnil);
2307 /* If the file name has special constructs in it,
2308 call the corresponding file handler. */
2310 handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
2312 if (!NILP (handler))
2313 return call2 (handler, Qfile_writable_p, abspath);
2315 if (stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0)
2316 return (check_writable ((char *) XSTRING_DATA (abspath))
2321 dir = Ffile_name_directory (abspath);
2323 return (check_writable (!NILP (dir) ? (char *) XSTRING_DATA (dir)
2328 DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
2329 Return non-nil if file FILENAME is the name of a symbolic link.
2330 The value is the name of the file to which it is linked.
2331 Otherwise returns nil.
2335 /* This function can GC. GC checked 1997.04.10. */
2336 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2343 Lisp_Object handler;
2344 struct gcpro gcpro1;
2346 CHECK_STRING (filename);
2347 filename = Fexpand_file_name (filename, Qnil);
2349 /* If the file name has special constructs in it,
2350 call the corresponding file handler. */
2352 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
2354 if (!NILP (handler))
2355 return call2 (handler, Qfile_symlink_p, filename);
2361 buf = xnew_array_and_zero (char, bufsize);
2362 valsize = readlink ((char *) XSTRING_DATA (filename),
2364 if (valsize < bufsize) break;
2365 /* Buffer was not long enough */
2374 val = make_string ((Bufbyte *) buf, valsize);
2377 #else /* not S_IFLNK */
2379 #endif /* not S_IFLNK */
2382 DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
2383 Return t if file FILENAME is the name of a directory as a file.
2384 A directory name spec may be given instead; then the value is t
2385 if the directory so specified exists and really is a directory.
2389 /* This function can GC. GC checked 1997.04.10. */
2390 Lisp_Object abspath;
2392 Lisp_Object handler;
2393 struct gcpro gcpro1;
2395 GCPRO1 (current_buffer->directory);
2396 abspath = expand_and_dir_to_file (filename,
2397 current_buffer->directory);
2400 /* If the file name has special constructs in it,
2401 call the corresponding file handler. */
2403 handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
2405 if (!NILP (handler))
2406 return call2 (handler, Qfile_directory_p, abspath);
2408 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2410 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2413 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
2414 Return t if file FILENAME is the name of a directory as a file,
2415 and files in that directory can be opened by you. In order to use a
2416 directory as a buffer's current directory, this predicate must return true.
2417 A directory name spec may be given instead; then the value is t
2418 if the directory so specified exists and really is a readable and
2419 searchable directory.
2423 /* This function can GC. GC checked 1997.04.10. */
2424 Lisp_Object handler;
2426 /* If the file name has special constructs in it,
2427 call the corresponding file handler. */
2428 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
2429 if (!NILP (handler))
2430 return call2 (handler, Qfile_accessible_directory_p,
2433 #if !defined(WIN32_NATIVE)
2434 if (NILP (Ffile_directory_p (filename)))
2437 return Ffile_executable_p (filename);
2441 struct gcpro gcpro1;
2442 /* It's an unlikely combination, but yes we really do need to gcpro:
2443 Suppose that file-accessible-directory-p has no handler, but
2444 file-directory-p does have a handler; this handler causes a GC which
2445 relocates the string in `filename'; and finally file-directory-p
2446 returns non-nil. Then we would end up passing a garbaged string
2447 to file-executable-p. */
2449 tem = (NILP (Ffile_directory_p (filename))
2450 || NILP (Ffile_executable_p (filename)));
2452 return tem ? Qnil : Qt;
2454 #endif /* !defined(WIN32_NATIVE) */
2457 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
2458 Return t if file FILENAME is the name of a regular file.
2459 This is the sort of file that holds an ordinary stream of data bytes.
2463 /* This function can GC. GC checked 1997.04.10. */
2464 Lisp_Object abspath;
2466 Lisp_Object handler;
2467 struct gcpro gcpro1;
2469 GCPRO1 (current_buffer->directory);
2470 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
2473 /* If the file name has special constructs in it,
2474 call the corresponding file handler. */
2476 handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
2478 if (!NILP (handler))
2479 return call2 (handler, Qfile_regular_p, abspath);
2481 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2483 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2486 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
2487 Return mode bits of FILE, as an integer.
2491 /* This function can GC. GC checked 1997.04.10. */
2492 Lisp_Object abspath;
2494 Lisp_Object handler;
2495 struct gcpro gcpro1;
2497 GCPRO1 (current_buffer->directory);
2498 abspath = expand_and_dir_to_file (filename,
2499 current_buffer->directory);
2502 /* If the file name has special constructs in it,
2503 call the corresponding file handler. */
2505 handler = Ffind_file_name_handler (abspath, Qfile_modes);
2507 if (!NILP (handler))
2508 return call2 (handler, Qfile_modes, abspath);
2510 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2512 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
2515 if (check_executable (XSTRING_DATA (abspath)))
2516 st.st_mode |= S_IEXEC;
2517 #endif /* WIN32_NATIVE */
2520 return make_int (st.st_mode & 07777);
2523 DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /*
2524 Set mode bits of FILE to MODE (an integer).
2525 Only the 12 low bits of MODE are used.
2529 /* This function can GC. GC checked 1997.04.10. */
2530 Lisp_Object abspath;
2531 Lisp_Object handler;
2532 struct gcpro gcpro1;
2534 GCPRO1 (current_buffer->directory);
2535 abspath = Fexpand_file_name (filename, current_buffer->directory);
2540 /* If the file name has special constructs in it,
2541 call the corresponding file handler. */
2543 handler = Ffind_file_name_handler (abspath, Qset_file_modes);
2545 if (!NILP (handler))
2546 return call3 (handler, Qset_file_modes, abspath, mode);
2548 if (chmod ((char *) XSTRING_DATA (abspath), XINT (mode)) < 0)
2549 report_file_error ("Doing chmod", list1 (abspath));
2554 DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
2555 Set the file permission bits for newly created files.
2556 MASK should be an integer; if a permission's bit in MASK is 1,
2557 subsequently created files will not have that permission enabled.
2558 Only the low 9 bits are used.
2559 This setting is inherited by subprocesses.
2565 umask ((~ XINT (mode)) & 0777);
2570 DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
2571 Return the default file protection for created files.
2572 The umask value determines which permissions are enabled in newly
2573 created files. If a permission's bit in the umask is 1, subsequently
2574 created files will not have that permission enabled.
2583 return make_int ((~ mode) & 0777);
2586 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /*
2587 Tell Unix to finish all pending disk updates.
2591 #ifndef WIN32_NATIVE
2598 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
2599 Return t if file FILE1 is newer than file FILE2.
2600 If FILE1 does not exist, the answer is nil;
2601 otherwise, if FILE2 does not exist, the answer is t.
2605 /* This function can GC. GC checked 1997.04.10. */
2606 Lisp_Object abspath1, abspath2;
2609 Lisp_Object handler;
2610 struct gcpro gcpro1, gcpro2, gcpro3;
2612 CHECK_STRING (file1);
2613 CHECK_STRING (file2);
2618 GCPRO3 (abspath1, abspath2, current_buffer->directory);
2619 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
2620 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
2622 /* If the file name has special constructs in it,
2623 call the corresponding file handler. */
2624 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p);
2626 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p);
2628 if (!NILP (handler))
2629 return call3 (handler, Qfile_newer_than_file_p, abspath1,
2632 if (stat ((char *) XSTRING_DATA (abspath1), &st) < 0)
2635 mtime1 = st.st_mtime;
2637 if (stat ((char *) XSTRING_DATA (abspath2), &st) < 0)
2640 return (mtime1 > st.st_mtime) ? Qt : Qnil;
2644 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
2645 /* #define READ_BUF_SIZE (2 << 16) */
2646 #define READ_BUF_SIZE (1 << 15)
2648 DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal,
2650 Insert contents of file FILENAME after point; no coding-system frobbing.
2651 This function is identical to `insert-file-contents' except for the
2652 handling of the CODESYS and USED-CODESYS arguments under
2653 XEmacs/Mule. (When Mule support is not present, both functions are
2654 identical and ignore the CODESYS and USED-CODESYS arguments.)
2656 If support for Mule exists in this Emacs, the file is decoded according
2657 to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil,
2658 it should be a symbol, and the actual coding system that was used for the
2659 decoding is stored into it. It will in general be different from CODESYS
2660 if CODESYS specifies automatic encoding detection or end-of-line detection.
2662 Currently BEG and END refer to byte positions (as opposed to character
2663 positions), even in Mule. (Fixing this is very difficult.)
2665 (filename, visit, beg, end, replace, codesys, used_codesys))
2667 /* This function can call lisp */
2668 /* #### dmoore - this function hasn't been checked for gc recently */
2672 Charcount inserted = 0;
2674 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2675 Lisp_Object handler = Qnil, val;
2677 Bufbyte read_buf[READ_BUF_SIZE];
2679 struct buffer *buf = current_buffer;
2681 int not_regular = 0;
2683 if (buf->base_buffer && ! NILP (visit))
2684 error ("Cannot do file visiting in an indirect buffer");
2686 /* No need to call Fbarf_if_buffer_read_only() here.
2687 That's called in begin_multiple_change() or wherever. */
2691 /* #### dmoore - should probably check in various places to see if
2692 curbuf was killed and if so signal an error? */
2694 XSETBUFFER (curbuf, buf);
2696 GCPRO5 (filename, val, visit, handler, curbuf);
2698 mc_count = (NILP (replace)) ?
2699 begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) :
2700 begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf));
2702 speccount = specpdl_depth (); /* begin_multiple_change also adds
2703 an unwind_protect */
2705 filename = Fexpand_file_name (filename, Qnil);
2707 /* If the file name has special constructs in it,
2708 call the corresponding file handler. */
2709 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
2710 if (!NILP (handler))
2712 val = call6 (handler, Qinsert_file_contents, filename,
2713 visit, beg, end, replace);
2718 if (!NILP (used_codesys))
2719 CHECK_SYMBOL (used_codesys);
2722 if ( (!NILP (beg) || !NILP (end)) && !NILP (visit) )
2723 error ("Attempt to visit less than an entire file");
2727 if (stat ((char *) XSTRING_DATA (filename), &st) < 0)
2729 if (fd >= 0) close (fd);
2732 report_file_error ("Opening input file", list1 (filename));
2738 /* Signal an error if we are accessing a non-regular file, with
2739 REPLACE, BEG or END being non-nil. */
2740 if (!S_ISREG (st.st_mode))
2747 if (!NILP (replace) || !NILP (beg) || !NILP (end))
2749 end_multiple_change (buf, mc_count);
2751 return Fsignal (Qfile_error,
2752 list2 (build_translated_string("not a regular file"),
2756 #endif /* S_IFREG */
2768 if ((fd = interruptible_open ((char *) XSTRING_DATA (filename),
2769 O_RDONLY | OPEN_BINARY, 0)) < 0)
2773 /* Replacement should preserve point as it preserves markers. */
2774 if (!NILP (replace))
2775 record_unwind_protect (restore_point_unwind, Fpoint_marker (Qnil, Qnil));
2777 record_unwind_protect (close_file_unwind, make_int (fd));
2779 /* Supposedly happens on VMS. */
2781 error ("File size is negative");
2787 end = make_int (st.st_size);
2788 if (XINT (end) != st.st_size)
2789 error ("Maximum buffer size exceeded");
2793 /* If requested, replace the accessible part of the buffer
2794 with the file contents. Avoid replacing text at the
2795 beginning or end of the buffer that matches the file contents;
2796 that preserves markers pointing to the unchanged parts. */
2797 #if !defined (FILE_CODING)
2798 /* The replace-mode code currently only works when the assumption
2799 'one byte == one char' holds true. This fails Mule because
2800 files may contain multibyte characters. It holds under Windows NT
2801 provided we convert CRLF into LF. */
2802 # define FSFMACS_SPEEDY_INSERT
2803 #endif /* !defined (FILE_CODING) */
2805 #ifndef FSFMACS_SPEEDY_INSERT
2806 if (!NILP (replace))
2808 buffer_delete_range (buf, BUF_BEG (buf), BUF_Z (buf),
2809 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2811 #else /* FSFMACS_SPEEDY_INSERT */
2812 if (!NILP (replace))
2814 char buffer[1 << 14];
2815 Bufpos same_at_start = BUF_BEGV (buf);
2816 Bufpos same_at_end = BUF_ZV (buf);
2819 /* Count how many chars at the start of the file
2820 match the text at the beginning of the buffer. */
2825 nread = read_allowing_quit (fd, buffer, sizeof buffer);
2827 error ("IO error reading %s: %s",
2828 XSTRING_DATA (filename), strerror (errno));
2829 else if (nread == 0)
2832 while (bufpos < nread && same_at_start < BUF_ZV (buf)
2833 && BUF_FETCH_CHAR (buf, same_at_start) == buffer[bufpos])
2834 same_at_start++, bufpos++;
2835 /* If we found a discrepancy, stop the scan.
2836 Otherwise loop around and scan the next bufferful. */
2837 if (bufpos != nread)
2840 /* If the file matches the buffer completely,
2841 there's no need to replace anything. */
2842 if (same_at_start - BUF_BEGV (buf) == st.st_size)
2845 unbind_to (speccount, Qnil);
2846 /* Truncate the buffer to the size of the file. */
2847 buffer_delete_range (buf, same_at_start, same_at_end,
2848 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2851 /* Count how many chars at the end of the file
2852 match the text at the end of the buffer. */
2855 int total_read, nread;
2856 Bufpos bufpos, curpos, trial;
2858 /* At what file position are we now scanning? */
2859 curpos = st.st_size - (BUF_ZV (buf) - same_at_end);
2860 /* If the entire file matches the buffer tail, stop the scan. */
2863 /* How much can we scan in the next step? */
2864 trial = min (curpos, (Bufpos) sizeof (buffer));
2865 if (lseek (fd, curpos - trial, 0) < 0)
2866 report_file_error ("Setting file position", list1 (filename));
2869 while (total_read < trial)
2871 nread = read_allowing_quit (fd, buffer + total_read,
2872 trial - total_read);
2874 report_file_error ("IO error reading file", list1 (filename));
2875 total_read += nread;
2877 /* Scan this bufferful from the end, comparing with
2878 the Emacs buffer. */
2879 bufpos = total_read;
2880 /* Compare with same_at_start to avoid counting some buffer text
2881 as matching both at the file's beginning and at the end. */
2882 while (bufpos > 0 && same_at_end > same_at_start
2883 && BUF_FETCH_CHAR (buf, same_at_end - 1) ==
2885 same_at_end--, bufpos--;
2886 /* If we found a discrepancy, stop the scan.
2887 Otherwise loop around and scan the preceding bufferful. */
2890 /* If display current starts at beginning of line,
2891 keep it that way. */
2892 if (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == buf)
2893 XWINDOW (Fselected_window (Qnil))->start_at_line_beg =
2894 !NILP (Fbolp (make_buffer (buf)));
2897 /* Don't try to reuse the same piece of text twice. */
2898 overlap = same_at_start - BUF_BEGV (buf) -
2899 (same_at_end + st.st_size - BUF_ZV (buf));
2901 same_at_end += overlap;
2903 /* Arrange to read only the nonmatching middle part of the file. */
2904 beg = make_int (same_at_start - BUF_BEGV (buf));
2905 end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end));
2907 buffer_delete_range (buf, same_at_start, same_at_end,
2908 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2909 /* Insert from the file at the proper position. */
2910 BUF_SET_PT (buf, same_at_start);
2912 #endif /* FSFMACS_SPEEDY_INSERT */
2916 total = XINT (end) - XINT (beg);
2918 /* Make sure point-max won't overflow after this insertion. */
2919 if (total != XINT (make_int (total)))
2920 error ("Maximum buffer size exceeded");
2923 /* For a special file, all we can do is guess. The value of -1
2924 will make the stream functions read as much as possible. */
2928 #ifdef FSFMACS_SPEEDY_INSERT
2929 /* why was this here? asked jwz. The reason is that the replace-mode
2930 connivings above will normally put the file pointer other than
2931 where it should be. */
2933 #endif /* !FSFMACS_SPEEDY_INSERT */
2936 if (lseek (fd, XINT (beg), 0) < 0)
2937 report_file_error ("Setting file position", list1 (filename));
2941 Bufpos cur_point = BUF_PT (buf);
2942 struct gcpro ngcpro1;
2943 Lisp_Object stream = make_filedesc_input_stream (fd, 0, total,
2947 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2949 stream = make_decoding_input_stream
2950 (XLSTREAM (stream), Fget_coding_system (codesys));
2951 Lstream_set_character_mode (XLSTREAM (stream));
2952 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2953 #endif /* FILE_CODING */
2955 record_unwind_protect (delete_stream_unwind, stream);
2957 /* No need to limit the amount of stuff we attempt to read. (It would
2958 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
2959 occurs inside of the filedesc stream. */
2963 Charcount cc_inserted;
2966 this_len = Lstream_read (XLSTREAM (stream), read_buf,
2976 cc_inserted = buffer_insert_raw_string_1 (buf, cur_point, read_buf,
2979 ? INSDEL_NO_LOCKING : 0);
2980 inserted += cc_inserted;
2981 cur_point += cc_inserted;
2984 if (!NILP (used_codesys))
2987 XCODING_SYSTEM_NAME (decoding_stream_coding_system (XLSTREAM (stream))));
2989 #endif /* FILE_CODING */
2993 /* Close the file/stream */
2994 unbind_to (speccount, Qnil);
2998 error ("IO error reading %s: %s",
2999 XSTRING_DATA (filename), strerror (saverrno));
3005 end_multiple_change (buf, mc_count);
3009 if (!EQ (buf->undo_list, Qt))
3010 buf->undo_list = Qnil;
3013 buf->modtime = st.st_mtime;
3014 buf->filename = filename;
3015 /* XEmacs addition: */
3016 /* This function used to be in C, ostensibly so that
3017 it could be called here. But that's just silly.
3018 There's no reason C code can't call out to Lisp
3019 code, and it's a lot cleaner this way. */
3020 if (!NILP (Ffboundp (Qcompute_buffer_file_truename)))
3021 call1 (Qcompute_buffer_file_truename, make_buffer (buf));
3023 BUF_SAVE_MODIFF (buf) = BUF_MODIFF (buf);
3024 buf->auto_save_modified = BUF_MODIFF (buf);
3025 buf->saved_size = make_int (BUF_SIZE (buf));
3026 #ifdef CLASH_DETECTION
3029 if (!NILP (buf->file_truename))
3030 unlock_file (buf->file_truename);
3031 unlock_file (filename);
3033 #endif /* CLASH_DETECTION */
3035 RETURN_UNGCPRO (Fsignal (Qfile_error,
3036 list2 (build_string ("not a regular file"),
3039 /* If visiting nonexistent file, return nil. */
3040 if (buf->modtime == -1)
3041 report_file_error ("Opening input file",
3045 /* Decode file format */
3048 Lisp_Object insval = call3 (Qformat_decode,
3049 Qnil, make_int (inserted), visit);
3051 inserted = XINT (insval);
3057 struct gcpro ngcpro1;
3060 EXTERNAL_LIST_LOOP (p, Vafter_insert_file_functions)
3062 Lisp_Object insval =
3063 call1 (XCAR (p), make_int (inserted));
3066 CHECK_NATNUM (insval);
3067 inserted = XINT (insval);
3079 return (list2 (filename, make_int (inserted)));
3083 static int a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3084 Lisp_Object *annot);
3085 static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end);
3087 /* If build_annotations switched buffers, switch back to BUF.
3088 Kill the temporary buffer that was selected in the meantime. */
3091 build_annotations_unwind (Lisp_Object buf)
3095 if (XBUFFER (buf) == current_buffer)
3097 tembuf = Fcurrent_buffer ();
3099 Fkill_buffer (tembuf);
3103 DEFUN ("write-region-internal", Fwrite_region_internal, 3, 7,
3104 "r\nFWrite region to file: ", /*
3105 Write current region into specified file; no coding-system frobbing.
3106 This function is identical to `write-region' except for the handling
3107 of the CODESYS argument under XEmacs/Mule. (When Mule support is not
3108 present, both functions are identical and ignore the CODESYS argument.)
3109 If support for Mule exists in this Emacs, the file is encoded according
3110 to the value of CODESYS. If this is nil, no code conversion occurs.
3112 (start, end, filename, append, visit, lockname, codesys))
3114 /* This function can call lisp */
3120 int speccount = specpdl_depth ();
3121 int visiting_other = STRINGP (visit);
3122 int visiting = (EQ (visit, Qt) || visiting_other);
3123 int quietly = (!visiting && !NILP (visit));
3124 Lisp_Object visit_file = Qnil;
3125 Lisp_Object annotations = Qnil;
3126 struct buffer *given_buffer;
3127 Bufpos start1, end1;
3129 /* #### dmoore - if Fexpand_file_name or handlers kill the buffer,
3130 we should signal an error rather than blissfully continuing
3131 along. ARGH, this function is going to lose lose lose. We need
3132 to protect the current_buffer from being destroyed, but the
3133 multiple return points make this a pain in the butt. */
3136 codesys = Fget_coding_system (codesys);
3137 #endif /* FILE_CODING */
3139 if (current_buffer->base_buffer && ! NILP (visit))
3140 error ("Cannot do file visiting in an indirect buffer");
3142 if (!NILP (start) && !STRINGP (start))
3143 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0);
3146 Lisp_Object handler;
3147 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3149 GCPRO5 (start, filename, visit, visit_file, lockname);
3152 visit_file = Fexpand_file_name (visit, Qnil);
3154 visit_file = filename;
3155 filename = Fexpand_file_name (filename, Qnil);
3159 if (NILP (lockname))
3160 lockname = visit_file;
3162 /* If the file name has special constructs in it,
3163 call the corresponding file handler. */
3164 handler = Ffind_file_name_handler (filename, Qwrite_region);
3165 /* If FILENAME has no handler, see if VISIT has one. */
3166 if (NILP (handler) && STRINGP (visit))
3167 handler = Ffind_file_name_handler (visit, Qwrite_region);
3169 if (!NILP (handler))
3171 Lisp_Object val = call8 (handler, Qwrite_region, start, end,
3172 filename, append, visit, lockname, codesys);
3175 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3176 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3177 current_buffer->filename = visit_file;
3178 MARK_MODELINE_CHANGED;
3184 #ifdef CLASH_DETECTION
3188 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3190 XSETBUFFER (curbuf, current_buffer);
3191 GCPRO5 (start, filename, visit_file, lockname, curbuf);
3192 lock_file (lockname);
3195 #endif /* CLASH_DETECTION */
3197 /* Special kludge to simplify auto-saving. */
3200 start1 = BUF_BEG (current_buffer);
3201 end1 = BUF_Z (current_buffer);
3204 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
3206 given_buffer = current_buffer;
3207 annotations = build_annotations (start, end);
3208 if (current_buffer != given_buffer)
3210 start1 = BUF_BEGV (current_buffer);
3211 end1 = BUF_ZV (current_buffer);
3218 desc = open ((char *) XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0);
3222 desc = open ((char *) XSTRING_DATA (fn),
3223 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
3224 auto_saving ? auto_save_mode_bits : CREAT_MODE);
3229 #ifdef CLASH_DETECTION
3231 if (!auto_saving) unlock_file (lockname);
3233 #endif /* CLASH_DETECTION */
3234 report_file_error ("Opening output file", list1 (filename));
3238 Lisp_Object desc_locative = Fcons (make_int (desc), Qnil);
3239 Lisp_Object instream = Qnil, outstream = Qnil;
3240 struct gcpro gcpro1, gcpro2;
3241 /* need to gcpro; QUIT could happen out of call to write() */
3242 GCPRO2 (instream, outstream);
3244 record_unwind_protect (close_file_unwind, desc_locative);
3248 if (lseek (desc, 0, 2) < 0)
3250 #ifdef CLASH_DETECTION
3251 if (!auto_saving) unlock_file (lockname);
3252 #endif /* CLASH_DETECTION */
3253 report_file_error ("Lseek error",
3260 /* Note: I tried increasing the buffering size, along with
3261 various other tricks, but nothing seemed to make much of
3262 a difference in the time it took to save a large file.
3263 (Actually that's not true. With a local disk, changing
3264 the buffer size doesn't seem to make much difference.
3265 With an NFS-mounted disk, it could make a lot of difference
3266 because you're affecting the number of network requests
3267 that need to be made, and there could be a large latency
3268 for each request. So I've increased the buffer size
3270 outstream = make_filedesc_output_stream (desc, 0, -1, 0);
3271 Lstream_set_buffering (XLSTREAM (outstream),
3272 LSTREAM_BLOCKN_BUFFERED, 65536);
3275 make_encoding_output_stream (XLSTREAM (outstream), codesys);
3276 Lstream_set_buffering (XLSTREAM (outstream),
3277 LSTREAM_BLOCKN_BUFFERED, 65536);
3278 #endif /* FILE_CODING */
3279 if (STRINGP (start))
3281 instream = make_lisp_string_input_stream (start, 0, -1);
3285 instream = make_lisp_buffer_input_stream (current_buffer, start1, end1,
3287 LSTR_IGNORE_ACCESSIBLE);
3288 failure = (0 > (a_write (outstream, instream, start1,
3291 /* Note that this doesn't close the desc since we created the
3292 stream without the LSTR_CLOSING flag, but it does
3293 flush out any buffered data. */
3294 if (Lstream_close (XLSTREAM (outstream)) < 0)
3299 Lstream_close (XLSTREAM (instream));
3303 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3304 Disk full in NFS may be reported here. */
3305 /* mib says that closing the file will try to write as fast as NFS can do
3306 it, and that means the fsync here is not crucial for autosave files. */
3307 if (!auto_saving && fsync (desc) < 0
3308 /* If fsync fails with EINTR, don't treat that as serious. */
3314 #endif /* HAVE_FSYNC */
3316 /* Spurious "file has changed on disk" warnings used to be seen on
3317 systems where close() can change the modtime. This is known to
3318 happen on various NFS file systems, on Windows, and on Linux.
3319 Rather than handling this on a per-system basis, we
3320 unconditionally do the stat() after the close(). */
3322 /* NFS can report a write failure now. */
3323 if (close (desc) < 0)
3329 /* Discard the close unwind-protect. Execute the one for
3330 build_annotations (switches back to the original current buffer
3332 XCAR (desc_locative) = Qnil;
3333 unbind_to (speccount, Qnil);
3336 stat ((char *) XSTRING_DATA (fn), &st);
3338 #ifdef CLASH_DETECTION
3340 unlock_file (lockname);
3341 #endif /* CLASH_DETECTION */
3343 /* Do this before reporting IO error
3344 to avoid a "file has changed on disk" warning on
3345 next attempt to save. */
3347 current_buffer->modtime = st.st_mtime;
3350 error ("IO error writing %s: %s",
3352 strerror (save_errno));
3356 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3357 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3358 current_buffer->filename = visit_file;
3359 MARK_MODELINE_CHANGED;
3369 message ("Wrote %s", XSTRING_DATA (visit_file));
3372 struct gcpro gcpro1;
3376 fsp = Ffile_symlink_p (fn);
3378 message ("Wrote %s", XSTRING_DATA (fn));
3380 message ("Wrote %s (symlink to %s)",
3381 XSTRING_DATA (fn), XSTRING_DATA (fsp));
3388 /* #### This is such a load of shit!!!! There is no way we should define
3389 something so stupid as a subr, just sort the fucking list more
3391 DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3392 Return t if (car A) is numerically less than (car B).
3396 Lisp_Object objs[2];
3399 return Flss (2, objs);
3402 /* Heh heh heh, let's define this too, just to aggravate the person who
3403 wrote the above comment. */
3404 DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3405 Return t if (cdr A) is numerically less than (cdr B).
3409 Lisp_Object objs[2];
3412 return Flss (2, objs);
3415 /* Build the complete list of annotations appropriate for writing out
3416 the text between START and END, by calling all the functions in
3417 write-region-annotate-functions and merging the lists they return.
3418 If one of these functions switches to a different buffer, we assume
3419 that buffer contains altered text. Therefore, the caller must
3420 make sure to restore the current buffer in all cases,
3421 as save-excursion would do. */
3424 build_annotations (Lisp_Object start, Lisp_Object end)
3426 /* This function can GC */
3427 Lisp_Object annotations;
3429 struct gcpro gcpro1, gcpro2;
3430 Lisp_Object original_buffer;
3432 XSETBUFFER (original_buffer, current_buffer);
3435 p = Vwrite_region_annotate_functions;
3436 GCPRO2 (annotations, p);
3439 struct buffer *given_buffer = current_buffer;
3440 Vwrite_region_annotations_so_far = annotations;
3441 res = call2 (Fcar (p), start, end);
3442 /* If the function makes a different buffer current,
3443 assume that means this buffer contains altered text to be output.
3444 Reset START and END from the buffer bounds
3445 and discard all previous annotations because they should have
3446 been dealt with by this function. */
3447 if (current_buffer != given_buffer)
3449 start = make_int (BUF_BEGV (current_buffer));
3450 end = make_int (BUF_ZV (current_buffer));
3453 Flength (res); /* Check basic validity of return value */
3454 annotations = merge (annotations, res, Qcar_less_than_car);
3458 /* Now do the same for annotation functions implied by the file-format */
3459 if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
3460 p = Vauto_save_file_format;
3462 p = current_buffer->file_format;
3465 struct buffer *given_buffer = current_buffer;
3466 Vwrite_region_annotations_so_far = annotations;
3467 res = call4 (Qformat_annotate_function, Fcar (p), start, end,
3469 if (current_buffer != given_buffer)
3471 start = make_int (BUF_BEGV (current_buffer));
3472 end = make_int (BUF_ZV (current_buffer));
3476 annotations = merge (annotations, res, Qcar_less_than_car);
3483 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3484 EOF is encountered), assuming they start at position POS in the buffer
3485 of string that STREAM refers to. Intersperse with them the annotations
3486 from *ANNOT that fall into the range of positions we are reading from,
3487 each at its appropriate position.
3489 Modify *ANNOT by discarding elements as we output them.
3490 The return value is negative in case of system call failure. */
3492 /* 4K should probably be fine. We just need to reduce the number of
3493 function calls to reasonable level. The Lstream stuff itself will
3494 batch to 64K to reduce the number of system calls. */
3496 #define A_WRITE_BATCH_SIZE 4096
3499 a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3504 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3505 Lstream *instr = XLSTREAM (instream);
3506 Lstream *outstr = XLSTREAM (outstream);
3508 while (LISTP (*annot))
3510 tem = Fcar_safe (Fcar (*annot));
3512 nextpos = XINT (tem);
3516 /* If there are annotations left and we have Mule, then we
3517 have to do the I/O one emchar at a time so we can
3518 determine when to insert the annotation. */
3522 while (pos != nextpos && (ch = Lstream_get_emchar (instr)) != EOF)
3524 if (Lstream_put_emchar (outstr, ch) < 0)
3532 while (pos != nextpos)
3534 /* Otherwise there is no point to that. Just go in batches. */
3535 int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE);
3537 chunk = Lstream_read (instr, largebuf, chunk);
3540 if (chunk == 0) /* EOF */
3542 if (Lstream_write (outstr, largebuf, chunk) < chunk)
3549 tem = Fcdr (Fcar (*annot));
3552 if (Lstream_write (outstr, XSTRING_DATA (tem),
3553 XSTRING_LENGTH (tem)) < 0)
3556 *annot = Fcdr (*annot);
3567 #include <des_crypt.h>
3569 #define CRYPT_BLOCK_SIZE 8 /* bytes */
3570 #define CRYPT_KEY_SIZE 8 /* bytes */
3572 DEFUN ("encrypt-string", Fencrypt_string, 2, 2, 0, /*
3573 Encrypt STRING using KEY.
3577 char *encrypted_string, *raw_key;
3578 int rounded_size, extra, key_size;
3580 /* !!#### May produce bogus data under Mule. */
3581 CHECK_STRING (string);
3584 extra = XSTRING_LENGTH (string) % CRYPT_BLOCK_SIZE;
3585 rounded_size = XSTRING_LENGTH (string) + extra;
3586 encrypted_string = alloca (rounded_size + 1);
3587 memcpy (encrypted_string, XSTRING_DATA (string), XSTRING_LENGTH (string));
3588 memset (encrypted_string + rounded_size - extra, 0, extra + 1);
3590 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3592 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3593 memcpy (raw_key, XSTRING_DATA (key), key_size);
3594 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3596 ecb_crypt (raw_key, encrypted_string, rounded_size,
3597 DES_ENCRYPT | DES_SW);
3598 return make_string (encrypted_string, rounded_size);
3601 DEFUN ("decrypt-string", Fdecrypt_string, 2, 2, 0, /*
3602 Decrypt STRING using KEY.
3606 char *decrypted_string, *raw_key;
3607 int string_size, key_size;
3609 CHECK_STRING (string);
3612 string_size = XSTRING_LENGTH (string) + 1;
3613 decrypted_string = alloca (string_size);
3614 memcpy (decrypted_string, XSTRING_DATA (string), string_size);
3615 decrypted_string[string_size - 1] = '\0';
3617 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3619 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3620 memcpy (raw_key, XSTRING_DATA (key), key_size);
3621 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3624 ecb_crypt (raw_key, decrypted_string, string_size, D | DES_SW);
3625 return make_string (decrypted_string, string_size - 1);
3630 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
3631 Return t if last mod time of BUF's visited file matches what BUF records.
3632 This means that the file has not been changed since it was visited or saved.
3636 /* This function can call lisp */
3639 Lisp_Object handler;
3644 if (!STRINGP (b->filename)) return Qt;
3645 if (b->modtime == 0) return Qt;
3647 /* If the file name has special constructs in it,
3648 call the corresponding file handler. */
3649 handler = Ffind_file_name_handler (b->filename,
3650 Qverify_visited_file_modtime);
3651 if (!NILP (handler))
3652 return call2 (handler, Qverify_visited_file_modtime, buf);
3654 if (stat ((char *) XSTRING_DATA (b->filename), &st) < 0)
3656 /* If the file doesn't exist now and didn't exist before,
3657 we say that it isn't modified, provided the error is a tame one. */
3658 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3663 if (st.st_mtime == b->modtime
3664 /* If both are positive, accept them if they are off by one second. */
3665 || (st.st_mtime > 0 && b->modtime > 0
3666 && (st.st_mtime == b->modtime + 1
3667 || st.st_mtime == b->modtime - 1)))
3672 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3673 Clear out records of last mod time of visited file.
3674 Next attempt to save will certainly not complain of a discrepancy.
3678 current_buffer->modtime = 0;
3682 DEFUN ("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3683 Return the current buffer's recorded visited file modification time.
3684 The value is a list of the form (HIGH . LOW), like the time values
3685 that `file-attributes' returns.
3689 return time_to_lisp ((time_t) current_buffer->modtime);
3692 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3693 Update buffer's recorded modification time from the visited file's time.
3694 Useful if the buffer was not read from the file normally
3695 or if the file itself has been changed for some known benign reason.
3696 An argument specifies the modification time value to use
3697 \(instead of that of the visited file), in the form of a list
3698 \(HIGH . LOW) or (HIGH LOW).
3702 /* This function can call lisp */
3703 if (!NILP (time_list))
3706 lisp_to_time (time_list, &the_time);
3707 current_buffer->modtime = (int) the_time;
3711 Lisp_Object filename;
3713 Lisp_Object handler;
3714 struct gcpro gcpro1, gcpro2, gcpro3;
3716 GCPRO3 (filename, time_list, current_buffer->filename);
3717 filename = Fexpand_file_name (current_buffer->filename, Qnil);
3719 /* If the file name has special constructs in it,
3720 call the corresponding file handler. */
3721 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
3723 if (!NILP (handler))
3724 /* The handler can find the file name the same way we did. */
3725 return call2 (handler, Qset_visited_file_modtime, Qnil);
3726 else if (stat ((char *) XSTRING_DATA (filename), &st) >= 0)
3727 current_buffer->modtime = st.st_mtime;
3734 auto_save_error (Lisp_Object condition_object, Lisp_Object ignored)
3736 /* This function can call lisp */
3739 /* Don't try printing an error message after everything is gone! */
3740 if (preparing_for_armageddon)
3742 clear_echo_area (selected_frame (), Qauto_saving, 1);
3743 Fding (Qt, Qauto_save_error, Qnil);
3744 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3745 Fsleep_for (make_int (1));
3746 message ("Auto-saving...error!for %s", XSTRING_DATA (current_buffer->name));
3747 Fsleep_for (make_int (1));
3748 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3749 Fsleep_for (make_int (1));
3754 auto_save_1 (Lisp_Object ignored)
3756 /* This function can call lisp */
3757 /* #### I think caller is protecting current_buffer? */
3759 Lisp_Object fn = current_buffer->filename;
3760 Lisp_Object a = current_buffer->auto_save_file_name;
3765 /* Get visited file's mode to become the auto save file's mode. */
3767 stat ((char *) XSTRING_DATA (fn), &st) >= 0)
3768 /* But make sure we can overwrite it later! */
3769 auto_save_mode_bits = st.st_mode | 0600;
3771 /* default mode for auto-save files of buffers with no file is
3772 readable by owner only. This may annoy some small number of
3773 people, but the alternative removes all privacy from email. */
3774 auto_save_mode_bits = 0600;
3777 /* !!#### need to deal with this 'escape-quoted everywhere */
3778 Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil,
3788 auto_save_expand_name_error (Lisp_Object condition_object, Lisp_Object ignored)
3790 /* #### this function should spew an error message about not being
3791 able to open the .saves file. */
3796 auto_save_expand_name (Lisp_Object name)
3798 struct gcpro gcpro1;
3800 /* note that caller did NOT gc protect name, so we do it. */
3801 /* #### dmoore - this might not be necessary, if condition_case_1
3802 protects it. but I don't think it does. */
3804 RETURN_UNGCPRO (Fexpand_file_name (name, Qnil));
3809 do_auto_save_unwind (Lisp_Object fd)
3816 do_auto_save_unwind_2 (Lisp_Object old_auto_saving)
3818 auto_saving = XINT (old_auto_saving);
3822 /* Fdo_auto_save() checks whether a GC is in progress when it is called,
3823 and if so, tries to avoid touching lisp objects.
3825 The only time that Fdo_auto_save() is called while GC is in progress
3826 is if we're going down, as a result of an abort() or a kill signal.
3827 It's fairly important that we generate autosave files in that case!
3830 DEFUN ("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3831 Auto-save all buffers that need it.
3832 This is all buffers that have auto-saving enabled
3833 and are changed since last auto-saved.
3834 Auto-saving writes the buffer into a file
3835 so that your editing is not lost if the system crashes.
3836 This file is not the file you visited; that changes only when you save.
3837 Normally we run the normal hook `auto-save-hook' before saving.
3839 Non-nil first argument means do not print any message if successful.
3840 Non-nil second argument means save only current buffer.
3842 (no_message, current_only))
3844 /* This function can call lisp */
3846 Lisp_Object tail, buf;
3848 int do_handled_files;
3849 Lisp_Object oquit = Qnil;
3850 Lisp_Object listfile = Qnil;
3853 int speccount = specpdl_depth ();
3854 struct gcpro gcpro1, gcpro2, gcpro3;
3856 XSETBUFFER (old, current_buffer);
3857 GCPRO3 (oquit, listfile, old);
3858 check_quit (); /* make Vquit_flag accurate */
3859 /* Ordinarily don't quit within this function,
3860 but don't make it impossible to quit (in case we get hung in I/O). */
3864 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3865 variables point to non-strings reached from Vbuffer_alist. */
3867 if (minibuf_level != 0 || preparing_for_armageddon)
3870 run_hook (Qauto_save_hook);
3872 if (STRINGP (Vauto_save_list_file_name))
3873 listfile = condition_case_1 (Qt,
3874 auto_save_expand_name,
3875 Vauto_save_list_file_name,
3876 auto_save_expand_name_error, Qnil);
3878 /* Make sure auto_saving is reset. */
3879 record_unwind_protect (do_auto_save_unwind_2, make_int (auto_saving));
3883 /* First, save all files which don't have handlers. If Emacs is
3884 crashing, the handlers may tweak what is causing Emacs to crash
3885 in the first place, and it would be a shame if Emacs failed to
3886 autosave perfectly ordinary files because it couldn't handle some
3888 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
3890 for (tail = Vbuffer_alist;
3894 buf = XCDR (XCAR (tail));
3897 if (!NILP (current_only)
3898 && b != current_buffer)
3901 /* Don't auto-save indirect buffers.
3902 The base buffer takes care of it. */
3906 /* Check for auto save enabled
3907 and file changed since last auto save
3908 and file changed since last real save. */
3909 if (STRINGP (b->auto_save_file_name)
3910 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
3911 && b->auto_save_modified < BUF_MODIFF (b)
3912 /* -1 means we've turned off autosaving for a while--see below. */
3913 && XINT (b->saved_size) >= 0
3914 && (do_handled_files
3915 || NILP (Ffind_file_name_handler (b->auto_save_file_name,
3918 EMACS_TIME before_time, after_time;
3920 EMACS_GET_TIME (before_time);
3921 /* If we had a failure, don't try again for 20 minutes. */
3922 if (!preparing_for_armageddon
3923 && b->auto_save_failure_time >= 0
3924 && (EMACS_SECS (before_time) - b->auto_save_failure_time <
3928 if (!preparing_for_armageddon &&
3929 (XINT (b->saved_size) * 10
3930 > (BUF_Z (b) - BUF_BEG (b)) * 13)
3931 /* A short file is likely to change a large fraction;
3932 spare the user annoying messages. */
3933 && XINT (b->saved_size) > 5000
3934 /* These messages are frequent and annoying for `*mail*'. */
3935 && !NILP (b->filename)
3936 && NILP (no_message)
3937 && disable_auto_save_when_buffer_shrinks)
3939 /* It has shrunk too much; turn off auto-saving here.
3940 Unless we're about to crash, in which case auto-save it
3944 ("Buffer %s has shrunk a lot; auto save turned off there",
3945 XSTRING_DATA (b->name));
3946 /* Turn off auto-saving until there's a real save,
3947 and prevent any more warnings. */
3948 b->saved_size = make_int (-1);
3949 if (!gc_in_progress)
3950 Fsleep_for (make_int (1));
3953 set_buffer_internal (b);
3954 if (!auto_saved && NILP (no_message))
3956 static const unsigned char *msg
3957 = (const unsigned char *) "Auto-saving...";
3958 echo_area_message (selected_frame (), msg, Qnil,
3959 0, strlen ((const char *) msg),
3963 /* Open the auto-save list file, if necessary.
3964 We only do this now so that the file only exists
3965 if we actually auto-saved any files. */
3966 if (!auto_saved && STRINGP (listfile) && listdesc < 0)
3968 listdesc = open ((char *) XSTRING_DATA (listfile),
3969 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
3972 /* Arrange to close that file whether or not we get
3975 record_unwind_protect (do_auto_save_unwind,
3976 make_int (listdesc));
3979 /* Record all the buffers that we are auto-saving in
3980 the special file that lists them. For each of
3981 these buffers, record visited name (if any) and
3985 const Extbyte *auto_save_file_name_ext;
3986 Extcount auto_save_file_name_ext_len;
3988 TO_EXTERNAL_FORMAT (LISP_STRING, b->auto_save_file_name,
3989 ALLOCA, (auto_save_file_name_ext,
3990 auto_save_file_name_ext_len),
3992 if (!NILP (b->filename))
3994 const Extbyte *filename_ext;
3995 Extcount filename_ext_len;
3997 TO_EXTERNAL_FORMAT (LISP_STRING, b->filename,
3998 ALLOCA, (filename_ext,
4001 write (listdesc, filename_ext, filename_ext_len);
4003 write (listdesc, "\n", 1);
4004 write (listdesc, auto_save_file_name_ext,
4005 auto_save_file_name_ext_len);
4006 write (listdesc, "\n", 1);
4009 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
4010 based on values in Vbuffer_alist. auto_save_1 may
4011 cause lisp handlers to run. Those handlers may kill
4012 the buffer and then GC. Since the buffer is killed,
4013 it's no longer in Vbuffer_alist so it might get reaped
4014 by the GC. We also need to protect tail. */
4015 /* #### There is probably a lot of other code which has
4016 pointers into buffers which may get blown away by
4019 struct gcpro ngcpro1, ngcpro2;
4020 NGCPRO2 (buf, tail);
4021 condition_case_1 (Qt,
4023 auto_save_error, Qnil);
4026 /* Handler killed our saved current-buffer! Pick any. */
4027 if (!BUFFER_LIVE_P (XBUFFER (old)))
4028 XSETBUFFER (old, current_buffer);
4030 set_buffer_internal (XBUFFER (old));
4033 /* Handler killed their own buffer! */
4034 if (!BUFFER_LIVE_P(b))
4037 b->auto_save_modified = BUF_MODIFF (b);
4038 b->saved_size = make_int (BUF_SIZE (b));
4039 EMACS_GET_TIME (after_time);
4040 /* If auto-save took more than 60 seconds,
4041 assume it was an NFS failure that got a timeout. */
4042 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
4043 b->auto_save_failure_time = EMACS_SECS (after_time);
4048 /* Prevent another auto save till enough input events come in. */
4050 record_auto_save ();
4052 /* If we didn't save anything into the listfile, remove the old
4053 one because nothing needed to be auto-saved. Do this afterwards
4054 rather than before in case we get a crash attempting to autosave
4055 (in that case we'd still want the old one around). */
4056 if (listdesc < 0 && !auto_saved && STRINGP (listfile))
4057 unlink ((char *) XSTRING_DATA (listfile));
4059 /* Show "...done" only if the echo area would otherwise be empty. */
4060 if (auto_saved && NILP (no_message)
4061 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0)))
4063 static const unsigned char *msg
4064 = (const unsigned char *)"Auto-saving...done";
4065 echo_area_message (selected_frame (), msg, Qnil, 0,
4066 strlen ((const char *) msg), Qauto_saving);
4071 RETURN_UNGCPRO (unbind_to (speccount, Qnil));
4074 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
4075 Mark current buffer as auto-saved with its current text.
4076 No auto-save file will be written until the buffer changes again.
4080 current_buffer->auto_save_modified = BUF_MODIFF (current_buffer);
4081 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
4082 current_buffer->auto_save_failure_time = -1;
4086 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
4087 Clear any record of a recent auto-save failure in the current buffer.
4091 current_buffer->auto_save_failure_time = -1;
4095 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
4096 Return t if buffer has been auto-saved since last read in or saved.
4100 return (BUF_SAVE_MODIFF (current_buffer) <
4101 current_buffer->auto_save_modified) ? Qt : Qnil;
4105 /************************************************************************/
4106 /* initialization */
4107 /************************************************************************/
4110 syms_of_fileio (void)
4112 defsymbol (&Qexpand_file_name, "expand-file-name");
4113 defsymbol (&Qfile_truename, "file-truename");
4114 defsymbol (&Qsubstitute_in_file_name, "substitute-in-file-name");
4115 defsymbol (&Qdirectory_file_name, "directory-file-name");
4116 defsymbol (&Qfile_name_directory, "file-name-directory");
4117 defsymbol (&Qfile_name_nondirectory, "file-name-nondirectory");
4118 defsymbol (&Qunhandled_file_name_directory, "unhandled-file-name-directory");
4119 defsymbol (&Qfile_name_as_directory, "file-name-as-directory");
4120 defsymbol (&Qcopy_file, "copy-file");
4121 defsymbol (&Qmake_directory_internal, "make-directory-internal");
4122 defsymbol (&Qdelete_directory, "delete-directory");
4123 defsymbol (&Qdelete_file, "delete-file");
4124 defsymbol (&Qrename_file, "rename-file");
4125 defsymbol (&Qadd_name_to_file, "add-name-to-file");
4126 defsymbol (&Qmake_symbolic_link, "make-symbolic-link");
4127 defsymbol (&Qfile_exists_p, "file-exists-p");
4128 defsymbol (&Qfile_executable_p, "file-executable-p");
4129 defsymbol (&Qfile_readable_p, "file-readable-p");
4130 defsymbol (&Qfile_symlink_p, "file-symlink-p");
4131 defsymbol (&Qfile_writable_p, "file-writable-p");
4132 defsymbol (&Qfile_directory_p, "file-directory-p");
4133 defsymbol (&Qfile_regular_p, "file-regular-p");
4134 defsymbol (&Qfile_accessible_directory_p, "file-accessible-directory-p");
4135 defsymbol (&Qfile_modes, "file-modes");
4136 defsymbol (&Qset_file_modes, "set-file-modes");
4137 defsymbol (&Qfile_newer_than_file_p, "file-newer-than-file-p");
4138 defsymbol (&Qinsert_file_contents, "insert-file-contents");
4139 defsymbol (&Qwrite_region, "write-region");
4140 defsymbol (&Qverify_visited_file_modtime, "verify-visited-file-modtime");
4141 defsymbol (&Qset_visited_file_modtime, "set-visited-file-modtime");
4142 defsymbol (&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */
4144 defsymbol (&Qauto_save_hook, "auto-save-hook");
4145 defsymbol (&Qauto_save_error, "auto-save-error");
4146 defsymbol (&Qauto_saving, "auto-saving");
4148 defsymbol (&Qformat_decode, "format-decode");
4149 defsymbol (&Qformat_annotate_function, "format-annotate-function");
4151 defsymbol (&Qcompute_buffer_file_truename, "compute-buffer-file-truename");
4152 deferror (&Qfile_error, "file-error", "File error", Qio_error);
4153 deferror (&Qfile_already_exists, "file-already-exists",
4154 "File already exists", Qfile_error);
4156 DEFSUBR (Ffind_file_name_handler);
4158 DEFSUBR (Ffile_name_directory);
4159 DEFSUBR (Ffile_name_nondirectory);
4160 DEFSUBR (Funhandled_file_name_directory);
4161 DEFSUBR (Ffile_name_as_directory);
4162 DEFSUBR (Fdirectory_file_name);
4163 DEFSUBR (Fmake_temp_name);
4164 DEFSUBR (Fexpand_file_name);
4165 DEFSUBR (Ffile_truename);
4166 DEFSUBR (Fsubstitute_in_file_name);
4167 DEFSUBR (Fcopy_file);
4168 DEFSUBR (Fmake_directory_internal);
4169 DEFSUBR (Fdelete_directory);
4170 DEFSUBR (Fdelete_file);
4171 DEFSUBR (Frename_file);
4172 DEFSUBR (Fadd_name_to_file);
4173 DEFSUBR (Fmake_symbolic_link);
4175 DEFSUBR (Fsysnetunam);
4176 #endif /* HPUX_NET */
4177 DEFSUBR (Ffile_name_absolute_p);
4178 DEFSUBR (Ffile_exists_p);
4179 DEFSUBR (Ffile_executable_p);
4180 DEFSUBR (Ffile_readable_p);
4181 DEFSUBR (Ffile_writable_p);
4182 DEFSUBR (Ffile_symlink_p);
4183 DEFSUBR (Ffile_directory_p);
4184 DEFSUBR (Ffile_accessible_directory_p);
4185 DEFSUBR (Ffile_regular_p);
4186 DEFSUBR (Ffile_modes);
4187 DEFSUBR (Fset_file_modes);
4188 DEFSUBR (Fset_default_file_modes);
4189 DEFSUBR (Fdefault_file_modes);
4190 DEFSUBR (Funix_sync);
4191 DEFSUBR (Ffile_newer_than_file_p);
4192 DEFSUBR (Finsert_file_contents_internal);
4193 DEFSUBR (Fwrite_region_internal);
4194 DEFSUBR (Fcar_less_than_car); /* Vomitous! */
4195 DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
4197 DEFSUBR (Fencrypt_string);
4198 DEFSUBR (Fdecrypt_string);
4200 DEFSUBR (Fverify_visited_file_modtime);
4201 DEFSUBR (Fclear_visited_file_modtime);
4202 DEFSUBR (Fvisited_file_modtime);
4203 DEFSUBR (Fset_visited_file_modtime);
4205 DEFSUBR (Fdo_auto_save);
4206 DEFSUBR (Fset_buffer_auto_saved);
4207 DEFSUBR (Fclear_buffer_auto_save_failure);
4208 DEFSUBR (Frecent_auto_save_p);
4212 vars_of_fileio (void)
4214 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /*
4215 *Format in which to write auto-save files.
4216 Should be a list of symbols naming formats that are defined in `format-alist'.
4217 If it is t, which is the default, auto-save files are written in the
4218 same format as a regular save would use.
4220 Vauto_save_file_format = Qt;
4222 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /*
4223 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
4224 If a file name matches REGEXP, then all I/O on that file is done by calling
4227 The first argument given to HANDLER is the name of the I/O primitive
4228 to be handled; the remaining arguments are the arguments that were
4229 passed to that primitive. For example, if you do
4230 (file-exists-p FILENAME)
4231 and FILENAME is handled by HANDLER, then HANDLER is called like this:
4232 (funcall HANDLER 'file-exists-p FILENAME)
4233 The function `find-file-name-handler' checks this list for a handler
4236 Vfile_name_handler_alist = Qnil;
4238 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /*
4239 A list of functions to be called at the end of `insert-file-contents'.
4240 Each is passed one argument, the number of bytes inserted. It should return
4241 the new byte count, and leave point the same. If `insert-file-contents' is
4242 intercepted by a handler from `file-name-handler-alist', that handler is
4243 responsible for calling the after-insert-file-functions if appropriate.
4245 Vafter_insert_file_functions = Qnil;
4247 DEFVAR_LISP ("write-region-annotate-functions",
4248 &Vwrite_region_annotate_functions /*
4249 A list of functions to be called at the start of `write-region'.
4250 Each is passed two arguments, START and END, as for `write-region'.
4251 It should return a list of pairs (POSITION . STRING) of strings to be
4252 effectively inserted at the specified positions of the file being written
4253 \(1 means to insert before the first byte written). The POSITIONs must be
4254 sorted into increasing order. If there are several functions in the list,
4255 the several lists are merged destructively.
4257 Vwrite_region_annotate_functions = Qnil;
4259 DEFVAR_LISP ("write-region-annotations-so-far",
4260 &Vwrite_region_annotations_so_far /*
4261 When an annotation function is called, this holds the previous annotations.
4262 These are the annotations made by other annotation functions
4263 that were already called. See also `write-region-annotate-functions'.
4265 Vwrite_region_annotations_so_far = Qnil;
4267 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
4268 A list of file name handlers that temporarily should not be used.
4269 This applies only to the operation `inhibit-file-name-operation'.
4271 Vinhibit_file_name_handlers = Qnil;
4273 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
4274 The operation for which `inhibit-file-name-handlers' is applicable.
4276 Vinhibit_file_name_operation = Qnil;
4278 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name /*
4279 File name in which we write a list of all auto save file names.
4281 Vauto_save_list_file_name = Qnil;
4283 DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks",
4284 &disable_auto_save_when_buffer_shrinks /*
4285 If non-nil, auto-saving is disabled when a buffer shrinks too much.
4286 This is to prevent you from losing your edits if you accidentally
4287 delete a large chunk of the buffer and don't notice it until too late.
4288 Saving the buffer normally turns auto-save back on.
4290 disable_auto_save_when_buffer_shrinks = 1;
4292 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /*
4293 Directory separator character for built-in functions that return file names.
4294 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
4295 This variable affects the built-in functions only on Windows,
4296 on other platforms, it is initialized so that Lisp code can find out
4297 what the normal separator is.
4300 Vdirectory_sep_char = make_char ('\\');
4302 Vdirectory_sep_char = make_char ('/');
4305 reinit_vars_of_fileio ();
4309 reinit_vars_of_fileio (void)
4311 /* We want temp_name_rand to be initialized to a value likely to be
4312 unique to the process, not to the executable. The danger is that
4313 two different XEmacs processes using the same binary on different
4314 machines creating temp files in the same directory will be
4315 unlucky enough to have the same pid. If we randomize using
4316 process startup time, then in practice they will be unlikely to
4317 collide. We use the microseconds field so that scripts that start
4318 simultaneous XEmacs processes on multiple machines will have less
4319 chance of collision. */
4323 EMACS_GET_TIME (thyme);
4324 temp_name_rand = (unsigned int) (EMACS_SECS (thyme) ^ EMACS_USECS (thyme));